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

mescc: Handle && in if and while.

Browse source 
* scaffold/t.c (test): Add strcmp tests.
* module/language/c99/compiler.mes (expr->arg):
  (test->jump->info): New function.
  (ast->info): Use it.
* module/mes/libc-i386.mes (i386:global->accu):
  (i386:base-mem->accu): Rename from i386:mem->accu.
  (i386:byte-base-mem->accu): Rename from i386:base-mem->accu.
  (i386:accu-not, i386:global->accu, i386:xor-accu): New functions.
* module/mes/libc-i386.scm: Export them.
This commit is contained in:
Jan Nieuwenhuizen 2017-01-08 17:51:40 +01:00
parent 7667fb95c0
commit b98a2dda6e
6 changed files with 356 additions and 151 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
doc/examples/main.c
View file

@ -19,15 +19,29 @@
*/ */
#if __GNUC__ #if __GNUC__
void
exit (int code)
{
asm (
"movl %0,%%ebx\n\t"
"movl $1,%%eax\n\t"
"int $0x80"
: // no outputs "=" (r)
: "" (code)
);
// not reached
exit (0);
}
void void
write (int fd, char const* s, int n) write (int fd, char const* s, int n)
{ {
int r; int r;
//syscall (SYS_write, fd, s, n)); //syscall (SYS_write, fd, s, n));
asm ( asm (
"mov %0, %%ebx\n\t" "mov %0,%%ebx\n\t"
"mov %1, %%ecx\n\t" "mov %1,%%ecx\n\t"
"mov %2, %%edx\n\t" "mov %2,%%edx\n\t"
"mov $0x4, %%eax\n\t" "mov $0x4, %%eax\n\t"
"int $0x80\n\t" "int $0x80\n\t"
@ -37,20 +51,6 @@ write (int fd, char const* s, int n)
); );
} }
void
exit (int code)
{
asm (
"movl %0, %%ebx\n\t"
"movl $1, %%eax\n\t"
"int $0x80"
: // no outputs "=" (r)
: "" (code)
);
// not reached
exit (0);
}
#define STDOUT 1 #define STDOUT 1
typedef long size_t; typedef long size_t;
@ -84,9 +84,8 @@ int
//main () //main ()
main (int argc, char *argv[]) main (int argc, char *argv[])
{ {
int i = 0;
if (argc > 1 && !strcmp (argv[1], "--help")) puts ("argc > 1 && --help\n");
puts ("Hi Mes!\n"); puts ("Hi Mes!\n");
if (argc > 1 && !strcmp (argv[1], "--help")) return puts ("argc > 1 && --help\n");
return 42; return 42;
} }

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

