ba6042f · Idris-dev · git.iko.soy

git.iko.soy/Idris-dev

Message passing fixes; also abstract SETTY/GETTY in rts

commitba6042f1acfead1520166d733fb99a016a4d044d authorEdwin Brady <ecb10@st-andrews.ac.uk> dateTue 30 Oct 2012, 13:15 (14 years ago) parent5d2ff60

5 files changed+56−27

compare with master

unifiedsplit

rts/idris_gc.c+3−3 rts/idris_gmp.c+7−7 rts/idris_rts.c+33−16 rts/idris_rts.h+11 src/IRTS/Compiler.hs+2−1

rts/idris_gc.c+3−3

@@ -9,7 +9,7 @@ VAL copy(VM* vm, VAL x) {

99 if (x==NULL || ISINT(x)) {

1010 return x;

1111 }

12− switch(x->ty) {

12+ switch(GETTY(x)) {

1313 case CON:

1414 cl = allocCon(vm, x->info.c.arity);

1515 cl->info.c.tag = x->info.c.tag;

@@ -39,7 +39,7 @@ VAL copy(VM* vm, VAL x) {

3939 default:

4040 break;

4141 }

42− x->ty = FWD;

42+ SETTY(x, FWD);

4343 x->info.ptr = cl;

4444 return cl;

4545}

@@ -53,7 +53,7 @@ void cheney(VM *vm) {

5353 size_t inc = *((size_t*)scan);

5454 VAL heap_item = (VAL)(scan+sizeof(size_t));

5555 // If it's a CON, copy its arguments

56− switch(heap_item->ty) {

56+ switch(GETTY(heap_item)) {

5757 case CON:

5858 argptr = (VAL*)(heap_item->info.c.args);

5959 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) {

1515 mpz_init(*bigint);

1616 mpz_set_str(*bigint, val, 10);

1717

18− cl -> ty = BIGINT;

18+ SETTY(cl, BIGINT);

1919 cl -> info.ptr = (void*)bigint;

2020

2121 return cl;

@@ -29,7 +29,7 @@ VAL MKBIGM(VM* vm, void* big) {

2929 mpz_init(*bigint);

3030 mpz_set(*bigint, *((mpz_t*)big));

3131

32− cl -> ty = BIGINT;

32+ SETTY(cl, BIGINT);

3333 cl -> info.ptr = (void*)bigint;

3434

3535 return cl;

@@ -44,7 +44,7 @@ VAL GETBIG(VM * vm, VAL x) {

4444 mpz_init(*bigint);

4545 mpz_set_si(*bigint, GETINT(x));

4646

47− cl -> ty = BIGINT;

47+ SETTY(cl, BIGINT);

4848 cl -> info.ptr = (void*)bigint;

4949

5050 return cl;

@@ -58,7 +58,7 @@ VAL bigAdd(VM* vm, VAL x, VAL y) {

5858 VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));

5959 bigint = allocate(vm, sizeof(mpz_t));

6060 mpz_add(*bigint, GETMPZ(x), GETMPZ(y));

61− cl -> ty = BIGINT;

61+ SETTY(cl, BIGINT);

6262 cl -> info.ptr = (void*)bigint;

6363 return cl;

6464}

@@ -68,7 +68,7 @@ VAL bigSub(VM* vm, VAL x, VAL y) {

6868 VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));

6969 bigint = allocate(vm, sizeof(mpz_t));

7070 mpz_sub(*bigint, GETMPZ(x), GETMPZ(y));

71− cl -> ty = BIGINT;

71+ SETTY(cl, BIGINT);

7272 cl -> info.ptr = (void*)bigint;

7373 return cl;

7474}

@@ -78,7 +78,7 @@ VAL bigMul(VM* vm, VAL x, VAL y) {

7878 VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));

7979 bigint = allocate(vm, sizeof(mpz_t));

8080 mpz_mul(*bigint, GETMPZ(x), GETMPZ(y));

81− cl -> ty = BIGINT;

81+ SETTY(cl, BIGINT);

8282 cl -> info.ptr = (void*)bigint;

8383 return cl;

8484}

@@ -88,7 +88,7 @@ VAL bigDiv(VM* vm, VAL x, VAL y) {

8888 VAL cl = allocate(vm, sizeof(ClosureType) + sizeof(void*));

8989 bigint = allocate(vm, sizeof(mpz_t));

9090 mpz_div(*bigint, GETMPZ(x), GETMPZ(y));

91− cl -> ty = BIGINT;

91+ SETTY(cl, BIGINT);

9292 cl -> info.ptr = (void*)bigint;

9393 return cl;

9494}

rts/idris_rts.c+33−16

@@ -90,7 +90,7 @@ void* allocate(VM* vm, size_t size) {

9090

9191void* allocCon(VM* vm, int arity) {

9292 Closure* cl = allocate(vm, sizeof(Closure) + sizeof(VAL)*arity);

93− cl -> ty = CON;

93+ SETTY(cl, CON);

9494 if (arity == 0) {

9595 cl -> info.c.args = NULL;

9696 } else {

@@ -104,7 +104,7 @@ void* allocCon(VM* vm, int arity) {

104104

105105VAL MKFLOAT(VM* vm, double val) {

106106 Closure* cl = allocate(vm, sizeof(Closure));

107− cl -> ty = FLOAT;

107+ SETTY(cl, FLOAT);

108108 cl -> info.f = val;

109109 return cl;

110110}

@@ -112,7 +112,7 @@ VAL MKFLOAT(VM* vm, double val) {

112112VAL MKSTR(VM* vm, char* str) {

113113 Closure* cl = allocate(vm, sizeof(Closure) + // Type) + sizeof(char*) +

114114 sizeof(char)*strlen(str)+1);

115− cl -> ty = STRING;

115+ SETTY(cl, STRING);

116116 cl -> info.str = (char*)cl + sizeof(Closure);

117117

118118 strcpy(cl -> info.str, str);

@@ -121,7 +121,7 @@ VAL MKSTR(VM* vm, char* str) {

121121

122122VAL MKPTR(VM* vm, void* ptr) {

123123 Closure* cl = allocate(vm, sizeof(Closure));

124− cl -> ty = PTR;

124+ SETTY(cl, PTR);

125125 cl -> info.ptr = ptr;

126126 return cl;

127127}

@@ -185,7 +185,7 @@ void dumpVal(VAL v) {

185185 printf("%d ", (int)(GETINT(v)));

186186 return;

187187 }

188− switch(v->ty) {

188+ switch(GETTY(v)) {

189189 case CON:

190190 printf("%d[", v->info.c.tag);

191191 for(i = 0; i < v->info.c.arity; ++i) {

@@ -209,7 +209,7 @@ void dumpVal(VAL v) {

209209

210210VAL idris_castIntStr(VM* vm, VAL i) {

211211 Closure* cl = allocate(vm, sizeof(Closure) + sizeof(char)*16);

212− cl -> ty = STRING;

212+ SETTY(cl, STRING);

213213 cl -> info.str = (char*)cl + sizeof(Closure);

214214 sprintf(cl -> info.str, "%d", (int)(GETINT(i)));

215215 return cl;

@@ -226,7 +226,7 @@ VAL idris_castStrInt(VM* vm, VAL i) {

226226

227227VAL idris_castFloatStr(VM* vm, VAL i) {

228228 Closure* cl = allocate(vm, sizeof(Closure) + sizeof(char)*32);

229− cl -> ty = STRING;

229+ SETTY(cl, STRING);

230230 cl -> info.str = (char*)cl + sizeof(Closure);

231231 sprintf(cl -> info.str, "%g", GETFLOAT(i));

232232 return cl;

@@ -242,7 +242,7 @@ VAL idris_concat(VM* vm, VAL l, VAL r) {

242242 // dumpVal(l);

243243 // printf("\n");

244244 Closure* cl = allocate(vm, sizeof(Closure) + strlen(ls) + strlen(rs) + 1);

245− cl -> ty = STRING;

245+ SETTY(cl, STRING);

246246 cl -> info.str = (char*)cl + sizeof(Closure);

247247 strcpy(cl -> info.str, ls);

248248 strcat(cl -> info.str, rs);

@@ -317,7 +317,7 @@ VAL idris_strCons(VM* vm, VAL x, VAL xs) {

317317 char *xstr = GETSTR(xs);

318318 Closure* cl = allocate(vm, sizeof(Closure) +

319319 strlen(xstr) + 2);

320− cl -> ty = STRING;

320+ SETTY(cl, STRING);

321321 cl -> info.str = (char*)cl + sizeof(Closure);

322322 cl -> info.str[0] = (char)(GETINT(x));

323323 strcpy(cl -> info.str+1, xstr);

@@ -332,7 +332,7 @@ VAL idris_strRev(VM* vm, VAL str) {

332332 char *xstr = GETSTR(str);

333333 Closure* cl = allocate(vm, sizeof(Closure) +

334334 strlen(xstr) + 1);

335− cl -> ty = STRING;

335+ SETTY(cl, STRING);

336336 cl -> info.str = (char*)cl + sizeof(Closure);

337337 int y = 0;

338338 int x = strlen(xstr);

@@ -379,7 +379,7 @@ void* vmThread(VM* callvm, func f, VAL arg) {

379379 td->arg = copyTo(vm, arg);

380380

381381 pthread_create(&t, &attr, runThread, td);

382− usleep(100);

382+// usleep(100);

383383 return vm;

384384}

385385

@@ -393,7 +393,7 @@ VAL copyTo(VM* vm, VAL x) {

393393 if (x==NULL || ISINT(x)) {

394394 return x;

395395 }

396− switch(x->ty) {

396+ switch(GETTY(x)) {

397397 case CON:

398398 cl = allocCon(vm, x->info.c.arity);

399399 cl->info.c.tag = x->info.c.tag;

@@ -430,6 +430,8 @@ void sendMessage(VM* sender, VM* dest, VAL msg) {

430430

431431 VAL dmsg = copyTo(dest, msg);

432432

433+

434+// printf("Sending [lock]...\n");

433435 pthread_mutex_lock(&(dest->inbox_lock));

434436

435437 *(dest->inbox_write) = dmsg;

@@ -445,21 +447,36 @@ void sendMessage(VM* sender, VM* dest, VAL msg) {

445447 }

446448

447449 // Wake up the other thread

448− pthread_cond_signal(&(dest->inbox_waiting));

450+ pthread_mutex_lock(&dest->inbox_block);

451+ pthread_cond_signal(&dest->inbox_waiting);

452+ pthread_mutex_unlock(&dest->inbox_block);

453+

454+// printf("Sending [signalled]...\n");

449455

450456 pthread_mutex_unlock(&(dest->inbox_lock));

457+// printf("Sending [unlock]...\n");

451458}

452459

453460// block until there is a message in the queue

454461VAL recvMessage(VM* vm) {

455462 VAL msg = NULL;

463+ struct timespec timeout;

464+ int status;

456465

466+ pthread_mutex_lock(&vm->inbox_block);

467+ msg = *(vm->inbox_ptr);

457468 while (msg == NULL) {

458− pthread_mutex_lock(&vm->inbox_block);

459− pthread_cond_wait(&vm->inbox_waiting, &vm->inbox_block);

460− pthread_mutex_unlock(&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;

473+ status = pthread_cond_timedwait(&vm->inbox_waiting, &vm->inbox_block,

474+ &timeout);

475+// printf("Waiting [unlock]... %d\n", status);

461476 msg = *(vm->inbox_ptr);

462477 }

478+ pthread_mutex_unlock(&vm->inbox_block);

479+

463480 if (msg != NULL) {

464481 pthread_mutex_lock(&(vm->inbox_lock));

465482 *(vm->inbox_ptr) = NULL;

rts/idris_rts.h+11

@@ -21,6 +21,8 @@ typedef struct {

2121} con;

2222

2323typedef struct {

24+// Use top 16 bits of ty for saying which heap value is in

25+// Bottom 16 bits for closure type

2426 ClosureType ty;

2527 union {

2628 con c;

@@ -92,6 +94,15 @@ typedef void(*func)(VM*, VAL*);

9294

9395#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( (x)->ty == CON ? (x)->info.c.tag : (-1)) )

9496

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+

95106// Integers, floats and operators

96107

97108typedef intptr_t i_int;

src/IRTS/Compiler.hs+2−1

@@ -224,7 +224,8 @@ instance ToIR (TT Name) where

224224 do args' <- mapM (ir' env) args

225225 -- wrap it in a prim__IO

226226 -- return $ con_ 0 @@ impossible @@

227− return $ LLazyExp $ LForeign LANG_C rty fgnName (zip tys args')

227+ return $ LLazyExp $

228+ LForeign LANG_C rty fgnName (zip tys args')

228229 | otherwise = fail "Badly formed foreign function call"

229230

230231getFTypes :: TT Name -> [FType]