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))))
((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))
(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)
((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)
;;; 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
(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))))
typedef int SCM;
-#if __GNUC__
int g_debug = 0;
-#endif
-
int g_free = 0;
SCM g_continuations = 0;
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));
}
pairlis (cdr (x), cdr (y), a));
}
-
-#if __GNUC__
SCM display_ (SCM);
-#endif
SCM
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);}
}
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;
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 ()
}
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);
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;
}
//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;
}
}
case TSYMBOL:
{
- // FIXME
- ///SCM t = CAR (x);
- SCM t;
- t = CAR (x);
+ SCM t = CAR (x);
while (t != cell_nil)
{
putchar (VALUE (CAR (t)));
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
#if !MES_MINI
gc (g_stack);
#endif
-#if __GNUC__
if (g_debug)
{
eputs ("\nstats: [");
eputs (itoa (g_free));
eputs ("]\n");
}
-#endif
return 0;
}