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

mescc: Have micro-mes use if not to segfault.

Browse source 
* module/language/c99/compiler.mes (write-any): Check explicitly on
  number?, report error otherwise.
  (statement->text+symbols+locals): Remove statement-offset.
  Handle compounds.  Handle very specific if.
  (function->symbols): Remove unused text-offset.
* doc/examples/micro-mes.c (main): If argc > 1 print argv1.  Fixes
  segfault :-)
* module/mes/elf-util.mes (symbols->text): Loop rather than map,
  feed text-offset.
* module/mes/libc-i386.mes (i386:local-test, i386:jump-le): New
  functions.
* module/mes/libc-i386.scm: Export them.
This commit is contained in:
Jan Nieuwenhuizen 2017-01-03 18:22:56 +01:00
parent 296449c615
commit 38dc229a01
5 changed files with 60 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -58,7 +58,9 @@
))
(define (write-any x)
(write-char (if (char? x) x (integer->char (if (>= x 0) x (+ x 256))))))
(write-char (cond ((char? x) x)
((number? x) (integer->char (if (>= x 0) x (+ x 256))))
(else (stderr "write-any: ~a\n" x) barf))))
(define (ast:function? o)
(and (pair? o) (eq? (car o) 'fctn-defn)))
@ -167,10 +169,7 @@
;;(stderr "S=~a\n" o)
(let* ((text (.text text+symbols+locals))
(symbols (.symbols text+symbols+locals))
(locals (.locals text+symbols+locals))
(text-list (text->list text))
(prefix-list (symbols->text symbols 0 0))
(statement-offset (- (+ (length prefix-list) (length text-list)))))
(locals (.locals text+symbols+locals)))
;; (stderr " tsl=~a\n" text+symbols+locals)
;; (stderr " locals=~s\n" locals)
(pmatch o
@ -190,8 +189,7 @@
(append text
(list (lambda (s t d)
(i386:call s t d
(+ t (function-offset name s)
statement-offset)
(+ t (function-offset name s))
(+ d (data-offset string s))))))
(append symbols (list (string->symbols string)))
locals)))
@ -202,10 +200,40 @@
(args (map (expr->arg symbols locals) expr-list)))
(make-text+symbols+locals
(append text
(list (lambda (s t d) (apply i386:call (cons* s t d (+ t (function-offset name s) statement-offset) args)))))
(list (lambda (s t d) (apply i386:call (cons* s t d (+ t (function-offset name s)) args)))))
symbols
locals)))
((compd-stmt (block-item-list . ,statements))
(let loop ((statements statements)
(text+symbols+locals (make-text+symbols+locals text symbols locals)))
(if (null? statements) text+symbols+locals
(let* ((statement (car statements))
(r ((statement->text+symbols+locals text+symbols+locals) statement)))
(loop (cdr statements) r)))))
((if (gt (p-expr (ident ,name)) (p-expr (fixed ,value))) ,body)
(let* ((value (string->number value))
(t+s+l (make-text+symbols+locals '() symbols locals))
(body-t+s+l ((statement->text+symbols+locals t+s+l) body))
(body-text (.text body-t+s+l))
;;(body-symbols (.symbols body-t+s+l))
(symbols (.symbols body-t+s+l))
(body-locals (.locals body-t+s+l))
(body-length (length (text->list body-text))))
(make-text+symbols+locals
(append text
(list (lambda (s t d)
(append
(i386:local-test (assoc-ref locals name) value)
(i386:jump-le body-length))))
body-text)
symbols
locals)))
((while ,test ,body)
(let* ((t+s+l (make-text+symbols+locals '() symbols locals))
@ -227,7 +255,7 @@
(list (lambda (s t d) (i386:jump body-length)))
body-text
test-text
(list (lambda (s t d) (i386:test-jump (- (+ body-length test-length))))))
(list (lambda (s t d) (i386:jump-nz (- (+ body-length test-length))))))
symbols
locals)))
@ -399,8 +427,7 @@
(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))))
(locals (formals->locals (.formals o))))
;;(stderr "locals=~a\n" locals)
(let loop ((statements (.statements o))
(text+symbols+locals (make-text+symbols+locals text symbols locals)))

5
module/mes/elf-util.mes
View file

@ -53,7 +53,10 @@
(append-map cdr (filter function-symbol? (map cdr symbols))))
(define (symbols->text symbols t d)
(append-map (lambda (f) (f symbols t d)) (symbols->functions symbols)))
(let loop ((functions (symbols->functions symbols)) (text '()))
(if (null? functions) text
(loop (cdr functions)
(append text ((car functions) symbols (- (length text)) d))))))
(define (function-offset name symbols)
(let* ((functions (filter function-entry? symbols))

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

@ -95,6 +95,9 @@
`(#xc7 #x45 ,(- 0 (* 4 n)) ; movl $<v>,0x<n>(%ebp)
,@(int->bv32 v)))
(define (i386:local-test n v)
`(#x83 #x7d ,(- 0 (* 4 n)) ,v)) ; cmpl $<v>,0x<n>(%ebp)
(define (i386:ret-local n)
`(
#x89 #x45 ,(- 0 (* 4 n)) ; mov %eax,-0x<n>(%ebp)
@ -157,7 +160,10 @@
(define (i386:jump n)
`(#xeb ,(if (>= n 0) n (- n 2)))) ; jmp <n>
(define (i386:test-jump n)
(define (i386:jump-le n)
`(#x7e ,(if (>= n 0) n (- n 4)))) ; jle <n>
(define (i386:jump-nz n)
`(#x84 #xc0 ; test %al,%al
#x75 ,(if (>= n 0) n (- n 4)))) ; jne <n>
@ -165,7 +171,8 @@
int
strcmp (char const* a, char const* b)
{
while (*a && *b && *a == *b) {*a++;b++;}
while (*a && *b && *a == *b) {*a++;b++;
}
return *a == *b;
}
08048150 <strcmp>:
@ -208,4 +215,3 @@ strcmp (char const* a, char const* b)
804819a: 5d pop %ebp
804819b: c3 ret
!#

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

@ -35,10 +35,13 @@
i386:function-locals
i386:eputs
i386:jump
i386:jump-nz
i386:jump-le
i386:local-add
i386:local-assign
i386:local->accu
i386:local->base
i386:local-test
i386:mem->accu
i386:mem-byte->accu
i386:push-accu
@ -47,7 +50,6 @@
i386:ref-local
i386:ret
i386:ret-local
i386:test-jump
i386:value->accu
i386:write
))

7
scaffold/micro-mes.c
View file

@ -220,8 +220,11 @@ main (int argc, char *argv[])
{
puts ("arg0=");
puts (argv[0]);
puts ("\narg1=");
puts (argv[1]);
if (argc > 1)
{
puts ("\narg1=");
puts (argv[1]);
}
puts ("\n");
eputs ("Strlen...\n");
puts ("Bye micro\n");