diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index e80efc50..7a55c03d 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -204,7 +204,7 @@ (i386:push-local-de-ref (local:id o))))) (define (string->global string) - (make-global string "string" 0 (append (string->list string) (list #\nul)))) + (make-global (add-s:-prefix string) "string" 0 (append (string->list string) (list #\nul)))) (define (ident->global name type pointer value) (make-global name type pointer (int->bv32 value))) @@ -256,7 +256,7 @@ (i386:push-accu)))))))) ((p-expr (string ,string)) - (clone info #:text (append text (list ((push-global-address info) string))))) + (clone info #:text (append text (list ((push-global-address info) (add-s:-prefix string)))))) ((p-expr (ident ,name)) (clone info #:text (append text (list ((push-ident info) name))))) @@ -344,7 +344,7 @@ ;; (stderr "globals: ~a\n" (map car (.globals info)))) (if local (let ((ptr (local:pointer local))) - (stderr "ident->accu PTR[~a]: ~a\n" o ptr) + ;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr) (cond ((equal? o "c1") (list (lambda (f g ta t d) (i386:byte-local->accu (local:id local))))) ;; FIXME type @@ -359,7 +359,7 @@ (i386:local->accu (local:id local))))))))) (if global (let ((ptr (ident->pointer info o))) - (stderr "ident->accu PTR[~a]: ~a\n" o ptr) + ;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr) (case ptr ((-1) (list (lambda (f g ta t d) (i386:global->accu (+ (data-offset o g) d))))) @@ -425,14 +425,14 @@ (define (ident->base info) (lambda (o) (let ((local (assoc-ref (.locals info) o))) - (stderr "ident->base: local[~a]: ~a\n" o (and local (local:id local))) + ;;(stderr "ident->base: local[~a]: ~a\n" o (and local (local:id local))) (if local (list (lambda (f g ta t d) (i386:local->base (local:id local)))) (let ((global (assoc-ref (.globals info) o) )) (if global (let ((ptr (ident->pointer info o))) - (stderr "ident->accu PTR[~a]: ~a\n" o ptr) + ;;(stderr "ident->accu PTR[~a]: ~a\n" o ptr) (case ptr ((-1) (list (lambda (f g ta t d) (i386:global->base (+ (data-offset o g) d))))) @@ -448,9 +448,15 @@ (define (expr->accu info) (lambda (o) (let ((text (.text info)) - (locals (.locals info))) + (locals (.locals info)) + (globals (.globals info))) ;;(stderr "expr->accu o=~a\n" o) (pmatch o + ((p-expr (string ,string)) + (clone info #:text (append text (list (lambda (f g ta t d) + ;;(stderr "OFF[~a]: ~a\n" string (data-offset string globals)) + ;;(stderr "globals: ~s\n" (map car globals)) + (i386:global->accu (+ (data-offset (add-s:-prefix string) globals) d))))))) ((p-expr (fixed ,value)) (clone info #:text (append text (value->accu (cstring->number value))))) ((p-expr (ident ,name)) @@ -566,7 +572,6 @@ '())) (offset (* field-size (1- (length rest)))) (text (.text info))) - ;;(stderr "COUNT=~a\n" count) (clone info #:text (append text (.text index) @@ -601,7 +606,6 @@ ((ident->accu info) name)))) ((de-ref (p-expr (ident ,name))) - (stderr "de-ref: ~a\n" name) (clone info #:text (append text ((ident->accu info) name) @@ -808,6 +812,11 @@ ((p-expr (string ,string)) (string->global string)) (_ #f))) +(define (initzer->global o) + (pmatch o + ((initzer ,initzer) (expr->global initzer)) + (_ #f))) + (define (byte->hex o) (string->number (string-drop o 2) 16)) @@ -972,7 +981,9 @@ (cons type name)) ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list (param-decl (decl-spec-list (type-spec (void))))))))) (cons type name)) ;; FIXME function / int - (_ (stderr "struct-field: no match: ~a" o) barf))) + ((comp-decl (decl-spec-list (type-spec (fixed-type ,type))) (comp-declr-list (comp-declr (ptr-declr (pointer) (ident ,name))))) + (cons type name)) ;; FIXME: ptr/char + (_ (stderr "struct-field: no match: ~s\n" o) barf))) (define (ast->type o) (pmatch o @@ -993,7 +1004,7 @@ (cadr (assoc-ref (.types info) o))) (define (ident->decl info o) - ;; (stderr "ident->decl o=~s\n" o) + (stderr "ident->decl o=~s\n" o) ;; (stderr " types=~s\n" (.types info)) ;; (stderr " local=~s\n" (assoc-ref (.locals info) o)) ;; (stderr " global=~s\n" (assoc-ref (.globals info) o)) @@ -1536,16 +1547,16 @@ ;; char *p = "t.c"; ;;(decl (decl-spec-list (type-spec (fixed-type "char"))) (init-declr-list (init-declr (ptr-declr (pointer) (ident "p")) (initzer (p-expr (string "t.c\n")))))) - ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (string ,value)))))) + ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (string ,string)))))) (if (not (.function info)) decl-barf3) (let* ((locals (add-local locals name type 1)) - (globals (append globals (list (string->global value)))) + (globals (append globals (list (string->global string)))) (info (clone info #:locals locals #:globals globals))) (clone info #:text (append text (list (lambda (f g ta t d) (append - (i386:global->accu (+ (data-offset value g) d))))) + (i386:global->accu (+ (data-offset (add-s:-prefix string) g) d))))) ((accu->ident info) name))))) ;; char arena[20000]; @@ -1731,7 +1742,7 @@ ;; struct ((decl (decl-spec-list (type-spec (struct-def (ident ,name) (field-list . ,fields))))) (let* ((type (struct->type (list "struct" name) (map struct-field fields)))) - (stderr "type: ~a\n" type) + ;;(stderr "type: ~a\n" type) (clone info #:types (append (.types info) (list type))))) ;; *p++ = b; @@ -1821,8 +1832,8 @@ (count (length fields)) (field-size 4) ;; FIXME:4, not fixed (ptr (ident->pointer info array))) - (clone info #:text - (append text + (clone info #:text + (append text (.text base) (list (lambda (f g ta t d) (i386:push-base))) @@ -1841,6 +1852,9 @@ (cond ((equal? array "g_functions") ;; FIXME (list (lambda (f g ta t d) (append + (i386:base-address->accu-address) + (i386:accu+n 4) + (i386:base+n 4) (i386:base-address->accu-address) (i386:accu+n 4) (i386:base+n 4) @@ -1888,6 +1902,9 @@ (cond ((equal? array "g_functions") ;; FIXME (list (lambda (f g ta t d) (append + (i386:base-address->accu-address) + (i386:accu+n 4) + (i386:base+n 4) (i386:base-address->accu-address) (i386:accu+n 4) (i386:base+n 4) @@ -1934,6 +1951,9 @@ (cond ((equal? array "g_functions") ;; FIXME (list (lambda (f g ta t d) (append + (i386:base-address->accu-address) + (i386:accu+n 4) + (i386:base+n 4) (i386:base-address->accu-address) (i386:accu+n 4) (i386:base+n 4) @@ -1953,14 +1973,14 @@ (field-size 4)) ;; FIXME:4, not fixed ;;(stderr "7TYPE: ~s\n" type) (if (.function info) - (let* ((locals (let loop ((fields (cdr fields)) (locals locals)) + (let* ((globals (append globals (filter-map initzer->global initzers))) + (locals (let loop ((fields (cdr fields)) (locals locals)) (if (null? fields) locals (loop (cdr fields) (add-local locals "foobar" "int" 0))))) (locals (add-local locals name type -1)) - (info (clone info #:locals locals)) + (info (clone info #:locals locals #:globals globals)) (empty (clone info #:text '()))) (let loop ((fields (iota (length fields))) (initzers initzers) (info info)) - ;; (stderr "LOEP local initzers=~s\n" initzers) (if (null? fields) info (let ((offset (* field-size (car fields))) (initzer (car initzers))) @@ -1975,13 +1995,13 @@ (.text ((expr->accu empty) initzer)) (list (lambda (f g ta t d) (i386:accu->base-address+n offset)))))))))) - (let* ((global (make-global name type -1 (string->list (make-string size #\nul)))) + (let* ((globals (append globals (filter-map initzer->global initzers))) + (global (make-global name type -1 (string->list (make-string size #\nul)))) (globals (append globals (list global))) (here (data-offset name globals)) (info (clone info #:globals globals)) (field-size 4)) (let loop ((fields (iota (length fields))) (initzers initzers) (info info)) - ;; (stderr "LOEP local initzers=~s\n" initzers) (if (null? fields) info (let ((offset (* field-size (car fields))) (initzer (car initzers))) @@ -2013,6 +2033,8 @@ ((initzer (p-expr (ident ,name))) (let ((value (assoc-ref (.constants info) name))) (int->bv32 value))) + ((initzer (p-expr (string ,string))) + (int->bv32 (+ (data-offset (add-s:-prefix string) globals) d))) (_ (stderr "initzer->data:SKIP: ~s\n" o) barf (int->bv32 0)))) @@ -2064,10 +2086,10 @@ (format (current-error-port) "compiling ~a\n" name) ;;(stderr "locals=~a\n" locals) (let loop ((statements (.statements o)) - (info (clone info #:locals locals #:function name #:text text))) + (info (clone info #:locals locals #:function (.name o) #:text text))) (if (null? statements) (clone info #:function #f - #:functions (append (.functions info) (list (cons (.name o) (.text info))))) + #:functions (append (.functions info) (list (cons name (.text info))))) (let* ((statement (car statements))) (loop (cdr statements) ((ast->info info) (car statements))))))))) diff --git a/module/mes/elf-util.mes b/module/mes/elf-util.mes index 5334de1d..002d4c84 100644 --- a/module/mes/elf-util.mes +++ b/module/mes/elf-util.mes @@ -38,6 +38,9 @@ (define global:pointer cadr) (define global:value caddr) +(define (drop-s:-prefix o) (substring o 2)) +(define (add-s:-prefix o) (string-append "s:" o)) + (define (dec->hex o) (cond ((number? o) (number->string o 16)) ((char? o) (number->string (char->integer o) 16)))) diff --git a/module/mes/elf-util.scm b/module/mes/elf-util.scm index 15394e2a..9ed6178b 100644 --- a/module/mes/elf-util.scm +++ b/module/mes/elf-util.scm @@ -26,6 +26,8 @@ #:use-module (srfi srfi-1) #:export (data-offset dec->hex + add-s:-prefix + drop-s:-prefix function-offset label-offset functions->lambdas diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c index 794cd992..047cba43 100644 --- a/scaffold/mini-mes.c +++ b/scaffold/mini-mes.c @@ -386,8 +386,8 @@ SCM make_cell (SCM type, SCM car, SCM cdr); #endif struct function fun_make_cell = {&make_cell, 3}; -#if __GNUC__ -struct scm scm_make_cell = {TFUNCTION, "make-cell", 0}; +#if 1 +struct scm scm_make_cell = {TFUNCTION,"make-cell",0}; #else struct scm scm_make_cell = {TFUNCTION,0,0}; #endif @@ -399,9 +399,9 @@ SCM cons (SCM x, SCM y); #endif struct function fun_cons = {&cons, 2}; #if __GNUC__ -struct scm scm_cons = {TFUNCTION,"cons", 0}; +struct scm scm_cons = {TFUNCTION,"cons",0}; #else -struct scm scm_make_cell = {TFUNCTION,0,0}; +struct scm scm_cons = {TFUNCTION,0,0}; #endif SCM cell_cons; @@ -411,9 +411,9 @@ SCM car (SCM x); #endif struct function fun_car = {&car, 1}; #if __GNUC__ -struct scm scm_car = {TFUNCTION,"car", 0}; +struct scm scm_car = {TFUNCTION,"car",0}; #else -struct scm scm_make_cell = {TFUNCTION,0,0}; +struct scm scm_car = {TFUNCTION,0,0}; #endif SCM cell_car; @@ -423,9 +423,9 @@ SCM cdr (SCM x); #endif struct function fun_cdr = {&cdr, 1}; #if __GNUC__ -struct scm scm_cdr = {TFUNCTION,"cdr", 0}; +struct scm scm_cdr = {TFUNCTION,"cdr",0}; #else -struct scm scm_make_cell = {TFUNCTION,0,0}; +struct scm scm_cdr = {TFUNCTION,0,0}; #endif SCM cell_cdr; @@ -1433,6 +1433,7 @@ g_functions[g_function++] = fun_cdr; cell_cdr = g_free++; g_cells[cell_cdr] = scm_cdr; + #if 1 //scm_make_cell.string = cstring_to_list (scm_make_cell.name); //g_cells[cell_make_cell].string = MAKE_STRING (scm_make_cell.string); //a = acons (make_symbol (scm_make_cell.string), cell_make_cell, a); @@ -1465,6 +1466,8 @@ scm_cdr.car = cstring_to_list (scm_cdr.car); g_cells[cell_cdr].car = MAKE_STRING (scm_cdr.car); a = acons (make_symbol (scm_cdr.car), cell_cdr, a); + #endif + #endif return a; } diff --git a/scaffold/t.c b/scaffold/t.c index 61c36014..b1547cbf 100644 --- a/scaffold/t.c +++ b/scaffold/t.c @@ -105,10 +105,11 @@ int bar (int i) {puts ("t: bar\n"); return 0;}; struct function { int (*function) (void); int arity; + char *name; }; -struct function g_fun = {&exit, 1}; -struct function g_foo = {&foo, 0}; -struct function g_bar = {&bar, 1}; +struct function g_fun = {&exit,1,"fun"}; +struct function g_foo = {&foo,0,"foo"}; +struct function g_bar = {&bar,1,"bar"}; //void *functions[2]; int functions[2]; @@ -299,21 +300,27 @@ struct_test () if (CDR (3) != 0x22) return CDR (3); - puts ("t: struct fun = {&exit, 1};\n"); - struct function fun = {&exit, 1}; - puts ("t: g_fun.arity != 1;\n"); if (g_fun.arity != 1) return 1; puts ("t: g_fun.function != exit;\n"); if (g_fun.function != &exit) return 1; + puts ("t: struct fun = {&exit,1,\"exit\"};\n"); + struct function fun = {&exit,1,"exit"}; + puts ("t: fun.arity != 1;\n"); if (fun.arity != 1) return 1; puts ("t: fun.function != exit;\n"); if (fun.function != &exit) return 1; + puts ("t: puts (fun.name)\n"); + if (strcmp (fun.name, "exit")) return 1; + + puts ("t: puts (g_fun.name)\n"); + if (strcmp (g_fun.name, "fun")) return 1; + puts ("t: g_functions[g_function++] = g_foo;\n"); g_functions[g_function++] = g_foo; @@ -327,10 +334,13 @@ struct_test () int (*functionx) (void) = 0; functionx = g_functions[0].function; - puts ("t: *functionx == foo\n"); + puts ("t: functionx == foo\n"); if (functionx != foo) return 11; - puts ("t: (*functionx) () == foo\n"); + puts ("t: g_functions[0].name\n"); + if (strcmp (g_functions[0].name, "foo")) return 1; + + puts ("t: (functionx) () == foo\n"); if ((functionx) () != 0) return 12; puts ("t: g_functions[].arity\n"); @@ -344,10 +354,13 @@ struct_test () puts ("t: g_functions[g_cells[fn].cdr].function\n"); functionx = g_functions[g_cells[fn].cdr].function; + puts ("t: g_functions[1].name\n"); + if (strcmp (g_functions[1].name, "bar")) return 1; + puts ("t: functionx == bar\n"); if (functionx != bar) return 15; - puts ("t: (*functiony) (1) == bar\n"); + puts ("t: (functiony) (1) == bar\n"); #if __GNUC__ //FIXME int (*functiony) (int) = 0; @@ -642,9 +655,6 @@ test (char *p) int main (int argc, char *argv[]) { - // int fn = 0; - // g_functions[fn] = g_bar; - // if (g_functions[fn].arity != 1) return 1; char *p = "t.c\n"; puts ("t.c\n");