(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)))
(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)))))
;; (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
(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)))))
(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)))))
(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))
'()))
(offset (* field-size (1- (length rest))))
(text (.text info)))
- ;;(stderr "COUNT=~a\n" count)
(clone info #:text
(append text
(.text index)
((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)
((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))
(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
(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))
;; 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];
;; 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;
(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)))
(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)
(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)
(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)
(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)))
(.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)))
((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))))
(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)))))))))
#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
#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;
#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;
#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;
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);
g_cells[cell_cdr].car = MAKE_STRING (scm_cdr.car);
a = acons (make_symbol (scm_cdr.car), cell_cdr, a);
+ #endif
+
#endif
return a;
}
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];
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;
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");
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;
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");