mescc: Support strings in struct initialization.
* module/mes/elf-util.mes (add-s:-prefix, drop-s:-prefix): New functions. * module/mes/elf-util.scm: Export them. * module/language/c99/compiler.mes (string->global): Add `s:' prefix to global strings. Update users. (expr->arg): Update. (expr->accu): Handle string expressions. (initzer->global): New function. (struct-field): Handle string field. * doc/examples/t.c: Test it. * doc/examples/mini-mes.c: Use it. dun!
This commit is contained in:
Jan Nieuwenhuizen
parent
64e73dcf29
commit
e9560e95a5
|
|
@ -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;
|
||||
|
|
@ -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)))))))))
|
||||
|
|
|
|||
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -386,7 +386,7 @@ SCM make_cell (SCM type, SCM car, SCM cdr);
|
|||
#endif
|
||||
struct function fun_make_cell = {&make_cell, 3};
|
||||
|
||||
#if __GNUC__
|
||||
#if 1
|
||||
struct scm scm_make_cell = {TFUNCTION,"make-cell",0};
|
||||
#else
|
||||
struct scm scm_make_cell = {TFUNCTION,0,0};
|
||||
|
|
@ -401,7 +401,7 @@ struct function fun_cons = {&cons, 2};
|
|||
#if __GNUC__
|
||||
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;
|
||||
|
||||
|
|
@ -413,7 +413,7 @@ struct function fun_car = {&car, 1};
|
|||
#if __GNUC__
|
||||
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;
|
||||
|
||||
|
|
@ -425,7 +425,7 @@ struct function fun_cdr = {&cdr, 1};
|
|||
#if __GNUC__
|
||||
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;
|
||||
}
|
||||
|
|
|
|||
34
scaffold/t.c
34
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[<foo>].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");
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue