Skip to content

Commit

Permalink
Use a common header instead of a union
Browse files Browse the repository at this point in the history
  • Loading branch information
@jacereda
jacereda committed Mar 19, 2018
1 parent 807f009 commit 4698b9a
Show file tree
Hide file tree
Showing 9 changed files with 579 additions and 736 deletions.
518 changes: 145 additions & 373 deletions rts/idris_bitstring.c
View file

Large diffs are not rendered by default.

3 changes: 1 addition & 2 deletions rts/idris_buffer.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,10 +110,9 @@ double idris_getBufferDouble(void* buffer, int loc) {

VAL idris_getBufferString(void* buffer, int loc, int len) {
Buffer* b = buffer;

char * s = (char*)(b->data + loc);
size_t sz = loc >= 0 && loc+len <= b->size? len : 0;
return MKSTRlen(NULL, s, sz);
return MKSTRlen(get_vm(), s, sz);
}

int idris_readBuffer(FILE* h, void* buffer, int loc, int max) {
Expand Down
56 changes: 28 additions & 28 deletions rts/idris_gc.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,8 +5,8 @@
#include <assert.h>

VAL copy(VM* vm, VAL x) {
int ar, len;
Closure* cl = NULL;
int ar;
VAL cl;
if (x==NULL || ISINT(x)) {
return x;
}
Expand All @@ -18,7 +18,7 @@ VAL copy(VM* vm, VAL x) {
c_heap_mark_item(GETCDATA(x));
break;
case CT_BIGINT:
cl = MKBIGMc(vm, GETPTR(x));
cl = MKBIGMc(vm, GETMPZ(x));
break;
case CT_CON:
ar = CARITY(x);
Expand All @@ -39,47 +39,47 @@ VAL copy(VM* vm, VAL x) {
case CT_BITS64:
case CT_RAWDATA:
{
size_t size = sizeof(Closure) + x->extrasz;
cl = allocate(size, 1);
memcpy(cl, x, size);
Hdr * s = (Hdr*)x;
cl = iallocate(vm, s->sz, 1);
memcpy(cl, x, s->sz);
}
break;
default:
cl = NULL;
break;
}
SETTY(x, CT_FWD);
x->info.ptr = cl;
((Fwd*)x)->fwd = cl;
return cl;
}

void cheney(VM *vm) {
size_t i, len;
char* scan = aligned_heap_pointer(vm->heap.heap);

while(scan < vm->heap.next) {
VAL heap_item = (VAL)scan;
// If it's a CT_CON, CT_REF or CT_STROFFSET, copy its arguments
switch(GETTY(heap_item)) {
case CT_CON:
len = CARITY(heap_item);
for(i = 0; i < len; ++i) {
VAL newptr = copy(vm, heap_item->extra.cargs[i]);
heap_item->extra.cargs[i] = newptr;
}
break;
case CT_ARRAY:
len = CELEM(heap_item);
for(i = 0; i < len; ++i) {
VAL newptr = copy(vm, heap_item->extra.array[i]);
heap_item->extra.array[i] = newptr;
}
break;
case CT_REF:
heap_item->info.ptr = copy(vm, (VAL)(GETPTR(heap_item)));
break;
case CT_STROFFSET:
heap_item->extra.basestr[0] = copy(vm, heap_item->extra.basestr[0]);
break;
case CT_CON: {
Con * c = (Con*)heap_item;
size_t len = CARITY(c);
for(size_t i = 0; i < len; ++i)
c->args[i] = copy(vm, c->args[i]);
} break;
case CT_ARRAY: {
Array * a = (Array*)heap_item;
size_t len = CELEM(a);
for(size_t i = 0; i < len; ++i)
a->array[i] = copy(vm, a->array[i]);
} break;
case CT_REF: {
Ref * r = (Ref*)heap_item;
r->ref = copy(vm, r->ref);
} break;
case CT_STROFFSET: {
StrOffset * s = (StrOffset*)heap_item;
s->base = (String*)copy(vm, (VAL)s->base);
} break;
default: // Nothing to copy
break;
}
Expand Down
136 changes: 69 additions & 67 deletions rts/idris_gmp.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,17 +22,17 @@ VAL MKBIGI(int val) {
return MKINT((i_int)val);
}

static mpz_t * big(VAL v) {
return (mpz_t*)(v->info.ptr);
static mpz_t * big(BigInt * v) {
return (mpz_t*)(v->big);
}

static VAL allocBig() {
idris_requireAlloc(IDRIS_MAXGMP);
VAL cl = allocate(sizeof(Closure) + sizeof(mpz_t), 0);
idris_doneAlloc();
#define BIG(x) big((BigInt*)(x))

static BigInt * allocBig(VM * vm) {
idris_requireAlloc(vm, IDRIS_MAXGMP);
BigInt * cl = iallocate(vm, sizeof(*cl) + sizeof(mpz_t), 0);
idris_doneAlloc(vm);
SETTY(cl, CT_BIGINT);
cl->info.ptr = (void*)(cl+1);
cl->extrasz = sizeof(mpz_t);
mpz_init(*big(cl));
return cl;
}
Expand All @@ -42,125 +42,127 @@ VAL MKBIGC(VM* vm, char* val) {
return MKBIGI(0);
}
else {
VAL cl = allocBig();
BigInt * cl = allocBig(vm);
mpz_set_str(*big(cl), val, 10);
return cl;
return (VAL)cl;
}
}

VAL MKBIGM(VM* vm, void* ibig) {
VAL cl = allocBig();
BigInt * cl = allocBig(vm);
mpz_set(*big(cl), *((mpz_t*)ibig));
return cl;
return (VAL)cl;
}

VAL MKBIGMc(VM* vm, void* ibig) {
VAL cl = allocBig();
BigInt * cl = allocBig(vm);
mpz_init_set(*big(cl), *((mpz_t*)ibig));
return cl;
return (VAL)cl;
}

VAL MKBIGUI(VM* vm, unsigned long val) {
VAL cl = allocBig();
BigInt * cl = allocBig(vm);
mpz_init_set_ui(*big(cl), val);
return cl;
return (VAL)cl;
}

VAL MKBIGSI(VM* vm, signed long val) {
VAL cl = allocBig();
BigInt * cl = allocBig(vm);
mpz_init_set_si(*big(cl), val);
return cl;
return (VAL)cl;
}

VAL GETBIG(VM * vm, VAL x) {
static BigInt * getbig(VM * vm, VAL x) {
if (ISINT(x)) {
VAL cl = allocBig();
BigInt * cl = allocBig(vm);
mpz_set_si(*big(cl), GETINT(x));
return cl;
} else {
switch(GETTY(x)) {
case CT_FWD:
return GETBIG(vm, x->info.ptr);
return getbig(vm, ((Fwd*)x)->fwd);
default:
return x;
return (BigInt*)x;
}
}
}

#define GETBIG (VAL)getbig

VAL bigAdd(VM* vm, VAL x, VAL y) {
VAL cl = allocBig();
mpz_add(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
return cl;
BigInt * cl = allocBig(vm);
mpz_add(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
return (VAL)cl;
}

VAL bigSub(VM* vm, VAL x, VAL y) {
VAL cl = allocBig();
mpz_sub(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
return cl;
BigInt * cl = allocBig(vm);
mpz_sub(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
return (VAL)cl;
}

VAL bigMul(VM* vm, VAL x, VAL y) {
VAL cl = allocBig();
mpz_mul(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
return cl;
BigInt * cl = allocBig(vm);
mpz_mul(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
return (VAL)cl;
}

VAL bigDiv(VM* vm, VAL x, VAL y) {
VAL cl = allocBig();
mpz_tdiv_q(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
return cl;
BigInt * cl = allocBig(vm);
mpz_tdiv_q(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
return (VAL)cl;
}

VAL bigMod(VM* vm, VAL x, VAL y) {
VAL cl = allocBig();
mpz_tdiv_r(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
return cl;
BigInt * cl = allocBig(vm);
mpz_tdiv_r(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
return (VAL)cl;
}

VAL bigAnd(VM* vm, VAL x, VAL y) {
VAL cl = allocBig();
mpz_and(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
return cl;
BigInt * cl = allocBig(vm);
mpz_and(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
return (VAL)cl;
}

VAL bigOr(VM* vm, VAL x, VAL y) {
VAL cl = allocBig();
mpz_ior(*big(cl), GETMPZ(GETBIG(vm,x)), GETMPZ(GETBIG(vm,y)));
return cl;
BigInt * cl = allocBig(vm);
mpz_ior(*big(cl), *big(getbig(vm,x)), *big(getbig(vm,y)));
return (VAL)cl;
}

VAL bigShiftLeft(VM* vm, VAL x, VAL y) {
VAL cl = allocBig();
mpz_mul_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
return cl;
BigInt * cl = allocBig(vm);
mpz_mul_2exp(*big(cl), *big(getbig(vm,x)), GETINT(y));
return (VAL)cl;
}


VAL bigLShiftRight(VM* vm, VAL x, VAL y) {
VAL cl = allocBig();
mpz_fdiv_q_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
return cl;
BigInt * cl = allocBig(vm);
mpz_fdiv_q_2exp(*big(cl), *big(getbig(vm,x)), GETINT(y));
return (VAL)cl;
}

VAL bigAShiftRight(VM* vm, VAL x, VAL y) {
VAL cl = allocBig();
mpz_fdiv_q_2exp(*big(cl), GETMPZ(GETBIG(vm,x)), GETINT(y));
return cl;
BigInt * cl = allocBig(vm);
mpz_fdiv_q_2exp(*big(cl), *big(getbig(vm,x)), GETINT(y));
return (VAL)cl;
}

VAL idris_bigAnd(VM* vm, VAL x, VAL y) {
if (ISINT(x) && ISINT(y)) {
return INTOP(&, x, y);
} else {
return bigAnd(vm, GETBIG(vm, x), GETBIG(vm, y));
return bigAnd(vm, (VAL)GETBIG(vm, x), (VAL)GETBIG(vm, y));
}
}

VAL idris_bigOr(VM* vm, VAL x, VAL y) {
if (ISINT(x) && ISINT(y)) {
return INTOP(|, x, y);
} else {
return bigOr(vm, GETBIG(vm, x), GETBIG(vm, y));
return bigOr(vm, (VAL)GETBIG(vm, x), (VAL)GETBIG(vm, y));
}
}

Expand All @@ -173,12 +175,12 @@ VAL idris_bigPlus(VM* vm, VAL x, VAL y) {
}
i_int res = vx + vy;
if (res >= 1<<30 || res <= -(1 << 30)) {
return bigAdd(vm, GETBIG(vm, x), GETBIG(vm, y));
return bigAdd(vm, (VAL)GETBIG(vm, x), (VAL)GETBIG(vm, y));
} else {
return MKINT(res);
}
} else {
return bigAdd(vm, GETBIG(vm, x), GETBIG(vm, y));
return bigAdd(vm, (VAL)GETBIG(vm, x), (VAL)GETBIG(vm, y));
}
}

Expand Down Expand Up @@ -264,29 +266,29 @@ VAL idris_bigMod(VM* vm, VAL x, VAL y) {
int bigEqConst(VAL x, int c) {
if (ISINT(x)) { return (GETINT(x) == c); }
else {
int rv = mpz_cmp_si(GETMPZ(x), c);
int rv = mpz_cmp_si(*BIG(x), c);
return (rv == 0);
}
}

VAL bigEq(VM* vm, VAL x, VAL y) {
return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) == 0));
return MKINT((i_int)(mpz_cmp(*BIG(x), *BIG(y)) == 0));
}

VAL bigLt(VM* vm, VAL x, VAL y) {
return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) < 0));
return MKINT((i_int)(mpz_cmp(*BIG(x), *BIG(y)) < 0));
}

VAL bigGt(VM* vm, VAL x, VAL y) {
return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) > 0));
return MKINT((i_int)(mpz_cmp(*BIG(x), *BIG(y)) > 0));
}

VAL bigLe(VM* vm, VAL x, VAL y) {
return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) <= 0));
return MKINT((i_int)(mpz_cmp(*BIG(x), *BIG(y)) <= 0));
}

VAL bigGe(VM* vm, VAL x, VAL y) {
return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) >= 0));
return MKINT((i_int)(mpz_cmp(*BIG(x), *BIG(y)) >= 0));
}

VAL idris_bigEq(VM* vm, VAL x, VAL y) {
Expand Down Expand Up @@ -338,31 +340,31 @@ VAL idris_castBigInt(VM* vm, VAL i) {
if (ISINT(i)) {
return i;
} else {
return MKINT((i_int)(mpz_get_ui(GETMPZ(i))));
return MKINT((i_int)(mpz_get_ui(*BIG(i))));
}
}

VAL idris_castBigFloat(VM* vm, VAL i) {
if (ISINT(i)) {
return MKFLOAT(vm, GETINT(i));
} else {
return MKFLOAT(vm, mpz_get_d(GETMPZ(i)));
return MKFLOAT(vm, mpz_get_d(*BIG(i)));
}
}

VAL idris_castFloatBig(VM* vm, VAL f) {
double val = GETFLOAT(f);
VAL cl = allocBig();
BigInt * cl = allocBig(vm);
mpz_init_set_d(*big(cl), val);
return cl;
return (VAL)cl;
}

VAL idris_castStrBig(VM* vm, VAL i) {
return MKBIGC(vm, GETSTR(i));
}

VAL idris_castBigStr(VM* vm, VAL i) {
char* str = mpz_get_str(NULL, 10, GETMPZ(GETBIG(vm, i)));
char* str = mpz_get_str(NULL, 10, *big(getbig(vm, i)));
return MKSTR(vm, str);
}

Expand Down
Loading

0 comments on commit 4698b9a

Please sign in to comment.