mescc: Have micro-mes use strcmp to print help.
authorJan Nieuwenhuizen <janneke@gnu.org>
Thu, 5 Jan 2017 23:20:05 +0000 (00:20 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Thu, 5 Jan 2017 23:20:05 +0000 (00:20 +0100)
* doc/examples/micro-mes.c (main): Add --help.
* module/language/c99/compiler.mes (info?): New function.
  (expr->accu): Handle function call and sub.
  (ast->info): Handle if not, and, de-ref, eq, sub, return f ().
* module/mes/libc-i386.mes (i386:accu-zero?, i386:Xmem-byte->accu,
  i386:Xmem-byte->base, i386:jump-byte-nz, i386:jump-byte-z,
  i386:test-byte-base, i386:Xjump-byte-z, i386:sub-byte-base): New
  functions.
* module/mes/libc-i386.scm: Export them.

module/language/c99/compiler.mes
module/mes/libc-i386.mes
module/mes/libc-i386.scm
scaffold/micro-mes.c

index 7388bec53e7491bdcc7bb5a8c2930efe972a2ca7..f8106e660ef97dbf6cf0bfa0127baa496d89f5c1 100644 (file)
     (pmatch o
       ((p-expr (fixed ,value)) (string->number value))
       ((p-expr (ident ,name)) ((ident->accu (.locals info)) name))
+      ((fctn-call . _) ((ast->info info) `(expr-stmt ,o)))
+      ((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)
        0)
       )))
 
         ((fctn-defn . _) ((function->info info) o))
         ((comment . _) info)
         ((cpp-stmt (define (name ,name) (repl ,value)))
-         (stderr "SKIP: #define ~a ~a\n" name value)
+         (stderr "SKIP: #define ~s ~s\n" name value)
          info)
 
         ((compd-stmt (block-item-list . ,statements)) ((ast-list->info info) statements))
                           body-text)
                   #:globals (.globals body-info))))
 
+        ((if (not (fctn-call . ,call)) ,body)
+         (let* ((call-info ((ast->info info) `(expr-stmt (fctn-call . ,call))))
+                (info (clone info #:text '()))
+                (body-info ((ast->info info) body))
+                (body-text (.text body-info))
+                (body-length (length (text->list body-text))))
+
+           (clone info #:text
+                  (append (.text call-info)
+                          (list (lambda (f g t d)
+                                  (append
+                                   ;;(i386:local-test (assoc-ref locals name) 0)
+                                   ;;(i386:accu-test (assoc-ref locals name) 0)
+                                   (i386:jump-nz body-length))))
+                          body-text)
+                  #:globals (append (.globals call-info)
+                                    (.globals body-info)))))
+
         (;;(for ,init ,test ,step ,body)
          (for ,init
               ;; FIXME: ,test
                           body-text
                           step-text
                           ;;test-text
-                          ;;(list (lambda (f g t d) (i386:jump-nz (- (+ body-length test-length)))))
+                          ;;(list (lambda (f g t d) (i386:jump-byte-nz (- (+ body-length test-length)))))
                           (list (lambda (f g t d)
                                   (append
                                    (i386:local-test (assoc-ref init-locals name) value)
                           (list (lambda (f g t d) (i386:jump body-length)))
                           body-text
                           test-text
-                          (list (lambda (f g t d) (i386:jump-nz (- (+ body-length test-length))))))
-                  #:globals (.globals body-info))))
+                          (list (lambda (f g t d) (i386:jump-byte-nz (- (+ body-length test-length))))))
+                  #:globals (append globals (.globals body-info)))))
+
+        ;;(and (and (de-ref (p-expr (ident "a"))) (de-ref (p-expr (ident "b")))) (eq (de-ref (p-expr (ident "a"))) (de-ref (p-expr (ident "b")))))
+        
+        ((de-ref (p-expr (ident ,name)))
+         (clone info #:text
+                (append text
+                        (list (lambda (f g t d)
+                                (append (i386:local->accu (assoc-ref locals name))
+                                        (i386:Xmem-byte->accu)))))))
+
+        ((and ,a ,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))))
+
+        ((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:Xmem-byte->base)
+                                           (i386:local->accu (assoc-ref locals b))
+                                           (i386:Xmem-byte->accu)
+                                           (i386:test-byte-base))))))))
+
+        ((sub (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:Xmem-byte->base)
+                                        (i386:local->accu (assoc-ref locals b))
+                                        (i386:Xmem-byte->accu)
+                                        (i386:sub-byte-base)))))))
 
         ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,name)))
          (let ((value (string->number value)))
                                      (i386:local-add (assoc-ref locals name) 1))))))
 
         ((return ,expr)
-         (clone info #:text
-                (append text (list (i386:ret ((expr->accu info) expr))))))
+         (let ((accu ((expr->accu info) expr)))
+           (if (info? accu)
+               (clone accu #:text
+                      (append (.text accu) (list (i386:ret (lambda _ '())))))
+               (clone info #:text
+                      (append text (list (i386:ret ((expr->accu info) expr))))))))
 
         ;; int i;
         ((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ident ,name))))
            (clone info #:text (append (.text info) (list (lambda (f g t d) (i386:ret-local (assoc-ref locals name))))))))
 
         (_
-         (format (current-error-port) "SKIP statement=~a\n" o)
+         (format (current-error-port) "SKIP statement=~s\n" o)
          info)))))
 
 (define (info->exe info)
@@ -557,6 +628,23 @@ puts (char const* s)
                 parse-c99)))
     ast))
 
