mescc: Parse mlibc early, show progress.

* module/mes/libc.mes (_start, strlen, getchar, assert_fail, ungetc,
  putchar, fputc, eputs, fputs, puts, strcmp, itoa, isdigit, atoi,
  malloc, realloc, strncmp, c:getenv): Change to function, add
  progress.  Update callers.
* module/language/c99/compiler.mes (c99-input->info): Compile libc separately.
* guile/mescc.scm: Update progress.
* scripts/mescc.mes: Update progress.

guile/mescc.scm

@@ -61,6 +61,9 @@ GUILE='~/src/guile-1.8/build/pre-inst-guile --debug -q' guile/mescc.scm
           ((equal? file "--version")
            (format (current-error-port) "mescc.scm (mes) ~a\n" %version)
            (exit 0)))
-    (format (current-error-port) "compiling: ~a\n" file)
+    (format (current-error-port) "input: ~a\n" file)
     (with-input-from-file file
       c99-input->elf)))
+
+(format (current-error-port) "compiler loaded\n")
+(format (current-error-port) "calling ~s\n" (cons 'main (command-line)))

module/language/c99/compiler.mes

@@ -1824,7 +1824,7 @@
            (formals (.formals o))
            (text (formals->text formals))
            (locals (formals->locals formals)))
-      (format (current-error-port) "compiling ~s\n" name)
+      (format (current-error-port) "compiling: ~a\n" name)
       (let loop ((statements (.statements o))
                  (info (clone info #:locals locals #:function (.name o) #:text text)))
         (if (null? statements) (clone info
@@ -1841,14 +1841,18 @@
           (loop (cdr elements) ((ast->info info) (car elements)))))))
 
 (define (c99-input->info)
-  (stderr "COMPILE\n")
+  (let* ((info (make <info>
-  (let* ((ast (c99-input->ast))
-         (info (make <info>
                  #:functions i386:libc
                  #:types i386:type-alist))
-         (ast (append libc ast))
+         (foo (stderr "compiling: mlibc\n"))
+         (info (let loop ((info info) (libc libc))
+                 (if (null? libc) info
+                     (loop ((ast->info info) ((car libc))) (cdr libc)))))
+         (foo (stderr "parsing: input\n"))
+         (ast (c99-input->ast))
+         (foo (stderr "compiling: input\n"))
          (info ((ast->info info) ast))
-         (info ((ast->info info) _start)))
+         (info ((ast->info info) (_start))))
     info))
 
 (define (write-any x)

module/mes/libc.mes

@@ -31,9 +31,10 @@
   (mes-use-module (nyacc lang c99 parser))
   (mes-use-module (mes libc-i386))))
 
-(define _start
+(define (_start)
-  (let* ((argc-argv (i386:_start))
+  (let ((argc-argv (i386:_start)))
-         (ast (with-input-from-string
+    (format (current-error-port) "parsing: _start\n")
+    (with-input-from-string
         (string-append "
 char **g_environment;
 char **
@@ -51,12 +52,11 @@ _start ()
   int r = main ();
   exit (r);
 }
-")
+") parse-c99)))
-                parse-c99)))
-    ast))
 
-(define strlen
+(define (strlen)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: strlen\n")
+  (with-input-from-string
       "
 int
 strlen (char const* s)
@@ -65,13 +65,11 @@ strlen (char const* s)
   while (s[i]) i++;
   return i;
 }
-"
+"  parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define getchar
+(define (getchar)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: getchar\n")
+  (with-input-from-string
       "
 int g_stdin = 0;
 int ungetc_char = -1;
@@ -99,13 +97,11 @@ getchar ()
 
   return i;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define assert_fail
+(define (assert_fail)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: assert_fail\n")
+  (with-input-from-string
                "
 void
 assert_fail (char* s)
@@ -118,13 +114,11 @@ assert_fail (char* s)
   fail = 0;
   *fail = 0;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define ungetc
+(define (ungetc)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: ungetc\n")
+  (with-input-from-string
                 "
 //#define assert(x) ((x) ? (void)0 : assert_fail (#x))
 int
@@ -139,13 +133,11 @@ ungetc (int c, int fd)
   ungetc_buf[ungetc_char] = c;
   return c;
  }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define putchar
+(define (putchar)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: putchar\n")
+  (with-input-from-string
                "
 int
 putchar (int c)
@@ -153,13 +145,11 @@ putchar (int c)
   write (1, (char*)&c, 1);
   return 0;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define fputc
+(define (fputc)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: fputc\n")
+  (with-input-from-string
                "
 int
 fputc (int c, int fd)
@@ -167,13 +157,11 @@ fputc (int c, int fd)
   write (fd, (char*)&c, 1);
   return 0;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define eputs
+(define (eputs)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: eputs\n")
+  (with-input-from-string
                "
 int
 eputs (char const* s)
@@ -182,13 +170,12 @@ eputs (char const* s)
   write (2, s, i);
   return 0;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define fputs
+
-  (let* ((ast (with-input-from-string
+(define (fputs)
+  (format (current-error-port) "parsing: fputs\n")
+  (with-input-from-string
                "
 int
 fputs (char const* s, int fd)
@@ -197,13 +184,11 @@ fputs (char const* s, int fd)
   write (fd, s, i);
   return 0;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define puts
+(define (puts)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: puts\n")
+  (with-input-from-string
                "
 int
 puts (char const* s)
@@ -212,13 +197,11 @@ puts (char const* s)
   write (1, s, i);
   return 0;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define strcmp
+(define (strcmp)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: strcmp\n")
+  (with-input-from-string
                "
 int
 strcmp (char const* a, char const* b)
@@ -229,13 +212,11 @@ strcmp (char const* a, char const* b)
     }
   return *a - *b;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define itoa
+(define (itoa)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: itoa\n")
+  (with-input-from-string
                "
 char itoa_buf[10];
 
@@ -265,13 +246,11 @@ itoa (int x)
 
   return p+1;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define isdigit
+(define (isdigit)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: isdigit\n")
+  (with-input-from-string
                "
 int
 isdigit (char c)
@@ -280,13 +259,11 @@ isdigit (char c)
   if (c>='0' && c<='9') return 1;
   return 0;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define atoi
+(define (atoi)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: atoi\n")
+  (with-input-from-string
                "
 int
 atoi (char const *s)
@@ -306,13 +283,11 @@ atoi (char const *s)
     }
   return i * sign;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define malloc
+(define (malloc)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: malloc\n")
+  (with-input-from-string
                "
 //void *g_malloc_base = 0;
 char *g_malloc_base = 0;
@@ -328,13 +303,11 @@ malloc (int size)
   brk (p+size);
   return p;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define realloc
+(define (realloc)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: realloc\n")
+  (with-input-from-string
                "
 //void *
 int *
@@ -344,13 +317,11 @@ realloc (int *p, int size)
   brk (g_malloc_base + size);
   return g_malloc_base;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define strncmp
+(define (strncmp)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: strncmp\n")
+  (with-input-from-string
                "
 int
 strncmp (char const* a, char const* b, int length)
@@ -358,13 +329,11 @@ strncmp (char const* a, char const* b, int length)
   while (*a && *b && *a == *b && --length) {a++;b++;}
   return *a - *b;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
 
-(define c:getenv
+(define (c:getenv)
-  (let* ((ast (with-input-from-string
+  (format (current-error-port) "parsing: getenv\n")
+  (with-input-from-string
                   "
 char **g_environment;
 char const*
@@ -380,11 +349,7 @@ getenv (char const* s)
     }
   return 0;
 }
-"
+" parse-c99))
-;;paredit:"
-                parse-c99)))
-    ast))
-
 
 (define libc
   (list

scripts/mescc.mes

@@ -63,10 +63,11 @@ exit $r
                      (cdr mfiles)))
          (mfile (if (null? mfiles) (string-append %docdir "examples/main.c")
                     (car mfiles))))
-    (format (current-error-port) "compiling: ~a\n" mfile)
+    (format (current-error-port) "input: ~a\n" mfile)
     (with-input-from-file mfile
       c99-input->elf)))
 
-(format (current-error-port) "calling main, command-line=~s\n" (command-line))
+(format (current-error-port) "compiler loaded\n")
+(format (current-error-port) "calling ~s\n" (cons 'main (command-line)))
 (main (command-line))
 ()