mescc: Support generic initializer.
* module/language/c99/compiler.mes (ast->info): Support generic declaration using initializer. Supports struct field initializer. * doc/examples/t.c (struct_test): Test it. * doc/examples/mini-mes.c (call_lambda, eval_apply, write_byte, display_): Use it. (call_lambda): (eval_apply, list_of_char_equal_p): Use it.
This commit is contained in:
Jan Nieuwenhuizen
parent
ddd880bdc8
commit
a4d65166c0
|
|
@ -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))))
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue