git.iko.soy/Idris-dev
on master help sign in
Starting to make new RTS work
204d938Edwin Brady
iif/ctest.cnew file+99
compare with master
unifiedsplit
@@ -0,0 +1,99 @@
1+#include <closure.h>
2+
3+void plus(VM* vm, VAL* oldbase) {
4+ INITFRAME;
5+ RESERVE(2);
6+ ADDTOP(2);
7+
8+ switch(TAG(LOC(0))) {
9+ case 0:
10+// PROJECT(vm, LOC(0), 2, 0);
11+ RVAL = LOC(1);
12+ TOPBASE(0);
13+ REBASE;
14+ break;
15+ case 1:
16+ PROJECT(vm, LOC(0), 2, 1);
17+ RESERVE(2);
18+ TOP(0) = LOC(2);
19+ TOP(1) = LOC(1);
20+ STOREOLD;
21+ BASETOP(0);
22+ ADDTOP(2);
23+ CALL(plus);
24+ LOC(3) = RVAL;
25+ RVAL = MKCON(vm, 1, 1, LOC(3));
26+ TOPBASE(0);
27+ REBASE;
28+ break;
29+ }
30+}
31+
32+void natToInt(VM* vm, VAL* oldbase) {
33+ INITFRAME;
34+ RESERVE(3);
35+ ADDTOP(3);
36+
37+ switch(TAG(LOC(0))) {
38+ case 0:
39+ // PROJECT(vm, LOC(0), 2, 0);
40+ RVAL = MKINT(0);
41+ TOPBASE(0);
42+ REBASE;
43+ break;
44+ case 1:
45+ PROJECT(vm, LOC(0), 1, 1);
46+ RESERVE(1);
47+ TOP(0) = LOC(1);
48+ STOREOLD;
49+ BASETOP(0);
50+ ADDTOP(1);
51+ CALL(natToInt);
52+ LOC(2) = RVAL;
53+ RVAL = ADD(LOC(2), MKINT(1));
54+ TOPBASE(0);
55+ REBASE;
56+ break;
57+ }
58+}
59+
60+int main() {
61+ INITFRAME;
62+ VM* vm = init_vm(100,100);
63+
64+ RESERVE(2);
65+ ADDTOP(2);
66+
67+ LOC(0) = MKCON(vm, 0, 0);
68+ LOC(0) = MKCON(vm, 1, 1, LOC(0));
69+ LOC(0) = MKCON(vm, 1, 1, LOC(0));
70+
71+ dumpVal(LOC(0));
72+ printf("\n");
73+
74+ LOC(1) = MKCON(vm, 0, 0);
75+ LOC(1) = MKCON(vm, 1, 1, LOC(1));
76+ LOC(1) = MKCON(vm, 1, 1, LOC(1));
77+
78+ RESERVE(2);
79+ TOP(0) = LOC(0);
80+ TOP(1) = LOC(1);
81+
82+ STOREOLD;
83+ BASETOP(0);
84+ ADDTOP(2);
85+ CALL(plus);
86+ LOC(0) = RVAL;
87+
88+ RESERVE(1);
89+ TOP(0) = LOC(0);
90+ STOREOLD;
91+ BASETOP(0);
92+ ADDTOP(1);
93+ CALL(natToInt);
94+ LOC(0) = RVAL;
95+
96+ printf("%ld\n", GETINT(LOC(0)));
97+
98+ printf("%d %d\n", vm->valstack, vm->valstack_base);
99+}
rts/closure.c+48−43
@@ -2,6 +2,7 @@
2#include <stdio.h>
2#include <stdio.h>
3#include <string.h>
3#include <string.h>
4#include <unistd.h>
4#include <unistd.h>
5+#include <stdarg.h>
5
6
6#include "closure.h"
7#include "closure.h"
7
8
@@ -12,13 +13,15 @@ VM* init_vm(int stack_size, size_t heap_size) {
12
13
13 VM* vm = malloc(sizeof(VM));
14 VM* vm = malloc(sizeof(VM));
14 vm -> valstack = valstack;
15 vm -> valstack = valstack;
15− vm -> valstack_ptr = valstack;
16+ vm -> valstack_top = valstack;
17+ vm -> valstack_base = valstack;
16 vm -> intstack = intstack;
18 vm -> intstack = intstack;
17 vm -> intstack_ptr = intstack;
19 vm -> intstack_ptr = intstack;
18 vm -> floatstack = floatstack;
20 vm -> floatstack = floatstack;
19 vm -> floatstack_ptr = floatstack;
21 vm -> floatstack_ptr = floatstack;
20 vm -> stack_max = stack_size;
22 vm -> stack_max = stack_size;
21 vm -> heap = malloc(heap_size);
23 vm -> heap = malloc(heap_size);
24+ vm -> heap_next = vm -> heap;
22 vm -> ret = NULL;
25 vm -> ret = NULL;
23 return vm;
26 return vm;
24}
27}
@@ -27,78 +30,80 @@ void* allocate(VM* vm, int size) {
27 return malloc(size); // TMP!
30 return malloc(size); // TMP!
28}
31}
29
32
30−void* allocThunk(VM* vm, int argspace) {
31− Closure* cl = allocate(vm, sizeof(ClosureType) +
32− sizeof(VAL) * (argspace + 1) +
33− sizeof(int) * 2);
34− cl -> ty = THUNK;
35− return (void*)cl;
36−}
37−
38void* allocCon(VM* vm, int arity) {
33void* allocCon(VM* vm, int arity) {
39 Closure* cl = allocate(vm, sizeof(ClosureType) +
34 Closure* cl = allocate(vm, sizeof(ClosureType) +
40− sizeof(int) +
35+ sizeof(con));
41− sizeof(VAL) * arity);
42 cl -> ty = CON;
36 cl -> ty = CON;
37+ if (arity == 0) {
38+ cl -> info.c.args = NULL;
39+ } else {
40+ cl -> info.c.args = allocate(vm, sizeof(VAL)*arity);
41+ }
43 return (void*)cl;
42 return (void*)cl;
44}
43}
45
44
46−VAL mkInt(VM* vm, int val) {
47− Closure* cl = allocate(vm, sizeof(ClosureType) + sizeof(int));
48− cl -> ty = INT;
49− cl -> info.i = val;
50− return cl;
51−}
52−
53−VAL mkFloat(VM* vm, double val) {
45+VAL MKFLOAT(VM* vm, double val) {
54 Closure* cl = allocate(vm, sizeof(ClosureType) + sizeof(double));
46 Closure* cl = allocate(vm, sizeof(ClosureType) + sizeof(double));
55 cl -> ty = FLOAT;
47 cl -> ty = FLOAT;
56 cl -> info.f = val;
48 cl -> info.f = val;
57 return cl;
49 return cl;
58}
50}
59
51
60−VAL mkStr(VM* vm, char* str) {
52+VAL MKSTR(VM* vm, char* str) {
61− Closure* cl = allocate(vm, sizeof(ClosureType) + sizeof(char*) * strlen(str));
53+ Closure* cl = allocate(vm, sizeof(ClosureType) + sizeof(char*));
62 cl -> ty = STRING;
54 cl -> ty = STRING;
55+ cl -> info.str = allocate(vm, sizeof(char)*strlen(str)+1);
63 strcpy(cl -> info.str, str);
56 strcpy(cl -> info.str, str);
64 return cl;
57 return cl;
65}
58}
66
59
67−VAL mkThunk(VM* vm, func fn, int args, int arity) {
60+VAL MKCON(VM* vm, int tag, int arity, ...) {
61+ Closure* cl;
68 int i;
62 int i;
69− Closure* cl = allocThunk(vm, arity);
63+ va_list args;
70− cl -> info.t.fn = fn;
71− cl -> info.t.arity = arity;
72− cl -> info.t.numargs = args;
73− VAL** argptr = &(cl -> info.t.args);
74−
75− for (i = 0; i < args; ++i) {
76− VAL* v = POP;
77− *argptr++ = v;
78− }
79−}
80
64
81−VAL mkCon(VM* vm, int tag, int arity) {
65+ va_start(args, arity);
82− Closure* cl = allocCon(vm, arity);
83
66
84− int i;
67+ cl = allocCon(vm, arity);
85 cl -> info.c.tag = tag;
68 cl -> info.c.tag = tag;
69+ cl -> info.c.arity = arity;
86− VAL** argptr = &(cl -> info.c.args);
70+ VAL* argptr = (VAL*)(cl -> info.c.args);
87
71
88 for (i = 0; i < arity; ++i) {
72 for (i = 0; i < arity; ++i) {
89− VAL* v = POP;
73+ VAL v = va_arg(args, VAL);
90− *argptr++ = v;
74+ *argptr = v;
75+ argptr++;
91 }
76 }
92−}
77+ va_end(args);
93
78
94−// if 'update' is set, update the value at the top of the stack
79+ return cl;
95−// otherwise, replace it with a new value
80+}
96
81
97−void EVAL(int update) {
82+void PROJECT(VM* vm, VAL r, int loc, int arity) {
83+ int i;
84+ VAL* argptr = (VAL*)(r -> info.c.args);
98
85
86+ for(i = 0; i < arity; ++i) {
87+ LOC(i+loc) = *argptr++;
88+ }
89+}
90+
91+void dumpVal(VAL v) {
92+ int i;
93+ switch(v->ty) {
94+ case CON:
95+ printf("%d[", v->info.c.tag);
96+ for(i = 0; i < v->info.c.arity; ++i) {
97+ VAL* args = (VAL*)v->info.c.args;
98+ dumpVal(args[i]);
99+ }
100+ printf("] ");
101+ }
102+
99}
103}
100
104
101void stackOverflow() {
105void stackOverflow() {
102 fprintf(stderr, "Stack overflow");
106 fprintf(stderr, "Stack overflow");
103 exit(-1);
107 exit(-1);
104}
108}
109+
rts/closure.h+71−52
@@ -1,88 +1,107 @@
1#ifndef _CLOSURE_H
1#ifndef _CLOSURE_H
2#define _CLOSURE_H
2#define _CLOSURE_H
3
3
4+#include <stdlib.h>
5+#include <stdio.h>
6+#include <string.h>
7+#include <unistd.h>
8+#include <stdarg.h>
4
9
5// Closures
10// Closures
11+
12+typedef enum {
13+ CON, INT, FLOAT, STRING, UNIT, PTR
14+} ClosureType;
15+
6−typedef void* VAL;
16+typedef struct {
17+ int tag;
18+ int arity;
19+ void* args;
20+} con;
21+
22+typedef struct {
23+ ClosureType ty;
24+ union {
25+ con c;
26+ int i;
27+ double f;
28+ char* str;
29+ void* ptr;
30+ } info;
31+} Closure;
32+
33+typedef Closure* VAL;
7
34
8typedef struct {
35typedef struct {
9 VAL* valstack;
36 VAL* valstack;
10 int* intstack;
37 int* intstack;
11 double* floatstack;
38 double* floatstack;
12− VAL* valstack_ptr;
39+ VAL* valstack_top;
40+ VAL* valstack_base;
13 int* intstack_ptr;
41 int* intstack_ptr;
14 double* floatstack_ptr;
42 double* floatstack_ptr;
15 void* heap;
43 void* heap;
44+ void* heap_next;
16 int stack_max;
45 int stack_max;
17 VAL ret;
46 VAL ret;
18} VM;
47} VM;
19
48
20VM* init_vm(int stack_size, size_t heap_size);
49VM* init_vm(int stack_size, size_t heap_size);
21
50
22−// Functions all take a pointer to their VM, and return nothing.
51+// Functions all take a pointer to their VM, and previous stack base,
52+// and return nothing.
23−typedef void(*func)(VM*);
53+typedef void(*func)(VM*, VAL*);
24
54
25−#define EXTEND(n) if (vm->valstack_ptr-vm->valstack + n < vm -> stack_max) \
55+// Register access
26− { vm->valstack_ptr+=(n) } else { stackOverflow(vm); }
27−#define CLEAR(n) vm->valstack_ptr-=(n)
28−#define SLIDE(drop, keep) \
29− for (i=1; i<=keep; ++i) { \
30− *(vm->valstack_ptr-i-drop) = *(vm->valstack_ptr-i); \
31− } \
32− vm->valstack_ptr-=(drop)
33
56
34−typedef enum {
57+#define RVAL (vm->ret)
35− THUNK, CON, INT, FLOAT, STRING, UNIT, PTR
58+#define LOC(x) (*(vm->valstack_base + (x)))
36−} ClosureType;
59+#define TOP(x) (*(vm->valstack_top + (x)))
37
60
38−typedef struct {
61+// Retrieving values
39− VAL fn;
40− int arity;
41− int numargs;
42− VAL* args;
43−} thunk;
44
62
45−typedef struct {
63+#define GETSTR(x) (((VAL)(x))->info.str)
46− int tag;
64+#define GETPTR(x) (((void*)(x))->info.ptr)
47− VAL* args;
65+#define GETFLOAT(x) (((double)(x))->info.f)
48−} con;
49
66
50−typedef struct {
67+#define TAG(x) ((x)->info.c.tag)
51− ClosureType ty;
68+
52− union {
69+// Integers, floats and operators
53− thunk t;
54− con c;
55− int i;
56− double f;
57− char* str;
58− void* ptr;
59− } info;
60−} Closure;
61
70
62−// Stack manipulation instructions
71+typedef intptr_t i_int;
63
72
64−#define PUSH(i) *(vm->valstack_ptr++) = i;
73+#define MKINT(x) ((void*)((x)<<1)+1)
65−#define POP --vm->valstack_ptr;
74+#define GETINT(x) ((i_int)(x)>>1)
75+#define ISINT(x) ((((i_int)x)&1) == 1)
66
76
67−#define PUSHINT(i) *(vm->intstack_ptr++) = i;
77+#define INTOP(op,x,y) MKINT((i_int)((((i_int)x)>>1) op (((i_int)y)>>1)))
68−#define POPINT --vm->intstack_ptr;
78+#define FLOATOP(op,x,y) MKFLOAT(((GETFLOAT(x)) op (GETFLOAT(y))))
79+#define FLOATBOP(op,x,y) MKINT((i_int)(((GETFLOAT(x)) op (GETFLOAT(y)))))
80+#define ADD(x,y) (void*)(((i_int)x)+(((i_int)y)-1))
81+#define MULT(x,y) (MKINT((((i_int)x)>>1) * (((i_int)y)>>1)))
69
82
70−#define PUSHFLOAT(i) *(vm->floatstack_ptr++) = i;
83+// Stack management
71−#define POPFLOAT --vm->floatstack_ptr;
72
84
73−#define DISCARD(n) vm->valstack_ptr-=n;
85+#define INITFRAME VAL* myoldbase
74−#define DISCARDINT(n) vm->intstack_ptr-=n;
86+#define REBASE vm->valstack_base = oldbase
75−#define DISCARDFLOAT(n) vm->floatstack_ptr-=n;
87+#define RESERVE(x)
88+#define ADDTOP(x) vm->valstack_top += (x)
89+#define TOPBASE(x) vm->valstack_top = vm->valstack_base + (x)
90+#define BASETOP(x) vm->valstack_base = vm->valstack_top + (x)
91+#define STOREOLD myoldbase = vm->valstack_base
92+
93+#define CALL(f) f(vm, myoldbase);
94+#define TAILCALL(f) f(vm, oldbase);
76
95
77// Creating new values (each value placed at the top of the stack)
96// Creating new values (each value placed at the top of the stack)
78−VAL mkInt(VM* vm, int val);
79−VAL mkFloat(VM* vm, double val);
97+VAL MKFLOAT(VM* vm, double val);
80−VAL mkStr(VM* vm, char* str);
98+VAL MKSTR(VM* vm, char* str);
99+
100+VAL MKCON(VM* vm, int tag, int arity, ...);
81
101
82−VAL mkThunk(VM* vm, func fn, int args, int arity);
102+void PROJECT(VM* vm, VAL r, int loc, int arity);
83−VAL mkCon(VM* vm, int tag, int arity);
84
103
85−void EVAL(int update);
104+void dumpVal(VAL r);
86
105
87// Handle stack overflow.
106// Handle stack overflow.
88// Just reports an error and exits.
107// Just reports an error and exits.