mescc: Support struct assignment.
* module/mes/libc-i386.mes (i386:base-address->accu-address, i386:accu+n, i386:base+n): New functions. * module/mes/libc-i386.scm: Export them. * module/language/c99/compiler.mes (ast->info): Use them. * doc/examples/t.c: Test them. * doc/examples/cons-mes.c: Drop workarounds. * doc/examples/mini-mes.c: Likewise. * mes.c:
This commit is contained in:
Jan Nieuwenhuizen
parent
08ea0da745
commit
78e70f9024
|
|
@ -104,7 +104,7 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
|
|||
(define (function->source f i)
|
||||
(string-append
|
||||
(format #f "~a.function = g_function;\n" (function-builtin-name f))
|
||||
(format #f "functions[g_function++] = fun_~a;\n" (.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))))
|
||||
|
||||
|
|
|
|||
4
mes.c
4
mes.c
|
|
@ -171,7 +171,7 @@ SCM tmp;
|
|||
SCM tmp_num;
|
||||
SCM tmp_num2;
|
||||
|
||||
function_t functions[200];
|
||||
function_t g_functions[200];
|
||||
int g_function = 0;
|
||||
|
||||
SCM g_continuations = 0;
|
||||
|
|
@ -201,7 +201,7 @@ SCM r3 = 0; // continuation
|
|||
#define REF(x) g_cells[x].ref
|
||||
#define VALUE(x) g_cells[x].value
|
||||
#define VECTOR(x) g_cells[x].vector
|
||||
#define FUNCTION(x) functions[g_cells[x].function]
|
||||
#define FUNCTION(x) g_functions[g_cells[x].function]
|
||||
#define NCAR(x) g_news[x].car
|
||||
#define NTYPE(x) g_news[x].type
|
||||
|
||||
|
|
|
|||
|
|
@ -997,7 +997,9 @@
|
|||
(and=> (ident->decl info o) car))
|
||||
|
||||
(define (ident->pointer info o)
|
||||
(or (and=> (ident->decl info o) global:pointer) 0))
|
||||
(let ((local (assoc-ref (.locals info) o)))
|
||||
(if local (local:pointer local)
|
||||
(or (and=> (ident->decl info o) global:pointer) 0))))
|
||||
|
||||
(define (type->description info o)
|
||||
;; (stderr "type->description =~s\n" o)
|
||||
|
|
@ -1625,7 +1627,7 @@
|
|||
#:locals locals))))
|
||||
|
||||
;; int (*function) (void) = g_functions[g_cells[fn].cdr].function;
|
||||
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list ,param-list)) (initzer ,initzer))))
|
||||
((decl (decl-spec-list (type-spec (fixed-type ,type))) (init-declr-list (init-declr (ftn-declr (scope (ptr-declr (pointer) (ident ,name))) (param-list . ,param-list)) (initzer ,initzer))))
|
||||
(let* ((locals (add-local locals name type 1))
|
||||
(info (clone info #:locals locals))
|
||||
(empty (clone info #:text '()))
|
||||
|
|
@ -1784,7 +1786,7 @@
|
|||
((base->ident info) name)))))
|
||||
|
||||
;; *p = 0;
|
||||
((expr-stmt (assn-expr (de-ref (p-expr (ident ,name))) (op ,op) ,b))
|
||||
((expr-stmt (assn-expr (de-ref (p-expr (ident ,array))) (op ,op) ,b))
|
||||
(when (not (equal? op "="))
|
||||
(stderr "OOOPS2: op=~s\n" op)
|
||||
barf)
|
||||
|
|
@ -1793,84 +1795,142 @@
|
|||
(clone info #:text (append text
|
||||
(.text base)
|
||||
;;assign:
|
||||
((base->ident-address info) name)))))
|
||||
((base->ident-address info) array)))))
|
||||
|
||||
;; g_cells[0] = 65;
|
||||
((expr-stmt (assn-expr (array-ref (p-expr (fixed ,index)) (p-expr (ident ,name))) (op ,op) ,b))
|
||||
((expr-stmt (assn-expr (array-ref (p-expr (fixed ,index)) (p-expr (ident ,array))) (op ,op) ,b))
|
||||
(when (not (equal? op "="))
|
||||
(stderr "OOOPS3: op=~s\n" op)
|
||||
barf)
|
||||
(let* ((index (cstring->number index))
|
||||
(empty (clone info #:text '()))
|
||||
(base ((expr->base empty) b)))
|
||||
(base ((expr->base empty) b))
|
||||
(type (ident->type info array))
|
||||
(fields (or (type->description info type) '())) ;; FIXME: struct!
|
||||
(size (type->size info type))
|
||||
(count (length fields))
|
||||
(field-size 4) ;; FIXME:4, not fixed
|
||||
(ptr (ident->pointer info array)))
|
||||
(clone info #:text
|
||||
(append text
|
||||
(.text base)
|
||||
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:push-base)))
|
||||
((ident->base info) name)
|
||||
(list (lambda (f g ta t d)
|
||||
(append
|
||||
(i386:value->accu index)
|
||||
(i386:accu+base))))
|
||||
(i386:value->base index)
|
||||
(i386:base->accu)
|
||||
(if (> count 1) (i386:accu+accu) '())
|
||||
(if (= count 3) (i386:accu+base) '())
|
||||
(i386:accu-shl 2))))
|
||||
((ident->base info) array)
|
||||
(list (lambda (f g tav t d)
|
||||
(i386:accu+base)))
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:pop-base)))
|
||||
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:base->accu-address)))))))
|
||||
(cond ((equal? array "g_functions") ;; FIXME
|
||||
(list (lambda (f g ta t d)
|
||||
(append
|
||||
(i386:base-address->accu-address)
|
||||
(i386:accu+n 4)
|
||||
(i386:base+n 4)
|
||||
(i386:base-address->accu-address)))))
|
||||
(else (list (lambda (f g ta t d)
|
||||
(i386:base->accu-address)))))))))
|
||||
|
||||
;; g_cells[i] = c;
|
||||
((expr-stmt (assn-expr (array-ref (p-expr (ident ,index)) (p-expr (ident ,name))) (op ,op) ,b))
|
||||
((expr-stmt (assn-expr (array-ref (p-expr (ident ,index)) (p-expr (ident ,array))) (op ,op) ,b))
|
||||
(stderr "g_cells4[]: ~s\n" array)
|
||||
;;(stderr "pointer_cells4[]: ~s\n" array)
|
||||
(when (not (equal? op "="))
|
||||
(stderr "OOOPS4: op=~s\n" op)
|
||||
barf)
|
||||
(let* ((empty (clone info #:text '()))
|
||||
(base ((expr->base empty) b)))
|
||||
(base ((expr->base empty) b))
|
||||
(type (ident->type info array))
|
||||
(fields (or (type->description info type) '())) ;; FIXME: struct!
|
||||
(size (type->size info type))
|
||||
(count (length fields))
|
||||
(field-size 4) ;; FIXME:4, not fixed
|
||||
(ptr (ident->pointer info array)))
|
||||
(stderr "g_cells4[~a]: type=~a\n" array type)
|
||||
(stderr "g_cells4[~a]: pointer=~a\n" array ptr)
|
||||
(stderr "g_cells4[~a]: fields=~a\n" array fields)
|
||||
(stderr "g_cells4[~a]: size=~a\n" array size)
|
||||
(stderr "g_cells4[~a]: count=~a\n" array count)
|
||||
(clone info #:text
|
||||
(append text
|
||||
(.text base)
|
||||
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:push-base)))
|
||||
((ident->base info) name)
|
||||
((ident->accu info) index) ;; FIXME: chars! index*size
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:accu+base))) ; FIXME: type: char
|
||||
(i386:push-base)))
|
||||
((ident->base info) index)
|
||||
(list (lambda (f g ta t d)
|
||||
(append
|
||||
(i386:base->accu)
|
||||
(if (> count 1) (i386:accu+accu) '())
|
||||
(if (= count 3) (i386:accu+base) '())
|
||||
(i386:accu-shl 2))))
|
||||
((ident->base info) array)
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:accu+base)))
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:pop-base)))
|
||||
|
||||
(list (lambda (f g ta t d)
|
||||
;;(i386:byte-base->accu-address)
|
||||
(i386:base->accu-address)
|
||||
))))))
|
||||
(cond ((equal? array "g_functions") ;; FIXME
|
||||
(list (lambda (f g ta t d)
|
||||
(append
|
||||
(i386:base-address->accu-address)
|
||||
(i386:accu+n 4)
|
||||
(i386:base+n 4)
|
||||
(i386:base-address->accu-address)))))
|
||||
(else (list (lambda (f g ta t d)
|
||||
(i386:base->accu-address)))))))))
|
||||
|
||||
;; g_functions[g_function++] = g_foo;
|
||||
((expr-stmt (assn-expr (array-ref (post-inc (p-expr (ident ,index))) (p-expr (ident ,name))) (op ,op) ,b))
|
||||
((expr-stmt (assn-expr (array-ref (post-inc (p-expr (ident ,index))) (p-expr (ident ,array))) (op ,op) ,b))
|
||||
(when (not (equal? op "="))
|
||||
(stderr "OOOPS5: op=~s\n" op)
|
||||
barf)
|
||||
(let* ((empty (clone info #:text '()))
|
||||
(base ((expr->base empty) b)))
|
||||
(base ((expr->base empty) b))
|
||||
(type (ident->type info array))
|
||||
(fields (or (type->description info type) '())) ;; FIXME: struct!
|
||||
(size (type->size info type))
|
||||
(count (length fields))
|
||||
(field-size 4) ;; FIXME:4, not fixed
|
||||
(ptr (ident->pointer info array)))
|
||||
(stderr "g_cells5[~a]: type=~a\n" array type)
|
||||
(stderr "g_cells5[~a]: pointer=~a\n" array ptr)
|
||||
(stderr "g_cells5[~a]: fields=~a\n" array fields)
|
||||
(stderr "g_cells5[~a]: size=~a\n" array size)
|
||||
(stderr "g_cells5[~a]: count=~a\n" array count)
|
||||
(clone info #:text
|
||||
(append text
|
||||
(.text base)
|
||||
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:push-base)))
|
||||
((ident->base info) name)
|
||||
((ident->accu info) index) ;; FIXME: chars! index*size
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:accu+base))) ; FIXME: type: char
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:pop-base)))
|
||||
|
||||
(i386:push-base)))
|
||||
((ident->base info) index)
|
||||
(list (lambda (f g ta t d)
|
||||
(append
|
||||
(i386:base->accu-address))))
|
||||
|
||||
((ident-add info) index 1)
|
||||
))))
|
||||
(i386:base->accu)
|
||||
(if (> count 1) (i386:accu+accu) '())
|
||||
(if (= count 3) (i386:accu+base) '())
|
||||
(i386:accu-shl 2))))
|
||||
((ident->base info) array)
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:accu+base)))
|
||||
(list (lambda (f g ta t d)
|
||||
(i386:pop-base)))
|
||||
;; FIXME
|
||||
(cond ((equal? array "g_functions") ;; FIXME
|
||||
(list (lambda (f g ta t d)
|
||||
(append
|
||||
(i386:base-address->accu-address)
|
||||
(i386:accu+n 4)
|
||||
(i386:base+n 4)
|
||||
(i386:base-address->accu-address)))))
|
||||
(else (list (lambda (f g ta t d)
|
||||
(i386:base->accu-address)))))
|
||||
((ident-add info) index 1)))))
|
||||
|
||||
;; DECL
|
||||
;;
|
||||
|
|
|
|||
|
|
@ -232,6 +232,16 @@
|
|||
(define (i386:base->accu-address)
|
||||
'(#x89 #x10)) ; mov %edx,(%eax)
|
||||
|
||||
(define (i386:base-address->accu-address)
|
||||
'(#x8b #x0a ; mov (%edx),%ecx
|
||||
#x89 #x08)) ; mov %ecx,(%eax)
|
||||
|
||||
(define (i386:accu+n n)
|
||||
`(#x83 #xc0 ,n)) ; add $0x00,%eax
|
||||
|
||||
(define (i386:base+n n)
|
||||
`(#x83 #xc2 ,n)) ; add $0x00,%edx
|
||||
|
||||
(define (i386:byte-base->accu-address)
|
||||
'(#x88 #x10)) ; mov %dl,(%eax)
|
||||
|
||||
|
|
|
|||
|
|
@ -127,6 +127,10 @@
|
|||
|
||||
i386:XXjump
|
||||
|
||||
i386:accu+n
|
||||
i386:base+n
|
||||
i386:base-address->accu-address
|
||||
|
||||
;; libc
|
||||
i386:exit
|
||||
i386:open
|
||||
|
|
|
|||
|
|
@ -336,7 +336,7 @@ SCM tmp_num;
|
|||
SCM tmp_num2;
|
||||
|
||||
int ARENA_SIZE = 200;
|
||||
struct function functions[2];
|
||||
struct function g_functions[5];
|
||||
int g_function = 0;
|
||||
|
||||
|
||||
|
|
@ -393,10 +393,10 @@ SCM cell_cdr;
|
|||
#endif
|
||||
#define CONTINUATION(x) g_cells[x].cdr
|
||||
#if __GNUC__
|
||||
//#define FUNCTION(x) functions[g_cells[x].function]
|
||||
//#define FUNCTION(x) g_functions[g_cells[x].function]
|
||||
#endif
|
||||
|
||||
#define FUNCTION(x) functions[g_cells[x].cdr]
|
||||
#define FUNCTION(x) g_functions[g_cells[x].cdr]
|
||||
#define VALUE(x) g_cells[x].cdr
|
||||
#define VECTOR(x) g_cells[x].cdr
|
||||
|
||||
|
|
@ -666,65 +666,28 @@ SCM
|
|||
call (SCM fn, SCM x)
|
||||
{
|
||||
puts ("call\n");
|
||||
#if __GNUC__
|
||||
//fn=11
|
||||
//function1
|
||||
puts ("fn=");
|
||||
puts (itoa(fn));
|
||||
puts ("\n");
|
||||
puts ("functiono");
|
||||
puts (itoa(g_cells[fn].cdr));
|
||||
puts ("\n");
|
||||
#endif
|
||||
if (fn != 11) {
|
||||
puts("FN != 11\n");
|
||||
return 11;
|
||||
}
|
||||
if (g_cells[11].cdr != 1) {
|
||||
puts("fn.cdr != 11\n");
|
||||
return 11;
|
||||
}
|
||||
|
||||
if ((FUNCTION (fn).arity > 0 || FUNCTION (fn).arity == -1)
|
||||
&& x != cell_nil && TYPE (CAR (x)) == VALUES)
|
||||
x = cons (CADAR (x), CDR (x));
|
||||
puts ("00\n");
|
||||
if ((FUNCTION (fn).arity > 1 || FUNCTION (fn).arity == -1)
|
||||
&& x != cell_nil && TYPE (CDR (x)) == PAIR && TYPE (CADR (x)) == VALUES)
|
||||
x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
|
||||
//struct function* f = &FUNCTION (fn);
|
||||
puts ("01\n");
|
||||
switch (2)///FIXME FUNCTION (fn).arity)
|
||||
switch (FUNCTION (fn).arity)
|
||||
{
|
||||
// case 0: return FUNCTION (fn).function0 ();
|
||||
// case 1: return FUNCTION (fn).function1 (car (x));
|
||||
// case 2: return FUNCTION (fn).function2 (car (x), cadr (x));
|
||||
// case 3: return FUNCTION (fn).function3 (car (x), cadr (x), car (cddr (x)));
|
||||
// case -1: return FUNCTION (fn).functionn (x);
|
||||
case 0: {puts("02.0\n");return (FUNCTION (fn).function) ();}
|
||||
case 1: {puts("03.1\n");return ((SCM(*)(SCM))(FUNCTION (fn).function)) (car (x));}
|
||||
#if 0
|
||||
//__GNUC__
|
||||
case 2: {return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x));}
|
||||
#else
|
||||
case 2: {
|
||||
puts ("04.2\n");
|
||||
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;
|
||||
puts ("05\n");
|
||||
return cons (p1, p2);
|
||||
return (*functionx) (p1, p2);
|
||||
}
|
||||
case 0: {return (FUNCTION (fn).function) ();}
|
||||
case 1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (car (x));}
|
||||
//case 2: {return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x));}
|
||||
case 2: {return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (car (x), car (cdr (x)));}
|
||||
case 3: {return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x), car (cddr (x)));}
|
||||
#if __GNUC__
|
||||
// FIXME GNUC
|
||||
case -1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
|
||||
#endif
|
||||
case 3: {puts("05.3\n");return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x), car (cddr (x)));}
|
||||
//case -1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
|
||||
default: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
|
||||
}
|
||||
|
||||
|
|
@ -988,40 +951,22 @@ mes_builtins (SCM a)
|
|||
#else
|
||||
|
||||
scm_make_cell.cdr = g_function;
|
||||
functions[g_function++] = fun_make_cell;
|
||||
g_functions[g_function++] = fun_make_cell;
|
||||
cell_make_cell = g_free++;
|
||||
#if __GNUC__
|
||||
puts ("WOOOT=");
|
||||
puts (itoa (g_free));
|
||||
puts ("\n");
|
||||
//FIXME GNUC
|
||||
g_cells[cell_make_cell] = scm_make_cell;
|
||||
#else
|
||||
g_cells[16] = scm_make_cell;
|
||||
#endif
|
||||
|
||||
scm_cons.cdr = g_function;
|
||||
functions[g_function++] = fun_cons;
|
||||
g_functions[g_function++] = fun_cons;
|
||||
cell_cons = g_free++;
|
||||
#if __GNUC__
|
||||
//FIXME GNUC
|
||||
g_cells[cell_cons] = scm_cons;
|
||||
#else
|
||||
g_cells[17] = scm_cons;
|
||||
#endif
|
||||
|
||||
scm_car.cdr = g_function;
|
||||
functions[g_function++] = fun_car;
|
||||
g_functions[g_function++] = fun_car;
|
||||
cell_car = g_free++;
|
||||
#if __GNUC__
|
||||
//FIXME GNUC
|
||||
g_cells[cell_car] = scm_car;
|
||||
#endif
|
||||
|
||||
#if __GNUC__
|
||||
//FIXME GNUC
|
||||
scm_cdr.cdr = g_function;
|
||||
functions[g_function++] = fun_cdr;
|
||||
g_functions[g_function++] = fun_cdr;
|
||||
cell_cdr = g_free++;
|
||||
g_cells[cell_cdr] = scm_cdr;
|
||||
|
||||
|
|
@ -1040,7 +985,6 @@ g_cells[cell_cdr] = scm_cdr;
|
|||
// scm_cdr.string = cstring_to_list (scm_cdr.name);
|
||||
// g_cells[cell_cdr].string = MAKE_STRING (scm_cdr.string);
|
||||
// a = acons (make_symbol (scm_cdr.string), cell_cdr, a);
|
||||
#endif
|
||||
#endif
|
||||
return a;
|
||||
}
|
||||
|
|
@ -1050,19 +994,13 @@ bload_env (SCM a) ///((internal))
|
|||
{
|
||||
g_stdin = open ("module/mes/read-0.mo", 0);
|
||||
#if __GNUC__
|
||||
//FIXME GNUC
|
||||
//g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mo", "r");
|
||||
#endif
|
||||
char *p = (char*)g_cells;
|
||||
#if __GNUC__
|
||||
//FIXME GNUC
|
||||
assert (getchar () == 'M');
|
||||
assert (getchar () == 'E');
|
||||
assert (getchar () == 'S');
|
||||
#else
|
||||
getchar ();
|
||||
getchar ();
|
||||
getchar ();
|
||||
#endif
|
||||
g_stack = getchar () << 8;
|
||||
g_stack += getchar ();
|
||||
int c = getchar ();
|
||||
|
|
@ -1093,32 +1031,7 @@ fill ()
|
|||
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 (13) = 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;
|
||||
|
|
@ -1148,29 +1061,6 @@ fill ()
|
|||
CAR (15) = 0x58585858;
|
||||
CDR (15) = 1;
|
||||
|
||||
//g_stack@23
|
||||
TYPE (19) = PAIR;
|
||||
CAR (19) = 1;
|
||||
CDR (19) = 1;
|
||||
|
||||
TYPE (20) = PAIR;
|
||||
CAR (20) = 7;
|
||||
CDR (20) = 19;
|
||||
|
||||
TYPE (21) = PAIR;
|
||||
CAR (21) = 7;
|
||||
CDR (21) = 20;
|
||||
|
||||
TYPE (22) = PAIR;
|
||||
CAR (22) = 134;
|
||||
CDR (22) = 21;
|
||||
|
||||
TYPE (23) = PAIR;
|
||||
CAR (23) = 22;
|
||||
CDR (23) = 137;
|
||||
|
||||
#endif
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
|
@ -1267,32 +1157,17 @@ simple_bload_env (SCM a) ///((internal))
|
|||
puts ("\n");
|
||||
#endif
|
||||
|
||||
#if 0
|
||||
//__GNUC__
|
||||
assert (getchar () == 'M');
|
||||
assert (getchar () == 'E');
|
||||
assert (getchar () == 'S');
|
||||
puts (" *GOT MES*\n");
|
||||
g_stack = getchar () << 8;
|
||||
g_stack += getchar ();
|
||||
|
||||
#if __GNUC__
|
||||
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 (" *GOT MES*\n");
|
||||
|
||||
// skip stack
|
||||
getchar ();
|
||||
getchar ();
|
||||
#endif
|
||||
|
||||
c = getchar ();
|
||||
|
|
@ -1305,28 +1180,21 @@ simple_bload_env (SCM a) ///((internal))
|
|||
|
||||
puts ("read done\n");
|
||||
|
||||
// g_free = (p-(char*)g_cells) / sizeof (struct scm);
|
||||
c = p-(char*)g_cells;
|
||||
exit (c);
|
||||
g_free = (p-(char*)g_cells) / sizeof (struct scm);
|
||||
|
||||
if (g_free != 15) exit (33);
|
||||
|
||||
|
||||
|
||||
if (g_free != 15) exit (33);
|
||||
|
||||
// puts ("Xg_free: ");
|
||||
// puts (itoa (g_free));
|
||||
// puts ("\n");
|
||||
|
||||
|
||||
///if (g_free != 19) return 33;
|
||||
|
||||
// gc_peek_frame ();
|
||||
// g_symbols = r1;
|
||||
#if 0
|
||||
gc_peek_frame ();
|
||||
g_symbols = r1;
|
||||
#else
|
||||
g_symbols = 1;
|
||||
#endif
|
||||
g_stdin = STDIN;
|
||||
r0 = mes_builtins (r0);
|
||||
|
||||
if (g_free != 19) exit (34);
|
||||
|
||||
#if __GNUC__
|
||||
puts ("cells read: ");
|
||||
puts (itoa (g_free));
|
||||
|
|
@ -1429,44 +1297,17 @@ main (int argc, char *argv[])
|
|||
if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
|
||||
#endif
|
||||
|
||||
#if 1
|
||||
|
||||
#if __GNUC__
|
||||
puts ("g_free=");
|
||||
puts (itoa(g_free));
|
||||
puts ("\n");
|
||||
#else
|
||||
g_free = 19;
|
||||
|
||||
#endif
|
||||
|
||||
//return cons (r0, cell_nil);
|
||||
|
||||
//FIXME
|
||||
push_cc (r2, cell_unspecified, r0, cell_unspecified);
|
||||
#if __GNUC__
|
||||
for (int x=19; x<26 ;x++)
|
||||
{
|
||||
puts(itoa(x));
|
||||
puts(": type=");
|
||||
puts(itoa(g_cells[x].type));
|
||||
puts(" car=");
|
||||
puts(itoa(g_cells[x].car));
|
||||
puts(" cdr=");
|
||||
puts(itoa(g_cells[x].cdr));
|
||||
puts("\n");
|
||||
}
|
||||
#endif
|
||||
#else
|
||||
g_stack = 23;
|
||||
g_free = 24;
|
||||
r1 = r2; //10: the-program
|
||||
r2 = cell_unspecified;
|
||||
#endif
|
||||
|
||||
puts ("g_stack: ");
|
||||
display_ (g_stack);
|
||||
puts ("\n");
|
||||
// puts ("g_stack: ");
|
||||
// display_ (g_stack);
|
||||
// puts ("\n");
|
||||
|
||||
#if __GNUC__
|
||||
|
||||
|
|
|
|||
|
|
@ -336,7 +336,7 @@ SCM tmp_num;
|
|||
SCM tmp_num2;
|
||||
|
||||
int ARENA_SIZE = 200;
|
||||
struct function functions[2];
|
||||
struct function g_functions[5];
|
||||
int g_function = 0;
|
||||
|
||||
|
||||
|
|
@ -393,10 +393,10 @@ SCM cell_cdr;
|
|||
#endif
|
||||
#define CONTINUATION(x) g_cells[x].cdr
|
||||
#if __GNUC__
|
||||
//#define FUNCTION(x) functions[g_cells[x].function]
|
||||
//#define FUNCTION(x) g_functions[g_cells[x].function]
|
||||
#endif
|
||||
|
||||
#define FUNCTION(x) functions[g_cells[x].cdr]
|
||||
#define FUNCTION(x) g_functions[g_cells[x].cdr]
|
||||
#define VALUE(x) g_cells[x].cdr
|
||||
#define VECTOR(x) g_cells[x].cdr
|
||||
|
||||
|
|
@ -701,19 +701,8 @@ eval_apply ()
|
|||
switch (TYPE (car (r1)))
|
||||
{
|
||||
case TFUNCTION: {
|
||||
puts ("apply.function\n");
|
||||
y = 0x22;
|
||||
//check_formals (car (r1), MAKE_NUMBER (FUNCTION (car (r1)).arity), cdr (r1));
|
||||
#if __GNUC__
|
||||
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;
|
||||
}
|
||||
// case CLOSURE:
|
||||
|
|
@ -993,11 +982,8 @@ eval_apply ()
|
|||
// #endif
|
||||
|
||||
vm_return:
|
||||
// FIXME
|
||||
puts ("vm-return00\n");
|
||||
x = r1;
|
||||
gc_pop_frame ();
|
||||
puts ("vm-return01\n");
|
||||
r1 = x;
|
||||
goto eval_apply;
|
||||
}
|
||||
|
|
@ -1006,65 +992,28 @@ SCM
|
|||
call (SCM fn, SCM x)
|
||||
{
|
||||
puts ("call\n");
|
||||
#if __GNUC__
|
||||
//fn=11
|
||||
//function1
|
||||
puts ("fn=");
|
||||
puts (itoa(fn));
|
||||
puts ("\n");
|
||||
puts ("function");
|
||||
puts (itoa(g_cells[fn].cdr));
|
||||
puts ("\n");
|
||||
#endif
|
||||
if (fn != 11) {
|
||||
puts("FN != 11\n");
|
||||
return 11;
|
||||
}
|
||||
if (g_cells[11].cdr != 1) {
|
||||
puts("fn.cdr != 11\n");
|
||||
return 11;
|
||||
}
|
||||
|
||||
if ((FUNCTION (fn).arity > 0 || FUNCTION (fn).arity == -1)
|
||||
&& x != cell_nil && TYPE (CAR (x)) == VALUES)
|
||||
x = cons (CADAR (x), CDR (x));
|
||||
puts ("00\n");
|
||||
if ((FUNCTION (fn).arity > 1 || FUNCTION (fn).arity == -1)
|
||||
&& x != cell_nil && TYPE (CDR (x)) == PAIR && TYPE (CADR (x)) == VALUES)
|
||||
x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
|
||||
//struct function* f = &FUNCTION (fn);
|
||||
puts ("01\n");
|
||||
switch (2)///FIXME FUNCTION (fn).arity)
|
||||
switch (FUNCTION (fn).arity)
|
||||
{
|
||||
// case 0: return FUNCTION (fn).function0 ();
|
||||
// case 1: return FUNCTION (fn).function1 (car (x));
|
||||
// case 2: return FUNCTION (fn).function2 (car (x), cadr (x));
|
||||
// case 3: return FUNCTION (fn).function3 (car (x), cadr (x), car (cddr (x)));
|
||||
// case -1: return FUNCTION (fn).functionn (x);
|
||||
case 0: {puts("02.0\n");return (FUNCTION (fn).function) ();}
|
||||
case 1: {puts("03.1\n");return ((SCM(*)(SCM))(FUNCTION (fn).function)) (car (x));}
|
||||
#if 0
|
||||
//__GNUC__
|
||||
case 2: {return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x));}
|
||||
#else
|
||||
case 2: {
|
||||
puts ("04.2\n");
|
||||
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;
|
||||
puts ("05\n");
|
||||
return cons (p1, p2);
|
||||
return (*functionx) (p1, p2);
|
||||
}
|
||||
case 0: {return (FUNCTION (fn).function) ();}
|
||||
case 1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (car (x));}
|
||||
//case 2: {return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x));}
|
||||
case 2: {return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (car (x), car (cdr (x)));}
|
||||
case 3: {return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x), car (cddr (x)));}
|
||||
#if __GNUC__
|
||||
// FIXME GNUC
|
||||
case -1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
|
||||
#endif
|
||||
case 3: {puts("05.3\n");return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x), car (cddr (x)));}
|
||||
//case -1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
|
||||
default: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
|
||||
}
|
||||
|
||||
|
|
@ -1328,40 +1277,22 @@ mes_builtins (SCM a)
|
|||
#else
|
||||
|
||||
scm_make_cell.cdr = g_function;
|
||||
functions[g_function++] = fun_make_cell;
|
||||
g_functions[g_function++] = fun_make_cell;
|
||||
cell_make_cell = g_free++;
|
||||
#if __GNUC__
|
||||
puts ("WOOOT=");
|
||||
puts (itoa (g_free));
|
||||
puts ("\n");
|
||||
//FIXME GNUC
|
||||
g_cells[cell_make_cell] = scm_make_cell;
|
||||
#else
|
||||
g_cells[16] = scm_make_cell;
|
||||
#endif
|
||||
|
||||
scm_cons.cdr = g_function;
|
||||
functions[g_function++] = fun_cons;
|
||||
g_functions[g_function++] = fun_cons;
|
||||
cell_cons = g_free++;
|
||||
#if __GNUC__
|
||||
//FIXME GNUC
|
||||
g_cells[cell_cons] = scm_cons;
|
||||
#else
|
||||
g_cells[17] = scm_cons;
|
||||
#endif
|
||||
|
||||
scm_car.cdr = g_function;
|
||||
functions[g_function++] = fun_car;
|
||||
g_functions[g_function++] = fun_car;
|
||||
cell_car = g_free++;
|
||||
#if __GNUC__
|
||||
//FIXME GNUC
|
||||
g_cells[cell_car] = scm_car;
|
||||
#endif
|
||||
|
||||
#if __GNUC__
|
||||
//FIXME GNUC
|
||||
scm_cdr.cdr = g_function;
|
||||
functions[g_function++] = fun_cdr;
|
||||
g_functions[g_function++] = fun_cdr;
|
||||
cell_cdr = g_free++;
|
||||
g_cells[cell_cdr] = scm_cdr;
|
||||
|
||||
|
|
@ -1380,7 +1311,6 @@ g_cells[cell_cdr] = scm_cdr;
|
|||
// scm_cdr.string = cstring_to_list (scm_cdr.name);
|
||||
// g_cells[cell_cdr].string = MAKE_STRING (scm_cdr.string);
|
||||
// a = acons (make_symbol (scm_cdr.string), cell_cdr, a);
|
||||
#endif
|
||||
#endif
|
||||
return a;
|
||||
}
|
||||
|
|
@ -1390,19 +1320,13 @@ bload_env (SCM a) ///((internal))
|
|||
{
|
||||
g_stdin = open ("module/mes/read-0.mo", 0);
|
||||
#if __GNUC__
|
||||
//FIXME GNUC
|
||||
//g_stdin = g_stdin ? g_stdin : fopen (PREFIX "module/mes/read-0.mo", "r");
|
||||
#endif
|
||||
char *p = (char*)g_cells;
|
||||
#if __GNUC__
|
||||
//FIXME GNUC
|
||||
assert (getchar () == 'M');
|
||||
assert (getchar () == 'E');
|
||||
assert (getchar () == 'S');
|
||||
#else
|
||||
getchar ();
|
||||
getchar ();
|
||||
getchar ();
|
||||
#endif
|
||||
g_stack = getchar () << 8;
|
||||
g_stack += getchar ();
|
||||
int c = getchar ();
|
||||
|
|
@ -1592,6 +1516,7 @@ simple_bload_env (SCM a) ///((internal))
|
|||
{
|
||||
puts ("reading: ");
|
||||
char *mo = "module/mes/hack-32.mo";
|
||||
//char *mo = "cons-32.mo";
|
||||
puts (mo);
|
||||
puts ("\n");
|
||||
g_stdin = open (mo, 0);
|
||||
|
|
@ -1607,32 +1532,16 @@ simple_bload_env (SCM a) ///((internal))
|
|||
puts ("\n");
|
||||
#endif
|
||||
|
||||
#if 0
|
||||
//__GNUC__
|
||||
assert (getchar () == 'M');
|
||||
assert (getchar () == 'E');
|
||||
assert (getchar () == 'S');
|
||||
puts (" *GOT MES*\n");
|
||||
g_stack = getchar () << 8;
|
||||
g_stack += getchar ();
|
||||
#if __GNUC__
|
||||
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 (" *GOT MES*\n");
|
||||
|
||||
// skip stack
|
||||
getchar ();
|
||||
getchar ();
|
||||
#endif
|
||||
|
||||
c = getchar ();
|
||||
|
|
@ -1646,12 +1555,20 @@ simple_bload_env (SCM a) ///((internal))
|
|||
puts ("read done\n");
|
||||
|
||||
g_free = (p-(char*)g_cells) / sizeof (struct scm);
|
||||
// gc_peek_frame ();
|
||||
// g_symbols = r1;
|
||||
|
||||
#if 0
|
||||
gc_peek_frame ();
|
||||
g_symbols = r1;
|
||||
#else
|
||||
if (g_free != 15) exit (33);
|
||||
g_symbols = 1;
|
||||
r2 = 10;
|
||||
#endif
|
||||
g_stdin = STDIN;
|
||||
r0 = mes_builtins (r0);
|
||||
|
||||
///if (g_free != 19) exit (34);
|
||||
|
||||
#if __GNUC__
|
||||
puts ("cells read: ");
|
||||
puts (itoa (g_free));
|
||||
|
|
@ -1660,11 +1577,16 @@ simple_bload_env (SCM a) ///((internal))
|
|||
puts ("symbols: ");
|
||||
puts (itoa (g_symbols));
|
||||
puts ("\n");
|
||||
|
||||
puts ("r2: ");
|
||||
puts (itoa (r2));
|
||||
puts ("\n");
|
||||
|
||||
// display_ (g_symbols);
|
||||
// puts ("\n");
|
||||
#endif
|
||||
|
||||
display_ (10);
|
||||
display_ (r2);
|
||||
puts ("\n");
|
||||
|
||||
fill ();
|
||||
|
|
@ -1754,28 +1676,7 @@ main (int argc, char *argv[])
|
|||
if (argc > 1 && !strcmp (argv[1], "--dump")) return dump ();
|
||||
#endif
|
||||
|
||||
#if 0
|
||||
//FIXME
|
||||
push_cc (r2, cell_unspecified, r0, cell_unspecified);
|
||||
#if __GNUC__
|
||||
for (int x=19; x<26 ;x++)
|
||||
{
|
||||
puts(itoa(x));
|
||||
puts(": type=");
|
||||
puts(itoa(g_cells[x].type));
|
||||
puts(" car=");
|
||||
puts(itoa(g_cells[x].car));
|
||||
puts(" cdr=");
|
||||
puts(itoa(g_cells[x].cdr));
|
||||
puts("\n");
|
||||
}
|
||||
#endif
|
||||
#else
|
||||
g_stack = 23;
|
||||
g_free = 24;
|
||||
r1 = r2; //10: the-program
|
||||
r2 = cell_unspecified;
|
||||
#endif
|
||||
|
||||
#if __GNUC__
|
||||
display_ (g_stack);
|
||||
|
|
|
|||
66
scaffold/t.c
66
scaffold/t.c
|
|
@ -101,13 +101,13 @@ char *g_chars = arena;
|
|||
char buf[200];
|
||||
|
||||
int foo () {puts ("t: foo\n"); return 0;};
|
||||
int bar () {puts ("t: bar\n"); return 0;};
|
||||
int bar (int i) {puts ("t: bar\n"); return 0;};
|
||||
struct function {
|
||||
int (*function) (void);
|
||||
int arity;
|
||||
};
|
||||
struct function g_fun = {&exit, 1};
|
||||
struct function g_foo = {&foo, 1};
|
||||
struct function g_foo = {&foo, 0};
|
||||
struct function g_bar = {&bar, 1};
|
||||
|
||||
//void *functions[2];
|
||||
|
|
@ -123,6 +123,15 @@ int g_free = 3;
|
|||
SCM tmp;
|
||||
SCM tmp_num;
|
||||
|
||||
int ARENA_SIZE = 200;
|
||||
#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].cdr
|
||||
|
||||
struct scm scm_fun = {TFUNCTION,0,0};
|
||||
SCM cell_fun;
|
||||
|
||||
#if 1
|
||||
|
||||
int
|
||||
|
|
@ -225,15 +234,6 @@ math_test ()
|
|||
return read_test ();
|
||||
}
|
||||
|
||||
int ARENA_SIZE = 200;
|
||||
#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].cdr
|
||||
|
||||
struct scm scm_fun = {TFUNCTION,0,0};
|
||||
SCM cell_fun;
|
||||
|
||||
SCM
|
||||
alloc (int n)
|
||||
{
|
||||
|
|
@ -319,25 +319,48 @@ struct_test ()
|
|||
|
||||
int fn = 0;
|
||||
puts ("t: g_functions[g_cells[fn].cdr].arity\n");
|
||||
if (!g_functions[g_cells[fn].cdr].arity) return 1;
|
||||
#if __GNUC__
|
||||
//FIXME
|
||||
if (g_functions[g_cells[fn].cdr].arity) return 1;
|
||||
#endif
|
||||
if (g_functions[g_cells[fn].cdr].arity != 0) return 1;
|
||||
|
||||
int (*functionx) (void) = 0;
|
||||
functionx = g_functions[0].function;
|
||||
puts ("t: *functionx == foo\n");
|
||||
if (*functionx != foo) return 11;
|
||||
if (functionx != foo) return 11;
|
||||
|
||||
puts ("t: (*functionx) () == foo\n");
|
||||
if ((*functionx) () != 0) return 12;
|
||||
if ((functionx) () != 0) return 12;
|
||||
|
||||
puts ("t: g_functions[<foo>].arity\n");
|
||||
if (g_functions[0].arity != 0) return 17;
|
||||
|
||||
fn++;
|
||||
g_functions[0] = g_bar;
|
||||
if (g_cells[fn].cdr != 0) return 13;
|
||||
g_functions[fn] = g_bar;
|
||||
g_cells[fn].cdr = fn;
|
||||
if (g_cells[fn].cdr != fn) return 13;
|
||||
|
||||
puts ("t: g_functions[g_cells[fn].cdr].function\n");
|
||||
functionx = g_functions[g_cells[fn].cdr].function;
|
||||
puts ("t: *functionx == bar\n");
|
||||
if (*functionx != bar) return 15;
|
||||
puts ("t: (*functionx) () == bar\n");
|
||||
if ((*functionx) () != 0) return 16;
|
||||
|
||||
puts ("t: functionx == bar\n");
|
||||
if (functionx != bar) return 15;
|
||||
|
||||
puts ("t: (*functiony) (1) == bar\n");
|
||||
#if __GNUC__
|
||||
//FIXME
|
||||
int (*functiony) (int) = 0;
|
||||
functiony = g_functions[g_cells[fn].cdr].function;
|
||||
if ((functiony) (1) != 0) return 16;
|
||||
#endif
|
||||
#if !__GNUC__
|
||||
functionx = g_functions[g_cells[fn].cdr].function;
|
||||
if ((functionx) (1) != 0) return 16;
|
||||
#endif
|
||||
|
||||
puts ("t: g_functions[<bar>].arity;");
|
||||
if (g_functions[fn].arity != 1) return 18;
|
||||
|
||||
scm_fun.cdr = g_function;
|
||||
g_functions[g_function++] = g_fun;
|
||||
|
|
@ -619,6 +642,9 @@ test (char *p)
|
|||
int
|
||||
main (int argc, char *argv[])
|
||||
{
|
||||
// int fn = 0;
|
||||
// g_functions[fn] = g_bar;
|
||||
// if (g_functions[fn].arity != 1) return 1;
|
||||
char *p = "t.c\n";
|
||||
puts ("t.c\n");
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue