andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

mescc: Rename symbols to globals. 

* module/language/c99/compiler.mes:
This commit is contained in:
Jan Nieuwenhuizen 2017-01-03 18:34:49 +01:00
parent 38dc229a01
commit f106dbfdae
4 changed files with 112 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

160
module/language/c99/compiler.mes
View File

@ -85,16 +85,16 @@
;; (stderr "IDENT REF[~a]: ~a => ~a\n" o (assoc-ref locals o) (i386:ref-local (assoc-ref locals o))) ;; (stderr "IDENT REF[~a]: ~a => ~a\n" o (assoc-ref locals o) (i386:ref-local (assoc-ref locals o)))
(i386:ref-local (assoc-ref locals o)))) (i386:ref-local (assoc-ref locals o))))
(define (global-ref symbols) (define (global-ref globals)
(lambda (o) (lambda (o)
(lambda (s t d) (lambda (s t d)
(i386:ref-global (+ (data-offset o symbols) d))))) (i386:ref-global (+ (data-offset o globals) d)))))
(define (expr->arg symbols locals) ;; FIXME: get Mes curried-definitions (define (expr->arg globals locals) ;; FIXME: get Mes curried-definitions
(lambda (o) (lambda (o)
(pmatch o (pmatch o
((p-expr (fixed ,value)) (string->number value)) ((p-expr (fixed ,value)) (string->number value))
((p-expr (string ,string)) ((global-ref symbols) string)) ((p-expr (string ,string)) ((global-ref globals) string))
((p-expr (ident ,name)) ((ident-ref locals) name)) ((p-expr (ident ,name)) ((ident-ref locals) name))
((array-ref (p-expr (fixed ,value)) (p-expr (ident ,name))) ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,name)))
@ -124,12 +124,12 @@
(lambda (o) (lambda (o)
(i386:local->base (assoc-ref locals o)))) (i386:local->base (assoc-ref locals o))))
;; (define (global-accu symbols) ;; (define (global-accu globals)
;; (lambda (o) ;; (lambda (o)
;; (lambda (s t d) ;; (lambda (s t d)
;; (i386:accu-global (+ (data-offset o symbols) d))))) ;; (i386:accu-global (+ (data-offset o globals) d)))))
(define (expr->accu symbols locals) (define (expr->accu globals locals)
(lambda (o) (lambda (o)
(pmatch o (pmatch o
((p-expr (fixed ,value)) (string->number value)) ((p-expr (fixed ,value)) (string->number value))
@ -139,14 +139,14 @@
0) 0)
))) )))
(define (expr->symbols o) (define (expr->globals o)
(pmatch o (pmatch o
((p-expr (string ,string)) (string->symbols string)) ((p-expr (string ,string)) (string->globals string))
(_ #f))) (_ #f)))
(define make-text+symbols+locals cons*) (define make-text+globals+locals cons*)
(define .text car) (define .text car)
(define .symbols cadr) (define .globals cadr)
(define .locals cddr) (define .locals cddr)
(define (dec->hex o) (define (dec->hex o)
@ -164,13 +164,13 @@
(let ((s (string-drop o (string-length prefix)))) (let ((s (string-drop o (string-length prefix))))
(map byte->hex (string-split s #\space)))))) (map byte->hex (string-split s #\space))))))
(define (statement->text+symbols+locals text+symbols+locals) (define (statement->text+globals+locals text+globals+locals)
(lambda (o) (lambda (o)
;;(stderr "S=~a\n" o) ;;(stderr "S=~a\n" o)
(let* ((text (.text text+symbols+locals)) (let* ((text (.text text+globals+locals))
(symbols (.symbols text+symbols+locals)) (globals (.globals text+globals+locals))
(locals (.locals text+symbols+locals))) (locals (.locals text+globals+locals)))
;; (stderr " tsl=~a\n" text+symbols+locals) ;; (stderr " tsl=~a\n" text+globals+locals)
;; (stderr " locals=~s\n" locals) ;; (stderr " locals=~s\n" locals)
(pmatch o (pmatch o
@ -178,90 +178,90 @@
(expr-list (p-expr (string ,string))))) (expr-list (p-expr (string ,string)))))
;;(stderr "S1 string=~a\n" string) ;;(stderr "S1 string=~a\n" string)
(if (equal? name "asm") (if (equal? name "asm")
(make-text+symbols+locals (make-text+globals+locals
(append (append
text text
(list (lambda (s t d) (asm->hex string)))) (list (lambda (s t d) (asm->hex string))))
symbols globals
locals) locals)
(make-text+symbols+locals (make-text+globals+locals
(append text (append text
(list (lambda (s t d) (list (lambda (s t d)
(i386:call s t d (i386:call s t d
(+ t (function-offset name s)) (+ t (function-offset name s))
(+ d (data-offset string s)))))) (+ d (data-offset string s))))))
(append symbols (list (string->symbols string))) (append globals (list (string->globals string)))
locals))) locals)))
((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))) ((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
;;(stderr "S1 expr-list=~a\n" expr-list) ;;(stderr "S1 expr-list=~a\n" expr-list)
(let* ((symbols (append symbols (filter-map expr->symbols expr-list))) (let* ((globals (append globals (filter-map expr->globals expr-list)))
(args (map (expr->arg symbols locals) expr-list))) (args (map (expr->arg globals locals) expr-list)))
(make-text+symbols+locals (make-text+globals+locals
(append text (append text
(list (lambda (s t d) (apply i386:call (cons* s t d (+ t (function-offset name s)) args))))) (list (lambda (s t d) (apply i386:call (cons* s t d (+ t (function-offset name s)) args)))))
symbols globals
locals))) locals)))
((compd-stmt (block-item-list . ,statements)) ((compd-stmt (block-item-list . ,statements))
(let loop ((statements statements) (let loop ((statements statements)
(text+symbols+locals (make-text+symbols+locals text symbols locals))) (text+globals+locals (make-text+globals+locals text globals locals)))
(if (null? statements) text+symbols+locals (if (null? statements) text+globals+locals
(let* ((statement (car statements)) (let* ((statement (car statements))
(r ((statement->text+symbols+locals text+symbols+locals) statement))) (r ((statement->text+globals+locals text+globals+locals) statement)))
(loop (cdr statements) r))))) (loop (cdr statements) r)))))
((if (gt (p-expr (ident ,name)) (p-expr (fixed ,value))) ,body) ((if (gt (p-expr (ident ,name)) (p-expr (fixed ,value))) ,body)
(let* ((value (string->number value)) (let* ((value (string->number value))
(t+s+l (make-text+symbols+locals '() symbols locals)) (t+s+l (make-text+globals+locals '() globals locals))
(body-t+s+l ((statement->text+symbols+locals t+s+l) body)) (body-t+s+l ((statement->text+globals+locals t+s+l) body))
(body-text (.text body-t+s+l)) (body-text (.text body-t+s+l))
;;(body-symbols (.symbols body-t+s+l)) ;;(body-globals (.globals body-t+s+l))
(symbols (.symbols body-t+s+l)) (globals (.globals body-t+s+l))
(body-locals (.locals body-t+s+l)) (body-locals (.locals body-t+s+l))
(body-length (length (text->list body-text)))) (body-length (length (text->list body-text))))
(make-text+symbols+locals (make-text+globals+locals
(append text (append text
(list (lambda (s t d) (list (lambda (s t d)
(append (append
(i386:local-test (assoc-ref locals name) value) (i386:local-test (assoc-ref locals name) value)
(i386:jump-le body-length)))) (i386:jump-le body-length))))
body-text) body-text)
symbols globals
locals))) locals)))
((while ,test ,body) ((while ,test ,body)
(let* ((t+s+l (make-text+symbols+locals '() symbols locals)) (let* ((t+s+l (make-text+globals+locals '() globals locals))
(body-t+s+l ((statement->text+symbols+locals t+s+l) body)) (body-t+s+l ((statement->text+globals+locals t+s+l) body))
(body-text (.text body-t+s+l)) (body-text (.text body-t+s+l))
;;(body-symbols (.symbols body-t+s+l)) ;;(body-globals (.globals body-t+s+l))
(symbols (.symbols body-t+s+l)) (globals (.globals body-t+s+l))
(body-locals (.locals body-t+s+l)) (body-locals (.locals body-t+s+l))
(body-length (length (text->list body-text))) (body-length (length (text->list body-text)))
(test-t+s+l ((statement->text+symbols+locals t+s+l) test)) (test-t+s+l ((statement->text+globals+locals t+s+l) test))
(test-text (.text test-t+s+l)) (test-text (.text test-t+s+l))
(test-symbols (.symbols test-t+s+l)) (test-globals (.globals test-t+s+l))
(test-locals (.locals test-t+s+l)) (test-locals (.locals test-t+s+l))
(test-length (length (text->list test-text)))) (test-length (length (text->list test-text))))
(make-text+symbols+locals (make-text+globals+locals
(append text (append text
(list (lambda (s t d) (i386:jump body-length))) (list (lambda (s t d) (i386:jump body-length)))
body-text body-text
test-text test-text
(list (lambda (s t d) (i386:jump-nz (- (+ body-length test-length)))))) (list (lambda (s t d) (i386:jump-nz (- (+ body-length test-length))))))
symbols globals
locals))) locals)))
((array-ref (p-expr (fixed ,value)) (p-expr (ident ,name))) ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,name)))
(let ((value (string->number value))) (let ((value (string->number value)))
(make-text+symbols+locals (make-text+globals+locals
(append (append
text text
(list (list
@ -270,11 +270,11 @@
((ident->base locals) name) ((ident->base locals) name)
(i386:value->accu value) (i386:value->accu value)
(i386:mem-byte->accu))))) ; FIXME: type: char (i386:mem-byte->accu))))) ; FIXME: type: char
symbols globals
locals))) locals)))
((array-ref (p-expr (ident ,name)) (p-expr (ident ,index))) ((array-ref (p-expr (ident ,name)) (p-expr (ident ,index)))
(make-text+symbols+locals (make-text+globals+locals
(append (append
text text
(list (list
@ -283,106 +283,106 @@
((ident->base locals) name) ((ident->base locals) name)
((ident->accu locals) index) ((ident->accu locals) index)
(i386:mem-byte->accu))))) ; FIXME: type: char (i386:mem-byte->accu))))) ; FIXME: type: char
symbols globals
locals)) locals))
((expr-stmt (post-inc (p-expr (ident ,name)))) ((expr-stmt (post-inc (p-expr (ident ,name))))
(make-text+symbols+locals (make-text+globals+locals
(append text (append text
(list (lambda (s t d) (i386:local-add (assoc-ref locals name) 1)))) (list (lambda (s t d) (i386:local-add (assoc-ref locals name) 1))))
symbols globals
locals)) locals))
((return ,expr) ((return ,expr)
(make-text+symbols+locals (make-text+globals+locals
(append text (list (i386:ret ((expr->accu symbols locals) expr)))) (append text (list (i386:ret ((expr->accu globals locals) expr))))
symbols globals
locals)) locals))
;; int i; ;; int i;
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name)))) ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals))) (let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)))
(make-text+symbols+locals text symbols locals))) (make-text+globals+locals text globals locals)))
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (fixed ,value)))))) ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (fixed ,value))))))
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)) (let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals))
(value (string->number value))) (value (string->number value)))
(make-text+symbols+locals (make-text+globals+locals
(append (append
text text
(list (lambda (s t d) (i386:local-assign (assoc-ref locals name) value)))) (list (lambda (s t d) (i386:local-assign (assoc-ref locals name) value))))
symbols globals
locals))) locals)))
;; int i = argc; ;; int i = argc;
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local)))))) ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals))) (let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)))
(make-text+symbols+locals (make-text+globals+locals
(append (append
text text
(list (lambda (s t d) (list (lambda (s t d)
(append (append
((ident->accu locals) local) ((ident->accu locals) local)
((accu->ident locals) name))))) ((accu->ident locals) name)))))
symbols globals
locals))) locals)))
;; SCM i = argc; ;; SCM i = argc;
((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local)))))) ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals))) (let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)))
(make-text+symbols+locals (make-text+globals+locals
(append (append
text text
(list (lambda (s t d) (list (lambda (s t d)
(append (append
((ident->accu locals) local) ((ident->accu locals) local)
((accu->ident locals) name))))) ((accu->ident locals) name)))))
symbols globals
locals))) locals)))
;; int i = f (); ;; int i = f ();
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (fctn-call . ,call))))) ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (fctn-call . ,call)))))
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals))) (let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)))
(let* ((t+s+l (make-text+symbols+locals text symbols locals)) (let* ((t+s+l (make-text+globals+locals text globals locals))
(t+s+l ((statement->text+symbols+locals t+s+l) (t+s+l ((statement->text+globals+locals t+s+l)
`(expr-stmt (fctn-call ,@call)))) `(expr-stmt (fctn-call ,@call))))
(text (.text t+s+l)) (text (.text t+s+l))
(symbols (.symbols t+s+l)) (globals (.globals t+s+l))
(locals (.locals t+s+l))) (locals (.locals t+s+l)))
(make-text+symbols+locals (make-text+globals+locals
(append (append
text text
(list (lambda (s t d) (i386:ret-local (assoc-ref locals name))))) (list (lambda (s t d) (i386:ret-local (assoc-ref locals name)))))
symbols globals
locals)))) locals))))
;; i = 0; ;; i = 0;
((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (p-expr (fixed ,value)))) ((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (p-expr (fixed ,value))))
;;(stderr "RET LOCAL[~a]: ~a\n" name (assoc-ref locals name)) ;;(stderr "RET LOCAL[~a]: ~a\n" name (assoc-ref locals name))
(let ((value (string->number value))) (let ((value (string->number value)))
(make-text+symbols+locals (make-text+globals+locals
(append text (list (lambda (s t d) (i386:local-assign (assoc-ref locals name) value)))) (append text (list (lambda (s t d) (i386:local-assign (assoc-ref locals name) value))))
symbols globals
locals))) locals)))
((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (fctn-call . ,call))) ((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (fctn-call . ,call)))
(let* ((t+s+l ((statement->text+symbols+locals text+symbols+locals) (let* ((t+s+l ((statement->text+globals+locals text+globals+locals)
`(expr-stmt (fctn-call ,@call)))) `(expr-stmt (fctn-call ,@call))))
(text (.text t+s+l)) (text (.text t+s+l))
(symbols (.symbols t+s+l)) (globals (.globals t+s+l))
(locals (.locals t+s+l))) (locals (.locals t+s+l)))
(make-text+symbols+locals (make-text+globals+locals
(append text (list (lambda (s t d) (i386:ret-local (assoc-ref locals name))))) (append text (list (lambda (s t d) (i386:ret-local (assoc-ref locals name)))))
symbols globals
locals))) locals)))
(_ (_
(format (current-error-port) "SKIP statement=~a\n" o) (format (current-error-port) "SKIP statement=~a\n" o)
text+symbols+locals))))) text+globals+locals)))))
(define (symbols->exe symbols) (define (globals->exe globals)
(display "dumping elf\n" (current-error-port)) (display "dumping elf\n" (current-error-port))
(map write-any (make-elf symbols))) (map write-any (make-elf globals)))
(define (.formals o) (define (.formals o)
(pmatch o (pmatch o
@ -415,13 +415,13 @@
(let ((n (length formals))) (let ((n (length formals)))
;;(stderr "FORMALS: ~a ==> ~a\n" formals n) ;;(stderr "FORMALS: ~a ==> ~a\n" formals n)
(map cons (map .name formals) (iota n -2 -1)))) (map cons (map .name formals) (iota n -2 -1))))
(_ (format (current-error-port) "formals->symbols: no match: ~a\n" o) (_ (format (current-error-port) "formals->globals: no match: ~a\n" o)
barf))) barf)))
(define (string->symbols string) (define (string->globals string)
(make-data string (append (string->list string) (list #\nul)))) (make-data string (append (string->list string) (list #\nul))))
(define (function->symbols symbols) (define (function->globals globals)
(lambda (o) (lambda (o)
;;(stderr "\n") ;;(stderr "\n")
(format (current-error-port) "compiling ~a\n" (.name o)) (format (current-error-port) "compiling ~a\n" (.name o))
@ -430,11 +430,11 @@
(locals (formals->locals (.formals o)))) (locals (formals->locals (.formals o))))
;;(stderr "locals=~a\n" locals) ;;(stderr "locals=~a\n" locals)
(let loop ((statements (.statements o)) (let loop ((statements (.statements o))
(text+symbols+locals (make-text+symbols+locals text symbols locals))) (text+globals+locals (make-text+globals+locals text globals locals)))
(if (null? statements) (append (.symbols text+symbols+locals) (list (make-function (.name o) (.text text+symbols+locals)))) (if (null? statements) (append (.globals text+globals+locals) (list (make-function (.name o) (.text text+globals+locals))))
(let* ((statement (car statements))) (let* ((statement (car statements)))
(loop (cdr statements) (loop (cdr statements)
((statement->text+symbols+locals text+symbols+locals) (car statements))))))))) ((statement->text+globals+locals text+globals+locals) (car statements)))))))))
(define _start (define _start
(let* ((argc-argv (let* ((argc-argv
@ -539,6 +539,6 @@ puts (char const* s)
(let* ((ast (mescc)) (let* ((ast (mescc))
(functions (filter ast:function? (cdr ast))) (functions (filter ast:function? (cdr ast)))
(functions (append libc functions _start))) (functions (append libc functions _start)))
(let loop ((functions functions) (symbols i386:libc)) (let loop ((functions functions) (globals i386:libc))
(if (null? functions) (symbols->exe symbols) (if (null? functions) (globals->exe globals)
(loop (cdr functions) ((function->symbols symbols) (car functions))))))) (loop (cdr functions) ((function->globals globals) (car functions)))))))

28
module/mes/elf-util.mes
View File

@ -1,7 +1,7 @@
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of Mes. ;;; This file is part of Mes.
;;; ;;;
@ -49,30 +49,30 @@
(define (data-entry? x) (define (data-entry? x)
(data-symbol? (cdr x))) (data-symbol? (cdr x)))
(define (symbols->functions symbols) (define (globals->functions globals)
(append-map cdr (filter function-symbol? (map cdr symbols)))) (append-map cdr (filter function-symbol? (map cdr globals))))
(define (symbols->text symbols t d) (define (globals->text globals t d)
(let loop ((functions (symbols->functions symbols)) (text '())) (let loop ((functions (globals->functions globals)) (text '()))
(if (null? functions) text (if (null? functions) text
(loop (cdr functions) (loop (cdr functions)
(append text ((car functions) symbols (- (length text)) d)))))) (append text ((car functions) globals (- (length text)) d))))))
(define (function-offset name symbols) (define (function-offset name globals)
(let* ((functions (filter function-entry? symbols)) (let* ((functions (filter function-entry? globals))
(prefix (member name (reverse functions) (prefix (member name (reverse functions)
(lambda (a b) (lambda (a b)
(equal? (car b) name))))) (equal? (car b) name)))))
(if prefix (length (symbols->text (cdr prefix) 0 0)) (if prefix (length (globals->text (cdr prefix) 0 0))
0))) 0)))
(define (data-offset name symbols) (define (data-offset name globals)
(let* ((globals (filter data-entry? symbols)) (let* ((globals (filter data-entry? globals))
(prefix (member name (reverse globals) (prefix (member name (reverse globals)
(lambda (a b) (lambda (a b)
(equal? (car b) name))))) (equal? (car b) name)))))
(if prefix (length (symbols->data (cdr prefix))) (if prefix (length (globals->data (cdr prefix)))
0))) 0)))
(define (symbols->data symbols) (define (globals->data globals)
(append-map cdr (filter data-symbol? (map cdr symbols)))) (append-map cdr (filter data-symbol? (map cdr globals))))

8
module/mes/elf-util.scm
View File

@ -1,7 +1,7 @@
;;; -*-scheme-*- ;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software ;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
;;; ;;;
;;; This file is part of Mes. ;;; This file is part of Mes.
;;; ;;;
@ -32,9 +32,9 @@
function-symbol? function-symbol?
data-offset data-offset
function-offset function-offset
symbols->functions globals->functions
symbols->data globals->data
symbols->text)) globals->text))
(cond-expand (cond-expand
(guile-2) (guile-2)

28
module/mes/elf.mes
View File

@ -46,7 +46,7 @@
(define elf32-off int->bv32) (define elf32-off int->bv32)
(define elf32-word int->bv32) (define elf32-word int->bv32)
(define (make-elf symbols) (define (make-elf globals)
(define vaddress #x08048000) (define vaddress #x08048000)
(define ei-magic `(#x7f ,@(string->list "ELF"))) (define ei-magic `(#x7f ,@(string->list "ELF")))
@ -171,15 +171,15 @@
,@(string->list ".strtab") #x00 ; 37 ,@(string->list ".strtab") #x00 ; 37
)) ))
(define (str symbols) (define (str globals)
(cons (cons
0 0
(append-map (append-map
(lambda (s) (append (string->list s) (list 0))) (lambda (s) (append (string->list s) (list 0)))
(map car symbols)))) (map car globals))))
(define text-length (define text-length
(length (symbols->text symbols 0 0))) (length (globals->text globals 0 0)))
(define data-offset (define data-offset
(+ text-offset text-length)) (+ text-offset text-length))
@ -195,23 +195,23 @@
(list st-other) (list st-other)
(elf32-half st-shndx))) (elf32-half st-shndx)))
(define (sym symbols) (define (sym globals)
(define (symbol->table-entry o) (define (symbol->table-entry o)
(let* ((name (car o)) (let* ((name (car o))
(offset (function-offset name symbols)) (offset (function-offset name globals))
(len (length (append-map (lambda (f) (f symbols 0 0)) (cddr o)))) (len (length (append-map (lambda (f) (f globals 0 0)) (cddr o))))
(str (append-map (lambda (x) (cons 0 (string->list x))) (cdr (member name (reverse (map car symbols)))))) (str (append-map (lambda (x) (cons 0 (string->list x))) (cdr (member name (reverse (map car globals))))))
(i (1+ (length str)))) (i (1+ (length str))))
(symbol-table-entry i (+ vaddress text-offset offset) len stt-func 0 1))) (symbol-table-entry i (+ vaddress text-offset offset) len stt-func 0 1)))
(append (append
(symbol-table-entry 0 0 0 0 0 0) (symbol-table-entry 0 0 0 0 0 0)
(append-map symbol->table-entry symbols))) (append-map symbol->table-entry globals)))
(define data-address (+ data-offset vaddress)) (define data-address (+ data-offset vaddress))
(define text-address (+ text-offset vaddress)) (define text-address (+ text-offset vaddress))
(define data-length (define data-length
(length (symbols->data symbols))) (length (globals->data globals)))
(define note-length (define note-length
(length note)) (length note))
@ -238,10 +238,10 @@
(define SHF-EXEC 4) (define SHF-EXEC 4)
(define SHF-STRINGS #x20) (define SHF-STRINGS #x20)
(let* ((text (symbols->text symbols 0 data-address)) (let* ((text (globals->text globals 0 data-address))
(data (symbols->data symbols)) (data (globals->data globals))
(entry (+ text-offset (function-offset "_start" symbols))) (entry (+ text-offset (function-offset "_start" globals)))
(functions (filter function-entry? symbols)) (functions (filter function-entry? globals))
(sym (sym functions)) (sym (sym functions))
(str (str functions))) (str (str functions)))