@ -163,7 +163,7 @@
(append (append
((ident->base locals) name) ((ident->base locals) name)
(i386:value->accu (* size value)) ;; FIXME: type: int (i386:value->accu (* size value)) ;; FIXME: type: int
(i386:mem->accu) ;; FIXME: type: int (i386:base-mem->accu) ;; FIXME: type: int
(i386:push-accu) ;; hmm (i386:push-accu) ;; hmm
)))) ))))
@ -189,6 +189,7 @@
((p-expr (fixed ,value)) (string->number value)) ((p-expr (fixed ,value)) (string->number value))
((p-expr (ident ,name)) ((ident->accu (.locals info)) name)) ((p-expr (ident ,name)) ((ident->accu (.locals info)) name))
((fctn-call . _) ((ast->info info) `(expr-stmt ,o))) ((fctn-call . _) ((ast->info info) `(expr-stmt ,o)))
((not (fctn-call . _)) ((ast->info info) o))
((sub . _) ((ast->info info) o)) ;; FIXME: expr-stmt ((sub . _) ((ast->info info) o)) ;; FIXME: expr-stmt
(_ (_
(format (current-error-port) "SKIP expr->accu=~a\n" o) (format (current-error-port) "SKIP expr->accu=~a\n" o)
@ -215,6 +216,47 @@
(let ((s (string-drop o (string-length prefix)))) (let ((s (string-drop o (string-length prefix))))
(map byte->hex (string-split s #\space)))))) (map byte->hex (string-split s #\space))))))
(define (test->jump->info info)
(define (jump type)
(lambda (o)
(let* ((text (.text info))
(info (clone info #:text '()))
(info ((ast->info info) o))
(jump-text (lambda (body-length)
(list (lambda (f g t d) (type body-length))))))
(lambda (body-length)
(clone info #:text
(append text
(.text info)
(jump-text body-length)))))))
(lambda (o)
(pmatch o
((lt ,a ,b) ((jump i386:jump-nc) o))
((gt ,a ,b) ((jump i386:jump-nc) o))
((ne ,a ,b) ((jump i386:jump-nz) o))
((eq ,a ,b) ((jump i386:jump-nz) o))
((not _) ((jump i386:jump-z) o))
((and ,a ,b)
(let* ((text (.text info))
(info (clone info #:text '()))
(a-jump ((test->jump->info info) a))
(a-text (.text (a-jump 0)))
(a-length (length (text->list a-text)))
(b-jump ((test->jump->info info) b))
(b-text (.text (b-jump 0)))
(b-length (length (text->list b-text))))
(lambda (body-length)
(clone info #:text
(append text
(.text (a-jump (+ b-length body-length)))
(.text (b-jump body-length)))))))
((array-ref . _) ((jump i386:jump-byte-z) o))
((de-ref _) ((jump i386:jump-byte-z) o))
(_ ((jump i386:jump-z) o)))))
(define (ast->info info) (define (ast->info info)
(lambda (o) (lambda (o)
(let ((globals (.globals info)) (let ((globals (.globals info))
@ -237,6 +279,9 @@
(stderr "SKIP: #define ~s ~s\n" name value) (stderr "SKIP: #define ~s ~s\n" name value)
info) info)
;; ;
((expr-stmt) info)
((compd-stmt (block-item-list . ,statements)) ((ast-list->info info) statements)) ((compd-stmt (block-item-list . ,statements)) ((ast-list->info info) statements))
((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list))) ((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
@ -251,23 +296,23 @@
#:globals globals)))) #:globals globals))))
((if ,test ,body) ((if ,test ,body)
(let* ((jump (pmatch test (let* ((text-length (length text))
((lt ,a ,b) i386:jump-nc)
((gt ,a ,b) i386:jump-nc) (test-jump->info ((test->jump->info info) test))
(_ i386:jump-z))) (test+jump-info (test-jump->info 0))
(jump-text (lambda (body-length) (test-length (length (.text test+jump-info)))
(list (lambda (f g t d) (jump body-length)))))
(test-info ((ast->info info) test))
(test+jump-info (clone test-info #:text (append (.text test-info)
(jump-text 0))))
(text-length (length (.text test+jump-info)))
(body-info ((ast->info test+jump-info) body)) (body-info ((ast->info test+jump-info) body))
(body-text (list-tail (.text body-info) text-length)) (text-body-info (.text body-info))
(body-length (length (text->list body-text)))) (body-text (list-tail text-body-info test-length))
(body-length (length (text->list body-text)))
(text+test-text (.text (test-jump->info body-length)))
(test-text (list-tail text+test-text text-length)))
(clone info #:text (clone info #:text
(append (.text test-info) (append text
(jump-text body-length) test-text
body-text) body-text)
#:globals (.globals body-info)))) #:globals (.globals body-info))))
@ -311,30 +356,29 @@
#:locals locals))) #:locals locals)))
((while ,test ,body) ((while ,test ,body)
(let* ((jump (pmatch test (let* ((info (clone info #:text '()))
((lt ,a ,b) i386:jump-c)
((gt ,a ,b) i386:jump-c)
;;(_ i386:jump-nz)
(_ i386:jump-byte-nz) ;; FIXME
))
(jump-text (lambda (body-length)
(list (lambda (f g t d) (jump body-length)))))
(info (clone info #:text '()))
(body-info ((ast->info info) body)) (body-info ((ast->info info) body))
(body-text (.text body-info)) (body-text (.text body-info))
(body-length (length (text->list body-text))) (body-length (length (text->list body-text)))
(test-info ((ast->info info) test)) (test-jump->info ((test->jump->info info) test))
(test-text (.text test-info)) (test+jump-info (test-jump->info 0))
(test-length (length (text->list test-text)))) (test-length (length (text->list (.text test+jump-info))))
(skip-body-text (list (lambda (f g t d) (i386:jump (+ 2 body-length))))) ;; FIXME: 2
(jump-text (list (lambda (f g t d) (i386:jump (- (+ body-length test-length))))))
(jump-length (length (text->list jump-text)))
(test-text (.text (test-jump->info jump-length))))
(clone info #:text (clone info #:text
(append text (append text
(list (lambda (f g t d) (i386:jump (+ 2 body-length)))) ;; FIXME: 2 skip-body-text
body-text body-text
test-text test-text
(jump-text (- (+ body-length test-length)))) jump-text)
#:globals (.globals body-info)))) #:globals (.globals body-info))))
((labeled-stmt (ident ,label) ,statement) ((labeled-stmt (ident ,label) ,statement)
@ -361,15 +405,17 @@
(clone info #:text (clone info #:text
(append text (append text
(list (lambda (f g t d) (list (lambda (f g t d)
(append (i386:value->accu value) (append
(i386:accu-zero?)))))))) (i386:value->accu value)
(i386:accu-zero?))))))))
((de-ref (p-expr (ident ,name))) ((de-ref (p-expr (ident ,name)))
(clone info #:text (clone info #:text
(append text (append text
(list (lambda (f g t d) (list (lambda (f g t d)
(append (i386:local->accu (assoc-ref locals name)) (append
(i386:byte-mem->accu))))))) (i386:local->accu (assoc-ref locals name))
(i386:byte-mem->accu)))))))
((fctn-call . ,call) ((fctn-call . ,call)
(let ((info ((ast->info info) `(expr-stmt ,o)))) (let ((info ((ast->info info) `(expr-stmt ,o))))
@ -379,6 +425,14 @@
(i386:accu-zero?))))))) (i386:accu-zero?)))))))
;; FIXME ;; FIXME
;;((post-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
((post-inc (p-expr (ident ,name)))
(clone info #:text
(append text (list (lambda (f g t d)
(append
(i386:local->accu (assoc-ref locals name))
(i386:local-add (assoc-ref locals name) 1)
(i386:accu-zero?)))))))
((post-inc ,expr) ((ast->info info) `(expr-stmt ,o))) ((post-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
((post-dec ,expr) ((ast->info info) `(expr-stmt ,o))) ((post-dec ,expr) ((ast->info info) `(expr-stmt ,o)))
((pre-inc ,expr) ((ast->info info) `(expr-stmt ,o))) ((pre-inc ,expr) ((ast->info info) `(expr-stmt ,o)))
@ -388,73 +442,46 @@
((expr-stmt (post-inc (p-expr (ident ,name)))) ((expr-stmt (post-inc (p-expr (ident ,name))))
(clone info #:text (clone info #:text
(append text (list (lambda (f g t d) (append text (list (lambda (f g t d)
(append (i386:local->accu (assoc-ref locals name)) (i386:local-add (assoc-ref locals name) 1))))))
(i386:local-add (assoc-ref locals name) 1)
(i386:accu-zero?)))))))
;; ++i ;; ++i
((expr-stmt (pre-inc (p-expr (ident ,name)))) ((expr-stmt (pre-inc (p-expr (ident ,name))))
(clone info #:text (clone info #:text
(append text (list (lambda (f g t d) (append text (list (lambda (f g t d)
(append (i386:local-add (assoc-ref locals name) 1) (append
(i386:local->accu (assoc-ref locals name)) (i386:local-add (assoc-ref locals name) 1)
(i386:accu-zero?))))))) (i386:local->accu (assoc-ref locals name))
(i386:accu-zero?)))))))
;; i-- ;; i--
((expr-stmt (post-dec (p-expr (ident ,name)))) ((expr-stmt (post-dec (p-expr (ident ,name))))
(clone info #:text (clone info #:text
(append text (list (lambda (f g t d) (append text (list (lambda (f g t d)
(append (i386:local->accu (assoc-ref locals name)) (append
(i386:local-add (assoc-ref locals name) -1) (i386:local->accu (assoc-ref locals name))
(i386:accu-zero?))))))) (i386:local-add (assoc-ref locals name) -1)
(i386:accu-zero?)))))))
;; --i ;; --i
((expr-stmt (pre-dec (p-expr (ident ,name)))) ((expr-stmt (pre-dec (p-expr (ident ,name))))
(clone info #:text (clone info #:text
(append text (list (lambda (f g t d) (append text (list (lambda (f g t d)
(append (i386:local-add (assoc-ref locals name) -1) (append
(i386:local->accu (assoc-ref locals name)) (i386:local-add (assoc-ref locals name) -1)
(i386:accu-zero?))))))) (i386:local->accu (assoc-ref locals name))
(i386:accu-zero?)))))))
((not ,expr) ((not ,expr)
(let* ((test-info ((ast->info info) expr))) (let* ((test-info ((ast->info info) expr)))
(clone info #:text (clone info #:text
(append (.text test-info) (append (.text test-info)
(list (lambda (f g t d) (list (lambda (f g t d)
(i386:xor-zf)))) (append
(i386:accu-not)
(i386:accu-zero?)))))
#:globals (.globals test-info)))) #:globals (.globals test-info))))
((and ,a ,b) ((eq (p-expr (ident ,a)) (p-expr (fixed ,b)))
(let* ((info (clone info #:text '()))
(a-info ((ast->info info) a))
(a-text (.text a-info))
(a-length (length (text->list a-text)))
(b-info ((ast->info info) b))
(b-text (.text b-info))
(b-length (length (text->list b-text))))
(clone info #:text
(append text
a-text
(list (lambda (f g t d) (i386:jump-byte-z (+ b-length
2)))) ;; FIXME: need jump after last test
b-text))))
;; FIXME and, gt
((eq (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
(clone info #:text
(append text
(list (lambda (f g t d)
(append
(append (i386:local->accu (assoc-ref locals a))
(i386:byte-mem->base)
(i386:local->accu (assoc-ref locals b))
(i386:byte-mem->accu)
(i386:byte-test-base))))))))
((gt (p-expr (ident ,a)) (p-expr (fixed ,b)))
;; (stderr "GT: ~a > ~a\n" a b)
(let ((b (string->number b))) (let ((b (string->number b)))
(clone info #:text (clone info #:text
(append text (append text
@ -464,9 +491,60 @@
(i386:value->accu b) (i386:value->accu b)
(i386:sub-base)))))))) (i386:sub-base))))))))
((eq (fctn-call . ,call) (p-expr (fixed ,b)))
(let ((b (string->number b))
(info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
(clone info #:text
(append text
(.text info)
(list (lambda (f g t d)
(append
(i386:value->base b)
(i386:sub-base))))))))
((eq (p-expr (ident ,a)) (p-expr (fixed ,b))) ((eq (fctn-call . ,call) (p-expr (ident ,b)))
;;(stderr "EQ: ~a > ~a\n" a b) (let ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
(clone info #:text
(append text
(.text info)
(list (lambda (f g t d)
(append
(i386:local->base b)
(i386:sub-base))))))))
((eq (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
(clone info #:text
(append text
(list (lambda (f g t d)
(append
(i386:local->accu (assoc-ref locals a))
(i386:byte-mem->base)
(i386:local->accu (assoc-ref locals b))
(i386:byte-mem->accu)
(i386:byte-test-base)))))))
((gt (p-expr (ident ,a)) (p-expr (fixed ,b)))
(let ((b (string->number b)))
(clone info #:text
(append text
(list (lambda (f g t d)
(append
(i386:local->base (assoc-ref locals a))
(i386:value->accu b)
(i386:sub-base))))))))
((gt (p-expr (ident ,a)) (neg (p-expr (fixed ,b))))
(let ((b (- (string->number b))))
(clone info #:text
(append text
(list (lambda (f g t d)
(append
(i386:local->base (assoc-ref locals a))
(i386:value->accu b)
(i386:sub-base))))))))
((ne (p-expr (ident ,a)) (p-expr (fixed ,b)))
(let ((b (string->number b))) (let ((b (string->number b)))
(clone info #:text (clone info #:text
(append text (append text
@ -477,20 +555,42 @@
(i386:sub-base) (i386:sub-base)
(i386:xor-zf)))))))) (i386:xor-zf))))))))
((ne (fctn-call . ,call) (p-expr (fixed ,b)))
(let ((b (string->number b))
(info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
(clone info #:text
(append text
(.text info)
(list (lambda (f g t d)
(append
(i386:value->base b)
(i386:sub-base)
(i386:xor-zf))))))))
((ne (p-expr (ident ,a)) (p-expr (fixed ,b))) ((ne (fctn-call . ,call) (p-expr (ident ,b)))
;;(stderr "NE: ~a > ~a\n" a b) (let ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
(let ((b (string->number b))) (clone info #:text
(append text
(.text info)
(list (lambda (f g t d)
(append
(i386:local->base b)
(i386:sub-base)
(i386:xor-zf))))))))
((ne (de-ref (p-expr (ident ,a))) (de-ref (p-expr (ident ,b))))
(clone info #:text (clone info #:text
(append text (append text
(list (lambda (f g t d) (list (lambda (f g t d)
(append (append
(i386:local->base (assoc-ref locals a)) (i386:local->accu (assoc-ref locals a))
(i386:value->accu b) (i386:byte-mem->base)
(i386:sub-base)))))))) (i386:local->accu (assoc-ref locals b))
(i386:byte-mem->accu)
(i386:byte-test-base)
(i386:xor-zf)))))))
((lt (p-expr (ident ,a)) (p-expr (fixed ,b))) ((lt (p-expr (ident ,a)) (p-expr (fixed ,b)))
;;(stderr "LT: ~a < ~a\n" a b)
(let ((b (string->number b))) (let ((b (string->number b)))
(clone info #:text (clone info #:text
(append text (append text
@ -504,11 +604,12 @@
(clone info #:text (clone info #:text
(append text (append text
(list (lambda (f g t d) (list (lambda (f g t d)
(append (i386:local->accu (assoc-ref locals a)) (append
(i386:byte-mem->base) (i386:local->accu (assoc-ref locals a))
(i386:local->accu (assoc-ref locals b)) (i386:byte-mem->base)
(i386:byte-mem->accu) (i386:local->accu (assoc-ref locals b))
(i386:byte-sub-base))))))) (i386:byte-mem->accu)
(i386:byte-sub-base)))))))
((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)))
@ -517,7 +618,7 @@
(append (append
((ident->base locals) name) ((ident->base locals) name)
(i386:value->accu value) (i386:value->accu value)
(i386:byte-mem->accu)))))))) ; FIXME: type: char (i386:byte-base-mem->accu)))))))) ; FIXME: type: char
((array-ref (p-expr (ident ,name)) (p-expr (ident ,index))) ((array-ref (p-expr (ident ,name)) (p-expr (ident ,index)))
(clone info #:text (clone info #:text
@ -525,7 +626,7 @@
(append (append
((ident->base locals) name) ((ident->base locals) name)
((ident->accu locals) index) ((ident->accu locals) index)
(i386:byte-mem->accu))))))) ; FIXME: type: char (i386:byte-base-mem->accu))))))) ; FIXME: type: char
((return ,expr) ((return ,expr)
(let ((accu ((expr->accu info) expr))) (let ((accu ((expr->accu info) expr)))
@ -550,13 +651,27 @@
;; int i = argc; ;; int i = argc;
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local)))))) ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
(let ((locals (add-local name))) (let ((locals (add-local name)))
(clone info #:text (clone info #:text
(append text (list (lambda (f g t d) (append text (list (lambda (f g t d)
(append (append
((ident->accu locals) local) ((ident->accu locals) local)
((accu->ident locals) name))))) ((accu->ident locals) name)))))
#:locals locals))) #:locals locals)))
;; char *p = "t.c";
;;(decl (decl-spec-list (type-spec (fixed-type "char"))) (init-declr-list (init-declr (ptr-declr (pointer) (ident "p")) (initzer (p-expr (string "t.c\n"))))))
((decl (decl-spec-list (type-spec (fixed-type _))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)) (initzer (p-expr (string ,value))))))
(let ((locals (add-local name))
(globals (append globals (list (string->global value)))))
(clone info #:text
(append text
(list (lambda (f g t d)
(append
(i386:global->accu (+ (data-offset value g) d))
((accu->ident locals) name)))))
#:locals locals
#:globals globals)))
;; SCM i = argc; ;; SCM i = argc;
((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local)))))) ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (ident ,local))))))
(let ((locals (add-local name))) (let ((locals (add-local name)))

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

@ -34,6 +34,9 @@
(define (i386:ref-global o) (define (i386:ref-global o)
`(#x68 ,@(int->bv32 o))) ; push $0x<o> `(#x68 ,@(int->bv32 o))) ; push $0x<o>
(define (i386:global->accu o)
`(#xb8 ,@(int->bv32 o))) ; mov $<>,%eax
(define (i386:ref-local n) (define (i386:ref-local n)
(or n rl) (or n rl)
`(#xff #x75 ,(- 0 (* 4 n)))) ; pushl 0x<n>(%ebp) `(#xff #x75 ,(- 0 (* 4 n)))) ; pushl 0x<n>(%ebp)
@ -82,14 +85,17 @@
(or n lb) (or n lb)
`(#x8b #x55 ,(- 0 (* 4 n)))) ; mov -<0xn>(%ebp),%edx `(#x8b #x55 ,(- 0 (* 4 n)))) ; mov -<0xn>(%ebp),%edx
(define (i386:byte-mem->accu) (define (i386:byte-base-mem->accu)
'(#x01 #xd0 ; add %edx,%eax '(#x01 #xd0 ; add %edx,%eax
#x0f #xb6 #x00)) ; movzbl (%eax),%eax #x0f #xb6 #x00)) ; movzbl (%eax),%eax
(define (i386:byte-mem->accu)
'(#x0f #xb6 #x00)) ; movzbl (%eax),%eax
(define (i386:byte-mem->base) (define (i386:byte-mem->base)
'(#x0f #xb6 #x10)) ; movzbl (%eax),%edx '(#x0f #xb6 #x10)) ; movzbl (%eax),%edx
(define (i386:mem->accu) (define (i386:base-mem->accu)
'(#x01 #xd0 ; add %edx,%eax '(#x01 #xd0 ; add %edx,%eax
#x8b #x00)) ; mov (%eax),%eax #x8b #x00)) ; mov (%eax),%eax
@ -128,12 +134,19 @@
#x83 #xc4 ,(* n 4) ; add $00,%esp #x83 #xc4 ,(* n 4) ; add $00,%esp
))) )))
(define (i386:accu-not)
`(#x0f #x94 #xc0 ; sete %al
#x0f #xb6 #xc0)) ; movzbl %al,%eax
(define (i386:xor-accu v)
`(#x35 ,@(int->bv32 v))) ;xor $0xff,%eax
(define (i386:xor-zf) (define (i386:xor-zf)
'(#x9f ; lahf '(#x9f ; lahf
#x80 #xf4 #x40 ; xor $0x40,%ah #x80 #xf4 #x40 ; xor $0x40,%ah
#x9e)) ; sahf #x9e)) ; sahf
(define (i386:test-accu) (define (i386:accu-test)
'(#x85 #xc0)) ; test %eax,%eax '(#x85 #xc0)) ; test %eax,%eax
(define (i386:jump n) (define (i386:jump n)
@ -211,3 +224,45 @@
#xc9 ; leave #xc9 ; leave
#xc3 ; ret #xc3 ; ret
)) ))
#!
08048121 <strcmp>:
8048121: 55 push %ebp
8048122: 89 e5 mov %esp,%ebp
8048124: 83 ec 10 sub $0x10,%esp
8048127: eb 08 jmp 8048131 <strcmp+0x10>
<body>
8048129: 83 45 08 01 addl $0x1,0x8(%ebp)
804812d: 83 45 0c 01 addl $0x1,0xc(%ebp)
<test> *a
8048131: 8b 45 08 mov 0x8(%ebp),%eax
8048134: 0f b6 00 movzbl (%eax),%eax
8048137: 84 c0 test %al,%al
8048139: 74 08 je 8048143 <strcmp+0x22>
<test1> *b
804813b: 8b 45 0c mov 0xc(%ebp),%eax
804813e: 0f b6 00 movzbl (%eax),%eax
8048141: 84 c0 test %al,%al
8048143: 74 10 je 8048155 <strcmp+0x34>
<test2> *a == *b
8048145: 8b 45 08 mov 0x8(%ebp),%eax
8048148: 0f b6 10 movzbl (%eax),%edx
804814b: 8b 45 0c mov 0xc(%ebp),%eax
804814e: 0f b6 00 movzbl (%eax),%eax
8048151: 38 c2 cmp %al,%dl
8048153: 84 c0 test %al,%al
8048155: 75 d2 jne 8048129 <strcmp+0x8>
8048157: 8b 45 08 mov 0x8(%ebp),%eax
804815a: 0f b6 10 movzbl (%eax),%edx
804815d: 8b 45 0c mov 0xc(%ebp),%eax
8048160: 0f b6 00 movzbl (%eax),%eax
8048163: 28 d0 sub %dl,%al
8048165: c9 leave
8048166: c3 ret
!#

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

@ -28,11 +28,15 @@
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (mes elf) #:use-module (mes elf)
#:export ( #:export (
i386:accu-not
i386:accu->local i386:accu->local
i386:accu-non-zero? i386:accu-non-zero?
i386:accu-test
i386:accu-zero? i386:accu-zero?
i386:base-sub i386:base-sub
i386:base-mem->accu
i386:byte-base-sub i386:byte-base-sub
i386:byte-base-mem->accu
i386:byte-mem->accu i386:byte-mem->accu
i386:byte-mem->base i386:byte-mem->base
i386:byte-test-base i386:byte-test-base
@ -41,6 +45,7 @@
i386:formal i386:formal
i386:function-locals i386:function-locals
i386:function-preamble i386:function-preamble
i386:global->accu
i386:jump i386:jump
i386:jump i386:jump
i386:jump-byte-nz i386:jump-byte-nz
@ -57,18 +62,17 @@
i386:local-add i386:local-add
i386:local-assign i386:local-assign
i386:local-test i386:local-test
i386:mem->accu
i386:push-accu i386:push-accu
i386:ref-global i386:ref-global
i386:ref-local i386:ref-local
i386:ret i386:ret
i386:ret-local i386:ret-local
i386:sub-base i386:sub-base
i386:test-accu
i386:test-base i386:test-base
i386:test-jump-z i386:test-jump-z
i386:value->accu i386:value->accu
i386:value->base i386:value->base
i386:xor-accu
i386:xor-zf i386:xor-zf
;; libc ;; libc

33
scaffold/micro-mes.c
View file

@ -41,7 +41,7 @@ void
exit (int code) exit (int code)
{ {
asm ( asm (
"movl $0,%%ebx\n\t" "movl %0,%%ebx\n\t"
"movl $1,%%eax\n\t" "movl $1,%%eax\n\t"
"int $0x80" "int $0x80"
: // no outputs "=" (r) : // no outputs "=" (r)
@ -51,6 +51,12 @@ exit (int code)
exit (0); exit (0);
} }
char const*
getenv (char const* p)
{
return 0;
}
int int
open (char const *s, int mode) open (char const *s, int mode)
{ {
@ -74,7 +80,8 @@ write (int fd, char const* s, int n)
"mov %0,%%ebx\n\t" "mov %0,%%ebx\n\t"
"mov %1,%%ecx\n\t" "mov %1,%%ecx\n\t"
"mov %2,%%edx\n\t" "mov %2,%%edx\n\t"
"mov $0x4,%%eax\n\t"
"mov $0x4, %%eax\n\t"
"int $0x80\n\t" "int $0x80\n\t"
: // no outputs "=" (r) : // no outputs "=" (r)
: "" (fd), "" (s), "" (n) : "" (fd), "" (s), "" (n)
@ -151,7 +158,6 @@ eputs (char const* s)
return 0; return 0;
} }
#if __GNUC__
char const* char const*
itoa (int x) itoa (int x)
{ {
@ -174,7 +180,6 @@ itoa (int x)
return p+1; return p+1;
} }
#endif
void void
assert_fail (char* s) assert_fail (char* s)
@ -187,14 +192,10 @@ assert_fail (char* s)
#endif #endif
#define assert(x) ((x) ? (void)0 : assert_fail(#x)) #define assert(x) ((x) ? (void)0 : assert_fail(#x))
#define false 0
#define true 1
typedef int bool;
typedef int SCM; typedef int SCM;
#if __GNUC__ #if __GNUC__
bool g_debug = false; int g_debug = 0;
#endif #endif
int g_free = 0; int g_free = 0;
@ -222,18 +223,8 @@ bload_env (SCM a) ///((internal))
int int
main (int argc, char *argv[]) main (int argc, char *argv[])
{ {
puts ("arg0=");
puts (argv[0]);
if (argc > 1)
{
puts ("\narg1=");
puts (argv[1]);
if (!strcmp (argv[1], "--help")) /*return*/ puts ("XXUsage: mes [--dump|--load] < FILE");
}
puts ("\n");
#if __GNUC__ #if __GNUC__
//g_debug = getenv ("MES_DEBUG"); g_debug = (int)getenv ("MES_DEBUG");
#endif #endif
//if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA")); //if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
@ -246,8 +237,8 @@ main (int argc, char *argv[])
#endif #endif
#if MES_MINI #if MES_MINI
SCM program = bload_env (r0);
puts ("Hello micro-mes!\n"); puts ("Hello micro-mes!\n");
SCM program = bload_env (r0);
#else #else
SCM program = (argc > 1 && !strcmp (argv[1], "--load")) SCM program = (argc > 1 && !strcmp (argv[1], "--load"))
? bload_env (r0) : load_env (r0); ? bload_env (r0) : load_env (r0);

49
scaffold/t.c
View file

@ -78,18 +78,27 @@ strcmp (char const* a, char const* b)
while (*a && *b && *a == *b) {a++;b++;} while (*a && *b && *a == *b) {a++;b++;}
return *a - *b; return *a - *b;
} }
int test (); int test (char *p);
#endif #endif
int int
main (int argc, char *argv[]) main (int argc, char *argv[])
{ {
char *p = "t.c\n";
puts ("t.c\n"); puts ("t.c\n");
return test ();
if (argc > 1 && !strcmp (argv[1], "--help")) return 1;
puts ("t: if (argc > 1 && !strcmp (argv[1], \"--help\")\n");
// FIXME mescc?!
if (argc > 1) if (!strcmp (argv[1], "--help")) return 1;
return test (p);
return 22;
} }
int int
test () test (char *p)
{ {
int f = 0; int f = 0;
int t = 1; int t = 1;
@ -107,9 +116,21 @@ test ()
puts ("t: if (one < 0)\n"); puts ("t: if (one < 0)\n");
if (one < 0) return 1; if (one < 0) return 1;
puts ("t: stlrlen (\"\")\n"); puts ("t: if (strlen (\"\"))\n");
if (strlen ("")) return 1; if (strlen ("")) return 1;
puts ("t: if (strlen (p) != 4)\n");
if (strlen (p) != 4) return 1;
puts ("t: if (!strlen (\".\"))\n");
if (!strlen (".")) return 1;
puts ("t: if (strcmp (p, \"foo\"))\n");
if (!strcmp (p, "foo")) return 1;
puts ("t: if (strcmp (p, \"t.c\\n\"))\n");
if (strcmp (p, "t.c\n")) return 1;
puts ("t: if (!1)\n"); puts ("t: if (!1)\n");
if (!1) return 1; if (!1) return 1;
@ -122,6 +143,12 @@ test ()
puts ("t: if (1 && 0)\n"); puts ("t: if (1 && 0)\n");
if (1 && 0) return 1; if (1 && 0) return 1;
puts ("t: if (!t && f)\n");
if (!t && f) return 1;
puts ("t: if (t && !one)\n");
if (t && !one) return 1;
int i=0; int i=0;
puts ("t: if (i++)\n"); puts ("t: if (i++)\n");
if (i++) return 1; if (i++) return 1;
@ -154,6 +181,20 @@ test ()
return 1; return 1;
ok4: ok4:
puts ("t: if (strlen (p) == 4)\n");
if (strlen (p) == 4) goto ok40;
ok40:
puts ("t: if (!strcmp (p, \"t.c\\n\"))\n");
if (!strcmp (p, "t.c\n")) goto ok41;
return 1;
ok41:
puts ("t: if (strcmp (p, \"foo\"))\n");
if (strcmp (p, "foo")) goto ok42;
return 1;
ok42:
puts ("t: if (!0)\n"); puts ("t: if (!0)\n");
if (!0) goto ok5; if (!0) goto ok5;
return 1; return 1;