mescc: Support function call with enum value.
* doc/examples/mini-mes.c: Remove debug printing. * module/language/c99/compiler.mes (push-global, push-local, push-global-address, push-local-address, push-local-de-ref): Return list of lambda. (push-ident): Support push constant. Fixes mini-mes, cstring_to_list. * doc/examples/t.c (test): Test it.
This commit is contained in:
Jan Nieuwenhuizen
parent
a2f180ba4a
commit
cbee04c4b8
|
|
@ -178,30 +178,35 @@
|
|||
|
||||
(define (push-global globals)
|
||||
(lambda (o)
|
||||
(lambda (f g ta t d)
|
||||
(i386:push-global (+ (data-offset o g) d)))))
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(i386:push-global (+ (data-offset o g) d))))))
|
||||
|
||||
(define (push-local locals)
|
||||
(lambda (o)
|
||||
(lambda (f g ta t d)
|
||||
(i386:push-local (local:id o)))))
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(i386:push-local (local:id o))))))
|
||||
|
||||
(define (push-global-address globals)
|
||||
(lambda (o)
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(i386:push-global-address (+ (data-offset o g) d)))))
|
||||
(i386:push-global-address (+ (data-offset o g) d))))))
|
||||
|
||||
(define (push-local-address locals)
|
||||
(lambda (o)
|
||||
(lambda (f g ta t d)
|
||||
(i386:push-local-address (local:id o)))))
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(i386:push-local-address (local:id o))))))
|
||||
|
||||
(define push-global-de-ref push-global)
|
||||
|
||||
(define (push-local-de-ref locals)
|
||||
(lambda (o)
|
||||
(lambda (f g ta t d)
|
||||
(i386:push-local-de-ref (local:id o)))))
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(i386:push-local-de-ref (local:id o))))))
|
||||
|
||||
(define (string->global string)
|
||||
(make-global (add-s:-prefix string) "string" 0 (append (string->list string) (list #\nul))))
|
||||
|
|
@ -219,7 +224,16 @@
|
|||
(lambda (o)
|
||||
(let ((local (assoc-ref (.locals info) o)))
|
||||
(if local ((push-local (.locals info)) local)
|
||||
((push-global (.globals info)) o))))) ;; FIXME: char*/int
|
||||
(let ((global (assoc-ref (.globals info) o)))
|
||||
(if global
|
||||
((push-global (.globals info)) o) ;; FIXME: char*/int
|
||||
(let ((constant (assoc-ref (.constants info) o)))
|
||||
(if constant
|
||||
(list (lambda (f g ta t d)
|
||||
(append
|
||||
(i386:value->accu constant)
|
||||
(i386:push-accu))))
|
||||
TODO:push-function))))))))
|
||||
|
||||
(define (push-ident-address info)
|
||||
(lambda (o)
|
||||
|
|
@ -236,6 +250,7 @@
|
|||
(define (expr->arg info) ;; FIXME: get Mes curried-definitions
|
||||
(lambda (o)
|
||||
(let ((text (.text info)))
|
||||
;;(stderr "expr->arg o=~s\n" o)
|
||||
(pmatch o
|
||||
((p-expr (fixed ,value))
|
||||
(let ((value (cstring->number value)))
|
||||
|
|
@ -256,10 +271,10 @@
|
|||
(i386:push-accu))))))))
|
||||
|
||||
((p-expr (string ,string))
|
||||
(clone info #:text (append text (list ((push-global-address info) (add-s:-prefix string))))))
|
||||
(clone info #:text (append text ((push-global-address info) (add-s:-prefix string)))))
|
||||
|
||||
((p-expr (ident ,name))
|
||||
(clone info #:text (append text (list ((push-ident info) name)))))
|
||||
(clone info #:text (append text ((push-ident info) name))))
|
||||
|
||||
;; g_cells[0]
|
||||
((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))
|
||||
|
|
@ -302,10 +317,10 @@ _)))))
|
|||
(i386:push-accu)))))))
|
||||
|
||||
((de-ref (p-expr (ident ,name)))
|
||||
(clone info #:text (append text (list ((push-ident-de-ref info) name)))))
|
||||
(clone info #:text (append text ((push-ident-de-ref info) name))))
|
||||
|
||||
((ref-to (p-expr (ident ,name)))
|
||||
(clone info #:text (append text (list ((push-ident-address info) name)))))
|
||||
(clone info #:text (append text ((push-ident-address info) name))))
|
||||
|
||||
;; f (car (x))
|
||||
((fctn-call . ,call)
|
||||
|
|
@ -506,8 +521,8 @@ _)))))
|
|||
(i386:value->accu size))))))))
|
||||
|
||||
;; c+p expr->arg
|
||||
((array-ref (p-expr (fixed ,value)) (p-expr (ident ,array)))
|
||||
(let* ((value (cstring->number value))
|
||||
((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))
|
||||
(let* ((index (cstring->number index))
|
||||
(type (ident->type info array))
|
||||
(size (type->size info type)))
|
||||
(clone info #:text
|
||||
|
|
@ -515,7 +530,7 @@ _)))))
|
|||
((ident->base info) array)
|
||||
(list (lambda (f g ta t d)
|
||||
(append
|
||||
(i386:value->accu value)
|
||||
(i386:value->accu (* size index))
|
||||
(if (eq? size 1)
|
||||
(i386:byte-base-mem->accu)
|
||||
(i386:base-mem->accu)))))))))
|
||||
|
|
@ -789,6 +804,7 @@ _)))))
|
|||
(define (expr->accu* info)
|
||||
(lambda (o)
|
||||
(pmatch o
|
||||
;;(stderr "expr->accu* o=~s\n" o)
|
||||
;; g_cells[10].type
|
||||
((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
|
||||
(let* ((type (ident->type info array))
|
||||
|
|
@ -1129,7 +1145,7 @@ _)))))
|
|||
(locals (cons (make-local name type pointer id) locals)))
|
||||
locals))
|
||||
|
||||
;; (stderr "\n ast->info=~s\n" o)
|
||||
;;(stderr "\n ast->info=~s\n" o)
|
||||
;; (stderr " globals[~a=>~a]: ~a\n" (length globals) (length (append-map cdr globals)) (map (lambda (s) (if (string? s) (string-delete #\newline s))) (map car globals)))
|
||||
;; (stderr " text=~a\n" text)
|
||||
;; (stderr " info=~a\n" info)
|
||||
|
|
@ -1179,7 +1195,6 @@ _)))))
|
|||
#:globals globals)
|
||||
(let* ((empty (clone info #:text '()))
|
||||
(accu ((expr->accu empty) `(p-expr (ident ,name)))))
|
||||
(stderr "DINGES: ~a\n" o)
|
||||
(clone args-info #:text
|
||||
(append text
|
||||
(.text accu)
|
||||
|
|
@ -2301,6 +2316,7 @@ strlen (char const* s)
|
|||
(define getchar
|
||||
(let* ((ast (with-input-from-string
|
||||
"
|
||||
int g_stdin;
|
||||
int
|
||||
getchar ()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -616,7 +616,7 @@ call (SCM fn, SCM x)
|
|||
SCM
|
||||
assq (SCM x, SCM a)
|
||||
{
|
||||
//FIXME: todo eq_p
|
||||
//FIXME: eq_p
|
||||
//while (a != cell_nil && eq_p (x, CAAR (a)) == cell_f) a = CDR (a);
|
||||
while (a != cell_nil && x != CAAR (a)) a = CDR (a);
|
||||
return a != cell_nil ? car (a) : cell_f;
|
||||
|
|
@ -1087,25 +1087,10 @@ SCM
|
|||
make_symbol_ (SCM s)
|
||||
{
|
||||
VALUE (tmp_num) = TSYMBOL;
|
||||
///FIXMESCM x = make_cell (tmp_num, s, 0);
|
||||
///FIXME SCM x = make_cell (tmp_num, s, 0);
|
||||
SCM x;
|
||||
x = make_cell (tmp_num, s, 0);
|
||||
puts ("MAKE SYMBOL: ");
|
||||
// puts ("[s=");
|
||||
// puts (itoa (s));
|
||||
// puts (",s.car=");
|
||||
// puts (itoa (CAR (s)));
|
||||
// puts (",s.car.cdr=");
|
||||
// // puts (itoa (CDR (CAR (s))));
|
||||
// putchar (CDR (CAR (s)));
|
||||
// puts (",x=");
|
||||
// puts (itoa (x));
|
||||
// puts (",x.car=");
|
||||
// puts (itoa (CAR (x)));
|
||||
// puts ("]");
|
||||
|
||||
|
||||
////TYPE (x) = TSYMBOL;
|
||||
display_ (x);
|
||||
puts ("\n");
|
||||
g_symbols = cons (x, g_symbols);
|
||||
|
|
@ -1216,7 +1201,6 @@ display_ (SCM x)
|
|||
}
|
||||
case TFUNCTION:
|
||||
{
|
||||
#if 1
|
||||
puts ("#<procedure ");
|
||||
///puts (FUNCTION (x).name ? FUNCTION (x).name : "?");
|
||||
char *p = "?";
|
||||
|
|
@ -1227,29 +1211,11 @@ display_ (SCM x)
|
|||
puts (itoa (CDR (x)));
|
||||
puts ("]>");
|
||||
break;
|
||||
#endif
|
||||
// //puts ("<function>\n");
|
||||
// if (VALUE (x) == 0)
|
||||
// puts ("make-cell");
|
||||
// if (VALUE (x) == 1)
|
||||
// puts ("cons");
|
||||
// if (VALUE (x) == 2)
|
||||
// puts ("car");
|
||||
// if (VALUE (x) == 3)
|
||||
// puts ("cdr");
|
||||
// break;
|
||||
}
|
||||
case TNUMBER:
|
||||
{
|
||||
//puts ("<number>\n");
|
||||
#if __GNUC__
|
||||
puts (itoa (VALUE (x)));
|
||||
#else
|
||||
int i;
|
||||
i = VALUE (x);
|
||||
i = i + 48;
|
||||
putchar (i);
|
||||
#endif
|
||||
break;
|
||||
}
|
||||
case TPAIR:
|
||||
|
|
@ -1260,16 +1226,8 @@ display_ (SCM x)
|
|||
if (x && x != cell_nil) display_ (CAR (x));
|
||||
if (CDR (x) && CDR (x) != cell_nil)
|
||||
{
|
||||
#if __GNUC__
|
||||
if (TYPE (CDR (x)) != TPAIR)
|
||||
puts (" . ");
|
||||
#else
|
||||
int c;
|
||||
c = CDR (x);
|
||||
c = TYPE (c);
|
||||
if (c != TPAIR)
|
||||
puts (" . ");
|
||||
#endif
|
||||
display_ (CDR (x));
|
||||
}
|
||||
//if (cont != cell_f) puts (")");
|
||||
|
|
@ -1285,40 +1243,21 @@ display_ (SCM x)
|
|||
case 3: {puts ("#t"); break;}
|
||||
default:
|
||||
{
|
||||
#if __GNUC__
|
||||
puts ("<x:");
|
||||
puts (itoa (x));
|
||||
puts (">");
|
||||
#else
|
||||
puts ("<x>");
|
||||
#endif
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
case TSYMBOL:
|
||||
{
|
||||
#if 0
|
||||
puts ("<s:");
|
||||
puts (itoa (x));
|
||||
puts (">");
|
||||
#endif
|
||||
// FIXME
|
||||
///SCM t = CAR (x);
|
||||
SCM t;
|
||||
t = CAR (x);
|
||||
while (t != cell_nil)
|
||||
{
|
||||
//FIXME
|
||||
//SCM xx = CAR (t);
|
||||
// SCM xx;
|
||||
// xx = CAR (t);
|
||||
// puts ("[c:");
|
||||
// puts (itoa (xx));
|
||||
// puts (",");
|
||||
// puts (itoa (VALUE (xx)));
|
||||
// puts ("]");
|
||||
// putchar (VALUE (xx));
|
||||
putchar (VALUE (CAR (t)));
|
||||
t = CDR (t);
|
||||
}
|
||||
|
|
@ -1327,15 +1266,11 @@ display_ (SCM x)
|
|||
default:
|
||||
{
|
||||
//puts ("<default>\n");
|
||||
#if 1
|
||||
puts ("<");
|
||||
puts (itoa (TYPE (x)));
|
||||
puts (":");
|
||||
puts (itoa (x));
|
||||
puts (">");
|
||||
#else
|
||||
puts ("_");
|
||||
#endif
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -95,6 +95,7 @@ struct scm {
|
|||
int cdr;
|
||||
};
|
||||
|
||||
int bla = 1234;
|
||||
char arena[84];
|
||||
struct scm *g_cells = arena;
|
||||
char *g_chars = arena;
|
||||
|
|
@ -593,6 +594,9 @@ test (char *p)
|
|||
puts ("t: add (inc (0), inc (1))\n");
|
||||
if (add (inc (0), inc (1)) != 3) return 1;
|
||||
|
||||
puts ("t: add (TSTRING, 3)\n");
|
||||
if (add (TSTRING, 3) != 13) return 1;
|
||||
|
||||
puts ("t: add (inc (inc (0)), inc (inc (1)))\n");
|
||||
if (add (inc (inc (0)), inc (inc (1))) != 5) return 1;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue