mescc: Support stdarg.

* mlibc/include/stdarg.h (va_list): New type.
  (va_start, va_arg, va_end, va_copy): New macro.
  (vprintf): New declaration.
* mlibc/libc-mes.c (vprintf): New function.
  (printf): Rewrite using vprintf.
* module/language/c99/compiler.mes (expr->accu, expr->accu*): Handle
  any array.  Limitation: element size must be 4/sizeof (expression).
  (make-type): Add value pointer to type.
  (type:type, type:size, type:pointer, type:description): New functions.
  (ast->info): Handle typedef with pointer.

diff --git a/mlibc/include/stdarg.h b/mlibc/include/stdarg.h
index 40436a63c622cf709e3693d10d8b7f632a92f43f..cea11b7b14f19858b4a6a055233a5d5e5414c13b 100644 (file)
--- a/mlibc/include/stdarg.h
+++ b/mlibc/include/stdarg.h
@@ -22,7 +22,15 @@
 
 #if __GNUC__ && POSIX
 #include_next <stdarg.h>
-#endif // (__GNUC__ && POSIX)
+#else // ! (__GNUC__ && POSIX)
+typedef int va_list;
+#define va_start(ap, last) (void)((ap) = (char*)(&(last) + 4))
+#define va_arg(ap, type) (((type*)((ap) = ((ap) + sizeof(type))))[-1])
+#define va_end(ap) (void)((ap) = 0)
+#define va_copy(dest, src) dest = src
 
-#endif // __MES_STDARG_H
+int vprintf (char const* format, va_list ap);
+
+#endif // ! (__GNUC__ && POSIX)
 
+#endif // __MES_STDARG_H

diff --git a/mlibc/libc-mes.c b/mlibc/libc-mes.c
index dfddccb89ed50125541371a8aade876e0cebb8f4..e1ca9fc72fee3db753b8f68f1c97ed9611052b84 100644 (file)
--- a/mlibc/libc-mes.c
+++ b/mlibc/libc-mes.c
@@ -349,33 +349,11 @@ getenv (char const* s)
   return 0;
 }
 
-
-#if 0
-
-// !__MESC__
-// FIXME: mes+nyacc parser bug here
-// works fine with Guile, but let's keep a single input source
-
-#define pop_va_arg \
-  asm ("mov____0x8(%ebp),%eax !-4");  /* mov   -<0x4>(%ebp),%eax :va_arg */ \
-  asm ("shl____$i8,%eax !2");         /* shl   $0x2,%eax */ \
-  asm ("add____%ebp,%eax");           /* add   %ebp,%eax */ \
-  asm ("add____$i8,%eax !12");        /* add   $0xc,%eax */ \
-  asm ("mov____(%eax),%eax");         /* mov   (%eax),%eax */ \
-  asm ("mov____%eax,0x8(%ebp) !-8");  /* mov   %eax,-0x8(%ebp) :va */ \
-  asm ("push___%eax");                /* push   %eax */
-
-#else // __MESC__
-
-#define pop_va_arg asm ("mov____0x8(%ebp),%eax !-4\nshl____$i8,%eax !2\nadd____%ebp,%eax add____$i8,%eax !12\nmov____(%eax),%eax\nmov____%eax,0x8(%ebp) !-8\npush___%eax")
-
-#endif
+#include <stdarg.h>
 
 int
-printf (char const* format, int va_args)
+vprintf (char const* format, va_list ap)
 {
-  int va_arg = 0;
-  int va;
   char *p = format;
   while (*p)
     if (*p != '%')
@@ -387,13 +365,23 @@ printf (char const* format, int va_args)
         switch (c)
           {
           case '%': {putchar (*p); break;}
-          case 'c': {pop_va_arg; putchar ((char)va); va_arg++; break;}
-          case 'd': {pop_va_arg; puts (itoa (va)); va_arg++; break;}
-          case 's': {pop_va_arg; puts ((char*)va); va_arg++; break;}
+          case 'c': {char c; c = va_arg (ap, char); putchar (c); break;}
+          case 'd': {int d; d = va_arg (ap, int); puts (itoa (d)); break;}
+          case 's': {char *s; s = va_arg (ap, char *); puts (s); break;}
           default: putchar (*p);
           }
+        va_end (ap);
         p++;
       }
   return 0;
 }
 
+int
+printf (char const* format, ...)
+{
+  va_list ap;
+  va_start (ap, format);
+  int r = vprintf (format, ap);
+  va_end (ap);
+  return r;
+}

diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes
index 0b2c9c6c39d4543a6d6aeff9993f804a0a2a349c..fef88bd1da1412deb2dedd969f3393b3a0388a92 100644 (file)
--- a/module/language/c99/compiler.mes
+++ b/module/language/c99/compiler.mes
@@ -568,6 +568,10 @@
                 (size (type->size info type)))
            (append-text info (wrap-as (i386:value->accu size)))))
 
