314246b · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Make getArgs work with new backend

commit314246b976ab116eb7bdd8b14af49b9f7cbb3092 authorEdwin Brady <eb@cs.st-andrews.ac.uk> dateMon 24 Sep 2012, 20:48 (14 years ago) parent16027dd

6 files changed+73−39

compare with master

unifiedsplit

lib/system.idr+2−2 rts/Makefile+1−1 rts/idris_gc.c+8−1 rts/idris_main.c+1−1 rts/idris_rts.c+51−32 rts/idris_rts.h+10−2

lib/system.idr+2−2

@@ -9,10 +9,10 @@ getArgs = do n <- numArgs

99 ga' [] 0 n

1010 where

1111 numArgs : IO Int

12− numArgs = mkForeign (FFun "epic_numArgs" [] FInt)

12+ numArgs = mkForeign (FFun "idris_numArgs" [FPtr] FInt) prim__vm

1313

1414 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

1616

1717 ga' : List String -> Int -> Int -> IO (List String)

1818 ga' acc i n = if (i == n) then (return $ reverse acc) else

rts/Makefile+1−1

@@ -1,6 +1,6 @@

11OBJS = idris_rts.o idris_gc.o idris_gmp.o idris_stdfgn.o

22HDRS = idris_rts.h idris_gc.h idris_gmp.h idris_stdfgn.h

3−CFLAGS = -O2

3+CFLAGS = -O2 -Wall -Werror

55LIBTARGET = libidris_rts.a

rts/idris_gc.c+8−1

@@ -5,7 +5,7 @@

55VAL copy(VM* vm, VAL x) {

66 int i;

77 VAL* argptr;

8− Closure* cl;

8+ Closure* cl = NULL;

99 if (x==NULL || ISINT(x)) {

1010 return x;

1111 }

@@ -36,6 +36,8 @@ VAL copy(VM* vm, VAL x) {

3636 break;

3737 case FWD:

3838 return x->info.ptr;

39+ default:

40+ break;

3941 }

4042 x->ty = FWD;

4143 x->info.ptr = cl;

@@ -62,6 +64,8 @@ void cheney(VM *vm) {

6264 argptr++;

6365 }

6466 break;

67+ default: // Nothing to copy

68+ break;

6569 }

6670 scan += inc;

6771 }

