artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mescc: Parse mlibc early, show progress.

Browse source 
* 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.
This commit is contained in:
Jan Nieuwenhuizen 2017-04-24 19:09:54 +02:00
parent 8e6ae9ea5f
commit 26dcf7136b
4 changed files with 121 additions and 148 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
guile/mescc.scm
View file

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

16
module/language/c99/compiler.mes
View file

@ -1824,7 +1824,7 @@
(formals (.formals o)) (formals (.formals o))
(text (formals->text formals)) (text (formals->text formals))
(locals (formals->locals 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)) (let loop ((statements (.statements o))
(info (clone info #:locals locals #:function (.name o) #:text text))) (info (clone info #:locals locals #:function (.name o) #:text text)))
(if (null? statements) (clone info (if (null? statements) (clone info
@ -1841,14 +1841,18 @@
(loop (cdr elements) ((ast->info info) (car elements))))))) (loop (cdr elements) ((ast->info info) (car elements)))))))
(define (c99-input->info) (define (c99-input->info)
(stderr "COMPILE\n") (let* ((info (make <info>
(let* ((ast (c99-input->ast))
(info (make <info>
#:functions i386:libc #:functions i386:libc
#:types i386:type-alist)) #: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) ast))
(info ((ast->info info) _start))) (info ((ast->info info) (_start))))
info)) info))
(define (write-any x) (define (write-any x)

243
module/mes/libc.mes
View file

@ -31,10 +31,11 @@
(mes-use-module (nyacc lang c99 parser)) (mes-use-module (nyacc lang c99 parser))
(mes-use-module (mes libc-i386)))) (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")
(string-append " (with-input-from-string
(string-append "
char **g_environment; char **g_environment;
char ** char **
_env (char **e) _env (char **e)
@ -51,13 +52,12 @@ _start ()
int r = main (); int r = main ();
exit (r); 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 int
strlen (char const* s) strlen (char const* s)
{ {
@ -65,14 +65,12 @@ strlen (char const* s)
while (s[i]) i++; while (s[i]) i++;
return 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 g_stdin = 0;
int ungetc_char = -1; int ungetc_char = -1;
char ungetc_buf[2]; char ungetc_buf[2];
@ -86,27 +84,25 @@ getchar ()
int r = read (g_stdin, &c, 1); int r = read (g_stdin, &c, 1);
if (r < 1) return -1; if (r < 1) return -1;
i = c; i = c;
} }
else else
{ {
//FIXME //FIXME
//i = ungetc_buf[ungetc_char--]; //i = ungetc_buf[ungetc_char--];
i = ungetc_buf[ungetc_char]; i = ungetc_buf[ungetc_char];
//ungetc_char--; //ungetc_char--;
ungetc_char = ungetc_char - 1; ungetc_char = ungetc_char - 1;
} }
if (i < 0) i += 256; if (i < 0) i += 256;
return i; 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 void
assert_fail (char* s) assert_fail (char* s)
{ {
@ -118,14 +114,12 @@ assert_fail (char* s)
fail = 0; fail = 0;
*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)) //#define assert(x) ((x) ? (void)0 : assert_fail (#x))
int int
ungetc (int c, int fd) ungetc (int c, int fd)
@ -138,43 +132,37 @@ ungetc (int c, int fd)
ungetc_char++; ungetc_char++;
ungetc_buf[ungetc_char] = c; ungetc_buf[ungetc_char] = c;
return 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 int
putchar (int c) putchar (int c)
{ {
write (1, (char*)&c, 1); write (1, (char*)&c, 1);
return 0; 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 int
fputc (int c, int fd) fputc (int c, int fd)
{ {
write (fd, (char*)&c, 1); write (fd, (char*)&c, 1);
return 0; 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 int
eputs (char const* s) eputs (char const* s)
{ {
@ -182,14 +170,13 @@ eputs (char const* s)
write (2, s, i); write (2, s, i);
return 0; 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 int
fputs (char const* s, int fd) fputs (char const* s, int fd)
{ {
@ -197,14 +184,12 @@ fputs (char const* s, int fd)
write (fd, s, i); write (fd, s, i);
return 0; 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 int
puts (char const* s) puts (char const* s)
{ {
@ -212,31 +197,27 @@ puts (char const* s)
write (1, s, i); write (1, s, i);
return 0; 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 int
strcmp (char const* a, char const* b) strcmp (char const* a, char const* b)
{ {
while (*a && *b && *a == *b) while (*a && *b && *a == *b)
{ {
a++;b++; a++;b++;
} }
return *a - *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]; char itoa_buf[10];
char const* char const*
@ -255,24 +236,22 @@ itoa (int x)
x = -x; x = -x;
do do
{ {
*p-- = '0' + (x % 10); *p-- = '0' + (x % 10);
x = x / 10; x = x / 10;
} while (x); } while (x);
if (sign) if (sign)
*p-- = '-'; *p-- = '-';
return p+1; 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 int
isdigit (char c) isdigit (char c)
{ {
@ -280,14 +259,12 @@ isdigit (char c)
if (c>='0' && c<='9') return 1; if (c>='0' && c<='9') return 1;
return 0; 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 int
atoi (char const *s) atoi (char const *s)
{ {
@ -306,14 +283,12 @@ atoi (char const *s)
} }
return i * sign; 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; //void *g_malloc_base = 0;
char *g_malloc_base = 0; char *g_malloc_base = 0;
@ -328,14 +303,12 @@ malloc (int size)
brk (p+size); brk (p+size);
return p; 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 * //void *
int * int *
//realloc (void *p, int size) //realloc (void *p, int size)
@ -344,27 +317,23 @@ realloc (int *p, int size)
brk (g_malloc_base + size); brk (g_malloc_base + size);
return g_malloc_base; 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 int
strncmp (char const* a, char const* b, int length) strncmp (char const* a, char const* b, int length)
{ {
while (*a && *b && *a == *b && --length) {a++;b++;} while (*a && *b && *a == *b && --length) {a++;b++;}
return *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 **g_environment;
char const* char const*
@ -380,11 +349,7 @@ getenv (char const* s)
} }
return 0; return 0;
} }
" " parse-c99))
;;paredit:"
parse-c99)))
ast))
(define libc (define libc
(list (list

5
scripts/mescc.mes
View file

@ -63,10 +63,11 @@ exit $r
(cdr mfiles))) (cdr mfiles)))
(mfile (if (null? mfiles) (string-append %docdir "examples/main.c") (mfile (if (null? mfiles) (string-append %docdir "examples/main.c")
(car mfiles)))) (car mfiles))))
(format (current-error-port) "compiling: ~a\n" mfile) (format (current-error-port) "input: ~a\n" mfile)
(with-input-from-file mfile (with-input-from-file mfile
c99-input->elf))) 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)) (main (command-line))
() ()