mescc: Nyacc updates, factor-out elf-util.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 2 Apr 2017 09:55:37 +0000 (11:55 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 2 Apr 2017 09:55:37 +0000 (11:55 +0200)
* module/mes/bytevectors.mes
* module/mes/elf-util.mes: New file.
* module/mes/elf.mes: Use it.
  (make-elf): Generate symbol-table string-table.
* module/mes/elf-util.scm: New file.
* module/mes/elf.scm: Use it.
* module/language/c99/compiler.mes: Include it.
* module/language/c99/compiler.scm: Include it.
* module/mes/libc-i386.mes (call, eputs, exit, puts): New functions.
* module/mes/libc-i386.scm: Export them.

module/language/c99/compiler.mes
module/language/c99/compiler.scm
module/mes/elf-util.mes [new file with mode: 0644]
module/mes/elf-util.scm [new file with mode: 0644]
module/mes/elf.mes
module/mes/elf.scm
module/mes/libc-i386.mes
module/mes/libc-i386.scm

index d60332b59a3aa0ad108f46b8aea132dd78a7b562..5458356c7074a83c72c0f4e9279e0d35826ffb7d 100644 (file)
 ;;; Code:
 
 (cond-expand
-  (guile
-   (set-port-encoding! (current-output-port) "ISO-8859-1"))
-  (mes
-   (mes-use-module (nyacc lang c99 parser))
-   (mes-use-module (mes pmatch))
-   (mes-use-module (mes elf))
-   (mes-use-module (mes libc-i386))))
+ (guile-2
+  (set-port-encoding! (current-output-port) "ISO-8859-1"))
+ (guile)
+ (mes
+  (mes-use-module (nyacc lang c99 parser))
+  (mes-use-module (mes elf-util))
+  (mes-use-module (mes pmatch))
+  (mes-use-module (mes elf))
+  (mes-use-module (mes libc-i386))))
+
+;;(define (gnuc-xdef? name mode) (if (equal? name "__GNUC__") #f (env? mode 'code)))
+;;(define (gnuc-xdef? name mode) (equal? name "__GNUC__"))
+(define (gnuc-xdef? name mode)
+  (cond ((equal? name "__GNUC__") #t)
+        ((equal? name "asm") #f)))
 
 (define (mescc)
-  (parse-c99 #:inc-dirs '()))
+  (parse-c99 #:inc-dirs (string-split (getenv "C_INCLUDE_PATH") #\:)
+             #:cpp-defs '(("__GNUC__" . "0"))
+             #:xdef? gnuc-xdef?))
 
 (define (write-any x)
   (write-char (if (char? x) x (integer->char (if (>= x 0) x (+ x 256))))))
   (pmatch o
     ((fctn-defn _ (ftn-declr (ident ,name) _) (compd-stmt (block-item-list . ,statements))) statements)))
 
-(define (statement->data o)
-  (pmatch o
-    ((expr-stmt (fctn-call (p-expr (ident ,name))
-                           (expr-list (p-expr (string ,string)))))
-     (string->list string))
-    ((for (decl (decl-spec-list (type-spec (fixed-type ,type)))
-                  (init-declr-list (init-declr (ident ,identifier)
-                                               (initzer (p-expr (fixed ,start))))))
-            (lt (p-expr (ident _)) (p-expr (fixed ,test)))
-            ,step ;;(pre-inc (p-expr (ident i)))
-            ,statement)
-     (statement->data statement))
-    (_ '())))
-
-(define (statement->text data o)
-  (let ((offset (length data)))
+(define (expr->arg symbols) ;; FIXME: get Mes curried-definitions
+  (lambda (o)
     (pmatch o
-      ((expr-stmt (fctn-call (p-expr (ident ,name))
-                             (expr-list (p-expr (string ,string)))))
-       (list (lambda (data) (i386:puts (+ data offset) (string-length string)))))
-      ((for (decl (decl-spec-list (type-spec (fixed-type ,type)))
-                  (init-declr-list (init-declr (ident ,identifier)
-                                               (initzer (p-expr (fixed ,start))))))
-            (lt (p-expr (ident _)) (p-expr (fixed ,test)))
-            ,step ;;(pre-inc (p-expr (ident i)))
-            ,statement)
-       (display "start:" (current-error-port))
-       (display start (current-error-port))
-       (newline (current-error-port))
-
-       (display "test:" (current-error-port))
-       (display test (current-error-port))
-       (newline (current-error-port))
-
-       ;; (display "step:" (current-error-port))
-       ;; (display step (current-error-port))
-       ;; (newline (current-error-port))
-       ;; 
-       (display "for-statement:" (current-error-port))
-       (display statement (current-error-port))
-       (newline (current-error-port))
-
-       (let ((start (string->number start))
-             (test (string->number test))
-             (step 1)
-             (statement (car (statement->text data statement))))
-         
-         (display "2start:" (current-error-port))
-         (display start (current-error-port))
-         (newline (current-error-port))
-
-         (display "2for-statement:" (current-error-port))
-         (display statement (current-error-port))
-         (newline (current-error-port))
-
-         (list (lambda (d) (i386:for start test step (statement d))))))
-
-      ((return (p-expr (fixed ,value)))
-       (let ((value (string->number value)))
-        (list (lambda (data) (i386:exit value)))))
-      (_ '()))))
-
-(define (function->text+data o)
-  (let loop ((statements (.statements o)) (text '()) (data '()))
-    (display "text:" (current-error-port))
-    (display text (current-error-port))
-    (newline (current-error-port))
-    (if (null? statements) (values text data)
-        (let* ((statement (car statements)))
-          (display "statement:" (current-error-port))
-          (display statement (current-error-port))
-          (newline (current-error-port))
-          (loop (cdr statements)
-                (append text (statement->text data statement))
-                (append data (statement->data statement)))))))
-
-(define (text+data->exe text data)
-  (display "dumping to a.out:\n" (current-error-port))
-  (map write-any (make-elf (lambda (data)
-                             (append-map (lambda (f) (f data)) text)) data)))
+      ((p-expr (fixed ,value)) (string->number value))
+      ((p-expr (string ,string)) (data-offset symbols string))
+      (_
+       (format (current-error-port) "SKIPPING expr=~a\n" o)     
+       0))))
+
+(define (expr->symbols o)
+  (pmatch o
+    ((p-expr (string ,string)) (string->symbols string))
+    (_ #f)))
+
+(define make-text+symbols cons)
+(define .text car)
+(define .symbols cdr)
+
+(define (dec->hex o)
+  (number->string o 16))
+
+(define (statement->text+symbols text+symbols)
+  (lambda (o)
+    (let* ((text (.text text+symbols))
+           (symbols (.symbols text+symbols))
+           (text-list (append-map (lambda (f) (f '() 0 0)) text))
+           (prefix-list (symbols->text symbols 0 0))
+           (statement-offset (- (+ (length prefix-list) (length text-list)))))
+      (pmatch o
+        ((expr-stmt (fctn-call (p-expr (ident ,name))
+                               (expr-list (p-expr (string ,string)))))
+         (make-text+symbols
+          (append text
+                  (list (lambda (s t d)
+                          (i386:call (+ t
+                                                      (function-offset name s)
+                                                      statement-offset)
+                                                   (+ d (data-offset string s))))))
+          (append symbols (list (string->symbols string)))));; FIXME: ->symbolSXX
+        
+        ((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
+         (let ((args (map (expr->arg symbols) expr-list)))
+           (make-text+symbols
+            (append text
+                    (list (lambda (s t d) (apply i386:call (cons (+ t (function-offset name s) statement-offset) args)))))
+            (append symbols (filter-map expr->symbols expr-list)))))
+        
+        ((return (p-expr (fixed ,value)))
+         (let ((value (string->number value)))
+           (make-text+symbols (append text (list (lambda _ (i386:ret)))) symbols)))
+
+       (_
+        (format (current-error-port) "SKIPPING S=~a\n" o)
+        text+symbols)))))
+
+(define (symbols->exe symbols)
+  (display "dumping elf\n" (current-error-port))
+  (map write-any (make-elf symbols)))
+
+(define (.formals o)
+  (pmatch o
+    ((fctn-defn _ (ftn-declr _ ,formals) _) formals)
+    (_ (format (current-error-port) ".formals: no match: ~a\n" o)
+       barf)))
+
+(define (formal->text o)
+  '(#x58))  ;; pop %eax
+
+(define (formals->text o)
+  (pmatch o
+    ((param-list . ,formals)
+     (list (lambda (s t d)
+             (append
+              '(#x5f) ;; pop %edi
+              (append-map formal->text formals)
+              '(#x57) ;; push %edi
+              ))))
+    (_ (format (current-error-port) "formals->text+data: no match: ~a\n" o)
+       barf)))
+
+(define (string->symbols string)
+  (make-data string (string->list string)))
+
+(define (function->symbols symbols)
+  (lambda (o)
+    (format (current-error-port) "compiling ~a\n" (.name o))
+    (let* ((text (formals->text (.formals o)))
+           (text-offset (length (symbols->text symbols 0 0))))
+      (let loop ((statements (.statements o))
+                 (text+symbols (make-text+symbols text symbols)))
+        (if (null? statements) (append (.symbols text+symbols) (list (make-function (.name o) (.text text+symbols))))
+            (let* ((statement (car statements)))
+              (loop (cdr statements)
+                    ((statement->text+symbols text+symbols) (car statements)))))))))
+
+(define _start
+  (let* ((ast (with-input-from-string
+                  "int _start () {main(0,0);exit (0);}"
+                parse-c99))
+         (functions (filter ast:function? (cdr ast))))
+    (list (find (lambda (x) (equal? (.name x) "_start")) functions))))
+
+(define libc
+  (list
+   (make-function "eputs" (list i386:eputs))
+   (make-function "exit" (list i386:exit))
+   (make-function "puts" (list i386:puts))))
 
 (define (compile)
   (let* ((ast (mescc))
          (functions (filter ast:function? (cdr ast)))
-         (main (find (lambda (x) (equal? (.name x) "main")) functions)))
-    (display "AST" (current-error-port))
-    (pretty-print ast (current-error-port))
-    (format (current-error-port) "functions~a\n" functions)
-    (format (current-error-port) "main~a\n" main)
-    (call-with-values
-        (lambda () (function->text+data main))
-      text+data->exe)))
+         (functions (append functions _start)))
+    (let loop ((functions functions) (symbols libc))
+      (if (null? functions) (symbols->exe symbols)
+          (loop (cdr functions) ((function->symbols symbols) (car functions)))))))
index ee52800d8b1dc25ee16561a5722ac7ce81adf8f8..fd53c98c4ca7066c76cedc0c8f6dd03cadac08ca 100644 (file)
@@ -27,6 +27,7 @@
   #:use-module (system base pmatch)
   #:use-module (ice-9 pretty-print)
   #:use-module (mes elf)
+  #:use-module (mes elf-util)
   #:use-module (mes libc-i386)
   #:use-module (nyacc lang c99 parser)
   #:export (compile))
diff --git a/module/mes/elf-util.mes b/module/mes/elf-util.mes
new file mode 100644 (file)
index 0000000..3231e7b
--- /dev/null
@@ -0,0 +1,75 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; compiler.mes produces an i386 binary from the C produced by
+;;; Nyacc c99.
+
+;;; Code:
+
+(cond-expand
+ (guile)
+ (guile-2)
+ (mes
+  (mes-use-module (srfi srfi-1))))
+
+(define (make-function key value)
+  (cons key (cons 'function value)))
+
+(define (make-data key value)
+  (cons key (cons 'data value)))
+
+(define (function-symbol? x)
+  (eq? (car x) 'function))
+
+(define (function-entry? x)
+  (function-symbol? (cdr x)))
+
+(define (data-symbol? x)
+  (eq? (car x) 'data))
+
+(define (data-entry? x)
+  (data-symbol? (cdr x)))
+
+(define (symbols->functions symbols)
+  (append-map cdr (filter function-symbol? (map cdr symbols))))
+
+(define (symbols->text symbols t d)
+  (append-map (lambda (f) (f symbols t d)) (symbols->functions symbols)))
+
+(define (function-offset name symbols)
+  (let* ((functions (filter function-entry? symbols))
+         (prefix (member name (reverse functions)
+                         (lambda (a b)
+                           (equal? (car b) name)))))
+    (if prefix (length (symbols->text (cdr prefix) 0 0))
+        0)))
+
+(define (data-offset name symbols)
+  (let* ((globals (filter data-entry? symbols))
+         (prefix (member name (reverse globals)
+                         (lambda (a b)
+                           (equal? (car b) name)))))
+    (if prefix (length (symbols->data (cdr prefix)))
+        0)))
+
+(define (symbols->data symbols)
+  (append-map cdr (filter data-symbol? (map cdr symbols))))
diff --git a/module/mes/elf-util.scm b/module/mes/elf-util.scm
new file mode 100644 (file)
index 0000000..fb33c80
--- /dev/null
@@ -0,0 +1,45 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+;;; This file is part of Mes.
+;;;
+;;; Mes is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; Mes is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(define-module (mes elf-util)
+  #:use-module (srfi srfi-1)
+  #:export (make-data
+            make-function
+            data-entry?
+            data-symbol?
+            function-entry?
+            function-symbol?
+            data-offset
+            function-offset
+            symbols->functions
+            symbols->data
+            symbols->text))
+
+(cond-expand
+ (guile-2)
+ (guile
+  (use-modules (ice-9 syncase)))
+ (mes))
+
+(include-from-path "mes/elf-util.mes")
index 8ea9b679d48f18ca5231a78695769b4b2128327b..58876f5d95c603a897d3fd39377ebcf322353749 100644 (file)
@@ -27,7 +27,9 @@
 (cond-expand
  (guile)
  (mes
-  (mes-use-module (mes bytevectors))))
+  (mes-use-module (srfi srfi-1))
+  (mes-use-module (mes bytevectors))
+  (mes-use-module (mes elf-util))))
 
 (define (int->bv32 value)
   (let ((bv (make-bytevector 4)))
 (define elf32-off int->bv32)
 (define elf32-word int->bv32)
 
-(define (make-elf text data)
- (define vaddress #x08048000)
-
- (define ei-magic `(#x7f ,@(string->list "ELF")))
- (define ei-class '(#x01)) ;; 32 bit
- (define ei-data '(#x01)) ;; little endian
- (define ei-version '(#x01))
- (define ei-osabi '(#x00))
- (define ei-pad '(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0))
- (define e-ident
-   (append
-    ei-magic
-    ei-class
-    ei-data
-    ei-version
-    ei-osabi
-    ei-pad))
-
- (define ET-EXEC 2)
- (define EM-386 3)
- (define EV-CURRENT 1)
-
- (define p-filesz (elf32-word 0))
- (define p-memsz (elf32-word 0))
- (define PF-X 1)
- (define PF-W 2)
- (define PF-R 4)
- (define p-flags (elf32-word (logior PF-X PF-W PF-R)))
- (define p-align (elf32-word 1))
-
- (define (program-header type offset text)
-   (append
-    (elf32-word type)
-    (elf32-off offset)
-    (elf32-addr (+ vaddress offset))
-    (elf32-addr (+ vaddress offset))
-    (elf32-word (length text))
-    (elf32-word (length text))
-    p-flags
-    p-align
-    ))
-
- (define (section-header name type offset text)
-   (append
-    (elf32-word name)
-    (elf32-word type)
-    (elf32-word 3) ;; write/alloc must for data hmm
-    (elf32-addr (+ vaddress offset))
-    (elf32-off offset) 
-    (elf32-word (length text))
-    (elf32-word 0)
-    (elf32-word 0)
-    (elf32-word 1)
-    (elf32-word 0)))
-
-
- (define e-type (elf32-half ET-EXEC))
- (define e-machine (elf32-half EM-386))
- (define e-version (elf32-word EV-CURRENT))
- (define e-entry (elf32-addr 0))
- ;;(define e-entry (elf32-addr (+ vaddress text-offset)))
- ;;(define e-phoff (elf32-off 0))
- (define e-shoff (elf32-off 0))
- (define e-flags (elf32-word 0))
- ;;(define e-ehsize (elf32-half 0))
- (define e-phentsize (elf32-half (length (program-header 0 0 '()))))
- (define e-phnum (elf32-half 1))
- (define e-shentsize (elf32-half (length (section-header 0 0 0 '()))))
- (define e-shnum (elf32-half 5))
- (define e-shstrndx (elf32-half 4))
-
- (define (elf-header size entry sections)
-   (append
-    e-ident
-    e-type
-    e-machine
-    e-version
-    (elf32-addr (+ vaddress entry)) ;; e-entry
-    (elf32-off size) ;; e-phoff
-    (elf32-off sections) ;; e-shoff
-    e-flags
-    (elf32-half size) ;; e-ehsize
-    e-phentsize
-    e-phnum
-    e-shentsize
-    e-shnum
-    e-shstrndx
-    ))
-
- (define elf-header-size
-   (length (elf-header 0 0 0)))
-
- (define program-header-size
-   (length (program-header 0 0 '())))
-
- (define text-offset
-   (+ elf-header-size program-header-size))
-
- (define (program-headers)
-   (append
-    (program-header 1 text-offset (text 0))
-    ))
-
-
- (define note
-   (string->list
-    (string-append
-     "MES"
-     ;;"Mes -- Maxwell Equations of Software\n"
-     ;;"https://gitlab.com/janneke/mes"
-     )
-    ;; #x05 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x02 #x00 #x00 #x00
-    ;; #\i #\3 #\8 #\6 #x00 #x00 #x00 #x00
-    ))
-
- (define tab
-   `(
-     #x00 ,@(string->list ".shstrtab")
-          #x00 ,@(string->list ".text")
-          #x00 ,@(string->list ".data")
-          #x00 ,@(string->list ".note")
-          #x00 #x00 #x00 #x00
-          ))
-
- (define text-length
-   (length (text 0)))
-
- (define data-offset
-   (+ text-offset text-length))
-
- (define data-address (+ data-offset vaddress))
-
- (define data-length
-   (length data))
-
- (define note-length
-   (length note))
-
- (define note-offset
-   (+ data-offset data-length))
-
- (define tab-offset
-   (+ note-offset note-length))
-
- (define tab-length
-   (length tab))
-
- (define section-headers-offset
-   (+ tab-offset tab-length))
-
-
- (define SHT-PROGBITS 1)
- (define SHT-STRTAB 3)
- (define SHT-NOTE 7)
- (define (section-headers)
-   (append
-    (section-header 0 0 0 '())
-    (section-header 11 SHT-PROGBITS text-offset (text 0))
-    (section-header 17 SHT-PROGBITS data-offset data)
-    (section-header 23 SHT-NOTE note-offset note)
-    (section-header 1 SHT-STRTAB tab-offset tab)
-    ))
-
- (define exe
-   (append
-    (elf-header elf-header-size text-offset section-headers-offset)
-    (program-headers)
-    (text data-address)
-    data
-    note
-    tab
-    (section-headers)
-    ))
- exe)
+(define (make-elf symbols)
+  (define vaddress #x08048000)
+
+  (define ei-magic `(#x7f ,@(string->list "ELF")))
+  (define ei-class '(#x01)) ;; 32 bit
+  (define ei-data '(#x01))  ;; little endian
+  (define ei-version '(#x01))
+  (define ei-osabi '(#x00))
+  (define ei-pad '(#x0 #x0 #x0 #x0 #x0 #x0 #x0 #x0))
+  (define e-ident
+    (append
+     ei-magic
+     ei-class
+     ei-data
+     ei-version
+     ei-osabi
+     ei-pad))
+
+  (define ET-EXEC 2)
+  (define EM-386 3)
+  (define EV-CURRENT 1)
+
+  (define p-filesz (elf32-word 0))
+  (define p-memsz (elf32-word 0))
+  (define PF-X 1)
+  (define PF-W 2)
+  (define PF-R 4)
+  (define p-flags (elf32-word (logior PF-X PF-W PF-R)))
+  (define p-align (elf32-word 1))
+
+  (define (program-header type offset text)
+    (append
+     (elf32-word type)
+     (elf32-off offset)
+     (elf32-addr (+ vaddress offset))
+     (elf32-addr (+ vaddress offset))
+     (elf32-word (length text))
+     (elf32-word (length text))
+     p-flags
+     p-align
+     ))
+
+  (define (section-header name type flags offset text sh-link sh-info sh-entsize)
+    (append
+     (elf32-word name)
+     (elf32-word type)
+     ;;;;(elf32-word 3) ;; write/alloc must for data hmm
+     (elf32-word flags)
+     (elf32-addr (+ vaddress offset))
+     (elf32-off offset) 
+     (elf32-word (length text))
+     (elf32-word sh-link)
+     (elf32-word sh-info)
+     (elf32-word 1)
+     (elf32-word sh-entsize)))
+
+
+  (define e-type (elf32-half ET-EXEC))
+  (define e-machine (elf32-half EM-386))
+  (define e-version (elf32-word EV-CURRENT))
+  (define e-entry (elf32-addr 0))
+  ;;(define e-entry (elf32-addr (+ vaddress text-offset)))
+  ;;(define e-phoff (elf32-off 0))
+  (define e-shoff (elf32-off 0))
+  (define e-flags (elf32-word 0))
+  ;;(define e-ehsize (elf32-half 0))
+  (define e-phentsize (elf32-half (length (program-header 0 0 '()))))
+  (define e-phnum (elf32-half 1))
+  (define e-shentsize (elf32-half (length (section-header 0 0 0 0 '() 0 0 0))))
+  (define e-shnum (elf32-half 7))       ; sections: 7
+  (define e-shstrndx (elf32-half 4))
+
+  (define (elf-header size entry sections)
+    (append
+     e-ident
+     e-type
+     e-machine
+     e-version
+     (elf32-addr (+ vaddress entry)) ;; e-entry
+     (elf32-off size)                ;; e-phoff
+     (elf32-off sections)            ;; e-shoff
+     e-flags
+     (elf32-half size) ;; e-ehsize
+     e-phentsize
+     e-phnum
+     e-shentsize
+     e-shnum
+     e-shstrndx
+     ))
+
+  (define elf-header-size
+    (length (elf-header 0 0 0)))
+
+  (define program-header-size
+    (length (program-header 0 0 '())))
+
+  (define text-offset
+    (+ elf-header-size program-header-size))
+
+  (define (program-headers text)
+    (append
+     (program-header 1 text-offset text)))
+
+  (define note
+    (string->list
+     (string-append
+      "MES"
+      ;;"Mes -- Maxwell Equations of Software\n"
+      ;;"https://gitlab.com/janneke/mes"
+      )
+     ;; #x05 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x02 #x00 #x00 #x00
+     ;; #\i #\3 #\8 #\6 #x00 #x00 #x00 #x00
+     ))
+
+  (define shstr
+    `(
+      #x00                              ; 0
+      ,@(string->list ".text") #x00     ; 1
+      ,@(string->list ".data") #x00     ; 7
+      ,@(string->list ".note") #x00     ; 13
+      ,@(string->list ".shstrtab") #x00 ; 19
+      ,@(string->list ".symtab") #x00  ; 29
+      ,@(string->list ".strtab") #x00   ; 37
+      ))
+
+  (define (str symbols)
+    (cons
+     0
+     (append-map
+      (lambda (s) (append (string->list s) (list 0)))
+      (map car symbols))))
+
+  (define text-length
+    (length (symbols->text symbols 0 0)))
+
+  (define data-offset
+    (+ text-offset text-length))
+
+  (define stt-func 2)
+  (define stt-global-func 18)
+  (define (symbol-table-entry st-name st-offset st-length st-info st-other st-shndx)
+    (append
+     (elf32-word st-name)
+     (elf32-addr st-offset)
+     (elf32-word st-length)
+     (list st-info)
+     (list st-other)
+     (elf32-half st-shndx)))
+
+  (define (sym symbols)
+    (define (symbol->table-entry o)
+      (let* ((name (car o))
+             (offset (function-offset name symbols))
+            (len (length (append-map (lambda (f) (f symbols 0 0)) (cddr o))))
+            (str (append-map (lambda (x) (cons 0 (string->list x))) (cdr (member name (reverse (map car symbols))))))
+            (i (1+ (length str))))
+        (symbol-table-entry i (+ vaddress text-offset offset) len stt-func 0 1)))
+    (append
+     (symbol-table-entry 0 0 0 0 0 0)
+     (append-map symbol->table-entry symbols)))
+
+  (define data-address (+ data-offset vaddress))
+  (define text-address (+ text-offset vaddress))
+
+  (define data-length
+    (length (symbols->data symbols)))
+
+  (define note-length
+    (length note))
+
+  (define note-offset
+    (+ data-offset data-length))
+
+  (define shstr-offset
+    (+ note-offset note-length))
+
+  (define shstr-length
+    (length shstr))
+
+  (define sym-offset
+    (+ shstr-offset shstr-length))
+
+  (define SHT-PROGBITS 1)
+  (define SHT-SYMTAB 2)
+  (define SHT-STRTAB 3)
+  (define SHT-NOTE 7)
+
+  (define SHF-WRITE 1)
+  (define SHF-ALLOC 4)
+  (define SHF-EXEC 4)
+  (define SHF-STRINGS #x20)
+
+  (let* ((text (symbols->text symbols 0 data-address))
+         (data (symbols->data symbols))
+         (entry (+ text-offset (function-offset "_start" symbols)))
+         (functions (filter function-entry? symbols))
+         (sym (sym functions))
+         (str (str functions)))
+
+    (define (section-headers)
+    (append
+     (section-header 0 0 0 0 '() 0 0 0)
+     (section-header 1 SHT-PROGBITS (logior SHF-WRITE SHF-ALLOC) text-offset text 0 0 0)
+     (section-header 7 SHT-PROGBITS (logior SHF-WRITE SHF-ALLOC) data-offset data 0 0 0)
+     (section-header 13 SHT-NOTE 0 note-offset note 0 0 0)
+     (section-header 19 SHT-STRTAB SHF-STRINGS shstr-offset shstr 0 0 0)
+     (section-header 29 SHT-SYMTAB SHF-ALLOC sym-offset sym 6 0 (length (symbol-table-entry 0 0 0 0 0 0)))
+     (section-header 37 SHT-STRTAB SHF-STRINGS str-offset str 0 0 0)))
+
+
+    (define sym-length
+      (length sym))
+    
+    (define str-offset
+      (+ sym-offset sym-length))
+    
+    (define str-length
+      (length str))
+
+    (define section-headers-offset
+      (+ str-offset str-length))
+
+    (format (current-error-port) "ELF text=~a\n" text)
+    ;;(format (current-error-port) "ELF data=~a\n" data)
+    (format (current-error-port) "text-offset=~a\n" text-offset)
+    (format (current-error-port) "data-offset=~a\n" data-offset)
+    (format (current-error-port) "_start=~a\n" (number->string entry 16))
+    (append
+     (elf-header elf-header-size entry section-headers-offset)
+     (program-headers text)
+     text
+     data
+     note
+     shstr
+     sym
+     str
+     (section-headers))))
index fe568e3c8e4ea589a3da5ec657f945f3c44175e1..d20e6a8e3053409a883d5b56d7d4fdafc8e896e3 100644 (file)
@@ -23,7 +23,9 @@
 ;;; Code:
 
 (define-module (mes elf)
+  #:use-module (srfi srfi-1)
   #:use-module (mes bytevectors)
+  #:use-module (mes elf-util)
   #:export (int->bv16
             int->bv32
             make-elf))
index 46b64a821db6ae9037301e7959a57e0c04e9808b..cb3f46a97541dcc9262cbe6604af91a235fe6d30 100644 (file)
 
 ;;; Code:
 
-(define (i386:puts data length)
-  `(
-     #xba ,@(int->bv32 length)      ;; mov    $0xe,%edx
-          #xb9 ,@(int->bv32 data)        ;; mov    $data,%ecx
-          #xbb #x01 #x00 #x00 #x00       ;; mov    $0x1,%ebx
-          #xb8 #x04 #x00 #x00 #x00       ;; mov    $0x4,%eax
-          #xcd #x80                      ;; int    $0x80
-          ))
+(define (push-arg o)
+  `(#x68 ,@(int->bv32 o)))              ; push o
+
+(define (i386:ret)
+  '(
+    #xc3                                ; ret
+    ))
 
-(define (i386:exit code)
+(define (i386:call address . arguments)
+  (let ((pushes (append-map push-arg arguments)))
+   `(
+     ,@pushes                                         ; push args
+     #xe8 ,@(int->bv32 (- address 5 (length pushes))) ; call relative
+     )))
+  
+(define (i386:eputs s t d)
   `(
-    #xbb ,@(int->bv32 code)        ;; mov    $code,%ebx
-         #xb8 #x01 #x00 #x00 #x00       ;; mov    $0x1,%eax
-         #xcd #x80                      ;; int    $0x80
-         ))
+    #x5f                                ; pop    %edi
+    #xba #x01 #x00 #x00 #x00           ; mov    0xa,%edx
+    #x59                                ; pop    %ecx
+    #x57                                ; push   %edi
+    #xbb #x02 #x00 #x00 #x00            ; mov    $0x1,%ebx
+    #xb8 #x04 #x00 #x00 #x00            ; mov    $0x4,%eax
+    #xcd #x80                           ; int    $0x80
+    #xc3                                ; ret
+    ))
 
-(define (i386:for start test step statement)
-`(
+(define (i386:exit s t d)
+  `(
+    #x5f                                ; pop    %edi
+    #xb8 #x01 #x00 #x00 #x00            ; mov    $0x1,%eax
+    #xcd #x80                           ; int    $0x80
+    ))
 
-  ;;   b:
-  #x89 #xe5                    ;; mov    %esp,%ebp
-       ;;21:
-       #xc7 #x45 #xf4 ,@(int->bv32 start) ;;   movl   $start,-0xc(%ebp)
-       ;;28:
-       #xeb ,(+ (length statement) 9) ;;x14    jmp    3e <main+0x3e>
-       ;;2a:
-       ;;#x83 #xec #x0c             ;; sub    $0xc,%esp
-       
-       ;;   9:
-       #x55   ;;                       push   %ebp
-       
-       ,@statement
-       #x5d   ;;                       pop   %ebp
-       ;;2d:
- ;;;;;;#x68 #x09 #x00 #x00 #x00       ;;       push   $0x9
-       ;;32:
- ;;;;;;#xe8 #xfc #xff #xff #xff       ;;       call   33 <main+0x33>
-       ;;37:
- ;;;;;;#x83 #xc4 #x10             ;;   add    $0x10,%esp
-       ;;3a:
-       ;;;;#x83 #x45 #xf4 ,step          ;;    addl   $step,-0xc(%ebp)
-       ;;3e:
-       ;;;;#x83 #x7d #xf4 ,test          ;;    cmpl   $test,-0xc(%ebp)
-       #x81 #x45 #xf4 ,@(int->bv32 step)       ;;addl   $step,-0xc(%ebp)
-       #x81 #x7d #xf4 ,@(int->bv32 test) ;;cmpl   $0x7cff,-0xc(%ebp)
-       ;;42:
-       ;;;#x7e ,(- 0 (length statement) 18) ;;#xe6 ;;  jle    2a <main+0x2a>
-       #x75 ,(- 0 (length statement) 18) ;;#xe6 ;;     jne    2a <main+0x2a>
-))
+(define (i386:puts s t d)
+  `(
+    #x5f                                ; pop    %edi
+    #xba #x0a #x00 #x00 #x00           ; mov    0xa,%edx
+    #x59                                ; pop    %ecx
+    #x57                                ; push   %edi
+    #xbb #x01 #x00 #x00 #x00            ; mov    $0x1,%ebx
+    #xb8 #x04 #x00 #x00 #x00            ; mov    $0x4,%eax
+    #xcd #x80                           ; int    $0x80
+    #xc3                                ; ret
+    ))
index f1f05a0d0bde070067b57dd7ee092ef536793ee1..d64b34fbc1025e827557f132321f7d86a71afb06 100644 (file)
 ;;; Code:
 
 (define-module (mes libc-i386)
+  #:use-module (srfi srfi-1)
   #:use-module (mes elf)
-  #:export (i386:exit
+  #:export (i386:call
+            i386:exit
             i386:for
-            i386:puts))
+            i386:eputs
+            i386:puts
+            i386:ret
+            ))
 
 (cond-expand
  (guile-2)