mescc: Remove ELF creation, handled by hex2 now.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 25 Jun 2017 07:26:25 +0000 (09:26 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 25 Jun 2017 07:26:25 +0000 (09:26 +0200)
* module/language/c99/compiler.scm (make-global, global:type,
  global:pointer, global:value): Move from elf-util.mes
* module/mes/as.mes: New file.
* module/mes/as-i386.mes: Use it.
* module/mes/as-i386.scm: Use it.
* module/mes/elf-util.mes: Remove.
* module/mes/elf.mes (elf32-addr, elf32-half, elf32-off, elf32-word,
  make-elf, write-any, object->elf): Remove
  (hex2->elf): New function with dummy implementation.
* module/mes/elf.scm: Update exports.
* module/mes/hex2.mes (object->elf): New function.
* module/mes/hex2.scm: Export it.

12 files changed:
module/language/c99/compiler.mes
module/language/c99/compiler.scm
module/mes/as-i386.mes
module/mes/as-i386.scm
module/mes/as.mes [new file with mode: 0644]
module/mes/as.scm [new file with mode: 0644]
module/mes/elf-util.mes [deleted file]
module/mes/elf-util.scm [deleted file]
module/mes/elf.mes
module/mes/elf.scm
module/mes/hex2.mes
module/mes/hex2.scm

index 95273785280983a8ea8b86257c35b0c95d1c7db3..42cf683edb2fbf3de251368baa0d22b5e5663bd6 100644 (file)
@@ -33,7 +33,7 @@
   (mes-use-module (mes pmatch))
   (mes-use-module (nyacc lang c99 parser))
   (mes-use-module (nyacc lang c99 pprint))
-  (mes-use-module (mes elf-util))
+  (mes-use-module (mes as))
   (mes-use-module (mes as-i386))
   (mes-use-module (mes hex2))
   (mes-use-module (mes optargs))))
           (wrap-as (i386:push-byte-local-de-de-ref (local:id o)))
           (error "TODO int-de-de-ref")))))
 
