artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Support function call with enum value.

Browse source 
* 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 2017-03-17 08:37:45 +01:00
parent a2f180ba4a
commit cbee04c4b8
3 changed files with 41 additions and 86 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

54
module/language/c99/compiler.mes
View file

@ -178,30 +178,35 @@
(define (push-global globals) (define (push-global globals)
(lambda (o) (lambda (o)
(lambda (f g ta t d) (list
(i386:push-global (+ (data-offset o g) d))))) (lambda (f g ta t d)
(i386:push-global (+ (data-offset o g) d))))))
(define (push-local locals) (define (push-local locals)
(lambda (o) (lambda (o)
(lambda (f g ta t d) (list
(i386:push-local (local:id o))))) (lambda (f g ta t d)
(i386:push-local (local:id o))))))
(define (push-global-address globals) (define (push-global-address globals)
(lambda (o) (lambda (o)
(list
(lambda (f g ta t d) (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) (define (push-local-address locals)
(lambda (o) (lambda (o)
(lambda (f g ta t d) (list
(i386:push-local-address (local:id o))))) (lambda (f g ta t d)
(i386:push-local-address (local:id o))))))
(define push-global-de-ref push-global) (define push-global-de-ref push-global)
(define (push-local-de-ref locals) (define (push-local-de-ref locals)
(lambda (o) (lambda (o)
(lambda (f g ta t d) (list
(i386:push-local-de-ref (local:id o))))) (lambda (f g ta t d)
(i386:push-local-de-ref (local:id o))))))
(define (string->global string) (define (string->global string)
(make-global (add-s:-prefix string) "string" 0 (append (string->list string) (list #\nul)))) (make-global (add-s:-prefix string) "string" 0 (append (string->list string) (list #\nul))))
@ -219,7 +224,16 @@
(lambda (o) (lambda (o)
(let ((local (assoc-ref (.locals info) o))) (let ((local (assoc-ref (.locals info) o)))
(if local ((push-local (.locals info)) local) (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) (define (push-ident-address info)
(lambda (o) (lambda (o)
@ -236,6 +250,7 @@
(define (expr->arg info) ;; FIXME: get Mes curried-definitions (define (expr->arg info) ;; FIXME: get Mes curried-definitions
(lambda (o) (lambda (o)
(let ((text (.text info))) (let ((text (.text info)))
;;(stderr "expr->arg o=~s\n" o)
(pmatch o (pmatch o
((p-expr (fixed ,value)) ((p-expr (fixed ,value))
(let ((value (cstring->number value))) (let ((value (cstring->number value)))
@ -256,10 +271,10 @@
(i386:push-accu)))))))) (i386:push-accu))))))))
((p-expr (string ,string)) ((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)) ((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] ;; g_cells[0]
((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))) ((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))
@ -302,10 +317,10 @@ _)))))
(i386:push-accu))))))) (i386:push-accu)))))))
((de-ref (p-expr (ident ,name))) ((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))) ((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)) ;; f (car (x))
((fctn-call . ,call) ((fctn-call . ,call)
@ -506,8 +521,8 @@ _)))))
(i386:value->accu size)))))))) (i386:value->accu size))))))))
;; c+p expr->arg ;; c+p expr->arg
((array-ref (p-expr (fixed ,value)) (p-expr (ident ,array))) ((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))
(let* ((value (cstring->number value)) (let* ((index (cstring->number index))
(type (ident->type info array)) (type (ident->type info array))
(size (type->size info type))) (size (type->size info type)))
(clone info #:text (clone info #:text
@ -515,7 +530,7 @@ _)))))
((ident->base info) array) ((ident->base info) array)
(list (lambda (f g ta t d) (list (lambda (f g ta t d)
(append (append
(i386:value->accu value) (i386:value->accu (* size index))
(if (eq? size 1) (if (eq? size 1)
(i386:byte-base-mem->accu) (i386:byte-base-mem->accu)
(i386:base-mem->accu))))))))) (i386:base-mem->accu)))))))))
@ -789,6 +804,7 @@ _)))))
(define (expr->accu* info) (define (expr->accu* info)
(lambda (o) (lambda (o)
(pmatch o (pmatch o
;;(stderr "expr->accu* o=~s\n" o)
;; g_cells[10].type ;; g_cells[10].type
((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))) ((d-sel (ident ,field) (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))))
(let* ((type (ident->type info array)) (let* ((type (ident->type info array))
@ -1129,7 +1145,7 @@ _)))))
(locals (cons (make-local name type pointer id) locals))) (locals (cons (make-local name type pointer id) locals)))
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 " 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 " text=~a\n" text)
;; (stderr " info=~a\n" info) ;; (stderr " info=~a\n" info)
@ -1179,7 +1195,6 @@ _)))))
#:globals globals) #:globals globals)
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(accu ((expr->accu empty) `(p-expr (ident ,name))))) (accu ((expr->accu empty) `(p-expr (ident ,name)))))
(stderr "DINGES: ~a\n" o)
(clone args-info #:text (clone args-info #:text
(append text (append text
(.text accu) (.text accu)
@ -2301,6 +2316,7 @@ strlen (char const* s)
(define getchar (define getchar
(let* ((ast (with-input-from-string (let* ((ast (with-input-from-string
" "
int g_stdin;
int int
getchar () getchar ()
{ {

69
scaffold/mini-mes.c
View file

@ -616,7 +616,7 @@ call (SCM fn, SCM x)
SCM SCM
assq (SCM x, SCM a) 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 && eq_p (x, CAAR (a)) == cell_f) a = CDR (a);
while (a != cell_nil && x != CAAR (a)) a = CDR (a); while (a != cell_nil && x != CAAR (a)) a = CDR (a);
return a != cell_nil ? car (a) : cell_f; return a != cell_nil ? car (a) : cell_f;
@ -1087,25 +1087,10 @@ SCM
make_symbol_ (SCM s) make_symbol_ (SCM s)
{ {
VALUE (tmp_num) = TSYMBOL; VALUE (tmp_num) = TSYMBOL;
///FIXMESCM x = make_cell (tmp_num, s, 0); ///FIXME SCM x = make_cell (tmp_num, s, 0);
SCM x; SCM x;
x = make_cell (tmp_num, s, 0); x = make_cell (tmp_num, s, 0);
puts ("MAKE SYMBOL: "); 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); display_ (x);
puts ("\n"); puts ("\n");
g_symbols = cons (x, g_symbols); g_symbols = cons (x, g_symbols);
@ -1216,7 +1201,6 @@ display_ (SCM x)
} }
case TFUNCTION: case TFUNCTION:
{ {
#if 1
puts ("#<procedure "); puts ("#<procedure ");
///puts (FUNCTION (x).name ? FUNCTION (x).name : "?"); ///puts (FUNCTION (x).name ? FUNCTION (x).name : "?");
char *p = "?"; char *p = "?";
@ -1227,29 +1211,11 @@ display_ (SCM x)
puts (itoa (CDR (x))); puts (itoa (CDR (x)));
puts ("]>"); puts ("]>");
break; 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: case TNUMBER:
{ {
//puts ("<number>\n"); //puts ("<number>\n");
#if __GNUC__
puts (itoa (VALUE (x))); puts (itoa (VALUE (x)));
#else
int i;
i = VALUE (x);
i = i + 48;
putchar (i);
#endif
break; break;
} }
case TPAIR: case TPAIR:
@ -1260,16 +1226,8 @@ display_ (SCM x)
if (x && x != cell_nil) display_ (CAR (x)); if (x && x != cell_nil) display_ (CAR (x));
if (CDR (x) && CDR (x) != cell_nil) if (CDR (x) && CDR (x) != cell_nil)
{ {
#if __GNUC__
if (TYPE (CDR (x)) != TPAIR) if (TYPE (CDR (x)) != TPAIR)
puts (" . "); puts (" . ");
#else
int c;
c = CDR (x);
c = TYPE (c);
if (c != TPAIR)
puts (" . ");
#endif
display_ (CDR (x)); display_ (CDR (x));
} }
//if (cont != cell_f) puts (")"); //if (cont != cell_f) puts (")");
@ -1285,40 +1243,21 @@ display_ (SCM x)
case 3: {puts ("#t"); break;} case 3: {puts ("#t"); break;}
default: default:
{ {
#if __GNUC__
puts ("<x:"); puts ("<x:");
puts (itoa (x)); puts (itoa (x));
puts (">"); puts (">");
#else
puts ("<x>");
#endif
} }
} }
break; break;
} }
case TSYMBOL: case TSYMBOL:
{ {
#if 0
puts ("<s:");
puts (itoa (x));
puts (">");
#endif
// FIXME // FIXME
///SCM t = CAR (x); ///SCM t = CAR (x);
SCM t; SCM t;
t = CAR (x); t = CAR (x);
while (t != cell_nil) 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))); putchar (VALUE (CAR (t)));
t = CDR (t); t = CDR (t);
} }
@ -1327,15 +1266,11 @@ display_ (SCM x)
default: default:
{ {
//puts ("<default>\n"); //puts ("<default>\n");
#if 1
puts ("<"); puts ("<");
puts (itoa (TYPE (x))); puts (itoa (TYPE (x)));
puts (":"); puts (":");
puts (itoa (x)); puts (itoa (x));
puts (">"); puts (">");
#else
puts ("_");
#endif
break; break;
} }
} }

4
scaffold/t.c
View file

@ -95,6 +95,7 @@ struct scm {
int cdr; int cdr;
}; };
int bla = 1234;
char arena[84]; char arena[84];
struct scm *g_cells = arena; struct scm *g_cells = arena;
char *g_chars = arena; char *g_chars = arena;
@ -593,6 +594,9 @@ test (char *p)
puts ("t: add (inc (0), inc (1))\n"); puts ("t: add (inc (0), inc (1))\n");
if (add (inc (0), inc (1)) != 3) return 1; 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"); puts ("t: add (inc (inc (0)), inc (inc (1)))\n");
if (add (inc (inc (0)), inc (inc (1))) != 5) return 1; if (add (inc (inc (0)), inc (inc (1))) != 5) return 1;