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

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

@ -80,6 +80,7 @@
(define (ident-ref locals)
(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))))
(define (global-ref symbols)
@ -95,12 +96,13 @@
((p-expr (ident ,name)) ((ident-ref locals) 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)
(append
((ident->base locals) name)
(i386:local-assign (assoc-ref locals name) value)
(i386:mem-byte->accu)
(i386:value->accu (* size value)) ;; FIXME: type: int
(i386:mem->accu) ;; FIXME: type: int
(i386:push-accu) ;; hmm
))))
@ -238,8 +240,8 @@
(lambda (s t d)
(append
((ident->base locals) name)
(i386:local-assign (assoc-ref locals name) value)
(i386:mem-byte->accu)))))
(i386:value->accu value)
(i386:mem-byte->accu))))) ; FIXME: type: char
symbols
locals)))
@ -252,7 +254,7 @@
(append
((ident->base locals) name)
((ident->accu locals) index)
(i386:mem-byte->accu)))))
(i386:mem-byte->accu))))) ; FIXME: type: char
symbols
locals))
@ -269,29 +271,7 @@
symbols
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))))
(let ((locals (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals)))
(make-text+symbols+locals text symbols locals)))
@ -306,6 +286,33 @@
symbols
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)))))
(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))
@ -321,10 +328,9 @@
symbols
locals))))
;; i = 0;
((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (p-expr (fixed ,value))))
;;(stderr "RET LOCAL[~a]: ~a\n" name (assoc-ref locals name))
(let ((value (string->number value)))
(make-text+symbols+locals
(append text (list (lambda (s t d) (i386:local-assign (assoc-ref locals name) value))))
@ -379,7 +385,8 @@
(pmatch o
((param-list . ,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)
barf)))
@ -388,11 +395,13 @@
(define (function->symbols symbols)
(lambda (o)
;;(stderr "\n")
(format (current-error-port) "compiling ~a\n" (.name o))
;;(stderr "formals=~a\n" (.formals o))
(let* ((text (formals->text (.formals o)))
(locals (formals->locals (.formals o)))
(text-offset (length (symbols->text symbols 0 0))))
;;(stderr "locals=~a\n" locals)
(let loop ((statements (.statements o))
(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))))
@ -475,8 +484,8 @@ fputs (char const* s, int fd)
int
puts (char const* s)
{
//write (STDERR, s, strlen (s));
//int i = write (STDERR, 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;

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

@ -81,6 +81,13 @@
'(#x01 #xd0 ; add %edx,%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)
`(#x83 #x45 ,(- 0 (* 4 n)) ,v)) ; addl $<v>,0x<n>(%ebp)
@ -94,7 +101,7 @@
))
(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))
(n (length arguments)))
`(
@ -136,9 +143,9 @@
#x55 ; push %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 #x55 #x08 ; mov $0x4(%ebp),%edx
#x8b #x55 #x10 ; mov $0x4(%ebp),%edx
#xb8 #x04 #x00 #x00 #x00 ; mov $0x4,%eax
#xcd #x80 ; int $0x80

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

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

46
scaffold/micro-mes.c
View file

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