git.iko.soy/Idris-dev
on master help sign in
Message passing fixes; also abstract SETTY/GETTY in rts
ba6042fEdwin Brady
rts/idris_gc.c+3−3
compare with master
unifiedsplit
@@ -9,7 +9,7 @@ VAL copy(VM* vm, VAL x) {
9 if (x==NULL || ISINT(x)) {
9 if (x==NULL || ISINT(x)) {
10 return x;
10 return x;
11 }
11 }
12− switch(x->ty) {
12+ switch(GETTY(x)) {
13 case CON:
13 case CON:
14 cl = allocCon(vm, x->info.c.arity);
14 cl = allocCon(vm, x->info.c.arity);
15 cl->info.c.tag = x->info.c.tag;
15 cl->info.c.tag = x->info.c.tag;
@@ -39,7 +39,7 @@ VAL copy(VM* vm, VAL x) {
39 default:
39 default:
40 break;
40 break;
41 }
41 }
42− x->ty = FWD;
42+ SETTY(x, FWD);
43 x->info.ptr = cl;
43 x->info.ptr = cl;
44 return cl;
44 return cl;
45}
45}
@@ -53,7 +53,7 @@ void cheney(VM *vm) {
53 size_t inc = *((size_t*)scan);
53 size_t inc = *((size_t*)scan);
54 VAL heap_item = (VAL)(scan+sizeof(size_t));
54 VAL heap_item = (VAL)(scan+sizeof(size_t));
55 // If it's a CON, copy its arguments
55 // If it's a CON, copy its arguments
56− switch(heap_item->ty) {
56+ switch(GETTY(heap_item)) {
57 case CON:
57 case CON:
58 argptr = (VAL*)(heap_item->info.c.args);
58 argptr = (VAL*)(heap_item->info.c.args);
59 for(i = 0; i < heap_item->info.c.arity; ++i) {
59 for(i = 0; i < heap_item->info.c.arity; ++i) {
rts/idris_gmp.c+7−7
@@ -15,7 +15,7 @@ VAL MKBIGC(VM* vm, char* val) {
15 mpz_init(*bigint);
15 mpz_init(*bigint);
16 mpz_set_str(*bigint, val, 10);
16 mpz_set_str(*bigint, val, 10);
17
17
18− cl -> ty = BIGINT;
18+ SETTY(cl, BIGINT);
19 cl -> info.ptr = (void*)bigint;
19 cl -> info.ptr = (void*)bigint;
20
20
21 return cl;
21 return cl;
@@ -29,7 +29,7 @@ VAL MKBIGM(VM* vm, void* big) {
29 mpz_init(*bigint);
29 mpz_init(*bigint);
30 mpz_set(*bigint, *((mpz_t*)big));
30 mpz_set(*bigint, *((mpz_t*)big));
31
31
32− cl -> ty = BIGINT;
32+ SETTY(cl, BIGINT);
33 cl -> info.ptr = (void*)bigint;
33 cl -> info.ptr = (void*)bigint;
34
34
35 return cl;
35 return cl;
@@ -44,7 +44,7 @@ VAL GETBIG(VM * vm, VAL x) {
44 mpz_init(*bigint);
44 mpz_init(*bigint);
45 mpz_set_si(*bigint, GETINT(x));
45 mpz_set_si(*bigint, GETINT(x));
46
46
47− cl -> ty = BIGINT;
47+ SETTY(cl, BIGINT);
48 cl -> info.ptr = (void*)bigint;
48 cl -> info.ptr = (void*)bigint;
49
49
50 return cl;
50 return cl;
@@ -58,7 +58,7 @@ VAL bigAdd(VM* vm, VAL x, VAL y) {
58 VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
58 VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
59 bigint = allocate(vm, sizeof(mpz_t));
59 bigint = allocate(vm, sizeof(mpz_t));
60 mpz_add(*bigint, GETMPZ(x), GETMPZ(y));
60 mpz_add(*bigint, GETMPZ(x), GETMPZ(y));
61− cl -> ty = BIGINT;
61+ SETTY(cl, BIGINT);
62 cl -> info.ptr = (void*)bigint;
62 cl -> info.ptr = (void*)bigint;
63 return cl;
63 return cl;
64}
64}
@@ -68,7 +68,7 @@ VAL bigSub(VM* vm, VAL x, VAL y) {
68 VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
68 VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
69 bigint = allocate(vm, sizeof(mpz_t));
69 bigint = allocate(vm, sizeof(mpz_t));
70 mpz_sub(*bigint, GETMPZ(x), GETMPZ(y));
70 mpz_sub(*bigint, GETMPZ(x), GETMPZ(y));
71− cl -> ty = BIGINT;
71+ SETTY(cl, BIGINT);
72 cl -> info.ptr = (void*)bigint;
72 cl -> info.ptr = (void*)bigint;
73 return cl;
73 return cl;
74}
74}
@@ -78,7 +78,7 @@ VAL bigMul(VM* vm, VAL x, VAL y) {
78 VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
78 VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
79 bigint = allocate(vm, sizeof(mpz_t));
79 bigint = allocate(vm, sizeof(mpz_t));
80 mpz_mul(*bigint, GETMPZ(x), GETMPZ(y));
80 mpz_mul(*bigint, GETMPZ(x), GETMPZ(y));
81− cl -> ty = BIGINT;
81+ SETTY(cl, BIGINT);
82 cl -> info.ptr = (void*)bigint;
82 cl -> info.ptr = (void*)bigint;
83 return cl;
83 return cl;
84}
84}
@@ -88,7 +88,7 @@ VAL bigDiv(VM* vm, VAL x, VAL y) {
88 VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
88 VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));
89 bigint = allocate(vm, sizeof(mpz_t));
89 bigint = allocate(vm, sizeof(mpz_t));
90 mpz_div(*bigint, GETMPZ(x), GETMPZ(y));
90 mpz_div(*bigint, GETMPZ(x), GETMPZ(y));
91− cl -> ty = BIGINT;
91+ SETTY(cl, BIGINT);
92 cl -> info.ptr = (void*)bigint;
92 cl -> info.ptr = (void*)bigint;
93 return cl;
93 return cl;
94}
94}
rts/idris_rts.c+33−16
@@ -90,7 +90,7 @@ void* allocate(VM* vm, size_t size) {
90
90
91void* allocCon(VM* vm, int arity) {
91void* allocCon(VM* vm, int arity) {
92 Closure* cl = allocate(vm, sizeof(Closure) + sizeof(VAL)*arity);
92 Closure* cl = allocate(vm, sizeof(Closure) + sizeof(VAL)*arity);
93− cl -> ty = CON;
93+ SETTY(cl, CON);
94 if (arity == 0) {
94 if (arity == 0) {
95 cl -> info.c.args = NULL;
95 cl -> info.c.args = NULL;
96 } else {
96 } else {
@@ -104,7 +104,7 @@ void* allocCon(VM* vm, int arity) {
104
104
105VAL MKFLOAT(VM* vm, double val) {
105VAL MKFLOAT(VM* vm, double val) {
106 Closure* cl = allocate(vm, sizeof(Closure));
106 Closure* cl = allocate(vm, sizeof(Closure));
107− cl -> ty = FLOAT;
107+ SETTY(cl, FLOAT);
108 cl -> info.f = val;
108 cl -> info.f = val;
109 return cl;
109 return cl;
110}
110}
@@ -112,7 +112,7 @@ VAL MKFLOAT(VM* vm, double val) {
112VAL MKSTR(VM* vm, char* str) {
112VAL MKSTR(VM* vm, char* str) {
113 Closure* cl = allocate(vm, sizeof(Closure) + // Type) + sizeof(char*) +
113 Closure* cl = allocate(vm, sizeof(Closure) + // Type) + sizeof(char*) +
114 sizeof(char)*strlen(str)+1);
114 sizeof(char)*strlen(str)+1);
115− cl -> ty = STRING;
115+ SETTY(cl, STRING);
116 cl -> info.str = (char*)cl + sizeof(Closure);
116 cl -> info.str = (char*)cl + sizeof(Closure);
117
117
118 strcpy(cl -> info.str, str);
118 strcpy(cl -> info.str, str);
@@ -121,7 +121,7 @@ VAL MKSTR(VM* vm, char* str) {
121
121
122VAL MKPTR(VM* vm, void* ptr) {
122VAL MKPTR(VM* vm, void* ptr) {
123 Closure* cl = allocate(vm, sizeof(Closure));
123 Closure* cl = allocate(vm, sizeof(Closure));
124− cl -> ty = PTR;
124+ SETTY(cl, PTR);
125 cl -> info.ptr = ptr;
125 cl -> info.ptr = ptr;
126 return cl;
126 return cl;
127}
127}
@@ -185,7 +185,7 @@ void dumpVal(VAL v) {
185 printf("%d ", (int)(GETINT(v)));
185 printf("%d ", (int)(GETINT(v)));
186 return;
186 return;
187 }
187 }
188− switch(v->ty) {
188+ switch(GETTY(v)) {
189 case CON:
189 case CON:
190 printf("%d[", v->info.c.tag);
190 printf("%d[", v->info.c.tag);
191 for(i = 0; i < v->info.c.arity; ++i) {
191 for(i = 0; i < v->info.c.arity; ++i) {
@@ -209,7 +209,7 @@ void dumpVal(VAL v) {
209
209
210VAL idris_castIntStr(VM* vm, VAL i) {
210VAL idris_castIntStr(VM* vm, VAL i) {
211 Closure* cl = allocate(vm, sizeof(Closure) + sizeof(char)*16);
211 Closure* cl = allocate(vm, sizeof(Closure) + sizeof(char)*16);
212− cl -> ty = STRING;
212+ SETTY(cl, STRING);
213 cl -> info.str = (char*)cl + sizeof(Closure);
213 cl -> info.str = (char*)cl + sizeof(Closure);
214 sprintf(cl -> info.str, "%d", (int)(GETINT(i)));
214 sprintf(cl -> info.str, "%d", (int)(GETINT(i)));
215 return cl;
215 return cl;
@@ -226,7 +226,7 @@ VAL idris_castStrInt(VM* vm, VAL i) {
226
226
227VAL idris_castFloatStr(VM* vm, VAL i) {
227VAL idris_castFloatStr(VM* vm, VAL i) {
228 Closure* cl = allocate(vm, sizeof(Closure) + sizeof(char)*32);
228 Closure* cl = allocate(vm, sizeof(Closure) + sizeof(char)*32);
229− cl -> ty = STRING;
229+ SETTY(cl, STRING);
230 cl -> info.str = (char*)cl + sizeof(Closure);
230 cl -> info.str = (char*)cl + sizeof(Closure);
231 sprintf(cl -> info.str, "%g", GETFLOAT(i));
231 sprintf(cl -> info.str, "%g", GETFLOAT(i));
232 return cl;
232 return cl;
@@ -242,7 +242,7 @@ VAL idris_concat(VM* vm, VAL l, VAL r) {
242 // dumpVal(l);
242 // dumpVal(l);
243 // printf("\n");
243 // printf("\n");
244 Closure* cl = allocate(vm, sizeof(Closure) + strlen(ls) + strlen(rs) + 1);
244 Closure* cl = allocate(vm, sizeof(Closure) + strlen(ls) + strlen(rs) + 1);
245− cl -> ty = STRING;
245+ SETTY(cl, STRING);
246 cl -> info.str = (char*)cl + sizeof(Closure);
246 cl -> info.str = (char*)cl + sizeof(Closure);
247 strcpy(cl -> info.str, ls);
247 strcpy(cl -> info.str, ls);
248 strcat(cl -> info.str, rs);
248 strcat(cl -> info.str, rs);
@@ -317,7 +317,7 @@ VAL idris_strCons(VM* vm, VAL x, VAL xs) {
317 char *xstr = GETSTR(xs);
317 char *xstr = GETSTR(xs);
318 Closure* cl = allocate(vm, sizeof(Closure) +
318 Closure* cl = allocate(vm, sizeof(Closure) +
319 strlen(xstr) + 2);
319 strlen(xstr) + 2);
320− cl -> ty = STRING;
320+ SETTY(cl, STRING);
321 cl -> info.str = (char*)cl + sizeof(Closure);
321 cl -> info.str = (char*)cl + sizeof(Closure);
322 cl -> info.str[0] = (char)(GETINT(x));
322 cl -> info.str[0] = (char)(GETINT(x));
323 strcpy(cl -> info.str+1, xstr);
323 strcpy(cl -> info.str+1, xstr);
@@ -332,7 +332,7 @@ VAL idris_strRev(VM* vm, VAL str) {
332 char *xstr = GETSTR(str);
332 char *xstr = GETSTR(str);
333 Closure* cl = allocate(vm, sizeof(Closure) +
333 Closure* cl = allocate(vm, sizeof(Closure) +
334 strlen(xstr) + 1);
334 strlen(xstr) + 1);
335− cl -> ty = STRING;
335+ SETTY(cl, STRING);
336 cl -> info.str = (char*)cl + sizeof(Closure);
336 cl -> info.str = (char*)cl + sizeof(Closure);
337 int y = 0;
337 int y = 0;
338 int x = strlen(xstr);
338 int x = strlen(xstr);
@@ -379,7 +379,7 @@ void* vmThread(VM* callvm, func f, VAL arg) {
379 td->arg = copyTo(vm, arg);
379 td->arg = copyTo(vm, arg);
380
380
381 pthread_create(&t, &attr, runThread, td);
381 pthread_create(&t, &attr, runThread, td);
382− usleep(100);
382+// usleep(100);
383 return vm;
383 return vm;
384}
384}
385
385
@@ -393,7 +393,7 @@ VAL copyTo(VM* vm, VAL x) {
393 if (x==NULL || ISINT(x)) {
393 if (x==NULL || ISINT(x)) {
394 return x;
394 return x;
395 }
395 }
396− switch(x->ty) {
396+ switch(GETTY(x)) {
397 case CON:
397 case CON:
398 cl = allocCon(vm, x->info.c.arity);
398 cl = allocCon(vm, x->info.c.arity);
399 cl->info.c.tag = x->info.c.tag;
399 cl->info.c.tag = x->info.c.tag;
@@ -430,6 +430,8 @@ void sendMessage(VM* sender, VM* dest, VAL msg) {
430
430
431 VAL dmsg = copyTo(dest, msg);
431 VAL dmsg = copyTo(dest, msg);
432
432
433+
434+// printf("Sending [lock]...\n");
433 pthread_mutex_lock(&(dest->inbox_lock));
435 pthread_mutex_lock(&(dest->inbox_lock));
434
436
435 *(dest->inbox_write) = dmsg;
437 *(dest->inbox_write) = dmsg;
@@ -445,21 +447,36 @@ void sendMessage(VM* sender, VM* dest, VAL msg) {
445 }
447 }
446
448
447 // Wake up the other thread
449 // Wake up the other thread
450+ pthread_mutex_lock(&dest->inbox_block);
448− pthread_cond_signal(&(dest->inbox_waiting));
451+ pthread_cond_signal(&dest->inbox_waiting);
452+ pthread_mutex_unlock(&dest->inbox_block);
453+
454+// printf("Sending [signalled]...\n");
449
455
450 pthread_mutex_unlock(&(dest->inbox_lock));
456 pthread_mutex_unlock(&(dest->inbox_lock));
457+// printf("Sending [unlock]...\n");
451}
458}
452
459
453// block until there is a message in the queue
460// block until there is a message in the queue
454VAL recvMessage(VM* vm) {
461VAL recvMessage(VM* vm) {
455 VAL msg = NULL;
462 VAL msg = NULL;
463+ struct timespec timeout;
464+ int status;
456
465
466+ pthread_mutex_lock(&vm->inbox_block);
467+ msg = *(vm->inbox_ptr);
457 while (msg == NULL) {
468 while (msg == NULL) {
458− pthread_mutex_lock(&vm->inbox_block);
469+// printf("No message yet\n");
470+// printf("Waiting [lock]...\n");
471+ timeout.tv_sec = time (NULL) + 3;
472+ timeout.tv_nsec = 0;
459− pthread_cond_wait(&vm->inbox_waiting, &vm->inbox_block);
473+ status = pthread_cond_timedwait(&vm->inbox_waiting, &vm->inbox_block,
460− pthread_mutex_unlock(&vm->inbox_block);
474+ &timeout);
475+// printf("Waiting [unlock]... %d\n", status);
461 msg = *(vm->inbox_ptr);
476 msg = *(vm->inbox_ptr);
462 }
477 }
478+ pthread_mutex_unlock(&vm->inbox_block);
479+
463 if (msg != NULL) {
480 if (msg != NULL) {
464 pthread_mutex_lock(&(vm->inbox_lock));
481 pthread_mutex_lock(&(vm->inbox_lock));
465 *(vm->inbox_ptr) = NULL;
482 *(vm->inbox_ptr) = NULL;
rts/idris_rts.h+11
@@ -21,6 +21,8 @@ typedef struct {
21} con;
21} con;
22
22
23typedef struct {
23typedef struct {
24+// Use top 16 bits of ty for saying which heap value is in
25+// Bottom 16 bits for closure type
24 ClosureType ty;
26 ClosureType ty;
25 union {
27 union {
26 con c;
28 con c;
@@ -92,6 +94,15 @@ typedef void(*func)(VM*, VAL*);
92
94
93#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( (x)->ty == CON ? (x)->info.c.tag : (-1)) )
95#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( (x)->ty == CON ? (x)->info.c.tag : (-1)) )
94
96
97+// Use top 16 bits for saying which heap value is in
98+// Bottom 16 bits for closure type
99+
100+#define GETTY(x) ((x)->ty & 0x0000ffff)
101+#define SETTY(x,t) (x)->ty = (((x)->ty & 0xffff0000) | (t))
102+
103+#define GETHEAP(x) ((x)->ty >> 16)
104+#define SETHEAP(x,y) (x)->ty = (((x)->ty & 0x0000ffff) | ((t) << 16))
105+
95// Integers, floats and operators
106// Integers, floats and operators
96
107
97typedef intptr_t i_int;
108typedef intptr_t i_int;
src/IRTS/Compiler.hs+2−1
@@ -224,7 +224,8 @@ instance ToIR (TT Name) where
224 do args' <- mapM (ir' env) args
224 do args' <- mapM (ir' env) args
225 -- wrap it in a prim__IO
225 -- wrap it in a prim__IO
226 -- return $ con_ 0 @@ impossible @@
226 -- return $ con_ 0 @@ impossible @@
227+ return $ LLazyExp $
227− return $ LLazyExp $ LForeign LANG_C rty fgnName (zip tys args')
228+ LForeign LANG_C rty fgnName (zip tys args')
228 | otherwise = fail "Badly formed foreign function call"
229 | otherwise = fail "Badly formed foreign function call"
229
230
230getFTypes :: TT Name -> [FType]
231getFTypes :: TT Name -> [FType]