git.iko.soy/Idris-dev
on master help sign in
Don't keep allocating nullary constructors
commitce266335281bdb5fde752eb74462dac942c21a09 authorEdwin Brady <ecb10@st-andrews.ac.uk> dateTue 19 Aug 2014, 20:06 (12 years ago) parent8353de5
6 files changed+53−11
compare with master
unifiedsplit
rts/idris_gc.c+8−4 rts/idris_main.c+3 rts/idris_rts.c+33−6 rts/idris_rts.h+6 src/IRTS/CodegenC.hs+2 src/IRTS/Lang.hs+1−1
rts/idris_gc.c+8−4
@@ -12,10 +12,14 @@ VAL copy(VM* vm, VAL x) {
1212 switch(GETTY(x)) {
1313 case CON:
1414 ar = CARITY(x);
15− allocCon(cl, vm, CTAG(x), ar, 1);
16− for(i = 0; i < ar; ++i) {
17−// *argptr = copy(vm, *((VAL*)(x->info.c.args)+i)); // recursive version
18− cl->info.c.args[i] = x->info.c.args[i];
15+ if (ar == 0 && CTAG(x) < 256) {
16+ return x;
17+ } else {
18+ allocCon(cl, vm, CTAG(x), ar, 1);
19+ for(i = 0; i < ar; ++i) {
20+ // *argptr = copy(vm, *((VAL*)(x->info.c.args)+i)); // recursive version
21+ cl->info.c.args[i] = x->info.c.args[i];
22+ }
1923 }
2024 break;
2125 case FLOAT:
rts/idris_main.c+3
@@ -15,6 +15,8 @@ int main(int argc, char* argv[]) {
1515 __idris_argv = argv;
1616
1717 VM* vm = init_vm(opts.max_stack_size, opts.init_heap_size, 1);
18+ initNullaries();
19+
1820 _idris__123_runMain0_125_(vm, NULL);
1921
2022#ifdef IDRIS_DEBUG
@@ -29,5 +31,6 @@ int main(int argc, char* argv[]) {
2931 print_stats(&stats);
3032 }
3133
34+ freeNullaries();
3235 return EXIT_SUCCESS;
3336}
rts/idris_rts.c+33−6
@@ -828,12 +828,16 @@ VAL copyTo(VM* vm, VAL x) {
828828 switch(GETTY(x)) {
829829 case CON:
830830 ar = CARITY(x);
831− allocCon(cl, vm, CTAG(x), ar, 1);
832−
833− argptr = (VAL*)(cl->info.c.args);
834− for(i = 0; i < ar; ++i) {
835− *argptr = copyTo(vm, *((VAL*)(x->info.c.args)+i)); // recursive version
836− argptr++;
831+ if (ar == 0 && CTAG(x) < 256) { // globally allocated
832+ cl = x;
833+ } else {
834+ allocCon(cl, vm, CTAG(x), ar, 1);
835+
836+ argptr = (VAL*)(cl->info.c.args);
837+ for(i = 0; i < ar; ++i) {
838+ *argptr = copyTo(vm, *((VAL*)(x->info.c.args)+i)); // recursive version
839+ argptr++;
840+ }
837841 }
838842 break;
839843 case FLOAT:
@@ -962,6 +966,29 @@ VAL idris_recvMessage(VM* vm) {
962966 return msg;
963967}
964968#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+
965992int __idris_argc;
966993char **__idris_argv;
967994
rts/idris_rts.h+6
@@ -219,6 +219,12 @@ void idris_doneAlloc(VM* vm);
219219 SETTY(cl, CON); \
220220 cl->info.c.tag_arity = ((t) << 8) | (a);
221221
222+#define NULL_CON(x) nullary_cons[x]
223+
224+extern VAL* nullary_cons;
225+void initNullaries();
226+void freeNullaries();
227+
222228void* vmThread(VM* callvm, func f, VAL arg);
223229
224230// Copy a structure to another vm's heap
src/IRTS/CodegenC.hs+2
@@ -153,6 +153,8 @@ bcc i (ASSIGNCONST l c)
153153 mkConst (B64 x) = "idris_b64const(vm, " ++ show x ++ "ULL)"
154154 mkConst _ = "MKINT(42424242)"
155155bcc 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"
156158bcc i (MKCON l loc tag args)
157159 = indent i ++ alloc loc tag ++
158160 indent i ++ setArgs 0 args ++ "\n" ++
src/IRTS/Lang.hs+1−1
@@ -217,7 +217,7 @@ allocUnique defs (n, LFun opts fn args e)
217217 = findUp (LCon Nothing i n as)
218218 findUp (LV (Glob n))
219219 | 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
221221 findUp (LApp t f as) = LApp t <$> findUp f <*> mapM findUp as
222222 findUp (LLazyApp n as) = LLazyApp n <$> mapM findUp as
223223 findUp (LLazyExp e) = LLazyExp <$> findUp e