+(define strcmp
+  (let* ((ast (with-input-from-string
+                  "
+int
+strcmp (char const* a, char const* b)
+{
+  while (*a && *b && *a == *b) 
+    {
+      a++;b++;
+    }
+  return *a - *b;
+}
+"
+;;paredit:"
+                parse-c99)))
+    ast))
+
 (define i386:libc
   (list
    (cons "exit" (list i386:exit))
@@ -567,7 +655,8 @@ puts (char const* s)
    strlen
    eputs
    fputs
-   puts))
+   puts
+   strcmp))
 
 (define (compile)
   (let* ((ast (mescc))
index 0a0d02a1b56de03df1ecb1b3e842a0ebdea916f4..91fbfa83590937f7fad8307580be296677948617 100644 (file)
@@ -73,6 +73,9 @@
   (or n al)
   `(#x89 #x45 ,(- 0 (* 4 n))))          ; mov    ,%eax,-<0xn>(%ebp)
 
+(define (i386:accu-zero?)
+  `(#x85 #xc0))                         ; cmpl   %eax,%eax
+
 (define (i386:local->accu n)
   (or n la)
   `(#x8b #x45 ,(- 0 (* 4 n))))          ; mov    -<0xn>(%ebp),%eax
   '(#x01 #xd0                           ; add    %edx,%eax
          #x0f #xb6 #x00))               ; movzbl (%eax),%eax
 
+(define (i386:Xmem-byte->accu)
+  '(#x0f #xb6 #x00))                    ; movzbl (%eax),%eax
+
+(define (i386:Xmem-byte->base)
+  '(#x0f #xb6 #x10))                    ; movzbl (%eax),%edx
+
 (define (i386:mem->accu)
   '(#x01 #xd0                           ; add    %edx,%eax
          #x8b #x00))                    ; mov    (%eax),%eax
 (define (i386:jump-le n)
   `(#x7e ,(if (>= n 0) n (- n 4))))     ; jle <n>
 
-(define (i386:jump-nz n)
+(define (i386:jump-byte-nz n)
   `(#x84 #xc0                           ; test   %al,%al
     #x75 ,(if (>= n 0) n (- n 4))))     ; jne <n>
 
+(define (i386:jump-nz n)
+  `(#x85 #xc0                           ; test   %eax,%eax
+    #x75 ,(if (>= n 0) n (- n 4))))     ; jne <n>
+
+(define (i386:jump-byte-z n)
+  `(#x84 #xc0                           ; test   %al,%al
+    #x74 ,(if (>= n 0) n (- n 4))))     ; jne <n>
+
+(define (i386:test-byte-base)
+  `(#x38 #xc2))                         ; cmp    %al,%dl
+
+(define (i386:Xjump-byte-z n)
+  `(#x74 ,(if (>= n 0) n (- n 2))))     ; je <n>
+
+(define (i386:sub-byte-base)
+  `(#x28 #xd0))                         ; sub    %dl,%al
+
+;;28 d0                        sub    %dl,%al
+;;28 c2                        sub    %al,%dl
+;;29 d0                        sub    %edx,%eax
+;;29 c2                        sub    %eax,%edx
+
 #!
 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>:
  8048150:      55                      push   %ebp
  8048151:      89 e5                   mov    %esp,%ebp
- 8048153:      eb 0d                   jmp    8048162 <strcmp+0x12>
+
+ 8048153:      eb 08                   jmp    804815d <strcmp+0xd>
 
 <body>
- 8048155:      8b 45 08                mov    0x8(%ebp),%eax
- 8048158:      83 c0 01                add    $0x1,%eax
- 804815b:      89 45 08                mov    %eax,0x8(%ebp)
- 804815e:      83 45 0c 01             addl   $0x1,0xc(%ebp)
+ 8048155:      83 45 08 01             addl   $0x1,0x8(%ebp)
+ 8048159:      83 45 0c 01             addl   $0x1,0xc(%ebp)
 
 <test>
- 8048162:      8b 45 08                mov    0x8(%ebp),%eax
- 8048165:      0f b6 00                movzbl (%eax),%eax
- 8048168:      84 c0                   test   %al,%al
- 804816a:      74 1a                   je     8048186 <strcmp+0x36>
-
- 804816c:      8b 45 0c                mov    0xc(%ebp),%eax
- 804816f:      0f b6 00                movzbl (%eax),%eax
- 8048172:      84 c0                   test   %al,%al
- 8048174:      74 10                   je     8048186 <strcmp+0x36>
-
- 8048176:      8b 45 08                mov    0x8(%ebp),%eax
- 8048179:      0f b6 10                movzbl (%eax),%edx
- 804817c:      8b 45 0c                mov    0xc(%ebp),%eax
- 804817f:      0f b6 00                movzbl (%eax),%eax
- 8048182:      38 c2                   cmp    %al,%dl
- 8048184:      74 cf                   je     8048155 <strcmp+0x5>
-
-<done>
- 8048186:      8b 45 08                mov    0x8(%ebp),%eax
- 8048189:      0f b6 10                movzbl (%eax),%edx
- 804818c:      8b 45 0c                mov    0xc(%ebp),%eax
- 804818f:      0f b6 00                movzbl (%eax),%eax
- 8048192:      38 c2                   cmp    %al,%dl
- 8048194:      0f 94 c0                sete   %al
- 8048197:      0f b6 c0                movzbl %al,%eax
- 804819a:      5d                      pop    %ebp
- 804819b:      c3                      ret    
+ 804815d:      8b 45 08                mov    0x8(%ebp),%eax
+ 8048160:      0f b6 00                movzbl (%eax),%eax
+ 8048163:      84 c0                   test   %al,%al
+ 8048165:      74 1a                   je     8048181 <strcmp+0x31>
+
+ 8048167:      8b 45 0c                mov    0xc(%ebp),%eax
+ 804816a:      0f b6 00                movzbl (%eax),%eax
+ 804816d:      84 c0                   test   %al,%al
+ 804816f:      74 10                   je     8048181 <strcmp+0x31>
+
+ 8048171:      8b 45 08                mov    0x8(%ebp),%eax
+ 8048174:      0f b6 10                movzbl (%eax),%edx
+ 8048177:      8b 45 0c                mov    0xc(%ebp),%eax
+ 804817a:      0f b6 00                movzbl (%eax),%eax
+ 804817d:      38 c2                   cmp    %al,%dl
+ 804817f:      74 d4                   je     8048155 <strcmp+0x5>
+
+<exit>
+ 8048181:      8b 45 08                mov    0x8(%ebp),%eax
+ 8048184:      0f b6 00                movzbl (%eax),%eax
+ 8048187:      0f be d0                movsbl %al,%edx
+
+ 804818a:      8b 45 0c                mov    0xc(%ebp),%eax
+ 804818d:      0f b6 00                movzbl (%eax),%eax
+ 8048190:      0f be c0                movsbl %al,%eax
+
+ 8048193:      29 c2                   sub    %eax,%edx
+ 8048195:      89 d0                   mov    %edx,%eax
+
+ 8048197:      5d                      pop    %ebp
+ 8048198:      c3                      ret    
 !#
index 9095076e457edbe6651b46cfb82bf6c69fd0eef3..06a40ff893bdd7d6df725ac1e6a40bf02903e5de 100644 (file)
@@ -35,6 +35,8 @@
             i386:function-locals
             i386:eputs
             i386:jump
+            i386:jump-byte-nz
+            i386:jump-byte-z
             i386:jump-nz
             i386:jump-le
             i386:local-add
@@ -44,6 +46,7 @@
             i386:local-test
             i386:mem->accu
             i386:mem-byte->accu
+            i386:Xmem-byte->accu
             i386:push-accu
             i386:puts
             i386:ref-global
             i386:ret-local
             i386:value->accu
             i386:write
+
+            i386:test-byte-base
+            i386:Xmem-byte->base
+            i386:Xjump-byte-z
+            i386:sub-byte-base
             ))
 
 (cond-expand
index 97b646c65fd6865fedcc113e4b14cc66b3cb5a4d..b45224770e365238d1e4c8bf4a654197aaa6a650 100644 (file)
 #define NYACC2 nyacc2
 #endif
 
+#if __GNUC__
 typedef long size_t;
 void *malloc (size_t i);
 int open (char const *s, int mode);
 int read (int fd, int n);
 void write (int fd, char const* s, int n);
 
-#if __GNUC__
 void
 exit (int code)
 {
@@ -99,7 +99,6 @@ free (void *p)
   int *n = (int*)p-1;
   //munmap ((void*)p, *n);
 }
-#endif
 
 #define EOF -1
 #define STDIN 0
@@ -112,7 +111,6 @@ free (void *p)
 
 int g_stdin;
 
-#if __GNUC__
 size_t
 strlen (char const* s)
 {
@@ -224,29 +222,17 @@ main (int argc, char *argv[])
     {
       puts ("\narg1=");
       puts (argv[1]);
+      if (!strcmp (argv[1], "--help")) return puts ("Usage: mes [--dump|--load] < FILE");
     }
   puts ("\n");
   eputs ("Strlen...\n");
   puts ("Bye micro\n");
   int i = argc;
+  //int i = strcmp (argv[1], "1");
   return i;
 }
 
 #if __GNUC__
-// int
-// test1()
-// {
-//   return 9;
-// }
-
-// void
-// test()
-// {
-//   int r;
-//   r=7;
-//   r=test1();
-// }
-
 void
 _start ()
 {