+(define (make-global name type pointer value)
+  (cons name (list type pointer value)))
+
+(define global:type car)
+(define global:pointer cadr)
+(define global:value caddr)
+
 (define (string->global string)
   (make-global `(#:string ,string) "string" 0 (append (string->list string) (list #\nul))))
 
index a62de5aeea1e926742eadfc259f517dac808abd1..95be83fd88c8fd08417673e93f8b0eb451209dad 100644 (file)
@@ -28,9 +28,9 @@
   #:use-module (system base pmatch)
   #:use-module (ice-9 optargs)
   #:use-module (ice-9 pretty-print)
-  #:use-module (mes elf-util)
-  #:use-module (mes elf)
+  #:use-module (mes as)
   #:use-module (mes as-i386)
+  #:use-module (mes elf)
   #:use-module (mes hex2)
   #:use-module (nyacc lang c99 parser)
   #:use-module (nyacc lang c99 pprint)
index c5b224f26a81d867c9c4d6bb74add0780f99aac2..c62aa17c31e2a842fb891a75be0f56688e36bd13 100644 (file)
@@ -28,7 +28,7 @@
  (guile-2)
  (guile)
  (mes
-  (mes-use-module (mes elf-util))))
+  (mes-use-module (mes as))))
 
 (define (i386:function-preamble)
   '(#x55                                ; push   %ebp
index 7784124f1b0c3c8b960bc2b1dd4df389c7a1fd53..6201a4c048f1e77a619379f6e3151ee7bcf49ebd 100644 (file)
@@ -25,7 +25,7 @@
 ;;; Code:
 
 (define-module (mes as-i386)
-  #:use-module (mes elf-util)
+  #:use-module (mes as)
   #:export (
             i386:accu-not
             i386:accu-cmp-value
diff --git a/module/mes/as.mes b/module/mes/as.mes
new file mode 100644 (file)
index 0000000..e90316f
--- /dev/null
@@ -0,0 +1,48 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016,2017 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))
+  (mes-use-module (mes bytevectors))))
+
+(define (int->bv32 value)
+  (let ((bv (make-bytevector 4)))
+    (bytevector-u32-native-set! bv 0 value)
+    bv))
+
+(define (int->bv16 value)
+  (let ((bv (make-bytevector 2)))
+    (bytevector-u16-native-set! bv 0 value)
+    bv))
+
+(define (dec->hex o)
+  (cond ((number? o) (number->string o 16))
+        ((char? o) (number->string (char->integer o) 16))
+        (else (format #f "~s" o))))
diff --git a/module/mes/as.scm b/module/mes/as.scm
new file mode 100644 (file)
index 0000000..6e11a6b
--- /dev/null
@@ -0,0 +1,38 @@
+;;; -*-scheme-*-
+
+;;; Mes --- Maxwell Equations of Software
+;;; Copyright © 2016,2017 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 as)
+  #:use-module (srfi srfi-1)
+  #:use-module (mes bytevectors)
+  #:export (dec->hex
+            int->bv16
+            int->bv32))
+
+(cond-expand
+ (guile-2)
+ (guile
+  (use-modules (ice-9 syncase)))
+ (mes))
+
+(include-from-path "mes/as.mes")
diff --git a/module/mes/elf-util.mes b/module/mes/elf-util.mes
deleted file mode 100644 (file)
index 5dd55a4..0000000
+++ /dev/null
@@ -1,187 +0,0 @@
-;;; -*-scheme-*-
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 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))
-  (mes-use-module (srfi srfi-1))))
-
-
-(define (int->bv32 value)
-  (let ((bv (make-bytevector 4)))
-    (bytevector-u32-native-set! bv 0 value)
-    bv))
-
-(define (int->bv16 value)
-  (let ((bv (make-bytevector 2)))
-    (bytevector-u16-native-set! bv 0 value)
-    bv))
-
-(define (make-global name type pointer value)
-  (cons name (list type pointer value)))
-
-(define global:type car)
-(define global:pointer cadr)
-(define global:value caddr)
-
-(define (dec->hex o)
-  (cond ((number? o) (number->string o 16))
-        ((char? o) (number->string (char->integer o) 16))
-        (else (format #f "~s" o))))
-
-(define (functions->lines functions)
-  (filter (lambda (x) (not (and (pair? x) (pair? (car x)) (member (caar x) '(#:comment #:label))))) (append-map cdr functions))
-  ;;(append-map cdr functions)
-  )
-
-(define (text->list o)
-  (append-map cdr o))
-
-(define functions->text
-  (let ((cache '()))
-    (lambda (functions globals ta t d)
-      (let ((text (or (assoc-ref cache (cons ta (map car functions)))
-                      (let ((text (apply append (functions->lines functions))))
-                    (set! cache (assoc-set! cache (cons ta (map car functions)) text))
-                    text))))
-        (if (= ta 0) text
-            (let loop ((f functions))
-              (if (null? f) '()
-                  (append ((function->text functions globals ta t d) (car f))
-                          (loop (cdr f))))))))))
-
-(define (function->text functions globals ta t d)
-  (lambda (o)
-    (let ((text (apply append (cdr o)))
-          (offset (function-offset (car o) functions)))
-      (let loop ((text text) (off offset))
-        (if (null? text) '()
-            (let ((label (car text)))
-              (if (number? label) (cons label (loop (cdr text) (1+ off)))
-                  (if (and (pair? label) (member (car label) '(#:comment #:label))) (loop (cdr text) off)
-                      (let* ((prefix (cond ((and (pair? (cdr text))
-                                                 (pair? (cddr text))
-                                                 (boolean? (caddr text))) 4)
-                                           ((and (pair? (cdr text))
-                                                 (boolean? (cadr text))) 2)
-                                           (else 1)))
-                             ;; (foo (format (current-error-port) "LABEL=~s\n" label))
-                             ;; (foo (format (current-error-port) "  prefix=~s\n" prefix))
-                             (address? (and (pair? label) (eq? (car label) #:address)))
-                             (local? (and (pair? label) (eq? (car label) #:local)))
-                             (relative? (and (pair? label) (eq? (car label) #:relative)))
-                             (label (if (or address? local? relative?) (cadr label) label))
-                             (function-address (function-offset label functions))
-                             (data-address (data-offset label globals))
-                             (label-address (label-offset (car o) `((#:label ,label)) functions))
-                             ;; (foo (format (current-error-port) "  address?=~s\n" address?))
-                             ;; (foo (format (current-error-port) "  d=~s\n" data-address))
-                             ;; (foo (format (current-error-port) "  f=~s\n" function-address))
-                             ;; (foo (format (current-error-port) "  l=~s\n" label-address))
-                             (address (or (and local?
-                                               (and=> label-address (lambda (a) (- a (- off offset) prefix))))
-                                          (and=> data-address (lambda (a) (+ a d)))
-                                          (if address?
-                                              (and=> function-address (lambda (a) (+ a ta)))
-                                              (and=> function-address (lambda (a) (- a off prefix))))
-                                          (error "unresolved label: " label))))
-                        (append ((case prefix ((1) list) ((2) int->bv16) ((4) int->bv32)) address)
-                                (loop (list-tail text prefix) (+ off prefix))))))))))))
-
-(define (function-prefix name functions)
-  ;; FIXME
-  ;;(member name (reverse functions) (lambda (a b) (equal? (car b) name)))
-  (let* ((x functions)
-         (x (if (and (pair? x) (equal? (caar x) "_start")) (reverse x) x)))
-    (member name x (lambda (a b) (equal? (car b) name)))))
-
-(define function-offset
-  (let ((cache '()))
-    (lambda (name functions)
-      (or (assoc-ref cache name)
-          (let* ((functions (if (and (pair? functions) (equal? (caar functions) "_start")) functions (reverse functions)))
-                 (prefix (and=> (function-prefix name functions) cdr))
-                 (offset (and prefix
-                              (if (null? prefix) 0
-                                  (+ (length (functions->text (list (car prefix)) '() 0 0 0))
-                                     (if (null? (cdr prefix)) 0
-                                         (function-offset (caar prefix) functions)))))))
-            (if (and offset (or (equal? name "_start") (> offset 0))) (set! cache (assoc-set! cache name offset)))
-            offset)))))
-
-(define label-offset
-  (let ((cache '()))
-    (lambda (function label functions)
-      (or (assoc-ref cache (cons function label))
-          (let ((prefix (function-prefix function functions)))
-            (if (not prefix) 0
-                (let* ((function-entry (car prefix))
-                       (offset (let loop ((text (cdr function-entry)))
-                                 ;; FIXME: unresolved label
-                                 ;;(if (null? text) (error "unresolved label:"))
-                                 (if (or (null? text) (equal? (car text) label)) 0
-                                     (let* ((t (car text))
-                                            (n (if (and (pair? (car t))
-                                                        (member (caar t) '(#:label #:comment))) 0 (length t))))
-                                       (+ (loop (cdr text)) n))))))
-                  (when (> offset 0)
-                    (set! cache (assoc-set! cache (cons function label) offset)))
-                  offset)))))))
-
-(define (globals->data functions globals t d)
-  (let loop ((text (append-map cdr globals)))
-    (if (null? text) '()
-        (let ((label (car text)))
-          (if (or (char? label) (number? label)) (cons label (loop (cdr text)))
-              (let* ((prefix (if (and (pair? (cdr text))
-                                      (pair? (cddr text))
-                                      (boolean? (caddr text))) 4
-                                      2))
-                     (function-address (function-offset label functions))
-                     (data-address (data-offset label globals))
-                     (address (or (and=> data-address (lambda (a) (+ a d)))
-                                  (and=> function-address (lambda (a) (+ a t)))
-                                  (error "unresolved label: " label))))
-                      (append ((if (= prefix 2) int->bv16 int->bv32) address)
-                              (loop (list-tail text prefix)))))))))
-
-(define (simple-globals->data globals)
-  (append-map cdr globals))
-
-(define data-offset
-  (let ((cache '()))
-    (lambda (name globals)
-      (or (assoc-ref cache name)
-          (let ((prefix (member name (reverse globals)
-                                (lambda (a b)
-                                  (equal? (car b) name)))))
-            (and prefix
-                 (let ((offset (length (simple-globals->data (cdr prefix)))))
-                   (set! cache (assoc-set! cache name offset))
-                   offset)))))))
diff --git a/module/mes/elf-util.scm b/module/mes/elf-util.scm
deleted file mode 100644 (file)
index 8ab1ad6..0000000
+++ /dev/null
@@ -1,50 +0,0 @@
-;;; -*-scheme-*-
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016,2017 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)
-  #:use-module (mes bytevectors)
-  #:export (data-offset
-            dec->hex
-            function-offset
-            int->bv16
-            int->bv32
-            label-offset
-            functions->lambdas
-            functions->text
-            lambda/label->list
-            text->list
-            globals->data
-            make-global
-            global:type
-            global:pointer
-            global:value))
-
-(cond-expand
- (guile-2)
- (guile
-  (use-modules (ice-9 syncase)))
- (mes))
-
-(include-from-path "mes/elf-util.mes")
index 779c74788582d20781452f55161584c6600b0fc3..ab4787be07ec936d8bb3f5ddceb3edfcf50dda47 100644 (file)
 
 (cond-expand
  (guile)
- (mes
-  (mes-use-module (srfi srfi-1))
-  (mes-use-module (mes elf-util))))
+ (mes))
 
-(define elf32-addr int->bv32)
-(define elf32-half int->bv16)
-(define elf32-off int->bv32)
-(define elf32-word int->bv32)
-
-(define (make-elf functions globals init)
-  (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 2)) ; text+data
-  (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
-    (* 2 (length (program-header 0 0 '()))))
-
-  (define text-offset
-    (+ elf-header-size program-header-size))
-
-  (define PT-LOAD 1)
-  (define (program-headers text data)
-    (append
-     (program-header PT-LOAD text-offset text)
-     (program-header PT-LOAD data-offset data)))
-
-  (define comment
-    (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 ".comment") #x00     ; 13
-      ,@(string->list ".shstrtab") #x00 ; 22
-      ,@(string->list ".symtab") #x00  ; 32
-      ,@(string->list ".strtab") #x00   ; 40
-      ))
-
-  (define (str functions)
-    (cons
-     0
-     (append-map
-      (lambda (s) (append (string->list s) (list 0)))
-      (map car functions))))
-
-  (define text-length
-    (length (functions->text functions globals 0 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 functions globals)
-    (define (symbol->table-entry o)
-      (let* ((name (car o))
-             (offset (function-offset name functions))
-             (len (if (not (cdr o)) 0 (length (text->list (cddr o)))))
-             (str (append-map (lambda (x) (cons 0 (string->list x))) (cdr (member name (reverse (map car functions))))))
-             (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 functions)))
-
-  (define data-address (+ data-offset vaddress))
-  (define text-address (+ text-offset vaddress))
-
-  (define data-length
-    (length (globals->data functions globals 0 0)))
-
-  (define comment-length
-    (length comment))
-
-  (define comment-offset
-    (+ data-offset data-length))
-
-  (define shstr-offset
-    (+ comment-offset comment-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 2)
-  (define SHF-EXEC 4)
-  (define SHF-STRINGS #x20)
-
-  (let* ((text (functions->text functions globals text-address 0 data-address))
-         (raw-data (globals->data functions globals text-address data-address))
-         ;; (data (let loop ((data raw-data) (init init))
-         ;;         (if (null? init) data
-         ;;             (loop ((car init) functions globals text-address 0 data-address data) (cdr init)))))
-         (data raw-data)
-         (entry (+ text-offset (function-offset "_start" functions)))
-         (sym (sym functions globals))
-         (str (str functions)))
-
-    (define (section-headers)
-    (append
-     (section-header 0 0 0 0 '() 0 0 0)
-     (section-header 1 SHT-PROGBITS (logior SHF-ALLOC SHF-EXEC) text-offset text 0 0 0)
-     (section-header 7 SHT-PROGBITS (logior SHF-ALLOC SHF-WRITE) data-offset data 0 0 0)
-     (section-header 13 SHT-PROGBITS 0 comment-offset comment 0 0 0)
-     (section-header 22 SHT-STRTAB 0 shstr-offset shstr 0 0 0)
-     (section-header 32 SHT-SYMTAB 0 sym-offset sym 6 0 (length (symbol-table-entry 0 0 0 0 9 0)))
-     (section-header 40 SHT-STRTAB 0 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))
-
-    (if (< (length text) 2000)
-        (format (current-error-port) "ELF text=~a\n" (map dec->hex text)))
-    (if (< (length raw-data) 200)
-        (format (current-error-port) "ELF raw-data=~a\n" (map dec->hex raw-data)))
-    (if (< (length data) 200)
-        (format (current-error-port) "ELF data=~a\n" (map dec->hex 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 data)
-     text
-     data
-     comment
-     shstr
-     sym
-     str
-     (section-headers))))
-
-(define (logf port string . rest)
-  (apply format (cons* port string rest))
-  (force-output port)
-  #t)
-
-(define (stderr string . rest)
-  (apply logf (cons* (current-error-port) string rest)))
-
-(define (write-any x)
-  (write-char
-   (cond ((char? x) x)
-         ((and (number? x) (< (+ x 256) 0))
-          (format (current-error-port) "***BROKEN*** x=~a ==> ~a\n" x (dec->hex x)) (integer->char #xaa))
-         ((number? x) (integer->char (if (>= x 0) x (+ x 256))))
-         ((procedure? x)
-          (stderr "write-any: proc: ~a\n" x)
-          (stderr "  ==> ~a\n" (map dec->hex (x '() '() 0 0)))
-          (error "procedure: write-any:" x))
-         (else (stderr "write-any: ~a\n" x) (error "write-any: else: " x)))))
-
-(define (object->elf object)
-  (display "dumping elf\n" (current-error-port))
-  (for-each
-   write-any
-   (make-elf (filter cdr (assoc-ref object 'functions)) (assoc-ref object 'globals) (assoc-ref object 'inits))))
+(define (hex2->elf objects)
+  (error "->ELF support dropped, use hex2"))
index bc12d969b6ae8e7347cef4f4035beb4d8f7fce66..58a60473f90a4060b42027dc22d2dc356189c683 100644 (file)
 ;;; Code:
 
 (define-module (mes elf)
-  #:use-module (srfi srfi-1)
-  #:use-module (mes elf-util)
-  #:export (make-elf
-            object->elf))
+  #:export (hex2->elf))
 
 (cond-expand
  (guile-2)
index 759e5fcbf9f285a74b11fc53075b00f514bafc2f..0eecd0f51aae5b8b59c8a24cf0e5757db17b43aa 100644 (file)
@@ -28,7 +28,7 @@
  (guile)
  (mes
   (mes-use-module (srfi srfi-1))
-  (mes-use-module (mes elf-util))
+  (mes-use-module (mes as))
   (mes-use-module (mes elf))
   (mes-use-module (mes optargs))
   (mes-use-module (mes pmatch))))
 (define (objects->hex2 objects)
   ((compose object->hex2 merge-objects) objects))
 
+(define (object->elf o)
+  ((compose hex2->elf object->hex2) o))
+
 (define (objects->elf objects)
-  (error "->ELF support dropped, use hex2"))
+  ((compose hex2->elf object->hex2 merge-objects) objects))
 
 (define (merge-objects objects)
   (let loop ((objects (cdr objects)) (object (car objects)))
index 6db4d60d29510b5173c74ab30fb681a7a3d2aa53..437b1fd0ca8e50decff1c37b2f1a0a73f86f60fc 100644 (file)
 (define-module (mes hex2)
   #:use-module (srfi srfi-1)
   #:use-module (system base pmatch)
-  #:use-module (mes elf-util)
+  #:use-module (mes as)
   #:use-module (mes elf)
   #:export (object->hex2
             objects->hex2
+            object->elf
             objects->elf))
 
 (cond-expand