mescc: Beginning of expression and test template.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 2 Apr 2017 10:23:00 +0000 (12:23 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 2 Apr 2017 10:23:00 +0000 (12:23 +0200)
* scaffold/t.c: New file.
* GNUmakefile (mescc-check, t-check): New targets.
* module/language/c99/compiler.mes (write-any): Catch weirdness.
  (make): Add <function> slot.
  (.function): New accessor.
  (clone): Handle it.
  (function->info): Set it.
  (ast->info): Make tests generic in if, for, while.  Add goto, label,
  !, ==, !=, -, &&.
* module/mes/elf-util.mes (lambda/label->list): New function.
  (text->list): Use it.
  (functions->text, function-prefix): New function.
  (function-offset): Use it.
  (label-offset): New function.
* module/mes/elf-util.scm (mes): Export them.
* module/mes/elf.mes (make-elf): Use text->list.
* module/mes/libc-i386.mes (eputs, puts): Remove.
  (i386:byte-base-sub): Rename from sub-byte-base.
  (i386:byte-jump-z): Rename from i386:Xjump-byte-z.
  (i386:byte-mem->accu): Rename from i386:Xmem-byte->accu.
  (i386:byte-mem->base): Rename from i386:Xmem-byte->base.
  (i386:accu->local, i386:accu-non-zero?, i386:accu-zero?,
  i386:base-sub, i386:byte-sub-base, i386:jump-c, i386:jump-cz,
  i386:jump-nc, i386:jump-ncz, i386:byte-mem->base, i386:sub-base,
  i386:test-accu, i386:test-base, i386:test-jump-z, i386:value->base,
  i386:xor-zf): New functions.

12 files changed:
GNUmakefile
doc/examples/main.c
module/language/c99/compiler.mes
module/mes/elf-util.mes
module/mes/elf-util.scm
module/mes/elf.mes
module/mes/libc-i386.mes
module/mes/libc-i386.scm
scaffold/micro-mes.c
scaffold/mini-mes.c
scaffold/t.c [new file with mode: 0644]
tests/optargs.test

index 2731256846bc4cc0961122591d594c8b957868f3..3300b618295e1a0503fbe60d98ccdbd6e74b696b 100644 (file)
@@ -35,21 +35,6 @@ mes.o: math.c math.h math.i math.environment.i
 mes.o: posix.c posix.h posix.i posix.environment.i
 mes.o: reader.c reader.h reader.i reader.environment.i
 
-mini-mes: doc/examples/mini-mes.c GNUmakefile
-       rm -f $@
-       gcc -nostdlib --std=gnu99 -m32 -g -o mini-mes '-DVERSION="0.4"' $<
-       chmod +x $@
-
-micro-mes: doc/examples/micro-mes.c GNUmakefile
-       rm -f $@
-       gcc -nostdlib --std=gnu99 -m32 -o micro-mes '-DVERSION="0.4"' $<
-       chmod +x $@
-
-main: doc/examples/main.c GNUmakefile
-       rm -f $@
-       gcc -nostdlib --std=gnu99 -m32 -o main '-DVERSION="0.4"' $<
-       chmod +x $@
-
 clean:
        rm -f mes mes.o *.environment.i *.symbols.i *.environment.h *.cat a.out
 
@@ -59,7 +44,7 @@ distclean: clean
 %.h %.i %.environment.i %.symbols.i: %.c build-aux/mes-snarf.scm
        build-aux/mes-snarf.scm $<
 
-check: all guile-check mes-check
+check: all guile-check mes-check mescc-check
 
 TESTS:=\
  tests/read.test\
@@ -95,6 +80,8 @@ MES_DEBUG:=1
 
 mes-check: all
        set -e; for i in $(TESTS); do ./$$i; done
+
+mes-check-nyacc: all
        scripts/nyacc.mes
        scripts/nyacc-calc.mes
 
@@ -107,9 +94,37 @@ guile-check:
        set -e; for i in $(TESTS); do\
                $(GUILE) -s <(cat $(MES-0) module/mes/test.mes $$i);\
        done
-       guile/nyacc.scm
        guile/nyacc-calc.scm
 
+t-check: t
+       ./t
+
+mescc-check: t-check
+       rm -f a.out
+       guile/mescc.scm scaffold/t.c > a.out
+       chmod +x a.out
+       ./a.out
+
+mini-mes: scaffold/mini-mes.c GNUmakefile
+       rm -f $@
+       gcc -nostdlib --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $<
+       chmod +x $@
+
+micro-mes: scaffold/micro-mes.c GNUmakefile
+       rm -f $@
+       gcc -nostdlib --std=gnu99 -m32 -o $@ '-DVERSION="0.4"' $<
+       chmod +x $@
+
+main: doc/examples/main.c GNUmakefile
+       rm -f $@
+       gcc -nostdlib --std=gnu99 -m32 -o $@ '-DVERSION="0.4"' $<
+       chmod +x $@
+
+t: scaffold/t.c GNUmakefile
+       rm -f $@
+       gcc -nostdlib --std=gnu99 -m32 -o $@ '-DVERSION="0.4"' $<
+       chmod +x $@
+
 MAIN_C:=doc/examples/main.c
 mescc: all $(MAIN_C)
        rm -f a.out
index 93348108b46bc3fcb1cb5291739f378c2b4da73e..1aa861371ce2c0d77b30f57b9e02ad026fbb760a 100644 (file)
@@ -1,5 +1,24 @@
-#if __GNUC__
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
 
+#if __GNUC__
 void
 write (int fd, char const* s, int n)
 {
@@ -52,14 +71,22 @@ puts (char const* s)
   write (1, s, i);
   return 0;
 }
+
+int
+strcmp (char const* a, char const* b)
+{
+  while (*a && *b && *a == *b) {a++;b++;}
+  return *a - *b;
+}
 #endif
 
 int
-main ()
+//main ()
+main (int argc, char *argv[])
 {
+  int i = 0;
+  if (argc > 1 && !strcmp (argv[1], "--help")) puts ("argc > 1 && --help\n");
   puts ("Hi Mes!\n");
-  for (int i = 0; i < 4; ++i)
-    puts ("  Hello, world!\n");
   return 42;
 }
 
@@ -67,7 +94,24 @@ main ()
 void
 _start ()
 {
-  int r=main ();
+  // int r=main ();
+  // exit (r);
+  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
index f8106e660ef97dbf6cf0bfa0127baa496d89f5c1..0b8721b4c6cfafa2e28cba490d9e945fa11e52bf 100644 (file)
@@ -62,6 +62,7 @@
 
 (define (write-any x)
   (write-char (cond ((char? x) x)
+                    ((and (number? x) (< (+ x 256) 0)) (format (current-error-port) "***BROKEN*** x=~a\n" x) (integer->char #xaa))
                     ((number? x) (integer->char (if (>= x 0) x (+ x 256))))
                     (else (stderr "write-any: ~a\n" x) barf))))
 
 (define <functions> '<functions>)
 (define <globals> '<globals>)
 (define <locals> '<locals>)
+(define <function> '<function>)
 (define <text> '<text>)
-(define* (make o #:key (functions '()) (globals '()) (locals '()) (text '()))
+(define* (make o #:key (functions '()) (globals '()) (locals '()) (function #f) (text '()))
   (pmatch o
     (<info> (list <info>
                   (cons <functions> functions)
                   (cons <globals> globals)
                   (cons <locals> locals)
+                  (cons <function> function)
                   (cons <text> text)))))
 
 (define (.functions o)
   (pmatch o
     ((<info> . ,alist) (assq-ref alist <locals>))))
 
+(define (.function o)
+  (pmatch o
+    ((<info> . ,alist) (assq-ref alist <function>))))
+
 (define (.text o)
   (pmatch o
     ((<info> . ,alist) (assq-ref alist <text>))))
          (let ((functions (.functions o))
                (globals (.globals o))
                (locals (.locals o))
+               (function (.function o))
                (text (.text o)))
            (let-keywords rest
                          #f
                          ((functions functions)
                           (globals globals)
                           (locals locals)
+                          (function function)
                           (text text))
-                         (make <info> #:functions functions #:globals globals #:locals locals #:text text))))))
+                         (make <info> #:functions functions #:globals globals #:locals locals #:function function #:text text))))))
 
 (define (ref-local locals)
   (lambda (o)
       (define (add-local name)
          (acons name (1+ (or (and=> (member 1 (map cdr locals)) length) 0)) locals))
 
-      ;; (stderr "S=~a\n" o)
+      ;; (stderr "\nS=~a\n" o)
+      ;; (stderr "  text=~a\n" text)
       ;; (stderr "   info=~a\n" info)
       ;; (stderr "   globals=~a\n" globals)
       (pmatch o
 
         ((compd-stmt (block-item-list . ,statements)) ((ast-list->info info) statements))
         
-        ((expr-stmt (fctn-call (p-expr (ident ,name))
-                               (expr-list (p-expr (string ,string)))))
-         ;;(stderr "S1 string=~a\n" string)
-         (if (equal? name "asm") (clone info #:text (append text (list (lambda (f g t d) (asm->hex string)))))
-             (let ((globals (append globals (list (string->global string)))))
+        ((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
+         (if (equal? name "asm") (let ((arg0 (cadr (cadar expr-list)))) ;; FIXME
+                                   (clone info #:text (append text (list (lambda (f g t d) (asm->hex arg0))))))
+             (let* ((globals (append globals (filter-map expr->global expr-list)))
+                    (args (map (expr->arg globals locals) expr-list)))
                (clone info #:text
                       (append text (list (lambda (f g t d)
-                                           (i386:call f g t d
-                                                      (+ t (function-offset name f))
-                                                      (+ d (data-offset string g))))))
+                                           (apply i386:call (cons* f g t d
+                                                                   (+ t (function-offset name f)) args)))))
                       #:globals globals))))
-        
-        ((expr-stmt (fctn-call (p-expr (ident ,name)) (expr-list . ,expr-list)))
-         ;;(stderr "S1 expr-list=~a\n" expr-list)
-         (let* ((globals (append globals (filter-map expr->global expr-list)))
-                (args (map (expr->arg globals locals) expr-list)))
-           (clone info #:text
-                  (append text (list (lambda (f g t d)
-                                       (apply i386:call (cons* f g t d
-                                                               (+ t (function-offset name f)) args)))))
-                  #:globals globals)))
 
-        ((if (gt (p-expr (ident ,name)) (p-expr (fixed ,value))) ,body)
-         (let* ((value (string->number value))
-                (info (clone info #:text '()))
-                (body-info ((ast->info info) body))
-                (body-text (.text body-info))
+        ((if ,test ,body)
+         (let* ((jump (pmatch test
+                        ((lt ,a ,b) i386:jump-nc)
+                        ((gt ,a ,b) i386:jump-nc)
+                        (_ i386:jump-z)))
+                (jump-text (lambda (body-length)
+                             (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-text (list-tail (.text body-info) text-length))
                 (body-length (length (text->list body-text))))
 
            (clone info #:text
-                  (append text
-                          (list (lambda (f g t d)
-                                  (append
-                                   (i386:local-test (assoc-ref locals name) value)
-                                   (i386:jump-le body-length))))
+                  (append (.text test-info)
+                          (jump-text body-length)
                           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))))
+        ((for ,init ,test ,step ,body)
+         (let* ((jump (pmatch test
+                        ((lt ,a ,b) i386:jump-c)
+                        ((gt ,a ,b) i386:jump-c)
+                        (_ i386:jump-nz)))
+                (jump-text (lambda (body-length)
+                             (list (lambda (f g t d) (jump body-length)))))
 
-           (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
-              (lt (p-expr (ident ,name)) (p-expr (fixed ,value)))
-              ,step ,body)
-         (let* ((value (string->number value))
                 (info (clone info #:text '()))
 
                 (info ((ast->info info) init))
                 (step-text (.text step-info))
                 (step-length (length (text->list step-text)))
 
-                ;; (test-info ((ast->info info) test))
-                ;; (test-text (.text test-info))
-                ;; (test-length (length (text->list test-text)))
-                )
+                (test-info ((ast->info info) test))
+                (test-text (.text test-info))
+                (test-length (length (text->list test-text))))
 
            (clone info #:text
                   (append text
                           init-text
-                          (list (lambda (f g t d) (i386:jump body-length)))
+                          (list (lambda (f g t d) (i386:jump (+ 2 body-length)))) ;; FIXME: 2
                           body-text
                           step-text
-                          ;;test-text
-                          ;;(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)
-                                   (i386:jump-le (- (+ body-length step-length 2) ;;test-length
-                                                    )))))
-                          )
-                  #:globals (append globals (.globals body-info))
+                          test-text
+                          (jump-text (- (+ body-length step-length test-length))))
+                  #:globals (append globals (.globals body-info)) ;; FIXME
                   #:locals locals)))
 
         ((while ,test ,body)
-         (let* ((info (clone info #:text '()))
+         (let* ((jump (pmatch test
+                        ((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-text (.text body-info))
                 (body-length (length (text->list body-text)))
 
            (clone info #:text
                   (append text
-                          (list (lambda (f g t d) (i386:jump body-length)))
+                          (list (lambda (f g t d) (i386:jump (+ 2 body-length)))) ;; FIXME: 2
                           body-text
                           test-text
-                          (list (lambda (f g t d) (i386:jump-byte-nz (- (+ body-length test-length))))))
-                  #:globals (append globals (.globals body-info)))))
+                          (jump-text (- (+ body-length test-length))))
+                  #:globals (.globals body-info))))
+
+        ((labeled-stmt (ident ,label) ,statement)
+         (let ((info (clone info #:text (append text (list label)))))
+           ((ast->info info) statement)))
+
+        ((goto (ident ,label))
+         (let ((offset (length (text->list text))))
+           (clone info #:text
+                  (append text
+                          (list (lambda (f g t d)
+                                  (i386:jump (- (label-offset (.function info) label f) offset))))))))
+
+        ((p-expr (ident ,name))
+         (clone info #:text
+                (append text
+                        (list (lambda (f g t d)
+                                (append
+                                 (i386:local->accu (assoc-ref locals name))
+                                 (i386:accu-zero?)))))))
+
+        ((p-expr (fixed ,value))
+         (let ((value (string->number value)))
+          (clone info #:text
+                 (append text
+                         (list (lambda (f g t d)
+                                 (append (i386:value->accu value)
+                                         (i386:accu-zero?))))))))
 
-        ;;(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)))))))
+                                        (i386:byte-mem->accu)))))))
+
+        ((fctn-call . ,call)
+         (let ((info ((ast->info info) `(expr-stmt ,o))))
+           (clone info #:text
+                  (append (.text info)
+                          (list (lambda (f g t d)
+                                  (i386:accu-zero?)))))))
+
+        ;; i++
+        ((expr-stmt (post-inc (p-expr (ident ,name))))
+         (clone info #:text
+                (append text (list (lambda (f g t d)
+                                     (i386:local-add (assoc-ref locals name) 1))))))
+
+        ;; ++i -- same for now FIXME
+        ((expr-stmt (pre-inc (p-expr (ident ,name))))
+         (clone info #:text
+                (append text (list (lambda (f g t d)
+                                     (i386:local-add (assoc-ref locals name) 1))))))
+
+        ((not ,expr)
+         (let* ((test-info ((ast->info info) expr)))
+           (clone info #:text
+                  (append (.text test-info)
+                          (list (lambda (f g t d)
+                                  (i386:xor-zf))))
+                  #:globals (.globals test-info))))
 
         ((and ,a ,b)
          (let* ((info (clone info #:text '()))
                                                                        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:Xmem-byte->base)
+                                           (i386:byte-mem->base)
                                            (i386:local->accu (assoc-ref locals b))
-                                           (i386:Xmem-byte->accu)
-                                           (i386:test-byte-base))))))))
+                                           (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)))
+           (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))))))))
+
+        
+        ((eq (p-expr (ident ,a)) (p-expr (fixed ,b)))
+         ;;(stderr "EQ: ~a > ~a\n" a 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)
+                                   (i386:xor-zf))))))))
+
+        
+        ((ne (p-expr (ident ,a)) (p-expr (fixed ,b)))
+         ;;(stderr "NE: ~a > ~a\n" a 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))))))))
+        
+        ((lt (p-expr (ident ,a)) (p-expr (fixed ,b)))
+         ;;(stderr "LT: ~a < ~a\n" a 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:base-sub))))))))
 
         ((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:byte-mem->base)
                                         (i386:local->accu (assoc-ref locals b))
-                                        (i386:Xmem-byte->accu)
-                                        (i386:sub-byte-base)))))))
+                                        (i386:byte-mem->accu)
+                                        (i386:byte-sub-base)))))))
 
         ((array-ref (p-expr (fixed ,value)) (p-expr (ident ,name)))
          (let ((value (string->number value)))
                                        (append
                                         ((ident->base locals) name)
                                         (i386:value->accu value)
-                                        (i386:mem-byte->accu)))))))) ; FIXME: type: char
+                                        (i386:byte-mem->accu)))))))) ; FIXME: type: char
         
         ((array-ref (p-expr (ident ,name)) (p-expr (ident ,index)))
          (clone info #:text
                                      (append
                                       ((ident->base locals) name)
                                       ((ident->accu locals) index)
-                                      (i386:mem-byte->accu))))))) ; FIXME: type: char
+                                      (i386:byte-mem->accu))))))) ; FIXME: type: char
         
-        ;; i++
-        ((expr-stmt (post-inc (p-expr (ident ,name))))
-         (clone info #:text
-                (append text (list (lambda (f g t d)
-                                     (i386:local-add (assoc-ref locals name) 1))))))
-
-        ;; ++i -- same for now FIXME
-        ((expr-stmt (pre-inc (p-expr (ident ,name))))
-         (clone info #:text
-                (append text (list (lambda (f g t d)
-                                     (i386:local-add (assoc-ref locals name) 1))))))
-
         ((return ,expr)
          (let ((accu ((expr->accu info) expr)))
            (if (info? accu)
          ;;(stderr "RET LOCAL[~a]: ~a\n" name (assoc-ref locals name))
          (let ((value (string->number value)))
            (clone info #:text (append text (list (lambda (f g t d) (i386:local-assign (assoc-ref locals name) value)))))))
+
+        ;; i = 0; ...from for init FIXME
+        ((assn-expr (p-expr (ident ,name)) (op _) (p-expr (fixed ,value)))
+         (let ((value (string->number value)))
+           (clone info #:text (append text (list (lambda (f g t d) (i386:local-assign (assoc-ref locals name) value)))))))
         
         ((expr-stmt (assn-expr (p-expr (ident ,name)) (op _) (fctn-call . ,call)))
          (let* ((info ((ast->info info) `(expr-stmt (fctn-call ,@call)))))
 (define (function->info info)
   (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)))
+    (let* ((name (.name o))
+           (text (formals->text (.formals o)))
            (locals (formals->locals (.formals o))))
+      (format (current-error-port) "compiling ~a\n" name)
       ;;(stderr "locals=~a\n" locals)
       (let loop ((statements (.statements o))
-                 (info (clone info #:locals locals #:text text)))
+                 (info (clone info #:locals locals #:function name #:text text)))
         (if (null? statements) (clone info
+                                      #:function #f
                                       #:functions (append (.functions info) (list (cons (.name o) (.text info)))))
             (let* ((statement (car statements)))
-              (loop (cdr statements) ((ast->info info) (car statements)))))))))
+              (loop (cdr statements)
+                    ((ast->info info) (car statements)))))))))
 
 (define (ast-list->info info)
   (lambda (elements)
index 2e8a23796e956d7f2e81631b49efc52b90672f73..4875ecbf4dc14d3f6a26b71ec1ad6a14cea0c4b6 100644 (file)
 (define (functions->lambdas functions)
   (append-map cdr functions))
 
+(define (lambda/label->list f g t d)
+  (lambda (l/l)
+    (if (not (procedure? l/l)) '() (l/l f g t d))))
+
 (define (text->list o)
-  (append-map (lambda (f) (f '() '() 0 0)) o))
+  (append-map (lambda/label->list '() '() 0 0) o))
 
 (define (functions->text functions globals t d)
-  (let loop ((lambdas (functions->lambdas functions)) (text '()))
-    (if (null? lambdas) text
-        (loop (cdr lambdas)
-              (append text ((car lambdas) functions globals (- (length text)) d))))))
+  (let loop ((lambdas/labels (functions->lambdas functions)) (text '()))
+    (if (null? lambdas/labels) text
+        (loop (cdr lambdas/labels)
+              (append text ((lambda/label->list functions globals (- (length text)) d) (car lambdas/labels)))))))
+
+(define (function-prefix name functions)
+  (member name (reverse functions) (lambda (a b) (equal? (car b) name))))
 
 (define (function-offset name functions)
-  (let* ((prefix (member name (reverse functions)
-                         (lambda (a b)
-                           (equal? (car b) name)))))
+  (let ((prefix (function-prefix name functions)))
     (if prefix (length (functions->text (cdr prefix) '() 0 0))
         0)))
 
+(define (label-offset function label functions)
+  (let ((prefix (function-prefix function functions)))
+    (if (not prefix) 0
+        (let ((function-entry (car prefix)))
+          (let loop ((text (cdr function-entry)))
+            (if (or (equal? (car text) label) (null? text)) 0
+                (let* ((l/l (car text))
+                       (t ((lambda/label->list '() '() 0 0) l/l))
+                       (n (length t)))
+                  (+ (loop (cdr text)) n))))))))
+
 (define (globals->data globals)
   (append-map cdr globals))
 
index 3066ababb5fc5e1a7cbab5381c922084b3e5789d..a4b0b8691c7639e6acaf52c88ceb3edfbfab5122 100644 (file)
   #:use-module (srfi srfi-1)
   #:export (data-offset
             function-offset
+            label-offset
             functions->lambdas
             functions->text
+            lambda/label->list
             text->list
             globals->data))
 
index 5761144fbb39c14a7ecf219553106ce63ddc9a42..bd5d49a19f7b767f2ade49e6ac09a75b836c2a3c 100644 (file)
     (define (symbol->table-entry o)
       (let* ((name (car o))
              (offset (function-offset name functions))
-            (len (length (append-map (lambda (f) (f functions globals 0 0)) (cddr o))))
+             (len (length (text->list (cddr o))))
             (str (append-map (lambda (x) (cons 0 (string->list x))) (cdr (member name (reverse (map car functions))))))
             (i (1+ (length str))))
         (symbol-table-entry i (+ vaddress text-offset offset) len stt-func 0 1)))
index 91fbfa83590937f7fad8307580be296677948617..014bd4ace7933bf3bf308d474012319fb012733b 100644 (file)
 (define (i386:function-locals)
   '(#x83 #xec #x10))               ; sub    $0x10,%esp -- 4 local vars
 
-;; (define (i386:formal i n)
-;;   (case i
-;;     ((0) (list #x8b #x5d (* (- n 2) 4)))       ; mov    $00(%ebp),%ebx
-;;     ((1) (list #x8b #x4d (* (- n 3) 4)))    ; mov    $00(%ebp),%ecx
-;;     ((2) (list #x8b #x55 (* (- n 4) 4)))    ; mov    $00(%ebp),%edx
-;;     ((3) (list #x8b #x45 (* (- n 5) 4)))))  ; mov    $00(%ebp),%eax FIXME
-
 (define (i386:ref-global o)
   `(#x68 ,@(int->bv32 o)))               ; push  $0x<o>
 
 (define (i386:push-arg f g t d)
   (lambda (o)
     (cond ((number? o)
-           `(#x68 ,@(int->bv32 o)))       ; push $<o>
+           `(#x68 ,@(int->bv32 o)))     ; push $<o>
           ((pair? o) o)
-          ((procedure? o) (o f g t d)))))
+          ((procedure? o) (o f g t d))
+          (_ barf))))
 
 (define (i386:ret . rest)
   (lambda (f g t d)
 (define (i386:accu-zero?)
   `(#x85 #xc0))                         ; cmpl   %eax,%eax
 
+(define (i386:accu-non-zero?)
+  (append '(#x85 #xc0)                  ; cmpl   %eax,%eax
+          (i386:xor-zf)))
+
 (define (i386:local->accu n)
   (or n la)
   `(#x8b #x45 ,(- 0 (* 4 n))))          ; mov    -<0xn>(%ebp),%eax
   (or n lb)
   `(#x8b #x55 ,(- 0 (* 4 n))))          ; mov    -<0xn>(%ebp),%edx
 
-(define (i386:mem-byte->accu)
+(define (i386:byte-mem->accu)
   '(#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)
+(define (i386:byte-mem->base)
   '(#x0f #xb6 #x10))                    ; movzbl (%eax),%edx
 
 (define (i386:mem->accu)
 (define (i386:value->accu v)
   `(#xb8 ,@(int->bv32 v)))              ; mov    $<v>,%eax
 
+(define (i386:value->base v)
+  `(#xba ,@(int->bv32 v)))              ; mov    $<v>,%edx
+
 (define (i386:local-add n v)
   (or n ladd)
   `(#x83 #x45 ,(- 0 (* 4 n)) ,v))       ; addl   $<v>,0x<n>(%ebp)
      #x83 #xc4 ,(* n 4)                 ; add    $00,%esp
      )))
   
+(define (i386:xor-zf)
+  '(#x9f                                ; lahf   
+    #x80 #xf4 #x40                      ; xor    $0x40,%ah
+    #x9e))                              ; sahf   
+
+(define (i386:test-accu)
+  '(#x85 #xc0))                         ; test   %eax,%eax
+
+(define (i386:jump n)
+  `(#xeb ,(if (>= n 0) (- n 2) (- n 2))))   ; jmp <n>
+
+(define (i386:jump-c n)
+  `(#x72 ,(if (>= n 0) n (- n 2))))     ; jc <n>
+
+(define (i386:jump-cz n)
+  `(#x76 ,(if (>= n 0) n (- n 2))))     ; jna <n>
+
+(define (i386:jump-ncz n)
+  `(#x77 ,(if (>= n 0) n (- n 2))))     ; ja <n>
+
+(define (i386:jump-nc n)
+  `(#x73 ,(if (>= n 0) n (- n 2))))     ; jnc <n>
+
+(define (i386:jump-z n)
+  `(#x74 ,(if (>= n 0) n (- n 2)))) ; jz <n>
+
+(define (i386:jump-nz n)
+  `(#x75 ,(if (>= n 0) n (- n 2)))) ; jnz <n>
+
+(define (i386:test-jump-z n)
+  `(#x85 #xc0                           ; test   %eax,%eax
+    #x74 ,(if (>= n 0) n (- n 4))))     ; jz <n>
+
+(define (i386:jump-byte-nz n)
+  `(#x84 #xc0                           ; test   %al,%al
+    #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:byte-test-base)
+  `(#x38 #xc2))                         ; cmp    %al,%dl
+
+(define (i386:test-base)
+  `(#x39 #xd0))                         ; cmp    %edx,%eax
+
+(define (i386:byte-sub-base)
+  `(#x28 #xd0))                         ; sub    %dl,%al
+
+(define (i386:byte-base-sub)
+  `(#x28 #xd0))                         ; sub    %al,%dl
+
+(define (i386:sub-base)
+  `(#x29 #xd0))                         ; sub    %edx,%eax
+
+(define (i386:base-sub)
+  `(#x29 #xc2))                         ; sub    %eax,%edx
+
+;;;\f libc bits
 (define (i386:exit f g t d)
   `(
     #x5b                                ; pop    %ebx
     #xcd #x80                           ; int    $0x80
     ))
 
-;; (define (i386:_start f g t d)
-;;   (let* ((prefix
-;;           `(
-;;             #x55                         ; push   %ebp
-;;             #x89 #xe5                    ; mov    %esp,%ebp
-      
-;;             ;;#x83 #xec #x10                 ; sub    $0x10,%esp -- 4 local vars
-            
-;;             #xe8 ,@(int->bv32 (- address 5 s)) ; call relative
-
-;;             #xb8 #x04 #x00 #x00 #x00     ; mov    $0x4,%eax
-;;             #xcd #x80                    ; int    $0x80
-      
-;;             #xc9                         ; leave
-;;             #xc3                         ; ret
-;;             ))
-;;          (text-list (text->list t))
-;;          (statement-offset (- (+ (length prefix) (length text-list))))
-;;          (address (+ t (function-offset "main" s))))))
-
 (define (i386:write f g t d)
   `(
     #x55                                ; push   %ebp
     #xc9                                ; leave
     #xc3                                ; ret
     ))
-
-(define (i386:jump n)
-  `(#xeb ,(if (>= n 0) n (- n 2))))     ; jmp <n>
-
-(define (i386:jump-le n)
-  `(#x7e ,(if (>= n 0) n (- n 4))))     ; jle <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++;
-   }
-  return *a == *b;
-}
-08048150 <strcmp>:
- 8048150:      55                      push   %ebp
- 8048151:      89 e5                   mov    %esp,%ebp
-
- 8048153:      eb 08                   jmp    804815d <strcmp+0xd>
-
-<body>
- 8048155:      83 45 08 01             addl   $0x1,0x8(%ebp)
- 8048159:      83 45 0c 01             addl   $0x1,0xc(%ebp)
-
-<test>
- 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 06a40ff893bdd7d6df725ac1e6a40bf02903e5de..67ce55fc51481b5658e437ae59b725418c67eaef 100644 (file)
 (define-module (mes libc-i386)
   #:use-module (srfi srfi-1)
   #:use-module (mes elf)
-  #:export (i386:accu->local
+  #:export (
+            i386:accu->local
+            i386:accu-non-zero?
+            i386:accu-zero?
+            i386:base-sub
+            i386:byte-base-sub
+            i386:byte-mem->accu
+            i386:byte-mem->base
+            i386:byte-test-base
+            i386:byte-sub-base
             i386:call
-            i386:exit
             i386:formal
-            i386:function-preamble
             i386:function-locals
-            i386:eputs
+            i386:function-preamble
+            i386:jump
             i386:jump
             i386:jump-byte-nz
             i386:jump-byte-z
-            i386:jump-nz
+            i386:jump-c
+            i386:jump-cz
             i386:jump-le
-            i386:local-add
-            i386:local-assign
+            i386:jump-nc
+            i386:jump-ncz
+            i386:jump-nz
+            i386:jump-z
             i386:local->accu
             i386:local->base
+            i386:local-add
+            i386:local-assign
             i386:local-test
             i386:mem->accu
-            i386:mem-byte->accu
-            i386:Xmem-byte->accu
             i386:push-accu
-            i386:puts
             i386:ref-global
             i386:ref-local
             i386:ret
             i386:ret-local
+            i386:sub-base
+            i386:test-accu
+            i386:test-base
+            i386:test-jump-z
             i386:value->accu
-            i386:write
+            i386:value->base
+            i386:xor-zf
 
-            i386:test-byte-base
-            i386:Xmem-byte->base
-            i386:Xjump-byte-z
-            i386:sub-byte-base
+            ;; libc
+            i386:exit
+            i386:write
             ))
 
 (cond-expand
index b45224770e365238d1e4c8bf4a654197aaa6a650..528f09a7f1378c8c8d7cdf9bcefa8cfa93298af2 100644 (file)
@@ -41,8 +41,8 @@ void
 exit (int code)
 {
   asm (
-       "movl %0, %%ebx\n\t"
-       "movl $1,  %%eax\n\t"
+       "movl $0,%%ebx\n\t"
+       "movl $1,%%eax\n\t"
        "int  $0x80"
        : // no outputs "=" (r)
        : "" (code)
@@ -71,11 +71,10 @@ write (int fd, char const* s, int n)
   int r;
   //syscall (SYS_write, fd, s, n));
   asm (
-       "mov %0, %%ebx\n\t"
-       "mov %1, %%ecx\n\t"
-       "mov %2, %%edx\n\t"
-
-       "mov $0x4, %%eax\n\t"
+       "mov %0,%%ebx\n\t"
+       "mov %1,%%ecx\n\t"
+       "mov %2,%%edx\n\t"
+       "mov $0x4,%%eax\n\t"
        "int $0x80\n\t"
        : // no outputs "=" (r)
        : "" (fd), "" (s), "" (n)
@@ -152,27 +151,7 @@ eputs (char const* s)
   return 0;
 }
 
-int g_a;
-int g_b;
-
-#if 0
-void
-eputs2 (char const* s, int a)
-{
-  g_a = a;
-  write (STDERR, s, strlen (s));
-  //return 0;
-}
-
-void
-eputs3 (char const* s, int a, int b)
-{
-  g_a = a;
-  g_b = b;
-  write (STDERR, s, strlen (s));
-  //return 0;
-}
-
+#if __GNUC__
 char const*
 itoa (int x)
 {
@@ -205,7 +184,6 @@ assert_fail (char* s)
   eputs ("\n");
   *((int*)0) = 0;
 }
-
 #endif
 
 #define assert(x) ((x) ? (void)0 : assert_fail(#x))
@@ -213,6 +191,34 @@ assert_fail (char* s)
 #define true 1
 typedef int bool;
 
+typedef int SCM;
+
+#if __GNUC__
+bool g_debug = false;
+#endif
+
+int g_free = 0;
+
+SCM g_symbols = 0;
+SCM g_stack = 0;
+SCM r0 = 0; // a/env
+SCM r1 = 0; // param 1
+SCM r2 = 0; // save 2+load/dump
+SCM r3 = 0; // continuation
+
+SCM
+mes_environment ()
+{
+  return 0;
+}
+
+SCM
+bload_env (SCM a) ///((internal))
+{
+  eputs ("bload_env\n");
+  return 0;
+}
+
 int
 main (int argc, char *argv[])
 {
@@ -222,14 +228,51 @@ main (int argc, char *argv[])
     {
       puts ("\narg1=");
       puts (argv[1]);
-      if (!strcmp (argv[1], "--help")) return puts ("Usage: mes [--dump|--load] < FILE");
+      if (!strcmp (argv[1], "--help")) /*return*/ puts ("XXUsage: mes [--dump|--load] < FILE");
     }
   puts ("\n");
-  eputs ("Strlen...\n");
-  puts ("Bye micro\n");
+
+#if __GNUC__
+  //g_debug = getenv ("MES_DEBUG");
+#endif
+  //if (getenv ("MES_ARENA")) ARENA_SIZE = atoi (getenv ("MES_ARENA"));
+
+  if (argc > 1 && !strcmp (argv[1], "--help")) return eputs ("Usage: mes [--dump|--load] < FILE\n");
+  if (argc > 1 && !strcmp (argv[1], "--version")) {eputs ("Mes ");eputs (VERSION);return eputs ("\n");};
+
+#if __GNUC__
+  g_stdin = STDIN;
+  r0 = mes_environment ();
+#endif
+
+#if MES_MINI
+  SCM program = bload_env (r0);
+  puts ("Hello micro-mes!\n");
+#else
+  SCM program = (argc > 1 && !strcmp (argv[1], "--load"))
+    ? bload_env (r0) : load_env (r0);
+  if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
+
+  push_cc (r2, cell_unspecified, r0, cell_unspecified);
+  r3 = cell_vm_begin;
+  r1 = eval_apply ();
+  stderr_ (r1);
+
+  eputs ("\n");
+  gc (g_stack);
+#endif
   int i = argc;
   //int i = strcmp (argv[1], "1");
   return i;
+#if __GNUC__
+  if (g_debug)
+    {
+      eputs ("\nstats: [");
+      eputs (itoa (g_free));
+      eputs ("]\n");
+    }
+#endif
+  return 0;
 }
 
 #if __GNUC__
index 6276b130b38594fb3197842edbf9e7e21a2254fc..ca4b576ca807f3f6c2babc9684637a1cde7e82d9 100644 (file)
@@ -763,15 +763,26 @@ main (int argc, char *argv[])
   return 0;
 }
 
+#if __GNUC__
 void
 _start ()
 {
-  /* main body of program: call main(), etc */
-  
-  /* exit system call */
+  int r;
   asm (
-       "movl $1,%eax;"
-       "xorl %ebx,%ebx;"
-       "int  $0x80"
+       "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
diff --git a/scaffold/t.c b/scaffold/t.c
new file mode 100644 (file)
index 0000000..59b7479
--- /dev/null
@@ -0,0 +1,203 @@
+/* -*-comment-start: "//";comment-end:""-*-
+ * Mes --- Maxwell Equations of Software
+ * Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
+ *
+ * This file is part of Mes.
+ *
+ * Mes is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 3 of the License, or (at
+ * your option) any later version.
+ *
+ * Mes is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
+ */
+
+#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
+write (int fd, char const* s, int n)
+{
+  int r;
+  //syscall (SYS_write, fd, s, n));
+  asm (
+       "mov %0,%%ebx\n\t"
+       "mov %1,%%ecx\n\t"
+       "mov %2,%%edx\n\t"
+
+       "mov $0x4,%%eax\n\t"
+       "int $0x80\n\t"
+       : // no outputs "=" (r)
+       : "" (fd), "" (s), "" (n)
+       : "eax", "ebx", "ecx", "edx"
+       );
+}
+
+#define STDOUT 1
+
+typedef long size_t;
+size_t
+strlen (char const* s)
+{
+  int i = 0;
+  while (s[i]) i++;
+  return i;
+}
+
+int
+puts (char const* s)
+{
+  //write (STDOUT, s, strlen (s));
+  //int i = write (STDOUT, s, strlen (s));
+  int i = strlen (s);
+  write (1, s, i);
+  return 0;
+}
+
+int
+strcmp (char const* a, char const* b)
+{
+  while (*a && *b && *a == *b) {a++;b++;}
+  return *a - *b;
+}
+int test ();
+#endif
+
+int
+main (int argc, char *argv[])
+{
+  puts ("t.c\n");
+  return test ();
+}
+
+int
+test ()
+{
+  int f = 0;
+  int t = 1;
+  int one = 1;
+
+  puts ("t: if (0)\n");
+  if (0) return 1;
+
+  puts ("t: if (f)\n");
+  if (f) return 1;
+
+  puts ("t: if (one > 1)\n");
+  if (one > 1) return 1;
+
+  puts ("t: if (one < 0)\n");
+  if (one < 0) return 1;
+
+  puts ("t: stlrlen (\"\")\n");
+  if (strlen ("")) return 1;
+
+  puts ("t: if (!1)\n");
+  if (!1) return 1;
+
+  puts ("t: if (one == 0)\n");
+  if (one == 0) return 1;
+
+  puts ("t: if (f != 0)\n");
+  if (one != 1) return 1;
+
+  puts ("t: if (1 && 0)\n");
+  if (1 && 0) return 1;
+
+  puts ("t: if (1)\n");
+  if (1) goto ok0;
+  return 1;
+ ok0:
+  
+  puts ("t: if (t)\n");
+  if (t) goto ok1;
+  return 1;
+ ok1:
+
+  puts ("t: if (one > 0)\n");
+  if (one > 0) goto ok2;
+  return 1;
+ ok2:
+
+  puts ("t: if (one < 2)\n");
+  if (one < 2) goto ok3;
+  return 1;
+ ok3:
+
+  puts ("t: if (strlen (\".\"))\n");
+  if (strlen (".")) goto ok4;
+  return 1;
+ ok4:
+
+  puts ("t: if (!0)\n");
+  if (!0) goto ok5;
+  return 1;
+ ok5:
+
+  puts ("t: if (one == 1)\n");
+  if (one == 1) goto ok6;
+  return 1;
+ ok6:
+
+  puts ("t: if (one != 0)\n");
+  if (one != 0) goto ok7;
+  return 1;
+ ok7:
+
+  puts ("t: if (1 && !0)\n");
+  if (1 && !0) goto ok8;
+  return 1;
+ ok8:
+
+  puts ("t: for (i=0; i<4; ++i)\n");
+  int i;
+  for (i=0; i<4; ++i);
+  if (i != 4) return i;
+
+  return 0;
+}
+
+#if __GNUC__
+void
+_start ()
+{
+  // int r=main ();
+  // exit (r);
+  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
index cffed7634f6f5772a43450b5b3c17fdd5d018948..8856ee76ec272d42abdd5edac954b38e9d8abfa1 100755 (executable)
@@ -56,7 +56,10 @@ exit $?
 (pass-if "optargs key" ((lambda* (#:key (foo #f)) foo) #:foo #t))
 (pass-if-equal "optargs key default" #f ((lambda* (#:key (foo #f)) foo)))
 
-(mes-use-module (mes pmatch))
+(cond-expand
+ (guile (use-modules (system base pmatch)
+                     (ice-9 optargs)))
+ (mes (mes-use-module (mes pmatch))))
 
 (define <info> '<info>)
 (define <functions> '<functions>)