mescc: Remove ELF creation, handled by hex2 now.
* 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.
This commit is contained in:
Jan Nieuwenhuizen
parent
1de0f33020
commit
c44df4ed8a
|
|
@ -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))))
|
||||
|
|
@ -262,6 +262,13 @@
|
|||
(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))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
48
module/mes/as.mes
Normal file
48
module/mes/as.mes
Normal file
|
|
@ -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))))
|
||||
|
|
@ -22,24 +22,12 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(define-module (mes elf-util)
|
||||
(define-module (mes as)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (mes bytevectors)
|
||||
#:export (data-offset
|
||||
dec->hex
|
||||
function-offset
|
||||
#:export (dec->hex
|
||||
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))
|
||||
int->bv32))
|
||||
|
||||
(cond-expand
|
||||
(guile-2)
|
||||
|
|
@ -47,4 +35,4 @@
|
|||
(use-modules (ice-9 syncase)))
|
||||
(mes))
|
||||
|
||||
(include-from-path "mes/elf-util.mes")
|
||||
(include-from-path "mes/as.mes")
|
||||
|
|
@ -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)))))))
|
||||
|
|
@ -26,284 +26,7 @@
|
|||
|
||||
(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"))
|
||||
|
|
|
|||
|
|
@ -23,10 +23,7 @@
|
|||
;;; 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)
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
@ -44,8 +44,11 @@
|
|||
(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)))
|
||||
|
|
|
|||
|
|
@ -25,10 +25,11 @@
|
|||
(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
|
||||
|
|
|
|||
Loading…
Reference in a new issue