From c210959c49ad2f661ef02b4de43ddae68e51e95d Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Tue, 10 Jan 2017 20:05:47 +0100 Subject: [PATCH] mescc: Read and display sexp dumped by mes. * lib.c (dump)[MES_HACK]: Dump small hello-world sexp, to be handled by * doc/examples/tiny-mes.c (display_): New function. * module/mes/libc-i386.mes (i386:accu->base, i386:mem->accu, i386:mem+n->accu): New functions. * module/mes/libc-i386.scm: Export them. * GNUmakefile (mes-32): New target. --- GNUmakefile | 8 + lib.c | 28 +++ module/language/c99/compiler.mes | 8 +- module/mes/libc-i386.mes | 11 +- module/mes/libc-i386.scm | 3 + scaffold/t.c | 41 ++++- scaffold/tiny-mes.c | 293 +++++++++++++++++++++++++------ 7 files changed, 332 insertions(+), 60 deletions(-) diff --git a/GNUmakefile b/GNUmakefile index 6815176c..edc6c9fa 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -90,6 +90,14 @@ module/mes/read-0.mo: module/mes/read-0.mes mes dump: module/mes/read-0.mo +mes-32: + rm -f mes mes.o + guix environment --system=i686-linux --ad-hoc gcc-toolchain -- bash -c 'make mes CC=i686-unknown-linux-gnu-gcc LIBRARY_PATH=$${PATH%%/bin:*}/lib' + mv mes mes-32 + +module/mes/hack-32.mo: mes-32 + MES_HACK=1 ./mes-32 --dump < module/mes/read-0.mes > module/mes/hack-32.mo + guile-check: set -e; for i in $(TESTS); do\ $(GUILE) -s <(cat $(MES-0) module/mes/test.mes $$i);\ diff --git a/lib.c b/lib.c index 16c58297..f13a04c8 100644 --- a/lib.c +++ b/lib.c @@ -139,6 +139,34 @@ dump () fputc ('S', stdout); fputc (g_stack >> 8, stdout); fputc (g_stack % 256, stdout); + if (getenv ("MES_HACK")) + { + TYPE (9) = 0x2d2d2d2d; + CAR (9) = 0x2d2d2d2d; + CDR (9) = 0x3e3e3e3e; + + TYPE (10) = PAIR; + CAR (10) = 11; + CDR (10) = 12; + + TYPE (11) = CHAR; + CAR (11) = 0x58585858; + CDR (11) = 65; + + TYPE (12) = PAIR; + CAR (12) = 13; + CDR (12) = 1; + + TYPE (13) = CHAR; + CAR (11) = 0x58585858; + CDR (13) = 66; + + TYPE (14) = 0x3c3c3c3c; + CAR (14) = 0x2d2d2d2d; + CDR (14) = 0x2d2d2d2d; + + g_free = 15; + } for (int i=0; iXaccu info) `(d-sel (ident ,field) ,@d-sel))) - (b (- (cstring->number b))) + (b (cstring->number b)) (struct-type "scm") ;; FIXME (struct (assoc-ref (.types info) struct-type)) (size (length struct)) (field-size 4) ;; FIXME:4, not fixed (offset (* field-size (1- (length (member field (reverse struct) (lambda (a b) (equal? a (cdr b))))))))) - (clone info #:text (append (.text expr) (list (lambda (f g t d) - (i386:value->accu-ref+n offset b))))))) + (append + (i386:mem+n->accu offset) + (i386:value->base b) + (i386:test-base)))))))) ((gt (p-expr (ident ,a)) (p-expr (fixed ,b))) (let ((b (cstring->number b))) diff --git a/module/mes/libc-i386.mes b/module/mes/libc-i386.mes index cfbec17c..1c6cab1a 100644 --- a/module/mes/libc-i386.mes +++ b/module/mes/libc-i386.mes @@ -84,9 +84,12 @@ #xc3 ; ret ))) +(define (i386:accu->base) + '(#x89 #xc2)) ; mov %eax,%edx + (define (i386:accu->local n) (or n accu->local) - `(#x89 #x45 ,(- 0 (* 4 n)))) ; mov ,%eax,-<0xn>(%ebp) + `(#x89 #x45 ,(- 0 (* 4 n)))) ; mov %eax,-<0xn>(%ebp) (define (i386:accu->global n) (or n accu->global) @@ -153,6 +156,12 @@ '(#x01 #xd0 ; add %edx,%eax #x8b #x00)) ; mov (%eax),%eax +(define (i386:mem->accu) + '(#x8b #x00)) ; mov (%eax),%eax + +(define (i386:mem+n->accu n) + `(#x8b #x40 ,n)) ; mov 0x(%eax),%eax + (define (i386:base-mem+n->accu n) `(#x01 #xd0 ; add %edx,%eax #x8b #x40 ,n)) ; mov (%eax),%eax diff --git a/module/mes/libc-i386.scm b/module/mes/libc-i386.scm index dc020a29..1ecb6180 100644 --- a/module/mes/libc-i386.scm +++ b/module/mes/libc-i386.scm @@ -30,6 +30,7 @@ #:export ( i386:accu-not i386:accu-cmp-value + i386:accu->base i386:accu->global i386:accu->local i386:accu-non-zero? @@ -74,6 +75,8 @@ i386:local-address->accu i386:local-ref->base i386:local-test + i386:mem->accu + i386:mem+n->accu i386:push-accu i386:push-global i386:push-global-ref diff --git a/scaffold/t.c b/scaffold/t.c index 79590fba..39884362 100644 --- a/scaffold/t.c +++ b/scaffold/t.c @@ -147,6 +147,7 @@ test (char *p) int f = 0; int t = 1; int one = 1; + char c = 'C'; puts ("t: if (0)\n"); if (0) return 1; @@ -206,11 +207,22 @@ test (char *p) puts ("t: (f) ?\n"); (f) ? exit (1) : 1; + puts ("t: *g_cells != 'A'\n"); + arena[0] = 'A'; + if (*g_cells != 'A') return 1; + + puts ("t: *x != 'A'\n"); + char *x = g_cells; + if (*x != 'A') return 1; + puts ("t: *x != 'Q'\n"); g_cells[0] = 'Q'; - char *x = g_cells; if (*x != 'Q') return 1; + puts ("t: *x++ != 'C'\n"); + *x++ = c; + if (*g_cells != 'C') return 1; + puts ("t: switch 0\n"); if (swits (0) != 0) return swits (0); @@ -281,12 +293,39 @@ test (char *p) puts ("t: if (++i)\n"); if (++i) goto ok9; + return 1; ok9: puts ("t: if (i--)\n"); if (i--) goto ok10; + return 1; ok10: + puts ("t: *g_cells == 'B'\n"); + arena[0] = 'B'; + if (*g_cells == 'B') goto ok11; + return 1; + ok11: + + puts ("t: *x == 'B'\n"); + x = g_cells; + if (*x == 'B') goto ok12; + return 1; + ok12: + + puts ("t: *x == 'R'\n"); + g_cells[0] = 'R'; + x = g_cells; + if (*x == 'R') goto ok13; + return 1; + ok13: + + puts ("t: *x++ == 'C'\n"); + *x++ = c; + if (*g_cells == 'C') goto ok14; + return 1; + ok14: + puts ("t: for (i=0; i<4; ++i)\n"); for (i=0; i<4; ++i); if (i != 4) return i; diff --git a/scaffold/tiny-mes.c b/scaffold/tiny-mes.c index 58bbbd9b..5e7261b2 100644 --- a/scaffold/tiny-mes.c +++ b/scaffold/tiny-mes.c @@ -219,9 +219,13 @@ void assert_fail (char* s) { eputs ("assert fail:"); +#if __GNUC__ eputs (s); +#endif eputs ("\n"); +#if __GNUC__ *((int*)0) = 0; +#endif } #if __GNUC__ @@ -246,56 +250,36 @@ SCM r1 = 0; // param 1 SCM r2 = 0; // save 2+load/dump SCM r3 = 0; // continuation -typedef int SCM; #if __NYACC__ || FIXME_NYACC enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, TSTRING, SYMBOL, VALUES, TVECTOR, BROKEN_HEART}; #else enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, STRING, SYMBOL, VALUES, VECTOR, BROKEN_HEART}; #endif -typedef SCM (*function0_t) (void); -typedef SCM (*function1_t) (SCM); -typedef SCM (*function2_t) (SCM, SCM); -typedef SCM (*function3_t) (SCM, SCM, SCM); -typedef SCM (*functionn_t) (SCM); -typedef struct function_struct { - union { - function0_t function0; - function1_t function1; - function2_t function2; - function3_t function3; - functionn_t functionn; - } data; - int arity; -} function_t; -struct scm; -typedef struct scm_struct { +struct scm { enum type_t type; - union { - char const *name; - SCM string; - SCM car; - SCM ref; - int length; - } NYACC_CAR; - union { - int value; - int function; - SCM cdr; - SCM closure; - SCM continuation; - SCM macro; - SCM vector; - int hits; - } NYACC_CDR; -} scm; + SCM car; + SCM cdr; +}; -char arena[200000]; -scm *g_cells = (scm*)arena; +#if 0 +char arena[200]; +struct scm *g_cells = (struct scm*)arena; +#else +struct scm g_cells[200]; +#endif + +#define cell_nil 1 +#define cell_f 2 +#define cell_t 3 + +#define TYPE(x) (g_cells[x].type) #define CAR(x) g_cells[x].car #define CDR(x) g_cells[x].cdr +//#define VALUE(x) g_cells[x].value +#define VALUE(x) g_cells[x].cdr SCM car (SCM x) @@ -350,57 +334,254 @@ mes_builtins (SCM a) return a; } +SCM +fill () +{ + TYPE (0) = 0x6c6c6168; + CAR (0) = 0x6a746f6f; + CDR (0) = 0x00002165; + + TYPE (1) = SYMBOL; + CAR (1) = 0x2d2d2d2d; + CDR (1) = 0x3e3e3e3e; + + TYPE (9) = 0x2d2d2d2d; + CAR (9) = 0x2d2d2d2d; + CDR (9) = 0x3e3e3e3e; +#if 0 + // (A(B)) + TYPE (10) = PAIR; + CAR (10) = 11; + CDR (10) = 12; + + TYPE (11) = CHAR; + CAR (11) = 0x58585858; + CDR (11) = 89; + + TYPE (12) = PAIR; + CAR (12) = 13; + CDR (12) = 1; + + TYPE (13) = CHAR; + CAR (11) = 0x58585858; + CDR (13) = 90; + + TYPE (14) = 0x58585858; + CAR (14) = 0x58585858; + CDR (14) = 0x58585858; + + TYPE (14) = 0x58585858; + CAR (14) = 0x58585858; + CDR (14) = 0x58585858; +#else + // (cons 0 1) + TYPE (10) = PAIR; + CAR (10) = 11; + CDR (10) = 12; + + TYPE (11) = FUNCTION; + CAR (11) = 0x58585858; + // 0 = make_cell + // 1 = cons + CDR (11) = 1; + + TYPE (12) = PAIR; + CAR (12) = 13; + CDR (12) = 14; + + TYPE (13) = NUMBER; + CAR (13) =0x58585858; + CDR (13) = 0; + + TYPE (14) = PAIR; + CAR (14) = 15; + CDR (14) = 1; + + TYPE (15) = NUMBER; + CAR (15) = 0x58585858; + CDR (15) = 1; + +#endif + TYPE (16) = 0x3c3c3c3c; + CAR (16) = 0x2d2d2d2d; + CDR (16) = 0x2d2d2d2d; + return 0; +} + +SCM +display_ (SCM x) +{ + //puts ("\n"); + switch (TYPE (x)) + { + case CHAR: + { + //puts ("\n"); + puts ("#\\"); + putchar (VALUE (x)); + break; + } + case FUNCTION: + { + //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 NUMBER: + { + //puts ("\n"); +#if __GNUC__ + putchar (48 + VALUE (x)); +#else + int i; + i = VALUE (x); + i = i + 48; + putchar (i); +#endif + break; + } + case PAIR: + { + //puts ("\n"); + //if (cont != cell_f) puts "("); + puts ("("); + if (x && x != cell_nil) display_ (CAR (x)); + if (CDR (x) && CDR (x) != cell_nil) + { +#if __GNUC__ + if (TYPE (CDR (x)) != PAIR) + puts (" . "); +#else + int c; + c = CDR (x); + c = TYPE (c); + if (c != PAIR) + puts (" . "); +#endif + display_ (CDR (x)); + } + //if (cont != cell_f) puts (")"); + puts (")"); + break; + } + default: + { + //puts ("\n"); + puts ("_"); + break; + } + } + return 0; +} + SCM bload_env (SCM a) ///((internal)) { - puts ("bload_env\n"); - g_stdin = open ("module/mes/read-0.mo", 0); - if (g_stdin < 0) {eputs ("no such file: module/mes/read-0.mo\n");return 1;} + //g_stdin = open ("module/mes/read-0-32.mo", 0); + g_stdin = open ("module/mes/hack-32.mo", 0); + if (g_stdin < 0) {eputs ("no such file: module/mes/read-0-32.mo\n");return 1;} + + int c; + char *p = (char*)g_cells; + char *q = (char*)g_cells; + + puts ("q: "); + puts (q); + puts ("\n"); + #if __GNUC__ puts ("fd: "); puts (itoa (g_stdin)); puts ("\n"); - //g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mo", "r"); #endif - char *p = (char*)g_cells; - // int x; - // x = getchar (); - // if (x == 'M') puts ("M"); - // x = getchar (); - // if (x == 'E') puts ("E"); - // x = getchar (); - // if (x == 'S') puts ("S"); - +#if __GNUC__ assert (getchar () == 'M'); assert (getchar () == 'E'); assert (getchar () == 'S'); - puts ("GOT MES\n"); + puts ("GOT MES!\n"); g_stack = getchar () << 8; g_stack += getchar (); - int c = getchar (); + puts ("stack: "); + puts (itoa (g_stack)); + puts ("\n"); +#else + c = getchar (); + putchar (c); + if (c != 'M') exit (10); + c = getchar (); + putchar (c); + if (c != 'E') exit (11); + c = getchar (); + putchar (c); + if (c != 'S') exit (12); + puts ("\n"); + puts ("GOT MES!\n"); + getchar (); + getchar (); +#endif + + c = getchar (); while (c != -1) { *p++ = c; c = getchar (); } - g_free = (p-(char*)g_cells) / sizeof (scm); + + puts ("q: "); + puts (q); + puts ("\n"); +#if 0 + //__GNUC__ + g_free = (p-(char*)g_cells) / sizeof (struct scm); gc_peek_frame (); g_symbols = r1; g_stdin = STDIN; r0 = mes_builtins (r0); -#if __GNUC__ puts ("cells read: "); puts (itoa (g_free)); puts ("\n"); + + puts ("symbols: "); + puts (itoa (g_symbols)); + puts ("\n"); + display_ (g_symbols); + puts ("\n"); + + r2 = 10; + puts ("\n"); + puts ("program: "); + puts (itoa (r2)); + puts ("\n"); + display_ (r2); + puts ("\n"); +#else + display_ (10); + puts ("\n"); + puts ("\n"); + fill (); + display_ (10); #endif + puts ("\n"); return r2; } int main (int argc, char *argv[]) { + puts ("filled sexp:\n"); + fill (); + display_ (10); + puts ("\n"); + #if __GNUC__ g_debug = (int)getenv ("MES_DEBUG"); #endif @@ -420,6 +601,7 @@ main (int argc, char *argv[]) #if MES_MINI puts ("Hello tiny-mes!\n"); SCM program = bload_env (r0); + #else SCM program = (argc > 1 && !strcmp (argv[1], "--load")) ? bload_env (r0) : load_env (r0); @@ -467,3 +649,4 @@ _start () exit (r); } #endif +