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

mescc: Fixes for goto.

Browse source 
* module/mes/libc-i386.mes (XXjump): New function.
* module/mes/libc-i386.scm: Export it.
* module/language/c99/compiler.mes (case->jump-info, ast->info): Use it.
* scaffold/t.c: Test it.
* GNUmakefile (cons-mes): New target.
* scaffold/cons-mes.c: New file.
* scaffold/mini-mes.c:
This commit is contained in:
Jan Nieuwenhuizen 2017-04-02 12:13:04 +02:00
parent 184c9f2641
commit 07c4b02fa3
7 changed files with 1600 additions and 27 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
GNUmakefile
View file

@ -118,6 +118,11 @@ mini-mes: scaffold/mini-mes.c GNUmakefile
gcc -nostdlib --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $<
chmod +x $@
cons-mes: scaffold/cons-mes.c GNUmakefile
rm -f $@
gcc -nostdlib --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $<
chmod +x $@
tiny-mes: scaffold/tiny-mes.c GNUmakefile
rm -f $@
gcc -nostdlib --std=gnu99 -m32 -g -o $@ '-DVERSION="0.4"' $<

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

@ -797,17 +797,22 @@
(pmatch o
((case (p-expr (ident ,constant)) (compd-stmt (block-item-list . ,elements)))
(lambda (body-length)
(define (test->text value clause-length)
(append (list (lambda (f g ta t d) (i386:accu-cmp-value value)))
(jump-nz clause-length)))
(let* ((value (assoc-ref (.constants info) constant))
(text-length (length (.text info)))
(clause-info (let loop ((elements elements) (info info))
(test-info
(clone info #:text (append (.text info) (test->text value 0))))
(text-length (length (.text test-info)))
(clause-info (let loop ((elements elements) (info test-info))
(if (null? elements) info
(loop (cdr elements) ((statement->info info body-length) (car elements))))))
(clause-text (list-tail (.text clause-info) text-length))
(clause-length (length (text->list clause-text))))
(clone info #:text (append
(.text info)
(list (lambda (f g ta t d) (i386:accu-cmp-value value)))
(jump-nz clause-length)
(test->text value clause-length)
clause-text)
#:globals (.globals clause-info)))))
@ -820,17 +825,12 @@
(let* ((value (cstring->number value))
(test-info
(clone info #:text (append (.text info) (test->text value 0))))
;;(foo (stderr "000\n"))
(text-length (length (.text test-info)))
(clause-info (let loop ((elements elements) (info test-info))
;;(stderr "info text=~s\n" (map dec->hex (text->list (.text info))))
;;(stderr "case: ~s\n" (and (pair? elements) (car elements)))
(if (null? elements) info
(loop (cdr elements) ((statement->info info body-length) (car elements))))))
;;(foo (stderr "001\n"))
(clause-text (list-tail (.text clause-info) text-length))
(clause-length (length (text->list clause-text))))
;;(stderr "text info:~s\n" (.text info))
(clone info #:text (append
(.text info)
(test->text value clause-length)
@ -1236,12 +1236,12 @@
((goto (ident ,label))
(let ((offset (length (text->list text)))
(jump (lambda (n) (i386:Xjump n))))
(let* ((jump (lambda (n) (i386:XXjump n)))
(offset (+ (length (jump 0)) (length (text->list text)))))
(clone info #:text
(append text
(list (lambda (f g ta t d)
(jump (- (label-offset (.function info) label f) offset (length (jump 0))))))))))
(jump (- (label-offset (.function info) label f) offset))))))))
;;; FIXME: only zero?!
((p-expr (ident ,name))

4
module/mes/libc-i386.mes
View file

@ -333,6 +333,10 @@
(or n urg:Xjump)
`(#xe9 ,@(int->bv32 (if (>= n 0) n (- n 5))))) ; jmp . + <n>
(define (i386:XXjump n)
(or n urg:XXjump)
`(#xe9 ,@(int->bv32 n))) ; jmp . + <n>
(define (i386:Xjump-nz n)
(or n urg:Xjump-nz)
`(#x0f #x85 ,@(int->bv32 n))) ; jnz . + <n>

1
module/mes/libc-i386.scm
View file

@ -118,6 +118,7 @@
i386:xor-zf
i386:Xjump
i386:XXjump
i386:Xjump-c
i386:Xjump-nc
i386:Xjump-nz

1543
scaffold/cons-mes.c Normal file
View file

File diff suppressed because it is too large Load diff

20
scaffold/mini-mes.c
View file

@ -623,6 +623,7 @@ SCM gc_pop_frame ();
SCM
eval_apply ()
{
puts ("e/a: fixme\n");
eval_apply:
puts ("eval_apply\n");
// if (g_free + GC_SAFETY > ARENA_SIZE)
@ -700,6 +701,7 @@ eval_apply ()
r1 = call (x, y);
#endif
puts ("after call\n");
y = 0x44;
goto vm_return;
}
// case CLOSURE:
@ -978,18 +980,7 @@ eval_apply ()
// goto apply;
// #endif
asm(".byte 0x90");
asm(".byte 0x90");
vm_return:
asm(".byte 0x90");
asm(".byte 0x90");
asm(".byte 0x90");
asm(".byte 0x90");
asm(".byte 0x90");
asm(".byte 0x90");
asm(".byte 0x90");
asm(".byte 0x90");
asm(".byte 0x90");
// FIXME
puts ("vm-return00\n");
x = r1;
@ -1054,11 +1045,12 @@ call (SCM fn, SCM x)
SCM p1 = car (x);
SCM p2 = cdr (x);
p2 = car (p2);
//return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (p1, p2);
int (*functionx) (int,int) = (SCM(*)(SCM,SCM))FUNCTION (fn).function;
//return ((SCM(*)(SCM,SCM))(*FUNCTION (fn).function)) (p1, p2);
//return ((SCM(*)(SCM,SCM))(*functionx)) (p1, p2);
SCM p3;
p3 = 0x44;
//p3 = 0x44;
puts ("05\n");
return cons (p1, p2);
return (*functionx) (p1, p2);
@ -1741,9 +1733,9 @@ main (int argc, char *argv[])
#endif
#if 0
//__GNUC__
//FIXME
push_cc (r2, cell_unspecified, r0, cell_unspecified);
#if __GNUC__
for (int x=19; x<26 ;x++)
{
puts(itoa(x));
@ -1755,8 +1747,8 @@ main (int argc, char *argv[])
puts(itoa(g_cells[x].cdr));
puts("\n");
}
#endif
#else
g_stack = 23;
g_free = 24;
r1 = r2; //10: the-program

30
scaffold/t.c
View file

@ -124,6 +124,16 @@ SCM tmp;
SCM tmp_num;
#if 1
int
label (int c)
{
label:
if (c == 0) return c;
c--;
goto label;
return 1;
}
int
swits (int c)
{
@ -131,7 +141,7 @@ swits (int c)
switch (c)
{
case 0: {goto next;}
case CHAR: {goto next;}
case 1: {goto next;}
case 2: {goto next;}
default: {goto next;}
@ -434,6 +444,9 @@ test (char *p)
*x++ = c;
if (*g_chars != 'C') return 1;
puts ("t: goto label\n");
if (label (1) != 0) return 1;
puts ("t: switch 0\n");
if (swits (0) != 0) return swits (0);
@ -563,6 +576,21 @@ test (char *p)
int
main (int argc, char *argv[])
{
// main:
// puts ("t.c\n");
// if (argc == 0x22) return 11;
// argc = 0x22;
// goto main;
// switch (0)
// {
// case 0: {goto next;}
// // case 1: {goto next;}
// // case 2: {goto next;}
// // default: {goto next;}
// }
// return 1;
// next:
char *p = "t.c\n";
puts ("t.c\n");