mescc: Support any expression as arg.
* module/language/c99/compiler.mes (expr->arg): Also push parameter, always return info. (ast->info): Loop over args. Fixes using function calls in arguments. * module/mes/libc-i386.mes (i386:push-arg): Remove. (i386:call, i386:call-accu): Remove arguments parameter. * doc/examples/t.c: Test it.
This commit is contained in:
Jan Nieuwenhuizen
parent
394a3925be
commit
c9b251616a
|
|
@ -176,18 +176,33 @@
|
|||
(text text))
|
||||
(make <info> #:types types #:constants constants #:functions functions #:globals globals #:init init #:locals locals #:function function #:text text))))))
|
||||
|
||||
(define (push-global-address globals)
|
||||
(lambda (o)
|
||||
(lambda (f g ta t d)
|
||||
(i386:push-global-address (+ (data-offset o g) d)))))
|
||||
|
||||
(define (push-global globals)
|
||||
(lambda (o)
|
||||
(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)))))
|
||||
|
||||
(define (push-global-address globals)
|
||||
(lambda (o)
|
||||
(lambda (f g ta t 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)))))
|
||||
|
||||
(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)))))
|
||||
|
||||
(define (string->global string)
|
||||
(make-global string "string" 0 (append (string->list string) (list #\nul))))
|
||||
|
||||
|
|
@ -203,97 +218,118 @@
|
|||
(define (push-ident info)
|
||||
(lambda (o)
|
||||
(let ((local (assoc-ref (.locals info) o)))
|
||||
(if local (i386:push-local (local:id local))
|
||||
(if local ((push-local (.locals info)) local)
|
||||
((push-global (.globals info)) o))))) ;; FIXME: char*/int
|
||||
|
||||
(define (push-ident-address info)
|
||||
(lambda (o)
|
||||
(let ((local (assoc-ref (.locals info) o)))
|
||||
(if local (i386:push-local-address (local:id local))
|
||||
(if local ((push-local-address (.locals info)) local)
|
||||
((push-global-address (.globals info)) o)))))
|
||||
|
||||
(define (push-ident-de-ref info)
|
||||
(lambda (o)
|
||||
(let ((local (assoc-ref (.locals info) o)))
|
||||
(if local (i386:push-local-de-ref (local:id local))
|
||||
(if local ((push-local-de-ref (.locals info)) local)
|
||||
((push-global-de-ref (.globals info)) o)))))
|
||||
|
||||
(define (expr->arg info) ;; FIXME: get Mes curried-definitions
|
||||
(lambda (o)
|
||||
(pmatch o
|
||||
((p-expr (fixed ,value)) (cstring->number value))
|
||||
((neg (p-expr (fixed ,value))) (- (cstring->number value)))
|
||||
((p-expr (string ,string)) ((push-global-address info) string))
|
||||
((p-expr (ident ,name))
|
||||
((push-ident info) name))
|
||||
(let ((text (.text info)))
|
||||
(pmatch o
|
||||
((p-expr (fixed ,value))
|
||||
(let ((value (cstring->number value)))
|
||||
(clone info #:text (append text
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(append
|
||||
(i386:value->accu value)
|
||||
(i386:push-accu))))))))
|
||||
|
||||
;; g_cells[0]
|
||||
((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))
|
||||
(let ((index (cstring->number index))
|
||||
(size 4)) ;; FIXME: type: int
|
||||
(append
|
||||
((ident->base info) array)
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(append
|
||||
(i386:value->accu (* size index)) ;; FIXME: type: int
|
||||
(i386:base-mem->accu) ;; FIXME: type: int
|
||||
(i386:push-accu) ;; hmm
|
||||
))))))
|
||||
((neg (p-expr (fixed ,value)))
|
||||
(let ((value (- (cstring->number value))))
|
||||
(clone info #:text (append text
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(append
|
||||
(i386:value->accu value)
|
||||
(i386:push-accu))))))))
|
||||
|
||||
;; g_cells[i]
|
||||
((array-ref (p-expr (ident ,index)) (p-expr (ident ,array)))
|
||||
(let ((index (cstring->number index))
|
||||
(size 4)) ;; FIXME: type: int
|
||||
(append
|
||||
((ident->base info) array)
|
||||
((ident->accu info) array)
|
||||
(list (lambda (f g ta t d)
|
||||
;;(i386:byte-base-mem->accu)
|
||||
(i386:base-mem->accu)
|
||||
))
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(append
|
||||
(i386:push-accu)))))))
|
||||
((p-expr (string ,string))
|
||||
(clone info #:text (append text (list ((push-global-address info) string)))))
|
||||
|
||||
((de-ref (p-expr (ident ,name)))
|
||||
(lambda (f g ta t d)
|
||||
((push-ident-de-ref info) name)))
|
||||
((p-expr (ident ,name))
|
||||
(clone info #:text (append text (list ((push-ident info) name)))))
|
||||
|
||||
((ref-to (p-expr (ident ,name)))
|
||||
(lambda (f g ta t d)
|
||||
((push-ident-address info) name)))
|
||||
;; g_cells[0]
|
||||
((array-ref (p-expr (fixed ,index)) (p-expr (ident ,array)))
|
||||
(let ((index (cstring->number index))
|
||||
(size 4)) ;; FIXME: type: int
|
||||
(clone info
|
||||
#:text (append text
|
||||
((ident->base info) array)
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(append
|
||||
(i386:value->accu (* size index)) ;; FIXME: type: int
|
||||
(i386:base-mem->accu) ;; FIXME: type: int
|
||||
(i386:push-accu))))))))
|
||||
|
||||
;; f (car (x))
|
||||
((fctn-call . ,call)
|
||||
(let* ((empty (clone info #:text '()))
|
||||
(info ((ast->info empty) o)))
|
||||
(append (.text info)
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(i386:push-accu))))))
|
||||
;; g_cells[i]
|
||||
((array-ref (p-expr (ident ,index)) (p-expr (ident ,array)))
|
||||
(let ((index (cstring->number index))
|
||||
(size 4)) ;; FIXME: type: int
|
||||
(clone info #:text (append text
|
||||
((ident->base info) array)
|
||||
((ident->accu info) array)
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(i386:base-mem->accu)))
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(i386:push-accu)))))))
|
||||
|
||||
;; f (CAR (x))
|
||||
((d-sel . ,d-sel)
|
||||
(let* ((empty (clone info #:text '()))
|
||||
(expr ((expr->accu empty) `(d-sel ,@d-sel))))
|
||||
(append (.text expr)
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:push-accu))))))
|
||||
((de-ref (p-expr (ident ,name)))
|
||||
(clone info #:text (append text (list ((push-ident-de-ref info) name)))))
|
||||
|
||||
;; f (0 + x)
|
||||
;;; aargh
|
||||
;;;((add (p-expr (fixed ,value)) (d-sel (ident cdr) (array-ref (p-expr (ident x)) (p-expr (ident g_cells))))))
|
||||
((ref-to (p-expr (ident ,name)))
|
||||
(clone info #:text (append text (list ((push-ident-address info) name)))))
|
||||
|
||||
((cast (type-name (decl-spec-list (type-spec (fixed-type _)))
|
||||
(abs-declr (pointer)))
|
||||
,cast)
|
||||
((expr->arg info) cast))
|
||||
(_
|
||||
(format (current-error-port) "SKIP: expr->arg=~s\n" o)
|
||||
barf
|
||||
0))))
|
||||
;; f (car (x))
|
||||
((fctn-call . ,call)
|
||||
(let* (;;(empty (clone info #:text '()))
|
||||
;;(info ((ast->info empty) o))
|
||||
(info ((ast->info info) o))
|
||||
(text (.text info)))
|
||||
(clone info
|
||||
#:text (append text
|
||||
(list
|
||||
(lambda (f g ta t d)
|
||||
(i386:push-accu)))))))
|
||||
|
||||
;; f (CAR (x))
|
||||
((d-sel . ,d-sel)
|
||||
(let* (;;(empty (clone info #:text '()))
|
||||
;;(expr ((expr->accu empty) `(d-sel ,@d-sel)))
|
||||
(expr ((expr->accu info) `(d-sel ,@d-sel)))
|
||||
(text (.text expr)))
|
||||
(clone info
|
||||
#:text (append text
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:push-accu)))))))
|
||||
|
||||
;; f (0 + x)
|
||||
;;; aargh
|
||||
;;;((add (p-expr (fixed ,value)) (d-sel (ident cdr) (array-ref (p-expr (ident x)) (p-expr (ident g_cells))))))
|
||||
|
||||
((cast (type-name (decl-spec-list (type-spec (fixed-type _)))
|
||||
(abs-declr (pointer)))
|
||||
,cast)
|
||||
((expr->arg info) cast))
|
||||
(_
|
||||
(format (current-error-port) "SKIP: expr->arg=~s\n" o)
|
||||
barf
|
||||
0)))))
|
||||
|
||||
;; FIXME: see ident->base
|
||||
(define (ident->accu info)
|
||||
|
|
@ -1019,47 +1055,46 @@
|
|||
(clone info #:text (append text (list (lambda (f g ta t d) (asm->hex arg0))))))
|
||||
(let* ((globals (append globals (filter-map expr->global expr-list)))
|
||||
(info (clone info #:globals globals))
|
||||
(args (map (expr->arg info) expr-list)))
|
||||
(text-length (length text))
|
||||
(args-info (let loop ((expressions (reverse expr-list)) (info info))
|
||||
(if (null? expressions) info
|
||||
(loop (cdr expressions) ((expr->arg info) (car expressions))))))
|
||||
(text (.text args-info))
|
||||
(n (length expr-list)))
|
||||
(if ;;#t ;;(assoc-ref globals name)
|
||||
(not (equal? name "functionx"))
|
||||
(clone info #:text
|
||||
(clone args-info #:text
|
||||
(append text
|
||||
(list (lambda (f g ta t d)
|
||||
(apply i386:call (cons* f g ta t d
|
||||
(+ t (function-offset name f)) args)))))
|
||||
(i386:call f g ta t d (+ t (function-offset name f)) n))))
|
||||
#:globals globals)
|
||||
(let* ((empty (clone info #:text '()))
|
||||
;;(accu ((ident->accu info) name))
|
||||
(accu ((expr->accu empty) `(p-expr (ident ,name)))))
|
||||
(stderr "DINGES: ~a\n" o)
|
||||
(clone info #:text
|
||||
(clone args-info #:text
|
||||
(append text
|
||||
(list (lambda (f g ta t d)
|
||||
'(#x90)))
|
||||
;;accu
|
||||
(.text accu)
|
||||
(list (lambda (f g ta t d)
|
||||
'(#x90)))
|
||||
(list (lambda (f g ta t d)
|
||||
(apply i386:call-accu (cons* f g ta t d args)))))
|
||||
(i386:call-accu f g ta t d n))))
|
||||
#:globals globals))))))
|
||||
|
||||
;;((expr-stmt (fctn-call (d-sel (ident "function") (array-ref (d-sel (ident "cdr") (array-ref (p-expr (ident "fn")) (p-expr (ident "g_cells")))) (p-expr (ident "g_functions")))) (expr-list))))
|
||||
((expr-stmt (fctn-call ,function (expr-list . ,expr-list)))
|
||||
(let* ((globals (append globals (filter-map expr->global expr-list)))
|
||||
(info (clone info #:globals globals))
|
||||
(args (map (expr->arg info) expr-list))
|
||||
(empty (clone info #:text '()))
|
||||
(accu ((expr->accu empty) function)))
|
||||
(info (clone info #:globals globals))
|
||||
(text-length (length text))
|
||||
(args-info (let loop ((expressions (reverse expr-list)) (info info))
|
||||
(if (null? expressions) info
|
||||
(loop (cdr expressions) ((expr->arg info) (car expressions))))))
|
||||
(text (.text args-info))
|
||||
(n (length expr-list))
|
||||
(empty (clone info #:text '()))
|
||||
(accu ((expr->accu empty) function)))
|
||||
(clone info #:text
|
||||
(append text
|
||||
(list (lambda (f g ta t d)
|
||||
'(#x90)))
|
||||
(.text accu)
|
||||
(list (lambda (f g ta t d)
|
||||
'(#x90)))
|
||||
(list (lambda (f g ta t d)
|
||||
(apply i386:call-accu (cons* f g ta t d args)))))
|
||||
(i386:call-accu f g ta t d n))))
|
||||
#:globals globals)))
|
||||
|
||||
((if ,test ,body)
|
||||
|
|
@ -1716,11 +1751,7 @@
|
|||
(offset (* field-size (1- (length (member field (reverse fields) (lambda (a b) (equal? a (cdr b)))))))) )
|
||||
(clone info #:text (append text
|
||||
(.text expr)
|
||||
(list (lambda (f g ta t d)
|
||||
'(#x90)))
|
||||
(.text base)
|
||||
(list (lambda (f g ta t d)
|
||||
'(#x90)))
|
||||
(list (lambda (f g ta t d)
|
||||
;;(i386:byte-base->accu-ref) ;; FIXME: size
|
||||
(i386:base->accu-address)
|
||||
|
|
|
|||
|
|
@ -68,17 +68,6 @@
|
|||
(define (i386:push-base)
|
||||
'(#x52)) ; push %eax
|
||||
|
||||
(define (i386:push-arg f g ta t d)
|
||||
(lambda (o)
|
||||
(or o push-arg)
|
||||
(cond ((number? o)
|
||||
`(#x68 ,@(int->bv32 o))) ; push $<o>
|
||||
((and (pair? o) (procedure? (car o)))
|
||||
(append-map (lambda (p) (p f g ta t d)) o))
|
||||
((pair? o) o)
|
||||
((procedure? o) (o f g ta t d))
|
||||
(_ barf))))
|
||||
|
||||
(define (i386:ret . rest)
|
||||
(lambda (f g ta t d)
|
||||
`(
|
||||
|
|
@ -280,36 +269,17 @@
|
|||
(or n local-test)
|
||||
`(#x83 #x7d ,(- 0 (* 4 n)) ,v)) ; cmpl $<v>,0x<n>(%ebp)
|
||||
|
||||
(define (i386:call f g ta t d address . arguments)
|
||||
(define (i386:call f g ta t d address n)
|
||||
(or address urg:call)
|
||||
(let* ((pushes (append-map (i386:push-arg f g ta t d) (reverse arguments)))
|
||||
(s (length pushes))
|
||||
(n (length arguments)))
|
||||
`(
|
||||
,@pushes ; push args
|
||||
#xe8 ,@(int->bv32 (- address 5 s)) ; call relative
|
||||
#x83 #xc4 ,(* n 4) ; add $00,%esp
|
||||
)))
|
||||
`(#xe8 ,@(int->bv32 (- address 5)) ; call relative $00
|
||||
#x83 #xc4 ,(* n 4))) ; add $00,%esp
|
||||
|
||||
(define (i386:call-accu f g ta t d n)
|
||||
`(,@(i386:push-accu)
|
||||
,@(i386:pop-accu)
|
||||
#xff #xd0 ; call *%eax
|
||||
#x83 #xc4 ,(* n 4))) ; add $00,%esp
|
||||
|
||||
(define (i386:call-accu f g ta t d . arguments)
|
||||
;;(or address urg:call)
|
||||
(let* ((pushes (append-map (i386:push-arg f g ta t d) (reverse arguments)))
|
||||
(s (length pushes))
|
||||
(n (length arguments)))
|
||||
`(
|
||||
,@(i386:push-accu)
|
||||
,@pushes ; push args
|
||||
;;#xe8 ,@(int->bv32 (- address 5 s)) ; call relative
|
||||
;; FIXME: add t?/address
|
||||
;; #x50 ; push %eax
|
||||
;; #xc3 ; ret
|
||||
,@(i386:pop-accu)
|
||||
;; #x05 ,@(int->bv32 t) ; add <t>,%eax
|
||||
;; #x05 ,@(int->bv32 ta) ; add <ta>,%eax
|
||||
#xff #xd0 ; call *%eax
|
||||
#x83 #xc4 ,(* n 4) ; add $00,%esp
|
||||
)))
|
||||
|
||||
(define (i386:accu-not)
|
||||
`(#x0f #x94 #xc0 ; sete %al
|
||||
#x0f #xb6 #xc0)) ; movzbl %al,%eax
|
||||
|
|
|
|||
|
|
@ -117,13 +117,16 @@
|
|||
i386:xor-accu
|
||||
i386:xor-zf
|
||||
|
||||
;; long jump
|
||||
i386:Xjump
|
||||
i386:Xjump
|
||||
i386:XXjump
|
||||
i386:Xjump-c
|
||||
i386:Xjump-nc
|
||||
i386:Xjump-nz
|
||||
i386:Xjump-z
|
||||
|
||||
i386:XXjump
|
||||
|
||||
;; libc
|
||||
i386:exit
|
||||
i386:open
|
||||
|
|
|
|||
|
|
@ -609,10 +609,21 @@ push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
|
|||
}
|
||||
#endif
|
||||
|
||||
#if __GNUC__
|
||||
SCM caar (SCM x) {return car (car (x));}
|
||||
SCM cadr (SCM x) {return car (cdr (x));}
|
||||
SCM cdar (SCM x) {return cdr (car (x));}
|
||||
SCM cddr (SCM x) {return cdr (cdr (x));}
|
||||
#else
|
||||
SCM cadr (SCM x) {
|
||||
x = cdr (x);
|
||||
return car (x);
|
||||
}
|
||||
SCM cddr (SCM x) {
|
||||
x = cdr (x);
|
||||
return cdr (x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#if __GNUC__
|
||||
//FIXME
|
||||
|
|
@ -625,6 +636,10 @@ eval_apply ()
|
|||
{
|
||||
puts ("e/a: fixme\n");
|
||||
eval_apply:
|
||||
asm (".byte 0x90");
|
||||
asm (".byte 0x90");
|
||||
asm (".byte 0x90");
|
||||
asm (".byte 0x90");
|
||||
puts ("eval_apply\n");
|
||||
// if (g_free + GC_SAFETY > ARENA_SIZE)
|
||||
// gc_pop_frame (gc (gc_push_frame ()));
|
||||
|
|
@ -987,11 +1002,6 @@ eval_apply ()
|
|||
gc_pop_frame ();
|
||||
puts ("vm-return01\n");
|
||||
r1 = x;
|
||||
|
||||
//FIXME:
|
||||
r3 = cell_unspecified;
|
||||
/// fIXME: must via eval-apply
|
||||
return r1;
|
||||
goto eval_apply;
|
||||
}
|
||||
|
||||
|
|
@ -1069,9 +1079,24 @@ gc_peek_frame ()
|
|||
{
|
||||
SCM frame = car (g_stack);
|
||||
r1 = car (frame);
|
||||
#if __GNUC__
|
||||
r2 = cadr (frame);
|
||||
r3 = car (cddr (frame));
|
||||
r0 = cadr (cddr (frame));
|
||||
#else
|
||||
r2 = cdr (frame);
|
||||
r2 = car (r2);
|
||||
|
||||
r3 = cdr (frame);
|
||||
r3 = cdr (r3);
|
||||
r3 = car (r3);
|
||||
|
||||
r0 = cdr (frame);
|
||||
r0 = cdr (r0);
|
||||
r0 = cdr (r0);
|
||||
r0 = cdr (r0);
|
||||
r0 = car (r0);
|
||||
#endif
|
||||
return frame;
|
||||
}
|
||||
|
||||
|
|
|
|||
46
scaffold/t.c
46
scaffold/t.c
|
|
@ -124,6 +124,19 @@ SCM tmp;
|
|||
SCM tmp_num;
|
||||
|
||||
#if 1
|
||||
|
||||
int
|
||||
add (int a, int b)
|
||||
{
|
||||
return a + b;
|
||||
}
|
||||
|
||||
int
|
||||
inc (int i)
|
||||
{
|
||||
return i + 1;
|
||||
}
|
||||
|
||||
int
|
||||
label (int c)
|
||||
{
|
||||
|
|
@ -444,6 +457,24 @@ test (char *p)
|
|||
*x++ = c;
|
||||
if (*g_chars != 'C') return 1;
|
||||
|
||||
puts ("t: inc (0)\n");
|
||||
if (inc (0) != 1) return 1;
|
||||
|
||||
puts ("t: inc (inc (0))\n");
|
||||
if (inc (inc (0)) != 2) return 1;
|
||||
|
||||
puts ("t: inc (inc (inc (0)))\n");
|
||||
if (inc (inc (inc (0))) != 3) return 1;
|
||||
|
||||
puts ("t: add (1, 2)\n");
|
||||
if (add (1, 2) != 3) return 1;
|
||||
|
||||
puts ("t: add (inc (0), inc (1))\n");
|
||||
if (add (inc (0), inc (1)) != 3) return 1;
|
||||
|
||||
puts ("t: add (inc (inc (0)), inc (inc (1)))\n");
|
||||
if (add (inc (inc (0)), inc (inc (1))) != 5) return 1;
|
||||
|
||||
puts ("t: goto label\n");
|
||||
if (label (1) != 0) return 1;
|
||||
|
||||
|
|
@ -576,21 +607,6 @@ test (char *p)
|
|||
int
|
||||
main (int argc, char *argv[])
|
||||
{
|
||||
// main:
|
||||
// puts ("t.c\n");
|
||||
// if (argc == 0x22) return 11;
|
||||
// argc = 0x22;
|
||||
// goto main;
|
||||
// switch (0)
|
||||
// {
|
||||
// case 0: {goto next;}
|
||||
// // case 1: {goto next;}
|
||||
// // case 2: {goto next;}
|
||||
// // default: {goto next;}
|
||||
// }
|
||||
|
||||
// return 1;
|
||||
// next:
|
||||
char *p = "t.c\n";
|
||||
puts ("t.c\n");
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue