git.iko.soy/Idris-dev
on master help sign in
Make getArgs work with new backend
314246bEdwin Brady
lib/system.idr+2−2
compare with master
unifiedsplit
@@ -9,10 +9,10 @@ getArgs = do n <- numArgs
9 ga' [] 0 n
9 ga' [] 0 n
10 where
10 where
11 numArgs : IO Int
11 numArgs : IO Int
12− numArgs = mkForeign (FFun "epic_numArgs" [] FInt)
12+ numArgs = mkForeign (FFun "idris_numArgs" [FPtr] FInt) prim__vm
13
13
14 getArg : Int -> IO String
14 getArg : Int -> IO String
15− getArg x = mkForeign (FFun "epic_getArg" [FInt] FString) x
15+ getArg x = mkForeign (FFun "idris_getArg" [FPtr, FInt] (FAny String)) prim__vm x
16
16
17 ga' : List String -> Int -> Int -> IO (List String)
17 ga' : List String -> Int -> Int -> IO (List String)
18 ga' acc i n = if (i == n) then (return $ reverse acc) else
18 ga' acc i n = if (i == n) then (return $ reverse acc) else
rts/Makefile+1−1
@@ -1,6 +1,6 @@
1OBJS = idris_rts.o idris_gc.o idris_gmp.o idris_stdfgn.o
1OBJS = idris_rts.o idris_gc.o idris_gmp.o idris_stdfgn.o
2HDRS = idris_rts.h idris_gc.h idris_gmp.h idris_stdfgn.h
2HDRS = idris_rts.h idris_gc.h idris_gmp.h idris_stdfgn.h
3−CFLAGS = -O2
3+CFLAGS = -O2 -Wall -Werror
4
4
5LIBTARGET = libidris_rts.a
5LIBTARGET = libidris_rts.a
6
6
rts/idris_gc.c+8−1
@@ -5,7 +5,7 @@
5VAL copy(VM* vm, VAL x) {
5VAL copy(VM* vm, VAL x) {
6 int i;
6 int i;
7 VAL* argptr;
7 VAL* argptr;
8− Closure* cl;
8+ Closure* cl = NULL;
9 if (x==NULL || ISINT(x)) {
9 if (x==NULL || ISINT(x)) {
10 return x;
10 return x;
11 }
11 }
@@ -36,6 +36,8 @@ VAL copy(VM* vm, VAL x) {
36 break;
36 break;
37 case FWD:
37 case FWD:
38 return x->info.ptr;
38 return x->info.ptr;
39+ default:
40+ break;
39 }
41 }
40 x->ty = FWD;
42 x->ty = FWD;
41 x->info.ptr = cl;
43 x->info.ptr = cl;
@@ -62,6 +64,8 @@ void cheney(VM *vm) {
62 argptr++;
64 argptr++;
63 }
65 }
64 break;
66 break;
67+ default: // Nothing to copy
68+ break;
65 }
69 }
66 scan += inc;
70 scan += inc;
67 }
71 }
@@ -89,6 +93,9 @@ void gc(VM* vm) {
89 for(root = vm->inbox_ptr; root < vm->inbox_write; ++root) {
93 for(root = vm->inbox_ptr; root < vm->inbox_write; ++root) {
90 *root = copy(vm, *root);
94 *root = copy(vm, *root);
91 }
95 }
96+ for(root = vm->argv; root < vm->argv + vm->argc; ++root) {
97+ *root = copy(vm, *root);
98+ }
92 vm->ret = copy(vm, vm->ret);
99 vm->ret = copy(vm, vm->ret);
93 vm->reg1 = copy(vm, vm->reg1);
100 vm->reg1 = copy(vm, vm->reg1);
94
101
rts/idris_main.c+1−1
@@ -1,5 +1,5 @@
1int main(int argc, char* argv[]) {
1int main(int argc, char* argv[]) {
2− VM* vm = init_vm(4096000, 2048000); // 1024000);
2+ VM* vm = init_vm(4096000, 2048000, argc, argv); // 1024000);
3 _idris__123_runMain0_125_(vm, NULL);
3 _idris__123_runMain0_125_(vm, NULL);
4 //_idris_main(vm, NULL);
4 //_idris_main(vm, NULL);
5#ifdef IDRIS_TRACE
5#ifdef IDRIS_TRACE
rts/idris_rts.c+51−32
@@ -9,39 +9,49 @@
9#include "idris_rts.h"
9#include "idris_rts.h"
10#include "idris_gc.h"
10#include "idris_gc.h"
11
11
12−VM* init_vm(int stack_size, size_t heap_size) {
12+VM* init_vm(int stack_size, size_t heap_size, int argc, char* argv[]) {
13 VAL* valstack = malloc(stack_size*sizeof(VAL));
13 VAL* valstack = malloc(stack_size*sizeof(VAL));
14 int* intstack = malloc(stack_size*sizeof(int));
14 int* intstack = malloc(stack_size*sizeof(int));
15 double* floatstack = malloc(stack_size*sizeof(double));
15 double* floatstack = malloc(stack_size*sizeof(double));
16
16
17 VM* vm = malloc(sizeof(VM));
17 VM* vm = malloc(sizeof(VM));
18− vm -> valstack = valstack;
18+ vm->valstack = valstack;
19− vm -> valstack_top = valstack;
19+ vm->valstack_top = valstack;
20− vm -> valstack_base = valstack;
20+ vm->valstack_base = valstack;
21− vm -> intstack = intstack;
21+ vm->intstack = intstack;
22− vm -> intstack_ptr = intstack;
22+ vm->intstack_ptr = intstack;
23− vm -> floatstack = floatstack;
23+ vm->floatstack = floatstack;
24− vm -> floatstack_ptr = floatstack;
24+ vm->floatstack_ptr = floatstack;
25− vm -> stack_max = valstack + stack_size;
25+ vm->stack_max = valstack + stack_size;
26− vm -> heap = malloc(heap_size);
26+ vm->heap = malloc(heap_size);
27− vm -> oldheap = NULL;
27+ vm->oldheap = NULL;
28− vm -> heap_next = vm -> heap;
28+ vm->heap_next = vm->heap;
29− vm -> heap_end = vm -> heap + heap_size;
29+ vm->heap_end = vm->heap + heap_size;
30− vm -> heap_size = heap_size;
30+ vm->heap_size = heap_size;
31− vm -> collections = 0;
31+ vm->collections = 0;
32− vm -> allocations = 0;
32+ vm->allocations = 0;
33− vm -> heap_growth = heap_size;
33+ vm->heap_growth = heap_size;
34− vm -> ret = NULL;
34+ vm->ret = NULL;
35− vm -> reg1 = NULL;
35+ vm->reg1 = NULL;
36−
36+
37− vm -> inbox = malloc(1024*sizeof(VAL));
37+ vm->inbox = malloc(1024*sizeof(VAL));
38− vm -> inbox_end = vm -> inbox + 1024;
38+ vm->inbox_end = vm->inbox + 1024;
39− vm -> inbox_ptr = vm -> inbox;
39+ vm->inbox_ptr = vm->inbox;
40− vm -> inbox_write = vm -> inbox;
40+ vm->inbox_write = vm->inbox;
41−
41+
42− pthread_mutex_init(&(vm -> inbox_lock), NULL);
42+ pthread_mutex_init(&(vm->inbox_lock), NULL);
43− pthread_mutex_init(&(vm -> inbox_block), NULL);
43+ pthread_mutex_init(&(vm->inbox_block), NULL);
44− pthread_cond_init(&(vm -> inbox_waiting), NULL);
44+ pthread_cond_init(&(vm->inbox_waiting), NULL);
45+
46+ int i;
47+
48+ // Assumption: there's enough space for this in the initial heap.
49+ vm->argv = malloc(argc*sizeof(VAL));
50+ vm->argc = argc;
51+
52+ for(i = 0; i < argc; ++i) {
53+ vm->argv[i] = MKSTR(vm, argv[i]);
54+ }
45
55
46 return vm;
56 return vm;
47}
57}
@@ -52,6 +62,7 @@ void terminate(VM* vm) {
52 free(vm->intstack);
62 free(vm->intstack);
53 free(vm->floatstack);
63 free(vm->floatstack);
54 free(vm->heap);
64 free(vm->heap);
65+ free(vm->argv);
55 if (vm->oldheap != NULL) { free(vm->oldheap); }
66 if (vm->oldheap != NULL) { free(vm->oldheap); }
56 pthread_mutex_destroy(&(vm -> inbox_lock));
67 pthread_mutex_destroy(&(vm -> inbox_lock));
57 pthread_mutex_destroy(&(vm -> inbox_block));
68 pthread_mutex_destroy(&(vm -> inbox_block));
@@ -349,13 +360,14 @@ void* runThread(void* arg) {
349 td->fn(vm, NULL);
360 td->fn(vm, NULL);
350
361
351 free(td);
362 free(td);
363+ return NULL;
352}
364}
353
365
354void* vmThread(VM* callvm, func f, VAL arg) {
366void* vmThread(VM* callvm, func f, VAL arg) {
355− VM* vm = init_vm(callvm->stack_max - callvm->valstack, callvm->heap_size);
367+ VM* vm = init_vm(callvm->stack_max - callvm->valstack, callvm->heap_size, 0, NULL);
356 pthread_t t;
368 pthread_t t;
357 pthread_attr_t attr;
369 pthread_attr_t attr;
358− size_t stacksize;
370+// size_t stacksize;
359
371
360 pthread_attr_init(&attr);
372 pthread_attr_init(&attr);
361// pthread_attr_getstacksize (&attr, &stacksize);
373// pthread_attr_getstacksize (&attr, &stacksize);
@@ -405,9 +417,8 @@ VAL copyTo(VM* vm, VAL x) {
405 case PTR:
417 case PTR:
406 cl = MKPTR(vm, x->info.ptr);
418 cl = MKPTR(vm, x->info.ptr);
407 break;
419 break;
408− case FWD:
420+ default:
409 assert(0); // We're in trouble if this happens...
421 assert(0); // We're in trouble if this happens...
410− return x->info.ptr;
411 }
422 }
412 return cl;
423 return cl;
413}
424}
@@ -465,6 +476,14 @@ VAL recvMessage(VM* vm) {
465 return msg;
476 return msg;
466}
477}
467
478
479+int idris_numArgs(VM* vm) {
480+ return vm->argc;
481+}
482+
483+VAL idris_getArg(VM* vm, int i) {
484+ return vm->argv[i];
485+}
486+
468void stackOverflow() {
487void stackOverflow() {
469 fprintf(stderr, "Stack overflow");
488 fprintf(stderr, "Stack overflow");
470 exit(-1);
489 exit(-1);
rts/idris_rts.h+10−2
@@ -11,7 +11,7 @@
11// Closures
11// Closures
12
12
13typedef enum {
13typedef enum {
14− CON, INT, BIGINT, FLOAT, STRING, UNIT, PTR, MSG, FWD
14+ CON, INT, BIGINT, FLOAT, STRING, UNIT, PTR, FWD
15} ClosureType;
15} ClosureType;
16
16
17typedef struct {
17typedef struct {
@@ -57,6 +57,9 @@ typedef struct {
57 VAL* inbox_ptr; // Next message to read
57 VAL* inbox_ptr; // Next message to read
58 VAL* inbox_write; // Location of next message to write
58 VAL* inbox_write; // Location of next message to write
59
59
60+ int argc;
61+ VAL* argv; // command line arguments
62+
60 size_t heap_size;
63 size_t heap_size;
61 size_t heap_growth;
64 size_t heap_growth;
62 int allocations;
65 int allocations;
@@ -66,7 +69,7 @@ typedef struct {
66} VM;
69} VM;
67
70
68// Create a new VM
71// Create a new VM
69−VM* init_vm(int stack_size, size_t heap_size);
72+VM* init_vm(int stack_size, size_t heap_size, int argc, char* argv[]);
70// Clean up a VM once it's no longer needed
73// Clean up a VM once it's no longer needed
71void terminate(VM* vm);
74void terminate(VM* vm);
72
75
@@ -170,6 +173,11 @@ VAL idris_strCons(VM* vm, VAL x, VAL xs);
170VAL idris_strIndex(VM* vm, VAL str, VAL i);
173VAL idris_strIndex(VM* vm, VAL str, VAL i);
171VAL idris_strRev(VM* vm, VAL str);
174VAL idris_strRev(VM* vm, VAL str);
172
175
176+// Command line args
177+
178+int idris_numArgs(VM* vm);
179+VAL idris_getArg(VM* vm, int i);
180+
173// Handle stack overflow.
181// Handle stack overflow.
174// Just reports an error and exits.
182// Just reports an error and exits.
175
183