ce26633 · Idris-dev · git.iko.soy

rts/idris_gc.c+8−4

compare with master

unifiedsplit

@@ -12,10 +12,14 @@ VAL copy(VM* vm, VAL x) {

12 switch(GETTY(x)) {

13 case CON:

14 ar = CARITY(x);

15+ if (ar == 0 && CTAG(x) < 256) {

16+ return x;

17+ } else {

15− allocCon(cl, vm, CTAG(x), ar, 1);

18+ allocCon(cl, vm, CTAG(x), ar, 1);

16− for(i = 0; i < ar; ++i) {

19+ for(i = 0; i < ar; ++i) {

17−// *argptr = copy(vm, *((VAL*)(x->info.c.args)+i)); // recursive version

20+ // *argptr = copy(vm, *((VAL*)(x->info.c.args)+i)); // recursive version

18− cl->info.c.args[i] = x->info.c.args[i];

21+ cl->info.c.args[i] = x->info.c.args[i];

22+ }

19 }

23 }

20 break;

24 break;

21 case FLOAT:

25 case FLOAT:

rts/idris_main.c+3

@@ -15,6 +15,8 @@ int main(int argc, char* argv[]) {

15 __idris_argv = argv;

16

17 VM* vm = init_vm(opts.max_stack_size, opts.init_heap_size, 1);

18+ initNullaries();

19+

18 _idris__123_runMain0_125_(vm, NULL);

20 _idris__123_runMain0_125_(vm, NULL);

19

21

20#ifdef IDRIS_DEBUG

22#ifdef IDRIS_DEBUG

@@ -29,5 +31,6 @@ int main(int argc, char* argv[]) {

29 print_stats(&stats);

31 print_stats(&stats);

30 }

32 }

31

33

34+ freeNullaries();

32 return EXIT_SUCCESS;

35 return EXIT_SUCCESS;

33}

36}

rts/idris_rts.c+33−6

@@ -828,12 +828,16 @@ VAL copyTo(VM* vm, VAL x) {

828 switch(GETTY(x)) {

829 case CON:

830 ar = CARITY(x);

831+ if (ar == 0 && CTAG(x) < 256) { // globally allocated

832+ cl = x;

833+ } else {

831− allocCon(cl, vm, CTAG(x), ar, 1);

834+ allocCon(cl, vm, CTAG(x), ar, 1);

832−

835+

833− argptr = (VAL*)(cl->info.c.args);

836+ argptr = (VAL*)(cl->info.c.args);

834− for(i = 0; i < ar; ++i) {

837+ for(i = 0; i < ar; ++i) {

835− *argptr = copyTo(vm, *((VAL*)(x->info.c.args)+i)); // recursive version

838+ *argptr = copyTo(vm, *((VAL*)(x->info.c.args)+i)); // recursive version

836− argptr++;

839+ argptr++;

840+ }

837 }

841 }

838 break;

842 break;

839 case FLOAT:

843 case FLOAT:

@@ -962,6 +966,29 @@ VAL idris_recvMessage(VM* vm) {

962 return msg;

966 return msg;

963}

967}

964#endif

968#endif

969+

970+VAL* nullary_cons;

971+

972+void initNullaries() {

973+ int i;

974+ VAL cl;

975+ nullary_cons = malloc(256 * sizeof(VAL));

976+ for(i = 0; i < 256; ++i) {

977+ cl = malloc(sizeof(Closure));

978+ SETTY(cl, CON);

979+ cl->info.c.tag_arity = i << 8;

980+ nullary_cons[i] = cl;

981+ }

982+}

983+

984+void freeNullaries() {

985+ int i;

986+ for(i = 0; i < 256; ++i) {

987+ free(nullary_cons[i]);

988+ }

989+ free(nullary_cons);

990+}

991+

965int __idris_argc;

992int __idris_argc;

966char **__idris_argv;

993char **__idris_argv;

967

994

rts/idris_rts.h+6

@@ -219,6 +219,12 @@ void idris_doneAlloc(VM* vm);

219 SETTY(cl, CON); \

220 cl->info.c.tag_arity = ((t) << 8) | (a);

221

222+#define NULL_CON(x) nullary_cons[x]

223+

224+extern VAL* nullary_cons;

225+void initNullaries();

226+void freeNullaries();

227+

222void* vmThread(VM* callvm, func f, VAL arg);

228void* vmThread(VM* callvm, func f, VAL arg);

223

229

224// Copy a structure to another vm's heap

230// Copy a structure to another vm's heap

src/IRTS/CodegenC.hs+2

@@ -153,6 +153,8 @@ bcc i (ASSIGNCONST l c)

153 mkConst (B64 x) = "idris_b64const(vm, " ++ show x ++ "ULL)"

154 mkConst _ = "MKINT(42424242)"

155bcc i (UPDATE l r) = indent i ++ creg l ++ " = " ++ creg r ++ ";\n"

156+bcc i (MKCON l loc tag []) | tag < 256

157+ = indent i ++ creg l ++ " = NULL_CON(" ++ show tag ++ ");\n"

156bcc i (MKCON l loc tag args)

158bcc i (MKCON l loc tag args)

157 = indent i ++ alloc loc tag ++

159 = indent i ++ alloc loc tag ++

158 indent i ++ setArgs 0 args ++ "\n" ++

160 indent i ++ setArgs 0 args ++ "\n" ++

src/IRTS/Lang.hs+1−1

@@ -217,7 +217,7 @@ allocUnique defs (n, LFun opts fn args e)

217 = findUp (LCon Nothing i n as)

218 findUp (LV (Glob n))

219 | Just (LConstructor _ i 0) <- lookupCtxtExact n defs

220− = findUp (LCon Nothing i n [])

220+ = return $ LCon Nothing i n [] -- nullary cons are global, no need to update

221 findUp (LApp t f as) = LApp t <$> findUp f <*> mapM findUp as

222 findUp (LLazyApp n as) = LLazyApp n <$> mapM findUp as

223 findUp (LLazyExp e) = LLazyExp <$> findUp e