@@ -89,6 +93,9 @@ void gc(VM* vm) {

8993 for(root = vm->inbox_ptr; root < vm->inbox_write; ++root) {

9094 *root = copy(vm, *root);

9195 }

96+ for(root = vm->argv; root < vm->argv + vm->argc; ++root) {

97+ *root = copy(vm, *root);

98+ }

9299 vm->ret = copy(vm, vm->ret);

93100 vm->reg1 = copy(vm, vm->reg1);

94101

rts/idris_main.c+1−1

@@ -1,5 +1,5 @@

11int main(int argc, char* argv[]) {

2− VM* vm = init_vm(4096000, 2048000); // 1024000);

2+ VM* vm = init_vm(4096000, 2048000, argc, argv); // 1024000);

33 _idris__123_runMain0_125_(vm, NULL);

44 //_idris_main(vm, NULL);

55#ifdef IDRIS_TRACE

rts/idris_rts.c+51−32

@@ -9,39 +9,49 @@

99#include "idris_rts.h"

1010#include "idris_gc.h"

1111

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[]) {

1313 VAL* valstack = malloc(stack_size*sizeof(VAL));

1414 int* intstack = malloc(stack_size*sizeof(int));

1515 double* floatstack = malloc(stack_size*sizeof(double));

1616

1717 VM* vm = malloc(sizeof(VM));

18− vm -> valstack = valstack;

19− vm -> valstack_top = valstack;

20− vm -> valstack_base = valstack;

21− vm -> intstack = intstack;

22− vm -> intstack_ptr = intstack;

23− vm -> floatstack = floatstack;

24− vm -> floatstack_ptr = floatstack;

25− vm -> stack_max = valstack + stack_size;

26− vm -> heap = malloc(heap_size);

27− vm -> oldheap = NULL;

28− vm -> heap_next = vm -> heap;

29− vm -> heap_end = vm -> heap + heap_size;

30− vm -> heap_size = heap_size;

31− vm -> collections = 0;

32− vm -> allocations = 0;

33− vm -> heap_growth = heap_size;

34− vm -> ret = NULL;

35− vm -> reg1 = NULL;

36−

37− vm -> inbox = malloc(1024*sizeof(VAL));

38− vm -> inbox_end = vm -> inbox + 1024;

39− vm -> inbox_ptr = vm -> inbox;

40− vm -> inbox_write = vm -> inbox;

41−

42− pthread_mutex_init(&(vm -> inbox_lock), NULL);

43− pthread_mutex_init(&(vm -> inbox_block), NULL);

44− pthread_cond_init(&(vm -> inbox_waiting), NULL);

18+ vm->valstack = valstack;

19+ vm->valstack_top = valstack;

20+ vm->valstack_base = valstack;

21+ vm->intstack = intstack;

22+ vm->intstack_ptr = intstack;

23+ vm->floatstack = floatstack;

24+ vm->floatstack_ptr = floatstack;

25+ vm->stack_max = valstack + stack_size;

26+ vm->heap = malloc(heap_size);

27+ vm->oldheap = NULL;

28+ vm->heap_next = vm->heap;

29+ vm->heap_end = vm->heap + heap_size;

30+ vm->heap_size = heap_size;

31+ vm->collections = 0;

32+ vm->allocations = 0;

33+ vm->heap_growth = heap_size;

34+ vm->ret = NULL;

35+ vm->reg1 = NULL;

36+

37+ vm->inbox = malloc(1024*sizeof(VAL));

38+ vm->inbox_end = vm->inbox + 1024;

39+ vm->inbox_ptr = vm->inbox;

40+ vm->inbox_write = vm->inbox;

41+

42+ pthread_mutex_init(&(vm->inbox_lock), NULL);

43+ pthread_mutex_init(&(vm->inbox_block), 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+ }

4555

4656 return vm;

4757}

@@ -52,6 +62,7 @@ void terminate(VM* vm) {

5262 free(vm->intstack);

5363 free(vm->floatstack);

5464 free(vm->heap);

65+ free(vm->argv);

5566 if (vm->oldheap != NULL) { free(vm->oldheap); }

5667 pthread_mutex_destroy(&(vm -> inbox_lock));

5768 pthread_mutex_destroy(&(vm -> inbox_block));

@@ -349,13 +360,14 @@ void* runThread(void* arg) {

349360 td->fn(vm, NULL);

350361

351362 free(td);

363+ return NULL;

352364}

353365

354366void* 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);

356368 pthread_t t;

357369 pthread_attr_t attr;

358− size_t stacksize;

370+// size_t stacksize;

359371

360372 pthread_attr_init(&attr);

361373// pthread_attr_getstacksize (&attr, &stacksize);

@@ -405,9 +417,8 @@ VAL copyTo(VM* vm, VAL x) {

405417 case PTR:

406418 cl = MKPTR(vm, x->info.ptr);

407419 break;

408− case FWD:

420+ default:

409421 assert(0); // We're in trouble if this happens...

410− return x->info.ptr;

411422 }

412423 return cl;

413424}

@@ -465,6 +476,14 @@ VAL recvMessage(VM* vm) {

465476 return msg;

466477}

467478

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+

468487void stackOverflow() {

469488 fprintf(stderr, "Stack overflow");

470489 exit(-1);

rts/idris_rts.h+10−2

@@ -11,7 +11,7 @@

1111// Closures

1212

1313typedef enum {

14− CON, INT, BIGINT, FLOAT, STRING, UNIT, PTR, MSG, FWD

14+ CON, INT, BIGINT, FLOAT, STRING, UNIT, PTR, FWD

1515} ClosureType;

1616

1717typedef struct {

@@ -57,6 +57,9 @@ typedef struct {

5757 VAL* inbox_ptr; // Next message to read

5858 VAL* inbox_write; // Location of next message to write

5959

60+ int argc;

61+ VAL* argv; // command line arguments

62+

6063 size_t heap_size;

6164 size_t heap_growth;

6265 int allocations;

@@ -66,7 +69,7 @@ typedef struct {

6669} VM;

6770

6871// 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[]);

7073// Clean up a VM once it's no longer needed

7174void terminate(VM* vm);

7275

@@ -170,6 +173,11 @@ VAL idris_strCons(VM* vm, VAL x, VAL xs);

170173VAL idris_strIndex(VM* vm, VAL str, VAL i);

171174VAL idris_strRev(VM* vm, VAL str);

172175

176+// Command line args

177+

178+int idris_numArgs(VM* vm);

179+VAL idris_getArg(VM* vm, int i);

180+

173181// Handle stack overflow.

174182// Just reports an error and exits.

175183