diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index d8e20269..455015b7 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -991,6 +991,9 @@ _))))) clause-text) #:globals (.globals clause-info))))) + ((case (neg (p-expr (fixed ,value))) ,statement) + ((case->jump-info info) `(case (p-expr (fixed ,(string-append "-" value))) ,statement))) + ((default (compd-stmt (block-item-list . ,elements))) (lambda (body-length) (let ((text-length (length (.text info)))) @@ -1812,18 +1815,6 @@ _))))) ((ident->accu info) local) ((accu->ident info) name)))))) - ;; int i = f (); - ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (fctn-call . ,call))))) - ;;(stderr "4TYPE: ~s\n" type) - (let* ((locals (add-local locals name type 0)) - (info (clone info #:locals locals))) - (let ((info ((ast->info info) `(expr-stmt (fctn-call ,@call))))) - (clone info - #:text - (append (.text info) - ((accu->ident info) name)) - #:locals locals)))) - ;; int (*function) (void) = g_functions[g_cells[fn].cdr].function; ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)) (initzer ,initzer)))) (let* ((locals (add-local locals name type 1)) @@ -1843,17 +1834,6 @@ _))))) (i386:accu+base))))) #:locals locals))) - ;; SCM x = car (e); - ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (fctn-call . ,call))))) - ;;(stderr "5TYPE: ~s\n" type) - (let* ((locals (add-local locals name type 0)) - (info (clone info #:locals locals))) - (let ((info ((ast->info info) `(expr-stmt (fctn-call ,@call))))) - (clone info - #:text - (append (.text info) - ((accu->ident info) name)))))) - ;; char *p = (char*)g_cells; ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (cast (type-name (decl-spec-list (type-spec (fixed-type ,=type))) (abs-declr (pointer))) (p-expr (ident ,value))))))) ;;(stderr "6TYPE: ~s\n" type) @@ -1893,8 +1873,7 @@ _))))) ((ident->accu info) value) ((accu->ident info) name)))) (let* ((globals (append globals (list (ident->global name type 1 0)))) - (here (data-offset name globals)) - (there (data-offset value globals))) + (here (data-offset name globals))) (clone info #:globals globals #:init (append (.init info) @@ -1904,8 +1883,6 @@ _))))) ;;; FIXME: type ;;; char *x = arena;p (int->bv32 (+ d (data-offset value globals))) - ;;; char *y = x; - ;;;(list-head (list-tail data there) 4) (list-tail data (+ here 4))))))))))) ;; enum @@ -2205,9 +2182,34 @@ _))))) (initzer->data info functions globals ta t d (car initzers)) (list-tail data (+ here offset field-size))))))))))))))) + + ;;char cc = g_cells[c].cdr; ==> generic? + ((decl (decl-spec-list (type-spec ,type)) (init-declr-list (init-declr (ident ,name) (initzer ,initzer)))) + (let ((type (decl->type type))) + (if (.function info) + (let* ((locals (add-local locals name type 0)) + (info (clone info #:locals locals))) + (clone info #:text + (append (.text ((expr->accu info) initzer)) + ((accu->ident info) name)))) + (let* ((globals (append globals (list (ident->global name type 1 0)))) + (here (data-offset name globals))) + (clone info + #:globals globals + #:init (append (.init info) + (list (lambda (functions globals ta t d data) + (append + (list-head data here) + (initzer->data info functions globals ta t d initzer) + (list-tail data (+ here 4))))))))))) + + ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list))))) info) + ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list)))) (comment ,comment)) + info) + ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name)))) (let ((types (.types info))) (clone info #:types (cons (cons name (assoc-ref types type)) types)))) diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c index fed25893..b79ef163 100644 --- a/scaffold/mini-mes.c +++ b/scaffold/mini-mes.c @@ -251,10 +251,7 @@ assert_fail (char* s) typedef int SCM; -#if __GNUC__ int g_debug = 0; -#endif - int g_free = 0; SCM g_continuations = 0; @@ -560,10 +557,7 @@ SCM append2 (SCM x, SCM y) { if (x == cell_nil) return y; -#if __GNUC__ - //FIXME GNUC assert (TYPE (x) == TPAIR); -#endif return cons (car (x), append2 (cdr (x), y)); } @@ -578,10 +572,7 @@ pairlis (SCM x, SCM y, SCM a) pairlis (cdr (x), cdr (y), a)); } - -#if __GNUC__ SCM display_ (SCM); -#endif SCM call (SCM fn, SCM x) @@ -594,19 +585,11 @@ call (SCM fn, SCM x) x = cons (CAR (x), cons (CDADAR (x), CDR (x))); switch (FUNCTION (fn).arity) { - // case 0: return FUNCTION (fn).function0 (); - // case 1: return FUNCTION (fn).function1 (car (x)); - // case 2: return FUNCTION (fn).function2 (car (x), cadr (x)); - // case 3: return FUNCTION (fn).function3 (car (x), cadr (x), car (cddr (x))); - // case -1: return FUNCTION (fn).functionn (x); case 0: {return (FUNCTION (fn).function) ();} case 1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (car (x));} case 2: {return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x));} case 3: {return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x), car (cddr (x)));} -#if __GNUC__ - // FIXME GNUC case -1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);} -#endif default: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);} } @@ -657,9 +640,7 @@ set_env_x (SCM x, SCM e, SCM a) SCM call_lambda (SCM e, SCM x, SCM aa, SCM a) ///((internal)) { - //FIXME - //SCM cl = cons (cons (cell_closure, x), x); - SCM cl; + SCM cl = cons (cons (cell_closure, x), x); cl = cons (cons (cell_closure, x), x); r1 = e; r0 = cl; @@ -699,10 +680,7 @@ SCM cadr (SCM x) {return car (cdr (x));} SCM cdar (SCM x) {return cdr (car (x));} SCM cddr (SCM x) {return cdr (cdr (x));} -#if __GNUC__ -//FIXME SCM gc_pop_frame (); //((internal)) -#endif SCM eval_apply () @@ -765,10 +743,7 @@ eval_apply () } case TCLOSURE: { - //FIXME - //SCM cl = CLOSURE (car (r1)); - SCM cl; - cl = CLOSURE (car (r1)); + SCM cl = CLOSURE (car (r1)); SCM formals = cadr (cl); SCM body = cddr (cl); SCM aa = cdar (cl); @@ -1087,12 +1062,7 @@ SCM make_symbol_ (SCM s) { VALUE (tmp_num) = TSYMBOL; - ///FIXME SCM x = make_cell (tmp_num, s, 0); - SCM x; - x = make_cell (tmp_num, s, 0); - puts ("MAKE SYMBOL: "); - display_ (x); - puts ("\n"); + SCM x = make_cell (tmp_num, s, 0); g_symbols = cons (x, g_symbols); return x; } @@ -1178,10 +1148,7 @@ write_byte (SCM x) ///((arity . n)) //FILE *f = fd == 1 ? stdout : stderr; assert (TYPE (c) == TNUMBER || TYPE (c) == TCHAR); // fputc (VALUE (c), f); - // FIXME - //char cc = VALUE (c); - char cc; - cc = VALUE (c); + char cc = VALUE (c); write (1, (char*)&cc, fd); return c; } @@ -1252,10 +1219,7 @@ display_ (SCM x) } case TSYMBOL: { - // FIXME - ///SCM t = CAR (x); - SCM t; - t = CAR (x); + SCM t = CAR (x); while (t != cell_nil) { putchar (VALUE (CAR (t))); @@ -1461,16 +1425,6 @@ int main (int argc, char *argv[]) { eputs ("Hello mini-mes!\n"); - - // make_tmps (g_cells); - // SCM x = cstring_to_list ("bla"); - // while (x != 1) - // { - // putchar (CDR (CAR (x))); - // x = CDR (x); - // } - // return 0; - #if __GNUC__ //g_debug = getenv ("MES_DEBUG"); #endif @@ -1505,14 +1459,12 @@ main (int argc, char *argv[]) #if !MES_MINI gc (g_stack); #endif -#if __GNUC__ if (g_debug) { eputs ("\nstats: ["); eputs (itoa (g_free)); eputs ("]\n"); } -#endif return 0; } diff --git a/scaffold/t.c b/scaffold/t.c index 8f9fa807..f19d2933 100644 --- a/scaffold/t.c +++ b/scaffold/t.c @@ -327,6 +327,10 @@ struct_test () g_cells[0].car = 1; g_cells[1].car = 2; + puts ("t: int c = VALUE (0)\n"); + int c = CAR (0); + if (c != 1) return 1; + puts ("t: CAAR (0) != 2\n"); if (CAAR (0) != 2) return 1;