mescc: Fix add, sub, lshift.

* module/language/c99/compiler.mes (expr->accu): Fix add, sub, lshift.
* doc/examples/t.c: Test them.
* doc/examples/cons-mes.c:
* doc/examples/mini-mes.c:
This commit is contained in:
Jan Nieuwenhuizen 2017-03-02 20:19:53 +01:00
parent c9b251616a
commit 08ea0da745
4 changed files with 51 additions and 44 deletions

View File

@ -643,7 +643,7 @@
((add ,a ,b) ((add ,a ,b)
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(accu ((expr->base empty) a)) (accu ((expr->accu empty) a))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (clone info #:text
(append text (append text
@ -654,7 +654,7 @@
((sub ,a ,b) ((sub ,a ,b)
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(accu ((expr->base empty) a)) (accu ((expr->accu empty) a))
(base ((expr->base empty) b))) (base ((expr->base empty) b)))
(clone info #:text (clone info #:text
(append text (append text
@ -665,7 +665,7 @@
((lshift ,a (p-expr (fixed ,value))) ((lshift ,a (p-expr (fixed ,value)))
(let* ((empty (clone info #:text '())) (let* ((empty (clone info #:text '()))
(accu ((expr->base empty) a)) (accu ((expr->accu empty) a))
(value (cstring->number value))) (value (cstring->number value)))
(clone info #:text (clone info #:text
(append text (append text

View File

@ -592,8 +592,6 @@ assert_defined (SCM x, SCM e)
} }
#endif #endif
#if 1
//FIXME GNUC
SCM SCM
push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal)) push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
{ {
@ -607,7 +605,6 @@ push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
r3 = x; r3 = x;
return cell_unspecified; return cell_unspecified;
} }
#endif
#if __GNUC__ #if __GNUC__
SCM caar (SCM x) {return car (car (x));} SCM caar (SCM x) {return car (car (x));}
@ -635,9 +632,7 @@ SCM gc_pop_frame ();
SCM SCM
eval_apply () eval_apply ()
{ {
puts ("e/a: fixme\n");
eval_apply: eval_apply:
puts ("eval_apply\n");
// if (g_free + GC_SAFETY > ARENA_SIZE) // if (g_free + GC_SAFETY > ARENA_SIZE)
// gc_pop_frame (gc (gc_push_frame ())); // gc_pop_frame (gc (gc_push_frame ()));
@ -651,45 +646,18 @@ eval_apply ()
SCM y = cell_nil; SCM y = cell_nil;
apply: apply:
puts ("apply\n");
switch (TYPE (car (r1))) switch (TYPE (car (r1)))
{ {
case TFUNCTION: { case TFUNCTION: {
puts ("apply.function\n"); puts ("apply.function\n");
y = 0x22;
//check_formals (car (r1), MAKE_NUMBER (FUNCTION (car (r1)).arity), cdr (r1)); //check_formals (car (r1), MAKE_NUMBER (FUNCTION (car (r1)).arity), cdr (r1));
#if __GNUC__ r1 = call (car (r1), cdr (r1));
r1 = call (car (r1), cdr (r1)); /// FIXME: move into eval_apply
#else
//FIXME
x = car (r1);
y = cdr (r1);
r1 = call (x, y);
#endif
puts ("after call\n");
y = 0x44;
goto vm_return; goto vm_return;
} }
} }
// #if __GNUC__
// //FIXME
// push_cc (car (r1), r1, r0, cell_vm_apply2);
// #endif
// goto eval;
// apply2:
// //check_apply (r1, car (r2));
// r1 = cons (r1, cdr (r2));
// goto apply;
eval:
begin:
begin2:
vm_return: vm_return:
// FIXME
puts ("vm-return00\n");
x = r1; x = r1;
gc_pop_frame (); gc_pop_frame ();
puts ("vm-return01\n");
r1 = x; r1 = x;
goto eval_apply; goto eval_apply;
} }
@ -1337,7 +1305,22 @@ simple_bload_env (SCM a) ///((internal))
puts ("read done\n"); puts ("read done\n");
g_free = (p-(char*)g_cells) / sizeof (struct scm); // g_free = (p-(char*)g_cells) / sizeof (struct scm);
c = p-(char*)g_cells;
exit (c);
if (g_free != 15) exit (33);
// puts ("Xg_free: ");
// puts (itoa (g_free));
// puts ("\n");
///if (g_free != 19) return 33;
// gc_peek_frame (); // gc_peek_frame ();
// g_symbols = r1; // g_symbols = r1;
g_symbols = 1; g_symbols = 1;
@ -1446,10 +1429,22 @@ main (int argc, char *argv[])
if (argc > 1 && !strcmp (argv[1], "--dump")) return dump (); if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
#endif #endif
#if 0 #if 1
//__GNUC__
#if __GNUC__
puts ("g_free=");
puts (itoa(g_free));
puts ("\n");
#else
g_free = 19;
#endif
//return cons (r0, cell_nil);
//FIXME //FIXME
push_cc (r2, cell_unspecified, r0, cell_unspecified); push_cc (r2, cell_unspecified, r0, cell_unspecified);
#if __GNUC__
for (int x=19; x<26 ;x++) for (int x=19; x<26 ;x++)
{ {
puts(itoa(x)); puts(itoa(x));
@ -1461,16 +1456,19 @@ main (int argc, char *argv[])
puts(itoa(g_cells[x].cdr)); puts(itoa(g_cells[x].cdr));
puts("\n"); puts("\n");
} }
#endif
#else #else
g_stack = 23; g_stack = 23;
g_free = 24; g_free = 24;
r1 = r2; //10: the-program r1 = r2; //10: the-program
r2 = cell_unspecified; r2 = cell_unspecified;
#endif #endif
#if __GNUC__ puts ("g_stack: ");
display_ (g_stack); display_ (g_stack);
puts ("\n");
#if __GNUC__
puts ("g_free="); puts ("g_free=");
puts (itoa(g_free)); puts (itoa(g_free));

View File

@ -592,8 +592,6 @@ assert_defined (SCM x, SCM e)
} }
#endif #endif
#if 1
//FIXME GNUC
SCM SCM
push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal)) push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
{ {
@ -607,7 +605,6 @@ push_cc (SCM p1, SCM p2, SCM a, SCM c) ///((internal))
r3 = x; r3 = x;
return cell_unspecified; return cell_unspecified;
} }
#endif
#if __GNUC__ #if __GNUC__
SCM caar (SCM x) {return car (car (x));} SCM caar (SCM x) {return car (car (x));}

View File

@ -457,6 +457,18 @@ test (char *p)
*x++ = c; *x++ = c;
if (*g_chars != 'C') return 1; if (*g_chars != 'C') return 1;
puts ("t: 1 + 2\n");
if (1 + 2 != 3) return 1;
puts ("t: 2 - 1\n");
if (2 - 1 != 1) return 1;
puts ("t: 1 << 3\n");
if (1 << 3 != 8) return 1;
puts ("t: 8 / 4\n");
if (8 / 4 != 2) return 1;
puts ("t: inc (0)\n"); puts ("t: inc (0)\n");
if (inc (0) != 1) return 1; if (inc (0) != 1) return 1;