+        ((sizeof-type (type-name (decl-spec-list (type-spec (fixed-type ,type))) (abs-declr (pointer))))
+         (let ((size 4))
+           (append-text info (wrap-as (i386:value->accu size)))))
+
         ;; c+p expr->arg
         ;; g_cells[<expr>]
         ((array-ref ,index (p-expr (ident ,array)))
@@ -591,6 +595,11 @@
          (let ((info ((expr->accu* info) o)))
            (append-text info (wrap-as (i386:mem->accu)))))
 
+        ;; <expr>[baz]
+        ((array-ref ,index ,array)
+         (let ((info ((expr->accu* info) o)))
+           (append-text info (wrap-as (i386:mem->accu)))))
+
         ;; f.field
         ((d-sel (ident ,field) (p-expr (ident ,array)))
          (let* ((type (ident->type info array))
@@ -926,33 +935,52 @@
                                                     (i386:pop-base)
                                                     (i386:accu+base)))))))
       
+      ((array-ref ,index ,array)
+       (let* ((info ((expr->accu info) index))
+              (size 4) ;; FIXME
+              (info (append-text info (wrap-as (append (i386:accu->base)
+                                                       (if (eq? size 1) '()
+                                                           (append
+                                                            (if (<= size 4) '()
+                                                                (i386:accu+accu))
+                                                            (if (<= size 8) '()
+                                                                (i386:accu+base))
+                                                            (i386:accu-shl 2)))))))
+              (info ((expr->base info) array)))
+          (append-text info (wrap-as (i386:accu+base)))))
+
       (_ (error "expr->accu*: unsupported: " o)))))
 
 (define (ident->constant name value)
   (cons name value))
 
-(define (make-type name type size description)
-  (cons name (list type size description)))
+(define (make-type name type size pointer description)
+  (cons name (list type size pointer description)))
+
+(define type:type car)
+(define type:size cadr)
+(define type:pointer caddr)
+(define type:description cadddr)
 
 (define (enum->type name fields)
-  (make-type name 'enum 4 fields))
+  (make-type name 'enum 4 0 fields))
 
 (define (struct->type name fields)
-  (make-type name 'struct (apply + (map field:size fields)) fields))
+  (make-type name 'struct (apply + (map field:size fields)) 0 fields))
 
 (define i386:type-alist
-  '(("char" . (builtin 1 #f))
-    ("short" . (builtin 2 #f))
-    ("int" . (builtin 4 #f))
-    ("long" . (builtin 4 #f))
-    ("long long" . (builtin 8 #f))
+  '(("char" . (builtin 1 0 #f))
+    ("short" . (builtin 2 0 #f))
+    ("int" . (builtin 4 0 #f))
+    ("long" . (builtin 4 0 #f))
+    ("long long" . (builtin 8 0 #f))
     ;; FIXME sign
-    ("unsigned char" . (builtin 1 #f))
-    ("unsigned short" . (builtin 2 #f))
-    ("unsigned" . (builtin 4 #f))
-    ("unsigned int" . (builtin 4 #f))
-    ("unsigned long" . (builtin 4 #f))
-    ("unsigned long long" . (builtin 8 #f))))
+    ("unsigned char" . (builtin 1 0 #f))
+    ("unsigned short" . (builtin 2 0 #f))
+    ("unsigned" . (builtin 4 0 #f))
+    ("unsigned int" . (builtin 4 0 #f))
+    ("unsigned long" . (builtin 4 0 #f))
+    ("unsigned long long" . (builtin 8 0 #f))))
 
 (define (field:size o)
   (pmatch o
@@ -968,7 +996,7 @@
     ((struct-ref (ident ,type))
      (type->size info `("struct" ,type)))
     (_ (let ((type (get-type (.types info) o)))
-         (if type (cadr type)
+         (if type (type:size type)
              (error "type->size: unsupported: " o))))))
 
 (define (field-offset info struct field)
@@ -1214,7 +1242,7 @@
      (type->description info `("struct" ,type)))
     (_ (let ((type (get-type (.types info) o)))
          (if (not type) (stderr "TYPES=~s\n" (.types info)))
-         (if type (caddr type)
+         (if type (type:description type)
              (error "type->description: unsupported:" o))))))
 
 (define (local? o) ;; formals < 0, locals > 0
@@ -1994,6 +2022,15 @@
          (let ((info ((ast->info info) `(decl (decl-spec-list (type-spec (struct-def (ident ,name) ,field-list))) (init-declr-list (init-declr (ident ,name)))))))
            (clone info #:types (cons (cons name (or (get-type types `("struct" ,name)) `(typedef ,name))) types))))
 
+        ((decl (decl-spec-list (stor-spec (typedef)) (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ptr-declr (pointer) (ident ,name)))))
+         (let* ((type (get-type types type))
+                (type (make-type name
+                                 (type:type type)
+                                 (type:size type)
+                                 (1+ (type:pointer type))
+                                 (type:description type))))
+           (clone info #:types (cons type types))))
+
         ((decl (decl-spec-list (stor-spec (typedef)) ,type) ,name)
          (format (current-error-port) "SKIP: typedef=~s\n" o)
          info)