git.iko.soy/Idris-dev
on master help sign in
New RTS in place
f959008Edwin Brady
rts/idris_gc.c+4−4
compare with master
unifiedsplit
@@ -55,9 +55,9 @@ void cheney(VM *vm) {
55 case CON:
55 case CON:
56 argptr = (VAL*)(heap_item->info.c.args);
56 argptr = (VAL*)(heap_item->info.c.args);
57 for(i = 0; i < heap_item->info.c.arity; ++i) {
57 for(i = 0; i < heap_item->info.c.arity; ++i) {
58− printf("Copying %d %p\n", heap_item->info.c.tag, *argptr);
58+ // printf("Copying %d %p\n", heap_item->info.c.tag, *argptr);
59 VAL newptr = copy(vm, *argptr);
59 VAL newptr = copy(vm, *argptr);
60− printf("Got %p\t\t%p %p\n", newptr, scan, vm->heap_next);
60+ // printf("Got %p\t\t%p %p\n", newptr, scan, vm->heap_next);
61 *argptr = newptr;
61 *argptr = newptr;
62 argptr++;
62 argptr++;
63 }
63 }
@@ -69,7 +69,7 @@ void cheney(VM *vm) {
69}
69}
70
70
71void gc(VM* vm) {
71void gc(VM* vm) {
72− printf("Collecting\n");
72+ // printf("Collecting\n");
73
73
74 char* newheap = malloc(vm -> heap_size);
74 char* newheap = malloc(vm -> heap_size);
75 char* oldheap = vm -> heap;
75 char* oldheap = vm -> heap;
@@ -99,7 +99,7 @@ void gc(VM* vm) {
99 }
99 }
100 vm->oldheap = oldheap;
100 vm->oldheap = oldheap;
101
101
102− gcInfo(vm, 0);
102+ // gcInfo(vm, 0);
103}
103}
104
104
105void gcInfo(VM* vm, int doGC) {
105void gcInfo(VM* vm, int doGC) {
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, 20480); // 1024000);
2+ VM* vm = init_vm(4096000, 512000); // 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+3−3
@@ -100,7 +100,7 @@ VAL MKCON(VM* vm, VAL cl, int tag, int arity, ...) {
100 cl -> info.c.tag = tag;
100 cl -> info.c.tag = tag;
101 cl -> info.c.arity = arity;
101 cl -> info.c.arity = arity;
102 VAL* argptr = (VAL*)(cl -> info.c.args);
102 VAL* argptr = (VAL*)(cl -> info.c.args);
103− printf("... %p %p\n", cl, argptr);
103+ // printf("... %p %p\n", cl, argptr);
104
104
105 for (i = 0; i < arity; ++i) {
105 for (i = 0; i < arity; ++i) {
106 VAL v = va_arg(args, VAL);
106 VAL v = va_arg(args, VAL);
@@ -146,7 +146,7 @@ void dumpVal(VAL v) {
146 if (v==NULL) return;
146 if (v==NULL) return;
147 int i;
147 int i;
148 if (ISINT(v)) {
148 if (ISINT(v)) {
149− printf("%ld ", GETINT(v));
149+ printf("%d ", (int)(GETINT(v)));
150 return;
150 return;
151 }
151 }
152 switch(v->ty) {
152 switch(v->ty) {
@@ -172,7 +172,7 @@ VAL idris_castIntStr(VM* vm, VAL i) {
172 Closure* cl = allocate(vm, sizeof(Closure) + sizeof(char)*16);
172 Closure* cl = allocate(vm, sizeof(Closure) + sizeof(char)*16);
173 cl -> ty = STRING;
173 cl -> ty = STRING;
174 cl -> info.str = (char*)cl + sizeof(Closure);
174 cl -> info.str = (char*)cl + sizeof(Closure);
175− sprintf(cl -> info.str, "%ld", GETINT(i));
175+ sprintf(cl -> info.str, "%d", (int)(GETINT(i)));
176 return cl;
176 return cl;
177}
177}
178
178
rts/idris_rts.h+1−1
@@ -93,7 +93,7 @@ typedef intptr_t i_int;
93#define INITFRAME VAL* myoldbase
93#define INITFRAME VAL* myoldbase
94#define REBASE vm->valstack_base = oldbase
94#define REBASE vm->valstack_base = oldbase
95#define RESERVE(x) if (vm->valstack_top+(x) > vm->stack_max) { stackOverflow(); } \
95#define RESERVE(x) if (vm->valstack_top+(x) > vm->stack_max) { stackOverflow(); } \
96− else { bzero(vm->valstack_top, (x)); }
96+ else { bzero(vm->valstack_top, (x)*sizeof(VAL)); }
97#define ADDTOP(x) vm->valstack_top += (x)
97#define ADDTOP(x) vm->valstack_top += (x)
98#define TOPBASE(x) vm->valstack_top = vm->valstack_base + (x)
98#define TOPBASE(x) vm->valstack_top = vm->valstack_base + (x)
99#define BASETOP(x) vm->valstack_base = vm->valstack_top + (x)
99#define BASETOP(x) vm->valstack_base = vm->valstack_top + (x)
src/IRTS/CodegenC.hs+1−1
@@ -44,7 +44,7 @@ codegenC defs out exec incs libs dbg
44 " " ++ tmpn ++
44 " " ++ tmpn ++
45 " `idris --link` `idris --include` " ++ libs ++
45 " `idris --link` `idris --include` " ++ libs ++
46 " -lidris_rts -lgmp -o " ++ out
46 " -lidris_rts -lgmp -o " ++ out
47−-- putStrLn cout
47+ -- putStrLn cout
48 exit <- system gcc
48 exit <- system gcc
49 when (exit /= ExitSuccess) $
49 when (exit /= ExitSuccess) $
50 putStrLn ("FAILURE: " ++ gcc)
50 putStrLn ("FAILURE: " ++ gcc)
src/IRTS/Compiler.hs+1−1
@@ -36,7 +36,7 @@ compileC f tm = do checkMVs
36 let checked = checkDefs defuns (toAlist defuns)
36 let checked = checkDefs defuns (toAlist defuns)
37 case checked of
37 case checked of
38 OK c -> do -- iputStrLn $ showSep "\n" (map show c)
38 OK c -> do -- iputStrLn $ showSep "\n" (map show c)
39− liftIO $ codegenC c f True [] "" TRACE
39+ liftIO $ codegenC c f True [] "" NONE
40 Error e -> fail $ show e
40 Error e -> fail $ show e
41 where checkMVs = do i <- get
41 where checkMVs = do i <- get
42 case idris_metavars i \\ primDefs of
42 case idris_metavars i \\ primDefs of
src/Idris/REPL.hs+4−4
@@ -264,7 +264,7 @@ process fn Execute = do (m, _) <- elabVal toplevel False
264-- (PRef (FC "main" 0) (NS (UN "main") ["main"]))
264-- (PRef (FC "main" 0) (NS (UN "main") ["main"]))
265 (tmpn, tmph) <- liftIO tempfile
265 (tmpn, tmph) <- liftIO tempfile
266 liftIO $ hClose tmph
266 liftIO $ hClose tmph
267− compile tmpn m
267+ compileC tmpn m
268 liftIO $ system tmpn
268 liftIO $ system tmpn
269 return ()
269 return ()
270 where fc = FC "main" 0
270 where fc = FC "main" 0
@@ -272,13 +272,13 @@ process fn (NewCompile f)
272 = do (m, _) <- elabVal toplevel False
272 = do (m, _) <- elabVal toplevel False
273 (PApp fc (PRef fc (UN "run__IO"))
273 (PApp fc (PRef fc (UN "run__IO"))
274 [pexp $ PRef fc (NS (UN "main") ["main"])])
274 [pexp $ PRef fc (NS (UN "main") ["main"])])
275− compileC f m
275+ compile f m
276 where fc = FC "main" 0
276 where fc = FC "main" 0
277process fn (Compile f)
277process fn (Compile f)
278 = do (m, _) <- elabVal toplevel False
278 = do (m, _) <- elabVal toplevel False
279 (PApp fc (PRef fc (UN "run__IO"))
279 (PApp fc (PRef fc (UN "run__IO"))
280− [pexp $ PRef fc (NS (UN "main") ["main"])])
280+ [pexp $ PRef fc (NS (UN "main") ["main"])])
281− compile f m
281+ compileC f m
282 where fc = FC "main" 0
282 where fc = FC "main" 0
283process fn (LogLvl i) = setLogLevel i
283process fn (LogLvl i) = setLogLevel i
284process fn Metavars
284process fn Metavars