conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fixes bug 163540: allocation in bignum arithmetic does not garbage collect.

This commit is contained in:
Abdulaziz Ghuloum 2007-11-18 10:37:13 -05:00
parent 1afade6d43
commit 3b4d3097a1
4 changed files with 188 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/ikarus-collect.c
View File

@ -433,6 +433,9 @@ ik_collect(int mem_req, ikpcb* pcb){
pcb->gensym_table = add_object(&gc, pcb->gensym_table, "gensym_table"); pcb->gensym_table = add_object(&gc, pcb->gensym_table, "gensym_table");
pcb->arg_list = add_object(&gc, pcb->arg_list, "args_list_foo"); pcb->arg_list = add_object(&gc, pcb->arg_list, "args_list_foo");
pcb->base_rtd = add_object(&gc, pcb->base_rtd, "base_rtd"); pcb->base_rtd = add_object(&gc, pcb->base_rtd, "base_rtd");
if(pcb->root0) *(pcb->root0) = add_object(&gc, *(pcb->root0), "root0");
if(pcb->root1) *(pcb->root1) = add_object(&gc, *(pcb->root1), "root1");
/* now we trace all live objects */ /* now we trace all live objects */
collect_loop(&gc); collect_loop(&gc);

3
src/ikarus-data.h
View File

@ -138,6 +138,8 @@ typedef struct ikpcb{
ikp collect_key; /* offset = 48 */ ikp collect_key; /* offset = 48 */
/* the rest are not used by any scheme code */ /* the rest are not used by any scheme code */
/* they only support the runtime system (gc, etc.) */ /* they only support the runtime system (gc, etc.) */
ikp* root0;
ikp* root1;
unsigned int* segment_vector; unsigned int* segment_vector;
ikp weak_pairs_ap; ikp weak_pairs_ap;
ikp weak_pairs_ep; ikp weak_pairs_ep;
@ -199,6 +201,7 @@ ikp ik_asm_enter(ikpcb*, ikp code_object, ikp arg);
ikp ik_asm_reenter(ikpcb*, ikp code_object, ikp val); ikp ik_asm_reenter(ikpcb*, ikp code_object, ikp val);
ikp ik_underflow_handler(ikpcb*); ikp ik_underflow_handler(ikpcb*);
ikp ik_unsafe_alloc(ikpcb* pcb, int size); ikp ik_unsafe_alloc(ikpcb* pcb, int size);
ikp ik_safe_alloc(ikpcb* pcb, int size);
#define IK_FASL_HEADER "#@IK01" #define IK_FASL_HEADER "#@IK01"

202
src/ikarus-numerics.c
View File

@ -128,7 +128,7 @@ ikrt_fxfxplus(ikp x, ikp y, ikpcb* pcb){
return q; return q;
} }
else { else {
ikp bn = ik_unsafe_alloc(pcb, align(disp_bignum_data + wordsize)); ikp bn = ik_safe_alloc(pcb, align(disp_bignum_data + wordsize));
if(r > 0){ if(r > 0){
ref(bn, 0) = (ikp)(bignum_tag | (1 << bignum_length_shift)); ref(bn, 0) = (ikp)(bignum_tag | (1 << bignum_length_shift));
ref(bn, disp_bignum_data) = (ikp)r; ref(bn, disp_bignum_data) = (ikp)r;
@ -153,7 +153,9 @@ ikrt_fxbnplus(ikp x, ikp y, ikpcb* pcb){
if(intx > 0){ if(intx > 0){
if((bignum_sign_mask & (int)fst) == 0){ if((bignum_sign_mask & (int)fst) == 0){
/* positive fx + positive bn = even bigger positive */ /* positive fx + positive bn = even bigger positive */
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize)); pcb->root0 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize));
pcb->root0 = 0;
int carry = mpn_add_1((mp_limb_t*)(r+disp_bignum_data), int carry = mpn_add_1((mp_limb_t*)(r+disp_bignum_data),
(mp_limb_t*)(y - vector_tag + disp_bignum_data), (mp_limb_t*)(y - vector_tag + disp_bignum_data),
limb_count, limb_count,
@ -176,7 +178,9 @@ ikrt_fxbnplus(ikp x, ikp y, ikpcb* pcb){
else { else {
//fprintf(stderr, "this case 0x%08x\n", intx); //fprintf(stderr, "this case 0x%08x\n", intx);
/* positive fx + negative bn = smaller negative bn */ /* positive fx + negative bn = smaller negative bn */
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data+limb_count*wordsize)); pcb->root0 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data+limb_count*wordsize));
pcb->root0 = 0;
int borrow = mpn_sub_1((mp_limb_t*)(r+disp_bignum_data), int borrow = mpn_sub_1((mp_limb_t*)(r+disp_bignum_data),
(mp_limb_t*)(y - vector_tag + disp_bignum_data), (mp_limb_t*)(y - vector_tag + disp_bignum_data),
limb_count, limb_count,
@ -209,7 +213,9 @@ ikrt_fxbnplus(ikp x, ikp y, ikpcb* pcb){
else { else {
if((bignum_sign_mask & (int)fst) == 0){ if((bignum_sign_mask & (int)fst) == 0){
/* negative fx + positive bn = smaller positive */ /* negative fx + positive bn = smaller positive */
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data+limb_count*wordsize)); pcb->root0 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data+limb_count*wordsize));
pcb->root0 = 0;
int borrow = mpn_sub_1((mp_limb_t*)(r+disp_bignum_data), int borrow = mpn_sub_1((mp_limb_t*)(r+disp_bignum_data),
(mp_limb_t*)(y - vector_tag + disp_bignum_data), (mp_limb_t*)(y - vector_tag + disp_bignum_data),
limb_count, limb_count,
@ -239,7 +245,9 @@ ikrt_fxbnplus(ikp x, ikp y, ikpcb* pcb){
return verify_bignum(r+vector_tag, "fxbn+4"); return verify_bignum(r+vector_tag, "fxbn+4");
} else { } else {
/* negative fx + negative bn = larger negative */ /* negative fx + negative bn = larger negative */
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize)); pcb->root0 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize));
pcb->root0 = 0;
int carry = mpn_add_1((mp_limb_t*)(r+disp_bignum_data), int carry = mpn_add_1((mp_limb_t*)(r+disp_bignum_data),
(mp_limb_t*)(y - vector_tag + disp_bignum_data), (mp_limb_t*)(y - vector_tag + disp_bignum_data),
limb_count, limb_count,
@ -281,7 +289,11 @@ ikrt_bnbnplus(ikp x, ikp y, ikpcb* pcb){
} else { } else {
n1 = ylimbs; n2 = xlimbs; s1 = y; s2 = x; n1 = ylimbs; n2 = xlimbs; s1 = y; s2 = x;
} }
ikp res = ik_unsafe_alloc(pcb, align(disp_bignum_data + (n1+1)*wordsize)); pcb->root0 = &s1;
pcb->root1 = &s2;
ikp res = ik_safe_alloc(pcb, align(disp_bignum_data + (n1+1)*wordsize));
pcb->root0 = 0;
pcb->root1 = 0;
mp_limb_t carry = mpn_add((mp_limb_t*) (res+disp_bignum_data), mp_limb_t carry = mpn_add((mp_limb_t*) (res+disp_bignum_data),
(mp_limb_t*) (s1-vector_tag+disp_bignum_data), (mp_limb_t*) (s1-vector_tag+disp_bignum_data),
n1, n1,
@ -329,7 +341,11 @@ ikrt_bnbnplus(ikp x, ikp y, ikpcb* pcb){
} }
} }
/* |s1| > |s2| */ /* |s1| > |s2| */
ikp res = ik_unsafe_alloc(pcb, align(disp_bignum_data + n1 * wordsize)); pcb->root0 = &s1;
pcb->root1 = &s2;
ikp res = ik_safe_alloc(pcb, align(disp_bignum_data + n1 * wordsize));
pcb->root0 = 0;
pcb->root1 = 0;
int burrow = mpn_sub((mp_limb_t*) (res + disp_bignum_data), int burrow = mpn_sub((mp_limb_t*) (res + disp_bignum_data),
(mp_limb_t*) (s1 - vector_tag + disp_bignum_data), (mp_limb_t*) (s1 - vector_tag + disp_bignum_data),
n1, n1,
@ -388,7 +404,7 @@ ikrt_fxfxminus(ikp x, ikp y, ikpcb* pcb){
if(((unsigned int)r) <= most_positive_fixnum){ if(((unsigned int)r) <= most_positive_fixnum){
return fix(r); return fix(r);
} else { } else {
ikp bn = ik_unsafe_alloc(pcb, align(disp_bignum_data + wordsize)); ikp bn = ik_safe_alloc(pcb, align(disp_bignum_data + wordsize));
ref(bn, 0) = (ikp) (bignum_tag | (1 << bignum_length_shift)); ref(bn, 0) = (ikp) (bignum_tag | (1 << bignum_length_shift));
ref(bn, disp_bignum_data) = (ikp)r; ref(bn, disp_bignum_data) = (ikp)r;
return verify_bignum(bn+vector_tag,"fxfx-1"); return verify_bignum(bn+vector_tag,"fxfx-1");
@ -398,7 +414,7 @@ ikrt_fxfxminus(ikp x, ikp y, ikpcb* pcb){
if(unfix(fxr) == r){ if(unfix(fxr) == r){
return fxr; return fxr;
} else { } else {
ikp bn = ik_unsafe_alloc(pcb, align(disp_bignum_data + wordsize)); ikp bn = ik_safe_alloc(pcb, align(disp_bignum_data + wordsize));
ref(bn, 0) = (ikp) ref(bn, 0) = (ikp)
(bignum_tag | (bignum_tag |
(1 << bignum_sign_shift) | (1 << bignum_sign_shift) |
@ -423,7 +439,9 @@ ikrt_bnnegate(ikp x, ikpcb* pcb){
} }
} }
} }
ikp bn = ik_unsafe_alloc(pcb, align(disp_bignum_data + limb_count * wordsize)); pcb->root0 = &x;
ikp bn = ik_safe_alloc(pcb, align(disp_bignum_data + limb_count * wordsize));
pcb->root0 = 0;
memcpy(bn+disp_bignum_data, memcpy(bn+disp_bignum_data,
x-vector_tag+disp_bignum_data, x-vector_tag+disp_bignum_data,
limb_count*wordsize); limb_count*wordsize);
@ -443,7 +461,9 @@ ikrt_fxbnminus(ikp x, ikp y, ikpcb* pcb){
if(intx > 0){ if(intx > 0){
if(bignum_sign_mask & (int)fst){ if(bignum_sign_mask & (int)fst){
/* positive fx - negative bn = positive bn */ /* positive fx - negative bn = positive bn */
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize)); pcb->root0 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize));
pcb->root0 = 0;
int carry = mpn_add_1((mp_limb_t*)(r+disp_bignum_data), int carry = mpn_add_1((mp_limb_t*)(r+disp_bignum_data),
(mp_limb_t*)(y - vector_tag + disp_bignum_data), (mp_limb_t*)(y - vector_tag + disp_bignum_data),
limb_count, limb_count,
@ -465,7 +485,9 @@ ikrt_fxbnminus(ikp x, ikp y, ikpcb* pcb){
} }
else { else {
/* positive fx - positive bn = smaller negative bn/fx */ /* positive fx - positive bn = smaller negative bn/fx */
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data+limb_count*wordsize)); pcb->root0 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data+limb_count*wordsize));
pcb->root0 = 0;
int borrow = mpn_sub_1((mp_limb_t*)(r+disp_bignum_data), int borrow = mpn_sub_1((mp_limb_t*)(r+disp_bignum_data),
(mp_limb_t*)(y - vector_tag + disp_bignum_data), (mp_limb_t*)(y - vector_tag + disp_bignum_data),
limb_count, limb_count,
@ -498,7 +520,9 @@ ikrt_fxbnminus(ikp x, ikp y, ikpcb* pcb){
else { else {
if(bignum_sign_mask & (int)fst){ if(bignum_sign_mask & (int)fst){
/* negative fx - negative bn = smaller positive */ /* negative fx - negative bn = smaller positive */
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data+limb_count*wordsize)); pcb->root0 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data+limb_count*wordsize));
pcb->root0 = 0;
int borrow = mpn_sub_1((mp_limb_t*)(r+disp_bignum_data), int borrow = mpn_sub_1((mp_limb_t*)(r+disp_bignum_data),
(mp_limb_t*)(y - vector_tag + disp_bignum_data), (mp_limb_t*)(y - vector_tag + disp_bignum_data),
limb_count, limb_count,
@ -528,7 +552,9 @@ ikrt_fxbnminus(ikp x, ikp y, ikpcb* pcb){
return verify_bignum(r+vector_tag,"fxbn-"); return verify_bignum(r+vector_tag,"fxbn-");
} else { } else {
/* negative fx - positive bn = larger negative */ /* negative fx - positive bn = larger negative */
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize)); pcb->root0 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize));
pcb->root0 = 0;
int carry = mpn_add_1((mp_limb_t*)(r+disp_bignum_data), int carry = mpn_add_1((mp_limb_t*)(r+disp_bignum_data),
(mp_limb_t*)(y - vector_tag + disp_bignum_data), (mp_limb_t*)(y - vector_tag + disp_bignum_data),
limb_count, limb_count,
@ -560,7 +586,9 @@ ikrt_bnfxminus(ikp x, ikp y, ikpcb* pcb){
if(inty < 0){ if(inty < 0){
if((bignum_sign_mask & (int)fst) == 0){ if((bignum_sign_mask & (int)fst) == 0){
/* - negative fx + positive bn = positive bn */ /* - negative fx + positive bn = positive bn */
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize)); pcb->root0 = &x;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize));
pcb->root0 = 0;
int carry = mpn_add_1((mp_limb_t*)(r+disp_bignum_data), int carry = mpn_add_1((mp_limb_t*)(r+disp_bignum_data),
(mp_limb_t*)(x - vector_tag + disp_bignum_data), (mp_limb_t*)(x - vector_tag + disp_bignum_data),
limb_count, limb_count,
@ -582,7 +610,9 @@ ikrt_bnfxminus(ikp x, ikp y, ikpcb* pcb){
} }
else { else {
/* - negative fx + negative bn = smaller negative bn/fx */ /* - negative fx + negative bn = smaller negative bn/fx */
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data+limb_count*wordsize)); pcb->root0 = &x;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data+limb_count*wordsize));
pcb->root0 = 0;
int borrow = mpn_sub_1((mp_limb_t*)(r+disp_bignum_data), int borrow = mpn_sub_1((mp_limb_t*)(r+disp_bignum_data),
(mp_limb_t*)(x - vector_tag + disp_bignum_data), (mp_limb_t*)(x - vector_tag + disp_bignum_data),
limb_count, limb_count,
@ -615,7 +645,9 @@ ikrt_bnfxminus(ikp x, ikp y, ikpcb* pcb){
else { else {
if((bignum_sign_mask & (int)fst) == 0){ if((bignum_sign_mask & (int)fst) == 0){
/* - positive fx + positive bn = smaller positive */ /* - positive fx + positive bn = smaller positive */
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data+limb_count*wordsize)); pcb->root0 = &x;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data+limb_count*wordsize));
pcb->root0 = 0;
int borrow = mpn_sub_1((mp_limb_t*)(r+disp_bignum_data), int borrow = mpn_sub_1((mp_limb_t*)(r+disp_bignum_data),
(mp_limb_t*)(x - vector_tag + disp_bignum_data), (mp_limb_t*)(x - vector_tag + disp_bignum_data),
limb_count, limb_count,
@ -645,7 +677,9 @@ ikrt_bnfxminus(ikp x, ikp y, ikpcb* pcb){
return verify_bignum(r+vector_tag, "bnfx-"); return verify_bignum(r+vector_tag, "bnfx-");
} else { } else {
/* - positive fx + negative bn = larger negative */ /* - positive fx + negative bn = larger negative */
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize)); pcb->root0 = &x;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data+(limb_count+1)*wordsize));
pcb->root0 = 0;
int carry = mpn_add_1((mp_limb_t*)(r+disp_bignum_data), int carry = mpn_add_1((mp_limb_t*)(r+disp_bignum_data),
(mp_limb_t*)(x - vector_tag + disp_bignum_data), (mp_limb_t*)(x - vector_tag + disp_bignum_data),
limb_count, limb_count,
@ -687,7 +721,11 @@ ikrt_bnbnminus(ikp x, ikp y, ikpcb* pcb){
} else { } else {
n1 = ylimbs; n2 = xlimbs; s1 = y; s2 = x; n1 = ylimbs; n2 = xlimbs; s1 = y; s2 = x;
} }
ikp res = ik_unsafe_alloc(pcb, align(disp_bignum_data + (n1+1)*wordsize)); pcb->root0 = &s1;
pcb->root0 = &s2;
ikp res = ik_safe_alloc(pcb, align(disp_bignum_data + (n1+1)*wordsize));
pcb->root0 = 0;
pcb->root0 = 0;
mp_limb_t carry = mpn_add((mp_limb_t*) (res+disp_bignum_data), mp_limb_t carry = mpn_add((mp_limb_t*) (res+disp_bignum_data),
(mp_limb_t*) (s1-vector_tag+disp_bignum_data), (mp_limb_t*) (s1-vector_tag+disp_bignum_data),
n1, n1,
@ -737,7 +775,11 @@ ikrt_bnbnminus(ikp x, ikp y, ikpcb* pcb){
} }
} }
/* |s1| > |s2| */ /* |s1| > |s2| */
ikp res = ik_unsafe_alloc(pcb, align(disp_bignum_data + n1 * wordsize)); pcb->root0 = &s1;
pcb->root0 = &s2;
ikp res = ik_safe_alloc(pcb, align(disp_bignum_data + n1 * wordsize));
pcb->root0 = 0;
pcb->root0 = 0;
int burrow = mpn_sub((mp_limb_t*) (res + disp_bignum_data), int burrow = mpn_sub((mp_limb_t*) (res + disp_bignum_data),
(mp_limb_t*) (s1 - vector_tag + disp_bignum_data), (mp_limb_t*) (s1 - vector_tag + disp_bignum_data),
n1, n1,
@ -812,7 +854,7 @@ ikrt_fxfxmult(ikp x, ikp y, ikpcb* pcb){
return fix((int)lo); return fix((int)lo);
} }
} }
ikp r = ik_unsafe_alloc(pcb, disp_bignum_data + wordsize); ikp r = ik_safe_alloc(pcb, disp_bignum_data + wordsize);
ref(r, 0) = (ikp) ref(r, 0) = (ikp)
(bignum_tag | (bignum_tag |
(sign << bignum_sign_shift) | (sign << bignum_sign_shift) |
@ -820,7 +862,7 @@ ikrt_fxfxmult(ikp x, ikp y, ikpcb* pcb){
ref(r, disp_bignum_data) = (ikp)lo; ref(r, disp_bignum_data) = (ikp)lo;
return BN(r+vector_tag); return BN(r+vector_tag);
} else { } else {
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + 2*wordsize)); ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + 2*wordsize));
ref(r, 0) = (ikp) ref(r, 0) = (ikp)
(bignum_tag | (bignum_tag |
(sign << bignum_sign_shift) | (sign << bignum_sign_shift) |
@ -861,7 +903,9 @@ ikrt_fxbnmult(ikp x, ikp y, ikpcb* pcb){
mp_limb_t s2 = (n2>0) ? n2 : (- n2); mp_limb_t s2 = (n2>0) ? n2 : (- n2);
ikp fst = ref(y, -vector_tag); ikp fst = ref(y, -vector_tag);
int limb_count = ((unsigned int) fst) >> bignum_length_shift; int limb_count = ((unsigned int) fst) >> bignum_length_shift;
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + (limb_count+1)*wordsize)); pcb->root0 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + (limb_count+1)*wordsize));
pcb->root0 = 0;
mp_limb_t hi = mpn_mul_1((mp_limb_t*)(r+disp_bignum_data), mp_limb_t hi = mpn_mul_1((mp_limb_t*)(r+disp_bignum_data),
(mp_limb_t*)(y-vector_tag+disp_bignum_data), (mp_limb_t*)(y-vector_tag+disp_bignum_data),
limb_count, limb_count,
@ -881,7 +925,11 @@ ikrt_bnbnmult(ikp x, ikp y, ikpcb* pcb){
int n1 = ((unsigned int)f1) >> bignum_length_shift; int n1 = ((unsigned int)f1) >> bignum_length_shift;
int n2 = ((unsigned int)f2) >> bignum_length_shift; int n2 = ((unsigned int)f2) >> bignum_length_shift;
int nr = n1 + n2; int nr = n1 + n2;
ikp bn = ik_unsafe_alloc(pcb, align(disp_bignum_data + nr*wordsize)); pcb->root0 = &x;
pcb->root1 = &y;
ikp bn = ik_safe_alloc(pcb, align(disp_bignum_data + nr*wordsize));
pcb->root0 = 0;
pcb->root1 = 0;
mp_limb_t r; mp_limb_t r;
if(n1 >= n2){ if(n1 >= n2){
r = mpn_mul((mp_limb_t*)(bn+disp_bignum_data), r = mpn_mul((mp_limb_t*)(bn+disp_bignum_data),
@ -992,7 +1040,9 @@ ikrt_fxbnlogand(ikp x, ikp y, ikpcb* pcb){
if((len == 1) && (nn <= most_negative_fixnum)){ if((len == 1) && (nn <= most_negative_fixnum)){
return fix(-nn); return fix(-nn);
} }
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + len * wordsize)); pcb->root0 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + len * wordsize));
pcb->root0 = 0;
ref(r, 0) = fst; ref(r, 0) = fst;
ref(r, disp_bignum_data) = (ikp) nn; ref(r, disp_bignum_data) = (ikp) nn;
int i; int i;
@ -1004,7 +1054,9 @@ ikrt_fxbnlogand(ikp x, ikp y, ikpcb* pcb){
} else { } else {
/* y is positive */ /* y is positive */
int len = (((unsigned int) fst) >> bignum_length_shift); int len = (((unsigned int) fst) >> bignum_length_shift);
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + len * wordsize)); pcb->root0 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + len * wordsize));
pcb->root0 = 0;
ref(r, 0) = fst; ref(r, 0) = fst;
ref(r, disp_bignum_data) = (ikp) ref(r, disp_bignum_data) = (ikp)
(((int)ref(y, disp_bignum_data - vector_tag)) & n1); (((int)ref(y, disp_bignum_data - vector_tag)) & n1);
@ -1090,10 +1142,12 @@ ikp
ikrt_bnlognot(ikp x, ikpcb* pcb){ ikrt_bnlognot(ikp x, ikpcb* pcb){
ikp fst = ref(x, -vector_tag); ikp fst = ref(x, -vector_tag);
int n = ((unsigned int)fst) >> bignum_length_shift; int n = ((unsigned int)fst) >> bignum_length_shift;
unsigned int* s1 = ((unsigned int*)(x+disp_bignum_data-vector_tag));
if(bignum_sign_mask & (unsigned int) fst){ if(bignum_sign_mask & (unsigned int) fst){
/* negative */ /* negative */
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + n*wordsize)); pcb->root0 = &x;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + n*wordsize));
pcb->root0 = 0;
unsigned int* s1 = ((unsigned int*)(x+disp_bignum_data-vector_tag));
unsigned int* rd = (unsigned int*)(r+disp_bignum_data); unsigned int* rd = (unsigned int*)(r+disp_bignum_data);
int i; int i;
for(i=0; (i<n) && (s1[i] == 0); i++) { for(i=0; (i<n) && (s1[i] == 0); i++) {
@ -1107,16 +1161,22 @@ ikrt_bnlognot(ikp x, ikpcb* pcb){
} else { } else {
/* positive */ /* positive */
int i; int i;
unsigned int* s1 = ((unsigned int*)(x+disp_bignum_data-vector_tag));
for(i=0; (i<n) && (s1[i] == -1); i++) {/*nothing*/} for(i=0; (i<n) && (s1[i] == -1); i++) {/*nothing*/}
if(i==n){ if(i==n){
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + (n+1)*wordsize)); pcb->root0 = &x;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + (n+1)*wordsize));
pcb->root0 = 0;
bzero(r+disp_bignum_data, n*wordsize); bzero(r+disp_bignum_data, n*wordsize);
((unsigned int*)(r+disp_bignum_data))[n] = 1; ((unsigned int*)(r+disp_bignum_data))[n] = 1;
ref(r, 0) = (ikp) ref(r, 0) = (ikp)
(bignum_tag | (1<<bignum_sign_shift) | ((n+1) << bignum_length_shift)); (bignum_tag | (1<<bignum_sign_shift) | ((n+1) << bignum_length_shift));
return r+vector_tag; return r+vector_tag;
} else { } else {
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + n*wordsize)); pcb->root0 = &x;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + n*wordsize));
pcb->root0 = 0;
unsigned int* s1 = ((unsigned int*)(x+disp_bignum_data-vector_tag));
unsigned int* rd = (unsigned int*)(r+disp_bignum_data); unsigned int* rd = (unsigned int*)(r+disp_bignum_data);
int j; int j;
for(j=0; j<i; j++){ rd[j] = 0; } for(j=0; j<i; j++){ rd[j] = 0; }
@ -1138,10 +1198,14 @@ ikrt_bnbnlogand(ikp x, ikp y, ikpcb* pcb){
int n2 = ((unsigned int) yfst) >> bignum_length_shift; int n2 = ((unsigned int) yfst) >> bignum_length_shift;
if(bignum_sign_mask & (unsigned int) xfst){ if(bignum_sign_mask & (unsigned int) xfst){
if(bignum_sign_mask & (unsigned int) yfst){ if(bignum_sign_mask & (unsigned int) yfst){
unsigned int* s1 = ((unsigned int*)(x+disp_bignum_data-vector_tag));
unsigned int* s2 = ((unsigned int*)(y+disp_bignum_data-vector_tag));
if(n1 >= n2){ if(n1 >= n2){
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + n1*wordsize)); pcb->root0 = &x;
pcb->root1 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + n1*wordsize));
pcb->root0 = 0;
pcb->root1 = 0;
unsigned int* s1 = ((unsigned int*)(x+disp_bignum_data-vector_tag));
unsigned int* s2 = ((unsigned int*)(y+disp_bignum_data-vector_tag));
unsigned int* s = ((unsigned int*)(r+disp_bignum_data)); unsigned int* s = ((unsigned int*)(r+disp_bignum_data));
bits_compliment(s1, s, n1); bits_compliment(s1, s, n1);
bits_compliment_logand(s2, s, s, n2); bits_compliment_logand(s2, s, s, n2);
@ -1157,9 +1221,13 @@ ikrt_bnbnlogand(ikp x, ikp y, ikpcb* pcb){
if(bignum_sign_mask & (unsigned int) yfst){ if(bignum_sign_mask & (unsigned int) yfst){
/* x positive, y negative */ /* x positive, y negative */
/* the result is at most n1 words long */ /* the result is at most n1 words long */
pcb->root0 = &x;
pcb->root1 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + n1*wordsize));
pcb->root0 = 0;
pcb->root1 = 0;
unsigned int* s1 = ((unsigned int*)(x+disp_bignum_data-vector_tag)); unsigned int* s1 = ((unsigned int*)(x+disp_bignum_data-vector_tag));
unsigned int* s2 = ((unsigned int*)(y+disp_bignum_data-vector_tag)); unsigned int* s2 = ((unsigned int*)(y+disp_bignum_data-vector_tag));
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + n1*wordsize));
unsigned int* s = ((unsigned int*)(r+disp_bignum_data)); unsigned int* s = ((unsigned int*)(r+disp_bignum_data));
bits_compliment_logand(s2, s1, s, n1); bits_compliment_logand(s2, s1, s, n1);
return normalize_bignum(n1, 0, r); return normalize_bignum(n1, 0, r);
@ -1177,7 +1245,11 @@ ikrt_bnbnlogand(ikp x, ikp y, ikpcb* pcb){
if((i == 0) && (last < most_positive_fixnum)){ if((i == 0) && (last < most_positive_fixnum)){
return fix(last); return fix(last);
} }
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data+(i+1)*wordsize)); pcb->root0 = &x;
pcb->root1 = &y;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data+(i+1)*wordsize));
pcb->root0 = 0;
pcb->root1 = 0;
ref(r, 0) = (ikp) (bignum_tag | ((i+1)<<bignum_length_shift)); ref(r, 0) = (ikp) (bignum_tag | ((i+1)<<bignum_length_shift));
ref(r, disp_bignum_data + i*wordsize) = (ikp)last; ref(r, disp_bignum_data + i*wordsize) = (ikp)last;
int j; int j;
@ -1237,7 +1309,9 @@ ikrt_bignum_shift_right(ikp x, ikp y, ikpcb* pcb){
return fix(-1); return fix(-1);
} }
if(bit_shift == 0){ if(bit_shift == 0){
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + new_limb_count * wordsize)); pcb->root0 = &x;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + new_limb_count * wordsize));
pcb->root0 = 0;
bits_compliment_with_carry( bits_compliment_with_carry(
(unsigned int*)(x+off_bignum_data+whole_limb_shift*wordsize), (unsigned int*)(x+off_bignum_data+whole_limb_shift*wordsize),
(unsigned int*)(r+disp_bignum_data), (unsigned int*)(r+disp_bignum_data),
@ -1249,7 +1323,9 @@ ikrt_bignum_shift_right(ikp x, ikp y, ikpcb* pcb){
new_limb_count); new_limb_count);
return normalize_bignum(new_limb_count, 1 << bignum_sign_shift, r); return normalize_bignum(new_limb_count, 1 << bignum_sign_shift, r);
} else { } else {
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + new_limb_count * wordsize)); pcb->root0 = &x;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + new_limb_count * wordsize));
pcb->root0 = 0;
bits_compliment_with_carry( bits_compliment_with_carry(
(unsigned int*)(x+off_bignum_data+whole_limb_shift*wordsize), (unsigned int*)(x+off_bignum_data+whole_limb_shift*wordsize),
(unsigned int*)(r+disp_bignum_data), (unsigned int*)(r+disp_bignum_data),
@ -1274,14 +1350,15 @@ ikrt_bignum_shift_right(ikp x, ikp y, ikpcb* pcb){
if(new_limb_count <= 0){ if(new_limb_count <= 0){
return 0; return 0;
} }
pcb->root0 = &x;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + new_limb_count * wordsize));
pcb->root0 = 0;
if(bit_shift == 0){ if(bit_shift == 0){
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + new_limb_count * wordsize));
memcpy(r+disp_bignum_data, memcpy(r+disp_bignum_data,
x+off_bignum_data+whole_limb_shift*wordsize, x+off_bignum_data+whole_limb_shift*wordsize,
new_limb_count * wordsize); new_limb_count * wordsize);
return normalize_bignum(new_limb_count, 0, r); return normalize_bignum(new_limb_count, 0, r);
} else { } else {
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + new_limb_count * wordsize));
copy_bits_shifting_right( copy_bits_shifting_right(
(unsigned int*)(x+off_bignum_data+whole_limb_shift*wordsize), (unsigned int*)(x+off_bignum_data+whole_limb_shift*wordsize),
(unsigned int*)(r+disp_bignum_data), (unsigned int*)(r+disp_bignum_data),
@ -1299,7 +1376,7 @@ ikrt_fixnum_shift_left(ikp x, ikp y, ikpcb* pcb){
int n = unfix(x); int n = unfix(x);
int limb_count = (m >> 5) + 2; /* FIXME: 5 are the bits in 32-bit num */ int limb_count = (m >> 5) + 2; /* FIXME: 5 are the bits in 32-bit num */
int bit_shift = m & 31; int bit_shift = m & 31;
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + limb_count * wordsize)); ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + limb_count * wordsize));
unsigned int* s = (unsigned int*)(r+disp_bignum_data); unsigned int* s = (unsigned int*)(r+disp_bignum_data);
bzero(s, limb_count * wordsize); bzero(s, limb_count * wordsize);
if(n >= 0){ if(n >= 0){
@ -1326,14 +1403,18 @@ ikrt_bignum_shift_left(ikp x, ikp y, ikpcb* pcb){
int bit_shift = m & 31; int bit_shift = m & 31;
if(bit_shift == 0){ if(bit_shift == 0){
int limb_count = n + whole_limb_shift; int limb_count = n + whole_limb_shift;
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + limb_count * wordsize)); pcb->root0 = &x;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + limb_count * wordsize));
pcb->root0 = 0;
unsigned int* s = (unsigned int*)(r+disp_bignum_data); unsigned int* s = (unsigned int*)(r+disp_bignum_data);
bzero(s, whole_limb_shift*wordsize); bzero(s, whole_limb_shift*wordsize);
memcpy(s+whole_limb_shift, x+off_bignum_data, n*wordsize); memcpy(s+whole_limb_shift, x+off_bignum_data, n*wordsize);
return normalize_bignum(limb_count, (unsigned int)fst & bignum_sign_mask, r); return normalize_bignum(limb_count, (unsigned int)fst & bignum_sign_mask, r);
} else { } else {
int limb_count = n + whole_limb_shift + 1; int limb_count = n + whole_limb_shift + 1;
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + limb_count * wordsize)); pcb->root0 = &x;
ikp r = ik_safe_alloc(pcb, align(disp_bignum_data + limb_count * wordsize));
pcb->root0 = 0;
unsigned int* s = (unsigned int*)(r+disp_bignum_data); unsigned int* s = (unsigned int*)(r+disp_bignum_data);
bzero(s, whole_limb_shift*wordsize); bzero(s, whole_limb_shift*wordsize);
copy_bits_shifting_left( copy_bits_shifting_left(
@ -1374,15 +1455,29 @@ ikrt_bnbndivrem(ikp x, ikp y, ikpcb* pcb){
mp_size_t yn = ((unsigned int) yfst) >> bignum_length_shift; mp_size_t yn = ((unsigned int) yfst) >> bignum_length_shift;
if(xn < yn){ if(xn < yn){
/* quotient is zero, remainder is x */ /* quotient is zero, remainder is x */
ikp rv = ik_unsafe_alloc(pcb, pair_size); pcb->root0 = &x;
pcb->root1 = &y;
ikp rv = ik_safe_alloc(pcb, pair_size);
pcb->root0 = 0;
pcb->root1 = 0;
ref(rv, disp_car) = 0; ref(rv, disp_car) = 0;
ref(rv, disp_cdr) = x; ref(rv, disp_cdr) = x;
return rv+pair_tag; return rv+pair_tag;
} }
mp_size_t qn = xn - yn + 1; mp_size_t qn = xn - yn + 1;
mp_size_t rn = yn; mp_size_t rn = yn;
/*
ikp q = ik_unsafe_alloc(pcb, align(disp_bignum_data + qn*wordsize)); ikp q = ik_unsafe_alloc(pcb, align(disp_bignum_data + qn*wordsize));
ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + rn*wordsize)); ikp r = ik_unsafe_alloc(pcb, align(disp_bignum_data + rn*wordsize));
*/
pcb->root0 = &x;
pcb->root1 = &y;
ikp q = ik_safe_alloc(pcb,
align(disp_bignum_data + qn*wordsize) +
align(disp_bignum_data + rn*wordsize));
ikp r = q + align(disp_bignum_data + qn*wordsize);
pcb->root0 = 0;
pcb->root1 = 0;
mpn_tdiv_qr ( mpn_tdiv_qr (
(mp_limb_t*)(q+disp_bignum_data), (mp_limb_t*)(q+disp_bignum_data),
(mp_limb_t*)(r+disp_bignum_data), (mp_limb_t*)(r+disp_bignum_data),
@ -1409,7 +1504,11 @@ ikrt_bnbndivrem(ikp x, ikp y, ikpcb* pcb){
int sign = (((unsigned int)xfst) & bignum_sign_mask); int sign = (((unsigned int)xfst) & bignum_sign_mask);
q = normalize_bignum(qn, sign, q); q = normalize_bignum(qn, sign, q);
} }
ikp rv = ik_unsafe_alloc(pcb, pair_size); pcb->root0 = &q;
pcb->root1 = &r;
ikp rv = ik_safe_alloc(pcb, pair_size);
pcb->root0 = 0;
pcb->root1 = 0;
ref(rv, disp_car) = q; ref(rv, disp_car) = q;
ref(rv, disp_cdr) = r; ref(rv, disp_cdr) = r;
return rv+pair_tag; return rv+pair_tag;
@ -1437,11 +1536,12 @@ usages, qxn will be zero.
ikp ikp
ikrt_bnfxdivrem(ikp x, ikp y, ikpcb* pcb){ ikrt_bnfxdivrem(ikp x, ikp y, ikpcb* pcb){
int yint = unfix(y); int yint = unfix(y);
mp_limb_t* s2p = (mp_limb_t*)(x+off_bignum_data);
ikp fst = ref(x, -vector_tag); ikp fst = ref(x, -vector_tag);
mp_size_t s2n = ((unsigned int) fst) >> bignum_length_shift; mp_size_t s2n = ((unsigned int) fst) >> bignum_length_shift;
ikp quot = ik_unsafe_alloc(pcb, pcb->root0 = &x;
align(s2n*wordsize + disp_bignum_data)); ikp quot = ik_safe_alloc(pcb, align(s2n*wordsize + disp_bignum_data));
pcb->root0 = 0;
mp_limb_t* s2p = (mp_limb_t*)(x+off_bignum_data);
mp_limb_t rv = mpn_divrem_1( mp_limb_t rv = mpn_divrem_1(
(mp_limb_t*)(quot+disp_bignum_data), (mp_limb_t*)(quot+disp_bignum_data),
0, 0,
@ -1471,7 +1571,11 @@ ikrt_bnfxdivrem(ikp x, ikp y, ikpcb* pcb){
} else { } else {
rem = fix(rv); rem = fix(rv);
} }
ikp p = ik_unsafe_alloc(pcb, pair_size); pcb->root0 = &quot;
pcb->root0 = &rem;
ikp p = ik_safe_alloc(pcb, pair_size);
pcb->root0 = 0;
pcb->root0 = 0;
ref(p, disp_car) = quot; ref(p, disp_car) = quot;
ref(p, disp_cdr) = rem; ref(p, disp_cdr) = rem;
return p+pair_tag; return p+pair_tag;
@ -1542,7 +1646,7 @@ ikrt_bignum_to_bytevector(ikp x, ikpcb* pcb){
string_start++; string_start++;
bytes--; bytes--;
} }
ikp bv = ik_unsafe_alloc(pcb, align(bytes + disp_bytevector_data + (sign_bit?1:0))); ikp bv = ik_safe_alloc(pcb, align(bytes + disp_bytevector_data + (sign_bit?1:0)));
ref(bv, 0) = fix(bytes + (sign_bit?1:0)); ref(bv, 0) = fix(bytes + (sign_bit?1:0));
ikp dest = bv + disp_bytevector_data; ikp dest = bv + disp_bytevector_data;
if(sign_bit){ if(sign_bit){

29
src/ikarus-runtime.c
View File

@ -394,6 +394,35 @@ void ik_delete_pcb(ikpcb* pcb){
ik_free(pcb, sizeof(ikpcb)); ik_free(pcb, sizeof(ikpcb));
} }
ikp
ik_safe_alloc(ikpcb* pcb, int size){
assert(size == align(size));
ikp ap = pcb->allocation_pointer;
ikp ep = pcb->heap_base + pcb->heap_size;
ikp nap = ap + size;
if(nap < ep){
pcb->allocation_pointer = nap;
return ap;
}
else {
ik_collect(size, pcb);
ikp ap = pcb->allocation_pointer;
ikp ep = pcb->heap_base + pcb->heap_size;
ikp nap = ap + size;
if(nap < ep){
pcb->allocation_pointer = nap;
return ap;
} else {
fprintf(stderr,
"ikaurs: BUG: collector did not leave enough room for %d\n",
size);
exit(-1);
}
}
}
ikp ikp
ik_unsafe_alloc(ikpcb* pcb, int size){ ik_unsafe_alloc(ikpcb* pcb, int size){