diff --git a/GNUmakefile b/GNUmakefile index a0499aa5..800d6d6f 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -151,7 +151,7 @@ main: doc/examples/main.c GNUmakefile t: scaffold/t.c GNUmakefile rm -f $@ - gcc -nostdlib --std=gnu99 -m32 -o $@ '-DVERSION="0.4"' $< + gcc -nostdlib --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $< chmod +x $@ MAIN_C:=doc/examples/main.c diff --git a/build-aux/mes-snarf.scm b/build-aux/mes-snarf.scm index 71054379..d88ac014 100755 --- a/build-aux/mes-snarf.scm +++ b/build-aux/mes-snarf.scm @@ -80,7 +80,13 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e (define (symbol->source s i) (string-append (format #f "g_free++;\n") - (format #f "g_cells[cell_~a] = scm_~a;\n\n" s s))) + ;; FIXME: g_functions + (if GCC? + (format #f "g_cells[cell_~a] = scm_~a;\n\n" s s) + (string-append + (format #f "g_cells[cell_~a].type = scm_~a.type;\n" s s) + (format #f "g_cells[cell_~a].car = scm_~a.car;\n" s s) + (format #f "g_cells[cell_~a].cdr = scm_~a.cdr;\n\n" s s))))) (define (symbol->names s i) (string-append @@ -110,7 +116,14 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e (format #f "~a.cdr = g_function;\n" (function-builtin-name f))) (format #f "g_functions[g_function++] = fun_~a;\n" (.name f)) (format #f "cell_~a = g_free++;\n" (.name f)) - (format #f "g_cells[cell_~a] = ~a;\n\n" (.name f) (function-builtin-name f)))) + ;; FIXME: g_functions + (if GCC? + (format #f "g_cells[cell_~a] = ~a;\n\n" (.name f) (function-builtin-name f)) + (string-append + (format #f "g_cells[cell_~a].type = ~a.type;\n" (.name f) (function-builtin-name f)) + (format #f "g_cells[cell_~a].car = ~a.car;\n" (.name f) (function-builtin-name f)) + ;;(format #f "g_cells[cell_~a].car = MAKE_STRING (~a.car);\n" (.name f) (function-builtin-name f)) + (format #f "g_cells[cell_~a].cdr = ~a.cdr;\n\n" (.name f) (function-builtin-name f)))))) (define (function->environment f i) (string-append diff --git a/module/language/c99/compiler.mes b/module/language/c99/compiler.mes index 339bbdae..35abc763 100644 --- a/module/language/c99/compiler.mes +++ b/module/language/c99/compiler.mes @@ -1046,7 +1046,7 @@ (cadr (assoc-ref (.types info) o))) (define (ident->decl info o) - (stderr "ident->decl o=~s\n" o) + ;; (stderr "ident->decl o=~s\n" o) ;; (stderr " types=~s\n" (.types info)) ;; (stderr " local=~s\n" (assoc-ref (.locals info) o)) ;; (stderr " global=~s\n" (assoc-ref (.globals info) o)) @@ -1671,19 +1671,15 @@ ;; SCM g_stack = 0; ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident ,name) (initzer (p-expr (fixed ,value)))))) ;;(stderr "2TYPE: ~s\n" type) - (if (.function info) - (let* ((locals (add-local locals name type 0)) - (globals (append globals (list (string->global value)))) - (info (clone info #:locals locals #:globals globals))) - (clone info #:text - (append text - (list (lambda (f g ta t d) - (append - (i386:global->accu (+ (data-offset value g) d))))) - ((accu->ident info) name)))) - (let* ((value (length (globals->data globals))) - (globals (append globals (list (ident->global name type 0 value))))) - (clone info #:globals globals)))) + (let ((value (cstring->number value))) + (if (.function info) + (let* ((locals (add-local locals name type 0)) + (info (clone info #:locals locals))) + (clone info #:text + (append text + ((value->ident info) name value)))) + (let ((globals (append globals (list (ident->global name type 0 value))))) + (clone info #:globals globals))))) ;; SCM g_stack = 0; // comment ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ident _) (initzer (p-expr (fixed _))))) (comment _)) @@ -2099,8 +2095,20 @@ (initzer->data info functions globals ta t d (car initzers)) (list-tail data (+ here offset field-size))))))))))))))) + ((decl (decl-spec-list (type-spec (typename ,type))) (init-declr-list (init-declr (ftn-declr (ident ,name) (param-list . ,param-list))))) + info) + + ((decl (decl-spec-list (stor-spec (typedef)) ,type) ,name) + (format (current-error-port) "SKIP: typedef=~s\n" o) + info) + + ((decl (@ ,at)) + (format (current-error-port) "SKIP: at=~s\n" o) + info) + ((decl . _) (format (current-error-port) "SKIP: decl statement=~s\n" o) + barf info) (_ diff --git a/module/mes/elf.mes b/module/mes/elf.mes index dcb52f6b..5b914ca0 100644 --- a/module/mes/elf.mes +++ b/module/mes/elf.mes @@ -272,7 +272,8 @@ (define section-headers-offset (+ str-offset str-length)) - (format (current-error-port) "ELF text=~a\n" (map dec->hex text)) + (if (< (length text) 2000) + (format (current-error-port) "ELF text=~a\n" (map dec->hex text))) (if (< (length raw-data) 200) (format (current-error-port) "ELF raw-data=~a\n" (map dec->hex raw-data))) (if (< (length data) 200) diff --git a/module/mes/libc-i386.mes b/module/mes/libc-i386.mes index 70bc4935..6bfe7b43 100644 --- a/module/mes/libc-i386.mes +++ b/module/mes/libc-i386.mes @@ -28,8 +28,11 @@ '(#x55 ; push %ebp #x89 #xe5)) ; mov %esp,%ebp +;; (define (i386:function-locals) +;; '(#x83 #xec #x20)) ; sub $0x10,%esp -- 8 local vars + (define (i386:function-locals) - '(#x83 #xec #x20)) ; sub $0x10,%esp -- 8 local vars + '(#x83 #xec #x40)) ; sub $0x10,%esp -- 16 local vars (define (i386:push-global-address o) (or o push-global-address) diff --git a/scaffold/cons-mes.c b/scaffold/cons-mes.c index d500914b..9d0a389d 100644 --- a/scaffold/cons-mes.c +++ b/scaffold/cons-mes.c @@ -1170,11 +1170,13 @@ simple_bload_env (SCM a) ///((internal)) return r2; } +char string_to_cstring_buf[1024]; char const* string_to_cstring (SCM s) { - static char buf[1024]; - char *p = buf; + //static char buf[1024]; + //char *p = buf; + char *p = string_to_cstring_buf; s = STRING(s); while (s != cell_nil) { @@ -1182,7 +1184,8 @@ string_to_cstring (SCM s) s = cdr (s); } *p = 0; - return buf; + //return buf; + return string_to_cstring_buf; } SCM diff --git a/scaffold/mini-mes.c b/scaffold/mini-mes.c index 62245d08..9de5677d 100644 --- a/scaffold/mini-mes.c +++ b/scaffold/mini-mes.c @@ -286,7 +286,8 @@ struct function { struct scm *g_cells = arena; -struct scm *g_news = 0; +//FIXME +//struct scm *g_news = 0; struct scm scm_nil = {TSPECIAL, "()",0}; struct scm scm_f = {TSPECIAL, "#f",0}; @@ -591,11 +592,6 @@ call (SCM fn, SCM x) if ((FUNCTION (fn).arity > 1 || FUNCTION (fn).arity == -1) && x != cell_nil && TYPE (CDR (x)) == TPAIR && TYPE (CADR (x)) == TVALUES) x = cons (CAR (x), cons (CDADAR (x), CDR (x))); - - eputs ("call: "); - if (FUNCTION (fn).name) eputs (FUNCTION (fn).name); - else eputs (itoa (CDR (fn))); - eputs ("\n"); switch (FUNCTION (fn).arity) { // case 0: return FUNCTION (fn).function0 (); @@ -621,12 +617,46 @@ SCM assq (SCM x, SCM a) { //while (a != cell_nil && eq_p (x, CAAR (a)) == cell_f) a = CDR (a); - while (a != cell_nil && x != CAAR (a)) a = CDR (a); -#if __GNUC__ + //while (a != cell_nil && x != CAAR (a)) a = CDR (a); + +#if BDEBUG puts ("assq: "); display_ (x); + puts (" ["); + puts (itoa (x)); + puts ("]\n"); +#endif + int i; + while (a != cell_nil) // && x != CAR (CAR (a))) + { + a = CDR (a); + // FIXME + i = CAR (CAR (a)); +#if 1 + //!__GNUC__ + // puts (" "); + // puts (itoa (i)); + // if (x == i) puts ("***FOUND*** "); + if (x == i) goto found; + // puts (" "); + // display_ (CAAR (a)); + // puts ("["); + // puts (itoa (CAAR (a))); + // puts ("]\n"); +#endif + } + found: +#if BDEBUG + //!__GNUC__ + //puts ("assq: "); + puts (" "); + puts (" ["); + puts (itoa (x)); + puts ("]"); + display_ (x); puts (" => "); - display_ (a != cell_nil ? car (a) : cell_f); + if (a == cell_nil) display_ (cell_f); + else display_ (CAR (a)); puts ("["); puts (itoa (CDR (CDR (CAR (a))))); puts ("]\n"); @@ -669,7 +699,10 @@ set_env_x (SCM x, SCM e, SCM a) SCM call_lambda (SCM e, SCM x, SCM aa, SCM a) ///((internal)) { - SCM cl = cons (cons (cell_closure, x), x); + //FIXME + //SCM cl = cons (cons (cell_closure, x), x); + SCM cl; + cl = cons (cons (cell_closure, x), x); r1 = e; r0 = cl; return cell_unspecified; @@ -774,7 +807,10 @@ eval_apply () } case TCLOSURE: { - SCM cl = CLOSURE (car (r1)); + //FIXME + //SCM cl = CLOSURE (car (r1)); + SCM cl; + cl = CLOSURE (car (r1)); SCM formals = cadr (cl); SCM body = cddr (cl); SCM aa = cdar (cl); @@ -964,8 +1000,8 @@ eval_apply () goto apply; } } - goto vm_return; #endif + goto vm_return; begin: x = cell_unspecified; while (r1 != cell_nil) { @@ -1093,8 +1129,25 @@ SCM make_symbol_ (SCM s) { VALUE (tmp_num) = TSYMBOL; - SCM x = make_cell (tmp_num, s, 0); + ///FIXMESCM x = make_cell (tmp_num, s, 0); + SCM x; + x = make_cell (tmp_num, s, 0); puts ("MAKE SYMBOL: "); + // puts ("[s="); + // puts (itoa (s)); + // puts (",s.car="); + // puts (itoa (CAR (s))); + // puts (",s.car.cdr="); + // // puts (itoa (CDR (CAR (s)))); + // putchar (CDR (CAR (s))); + // puts (",x="); + // puts (itoa (x)); + // puts (",x.car="); + // puts (itoa (CAR (x))); + // puts ("]"); + + + ////TYPE (x) = TSYMBOL; display_ (x); puts ("\n"); g_symbols = cons (x, g_symbols); @@ -1117,24 +1170,36 @@ SCM lookup_symbol_ (SCM s) { SCM x = g_symbols; +#if !MES_MINI while (x) { if (list_of_char_equal_p (STRING (car (x)), s) == cell_t) break; x = cdr (x); } if (x) x = car (x); +#endif; return x; } SCM make_symbol (SCM s) { -#if 0 - // MINI_MES - SCM x = 0; +#if MES_MINI + return make_symbol_ (s); #else SCM x = lookup_symbol_ (s); -#endif + // FIXME: does not work with mescc?! + // return x != 0 ? x : make_symbol_ (s); return x ? x : make_symbol_ (s); +#endif +// FIXME +// #if MES_MINI +// SCM x = 0; +// #else +// SCM x = lookup_symbol_ (s); +// #endif +// //FIXME +// //return x ? x : make_symbol_ (s); +// return x != 0 ? x : make_symbol_ (s); } SCM @@ -1143,16 +1208,38 @@ cstring_to_list (char const* s) char *x = s; SCM p = cell_nil; int i = strlen (s); + puts ("cstring_to_list["); + puts (s); + puts ("]: "); while (i--) { #if 0 //FIXME p = cons (MAKE_CHAR (s[i]), p); #else - p = cons (MAKE_CHAR (*x), p); + char c; + c = *x; + puts ("[c:"); + putchar (c); +#if __GNUC__ + p = cons (MAKE_CHAR (c), p); +#else + SCM xx; + xx = MAKE_CHAR (c); + //FIXME + TYPE (xx) = 0; + VALUE (xx) = c; + puts (",t="); + puts (itoa (TYPE (xx))); + puts (",v="); + putchar (VALUE (xx)); + puts ("]"); + p = cons (xx, p); +#endif x++; #endif } + puts ("\n"); return p; } @@ -1168,7 +1255,6 @@ acons (SCM key, SCM value, SCM alist) SCM write_byte (SCM x) ///((arity . n)) { - puts ("write-byte 00\n"); SCM c = car (x); SCM p = cdr (x); int fd = 1; @@ -1176,7 +1262,10 @@ write_byte (SCM x) ///((arity . n)) //FILE *f = fd == 1 ? stdout : stderr; assert (TYPE (c) == TNUMBER || TYPE (c) == TCHAR); // fputc (VALUE (c), f); - char cc = VALUE (c); + // FIXME + //char cc = VALUE (c); + char cc; + cc = VALUE (c); write (1, (char*)&cc, fd); return c; } @@ -1196,24 +1285,28 @@ display_ (SCM x) } case TFUNCTION: { -#if __GNUC__ +#if 1 puts ("#"); break; #endif - //puts ("\n"); - if (VALUE (x) == 0) - puts ("make-cell"); - if (VALUE (x) == 1) - puts ("cons"); - if (VALUE (x) == 2) - puts ("car"); - if (VALUE (x) == 3) - puts ("cdr"); - break; + // //puts ("\n"); + // if (VALUE (x) == 0) + // puts ("make-cell"); + // if (VALUE (x) == 1) + // puts ("cons"); + // if (VALUE (x) == 2) + // puts ("car"); + // if (VALUE (x) == 3) + // puts ("cdr"); + // break; } case TNUMBER: { @@ -1275,43 +1368,35 @@ display_ (SCM x) case TSYMBOL: { #if 0 - switch (x) - { - case 11: {puts (" . "); break;} - case 12: {puts ("lambda"); break;} - case 13: {puts ("begin"); break;} - case 14: {puts ("if"); break;} - case 15: {puts ("quote"); break;} - case 37: {puts ("car"); break;} - case 38: {puts ("cdr"); break;} - case 39: {puts ("null?"); break;} - case 40: {puts ("eq?"); break;} - case 41: {puts ("cons"); break;} - default: - { -#if __GNUC__ puts (""); -#else - puts (""); #endif - } - } - break; -#else - SCM t = CAR (x); + // FIXME + ///SCM t = CAR (x); + SCM t; + t = CAR (x); while (t != cell_nil) { + //FIXME + //SCM xx = CAR (t); + // SCM xx; + // xx = CAR (t); + // puts ("[c:"); + // puts (itoa (xx)); + // puts (","); + // puts (itoa (VALUE (xx))); + // puts ("]"); + // putchar (VALUE (xx)); putchar (VALUE (CAR (t))); t = CDR (t); } -#endif + break; } default: { //puts ("\n"); -#if __GNUC__ +#if 1 puts ("<"); puts (itoa (TYPE (x))); puts (":"); @@ -1407,9 +1492,6 @@ mes_builtins (SCM a) ///((internal)) // #include "posix.environment.i" // #include "reader.environment.i" - puts ("cell_write_byte: "); - puts (itoa (CDR (cell_write_byte))); - puts ("\n"); return a; } @@ -1439,7 +1521,8 @@ bload_env (SCM a) ///((internal)) g_symbols = r1; g_stdin = STDIN; r0 = mes_builtins (r0); -#if __GNUC__ +#if 1 + //__GNUC__ puts ("symbols: "); SCM s = g_symbols; while (s && s != cell_nil) { @@ -1465,11 +1548,13 @@ bload_env (SCM a) ///((internal)) return r2; } +char string_to_cstring_buf[1024]; char const* string_to_cstring (SCM s) { - static char buf[1024]; - char *p = buf; + //static char buf[1024]; + //char *p = buf; + char *p = string_to_cstring_buf; s = STRING(s); while (s != cell_nil) { @@ -1477,7 +1562,8 @@ string_to_cstring (SCM s) s = cdr (s); } *p = 0; - return buf; + //return buf; + return string_to_cstring_buf; } SCM @@ -1509,6 +1595,16 @@ int main (int argc, char *argv[]) { eputs ("Hello mini-mes!\n"); + + // make_tmps (g_cells); + // SCM x = cstring_to_list ("bla"); + // while (x != 1) + // { + // putchar (CDR (CAR (x))); + // x = CDR (x); + // } + // return 0; + #if __GNUC__ //g_debug = getenv ("MES_DEBUG"); #endif diff --git a/scaffold/t.c b/scaffold/t.c index 5121c969..23def0f2 100644 --- a/scaffold/t.c +++ b/scaffold/t.c @@ -117,7 +117,7 @@ int functions[2]; struct function g_functions[2]; int g_function = 0; -enum type_t {CHAR, CLOSURE, CONTINUATION, TFUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, TSTRING, SYMBOL, VALUES, TVECTOR, BROKEN_HEART}; +enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART}; typedef int SCM; int g_free = 3; @@ -193,7 +193,7 @@ swits (int c) switch (c) { - case CHAR: {goto next;} + case TCHAR: {goto next;} case 1: {goto next;} case 2: {goto next;} default: {goto next;} @@ -277,7 +277,7 @@ make_cell (SCM type, SCM car, SCM cdr) { SCM x = alloc (1); TYPE (x) = VALUE (type); - if (VALUE (type) == CHAR || VALUE (type) == NUMBER) { + if (VALUE (type) == TCHAR || VALUE (type) == TNUMBER) { if (car) CAR (x) = CAR (car); if (cdr) CDR(x) = CDR(cdr); } @@ -295,7 +295,7 @@ make_cell (SCM type, SCM car, SCM cdr) SCM make_cell_test () { - VALUE (tmp_num) = PAIR; + VALUE (tmp_num) = TPAIR; make_cell (tmp_num, 0, 1); return math_test (); } @@ -306,9 +306,9 @@ make_tmps_test (struct scm* cells) puts ("t: tmp = g_free++\n"); tmp = g_free++; puts ("t: cells[tmp].type = CHAR\n"); - cells[tmp].type = CHAR; + cells[tmp].type = TCHAR; tmp_num = g_free++; - cells[tmp_num].type = NUMBER; + cells[tmp_num].type = TNUMBER; return make_cell_test(); }