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

mescc: Have micro-mes print argv.

Browse source 
* module/language/c99/compiler.mes (expr->arg): Bugfix argv: Use
  size=4 (int).
  (statement->text+symbols+locals): Bugfixes: array-ref, initialize with
  immediate, initialize with local.
  (formals->locals): Bugfix: formals counted down from -1 [WAS: down to
  -1].
* module/mes/libc-i386.mes (i386:call): Reverse args pushes to match
  formals index changes.
  (i386:write): Update for changed formals push order.
  (i386:mem->accu, i386:value->accu): New functions.
* module/mes/libc-i386.scm (mes): Export them.
* doc/examples/micro-mes.c (eputs, puts, fputs): Make identical with
  mescc's implementations.
  (main): Print argv[0] and (unconditionally; crash if not given) argv[1].
This commit is contained in:
Jan Nieuwenhuizen 2017-01-03 12:33:34 +01:00
parent 01177f7324
commit 296449c615
4 changed files with 92 additions and 60 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -80,6 +80,7 @@
(define (ident-ref locals) (define (ident-ref locals)
(lambda (o) (lambda (o)
;; (stderr "IDENT REF[~a]: ~a => ~a\n" o (assoc-ref locals o) (i386:ref-local (assoc-ref locals o)))
(i386:ref-local (assoc-ref locals o)))) (i386:ref-local (assoc-ref locals o))))
(define (global-ref symbols) (define (global-ref symbols)
@ -95,12 +96,13 @@
((p-expr (ident ,name)) ((ident-ref locals) name)) ((p-expr (ident ,name)) ((ident-ref locals) name))
((array-ref (p-expr (fixed ,value)) (p-expr (ident ,name))) ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,name)))
(let ((value (string->number value))) (let ((value (string->number value))
(size 4)) ;; FIXME: type: int
(lambda (s t d) (lambda (s t d)
(append (append
((ident->base locals) name) ((ident->base locals) name)
(i386:local-assign (assoc-ref locals name) value) (i386:value->accu (* size value)) ;; FIXME: type: int
(i386:mem-byte->accu) (i386:mem->accu) ;; FIXME: type: int
(i386:push-accu) ;; hmm (i386:push-accu) ;; hmm
)))) ))))
@ -238,8 +240,8 @@
(lambda (s t d) (lambda (s t d)
(append (append
((ident->base locals) name) ((ident->base locals) name)
(i386:local-assign (assoc-ref locals name) value) (i386:value->accu value)
(i386:mem-byte->accu))))) (i386:mem-byte->accu))))) ; FIXME: type: char
symbols symbols
locals))) locals)))
@ -252,7 +254,7 @@
(append (append
((ident->base locals) name) ((ident->base locals) name)
((ident->accu locals) index) ((ident->accu locals) index)
(i386:mem-byte->accu))))) (i386:mem-byte->accu))))) ; FIXME: type: char
symbols symbols
locals)) locals))
@ -264,34 +266,12 @@
locals)) locals))
((return ,expr) ((return ,expr)
(make-text+symbols+locals (make-text+symbols+locals
(append text (list (i386:ret ((expr->accu symbols locals) expr)))) (append text (list (i386:ret ((expr->accu symbols locals) expr))))
symbols symbols
locals)) locals))
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)))
(make-text+symbols+locals
(append
text
(list (lambda (s t d)
((ident->accu locals) local)
((accu->ident locals) name))))
symbols
locals)))
((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)))
(make-text+symbols+locals
(append
text
((ident->accu locals) name)
(list (lambda (s t d)
((ident->accu locals) local)
((accu->ident locals) name))))
symbols
locals)))
;; int i;
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name)))) ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals))) (let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)))
(make-text+symbols+locals text symbols locals))) (make-text+symbols+locals text symbols locals)))
@ -306,6 +286,33 @@
symbols symbols
locals))) locals)))
;; int i = argc;
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)))
(make-text+symbols+locals
(append
text
(list (lambda (s t d)
(append
((ident->accu locals) local)
((accu->ident locals) name)))))
symbols
locals)))
;; SCM i = argc;
((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)))
(make-text+symbols+locals
(append
text
(list (lambda (s t d)
(append
((ident->accu locals) local)
((accu->ident locals) name)))))
symbols
locals)))
;; int i = f ();
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (fctn-call . ,call))))) ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (fctn-call . ,call)))))
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals))) (let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)))
(let* ((t+s+l (make-text+symbols+locals text symbols locals)) (let* ((t+s+l (make-text+symbols+locals text symbols locals))
@ -321,10 +328,9 @@
symbols symbols
locals)))) locals))))
;; i = 0;
((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (p-expr (fixed ,value)))) ((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (p-expr (fixed ,value))))
;;(stderr "RET LOCAL[~a]: ~a\n" name (assoc-ref locals name)) ;;(stderr "RET LOCAL[~a]: ~a\n" name (assoc-ref locals name))
(let ((value (string->number value))) (let ((value (string->number value)))
(make-text+symbols+locals (make-text+symbols+locals
(append text (list (lambda (s t d) (i386:local-assign (assoc-ref locals name) value)))) (append text (list (lambda (s t d) (i386:local-assign (assoc-ref locals name) value))))
@ -342,9 +348,9 @@
symbols symbols
locals))) locals)))
(_ (_
(format (current-error-port) "SKIP statement=~a\n" o) (format (current-error-port) "SKIP statement=~a\n" o)
text+symbols+locals))))) text+symbols+locals)))))
(define (symbols->exe symbols) (define (symbols->exe symbols)
(display "dumping elf\n" (current-error-port)) (display "dumping elf\n" (current-error-port))
@ -379,7 +385,8 @@
(pmatch o (pmatch o
((param-list . ,formals) ((param-list . ,formals)
(let ((n (length formals))) (let ((n (length formals)))
(map cons (map .name formals) (iota n (1- (- n)))))) ;;(stderr "FORMALS: ~a ==> ~a\n" formals n)
(map cons (map .name formals) (iota n -2 -1))))
(_ (format (current-error-port) "formals->symbols: no match: ~a\n" o) (_ (format (current-error-port) "formals->symbols: no match: ~a\n" o)
barf))) barf)))
@ -388,11 +395,13 @@
(define (function->symbols symbols) (define (function->symbols symbols)
(lambda (o) (lambda (o)
;;(stderr "\n")
(format (current-error-port) "compiling ~a\n" (.name o)) (format (current-error-port) "compiling ~a\n" (.name o))
;;(stderr "formals=~a\n" (.formals o)) ;;(stderr "formals=~a\n" (.formals o))
(let* ((text (formals->text (.formals o))) (let* ((text (formals->text (.formals o)))
(locals (formals->locals (.formals o))) (locals (formals->locals (.formals o)))
(text-offset (length (symbols->text symbols 0 0)))) (text-offset (length (symbols->text symbols 0 0))))
;;(stderr "locals=~a\n" locals)
(let loop ((statements (.statements o)) (let loop ((statements (.statements o))
(text+symbols+locals (make-text+symbols+locals text symbols locals))) (text+symbols+locals (make-text+symbols+locals text symbols locals)))
(if (null? statements) (append (.symbols text+symbols+locals) (list (make-function (.name o) (.text text+symbols+locals)))) (if (null? statements) (append (.symbols text+symbols+locals) (list (make-function (.name o) (.text text+symbols+locals))))
@ -475,8 +484,8 @@ fputs (char const* s, int fd)
int int
puts (char const* s) puts (char const* s)
{ {
//write (STDERR, s, strlen (s)); //write (STDOUT, s, strlen (s));
//int i = write (STDERR, s, strlen (s)); //int i = write (STDOUT, s, strlen (s));
int i = strlen (s); int i = strlen (s);
write (1, s, i); write (1, s, i);
return 0; return 0;

13
module/mes/libc-i386.mes
View file

@ -81,6 +81,13 @@
'(#x01 #xd0 ; add %edx,%eax '(#x01 #xd0 ; add %edx,%eax
#x0f #xb6 #x00)) ; movzbl (%eax),%eax #x0f #xb6 #x00)) ; movzbl (%eax),%eax
(define (i386:mem->accu)
'(#x01 #xd0 ; add %edx,%eax
#x8b #x00)) ; mov (%eax),%eax
(define (i386:value->accu v)
`(#xb8 ,@(int->bv32 v))) ; mov $<v>,%eax
(define (i386:local-add n v) (define (i386:local-add n v)
`(#x83 #x45 ,(- 0 (* 4 n)) ,v)) ; addl $<v>,0x<n>(%ebp) `(#x83 #x45 ,(- 0 (* 4 n)) ,v)) ; addl $<v>,0x<n>(%ebp)
@ -94,7 +101,7 @@
)) ))
(define (i386:call s t d address . arguments) (define (i386:call s t d address . arguments)
(let* ((pushes (append-map (i386:push-arg s t d) arguments)) (let* ((pushes (append-map (i386:push-arg s t d) (reverse arguments)))
(s (length pushes)) (s (length pushes))
(n (length arguments))) (n (length arguments)))
`( `(
@ -136,9 +143,9 @@
#x55 ; push %ebp #x55 ; push %ebp
#x89 #xe5 ; mov %esp,%ebp #x89 #xe5 ; mov %esp,%ebp
#x8b #x5d #x10 ; mov $0x8(%ebp),%ebx #x8b #x5d #x08 ; mov $0x8(%ebp),%ebx
#x8b #x4d #x0c ; mov $0xc(%ebp),%ecx #x8b #x4d #x0c ; mov $0xc(%ebp),%ecx
#x8b #x55 #x08 ; mov $0x4(%ebp),%edx #x8b #x55 #x10 ; mov $0x4(%ebp),%edx
#xb8 #x04 #x00 #x00 #x00 ; mov $0x4,%eax #xb8 #x04 #x00 #x00 #x00 ; mov $0x4,%eax
#xcd #x80 ; int $0x80 #xcd #x80 ; int $0x80

2
module/mes/libc-i386.scm
View file

@ -39,6 +39,7 @@
i386:local-assign i386:local-assign
i386:local->accu i386:local->accu
i386:local->base i386:local->base
i386:mem->accu
i386:mem-byte->accu i386:mem-byte->accu
i386:push-accu i386:push-accu
i386:puts i386:puts
@ -47,6 +48,7 @@
i386:ret i386:ret
i386:ret-local i386:ret-local
i386:test-jump i386:test-jump
i386:value->accu
i386:write i386:write
)) ))

46
scaffold/micro-mes.c
View file

@ -137,14 +137,20 @@ getc ()
int int
puts (char const* s) puts (char const* s)
{ {
write (STDOUT, s, strlen (s)); //write (STDOUT, s, strlen (s));
//int i = write (STDOUT, s, strlen (s));
int i = strlen (s);
write (1, s, i);
return 0; return 0;
} }
int int
eputs (char const* s) eputs (char const* s)
{ {
write (STDERR, s, strlen (s)); //write (STDERR, s, strlen (s));
//int i = write (STDERR, s, strlen (s));
int i = strlen (s);
write (2, s, i);
return 0; return 0;
} }
@ -212,10 +218,13 @@ typedef int bool;
int int
main (int argc, char *argv[]) main (int argc, char *argv[])
{ {
puts ("Hello main!\n"); puts ("arg0=");
puts (argv[0]);
puts ("\narg1=");
puts (argv[1]);
puts ("\n");
eputs ("Strlen...\n"); eputs ("Strlen...\n");
puts ("Bye micro\n"); puts ("Bye micro\n");
int i = strlen ("02013");
int i = argc; int i = argc;
return i; return i;
} }
@ -238,17 +247,22 @@ main (int argc, char *argv[])
void void
_start () _start ()
{ {
puts ("Hello micro-mes!\n"); int r;
int i; asm (
i = main (0,0); "mov %%ebp,%%eax\n\t"
// asm ( "addl $8,%%eax\n\t"
// "push $0\n\t" "push %%eax\n\t"
// "push $0\n\t"
// "call main\n\t" "mov %%ebp,%%eax\n\t"
// "movl %%eax,%0\n\t" "addl $4,%%eax\n\t"
// : "=r" (r) "movzbl (%%eax),%%eax\n\t"
// : //no inputs "" (&main) "push %%eax\n\t"
// );
exit (i); "call main\n\t"
"movl %%eax,%0\n\t"
: "=r" (r)
: //no inputs "" (&main)
);
exit (r);
} }
#endif #endif