(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))))
SCM tmp_num;
SCM tmp_num2;
-function_t functions[200];
+function_t g_functions[200];
int g_function = 0;
SCM g_continuations = 0;
#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
(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)
#: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 '()))
((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)
(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
;;
(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)
i386:XXjump
+ i386:accu+n
+ i386:base+n
+ i386:base-address->accu-address
+
;; libc
i386:exit
i386:open
SCM tmp_num2;
int ARENA_SIZE = 200;
-struct function functions[2];
+struct function g_functions[5];
int g_function = 0;
#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
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);}
}
#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;
// 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;
}
{
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 ();
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;
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;
}
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 ();
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));
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__
SCM tmp_num2;
int ARENA_SIZE = 200;
-struct function functions[2];
+struct function g_functions[5];
int g_function = 0;
#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
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:
// #endif
vm_return:
- // FIXME
- puts ("vm-return00\n");
x = r1;
gc_pop_frame ();
- puts ("vm-return01\n");
r1 = x;
goto eval_apply;
}
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);}
}
#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;
// 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;
}
{
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 ();
{
puts ("reading: ");
char *mo = "module/mes/hack-32.mo";
+ //char *mo = "cons-32.mo";
puts (mo);
puts ("\n");
g_stdin = open (mo, 0);
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 ();
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 ("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 ();
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);
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];
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
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)
{
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;
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");
projects / mes.git / commitdiff