mescc: Have micro-mes use if not to segfault.
authorJan Nieuwenhuizen <janneke@gnu.org>
Tue, 3 Jan 2017 17:22:56 +0000 (18:22 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Tue, 3 Jan 2017 17:22:56 +0000 (18:22 +0100)
* 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.

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

index 36a0629a2cc9a8f0661db1225a4b59d1dec57d3a..f6b6d18b7fb2f63ebf208402cb8ed7b5dbfdb10a 100644 (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)))
     ;;(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
               (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)))
                 (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))
 
                     (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)))
 
     (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)))
index 3231e7b041818af9834b192bd96d82f5971f2ac9..72a5981e0b3b56d76e25bebd99afc1c44fcc15a4 100644 (file)
   (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))
index 0fe8df84cc3fc859d17d38ff4d70af23b9f1d769..4a3fa51ffad9439228b74844de439f2d1d827151 100644 (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)
 (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>
 
 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    
 !#
-
index 58cdb14db44486f3904728616ae5c042a542887e..9095076e457edbe6651b46cfb82bf6c69fd0eef3 100644 (file)
             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
             ))
index fcb1d0f604486c9fd6caebc919059d9c884e552d..97b646c65fd6865fedcc113e4b14cc66b3cb5a4d 100644 (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");