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

changed type of ikptr to unsigned int now and removed ikint.

This commit is contained in:
Abdulaziz Ghuloum 2008-01-01 21:08:07 -05:00
parent 8538098043
commit e0909d76fe
13 changed files with 297 additions and 254 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/cpu_has_sse2.s
View File

@ -25,13 +25,19 @@ _cpu_has_sse2:
# callee-save registers are $ebx, %esi, %edi, %esp, $ebp # callee-save registers are $ebx, %esi, %edi, %esp, $ebp
# cpuid modifies %eax, %ebx, %ecx, %edx # cpuid modifies %eax, %ebx, %ecx, %edx
# only %ebx needs to be saved/restored # only %ebx needs to be saved/restored
# push %rbx #if __x86_64__
push %rbx
#else
push %ebx push %ebx
#endif
movl $1, %eax movl $1, %eax
cpuid cpuid
movl %edx, %eax movl %edx, %eax
sarl $26, %eax sarl $26, %eax
andl $1, %eax andl $1, %eax
# pop %rbx #if __x86_64__
pop %rbx
#else
pop %ebx pop %ebx
#endif
ret ret

165
src/ikarus-collect.c
View File

@ -178,7 +178,7 @@ gc_alloc_new_large_ptr(int size, gc_t* gc){
qupages_t* p = ik_malloc(sizeof(qupages_t)); qupages_t* p = ik_malloc(sizeof(qupages_t));
p->p = mem; p->p = mem;
p->q = mem+size; p->q = mem+size;
bzero(mem+size, memreq-size); bzero((char*)(long)(mem+size), memreq-size);
p->next = gc->queues[meta_ptrs]; p->next = gc->queues[meta_ptrs];
gc->queues[meta_ptrs] = p; gc->queues[meta_ptrs] = p;
return mem; return mem;
@ -259,7 +259,7 @@ gc_alloc_new_code(int size, gc_t* gc){
qupages_t* p = ik_malloc(sizeof(qupages_t)); qupages_t* p = ik_malloc(sizeof(qupages_t));
p->p = mem; p->p = mem;
p->q = mem+size; p->q = mem+size;
bzero(mem+size, memreq-size); bzero((char*)(long)(mem+size), memreq-size);
p->next = gc->queues[meta_code]; p->next = gc->queues[meta_code];
gc->queues[meta_code] = p; gc->queues[meta_code] = p;
return mem; return mem;
@ -294,7 +294,7 @@ gc_tconc_push_extending(gc_t* gc, ikptr tcbucket){
gc->pcb); gc->pcb);
add_to_collect_count(gc->pcb, pagesize); add_to_collect_count(gc->pcb, pagesize);
gc->segment_vector = gc->pcb->segment_vector; gc->segment_vector = gc->pcb->segment_vector;
bzero(ap, pagesize); bzero((char*)(long)ap, pagesize);
ikptr nap = ap + 2*wordsize; ikptr nap = ap + 2*wordsize;
gc->tconc_base = ap; gc->tconc_base = ap;
gc->tconc_ap = nap; gc->tconc_ap = nap;
@ -605,7 +605,7 @@ move_guardian(ikptr x, ik_ptr_page* dst, ik_ptr_page** cache){
if(y){ if(y){
*cache = y->next; *cache = y->next;
} else { } else {
y = ik_mmap(sizeof(ik_ptr_page)); y = (ik_ptr_page*)(long)ik_mmap(sizeof(ik_ptr_page));
} }
y->count = 0; y->count = 0;
y->next = dst; y->next = dst;
@ -834,7 +834,7 @@ forward_guardians(gc_t* gc){
collect_loop(gc); collect_loop(gc);
while(cache){ while(cache){
ik_ptr_page* next = cache->next; ik_ptr_page* next = cache->next;
ik_munmap((unsigned char*)cache, sizeof(ik_ptr_page)); ik_munmap((ikptr)cache, sizeof(ik_ptr_page));
cache = next; cache = next;
} }
} }
@ -860,19 +860,19 @@ empty_dropped_guardians(gc_t* gc){
ref(a, off_car) = false_object; ref(a, off_car) = false_object;
ref(a, off_cdr) = false_object; ref(a, off_cdr) = false_object;
ref(tc, off_cdr) = a; ref(tc, off_cdr) = a;
pcb->dirty_vector[page_index(tc)] = -1; ((int*)(long)pcb->dirty_vector)[page_index(tc)] = -1;
//pcb->dirty_vector[page_index(d)] = -1; //pcb->dirty_vector[page_index(d)] = -1;
{ {
int dgen = pcb->segment_vector[page_index(d)] & gen_mask; int dgen = pcb->segment_vector[page_index(d)] & gen_mask;
if( (dgen > (pcb->segment_vector[page_index(obj)] & gen_mask)) if( (dgen > (pcb->segment_vector[page_index(obj)] & gen_mask))
|| ||
(dgen > (pcb->segment_vector[page_index(a)] & gen_mask))){ (dgen > (pcb->segment_vector[page_index(a)] & gen_mask))){
pcb->dirty_vector[page_index(d)] = -1; ((int*)(long)pcb->dirty_vector)[page_index(d)] = -1;
} }
} }
} }
ik_ptr_page* next = src->next; ik_ptr_page* next = src->next;
ik_munmap((unsigned char*) src, sizeof(ik_ptr_page)); ik_munmap((ikptr)(long)src, sizeof(ik_ptr_page));
src = next; src = next;
} }
pcb->guardians_dropped[gen] = 0; pcb->guardians_dropped[gen] = 0;
@ -927,7 +927,9 @@ add_code_entry(gc_t* gc, ikptr entry){
ref(y, disp_code_reloc_vector) = reloc_vec; ref(y, disp_code_reloc_vector) = reloc_vec;
ref(y, disp_code_freevars) = freevars; ref(y, disp_code_freevars) = freevars;
ref(y, disp_code_annotation) = annotation; ref(y, disp_code_annotation) = annotation;
memcpy(y+disp_code_data, x+disp_code_data, code_size); memcpy((char*)(long)(y+disp_code_data),
(char*)(long)(x+disp_code_data),
code_size);
ref(x, 0) = forward_ptr; ref(x, 0) = forward_ptr;
ref(x, wordsize) = y + vector_tag; ref(x, wordsize) = y + vector_tag;
return y+disp_code_data; return y+disp_code_data;
@ -940,19 +942,19 @@ add_code_entry(gc_t* gc, ikptr entry){
static void collect_stack(gc_t* gc, ikptr top, ikptr end){ static void collect_stack(gc_t* gc, ikptr top, ikptr end){
if(DEBUG_STACK){ if(DEBUG_STACK){
fprintf(stderr, "collecting stack from 0x%016lx .. 0x%016lx\n", fprintf(stderr, "collecting stack from 0x%016lx .. 0x%016lx\n",
(long int) top, (long int) end); (long) top, (long) end);
} }
while(top < end){ while(top < end){
if(DEBUG_STACK){ if(DEBUG_STACK){
fprintf(stderr, "collecting frame at 0x%016lx: ", (long int) top); fprintf(stderr, "collecting frame at 0x%016lx: ", (long) top);
} }
ikptr rp = ref(top, 0); ikptr rp = ref(top, 0);
long int rp_offset = unfix(ref(rp, disp_frame_offset)); long int rp_offset = unfix(ref(rp, disp_frame_offset));
if(DEBUG_STACK){ if(DEBUG_STACK){
fprintf(stderr, "rp_offset=%ld\n", rp_offset); fprintf(stderr, "rp_offset=%ld\n", (long)rp_offset);
} }
if(rp_offset <= 0){ if(rp_offset <= 0){
fprintf(stderr, "invalid rp_offset %ld\n", rp_offset); fprintf(stderr, "invalid rp_offset %ld\n", (long)rp_offset);
exit(-1); exit(-1);
} }
/* since the return point is alive, we need to find the code /* since the return point is alive, we need to find the code
@ -999,18 +1001,18 @@ static void collect_stack(gc_t* gc, ikptr top, ikptr end){
* there is no live mask in this case, instead all values in the * there is no live mask in this case, instead all values in the
* frame are live. * frame are live.
*/ */
long int framesize = (long int) ref(rp, disp_frame_size); long int framesize = ref(rp, disp_frame_size);
if(DEBUG_STACK){ if(DEBUG_STACK){
fprintf(stderr, "fs=%ld\n", framesize); fprintf(stderr, "fs=%ld\n", (long)framesize);
} }
if(framesize < 0){ if(framesize < 0){
fprintf(stderr, "invalid frame size %ld\n", framesize); fprintf(stderr, "invalid frame size %ld\n", (long)framesize);
exit(-1); exit(-1);
} }
else if(framesize == 0){ else if(framesize == 0){
framesize = (long int)ref(top, wordsize); framesize = ref(top, wordsize);
if(framesize <= 0){ if(framesize <= 0){
fprintf(stderr, "invalid redirected framesize=%ld\n", framesize); fprintf(stderr, "invalid redirected framesize=%ld\n", (long)framesize);
exit(-1); exit(-1);
} }
ikptr base = top + framesize - wordsize; ikptr base = top + framesize - wordsize;
@ -1022,9 +1024,9 @@ static void collect_stack(gc_t* gc, ikptr top, ikptr end){
} else { } else {
long int frame_cells = framesize >> fx_shift; long int frame_cells = framesize >> fx_shift;
long int bytes_in_mask = (frame_cells+7) >> 3; long int bytes_in_mask = (frame_cells+7) >> 3;
char* mask = rp + disp_frame_size - bytes_in_mask; char* mask = (char*)(long)(rp+disp_frame_size-bytes_in_mask);
ikptr* fp = (ikptr*)(top + framesize); ikptr* fp = (ikptr*)(long)(top + framesize);
long int i; long int i;
for(i=0; i<bytes_in_mask; i++, fp-=8){ for(i=0; i<bytes_in_mask; i++, fp-=8){
unsigned char m = mask[i]; unsigned char m = mask[i];
@ -1084,7 +1086,7 @@ add_list(gc_t* gc, unsigned int t, ikptr x, ikptr* loc){
return; return;
} else { } else {
x = snd; x = snd;
loc = (ikptr*)(y + off_cdr); loc = (ikptr*)(long)(y + off_cdr);
/* don't return */ /* don't return */
} }
} }
@ -1158,15 +1160,18 @@ add_object_proc(gc_t* gc, ikptr x)
} }
#endif #endif
else if(tag == closure_tag){ else if(tag == closure_tag){
long int size = disp_closure_data+ ikptr size =
(long int) ref(fst, disp_code_freevars - disp_code_data); disp_closure_data +
ref(fst, disp_code_freevars - disp_code_data);
if(size > 1024){ if(size > 1024){
fprintf(stderr, "large closure size=0x%016lx\n", size); fprintf(stderr, "large closure size=0x%016lx\n", (long)size);
} }
long int asize = align(size); ikptr asize = align(size);
ikptr y = gc_alloc_new_ptr(asize, gc) + closure_tag; ikptr y = gc_alloc_new_ptr(asize, gc) + closure_tag;
ref(y, asize-closure_tag-wordsize) = 0; ref(y, asize-closure_tag-wordsize) = 0;
memcpy(y-closure_tag, x-closure_tag, size); memcpy((char*)(long)(y-closure_tag),
(char*)(long)(x-closure_tag),
size);
ref(y,-closure_tag) = add_code_entry(gc, ref(y,-closure_tag)); ref(y,-closure_tag) = add_code_entry(gc, ref(y,-closure_tag));
ref(x,-closure_tag) = forward_ptr; ref(x,-closure_tag) = forward_ptr;
ref(x,wordsize-closure_tag) = y; ref(x,wordsize-closure_tag) = y;
@ -1179,9 +1184,9 @@ add_object_proc(gc_t* gc, ikptr x)
if(is_fixnum(fst)){ if(is_fixnum(fst)){
/* real vector */ /* real vector */
//fprintf(stderr, "X=0x%08x, FST=0x%08x\n", (int)x, (int)fst); //fprintf(stderr, "X=0x%08x, FST=0x%08x\n", (int)x, (int)fst);
long int size = (long int)fst; ikptr size = fst;
assert(size >= 0); assert(size >= 0);
long int memreq = align(size + disp_vector_data); ikptr memreq = align(size + disp_vector_data);
if(memreq >= pagesize){ if(memreq >= pagesize){
if((t & large_object_mask) == large_object_tag){ if((t & large_object_mask) == large_object_tag){
enqueue_large_ptr(x-vector_tag, size+disp_vector_data, gc); enqueue_large_ptr(x-vector_tag, size+disp_vector_data, gc);
@ -1191,7 +1196,9 @@ add_object_proc(gc_t* gc, ikptr x)
+ vector_tag; + vector_tag;
ref(y, disp_vector_length-vector_tag) = fst; ref(y, disp_vector_length-vector_tag) = fst;
ref(y, memreq-vector_tag-wordsize) = 0; ref(y, memreq-vector_tag-wordsize) = 0;
memcpy(y+off_vector_data, x+off_vector_data, size); memcpy((char*)(long)(y+off_vector_data),
(char*)(long)(x+off_vector_data),
size);
ref(x,-vector_tag) = forward_ptr; ref(x,-vector_tag) = forward_ptr;
ref(x,wordsize-vector_tag) = y; ref(x,wordsize-vector_tag) = y;
return y; return y;
@ -1200,7 +1207,9 @@ add_object_proc(gc_t* gc, ikptr x)
ikptr y = gc_alloc_new_ptr(memreq, gc) + vector_tag; ikptr y = gc_alloc_new_ptr(memreq, gc) + vector_tag;
ref(y, disp_vector_length-vector_tag) = fst; ref(y, disp_vector_length-vector_tag) = fst;
ref(y, memreq-vector_tag-wordsize) = 0; ref(y, memreq-vector_tag-wordsize) = 0;
memcpy(y+off_vector_data, x+off_vector_data, size); memcpy((char*)(long)(y+off_vector_data),
(char*)(long)(x+off_vector_data),
size);
ref(x,-vector_tag) = forward_ptr; ref(x,-vector_tag) = forward_ptr;
ref(x,wordsize-vector_tag) = y; ref(x,wordsize-vector_tag) = y;
return y; return y;
@ -1223,7 +1232,7 @@ add_object_proc(gc_t* gc, ikptr x)
} }
else if(tagof(fst) == rtd_tag){ else if(tagof(fst) == rtd_tag){
/* struct / record */ /* struct / record */
long int size = (long int) ref(fst, off_rtd_length); ikptr size = ref(fst, off_rtd_length);
if(size & ((1<<align_shift)-1)) { if(size & ((1<<align_shift)-1)) {
/* size = n * object_alignment + 4 => /* size = n * object_alignment + 4 =>
memreq = n * object_alignment + 8 memreq = n * object_alignment + 8
@ -1231,7 +1240,7 @@ add_object_proc(gc_t* gc, ikptr x)
ikptr y = gc_alloc_new_ptr(size+wordsize, gc) + vector_tag; ikptr y = gc_alloc_new_ptr(size+wordsize, gc) + vector_tag;
ref(y, -vector_tag) = fst; ref(y, -vector_tag) = fst;
{ {
long int i; ikptr i;
ikptr p = y+disp_record_data-vector_tag; ikptr p = y+disp_record_data-vector_tag;
ikptr q = x+disp_record_data-vector_tag; ikptr q = x+disp_record_data-vector_tag;
ref(p, 0) = ref(q, 0); ref(p, 0) = ref(q, 0);
@ -1249,7 +1258,7 @@ add_object_proc(gc_t* gc, ikptr x)
ikptr y = gc_alloc_new_ptr(size+(2*wordsize), gc) + vector_tag; ikptr y = gc_alloc_new_ptr(size+(2*wordsize), gc) + vector_tag;
ref(y, -vector_tag) = fst; ref(y, -vector_tag) = fst;
{ {
long int i; ikptr i;
ikptr p = y+disp_record_data-vector_tag; ikptr p = y+disp_record_data-vector_tag;
ikptr q = x+disp_record_data-vector_tag; ikptr q = x+disp_record_data-vector_tag;
for(i=0; i<size; i+=(2*wordsize)){ for(i=0; i<size; i+=(2*wordsize)){
@ -1270,7 +1279,7 @@ add_object_proc(gc_t* gc, ikptr x)
} }
else if(fst == continuation_tag){ else if(fst == continuation_tag){
ikptr top = ref(x, off_continuation_top); ikptr top = ref(x, off_continuation_top);
long int size = (long int) ref(x, off_continuation_size); ikptr size = ref(x, off_continuation_size);
#ifndef NDEBUG #ifndef NDEBUG
if(size > 4096){ if(size > 4096){
fprintf(stderr, "large cont size=0x%08x\n", size); fprintf(stderr, "large cont size=0x%08x\n", size);
@ -1281,7 +1290,9 @@ add_object_proc(gc_t* gc, ikptr x)
ref(x, -vector_tag) = forward_ptr; ref(x, -vector_tag) = forward_ptr;
ref(x, wordsize-vector_tag) = y; ref(x, wordsize-vector_tag) = y;
ikptr new_top = gc_alloc_new_data(align(size), gc); ikptr new_top = gc_alloc_new_data(align(size), gc);
memcpy(new_top, top, size); memcpy((char*)(long)new_top,
(char*)(long)top,
size);
collect_stack(gc, new_top, new_top + size); collect_stack(gc, new_top, new_top + size);
ref(y, -vector_tag) = continuation_tag; ref(y, -vector_tag) = continuation_tag;
ref(y, off_continuation_top) = new_top; ref(y, off_continuation_top) = new_top;
@ -1314,7 +1325,7 @@ add_object_proc(gc_t* gc, ikptr x)
else if((((long int)fst) & port_mask) == port_tag){ else if((((long int)fst) & port_mask) == port_tag){
ikptr y = gc_alloc_new_ptr(port_size, gc) + vector_tag; ikptr y = gc_alloc_new_ptr(port_size, gc) + vector_tag;
ref(y, -vector_tag) = fst; ref(y, -vector_tag) = fst;
int i; long int i;
for(i=wordsize; i<port_size; i+=wordsize){ for(i=wordsize; i<port_size; i+=wordsize){
ref(y, i-vector_tag) = ref(x, i-vector_tag); ref(y, i-vector_tag) = ref(x, i-vector_tag);
} }
@ -1330,11 +1341,13 @@ add_object_proc(gc_t* gc, ikptr x)
ref(x, wordsize-vector_tag) = new; ref(x, wordsize-vector_tag) = new;
return new; return new;
} }
else if((((long int)fst) & bignum_mask) == bignum_tag){ else if((fst & bignum_mask) == bignum_tag){
long int len = ((unsigned long int)fst) >> bignum_length_shift; long int len = ((unsigned long int)fst) >> bignum_length_shift;
long int memreq = align(disp_bignum_data + len*wordsize); long int memreq = align(disp_bignum_data + len*wordsize);
ikptr new = gc_alloc_new_data(memreq, gc) + vector_tag; ikptr new = gc_alloc_new_data(memreq, gc) + vector_tag;
memcpy(new-vector_tag, x-vector_tag, memreq); memcpy((char*)(long)(new-vector_tag),
(char*)(long)(x-vector_tag),
memreq);
ref(x, -vector_tag) = forward_ptr; ref(x, -vector_tag) = forward_ptr;
ref(x, wordsize-vector_tag) = new; ref(x, wordsize-vector_tag) = new;
return new; return new;
@ -1363,8 +1376,8 @@ add_object_proc(gc_t* gc, ikptr x)
long int memreq = align(strlen*string_char_size + disp_string_data); long int memreq = align(strlen*string_char_size + disp_string_data);
ikptr new_str = gc_alloc_new_data(memreq, gc) + string_tag; ikptr new_str = gc_alloc_new_data(memreq, gc) + string_tag;
ref(new_str, off_string_length) = fst; ref(new_str, off_string_length) = fst;
memcpy(new_str+off_string_data, memcpy((char*)(long)(new_str+off_string_data),
x + off_string_data, (char*)(long)(x + off_string_data),
strlen*string_char_size); strlen*string_char_size);
ref(x, -string_tag) = forward_ptr; ref(x, -string_tag) = forward_ptr;
ref(x, wordsize-string_tag) = new_str; ref(x, wordsize-string_tag) = new_str;
@ -1384,8 +1397,8 @@ add_object_proc(gc_t* gc, ikptr x)
long int memreq = align(len + disp_bytevector_data + 1); long int memreq = align(len + disp_bytevector_data + 1);
ikptr new_bv = gc_alloc_new_data(memreq, gc) + bytevector_tag; ikptr new_bv = gc_alloc_new_data(memreq, gc) + bytevector_tag;
ref(new_bv, off_bytevector_length) = fst; ref(new_bv, off_bytevector_length) = fst;
memcpy(new_bv+off_bytevector_data, memcpy((char*)(long)(new_bv+off_bytevector_data),
x + off_bytevector_data, (char*)(long)(x + off_bytevector_data),
len + 1); len + 1);
ref(x, -bytevector_tag) = forward_ptr; ref(x, -bytevector_tag) = forward_ptr;
ref(x, wordsize-bytevector_tag) = new_bv; ref(x, wordsize-bytevector_tag) = new_bv;
@ -1402,7 +1415,7 @@ relocate_new_code(ikptr x, gc_t* gc){
ref(x, disp_code_reloc_vector) = relocvector; ref(x, disp_code_reloc_vector) = relocvector;
ref(x, disp_code_annotation) = ref(x, disp_code_annotation) =
add_object(gc, ref(x, disp_code_annotation), "annotation"); add_object(gc, ref(x, disp_code_annotation), "annotation");
long int relocsize = (long int)ref(relocvector, off_vector_length); ikptr relocsize = ref(relocvector, off_vector_length);
ikptr p = relocvector + off_vector_data; ikptr p = relocvector + off_vector_data;
ikptr q = p + relocsize; ikptr q = p + relocsize;
ikptr code = x + disp_code_data; ikptr code = x + disp_code_data;
@ -1723,8 +1736,8 @@ static unsigned int cleanup_mask[generation_count] = {
static void static void
scan_dirty_pointers_page(gc_t* gc, long int page_idx, int mask){ scan_dirty_pointers_page(gc_t* gc, long int page_idx, int mask){
unsigned int* segment_vec = gc->segment_vector; unsigned int* segment_vec = (unsigned int*)(long)gc->segment_vector;
unsigned int* dirty_vec = gc->pcb->dirty_vector; unsigned int* dirty_vec = (unsigned int*)(long)gc->pcb->dirty_vector;
unsigned int t = segment_vec[page_idx]; unsigned int t = segment_vec[page_idx];
unsigned int d = dirty_vec[page_idx]; unsigned int d = dirty_vec[page_idx];
unsigned int masked_d = d & mask; unsigned int masked_d = d & mask;
@ -1755,7 +1768,7 @@ scan_dirty_pointers_page(gc_t* gc, long int page_idx, int mask){
new_d = new_d | (d & (0xF << (j*meta_dirty_shift))); new_d = new_d | (d & (0xF << (j*meta_dirty_shift)));
} }
} }
dirty_vec = gc->pcb->dirty_vector; dirty_vec = (unsigned int*)(long)gc->pcb->dirty_vector;
new_d = new_d & cleanup_mask[t & gen_mask]; new_d = new_d & cleanup_mask[t & gen_mask];
dirty_vec[page_idx] = new_d; dirty_vec[page_idx] = new_d;
} }
@ -1765,8 +1778,8 @@ scan_dirty_code_page(gc_t* gc, long int page_idx, unsigned int mask){
ikptr p = (ikptr)(page_idx << pageshift); ikptr p = (ikptr)(page_idx << pageshift);
ikptr start = p; ikptr start = p;
ikptr q = p + pagesize; ikptr q = p + pagesize;
unsigned int* segment_vec = gc->segment_vector; unsigned int* segment_vec = (unsigned int*)(long)gc->segment_vector;
unsigned int* dirty_vec = gc->pcb->dirty_vector; unsigned int* dirty_vec = (unsigned int*)(long)gc->pcb->dirty_vector;
//unsigned int d = dirty_vec[page_idx]; //unsigned int d = dirty_vec[page_idx];
unsigned int t = segment_vec[page_idx]; unsigned int t = segment_vec[page_idx];
//unsigned int masked_d = d & mask; //unsigned int masked_d = d & mask;
@ -1781,7 +1794,7 @@ scan_dirty_code_page(gc_t* gc, long int page_idx, unsigned int mask){
relocate_new_code(p, gc); relocate_new_code(p, gc);
segment_vec = gc->segment_vector; segment_vec = gc->segment_vector;
ikptr rvec = ref(p, disp_code_reloc_vector); ikptr rvec = ref(p, disp_code_reloc_vector);
long int len = (long int)ref(rvec, off_vector_length); ikptr len = ref(rvec, off_vector_length);
assert(len >= 0); assert(len >= 0);
long int i; long int i;
unsigned long int code_d = segment_vec[page_index(rvec)]; unsigned long int code_d = segment_vec[page_index(rvec)];
@ -1799,7 +1812,7 @@ scan_dirty_code_page(gc_t* gc, long int page_idx, unsigned int mask){
p += align(code_size + disp_code_data); p += align(code_size + disp_code_data);
} }
} }
dirty_vec = gc->pcb->dirty_vector; dirty_vec = (unsigned int*)(long)gc->pcb->dirty_vector;
new_d = new_d & cleanup_mask[t & gen_mask]; new_d = new_d & cleanup_mask[t & gen_mask];
dirty_vec[page_idx] = new_d; dirty_vec[page_idx] = new_d;
} }
@ -1811,13 +1824,13 @@ scan_dirty_code_page(gc_t* gc, long int page_idx, unsigned int mask){
static void static void
scan_dirty_pages(gc_t* gc){ scan_dirty_pages(gc_t* gc){
ikpcb* pcb = gc->pcb; ikpcb* pcb = gc->pcb;
int lo_idx = page_index(pcb->memory_base); long int lo_idx = page_index(pcb->memory_base);
int hi_idx = page_index(pcb->memory_end); long int hi_idx = page_index(pcb->memory_end);
unsigned int* dirty_vec = pcb->dirty_vector; unsigned int* dirty_vec = (unsigned int*)(long)pcb->dirty_vector;
unsigned int* segment_vec = pcb->segment_vector; unsigned int* segment_vec = (unsigned int*)(long)pcb->segment_vector;
int collect_gen = gc->collect_gen; int collect_gen = gc->collect_gen;
unsigned int mask = dirty_mask[collect_gen]; unsigned int mask = dirty_mask[collect_gen];
int i = lo_idx; long int i = lo_idx;
while(i < hi_idx){ while(i < hi_idx){
unsigned int d = dirty_vec[i]; unsigned int d = dirty_vec[i];
if(d & mask){ if(d & mask){
@ -1826,24 +1839,24 @@ scan_dirty_pages(gc_t* gc){
int type = t & type_mask; int type = t & type_mask;
if(type == pointers_type){ if(type == pointers_type){
scan_dirty_pointers_page(gc, i, mask); scan_dirty_pointers_page(gc, i, mask);
dirty_vec = pcb->dirty_vector; dirty_vec = (unsigned int*)(long)pcb->dirty_vector;
segment_vec = pcb->segment_vector; segment_vec = (unsigned int*)(long)pcb->segment_vector;
} }
else if(type == symbols_type){ else if(type == symbols_type){
scan_dirty_pointers_page(gc, i, mask); scan_dirty_pointers_page(gc, i, mask);
dirty_vec = pcb->dirty_vector; dirty_vec = (unsigned int*)(long)pcb->dirty_vector;
segment_vec = pcb->segment_vector; segment_vec = (unsigned int*)(long)pcb->segment_vector;
} }
else if (type == weak_pairs_type){ else if (type == weak_pairs_type){
scan_dirty_pointers_page(gc, i, mask); scan_dirty_pointers_page(gc, i, mask);
dirty_vec = pcb->dirty_vector; dirty_vec = (unsigned int*)(long)pcb->dirty_vector;
segment_vec = pcb->segment_vector; segment_vec = (unsigned int*)(long)pcb->segment_vector;
} }
else if (type == code_type){ else if (type == code_type){
if((t & gen_mask) > collect_gen){ if((t & gen_mask) > collect_gen){
scan_dirty_code_page(gc, i, mask); scan_dirty_code_page(gc, i, mask);
dirty_vec = pcb->dirty_vector; dirty_vec = (unsigned int*)(long)pcb->dirty_vector;
segment_vec = pcb->segment_vector; segment_vec = (unsigned int*)(long)pcb->segment_vector;
} }
} }
else if (t & scannable_mask) { else if (t & scannable_mask) {
@ -1864,11 +1877,11 @@ deallocate_unused_pages(gc_t* gc){
ikpcb* pcb = gc->pcb; ikpcb* pcb = gc->pcb;
int collect_gen = gc->collect_gen; int collect_gen = gc->collect_gen;
unsigned int* segment_vec = pcb->segment_vector; unsigned int* segment_vec = pcb->segment_vector;
char* memory_base = pcb->memory_base; ikptr memory_base = pcb->memory_base;
char* memory_end = pcb->memory_end; ikptr memory_end = pcb->memory_end;
long int lo_idx = page_index(memory_base); ikptr lo_idx = page_index(memory_base);
long int hi_idx = page_index(memory_end); ikptr hi_idx = page_index(memory_end);
long int i = lo_idx; ikptr i = lo_idx;
while(i < hi_idx){ while(i < hi_idx){
unsigned int t = segment_vec[i]; unsigned int t = segment_vec[i];
if(t & dealloc_mask){ if(t & dealloc_mask){
@ -1878,7 +1891,7 @@ deallocate_unused_pages(gc_t* gc){
if(t & new_gen_mask){ if(t & new_gen_mask){
/* do nothing yet */ /* do nothing yet */
} else { } else {
ik_munmap_from_segment((char*)(i<<pageshift),pagesize,pcb); ik_munmap_from_segment((ikptr)(i<<pageshift),pagesize,pcb);
} }
} }
} }
@ -1891,11 +1904,11 @@ static void
fix_new_pages(gc_t* gc){ fix_new_pages(gc_t* gc){
ikpcb* pcb = gc->pcb; ikpcb* pcb = gc->pcb;
unsigned int* segment_vec = pcb->segment_vector; unsigned int* segment_vec = pcb->segment_vector;
char* memory_base = pcb->memory_base; ikptr memory_base = pcb->memory_base;
char* memory_end = pcb->memory_end; ikptr memory_end = pcb->memory_end;
int lo_idx = page_index(memory_base); ikptr lo_idx = page_index(memory_base);
int hi_idx = page_index(memory_end); ikptr hi_idx = page_index(memory_end);
int i = lo_idx; ikptr i = lo_idx;
while(i < hi_idx){ while(i < hi_idx){
segment_vec[i] &= ~new_gen_mask; segment_vec[i] &= ~new_gen_mask;
/* /*
@ -1922,8 +1935,8 @@ add_one_tconc(ikpcb* pcb, ikptr p){
ref(new_pair, off_cdr) = false_object; ref(new_pair, off_cdr) = false_object;
ref(tc, off_cdr) = new_pair; ref(tc, off_cdr) = new_pair;
ref(tcbucket, -vector_tag) = (ikptr)(tcbucket_size - wordsize); ref(tcbucket, -vector_tag) = (ikptr)(tcbucket_size - wordsize);
pcb->dirty_vector[page_index(tc)] = -1; ((int*)(long)pcb->dirty_vector)[page_index(tc)] = -1;
pcb->dirty_vector[page_index(d)] = -1; ((int*)(long)pcb->dirty_vector)[page_index(d)] = -1;
} }
static void static void

39
src/ikarus-data.h
View File

@ -91,7 +91,8 @@ inthash(int key) {
#define pagesize 4096 #define pagesize 4096
#define generation_count 5 /* generations 0 (nursery), 1, 2, 3, 4 */ #define generation_count 5 /* generations 0 (nursery), 1, 2, 3, 4 */
typedef char* ikptr; typedef unsigned int ikptr;
typedef int ikchar; typedef int ikchar;
void ik_error(ikptr args); void ik_error(ikptr args);
@ -132,11 +133,11 @@ typedef struct ikpcb{
ikptr frame_base; /* offset = 12 */ ikptr frame_base; /* offset = 12 */
ikptr frame_redline; /* offset = 16 */ ikptr frame_redline; /* offset = 16 */
ikptr next_k; /* offset = 20 */ ikptr next_k; /* offset = 20 */
void* system_stack; /* offset = 24 */ ikptr system_stack; /* offset = 24 */
unsigned int* dirty_vector; /* offset = 28 */ ikptr dirty_vector; /* offset = 28 */
ikptr arg_list; /* offset = 32 */ ikptr arg_list; /* offset = 32 */
int engine_counter; /* offset = 36 */ int engine_counter; /* offset = 36 */
int interrupted; /* offset = 40 */ int interrupted; /* offset = 40 */
ikptr base_rtd; /* offset = 44 */ ikptr base_rtd; /* offset = 44 */
ikptr collect_key; /* offset = 48 */ ikptr collect_key; /* offset = 48 */
/* the rest are not used by any scheme code */ /* the rest are not used by any scheme code */
@ -161,8 +162,8 @@ typedef struct ikpcb{
ik_ptr_page* guardians_dropped[generation_count]; ik_ptr_page* guardians_dropped[generation_count];
unsigned int* dirty_vector_base; unsigned int* dirty_vector_base;
unsigned int* segment_vector_base; unsigned int* segment_vector_base;
char* memory_base; ikptr memory_base;
char* memory_end; ikptr memory_end;
int collection_id; int collection_id;
int allocation_count_minor; int allocation_count_minor;
int allocation_count_major; int allocation_count_major;
@ -177,14 +178,14 @@ void ikarus_usage_short(void);
void* ik_malloc(int); void* ik_malloc(int);
void ik_free(void*, int); void ik_free(void*, int);
void* ik_mmap(int); ikptr ik_mmap(int);
void* ik_mmap_typed(int size, unsigned int type, ikpcb*); ikptr ik_mmap_typed(int size, unsigned int type, ikpcb*);
void* ik_mmap_ptr(int size, int gen, ikpcb*); ikptr ik_mmap_ptr(int size, int gen, ikpcb*);
void* ik_mmap_data(int size, int gen, ikpcb*); ikptr ik_mmap_data(int size, int gen, ikpcb*);
void* ik_mmap_code(int size, int gen, ikpcb*); ikptr ik_mmap_code(int size, int gen, ikpcb*);
void* ik_mmap_mixed(int size, ikpcb*); ikptr ik_mmap_mixed(int size, ikpcb*);
void ik_munmap(void*, int); void ik_munmap(ikptr, int);
void ik_munmap_from_segment(char*, int, ikpcb*); void ik_munmap_from_segment(ikptr, int, ikpcb*);
ikpcb* ik_make_pcb(); ikpcb* ik_make_pcb();
void ik_delete_pcb(ikpcb*); void ik_delete_pcb(ikpcb*);
void ik_free_symbol_table(ikpcb* pcb); void ik_free_symbol_table(ikpcb* pcb);
@ -241,17 +242,17 @@ ikptr ik_safe_alloc(ikpcb* pcb, int size);
#define fx_mask 3 #define fx_mask 3
#define unfix(x) (((long int)(x)) >> fx_shift) #define unfix(x) (((long int)(x)) >> fx_shift)
#define fix(x) ((ikptr)(((long int)(x)) << fx_shift)) #define fix(x) ((ikptr)(((long int)(x)) << fx_shift))
#define is_fixnum(x) ((((long int)(x)) & fx_mask) == 0) #define is_fixnum(x) ((((unsigned long)(x)) & fx_mask) == 0)
#define IK_FIXNUMP(x) \ #define IK_FIXNUMP(x) \
((((int)(x)) & IK_FX_MASK) == 0) ((((int)(x)) & IK_FX_MASK) == 0)
#define ref(x,n) \ #define ref(x,n) \
(((ikptr*)(((char*)(x)) + ((long int)(n))))[0]) (((ikptr*)(((char*)(long int)(x)) + ((long int)(n))))[0])
#define IK_MASK(x,m) (((long int)(x)) & ((long int)(m))) #define IK_MASK(x,m) (((long int)(x)) & ((long int)(m)))
#define IK_PTAG(x) (((int)(x)) & 7) #define IK_PTAG(x) (((int)(x)) & 7)
#define tagof(x) (((long int)(x)) & 7) #define tagof(x) (((int)(x)) & 7)
#define IK_STAG(x) REF(x, -IK_PTAG(x)) #define IK_STAG(x) REF(x, -IK_PTAG(x))
#define immediate_tag 7 #define immediate_tag 7
@ -443,7 +444,7 @@ ikptr ik_safe_alloc(ikpcb* pcb, int size);
#define flonum_size 16 #define flonum_size 16
#define disp_flonum_data 8 #define disp_flonum_data 8
#define off_flonum_data (disp_flonum_data - vector_tag) #define off_flonum_data (disp_flonum_data - vector_tag)
#define flonum_data(x) (*((double*)(((ikptr)(x))+off_flonum_data))) #define flonum_data(x) (*((double*)(((char*)(long)(x))+off_flonum_data)))
#define ratnum_tag ((ikptr) 0x27) #define ratnum_tag ((ikptr) 0x27)
#define ratnum_size 16 #define ratnum_size 16

23
src/ikarus-enter.s
View File

@ -35,7 +35,7 @@ _ik_asm_enter:
movl 0(%esi), %ebp # allocation pointer is at 0(pcb) movl 0(%esi), %ebp # allocation pointer is at 0(pcb)
movl %esp, %eax movl %esp, %eax
subl $16, %esp # 24 for alignment subl $16, %esp # 24 for alignment
set_stack: # set_stack:
movl %esp, 24(%esi) # save esp in pcb->system_stack movl %esp, 24(%esi) # save esp in pcb->system_stack
movl 8(%esi), %esp # load scheme stack from pcb->frame_pinter movl 8(%esi), %esp # load scheme stack from pcb->frame_pinter
jmp L_call jmp L_call
@ -47,7 +47,11 @@ set_stack:
.byte 0 .byte 0
.byte 0 .byte 0
.byte 0 .byte 0
.long L_multivalue_underflow #ifdef __x86_64__
.long 0 # FIXME
#else
.long L_multivalue_underflow
#endif
.byte 0 .byte 0
.byte 0 .byte 0
L_call: L_call:
@ -123,20 +127,29 @@ L_two:
L_one: L_one:
push $0 push $0
L_zero: L_zero:
# push %rsi # (pushl pcr) #if __x86_64__
push %rsi # (pushl pcr)
#else
push %esi # (pushl pcr) push %esi # (pushl pcr)
#endif
cmpl $0, %eax # (cmpl (int 0) eax) cmpl $0, %eax # (cmpl (int 0) eax)
je L_set # (je (label Lset)) je L_set # (je (label Lset))
L_loop: # (label Lloop) L_loop: # (label Lloop)
movl (%ebx,%eax), %ecx # (movl (mem ebx eax) ecx) movl (%ebx,%eax), %ecx # (movl (mem ebx eax) ecx)
# push %rcx # (pushl ecx) #if __x86_64__
push %rcx # (pushl ecx)
#else
push %ecx # (pushl ecx) push %ecx # (pushl ecx)
#endif
addl $4, %eax # (addl (int 4) eax) addl $4, %eax # (addl (int 4) eax)
cmpl $0, %eax # (cmpl (int 0) eax) cmpl $0, %eax # (cmpl (int 0) eax)
jne L_loop # (jne (label Lloop)) jne L_loop # (jne (label Lloop))
L_set: # (label Lset) L_set: # (label Lset)
# call *%rdi # (call cpr) #if __x86_64__
call *%rdi # (call cpr)
#else
call *%edi # (call cpr) call *%edi # (call cpr)
#endif
movl 8(%esi), %esp # (movl (pcb-ref 'frame-pointer) fpr) movl 8(%esi), %esp # (movl (pcb-ref 'frame-pointer) fpr)
movl 0(%esi), %ebp # (movl (pcb-ref 'allocation-pointer) apr) movl 0(%esi), %ebp # (movl (pcb-ref 'allocation-pointer) apr)
ret # (ret))) ret # (ret)))

16
src/ikarus-exec.c
View File

@ -34,7 +34,7 @@ ikptr ik_exec_code(ikpcb* pcb, ikptr code_ptr){
ikptr argc = ik_asm_enter(pcb, code_ptr+off_code_data,0); ikptr argc = ik_asm_enter(pcb, code_ptr+off_code_data,0);
ikptr next_k = pcb->next_k; ikptr next_k = pcb->next_k;
while(next_k){ while(next_k){
cont* k = (cont*)(next_k - vector_tag); cont* k = (cont*)(long)(next_k - vector_tag);
ikptr top = k->top; ikptr top = k->top;
ikptr rp = ref(top, 0); ikptr rp = ref(top, 0);
long int framesize = (long int) ref(rp, disp_frame_size); long int framesize = (long int) ref(rp, disp_frame_size);
@ -43,24 +43,24 @@ ikptr ik_exec_code(ikpcb* pcb, ikptr code_ptr){
exit(-1); exit(-1);
} }
if(framesize < k->size){ if(framesize < k->size){
cont* nk = (cont*) ik_unsafe_alloc(pcb, sizeof(cont)); cont* nk = (cont*)(long)ik_unsafe_alloc(pcb, sizeof(cont));
nk->tag = k->tag; nk->tag = k->tag;
nk->next = k->next; nk->next = k->next;
nk->top = top + framesize; nk->top = top + framesize;
nk->size = k->size - framesize; nk->size = k->size - framesize;
k->size = framesize; k->size = framesize;
k->next = vector_tag + (ikptr)nk; k->next = vector_tag + (ikptr)(long)nk;
/* record side effect */ /* record side effect */
unsigned long int idx = ((unsigned long int)(&k->next)) >> pageshift; unsigned long int idx = ((unsigned long int)(&k->next)) >> pageshift;
pcb->dirty_vector[idx] = -1; ((unsigned int*)(long)(pcb->dirty_vector))[idx] = -1;
} }
pcb->next_k = k->next; pcb->next_k = k->next;
ikptr fbase = pcb->frame_base - wordsize; ikptr fbase = pcb->frame_base - wordsize;
ikptr new_fbase = fbase - framesize; ikptr new_fbase = fbase - framesize;
memmove(new_fbase + (long int)argc, memmove((char*)new_fbase + argc,
fbase + (long int)argc, (char*)fbase + argc,
-(long int)argc); -argc);
memcpy(new_fbase, top, framesize); memcpy((char*)new_fbase, (char*)top, framesize);
argc = ik_asm_reenter(pcb, new_fbase, argc); argc = ik_asm_reenter(pcb, new_fbase, argc);
next_k = pcb->next_k; next_k = pcb->next_k;
} }

28
src/ikarus-fasl.c
View File

@ -98,7 +98,7 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
p.code_ep = 0; p.code_ep = 0;
ikptr v = ik_fasl_read(pcb, &p); ikptr v = ik_fasl_read(pcb, &p);
if(p.marks_size){ if(p.marks_size){
ik_munmap((unsigned char*) p.marks, p.marks_size*sizeof(ikptr*)); ik_munmap((ikptr) p.marks, p.marks_size*sizeof(ikptr*));
p.marks = 0; p.marks = 0;
p.marks_size = 0; p.marks_size = 0;
} }
@ -159,7 +159,7 @@ ik_relocate_code(ikptr code){
ikptr size = ref(vec, off_vector_length); ikptr size = ref(vec, off_vector_length);
ikptr data = code + disp_code_data; ikptr data = code + disp_code_data;
ikptr p = vec + off_vector_data; ikptr p = vec + off_vector_data;
ikptr q = p + (long int)size; ikptr q = p + size;
while(p < q){ while(p < q){
long int r = unfix(ref(p, 0)); long int r = unfix(ref(p, 0));
if(r == 0){ if(r == 0){
@ -207,7 +207,7 @@ ik_relocate_code(ikptr code){
fprintf(stderr, "failed to find foreign name %s: %s\n", name, err); fprintf(stderr, "failed to find foreign name %s: %s\n", name, err);
exit(-1); exit(-1);
} }
ref(data,code_off) = sym; ref(data,code_off) = (ikptr)sym;
p += (2*wordsize); p += (2*wordsize);
} }
else { else {
@ -289,7 +289,7 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
ref(code, disp_code_code_size) = fix(code_size); ref(code, disp_code_code_size) = fix(code_size);
ref(code, disp_code_freevars) = freevars; ref(code, disp_code_freevars) = freevars;
ref(code, disp_code_annotation) = annotation; ref(code, disp_code_annotation) = annotation;
fasl_read_buf(p, code+disp_code_data, code_size); fasl_read_buf(p, (void*)code+disp_code_data, code_size);
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = code+vector_tag; p->marks[put_mark_index] = code+vector_tag;
} }
@ -322,10 +322,10 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
int size = align(len*string_char_size + disp_string_data); int size = align(len*string_char_size + disp_string_data);
ikptr str = ik_unsafe_alloc(pcb, size) + string_tag; ikptr str = ik_unsafe_alloc(pcb, size) + string_tag;
ref(str, off_string_length) = fix(len); ref(str, off_string_length) = fix(len);
fasl_read_buf(p, str+off_string_data, len); fasl_read_buf(p, (char*)str+off_string_data, len);
{ {
unsigned char* pi = (unsigned char*) (str+off_string_data); unsigned char* pi = (unsigned char*)(long)(str+off_string_data);
ikchar* pj = (ikchar*) (str+off_string_data); ikchar* pj = (ikchar*)(long)(str+off_string_data);
int i = len-1; int i = len-1;
for(i=len-1; i >= 0; i--){ for(i=len-1; i >= 0; i--){
pj[i] = integer_to_char(pi[i]); pj[i] = integer_to_char(pi[i]);
@ -339,8 +339,8 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
} }
else if(c == 'S'){ else if(c == 'S'){
/* string */ /* string */
long int len; int len;
fasl_read_buf(p, &len, sizeof(long int)); fasl_read_buf(p, &len, sizeof(int));
int size = align(len*string_char_size + disp_string_data); int size = align(len*string_char_size + disp_string_data);
ikptr str = ik_unsafe_alloc(pcb, size) + string_tag; ikptr str = ik_unsafe_alloc(pcb, size) + string_tag;
ref(str, off_string_length) = fix(len); ref(str, off_string_length) = fix(len);
@ -432,7 +432,7 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
ref(rtd, off_rtd_printer) = false_object; ref(rtd, off_rtd_printer) = false_object;
ref(rtd, off_rtd_symbol) = symb; ref(rtd, off_rtd_symbol) = symb;
ref(symb, off_symbol_record_value) = rtd; ref(symb, off_symbol_record_value) = rtd;
pcb->dirty_vector[page_index(symb+off_symbol_record_value)] = -1; ((unsigned char*)(long)pcb->dirty_vector)[page_index(symb+off_symbol_record_value)] = -1;
} else { } else {
rtd = gensym_val; rtd = gensym_val;
} }
@ -476,8 +476,8 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
int size = align(len + disp_bytevector_data + 1); int size = align(len + disp_bytevector_data + 1);
ikptr x = ik_unsafe_alloc(pcb, size) + bytevector_tag; ikptr x = ik_unsafe_alloc(pcb, size) + bytevector_tag;
ref(x, off_bytevector_length) = fix(len); ref(x, off_bytevector_length) = fix(len);
fasl_read_buf(p, x+off_bytevector_data, len); fasl_read_buf(p, (void*)(long)(x+off_bytevector_data), len);
x[off_bytevector_data+len] = 0; ((char*)(long)x)[off_bytevector_data+len] = 0;
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = x; p->marks[put_mark_index] = x;
} }
@ -527,7 +527,7 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
else if(c == 'f'){ else if(c == 'f'){
ikptr x = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr x = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(x, -vector_tag) = flonum_tag; ref(x, -vector_tag) = flonum_tag;
fasl_read_buf(p, x+disp_flonum_data-vector_tag, 8); fasl_read_buf(p, (void*)(long)(x+disp_flonum_data-vector_tag), 8);
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = x; p->marks[put_mark_index] = x;
} }
@ -554,7 +554,7 @@ static ikptr do_read(ikpcb* pcb, fasl_port* p){
((len >> 2) << bignum_length_shift); ((len >> 2) << bignum_length_shift);
ikptr x = ik_unsafe_alloc(pcb, align(len + disp_bignum_data)) + vector_tag; ikptr x = ik_unsafe_alloc(pcb, align(len + disp_bignum_data)) + vector_tag;
ref(x, -vector_tag) = (ikptr) tag; ref(x, -vector_tag) = (ikptr) tag;
fasl_read_buf(p, x+off_bignum_data, len); fasl_read_buf(p, (void*)(long)(x+off_bignum_data), len);
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = x; p->marks[put_mark_index] = x;
} }

12
src/ikarus-io.c
View File

@ -51,7 +51,7 @@ ikrt_close_fd(ikptr fd, ikpcb* pcb){
ikptr ikptr
ikrt_open_input_fd(ikptr fn, ikpcb* pcb){ ikrt_open_input_fd(ikptr fn, ikpcb* pcb){
int fh = open((char*)(fn+off_bytevector_data), O_RDONLY, 0); int fh = open((char*)(long)(fn+off_bytevector_data), O_RDONLY, 0);
if(fh > 0){ if(fh > 0){
return fix(fh); return fix(fh);
} else { } else {
@ -77,7 +77,7 @@ ikrt_open_output_fd(ikptr fn, ikptr ikopts, ikpcb* pcb){
case 6: mode = O_WRONLY | O_CREAT ; break; case 6: mode = O_WRONLY | O_CREAT ; break;
case 7: mode = O_WRONLY ; break; case 7: mode = O_WRONLY ; break;
} }
int fh = open((char*)(fn+off_bytevector_data), int fh = open((char*)(long)(fn+off_bytevector_data),
mode, mode,
S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH); S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH);
if(fh > 0){ if(fh > 0){
@ -93,7 +93,7 @@ ikptr
ikrt_read_fd(ikptr fd, ikptr bv, ikptr off, ikptr cnt, ikpcb* pcb){ ikrt_read_fd(ikptr fd, ikptr bv, ikptr off, ikptr cnt, ikpcb* pcb){
ssize_t bytes = ssize_t bytes =
read(unfix(fd), read(unfix(fd),
(char*)(bv+off_bytevector_data+unfix(off)), (char*)(long)(bv+off_bytevector_data+unfix(off)),
unfix(cnt)); unfix(cnt));
if(bytes >= 0){ if(bytes >= 0){
return fix(bytes); return fix(bytes);
@ -106,7 +106,7 @@ ikptr
ikrt_write_fd(ikptr fd, ikptr bv, ikptr off, ikptr cnt, ikpcb* pcb){ ikrt_write_fd(ikptr fd, ikptr bv, ikptr off, ikptr cnt, ikpcb* pcb){
ssize_t bytes = ssize_t bytes =
write(unfix(fd), write(unfix(fd),
(char*)(bv+off_bytevector_data+unfix(off)), (char*)(long)(bv+off_bytevector_data+unfix(off)),
unfix(cnt)); unfix(cnt));
if(bytes >= 0){ if(bytes >= 0){
return fix(bytes); return fix(bytes);
@ -120,8 +120,8 @@ ikrt_write_fd(ikptr fd, ikptr bv, ikptr off, ikptr cnt, ikpcb* pcb){
ikptr ikptr
ikrt_tcp_connect(ikptr host, ikptr srvc, ikpcb* pcb){ ikrt_tcp_connect(ikptr host, ikptr srvc, ikpcb* pcb){
struct addrinfo* info; struct addrinfo* info;
int err = getaddrinfo(host+off_bytevector_data, int err = getaddrinfo((char*)(long)(host+off_bytevector_data),
srvc+off_bytevector_data, (char*)(long)(srvc+off_bytevector_data),
0, 0,
&info); &info);
if(err){ if(err){

4
src/ikarus-main.c
View File

@ -147,11 +147,11 @@ int main(int argc, char** argv){
} else { } else {
boot_file = BOOTFILE; boot_file = BOOTFILE;
} }
if(sizeof(mp_limb_t) != sizeof(int)){ if(sizeof(mp_limb_t) != sizeof(long int)){
fprintf(stderr, "ERROR: limb size does not match\n"); fprintf(stderr, "ERROR: limb size does not match\n");
exit(-1); exit(-1);
} }
if(mp_bits_per_limb != (8*sizeof(int))){ if(mp_bits_per_limb != (8*sizeof(long int))){
fprintf(stderr, "ERROR: invalid bits_per_limb=%d\n", mp_bits_per_limb); fprintf(stderr, "ERROR: invalid bits_per_limb=%d\n", mp_bits_per_limb);
exit(-1); exit(-1);
} }

28
src/ikarus-numerics.c
View File

@ -44,21 +44,21 @@ verify_bignum(ikptr x, char* caller){
exit(-1); exit(-1);
} }
ikptr fst = ref(x, -vector_tag); ikptr fst = ref(x, -vector_tag);
int limb_count = ((unsigned int) fst) >> bignum_length_shift; long int limb_count = ((unsigned long int) fst) >> bignum_length_shift;
if(limb_count <= 0){ if(limb_count <= 0){
fprintf(stderr, fprintf(stderr,
"Error in (%s) invalid limb count in fst=0x%08x\n", "Error in (%s) invalid limb count in fst=0x%08x\n",
caller, (int)fst); caller, (long int)fst);
exit(-1); exit(-1);
} }
int pos; int pos;
if((int)fst & bignum_sign_mask){ if((long int)fst & bignum_sign_mask){
pos = 0; pos = 0;
} else { } else {
pos = 1; pos = 1;
} }
unsigned int last_limb = mp_limb_t last_limb =
(unsigned int) ref(x, off_bignum_data + (limb_count - 1) * wordsize); (mp_limb_t) ref(x, off_bignum_data + (limb_count - 1) * wordsize);
if(last_limb == 0){ if(last_limb == 0){
fprintf(stderr, fprintf(stderr,
"Error in (%s) invalid last limb = 0x%08x", caller, last_limb); "Error in (%s) invalid last limb = 0x%08x", caller, last_limb);
@ -454,8 +454,8 @@ ikrt_bnnegate(ikptr x, ikpcb* pcb){
pcb->root0 = &x; pcb->root0 = &x;
ikptr bn = ik_safe_alloc(pcb, align(disp_bignum_data + limb_count * wordsize)); ikptr bn = ik_safe_alloc(pcb, align(disp_bignum_data + limb_count * wordsize));
pcb->root0 = 0; pcb->root0 = 0;
memcpy(bn+disp_bignum_data, memcpy((char*)bn+disp_bignum_data,
x-vector_tag+disp_bignum_data, (char*)x-vector_tag+disp_bignum_data,
limb_count*wordsize); limb_count*wordsize);
ref(bn, 0) = (ikptr) ref(bn, 0) = (ikptr)
(bignum_tag | (bignum_tag |
@ -1189,7 +1189,7 @@ ikrt_bnlognot(ikptr x, ikpcb* pcb){
pcb->root0 = &x; pcb->root0 = &x;
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + (n+1)*wordsize)); ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + (n+1)*wordsize));
pcb->root0 = 0; pcb->root0 = 0;
bzero(r+disp_bignum_data, n*wordsize); bzero((char*)r+disp_bignum_data, n*wordsize);
((mp_limb_t*)(r+disp_bignum_data))[n] = 1; ((mp_limb_t*)(r+disp_bignum_data))[n] = 1;
ref(r, 0) = (ikptr) ref(r, 0) = (ikptr)
(bignum_tag | (1<<bignum_sign_shift) | ((n+1) << bignum_length_shift)); (bignum_tag | (1<<bignum_sign_shift) | ((n+1) << bignum_length_shift));
@ -1376,9 +1376,9 @@ ikrt_bignum_shift_right(ikptr x, ikptr y, ikpcb* pcb){
ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + new_limb_count * wordsize)); ikptr r = ik_safe_alloc(pcb, align(disp_bignum_data + new_limb_count * wordsize));
pcb->root0 = 0; pcb->root0 = 0;
if(bit_shift == 0){ if(bit_shift == 0){
memcpy(r+disp_bignum_data, memcpy((char*)r+disp_bignum_data,
x+off_bignum_data+whole_limb_shift*wordsize, (char*)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 {
copy_bits_shifting_right( copy_bits_shifting_right(
@ -1430,7 +1430,7 @@ ikrt_bignum_shift_left(ikptr x, ikptr y, ikpcb* pcb){
pcb->root0 = 0; 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((char*)s+whole_limb_shift, (char*)x+off_bignum_data, n*wordsize);
return normalize_bignum(limb_count, bnfst_negative(fst), r); return normalize_bignum(limb_count, bnfst_negative(fst), r);
} else { } else {
int limb_count = n + whole_limb_shift + 1; int limb_count = n + whole_limb_shift + 1;
@ -1693,7 +1693,7 @@ ikrt_bignum_to_bytevector(ikptr x, ikpcb* pcb){
fprintf(stderr, "Error allocating space for bignum\n"); fprintf(stderr, "Error allocating space for bignum\n");
exit(-1); exit(-1);
} }
memcpy(mem, x - vector_tag + disp_bignum_data, nbsize); memcpy((char*)mem, (char*)x - vector_tag + disp_bignum_data, nbsize);
mp_size_t bytes = mp_size_t bytes =
mpn_get_str(mem+nbsize, /* output string */ mpn_get_str(mem+nbsize, /* output string */
10, /* base */ 10, /* base */
@ -1707,7 +1707,7 @@ ikrt_bignum_to_bytevector(ikptr x, ikpcb* pcb){
} }
ikptr bv = ik_safe_alloc(pcb, align(bytes + disp_bytevector_data + (sign_bit?1:0))); ikptr 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));
ikptr dest = bv + disp_bytevector_data; char* dest = (char*)(long)(bv + disp_bytevector_data);
if(sign_bit){ if(sign_bit){
*dest = '-'; *dest = '-';
dest++; dest++;

6
src/ikarus-process.c
View File

@ -26,7 +26,7 @@ list_to_vec(ikptr x){
if (vec == NULL) exit(-1); if (vec == NULL) exit(-1);
int i; int i;
for(i=0; i<n; i++){ for(i=0; i<n; i++){
vec[i] = (char*)ref(x, off_car) + off_bytevector_data; vec[i] = (char*)(long)ref(x, off_car) + off_bytevector_data;
x = ref(x, off_cdr); x = ref(x, off_cdr);
} }
vec[n] = 0; vec[n] = 0;
@ -53,9 +53,9 @@ ikrt_process(ikptr rvec, ikptr cmd, ikptr argv, ikpcb* pcb){
if(dup(outfds[1]) == -1) exit(1); if(dup(outfds[1]) == -1) exit(1);
if(close(2)) exit(2); if(close(2)) exit(2);
if(dup(errfds[1]) == -1) exit(1); if(dup(errfds[1]) == -1) exit(1);
execvp((char*)cmd+off_bytevector_data, list_to_vec(argv)); execvp((char*)(long)(cmd+off_bytevector_data), list_to_vec(argv));
fprintf(stderr, "failed to exec %s: %s\n", fprintf(stderr, "failed to exec %s: %s\n",
(char*)cmd+off_bytevector_data, (char*)(long)(cmd+off_bytevector_data),
strerror(errno)); strerror(errno));
exit(-1); exit(-1);
} else if(pid > 0){ } else if(pid > 0){

193
src/ikarus-runtime.c
View File

@ -46,32 +46,36 @@ extern char **environ;
#define segment_shift (pageshift+pageshift-wordshift) #define segment_shift (pageshift+pageshift-wordshift)
#define segment_index(x) (((unsigned long int)(x)) >> segment_shift) #define segment_index(x) (((unsigned long int)(x)) >> segment_shift)
void* ik_mmap(int size); ikptr ik_mmap(int size);
void ik_munmap(void* mem, int size); void ik_munmap(ikptr mem, int size);
static void static void
extend_table_maybe(char*p, int size, ikpcb* pcb){ extend_table_maybe(ikptr p, int size, ikpcb* pcb){
assert(size == align_to_next_page(size)); assert(size == align_to_next_page(size));
char* q = p + size; ikptr q = p + size;
if(p < pcb->memory_base){ if(p < pcb->memory_base){
long int new_lo = segment_index(p); long int new_lo = segment_index(p);
long int old_lo = segment_index(pcb->memory_base); long int old_lo = segment_index(pcb->memory_base);
long int hi = segment_index(pcb->memory_end); long int hi = segment_index(pcb->memory_end);
long int new_vec_size = (hi - new_lo) * pagesize; long int new_vec_size = (hi - new_lo) * pagesize;
long int old_vec_size = (hi - old_lo) * pagesize; long int old_vec_size = (hi - old_lo) * pagesize;
unsigned char* v = ik_mmap(new_vec_size); ikptr v = ik_mmap(new_vec_size);
bzero(v, new_vec_size - old_vec_size); bzero((char*)(long)v, new_vec_size - old_vec_size);
memcpy(v+new_vec_size-old_vec_size, pcb->dirty_vector_base, old_vec_size); memcpy((char*)(long)(v+new_vec_size-old_vec_size),
ik_munmap(pcb->dirty_vector_base, old_vec_size); (char*)(long)pcb->dirty_vector_base,
pcb->dirty_vector_base = (unsigned int*) v; old_vec_size);
pcb->dirty_vector = (unsigned int*)(v - new_lo * pagesize); ik_munmap((ikptr)pcb->dirty_vector_base, old_vec_size);
char* s = ik_mmap(new_vec_size); pcb->dirty_vector_base = (unsigned int*)(long)v;
bzero(s, new_vec_size - old_vec_size); pcb->dirty_vector = (v - new_lo * pagesize);
memcpy(s+new_vec_size-old_vec_size, pcb->segment_vector_base, old_vec_size); ikptr s = ik_mmap(new_vec_size);
ik_munmap(pcb->segment_vector_base, old_vec_size); bzero((char*)(long)s, new_vec_size - old_vec_size);
pcb->segment_vector_base = (unsigned int*) s; memcpy((char*)(long)(s+new_vec_size-old_vec_size),
pcb->segment_vector = (unsigned int*)(s - new_lo * pagesize); (char*)(long)(pcb->segment_vector_base),
pcb->memory_base = (char*)(new_lo * segment_size); old_vec_size);
ik_munmap((ikptr)(long)pcb->segment_vector_base, old_vec_size);
pcb->segment_vector_base = (unsigned int*)(long)s;
pcb->segment_vector = (unsigned int*)(long)(s - new_lo * pagesize);
pcb->memory_base = (new_lo * segment_size);
} }
else if (q > pcb->memory_end){ else if (q > pcb->memory_end){
long int lo = segment_index(pcb->memory_base); long int lo = segment_index(pcb->memory_base);
@ -79,25 +83,27 @@ extend_table_maybe(char*p, int size, ikpcb* pcb){
long int new_hi = segment_index(q+segment_size-1); long int new_hi = segment_index(q+segment_size-1);
long int new_vec_size = (new_hi - lo) * pagesize; long int new_vec_size = (new_hi - lo) * pagesize;
long int old_vec_size = (old_hi - lo) * pagesize; long int old_vec_size = (old_hi - lo) * pagesize;
char* v = ik_mmap(new_vec_size); ikptr v = ik_mmap(new_vec_size);
memcpy(v, pcb->dirty_vector_base, old_vec_size); memcpy((char*)(long)v,
bzero(v+old_vec_size, new_vec_size - old_vec_size); (char*)(long)pcb->dirty_vector_base,
ik_munmap(pcb->dirty_vector_base, old_vec_size); old_vec_size);
pcb->dirty_vector_base = (unsigned int*) v; bzero((char*)(long)(v+old_vec_size), new_vec_size - old_vec_size);
pcb->dirty_vector = (unsigned int*)(v - lo * pagesize); ik_munmap((ikptr)(long)pcb->dirty_vector_base, old_vec_size);
char* s = ik_mmap(new_vec_size); pcb->dirty_vector_base = (unsigned int*)(long)v;
memcpy(s, pcb->segment_vector_base, old_vec_size); pcb->dirty_vector = (v - lo * pagesize);
bzero(s+old_vec_size, new_vec_size - old_vec_size); ikptr s = ik_mmap(new_vec_size);
ik_munmap(pcb->segment_vector_base, old_vec_size); memcpy((char*)(long)s, pcb->segment_vector_base, old_vec_size);
pcb->segment_vector_base = (unsigned int*) s; bzero((char*)(long)(s+old_vec_size), new_vec_size - old_vec_size);
ik_munmap((ikptr)(long)pcb->segment_vector_base, old_vec_size);
pcb->segment_vector_base = (unsigned int*)(long) s;
pcb->segment_vector = (unsigned int*)(s - lo * pagesize); pcb->segment_vector = (unsigned int*)(s - lo * pagesize);
pcb->memory_end = (char*)(new_hi * segment_size); pcb->memory_end = (new_hi * segment_size);
} }
} }
static void static void
set_segment_type(char* base, int size, unsigned int type, ikpcb* pcb){ set_segment_type(ikptr base, int size, unsigned int type, ikpcb* pcb){
assert(base >= pcb->memory_base); assert(base >= pcb->memory_base);
assert((base+size) <= pcb->memory_end); assert((base+size) <= pcb->memory_end);
assert(size == align_to_next_page(size)); assert(size == align_to_next_page(size));
@ -110,12 +116,14 @@ set_segment_type(char* base, int size, unsigned int type, ikpcb* pcb){
} }
void void
ik_munmap_from_segment(char* base, int size, ikpcb* pcb){ ik_munmap_from_segment(ikptr base, int size, ikpcb* pcb){
assert(base >= pcb->memory_base); assert(base >= pcb->memory_base);
assert((base+size) <= pcb->memory_end); assert((base+size) <= pcb->memory_end);
assert(size == align_to_next_page(size)); assert(size == align_to_next_page(size));
unsigned int* p = pcb->segment_vector + page_index(base); unsigned int* p =
unsigned int* s = pcb->dirty_vector + page_index(base); ((unsigned int*)(long)(pcb->segment_vector)) + page_index(base);
unsigned int* s =
((unsigned int*)(long)(pcb->dirty_vector)) + page_index(base);
unsigned int* q = p + page_index(size); unsigned int* q = p + page_index(size);
while(p < q){ while(p < q){
assert(*p != hole_mt); assert(*p != hole_mt);
@ -145,9 +153,9 @@ ik_munmap_from_segment(char* base, int size, ikpcb* pcb){
void* ikptr
ik_mmap_typed(int size, unsigned int type, ikpcb* pcb){ ik_mmap_typed(int size, unsigned int type, ikpcb* pcb){
char* p; ikptr p;
if(size == pagesize) { if(size == pagesize) {
ikpage* s = pcb->cached_pages; ikpage* s = pcb->cached_pages;
if(s){ if(s){
@ -168,17 +176,17 @@ ik_mmap_typed(int size, unsigned int type, ikpcb* pcb){
return p; return p;
} }
void* ikptr
ik_mmap_ptr(int size, int gen, ikpcb* pcb){ ik_mmap_ptr(int size, int gen, ikpcb* pcb){
return ik_mmap_typed(size, pointers_mt | gen, pcb); return ik_mmap_typed(size, pointers_mt | gen, pcb);
} }
void* ikptr
ik_mmap_data(int size, int gen, ikpcb* pcb){ ik_mmap_data(int size, int gen, ikpcb* pcb){
return ik_mmap_typed(size, data_mt | gen, pcb); return ik_mmap_typed(size, data_mt | gen, pcb);
} }
void* ikptr
ik_mmap_code(int size, int gen, ikpcb* pcb){ ik_mmap_code(int size, int gen, ikpcb* pcb){
ikptr p = ik_mmap_typed(size, code_mt | gen, pcb); ikptr p = ik_mmap_typed(size, code_mt | gen, pcb);
if(size > pagesize){ if(size > pagesize){
@ -195,7 +203,7 @@ ik_mmap_code(int size, int gen, ikpcb* pcb){
} }
void* ikptr
ik_mmap_mixed(int size, ikpcb* pcb){ ik_mmap_mixed(int size, ikpcb* pcb){
return ik_mmap_typed(size, mainheap_mt, pcb); return ik_mmap_typed(size, mainheap_mt, pcb);
} }
@ -203,7 +211,7 @@ ik_mmap_mixed(int size, ikpcb* pcb){
void* ikptr
ik_mmap(int size){ ik_mmap(int size){
int pages = (size + pagesize - 1) / pagesize; int pages = (size + pagesize - 1) / pagesize;
total_allocated_pages += pages; total_allocated_pages += pages;
@ -217,6 +225,7 @@ ik_mmap(int size){
MAP_PRIVATE | MAP_ANON, MAP_PRIVATE | MAP_ANON,
-1, -1,
0); 0);
/* FIXME: check if in range */
if(mem == MAP_FAILED){ if(mem == MAP_FAILED){
fprintf(stderr, "Mapping failed: %s\n", strerror(errno)); fprintf(stderr, "Mapping failed: %s\n", strerror(errno));
exit(-1); exit(-1);
@ -229,18 +238,18 @@ ik_mmap(int size){
fprintf(stderr, "MMAP 0x%08x .. 0x%08x\n", (int)mem, fprintf(stderr, "MMAP 0x%08x .. 0x%08x\n", (int)mem,
((int)(mem))+mapsize-1); ((int)(mem))+mapsize-1);
#endif #endif
return mem; return (ikptr)(long)mem;
} }
void void
ik_munmap(void* mem, int size){ ik_munmap(ikptr mem, int size){
int pages = (size + pagesize - 1) / pagesize; int pages = (size + pagesize - 1) / pagesize;
int mapsize = pages * pagesize; int mapsize = pages * pagesize;
assert(size == mapsize); assert(size == mapsize);
assert(((-pagesize) & (int)mem) == (int)mem); assert(((-pagesize) & (int)mem) == (int)mem);
total_allocated_pages -= pages; total_allocated_pages -= pages;
#ifndef __CYGWIN__ #ifndef __CYGWIN__
int err = munmap(mem, mapsize); int err = munmap((char*)(long)mem, mapsize);
if(err != 0){ if(err != 0){
fprintf(stderr, "ik_munmap failed: %s\n", strerror(errno)); fprintf(stderr, "ik_munmap failed: %s\n", strerror(errno));
exit(-1); exit(-1);
@ -294,8 +303,8 @@ ikpcb* ik_make_pcb(){
{ /* make cache ikpage */ { /* make cache ikpage */
ikpage* p = ik_mmap(CACHE_SIZE * sizeof(ikpage)); ikpage* p = (ikpage*)(long)ik_mmap(CACHE_SIZE * sizeof(ikpage));
pcb->cached_pages_base = (ikptr)p; pcb->cached_pages_base = (ikptr)(long)p;
pcb->cached_pages_size = CACHE_SIZE * sizeof(ikpage); pcb->cached_pages_size = CACHE_SIZE * sizeof(ikpage);
ikpage* q = 0; ikpage* q = 0;
ikpage* e = p + CACHE_SIZE; ikpage* e = p + CACHE_SIZE;
@ -309,8 +318,8 @@ ikpcb* ik_make_pcb(){
{ {
/* compute extent of heap and stack */ /* compute extent of heap and stack */
char* lo_mem; ikptr lo_mem;
char* hi_mem; ikptr hi_mem;
if(pcb->heap_base < pcb->stack_base){ if(pcb->heap_base < pcb->stack_base){
lo_mem = pcb->heap_base - pagesize; lo_mem = pcb->heap_base - pagesize;
hi_mem = pcb->stack_base + pcb->stack_size + pagesize; hi_mem = pcb->stack_base + pcb->stack_size + pagesize;
@ -322,16 +331,16 @@ ikpcb* ik_make_pcb(){
long int lo_seg = segment_index(lo_mem); long int lo_seg = segment_index(lo_mem);
long int hi_seg = segment_index(hi_mem+segment_size-1); long int hi_seg = segment_index(hi_mem+segment_size-1);
long int vec_size = (hi_seg - lo_seg) * pagesize; long int vec_size = (hi_seg - lo_seg) * pagesize;
char* dvec = ik_mmap(vec_size); ikptr dvec = ik_mmap(vec_size);
bzero(dvec, vec_size); bzero((char*)(long)dvec, vec_size);
pcb->dirty_vector_base = (unsigned int*) (dvec); pcb->dirty_vector_base = (unsigned int*)(long) dvec;
pcb->dirty_vector = (unsigned int*) (dvec - lo_seg * pagesize); pcb->dirty_vector = (dvec - lo_seg * pagesize);
char* svec = ik_mmap(vec_size); ikptr svec = ik_mmap(vec_size);
bzero(svec, vec_size); bzero((char*)(long)svec, vec_size);
pcb->segment_vector_base = (unsigned int*) (svec); pcb->segment_vector_base = (unsigned int*)(long)svec;
pcb->segment_vector = (unsigned int*) (svec - lo_seg * pagesize); pcb->segment_vector = (unsigned int*)(long)(svec - lo_seg * pagesize);
pcb->memory_base = (char*)(lo_seg * segment_size); pcb->memory_base = (ikptr)(lo_seg * segment_size);
pcb->memory_end = (char*)(hi_seg * segment_size); pcb->memory_end = (ikptr)(hi_seg * segment_size);
set_segment_type(pcb->heap_base, set_segment_type(pcb->heap_base,
pcb->heap_size, pcb->heap_size,
mainheap_mt, mainheap_mt,
@ -370,13 +379,13 @@ void ik_delete_pcb(ikpcb* pcb){
ik_ptr_page* p = pcb->guardians[i]; ik_ptr_page* p = pcb->guardians[i];
while(p){ while(p){
ik_ptr_page* next = p->next; ik_ptr_page* next = p->next;
ik_munmap(p, pagesize); ik_munmap((ikptr)(long)p, pagesize);
p = next; p = next;
} }
} }
} }
char* base = pcb->memory_base; ikptr base = pcb->memory_base;
char* end = pcb->memory_end; ikptr end = pcb->memory_end;
unsigned int* segment_vec = pcb->segment_vector; unsigned int* segment_vec = pcb->segment_vector;
long int i = page_index(base); long int i = page_index(base);
long int j = page_index(end); long int j = page_index(end);
@ -388,8 +397,8 @@ void ik_delete_pcb(ikpcb* pcb){
i++; i++;
} }
long int vecsize = (segment_index(end) - segment_index(base)) * pagesize; long int vecsize = (segment_index(end) - segment_index(base)) * pagesize;
ik_munmap(pcb->dirty_vector_base, vecsize); ik_munmap((ikptr)(long)pcb->dirty_vector_base, vecsize);
ik_munmap(pcb->segment_vector_base, vecsize); ik_munmap((ikptr)(long)pcb->segment_vector_base, vecsize);
ik_free(pcb, sizeof(ikpcb)); ik_free(pcb, sizeof(ikpcb));
} }
@ -493,11 +502,11 @@ void ik_stack_overflow(ikpcb* pcb){
ref(k, -vector_tag) = continuation_tag; ref(k, -vector_tag) = continuation_tag;
ref(k, off_continuation_top) = pcb->frame_pointer; ref(k, off_continuation_top) = pcb->frame_pointer;
ref(k, off_continuation_size) = ref(k, off_continuation_size) =
pcb->frame_base - (long int)pcb->frame_pointer - wordsize; pcb->frame_base - pcb->frame_pointer - wordsize;
ref(k, off_continuation_next) = pcb->next_k; ref(k, off_continuation_next) = pcb->next_k;
pcb->next_k = k; pcb->next_k = k;
pcb->stack_base = ik_mmap_typed(STAKSIZE, mainstack_mt, pcb); pcb->stack_base = (ikptr)(long)ik_mmap_typed(STAKSIZE, mainstack_mt, pcb);
pcb->stack_size = STAKSIZE; pcb->stack_size = STAKSIZE;
pcb->frame_base = pcb->stack_base + pcb->stack_size; pcb->frame_base = pcb->stack_base + pcb->stack_size;
pcb->frame_pointer = pcb->frame_base - wordsize; pcb->frame_pointer = pcb->frame_base - wordsize;
@ -530,8 +539,8 @@ ikptr ik_uuid(ikptr str){
} }
uuid_strlen = strlen(uuid_chars); uuid_strlen = strlen(uuid_chars);
} }
int n = unfix(ref(str, off_bytevector_length)); long int n = unfix(ref(str, off_bytevector_length));
char* data = str+off_bytevector_data; char* data = (char*)(long)(str+off_bytevector_data);
read(fd, data, n); read(fd, data, n);
char* p = data; char* p = data;
char* q = data + n; char* q = data + n;
@ -568,7 +577,7 @@ ikptr
ikrt_file_exists(ikptr filename){ ikrt_file_exists(ikptr filename){
char* str; char* str;
if(tagof(filename) == bytevector_tag){ if(tagof(filename) == bytevector_tag){
str = (char*)filename + off_bytevector_data; str = (char*)(long)(filename + off_bytevector_data);
} else { } else {
fprintf(stderr, "bug in ikrt_file_exists\n"); fprintf(stderr, "bug in ikrt_file_exists\n");
exit(-1); exit(-1);
@ -639,7 +648,7 @@ ikptr
ikrt_delete_file(ikptr filename){ ikrt_delete_file(ikptr filename){
char* str; char* str;
if(tagof(filename) == bytevector_tag){ if(tagof(filename) == bytevector_tag){
str = (char*) filename + off_bytevector_data; str = (char*)(long)(filename + off_bytevector_data);
} else { } else {
fprintf(stderr, "bug in ikrt_delete_file\n"); fprintf(stderr, "bug in ikrt_delete_file\n");
exit(-1); exit(-1);
@ -669,7 +678,7 @@ ikrt_delete_file(ikptr filename){
ikptr ikptr
ik_system(ikptr str){ ik_system(ikptr str){
if(tagof(str) == bytevector_tag){ if(tagof(str) == bytevector_tag){
return fix(system((char*)str+off_bytevector_data)); return fix(system((char*)(long)(str+off_bytevector_data)));
} else { } else {
fprintf(stderr, "bug in ik_system\n"); fprintf(stderr, "bug in ik_system\n");
exit(-1); exit(-1);
@ -690,11 +699,11 @@ mtname(unsigned int n){
ikptr ikptr
ik_dump_metatable(ikpcb* pcb){ ik_dump_metatable(ikpcb* pcb){
unsigned int* s = pcb->segment_vector_base; unsigned int* s = pcb->segment_vector_base;
char* p = pcb->memory_base; ikptr p = pcb->memory_base;
char* hi = pcb->memory_end; ikptr hi = pcb->memory_end;
while(p < hi){ while(p < hi){
unsigned int t = *s & type_mask; unsigned int t = *s & type_mask;
char* start = p; ikptr start = p;
p += pagesize; p += pagesize;
s++; s++;
while((p < hi) && ((*s & type_mask) == t)){ while((p < hi) && ((*s & type_mask) == t)){
@ -712,11 +721,11 @@ ik_dump_metatable(ikpcb* pcb){
ikptr ikptr
ik_dump_dirty_vector(ikpcb* pcb){ ik_dump_dirty_vector(ikpcb* pcb){
unsigned int* s = pcb->dirty_vector_base; unsigned int* s = pcb->dirty_vector_base;
char* p = pcb->memory_base; ikptr p = pcb->memory_base;
char* hi = pcb->memory_end; ikptr hi = pcb->memory_end;
while(p < hi){ while(p < hi){
unsigned int t = *s; unsigned int t = *s;
char* start = p; ikptr start = p;
p += pagesize; p += pagesize;
s++; s++;
while((p < hi) && (*s == t)){ while((p < hi) && (*s == t)){
@ -734,10 +743,10 @@ ik_dump_dirty_vector(ikpcb* pcb){
ikptr ikptr
ikrt_make_code(ikptr codesizeptr, ikptr freevars, ikptr rvec, ikpcb* pcb){ ikrt_make_code(ikptr codesizeptr, ikptr freevars, ikptr rvec, ikpcb* pcb){
assert((fx_mask & (int)codesizeptr) == 0); assert((fx_mask & (int)codesizeptr) == 0);
int code_size = unfix(codesizeptr); long int code_size = unfix(codesizeptr);
int memreq = align_to_next_page(code_size + disp_code_data); long int memreq = align_to_next_page(code_size + disp_code_data);
ikptr mem = ik_mmap_code(memreq, 0, pcb); ikptr mem = ik_mmap_code(memreq, 0, pcb);
bzero(mem, memreq); bzero((char*)(long)mem, memreq);
ref(mem, 0) = code_tag; ref(mem, 0) = code_tag;
ref(mem, disp_code_code_size) = codesizeptr; ref(mem, disp_code_code_size) = codesizeptr;
ref(mem, disp_code_freevars) = freevars; ref(mem, disp_code_freevars) = freevars;
@ -751,14 +760,14 @@ ikptr
ikrt_set_code_reloc_vector(ikptr code, ikptr vec, ikpcb* pcb){ ikrt_set_code_reloc_vector(ikptr code, ikptr vec, ikpcb* pcb){
ref(code, off_code_reloc_vector) = vec; ref(code, off_code_reloc_vector) = vec;
ik_relocate_code(code-vector_tag); ik_relocate_code(code-vector_tag);
pcb->dirty_vector[page_index(code)] = -1; ((unsigned int*)(long)pcb->dirty_vector)[page_index(code)] = -1;
return void_object; return void_object;
} }
ikptr ikptr
ikrt_set_code_annotation(ikptr code, ikptr annot, ikpcb* pcb){ ikrt_set_code_annotation(ikptr code, ikptr annot, ikpcb* pcb){
ref(code, off_code_annotation) = annot; ref(code, off_code_annotation) = annot;
pcb->dirty_vector[page_index(code)] = -1; ((unsigned int*)(long)pcb->dirty_vector)[page_index(code)] = -1;
return void_object; return void_object;
} }
@ -774,9 +783,9 @@ ikrt_bvftime(ikptr outbv, ikptr fmtbv){
fprintf(stderr, "Error in time: %s\n", strerror(errno)); fprintf(stderr, "Error in time: %s\n", strerror(errno));
} }
int rv = int rv =
strftime((char*)outbv+off_bytevector_data, strftime((char*)(long)(outbv+off_bytevector_data),
unfix(ref(outbv, off_bytevector_length)) + 1, unfix(ref(outbv, off_bytevector_length)) + 1,
(char*)fmtbv+off_bytevector_data, (char*)(long)(fmtbv+off_bytevector_data),
tmp); tmp);
if(rv == 0){ if(rv == 0){
fprintf(stderr, "Error in strftime: %s\n", strerror(errno)); fprintf(stderr, "Error in strftime: %s\n", strerror(errno));
@ -789,7 +798,7 @@ ikrt_register_guardian_pair(ikptr p0, ikpcb* pcb){
ik_ptr_page* x = pcb->guardians[0]; ik_ptr_page* x = pcb->guardians[0];
if((x == NULL) || (x->count == ik_ptr_page_size)){ if((x == NULL) || (x->count == ik_ptr_page_size)){
assert(sizeof(ik_ptr_page) == pagesize); assert(sizeof(ik_ptr_page) == pagesize);
ik_ptr_page* y = ik_mmap(pagesize); ik_ptr_page* y = (ik_ptr_page*)(long)ik_mmap(pagesize);
y->count = 0; y->count = 0;
y->next = x; y->next = x;
pcb->guardians[0] = y; pcb->guardians[0] = y;
@ -887,13 +896,13 @@ ikrt_fork(){
ikptr ikptr
ikrt_getenv(ikptr bv, ikpcb* pcb){ ikrt_getenv(ikptr bv, ikpcb* pcb){
char* v = getenv((char*)bv + off_bytevector_data); char* v = getenv((char*)(long)(bv + off_bytevector_data));
if(v){ if(v){
int n = strlen(v); long int n = strlen(v);
ikptr s = ik_safe_alloc(pcb, align(n+disp_bytevector_data+1)) ikptr s = ik_safe_alloc(pcb, align(n+disp_bytevector_data+1))
+ bytevector_tag; + bytevector_tag;
ref(s, -bytevector_tag) = fix(n); ref(s, -bytevector_tag) = fix(n);
memcpy(s+off_bytevector_data, v, n+1); memcpy((char*)(long)(s+off_bytevector_data), v, n+1);
return s; return s;
} }
else { else {
@ -908,9 +917,9 @@ ikrt_getenv(ikptr bv, ikpcb* pcb){
ikptr ikptr
ikrt_make_vector1(ikptr len, ikpcb* pcb){ ikrt_make_vector1(ikptr len, ikpcb* pcb){
if(is_fixnum(len) && (((long int)len) >= 0)){ if(is_fixnum(len) && (((long int)len) >= 0)){
ikptr s = ik_safe_alloc(pcb, align(((long int)len) + disp_vector_data)); ikptr s = ik_safe_alloc(pcb, align(len + disp_vector_data));
ref(s, 0) = len; ref(s, 0) = len;
memset(s+disp_vector_data, 0, (long int)len); memset((char*)(long)(s+disp_vector_data), 0, len);
return s+vector_tag; return s+vector_tag;
} else { } else {
return 0; return 0;
@ -938,8 +947,8 @@ ikptr
ikrt_setenv(ikptr key, ikptr val, ikptr overwrite){ ikrt_setenv(ikptr key, ikptr val, ikptr overwrite){
fprintf(stderr, "setenv busted!\n"); fprintf(stderr, "setenv busted!\n");
exit(-1); exit(-1);
int err = setenv((char*)key+off_bytevector_data, int err = setenv((char*)(long)(key+off_bytevector_data),
(char*)val+off_bytevector_data, (char*)(long)(val+off_bytevector_data),
overwrite!=false_object); overwrite!=false_object);
if(err){ if(err){
return false_object; return false_object;
@ -957,10 +966,10 @@ ikrt_environ(ikpcb* pcb){
int i; char* e; int i; char* e;
ikptr ac = null_object; ikptr ac = null_object;
for(i=0; (e=es[i]); i++){ for(i=0; (e=es[i]); i++){
int n = strlen(e); long int n = strlen(e);
ikptr s = ik_unsafe_alloc(pcb, align(n+disp_string_data+1)) + string_tag; ikptr s = ik_unsafe_alloc(pcb, align(n+disp_string_data+1)) + string_tag;
ref(s, -string_tag) = fix(n); ref(s, -string_tag) = fix(n);
memcpy(s+off_string_data, e, n+1); memcpy((char*)(long)(s+off_string_data), e, n+1);
ikptr p = ik_unsafe_alloc(pcb, pair_size) + pair_tag; ikptr p = ik_unsafe_alloc(pcb, pair_size) + pair_tag;
ref(p, off_cdr) = ac; ref(p, off_cdr) = ac;
ref(p, off_car) = s; ref(p, off_car) = s;

12
src/ikarus-symbol-table.c
View File

@ -27,7 +27,7 @@ make_symbol_table(ikpcb* pcb){
#define NUM_OF_BUCKETS 4096 /* power of 2 */ #define NUM_OF_BUCKETS 4096 /* power of 2 */
int size = align_to_next_page(disp_vector_data + NUM_OF_BUCKETS * wordsize); int size = align_to_next_page(disp_vector_data + NUM_OF_BUCKETS * wordsize);
ikptr st = ik_mmap_ptr(size, 0, pcb) + vector_tag; ikptr st = ik_mmap_ptr(size, 0, pcb) + vector_tag;
bzero(st-vector_tag, size); bzero((char*)st-vector_tag, size);
ref(st, off_vector_length) = fix(NUM_OF_BUCKETS); ref(st, off_vector_length) = fix(NUM_OF_BUCKETS);
return st; return st;
} }
@ -60,8 +60,8 @@ static int strings_eqp(ikptr str1, ikptr str2){
ikptr len = ref(str1, off_string_length); ikptr len = ref(str1, off_string_length);
if(len == ref(str2, off_string_length)){ if(len == ref(str2, off_string_length)){
return return
(memcmp(str1+off_string_data, (memcmp((char*)str1+off_string_data,
str2+off_string_data, (char*)str2+off_string_data,
unfix(len) * string_char_size) unfix(len) * string_char_size)
== 0); == 0);
} }
@ -117,7 +117,7 @@ intern_string(ikptr str, ikptr st, ikpcb* pcb){
ref(b, off_car) = sym; ref(b, off_car) = sym;
ref(b, off_cdr) = bckt; ref(b, off_cdr) = bckt;
ref(st, off_vector_data + idx*wordsize) = b; ref(st, off_vector_data + idx*wordsize) = b;
pcb->dirty_vector[page_index(st+off_vector_data+idx*wordsize)] = -1; ((int*)(long)pcb->dirty_vector)[page_index(st+off_vector_data+idx*wordsize)] = -1;
return sym; return sym;
} }
@ -140,7 +140,7 @@ intern_unique_string(ikptr str, ikptr ustr, ikptr st, ikpcb* pcb){
ref(b, off_car) = sym; ref(b, off_car) = sym;
ref(b, off_cdr) = bckt; ref(b, off_cdr) = bckt;
ref(st, off_vector_data + idx*wordsize) = b; ref(st, off_vector_data + idx*wordsize) = b;
pcb->dirty_vector[page_index(st+off_vector_data+idx*wordsize)] = -1; ((int*)(long)pcb->dirty_vector)[page_index(st+off_vector_data+idx*wordsize)] = -1;
return sym; return sym;
} }
@ -168,7 +168,7 @@ ikrt_intern_gensym(ikptr sym, ikpcb* pcb){
ref(b, off_car) = sym; ref(b, off_car) = sym;
ref(b, off_cdr) = bckt; ref(b, off_cdr) = bckt;
ref(st, off_vector_data + idx*wordsize) = b; ref(st, off_vector_data + idx*wordsize) = b;
pcb->dirty_vector[page_index(st+off_vector_data+idx*wordsize)] = -1; ((int*)(long)pcb->dirty_vector)[page_index(st+off_vector_data+idx*wordsize)] = -1;
return true_object; return true_object;
} }

15
src/ikarus-verify-integrity.c
View File

@ -22,7 +22,7 @@
#include <assert.h> #include <assert.h>
static long int static long int
page_idx(char* x){ page_idx(void* x){
unsigned long int xi = (unsigned long int) x; unsigned long int xi = (unsigned long int) x;
return xi >> pageshift; return xi >> pageshift;
} }
@ -59,7 +59,7 @@ verify_code(char* x, char* base, unsigned int* svec, unsigned int* dvec){
assert(isa_fixnum(freevars)); assert(isa_fixnum(freevars));
assert(unfix(freevars) >= 0); assert(unfix(freevars) >= 0);
unsigned int rs = svec[page_idx(rvec) - page_idx(base)]; unsigned int rs = svec[page_idx((void*)rvec) - page_idx(base)];
unsigned int cs = svec[page_idx(x) - page_idx(base)]; unsigned int cs = svec[page_idx(x) - page_idx(base)];
int cgen = cs&gen_mask; int cgen = cs&gen_mask;
int rgen = rs&gen_mask; int rgen = rs&gen_mask;
@ -81,7 +81,7 @@ verify_object(ikptr x, char* base, unsigned int* svec, unsigned int* dvec){
static char* static char*
verify_code_small(char* p, int s, unsigned int d, verify_code_small(char* p, int s, unsigned int d,
char* base, unsigned int* svec, unsigned int* dvec){ char* base, unsigned int* svec, unsigned int* dvec){
ikptr q = p + pagesize; char* q = p + pagesize;
while(p < q){ while(p < q){
ikptr fst = ref(p, 0); ikptr fst = ref(p, 0);
if(fst == code_tag){ if(fst == code_tag){
@ -111,7 +111,7 @@ verify_code_large(char* p, unsigned int s, unsigned int d,
assert(code_size >= 0); assert(code_size >= 0);
verify_code(p, base, svec, dvec); verify_code(p, base, svec, dvec);
assert(align(code_size+disp_code_data) >= pagesize); assert(align(code_size+disp_code_data) >= pagesize);
ikptr end = p + code_size + disp_code_data; char* end = p + code_size + disp_code_data;
return((char*)align_to_next_page(end)); return((char*)align_to_next_page(end));
} }
@ -121,7 +121,8 @@ verify_code_page(char* p, unsigned int s, unsigned int d,
ikptr fst = ref(p, 0); ikptr fst = ref(p, 0);
fst += 0; fst += 0;
if(fst != code_tag){ if(fst != code_tag){
fprintf(stderr, "non code object with tag %p found\n", fst); fprintf(stderr, "non code object with tag %p found\n",
(void*)fst);
exit(-1); exit(-1);
} }
int code_size = unfix(ref(p, disp_code_code_size)); int code_size = unfix(ref(p, disp_code_code_size));
@ -198,8 +199,8 @@ verify_page(char* p, char* base, unsigned int* svec, unsigned int* dvec){
void void
verify_integrity(ikpcb* pcb, char* where){ verify_integrity(ikpcb* pcb, char* where){
fprintf(stderr, "verifying in %s...\n", where); fprintf(stderr, "verifying in %s...\n", where);
char* mem_base = pcb->memory_base; char* mem_base = (char*)pcb->memory_base;
char* mem_end = pcb->memory_end; char* mem_end = (char*)pcb->memory_end;
unsigned int* seg_vec = pcb->segment_vector_base; unsigned int* seg_vec = pcb->segment_vector_base;
unsigned int* dir_vec = pcb->dirty_vector_base; unsigned int* dir_vec = pcb->dirty_vector_base;
char* mem = mem_base; char* mem = mem_base;