@@ -37,15 +37,18 @@ VM* init_vm(int stack_size, size_t heap_size,
3737 vm->reg1 = NULL;
3838
3939 vm->inbox = malloc(1024*sizeof(VAL));
40+ memset(vm->inbox, 0, 1024*sizeof(VAL));
4041 vm->inbox_end = vm->inbox + 1024;
4142 vm->inbox_ptr = vm->inbox;
4243 vm->inbox_write = vm->inbox;
4344
4445 pthread_mutex_init(&(vm->inbox_lock), NULL);
4546 pthread_mutex_init(&(vm->inbox_block), NULL);
47+ pthread_mutex_init(&(vm->alloc_lock), NULL);
4648 pthread_cond_init(&(vm->inbox_waiting), NULL);
4749
4850 vm->max_threads = max_threads;
51+ vm->processes = 0;
4952
5053 int i;
5154 // Assumption: there's enough space for this in the initial heap.
@@ -73,8 +76,14 @@ void terminate(VM* vm) {
7376 free(vm);
7477}
7578
76−void* allocate(VM* vm, size_t size) {
79+void* allocate(VM* vm, size_t size, int outerlock) {
7780// return malloc(size);
81+ int lock = vm->processes > 0 && !outerlock;
82+
83+ if (lock) { // not message passing
84+ pthread_mutex_lock(&vm->alloc_lock);
85+ }
86+
7887 if ((size & 7)!=0) {
7988 size = 8 + ((size >> 3) << 3);
8089 }
@@ -84,15 +93,23 @@ void* allocate(VM* vm, size_t size) {
8493 *((size_t*)(vm->heap_next)) = size + sizeof(size_t);
8594 vm -> heap_next += size + sizeof(size_t);
8695 memset(ptr, 0, size);
96+ if (lock) { // not message passing
97+ pthread_mutex_unlock(&vm->alloc_lock);
98+ }
8799 return ptr;
88100 } else {
89− gc(vm);
90− return allocate(vm, size);
101+ idris_gc(vm);
102+ if (lock) { // not message passing
103+ pthread_mutex_unlock(&vm->alloc_lock);
104+ }
105+ return allocate(vm, size, 0);
91106 }
107+
92108}
93109
94−void* allocCon(VM* vm, int arity) {
95− Closure* cl = allocate(vm, sizeof(Closure) + sizeof(VAL)*arity);
110+void* allocCon(VM* vm, int arity, int outer) {
111+ Closure* cl = allocate(vm, sizeof(Closure) + sizeof(VAL)*arity,
112+ outer);
96113 SETTY(cl, CON);
97114 if (arity == 0) {
98115 cl -> info.c.args = NULL;
@@ -106,7 +123,7 @@ void* allocCon(VM* vm, int arity) {
106123}
107124
108125VAL MKFLOAT(VM* vm, double val) {
109− Closure* cl = allocate(vm, sizeof(Closure));
126+ Closure* cl = allocate(vm, sizeof(Closure), 0);
110127 SETTY(cl, FLOAT);
111128 cl -> info.f = val;
112129 return cl;
@@ -114,7 +131,7 @@ VAL MKFLOAT(VM* vm, double val) {
114131
115132VAL MKSTR(VM* vm, char* str) {
116133 Closure* cl = allocate(vm, sizeof(Closure) + // Type) + sizeof(char*) +
117− sizeof(char)*strlen(str)+1);
134+ sizeof(char)*strlen(str)+1, 0);
118135 SETTY(cl, STRING);
119136 cl -> info.str = (char*)cl + sizeof(Closure);
120137
@@ -123,7 +140,31 @@ VAL MKSTR(VM* vm, char* str) {
123140}
124141
125142VAL MKPTR(VM* vm, void* ptr) {
126− Closure* cl = allocate(vm, sizeof(Closure));
143+ Closure* cl = allocate(vm, sizeof(Closure), 0);
144+ SETTY(cl, PTR);
145+ cl -> info.ptr = ptr;
146+ return cl;
147+}
148+
149+VAL MKFLOATc(VM* vm, double val) {
150+ Closure* cl = allocate(vm, sizeof(Closure), 1);
151+ SETTY(cl, FLOAT);
152+ cl -> info.f = val;
153+ return cl;
154+}
155+
156+VAL MKSTRc(VM* vm, char* str) {
157+ Closure* cl = allocate(vm, sizeof(Closure) + // Type) + sizeof(char*) +
158+ sizeof(char)*strlen(str)+1, 1);
159+ SETTY(cl, STRING);
160+ cl -> info.str = (char*)cl + sizeof(Closure);
161+
162+ strcpy(cl -> info.str, str);
163+ return cl;
164+}
165+
166+VAL MKPTRc(VM* vm, void* ptr) {
167+ Closure* cl = allocate(vm, sizeof(Closure), 1);
127168 SETTY(cl, PTR);
128169 cl -> info.ptr = ptr;
129170 return cl;
@@ -211,7 +252,7 @@ void dumpVal(VAL v) {
211252}
212253
213254VAL idris_castIntStr(VM* vm, VAL i) {
214− Closure* cl = allocate(vm, sizeof(Closure) + sizeof(char)*16);
255+ Closure* cl = allocate(vm, sizeof(Closure) + sizeof(char)*16, 0);
215256 SETTY(cl, STRING);
216257 cl -> info.str = (char*)cl + sizeof(Closure);
217258 sprintf(cl -> info.str, "%d", (int)(GETINT(i)));
@@ -228,7 +269,7 @@ VAL idris_castStrInt(VM* vm, VAL i) {
228269}
229270
230271VAL idris_castFloatStr(VM* vm, VAL i) {
231− Closure* cl = allocate(vm, sizeof(Closure) + sizeof(char)*32);
272+ Closure* cl = allocate(vm, sizeof(Closure) + sizeof(char)*32, 0);
232273 SETTY(cl, STRING);
233274 cl -> info.str = (char*)cl + sizeof(Closure);
234275 sprintf(cl -> info.str, "%g", GETFLOAT(i));
@@ -244,7 +285,8 @@ VAL idris_concat(VM* vm, VAL l, VAL r) {
244285 char *ls = GETSTR(l);
245286 // dumpVal(l);
246287 // printf("\n");
247− Closure* cl = allocate(vm, sizeof(Closure) + strlen(ls) + strlen(rs) + 1);
288+ Closure* cl = allocate(vm, sizeof(Closure) + strlen(ls) + strlen(rs) + 1,
289+ 0);
248290 SETTY(cl, STRING);
249291 cl -> info.str = (char*)cl + sizeof(Closure);
250292 strcpy(cl -> info.str, ls);
@@ -319,7 +361,7 @@ VAL idris_strTail(VM* vm, VAL str) {
319361VAL idris_strCons(VM* vm, VAL x, VAL xs) {
320362 char *xstr = GETSTR(xs);
321363 Closure* cl = allocate(vm, sizeof(Closure) +
322− strlen(xstr) + 2);
364+ strlen(xstr) + 2, 0);
323365 SETTY(cl, STRING);
324366 cl -> info.str = (char*)cl + sizeof(Closure);
325367 cl -> info.str[0] = (char)(GETINT(x));
@@ -334,7 +376,7 @@ VAL idris_strIndex(VM* vm, VAL str, VAL i) {
334376VAL idris_strRev(VM* vm, VAL str) {
335377 char *xstr = GETSTR(str);
336378 Closure* cl = allocate(vm, sizeof(Closure) +
337− strlen(xstr) + 1);
379+ strlen(xstr) + 1, 0);
338380 SETTY(cl, STRING);
339381 cl -> info.str = (char*)cl + sizeof(Closure);
340382 int y = 0;
@@ -348,7 +390,8 @@ VAL idris_strRev(VM* vm, VAL str) {
348390}
349391
350392typedef struct {
351− VM* vm;
393+ VM* vm; // thread's VM
394+ VM* callvm; // calling thread's VM
352395 func fn;
353396 VAL arg;
354397} ThreadData;
@@ -356,13 +399,16 @@ typedef struct {
356399void* runThread(void* arg) {
357400 ThreadData* td = (ThreadData*)arg;
358401 VM* vm = td->vm;
402+ VM* callvm = td->callvm;
359403
360404 TOP(0) = td->arg;
361405 BASETOP(0);
362406 ADDTOP(1);
363407 td->fn(vm, NULL);
408+ callvm->processes--;
364409
365410 free(td);
411+ terminate(vm);
366412 return NULL;
367413}
368414
@@ -370,6 +416,7 @@ void* vmThread(VM* callvm, func f, VAL arg) {
370416 VM* vm = init_vm(callvm->stack_max - callvm->valstack, callvm->heap_size,
371417 callvm->max_threads,
372418 0, NULL);
419+ vm->processes=1; // since it can send and receive messages
373420 pthread_t t;
374421 pthread_attr_t attr;
375422// size_t stacksize;
@@ -380,16 +427,18 @@ void* vmThread(VM* callvm, func f, VAL arg) {
380427
381428 ThreadData *td = malloc(sizeof(ThreadData));
382429 td->vm = vm;
430+ td->callvm = callvm;
383431 td->fn = f;
384432 td->arg = copyTo(vm, arg);
433+
434+ callvm->processes++;
385435
386436 pthread_create(&t, &attr, runThread, td);
387437// usleep(100);
388438 return vm;
389439}
390440
391−// VM is assumed to be a different vm from the one x lives on (so we don't need
392−// to worry about gc moving things, as the VM x is on will not be allocating)
441+// VM is assumed to be a different vm from the one x lives on
393442
394443VAL copyTo(VM* vm, VAL x) {
395444 int i;
@@ -400,7 +449,7 @@ VAL copyTo(VM* vm, VAL x) {
400449 }
401450 switch(GETTY(x)) {
402451 case CON:
403− cl = allocCon(vm, x->info.c.arity);
452+ cl = allocCon(vm, x->info.c.arity, 1);
404453 cl->info.c.tag = x->info.c.tag;
405454 cl->info.c.arity = x->info.c.arity;
406455
@@ -411,16 +460,16 @@ VAL copyTo(VM* vm, VAL x) {
411460 }
412461 break;
413462 case FLOAT:
414− cl = MKFLOAT(vm, x->info.f);
463+ cl = MKFLOATc(vm, x->info.f);
415464 break;
416465 case STRING:
417− cl = MKSTR(vm, x->info.str);
466+ cl = MKSTRc(vm, x->info.str);
418467 break;
419468 case BIGINT:
420− cl = MKBIGM(vm, x->info.ptr);
469+ cl = MKBIGMc(vm, x->info.ptr);
421470 break;
422471 case PTR:
423− cl = MKPTR(vm, x->info.ptr);
472+ cl = MKPTRc(vm, x->info.ptr);
424473 break;
425474 default:
426475 assert(0); // We're in trouble if this happens...
@@ -433,12 +482,26 @@ void idris_sendMessage(VM* sender, VM* dest, VAL msg) {
433482 // FIXME: If GC kicks in in the middle of the copy, we're in trouble.
434483 // Probably best check there is enough room in advance. (How?)
435484
485+ // Also a problem if we're allocating at the same time as the
486+ // destination thread (which is very likely)
487+ // Should the inbox be a different memory space?
488+
489+ // So: we try to copy, if a collection happens, we do the copy again
490+ // under the assumption there's enough space this time.
491+
492+ int gcs = dest->collections;
493+ pthread_mutex_lock(&dest->alloc_lock);
436494 VAL dmsg = copyTo(dest, msg);
495+ pthread_mutex_unlock(&dest->alloc_lock);
437496
497+ if (dest->collections>gcs) {
498+ // a collection will have invalidated the copy
499+ pthread_mutex_lock(&dest->alloc_lock);
500+ dmsg = copyTo(dest, msg); // try again now there's room...
501+ pthread_mutex_unlock(&dest->alloc_lock);
502+ }
438503
439−// printf("Sending [lock]...\n");
440504 pthread_mutex_lock(&(dest->inbox_lock));
441−
442505 *(dest->inbox_write) = dmsg;
443506
444507 dest->inbox_write++;