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.
This commit is contained in:
Jan Nieuwenhuizen
parent
2bb9f2b818
commit
c210959c49
|
|
@ -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);\
|
||||
|
|
|
|||
28
lib.c
28
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; i<g_free * sizeof(scm); i++)
|
||||
fputc (*p++, stdout);
|
||||
return 0;
|
||||
|
|
|
|||
|
|
@ -930,17 +930,19 @@
|
|||
|
||||
((eq (d-sel (ident ,field) . ,d-sel) (p-expr (fixed ,b)))
|
||||
(let* ((expr ((expr->Xaccu 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)))
|
||||
|
|
|
|||
|
|
@ -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<n>(%eax),%eax
|
||||
|
||||
(define (i386:base-mem+n->accu n)
|
||||
`(#x01 #xd0 ; add %edx,%eax
|
||||
#x8b #x40 ,n)) ; mov <n>(%eax),%eax
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
41
scaffold/t.c
41
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;
|
||||
|
|
|
|||
|
|
@ -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 ("<display>\n");
|
||||
switch (TYPE (x))
|
||||
{
|
||||
case CHAR:
|
||||
{
|
||||
//puts ("<char>\n");
|
||||
puts ("#\\");
|
||||
putchar (VALUE (x));
|
||||
break;
|
||||
}
|
||||
case FUNCTION:
|
||||
{
|
||||
//puts ("<function>\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 ("<number>\n");
|
||||
#if __GNUC__
|
||||
putchar (48 + VALUE (x));
|
||||
#else
|
||||
int i;
|
||||
i = VALUE (x);
|
||||
i = i + 48;
|
||||
putchar (i);
|
||||
#endif
|
||||
break;
|
||||
}
|
||||
case PAIR:
|
||||
{
|
||||
//puts ("<pair>\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 ("<default>\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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue