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

changed type of ikp from unsigned char* to char*

This commit is contained in:
Abdulaziz Ghuloum 2007-12-23 13:37:48 -05:00
parent 097ca03e47
commit 5d33921c9e
15 changed files with 830 additions and 829 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/last-revision
View File

@ -1 +1 @@
1275 1276

366
src/ikarus-collect.c
View File

@ -28,7 +28,7 @@
#include <assert.h> #include <assert.h>
#include <errno.h> #include <errno.h>
#define forward_ptr ((ikp)-1) #define forward_ptr ((ikptr)-1)
#define minimum_heap_size (pagesize * 1024 * 4) #define minimum_heap_size (pagesize * 1024 * 4)
#define maximum_heap_size (pagesize * 1024 * 8) #define maximum_heap_size (pagesize * 1024 * 8)
#define minimum_stack_size (pagesize * 128) #define minimum_stack_size (pagesize * 128)
@ -47,17 +47,17 @@ static int htable_count = 0;
#endif #endif
typedef struct qupages_t{ typedef struct qupages_t{
ikp p; /* pointer to the scan start */ ikptr p; /* pointer to the scan start */
ikp q; /* pointer to the scan end */ ikptr q; /* pointer to the scan end */
struct qupages_t* next; struct qupages_t* next;
} qupages_t; } qupages_t;
typedef struct{ typedef struct{
ikp ap; ikptr ap;
ikp aq; ikptr aq;
ikp ep; ikptr ep;
ikp base; ikptr base;
} meta_t; } meta_t;
@ -94,9 +94,9 @@ typedef struct gc_t{
unsigned int* segment_vector; unsigned int* segment_vector;
int collect_gen; int collect_gen;
int collect_gen_tag; int collect_gen_tag;
ikp tconc_ap; ikptr tconc_ap;
ikp tconc_ep; ikptr tconc_ep;
ikp tconc_base; ikptr tconc_base;
ikpages* tconc_queue; ikpages* tconc_queue;
} gc_t; } gc_t;
@ -109,7 +109,7 @@ next_gen_tag[generation_count] = {
(0 << meta_dirty_shift) | 4 | new_gen_tag (0 << meta_dirty_shift) | 4 | new_gen_tag
}; };
static ikp static ikptr
meta_alloc_extending(int size, gc_t* gc, int meta_id){ meta_alloc_extending(int size, gc_t* gc, int meta_id){
int mapsize = align_to_next_page(size); int mapsize = align_to_next_page(size);
if(mapsize < extension_amount[meta_id]){ if(mapsize < extension_amount[meta_id]){
@ -118,20 +118,20 @@ meta_alloc_extending(int size, gc_t* gc, int meta_id){
meta_t* meta = &gc->meta[meta_id]; meta_t* meta = &gc->meta[meta_id];
if((meta_id != meta_data) && meta->base){ if((meta_id != meta_data) && meta->base){
qupages_t* p = ik_malloc(sizeof(qupages_t)); qupages_t* p = ik_malloc(sizeof(qupages_t));
ikp aq = meta->aq; ikptr aq = meta->aq;
ikp ap = meta->ap; ikptr ap = meta->ap;
ikp ep = meta->ep; ikptr ep = meta->ep;
p->p = aq; p->p = aq;
p->q = ap; p->q = ap;
p->next = gc->queues[meta_id]; p->next = gc->queues[meta_id];
gc->queues[meta_id] = p; gc->queues[meta_id] = p;
ikp x = ap; ikptr x = ap;
while(x < ep){ while(x < ep){
ref(x, 0) = 0; ref(x, 0) = 0;
x += wordsize; x += wordsize;
} }
} }
ikp mem = ik_mmap_typed( ikptr mem = ik_mmap_typed(
mapsize, mapsize,
meta_mt[meta_id] | gc->collect_gen_tag, meta_mt[meta_id] | gc->collect_gen_tag,
gc->pcb); gc->pcb);
@ -146,13 +146,13 @@ meta_alloc_extending(int size, gc_t* gc, int meta_id){
static inline ikp static inline ikptr
meta_alloc(int size, gc_t* gc, int meta_id){ meta_alloc(int size, gc_t* gc, int meta_id){
assert(size == align(size)); assert(size == align(size));
meta_t* meta = &gc->meta[meta_id]; meta_t* meta = &gc->meta[meta_id];
ikp ap = meta->ap; ikptr ap = meta->ap;
ikp ep = meta->ep; ikptr ep = meta->ep;
ikp nap = ap + size; ikptr nap = ap + size;
if(nap > ep){ if(nap > ep){
return meta_alloc_extending(size, gc, meta_id); return meta_alloc_extending(size, gc, meta_id);
} else { } else {
@ -161,16 +161,16 @@ meta_alloc(int size, gc_t* gc, int meta_id){
} }
} }
static inline ikp static inline ikptr
gc_alloc_new_ptr(int size, gc_t* gc){ gc_alloc_new_ptr(int size, gc_t* gc){
assert(size == align(size)); assert(size == align(size));
return meta_alloc(size, gc, meta_ptrs); return meta_alloc(size, gc, meta_ptrs);
} }
static inline ikp static inline ikptr
gc_alloc_new_large_ptr(int size, gc_t* gc){ gc_alloc_new_large_ptr(int size, gc_t* gc){
int memreq = align_to_next_page(size); int memreq = align_to_next_page(size);
ikp mem = ikptr mem =
ik_mmap_typed(memreq, ik_mmap_typed(memreq,
pointers_mt | large_object_tag | gc->collect_gen_tag, pointers_mt | large_object_tag | gc->collect_gen_tag,
gc->pcb); gc->pcb);
@ -186,7 +186,7 @@ gc_alloc_new_large_ptr(int size, gc_t* gc){
static inline void static inline void
enqueue_large_ptr(ikp mem, int size, gc_t* gc){ enqueue_large_ptr(ikptr mem, int size, gc_t* gc){
int i = page_index(mem); int i = page_index(mem);
int j = page_index(mem+size-1); int j = page_index(mem+size-1);
while(i<=j){ while(i<=j){
@ -202,7 +202,7 @@ enqueue_large_ptr(ikp mem, int size, gc_t* gc){
} }
static inline ikp static inline ikptr
gc_alloc_new_symbol_record(gc_t* gc){ gc_alloc_new_symbol_record(gc_t* gc){
assert(symbol_record_size == align(symbol_record_size)); assert(symbol_record_size == align(symbol_record_size));
return meta_alloc(symbol_record_size, gc, meta_symbol); return meta_alloc(symbol_record_size, gc, meta_symbol);
@ -211,21 +211,21 @@ gc_alloc_new_symbol_record(gc_t* gc){
static inline ikp static inline ikptr
gc_alloc_new_pair(gc_t* gc){ gc_alloc_new_pair(gc_t* gc){
return meta_alloc(pair_size, gc, meta_pair); return meta_alloc(pair_size, gc, meta_pair);
} }
static inline ikp static inline ikptr
gc_alloc_new_weak_pair(gc_t* gc){ gc_alloc_new_weak_pair(gc_t* gc){
meta_t* meta = &gc->meta[meta_weak]; meta_t* meta = &gc->meta[meta_weak];
ikp ap = meta->ap; ikptr ap = meta->ap;
ikp ep = meta->ep; ikptr ep = meta->ep;
ikp nap = ap + pair_size; ikptr nap = ap + pair_size;
if(nap > ep){ if(nap > ep){
ikp mem = ik_mmap_typed( ikptr mem = ik_mmap_typed(
pagesize, pagesize,
meta_mt[meta_weak] | gc->collect_gen_tag, meta_mt[meta_weak] | gc->collect_gen_tag,
gc->pcb); gc->pcb);
@ -241,20 +241,20 @@ gc_alloc_new_weak_pair(gc_t* gc){
} }
} }
static inline ikp static inline ikptr
gc_alloc_new_data(int size, gc_t* gc){ gc_alloc_new_data(int size, gc_t* gc){
assert(size == align(size)); assert(size == align(size));
return meta_alloc(size, gc, meta_data); return meta_alloc(size, gc, meta_data);
} }
static inline ikp static inline ikptr
gc_alloc_new_code(int size, gc_t* gc){ gc_alloc_new_code(int size, gc_t* gc){
assert(size == align(size)); assert(size == align(size));
if(size < pagesize){ if(size < pagesize){
return meta_alloc(size, gc, meta_code); return meta_alloc(size, gc, meta_code);
} else { } else {
int memreq = align_to_next_page(size); int memreq = align_to_next_page(size);
ikp mem = ik_mmap_code(memreq, gc->collect_gen, gc->pcb); ikptr mem = ik_mmap_code(memreq, gc->collect_gen, gc->pcb);
gc->segment_vector = gc->pcb->segment_vector; gc->segment_vector = gc->pcb->segment_vector;
qupages_t* p = ik_malloc(sizeof(qupages_t)); qupages_t* p = ik_malloc(sizeof(qupages_t));
p->p = mem; p->p = mem;
@ -280,7 +280,7 @@ add_to_collect_count(ikpcb* pcb, int bytes){
static void static void
gc_tconc_push_extending(gc_t* gc, ikp tcbucket){ gc_tconc_push_extending(gc_t* gc, ikptr tcbucket){
if(gc->tconc_base){ if(gc->tconc_base){
ikpages* p = ik_malloc(sizeof(ikpages)); ikpages* p = ik_malloc(sizeof(ikpages));
p->base = gc->tconc_base; p->base = gc->tconc_base;
@ -288,14 +288,14 @@ gc_tconc_push_extending(gc_t* gc, ikp tcbucket){
p->next = gc->tconc_queue; p->next = gc->tconc_queue;
gc->tconc_queue = p; gc->tconc_queue = p;
} }
ikp ap = ikptr ap =
ik_mmap_typed(pagesize, ik_mmap_typed(pagesize,
meta_mt[meta_ptrs] | gc->collect_gen_tag, meta_mt[meta_ptrs] | gc->collect_gen_tag,
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(ap, pagesize);
ikp 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;
gc->tconc_ep = ap + pagesize; gc->tconc_ep = ap + pagesize;
@ -304,9 +304,9 @@ gc_tconc_push_extending(gc_t* gc, ikp tcbucket){
static inline void static inline void
gc_tconc_push(gc_t* gc, ikp tcbucket){ gc_tconc_push(gc_t* gc, ikptr tcbucket){
ikp ap = gc->tconc_ap; ikptr ap = gc->tconc_ap;
ikp nap = ap + 2*wordsize; ikptr nap = ap + 2*wordsize;
if(nap > gc->tconc_ep){ if(nap > gc->tconc_ep){
gc_tconc_push_extending(gc, tcbucket); gc_tconc_push_extending(gc, tcbucket);
} else { } else {
@ -317,14 +317,14 @@ gc_tconc_push(gc_t* gc, ikp tcbucket){
#ifndef NDEBUG #ifndef NDEBUG
static ikp add_object_proc(gc_t* gc, ikp x, char* caller); static ikptr add_object_proc(gc_t* gc, ikptr x, char* caller);
#define add_object(gc,x,caller) add_object_proc(gc,x,caller) #define add_object(gc,x,caller) add_object_proc(gc,x,caller)
#else #else
static ikp add_object_proc(gc_t* gc, ikp x); static ikptr add_object_proc(gc_t* gc, ikptr x);
#define add_object(gc,x,caller) add_object_proc(gc,x) #define add_object(gc,x,caller) add_object_proc(gc,x)
#endif #endif
static void collect_stack(gc_t*, ikp top, ikp base); static void collect_stack(gc_t*, ikptr top, ikptr base);
static void collect_loop(gc_t*); static void collect_loop(gc_t*);
static void forward_guardians(gc_t*); static void forward_guardians(gc_t*);
static void fix_weak_pointers(gc_t*); static void fix_weak_pointers(gc_t*);
@ -515,7 +515,7 @@ ik_collect(int mem_req, ikpcb* pcb){
pcb->heap_base, pcb->heap_base,
pcb->heap_size, pcb->heap_size,
pcb); pcb);
ikp ptr = ik_mmap_mixed(memsize+2*pagesize, pcb); ikptr ptr = ik_mmap_mixed(memsize+2*pagesize, pcb);
pcb->allocation_pointer = ptr; pcb->allocation_pointer = ptr;
pcb->allocation_redline = ptr+memsize; pcb->allocation_redline = ptr+memsize;
pcb->heap_base = ptr; pcb->heap_base = ptr;
@ -523,9 +523,9 @@ ik_collect(int mem_req, ikpcb* pcb){
} }
#ifndef NDEBUG #ifndef NDEBUG
ikp x = pcb->allocation_pointer; ikptr x = pcb->allocation_pointer;
while(x < pcb->allocation_redline){ while(x < pcb->allocation_redline){
ref(x, 0) = (ikp)(0x1234FFFF); ref(x, 0) = (ikptr)(0x1234FFFF);
x+=wordsize; x+=wordsize;
} }
#endif #endif
@ -574,7 +574,7 @@ ik_collect(int mem_req, ikpcb* pcb){
} }
static inline int static inline int
is_live(ikp x, gc_t* gc){ is_live(ikptr x, gc_t* gc){
if(is_fixnum(x)){ if(is_fixnum(x)){
return 1; return 1;
} }
@ -599,7 +599,7 @@ next_gen(int i){
} }
static ik_ptr_page* static ik_ptr_page*
move_guardian(ikp x, ik_ptr_page* dst, ik_ptr_page** cache){ move_guardian(ikptr x, ik_ptr_page* dst, ik_ptr_page** cache){
if((dst == 0) || (dst->count == ik_ptr_page_size)){ if((dst == 0) || (dst->count == ik_ptr_page_size)){
ik_ptr_page* y = *cache; ik_ptr_page* y = *cache;
if(y){ if(y){
@ -637,9 +637,9 @@ forward_guardians_initial(gc_t* gc,
int i; int i;
int n = src->count; int n = src->count;
for(i=0; i<n; i++){ for(i=0; i<n; i++){
ikp a = src->ptr[i]; ikptr a = src->ptr[i];
ikp tc = ref(a, off_car); ikptr tc = ref(a, off_car);
ikp obj = ref(a, off_cdr); ikptr obj = ref(a, off_cdr);
if(is_live(tc, gc)){ if(is_live(tc, gc)){
if(is_live(obj, gc)){ if(is_live(obj, gc)){
live_live = move_guardian(a, live_live, cache); live_live = move_guardian(a, live_live, cache);
@ -681,8 +681,8 @@ forward_guardians_revive_dead(gc_t* gc,
int i; int i;
int n = src->count; int n = src->count;
for(i=0; i<n; i++){ for(i=0; i<n; i++){
ikp a = src->ptr[i]; ikptr a = src->ptr[i];
ikp obj = ref(a, off_cdr); ikptr obj = ref(a, off_cdr);
add_object(gc, obj, "guardian1"); add_object(gc, obj, "guardian1");
} }
src = src->next; src = src->next;
@ -709,8 +709,8 @@ forward_guardians_process_tconcs(gc_t* gc,
int i; int i;
int n = src->count; int n = src->count;
for(i=0; i<n; i++){ for(i=0; i<n; i++){
ikp a = src->ptr[i]; ikptr a = src->ptr[i];
ikp tc = ref(a, off_car); ikptr tc = ref(a, off_car);
if(is_live(tc, gc)){ if(is_live(tc, gc)){
live = move_guardian(a, live, cache); live = move_guardian(a, live, cache);
} else { } else {
@ -736,8 +736,8 @@ forward_guardians_process_tconcs(gc_t* gc,
int i; int i;
int n = src->count; int n = src->count;
for(i=0; i<n; i++){ for(i=0; i<n; i++){
ikp a = src->ptr[i]; ikptr a = src->ptr[i];
ikp tc = ref(a, off_car); ikptr tc = ref(a, off_car);
if(is_live(tc, gc)){ if(is_live(tc, gc)){
some_were_revived = 1; some_were_revived = 1;
add_object(gc, ref(a, off_cdr), "guardian2"); add_object(gc, ref(a, off_cdr), "guardian2");
@ -849,11 +849,11 @@ empty_dropped_guardians(gc_t* gc){
int i; int i;
int n = src->count; int n = src->count;
for(i=0; i<n; i++){ for(i=0; i<n; i++){
ikp a = src->ptr[i]; ikptr a = src->ptr[i];
ikp tc = ref(a, off_car); ikptr tc = ref(a, off_car);
ikp obj = ref(a, off_cdr); ikptr obj = ref(a, off_cdr);
assert(tagof(tc) == pair_tag); assert(tagof(tc) == pair_tag);
ikp d = ref(tc, off_cdr); ikptr d = ref(tc, off_cdr);
assert(tagof(d) == pair_tag); assert(tagof(d) == pair_tag);
ref(d, off_car) = obj; ref(d, off_car) = obj;
ref(d, off_cdr) = a; ref(d, off_cdr) = a;
@ -889,9 +889,9 @@ empty_dropped_guardians(gc_t* gc){
static int alloc_code_count = 0; static int alloc_code_count = 0;
static ikp static ikptr
add_code_entry(gc_t* gc, ikp entry){ add_code_entry(gc_t* gc, ikptr entry){
ikp x = entry - disp_code_data; ikptr x = entry - disp_code_data;
if(ref(x,0) == forward_ptr){ if(ref(x,0) == forward_ptr){
return ref(x,wordsize) + off_code_data; return ref(x,wordsize) + off_code_data;
} }
@ -902,9 +902,9 @@ add_code_entry(gc_t* gc, ikp entry){
return entry; return entry;
} }
int code_size = unfix(ref(x, disp_code_code_size)); int code_size = unfix(ref(x, disp_code_code_size));
ikp reloc_vec = ref(x, disp_code_reloc_vector); ikptr reloc_vec = ref(x, disp_code_reloc_vector);
ikp freevars = ref(x, disp_code_freevars); ikptr freevars = ref(x, disp_code_freevars);
ikp annotation = ref(x, disp_code_annotation); ikptr annotation = ref(x, disp_code_annotation);
int required_mem = align(disp_code_data + code_size); int required_mem = align(disp_code_data + code_size);
if(required_mem >= pagesize){ if(required_mem >= pagesize){
int new_tag = gc->collect_gen_tag; int new_tag = gc->collect_gen_tag;
@ -921,7 +921,7 @@ add_code_entry(gc_t* gc, ikp entry){
gc->queues[meta_code] = p; gc->queues[meta_code] = p;
return entry; return entry;
} else { } else {
ikp y = gc_alloc_new_code(required_mem, gc); ikptr y = gc_alloc_new_code(required_mem, gc);
ref(y, 0) = code_tag; ref(y, 0) = code_tag;
ref(y, disp_code_code_size) = fix(code_size); ref(y, disp_code_code_size) = fix(code_size);
ref(y, disp_code_reloc_vector) = reloc_vec; ref(y, disp_code_reloc_vector) = reloc_vec;
@ -937,7 +937,7 @@ add_code_entry(gc_t* gc, ikp entry){
#define DEBUG_STACK 0 #define DEBUG_STACK 0
static void collect_stack(gc_t* gc, ikp top, ikp end){ static void collect_stack(gc_t* gc, ikptr top, ikptr end){
if(DEBUG_STACK){ if(DEBUG_STACK){
fprintf(stderr, "collecting stack from 0x%08x .. 0x%08x\n", fprintf(stderr, "collecting stack from 0x%08x .. 0x%08x\n",
(int) top, (int) end); (int) top, (int) end);
@ -946,7 +946,7 @@ static void collect_stack(gc_t* gc, ikp top, ikp end){
if(DEBUG_STACK){ if(DEBUG_STACK){
fprintf(stderr, "collecting frame at 0x%08x: ", (int) top); fprintf(stderr, "collecting frame at 0x%08x: ", (int) top);
} }
ikp rp = ref(top, 0); ikptr rp = ref(top, 0);
int rp_offset = unfix(ref(rp, disp_frame_offset)); int rp_offset = unfix(ref(rp, disp_frame_offset));
if(DEBUG_STACK){ if(DEBUG_STACK){
fprintf(stderr, "rp_offset=%d\n", rp_offset); fprintf(stderr, "rp_offset=%d\n", rp_offset);
@ -960,9 +960,9 @@ static void collect_stack(gc_t* gc, ikp top, ikp end){
* updated to reflect the new code object. */ * updated to reflect the new code object. */
int code_offset = rp_offset - disp_frame_offset; int code_offset = rp_offset - disp_frame_offset;
ikp code_entry = rp - code_offset; ikptr code_entry = rp - code_offset;
ikp new_code_entry = add_code_entry(gc, code_entry); ikptr new_code_entry = add_code_entry(gc, code_entry);
ikp new_rp = new_code_entry + code_offset; ikptr new_rp = new_code_entry + code_offset;
ref(top, 0) = new_rp; ref(top, 0) = new_rp;
/* now for some livemask action. /* now for some livemask action.
@ -1013,18 +1013,18 @@ static void collect_stack(gc_t* gc, ikp top, ikp end){
fprintf(stderr, "invalid redirected framesize=%d\n", framesize); fprintf(stderr, "invalid redirected framesize=%d\n", framesize);
exit(-1); exit(-1);
} }
ikp base = top + framesize - wordsize; ikptr base = top + framesize - wordsize;
while(base > top){ while(base > top){
ikp new_obj = add_object(gc,ref(base,0), "frame"); ikptr new_obj = add_object(gc,ref(base,0), "frame");
ref(base,0) = new_obj; ref(base,0) = new_obj;
base -= wordsize; base -= wordsize;
} }
} else { } else {
int frame_cells = framesize >> fx_shift; int frame_cells = framesize >> fx_shift;
int bytes_in_mask = (frame_cells+7) >> 3; int bytes_in_mask = (frame_cells+7) >> 3;
unsigned char* mask = rp + disp_frame_size - bytes_in_mask; char* mask = rp + disp_frame_size - bytes_in_mask;
ikp* fp = (ikp*)(top + framesize); ikptr* fp = (ikptr*)(top + framesize);
int i; 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];
@ -1055,12 +1055,12 @@ static void collect_stack(gc_t* gc, ikp top, ikp end){
static void static void
add_list(gc_t* gc, unsigned int t, ikp x, ikp* loc){ add_list(gc_t* gc, unsigned int t, ikptr x, ikptr* loc){
int collect_gen = gc->collect_gen; int collect_gen = gc->collect_gen;
while(1){ while(1){
ikp fst = ref(x, off_car); ikptr fst = ref(x, off_car);
ikp snd = ref(x, off_cdr); ikptr snd = ref(x, off_cdr);
ikp y; ikptr y;
if((t & type_mask) != weak_pairs_type){ if((t & type_mask) != weak_pairs_type){
y = gc_alloc_new_pair(gc) + pair_tag; y = gc_alloc_new_pair(gc) + pair_tag;
} else { } else {
@ -1084,7 +1084,7 @@ add_list(gc_t* gc, unsigned int t, ikp x, ikp* loc){
return; return;
} else { } else {
x = snd; x = snd;
loc = (ikp*)(y + off_cdr); loc = (ikptr*)(y + off_cdr);
/* don't return */ /* don't return */
} }
} }
@ -1107,11 +1107,11 @@ add_list(gc_t* gc, unsigned int t, ikp x, ikp* loc){
} }
static ikp static ikptr
#ifndef NDEBUG #ifndef NDEBUG
add_object_proc(gc_t* gc, ikp x, char* caller) add_object_proc(gc_t* gc, ikptr x, char* caller)
#else #else
add_object_proc(gc_t* gc, ikp x) add_object_proc(gc_t* gc, ikptr x)
#endif #endif
{ {
if(is_fixnum(x)){ if(is_fixnum(x)){
@ -1122,7 +1122,7 @@ add_object_proc(gc_t* gc, ikp x)
if(tag == immediate_tag){ if(tag == immediate_tag){
return x; return x;
} }
ikp fst = ref(x, -tag); ikptr fst = ref(x, -tag);
if(fst == forward_ptr){ if(fst == forward_ptr){
/* already moved */ /* already moved */
return ref(x, wordsize-tag); return ref(x, wordsize-tag);
@ -1133,14 +1133,14 @@ add_object_proc(gc_t* gc, ikp x)
return x; return x;
} }
if(tag == pair_tag){ if(tag == pair_tag){
ikp y; ikptr y;
add_list(gc, t, x, &y); add_list(gc, t, x, &y);
return y; return y;
} }
#if 0 #if 0
else if(tag == symbol_tag){ else if(tag == symbol_tag){
//ikp y = gc_alloc_new_ptr(align(symbol_size),gen, gc) + symbol_tag; //ikptr y = gc_alloc_new_ptr(align(symbol_size),gen, gc) + symbol_tag;
ikp y = gc_alloc_new_symbol(gen, gc) + symbol_tag; ikptr y = gc_alloc_new_symbol(gen, gc) + symbol_tag;
ref(y, off_symbol_string) = ref(x, off_symbol_string); ref(y, off_symbol_string) = ref(x, off_symbol_string);
ref(y, off_symbol_ustring) = ref(x, off_symbol_ustring); ref(y, off_symbol_ustring) = ref(x, off_symbol_ustring);
ref(y, off_symbol_value) = ref(x, off_symbol_value); ref(y, off_symbol_value) = ref(x, off_symbol_value);
@ -1164,7 +1164,7 @@ add_object_proc(gc_t* gc, ikp x)
fprintf(stderr, "large closure size=0x%08x\n", size); fprintf(stderr, "large closure size=0x%08x\n", size);
} }
int asize = align(size); int asize = align(size);
ikp 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(y-closure_tag, 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));
@ -1187,7 +1187,7 @@ add_object_proc(gc_t* gc, ikp x)
enqueue_large_ptr(x-vector_tag, size+disp_vector_data, gc); enqueue_large_ptr(x-vector_tag, size+disp_vector_data, gc);
return x; return x;
} else { } else {
ikp y = gc_alloc_new_large_ptr(size+disp_vector_data, gc) ikptr y = gc_alloc_new_large_ptr(size+disp_vector_data, gc)
+ 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;
@ -1197,7 +1197,7 @@ add_object_proc(gc_t* gc, ikp x)
return y; return y;
} }
} else { } else {
ikp 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(y+off_vector_data, x+off_vector_data, size);
@ -1210,7 +1210,7 @@ add_object_proc(gc_t* gc, ikp x)
#endif #endif
} }
else if(fst == symbol_record_tag){ else if(fst == symbol_record_tag){
ikp y = gc_alloc_new_symbol_record(gc) + record_tag; ikptr y = gc_alloc_new_symbol_record(gc) + record_tag;
ref(y, -record_tag) = symbol_record_tag; ref(y, -record_tag) = symbol_record_tag;
ref(y, off_symbol_record_string) = ref(x, off_symbol_record_string); ref(y, off_symbol_record_string) = ref(x, off_symbol_record_string);
ref(y, off_symbol_record_ustring) = ref(x, off_symbol_record_ustring); ref(y, off_symbol_record_ustring) = ref(x, off_symbol_record_ustring);
@ -1228,12 +1228,12 @@ add_object_proc(gc_t* gc, ikp x)
/* size = n * object_alignment + 4 => /* size = n * object_alignment + 4 =>
memreq = n * object_alignment + 8 memreq = n * object_alignment + 8
= (n+1) * object_alignment => aligned */ = (n+1) * object_alignment => aligned */
ikp 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;
{ {
int i; int i;
ikp p = y+disp_record_data-vector_tag; ikptr p = y+disp_record_data-vector_tag;
ikp 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);
for(i=wordsize; i<size; i+=(2*wordsize)){ for(i=wordsize; i<size; i+=(2*wordsize)){
ref(p, i) = ref(q, i); ref(p, i) = ref(q, i);
@ -1246,12 +1246,12 @@ add_object_proc(gc_t* gc, ikp x)
} else { } else {
/* size = n * object_alignment => /* size = n * object_alignment =>
memreq = n * object_alignment + 4 + 4 (pad) */ memreq = n * object_alignment + 4 + 4 (pad) */
ikp 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;
{ {
int i; int i;
ikp p = y+disp_record_data-vector_tag; ikptr p = y+disp_record_data-vector_tag;
ikp 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)){
ref(p, i) = ref(q, i); ref(p, i) = ref(q, i);
ref(p, i+wordsize) = ref(q, i+wordsize); ref(p, i+wordsize) = ref(q, i+wordsize);
@ -1264,28 +1264,28 @@ add_object_proc(gc_t* gc, ikp x)
} }
} }
else if(fst == code_tag){ else if(fst == code_tag){
ikp entry = x + off_code_data; ikptr entry = x + off_code_data;
ikp new_entry = add_code_entry(gc, entry); ikptr new_entry = add_code_entry(gc, entry);
return new_entry - off_code_data; return new_entry - off_code_data;
} }
else if(fst == continuation_tag){ else if(fst == continuation_tag){
ikp top = ref(x, off_continuation_top); ikptr top = ref(x, off_continuation_top);
int size = (int) ref(x, off_continuation_size); int size = (int) 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);
} }
#endif #endif
ikp next = ref(x, off_continuation_next); ikptr next = ref(x, off_continuation_next);
ikp y = gc_alloc_new_ptr(continuation_size, gc) + vector_tag; ikptr y = gc_alloc_new_ptr(continuation_size, gc) + vector_tag;
ref(x, -vector_tag) = forward_ptr; ref(x, -vector_tag) = forward_ptr;
ref(x, wordsize-vector_tag) = y; ref(x, wordsize-vector_tag) = y;
ikp 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(new_top, 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;
ref(y, off_continuation_size) = (ikp) size; ref(y, off_continuation_size) = (ikptr) size;
ref(y, off_continuation_next) = next; ref(y, off_continuation_next) = next;
#if accounting #if accounting
continuation_count++; continuation_count++;
@ -1294,9 +1294,9 @@ add_object_proc(gc_t* gc, ikp x)
} }
else if(tagof(fst) == pair_tag){ else if(tagof(fst) == pair_tag){
/* tcbucket */ /* tcbucket */
ikp y = gc_alloc_new_ptr(tcbucket_size, gc) + vector_tag; ikptr y = gc_alloc_new_ptr(tcbucket_size, gc) + vector_tag;
ref(y,off_tcbucket_tconc) = fst; ref(y,off_tcbucket_tconc) = fst;
ikp key = ref(x, off_tcbucket_key); ikptr key = ref(x, off_tcbucket_key);
ref(y,off_tcbucket_key) = key; ref(y,off_tcbucket_key) = key;
ref(y,off_tcbucket_val) = ref(x, off_tcbucket_val); ref(y,off_tcbucket_val) = ref(x, off_tcbucket_val);
ref(y,off_tcbucket_next) = ref(x, off_tcbucket_next); ref(y,off_tcbucket_next) = ref(x, off_tcbucket_next);
@ -1312,7 +1312,7 @@ add_object_proc(gc_t* gc, ikp x)
return y; return y;
} }
else if((((int)fst) & port_mask) == port_tag){ else if((((int)fst) & port_mask) == port_tag){
ikp 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; int i;
for(i=wordsize; i<port_size; i+=wordsize){ for(i=wordsize; i<port_size; i+=wordsize){
@ -1323,7 +1323,7 @@ add_object_proc(gc_t* gc, ikp x)
return y; return y;
} }
else if(fst == flonum_tag){ else if(fst == flonum_tag){
ikp new = gc_alloc_new_data(flonum_size, gc) + vector_tag; ikptr new = gc_alloc_new_data(flonum_size, gc) + vector_tag;
ref(new, -vector_tag) = flonum_tag; ref(new, -vector_tag) = flonum_tag;
flonum_data(new) = flonum_data(x); flonum_data(new) = flonum_data(x);
ref(x, -vector_tag) = forward_ptr; ref(x, -vector_tag) = forward_ptr;
@ -1333,16 +1333,16 @@ add_object_proc(gc_t* gc, ikp x)
else if((((int)fst) & bignum_mask) == bignum_tag){ else if((((int)fst) & bignum_mask) == bignum_tag){
int len = ((unsigned int)fst) >> bignum_length_shift; int len = ((unsigned int)fst) >> bignum_length_shift;
int memreq = align(disp_bignum_data + len*wordsize); int memreq = align(disp_bignum_data + len*wordsize);
ikp 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(new-vector_tag, 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;
} }
else if(fst == ratnum_tag){ else if(fst == ratnum_tag){
ikp y = gc_alloc_new_data(ratnum_size, gc) + vector_tag; ikptr y = gc_alloc_new_data(ratnum_size, gc) + vector_tag;
ikp num = ref(x, disp_ratnum_num-vector_tag); ikptr num = ref(x, disp_ratnum_num-vector_tag);
ikp den = ref(x, disp_ratnum_den-vector_tag); ikptr den = ref(x, disp_ratnum_den-vector_tag);
ref(x, -vector_tag) = forward_ptr; ref(x, -vector_tag) = forward_ptr;
ref(x, wordsize-vector_tag) = y; ref(x, wordsize-vector_tag) = y;
ref(y, -vector_tag) = fst; ref(y, -vector_tag) = fst;
@ -1360,7 +1360,7 @@ add_object_proc(gc_t* gc, ikp x)
if(is_fixnum(fst)){ if(is_fixnum(fst)){
int strlen = unfix(fst); int strlen = unfix(fst);
int memreq = align(strlen*string_char_size + disp_string_data); int memreq = align(strlen*string_char_size + disp_string_data);
ikp 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(new_str+off_string_data,
x + off_string_data, x + off_string_data,
@ -1381,7 +1381,7 @@ add_object_proc(gc_t* gc, ikp x)
else if(tag == bytevector_tag){ else if(tag == bytevector_tag){
int len = unfix(fst); int len = unfix(fst);
int memreq = align(len + disp_bytevector_data + 1); int memreq = align(len + disp_bytevector_data + 1);
ikp 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(new_bv+off_bytevector_data,
x + off_bytevector_data, x + off_bytevector_data,
@ -1395,16 +1395,16 @@ add_object_proc(gc_t* gc, ikp x)
} }
static void static void
relocate_new_code(ikp x, gc_t* gc){ relocate_new_code(ikptr x, gc_t* gc){
ikp relocvector = ref(x, disp_code_reloc_vector); ikptr relocvector = ref(x, disp_code_reloc_vector);
relocvector = add_object(gc, relocvector, "relocvec"); relocvector = add_object(gc, relocvector, "relocvec");
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");
int relocsize = (int)ref(relocvector, off_vector_length); int relocsize = (int)ref(relocvector, off_vector_length);
ikp p = relocvector + off_vector_data; ikptr p = relocvector + off_vector_data;
ikp q = p + relocsize; ikptr q = p + relocsize;
ikp code = x + disp_code_data; ikptr code = x + disp_code_data;
while(p < q){ while(p < q){
int r = unfix(ref(p, 0)); int r = unfix(ref(p, 0));
int tag = r & 3; int tag = r & 3;
@ -1415,31 +1415,31 @@ relocate_new_code(ikp x, gc_t* gc){
// fprintf(stderr, "r=0x%08x code_off=%d reloc_size=0x%08x\n", // fprintf(stderr, "r=0x%08x code_off=%d reloc_size=0x%08x\n",
// r, code_off, relocsize); // r, code_off, relocsize);
#endif #endif
ikp old_object = ref(p, wordsize); ikptr old_object = ref(p, wordsize);
ikp new_object = add_object(gc, old_object, "reloc1"); ikptr new_object = add_object(gc, old_object, "reloc1");
ref(code, code_off) = new_object; ref(code, code_off) = new_object;
p += (2*wordsize); p += (2*wordsize);
} }
else if(tag == 2){ else if(tag == 2){
/* displaced pointer */ /* displaced pointer */
int obj_off = unfix(ref(p, wordsize)); int obj_off = unfix(ref(p, wordsize));
ikp old_object = ref(p, 2*wordsize); ikptr old_object = ref(p, 2*wordsize);
ikp new_object = add_object(gc, old_object, "reloc2"); ikptr new_object = add_object(gc, old_object, "reloc2");
ref(code, code_off) = new_object + obj_off; ref(code, code_off) = new_object + obj_off;
p += (3 * wordsize); p += (3 * wordsize);
} }
else if(tag == 3){ else if(tag == 3){
/* displaced relative pointer */ /* displaced relative pointer */
int obj_off = unfix(ref(p, wordsize)); int obj_off = unfix(ref(p, wordsize));
ikp obj = ref(p, 2*wordsize); ikptr obj = ref(p, 2*wordsize);
#ifndef NDEBUG #ifndef NDEBUG
//fprintf(stderr, "obj=0x%08x, obj_off=0x%08x\n", (int)obj, //fprintf(stderr, "obj=0x%08x, obj_off=0x%08x\n", (int)obj,
// obj_off); // obj_off);
#endif #endif
obj = add_object(gc, obj, "reloc3"); obj = add_object(gc, obj, "reloc3");
ikp displaced_object = obj + obj_off; ikptr displaced_object = obj + obj_off;
ikp next_word = code + code_off + wordsize; ikptr next_word = code + code_off + wordsize;
ikp relative_distance = displaced_object - (int)next_word; ikptr relative_distance = displaced_object - (int)next_word;
ref(next_word, -wordsize) = relative_distance; ref(next_word, -wordsize) = relative_distance;
p += (3*wordsize); p += (3*wordsize);
} }
@ -1467,8 +1467,8 @@ collect_loop(gc_t* gc){
done = 0; done = 0;
gc->queues[meta_pair] = 0; gc->queues[meta_pair] = 0;
do{ do{
ikp p = qu->p; ikptr p = qu->p;
ikp q = qu->q; ikptr q = qu->q;
while(p < q){ while(p < q){
ref(p,0) = add_object(gc, ref(p,0), "loop"); ref(p,0) = add_object(gc, ref(p,0), "loop");
p += (2*wordsize); p += (2*wordsize);
@ -1486,8 +1486,8 @@ collect_loop(gc_t* gc){
done = 0; done = 0;
gc->queues[meta_ptrs] = 0; gc->queues[meta_ptrs] = 0;
do{ do{
ikp p = qu->p; ikptr p = qu->p;
ikp q = qu->q; ikptr q = qu->q;
while(p < q){ while(p < q){
ref(p,0) = add_object(gc, ref(p,0), "pending"); ref(p,0) = add_object(gc, ref(p,0), "pending");
p += wordsize; p += wordsize;
@ -1505,8 +1505,8 @@ collect_loop(gc_t* gc){
done = 0; done = 0;
gc->queues[meta_symbol] = 0; gc->queues[meta_symbol] = 0;
do{ do{
ikp p = qu->p; ikptr p = qu->p;
ikp q = qu->q; ikptr q = qu->q;
while(p < q){ while(p < q){
ref(p,0) = add_object(gc, ref(p,0), "symbols"); ref(p,0) = add_object(gc, ref(p,0), "symbols");
p += wordsize; p += wordsize;
@ -1524,8 +1524,8 @@ collect_loop(gc_t* gc){
gc->queues[meta_code] = 0; gc->queues[meta_code] = 0;
done = 0; done = 0;
do{ do{
ikp p = codes->p; ikptr p = codes->p;
ikp q = codes->q; ikptr q = codes->q;
while(p < q){ while(p < q){
relocate_new_code(p, gc); relocate_new_code(p, gc);
alloc_code_count--; alloc_code_count--;
@ -1540,8 +1540,8 @@ collect_loop(gc_t* gc){
{/* see if there are any remaining in the main ptr segment */ {/* see if there are any remaining in the main ptr segment */
{ {
meta_t* meta = &gc->meta[meta_pair]; meta_t* meta = &gc->meta[meta_pair];
ikp p = meta->aq; ikptr p = meta->aq;
ikp q = meta->ap; ikptr q = meta->ap;
if(p < q){ if(p < q){
done = 0; done = 0;
do{ do{
@ -1557,8 +1557,8 @@ collect_loop(gc_t* gc){
} }
{ {
meta_t* meta = &gc->meta[meta_symbol]; meta_t* meta = &gc->meta[meta_symbol];
ikp p = meta->aq; ikptr p = meta->aq;
ikp q = meta->ap; ikptr q = meta->ap;
if(p < q){ if(p < q){
done = 0; done = 0;
do{ do{
@ -1574,8 +1574,8 @@ collect_loop(gc_t* gc){
} }
{ {
meta_t* meta = &gc->meta[meta_ptrs]; meta_t* meta = &gc->meta[meta_ptrs];
ikp p = meta->aq; ikptr p = meta->aq;
ikp q = meta->ap; ikptr q = meta->ap;
if(p < q){ if(p < q){
done = 0; done = 0;
do{ do{
@ -1591,8 +1591,8 @@ collect_loop(gc_t* gc){
} }
{ {
meta_t* meta = &gc->meta[meta_code]; meta_t* meta = &gc->meta[meta_code];
ikp p = meta->aq; ikptr p = meta->aq;
ikp q = meta->ap; ikptr q = meta->ap;
if(p < q){ if(p < q){
done = 0; done = 0;
do{ do{
@ -1615,8 +1615,8 @@ collect_loop(gc_t* gc){
/* FIXME: did you hear of code reuse? */ /* FIXME: did you hear of code reuse? */
{ {
meta_t* meta = &gc->meta[meta_pair]; meta_t* meta = &gc->meta[meta_pair];
ikp p = meta->ap; ikptr p = meta->ap;
ikp q = meta->ep; ikptr q = meta->ep;
while(p < q){ while(p < q){
ref(p, 0) = 0; ref(p, 0) = 0;
p += wordsize; p += wordsize;
@ -1624,8 +1624,8 @@ collect_loop(gc_t* gc){
} }
{ {
meta_t* meta = &gc->meta[meta_symbol]; meta_t* meta = &gc->meta[meta_symbol];
ikp p = meta->ap; ikptr p = meta->ap;
ikp q = meta->ep; ikptr q = meta->ep;
while(p < q){ while(p < q){
ref(p, 0) = 0; ref(p, 0) = 0;
p += wordsize; p += wordsize;
@ -1633,8 +1633,8 @@ collect_loop(gc_t* gc){
} }
{ {
meta_t* meta = &gc->meta[meta_ptrs]; meta_t* meta = &gc->meta[meta_ptrs];
ikp p = meta->ap; ikptr p = meta->ap;
ikp q = meta->ep; ikptr q = meta->ep;
while(p < q){ while(p < q){
ref(p, 0) = 0; ref(p, 0) = 0;
p += wordsize; p += wordsize;
@ -1642,8 +1642,8 @@ collect_loop(gc_t* gc){
} }
{ {
meta_t* meta = &gc->meta[meta_weak]; meta_t* meta = &gc->meta[meta_weak];
ikp p = meta->ap; ikptr p = meta->ap;
ikp q = meta->ep; ikptr q = meta->ep;
while(p < q){ while(p < q){
ref(p, 0) = 0; ref(p, 0) = 0;
p += wordsize; p += wordsize;
@ -1651,8 +1651,8 @@ collect_loop(gc_t* gc){
} }
{ {
meta_t* meta = &gc->meta[meta_code]; meta_t* meta = &gc->meta[meta_code];
ikp p = meta->ap; ikptr p = meta->ap;
ikp q = meta->ep; ikptr q = meta->ep;
while(p < q){ while(p < q){
ref(p, 0) = 0; ref(p, 0) = 0;
p += wordsize; p += wordsize;
@ -1675,14 +1675,14 @@ fix_weak_pointers(gc_t* gc){
(weak_pairs_type|new_gen_tag)){ (weak_pairs_type|new_gen_tag)){
//int gen = t & gen_mask; //int gen = t & gen_mask;
if (1) { //(gen > collect_gen){ if (1) { //(gen > collect_gen){
ikp p = (ikp)(i << pageshift); ikptr p = (ikptr)(i << pageshift);
ikp q = p + pagesize; ikptr q = p + pagesize;
while(p < q){ while(p < q){
ikp x = ref(p, 0); ikptr x = ref(p, 0);
if(! is_fixnum(x)){ if(! is_fixnum(x)){
int tag = tagof(x); int tag = tagof(x);
if(tag != immediate_tag){ if(tag != immediate_tag){
ikp fst = ref(x, -tag); ikptr fst = ref(x, -tag);
if(fst == forward_ptr){ if(fst == forward_ptr){
ref(p, 0) = ref(x, wordsize-tag); ref(p, 0) = ref(x, wordsize-tag);
} else { } else {
@ -1727,20 +1727,20 @@ scan_dirty_pointers_page(gc_t* gc, int page_idx, int mask){
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;
ikp p = (ikp)(page_idx << pageshift); ikptr p = (ikptr)(page_idx << pageshift);
int j; int j;
unsigned int new_d = 0; unsigned int new_d = 0;
for(j=0; j<cards_per_page; j++){ for(j=0; j<cards_per_page; j++){
if(masked_d & (0xF << (j*meta_dirty_shift))){ if(masked_d & (0xF << (j*meta_dirty_shift))){
/* dirty card */ /* dirty card */
ikp q = p + cardsize; ikptr q = p + cardsize;
unsigned int card_d = 0; unsigned int card_d = 0;
while(p < q){ while(p < q){
ikp x = ref(p, 0); ikptr x = ref(p, 0);
if(is_fixnum(x) || (tagof(x) == immediate_tag)){ if(is_fixnum(x) || (tagof(x) == immediate_tag)){
/* do nothing */ /* do nothing */
} else { } else {
ikp y = add_object(gc, x, "nothing"); ikptr y = add_object(gc, x, "nothing");
segment_vec = gc->segment_vector; segment_vec = gc->segment_vector;
ref(p, 0) = y; ref(p, 0) = y;
card_d = card_d | segment_vec[page_index(y)]; card_d = card_d | segment_vec[page_index(y)];
@ -1761,9 +1761,9 @@ scan_dirty_pointers_page(gc_t* gc, int page_idx, int mask){
static void static void
scan_dirty_code_page(gc_t* gc, int page_idx, unsigned int mask){ scan_dirty_code_page(gc_t* gc, int page_idx, unsigned int mask){
ikp p = (ikp)(page_idx << pageshift); ikptr p = (ikptr)(page_idx << pageshift);
ikp start = p; ikptr start = p;
ikp q = p + pagesize; ikptr q = p + pagesize;
unsigned int* segment_vec = gc->segment_vector; unsigned int* segment_vec = gc->segment_vector;
unsigned int* dirty_vec = gc->pcb->dirty_vector; unsigned int* dirty_vec = gc->pcb->dirty_vector;
//unsigned int d = dirty_vec[page_idx]; //unsigned int d = dirty_vec[page_idx];
@ -1779,13 +1779,13 @@ scan_dirty_code_page(gc_t* gc, int page_idx, unsigned int mask){
int code_size = unfix(ref(p, disp_code_code_size)); int code_size = unfix(ref(p, disp_code_code_size));
relocate_new_code(p, gc); relocate_new_code(p, gc);
segment_vec = gc->segment_vector; segment_vec = gc->segment_vector;
ikp rvec = ref(p, disp_code_reloc_vector); ikptr rvec = ref(p, disp_code_reloc_vector);
int len = (int)ref(rvec, off_vector_length); int len = (int)ref(rvec, off_vector_length);
assert(len >= 0); assert(len >= 0);
int i; int i;
unsigned int code_d = segment_vec[page_index(rvec)]; unsigned int code_d = segment_vec[page_index(rvec)];
for(i=0; i<len; i+=wordsize){ for(i=0; i<len; i+=wordsize){
ikp r = ref(rvec, i+off_vector_data); ikptr r = ref(rvec, i+off_vector_data);
if(is_fixnum(r) || (tagof(r) == immediate_tag)){ if(is_fixnum(r) || (tagof(r) == immediate_tag)){
/* do nothing */ /* do nothing */
} else { } else {
@ -1863,8 +1863,8 @@ 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;
unsigned char* memory_base = pcb->memory_base; char* memory_base = pcb->memory_base;
unsigned char* memory_end = pcb->memory_end; char* memory_end = pcb->memory_end;
int lo_idx = page_index(memory_base); int lo_idx = page_index(memory_base);
int hi_idx = page_index(memory_end); int hi_idx = page_index(memory_end);
int i = lo_idx; int i = lo_idx;
@ -1877,7 +1877,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((unsigned char*)(i<<pageshift),pagesize,pcb); ik_munmap_from_segment((char*)(i<<pageshift),pagesize,pcb);
} }
} }
} }
@ -1890,8 +1890,8 @@ 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;
unsigned char* memory_base = pcb->memory_base; char* memory_base = pcb->memory_base;
unsigned char* memory_end = pcb->memory_end; char* memory_end = pcb->memory_end;
int lo_idx = page_index(memory_base); int lo_idx = page_index(memory_base);
int hi_idx = page_index(memory_end); int hi_idx = page_index(memory_end);
int i = lo_idx; int i = lo_idx;
@ -1908,19 +1908,19 @@ fix_new_pages(gc_t* gc){
} }
static void static void
add_one_tconc(ikpcb* pcb, ikp p){ add_one_tconc(ikpcb* pcb, ikptr p){
ikp tcbucket = ref(p,0); ikptr tcbucket = ref(p,0);
ikp tc = ref(tcbucket, off_tcbucket_tconc); ikptr tc = ref(tcbucket, off_tcbucket_tconc);
assert(tagof(tc) == pair_tag); assert(tagof(tc) == pair_tag);
ikp d = ref(tc, off_cdr); ikptr d = ref(tc, off_cdr);
assert(tagof(d) == pair_tag); assert(tagof(d) == pair_tag);
ikp new_pair = p + pair_tag; ikptr new_pair = p + pair_tag;
ref(d, off_car) = tcbucket; ref(d, off_car) = tcbucket;
ref(d, off_cdr) = new_pair; ref(d, off_cdr) = new_pair;
ref(new_pair, off_car) = false_object; ref(new_pair, off_car) = false_object;
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) = (ikp)(tcbucket_size - wordsize); ref(tcbucket, -vector_tag) = (ikptr)(tcbucket_size - wordsize);
pcb->dirty_vector[page_index(tc)] = -1; pcb->dirty_vector[page_index(tc)] = -1;
pcb->dirty_vector[page_index(d)] = -1; pcb->dirty_vector[page_index(d)] = -1;
} }
@ -1932,8 +1932,8 @@ gc_add_tconcs(gc_t* gc){
} }
ikpcb* pcb = gc->pcb; ikpcb* pcb = gc->pcb;
{ {
ikp p = gc->tconc_base; ikptr p = gc->tconc_base;
ikp q = gc->tconc_ap; ikptr q = gc->tconc_ap;
while(p < q){ while(p < q){
add_one_tconc(pcb, p); add_one_tconc(pcb, p);
p += 2*wordsize; p += 2*wordsize;
@ -1941,8 +1941,8 @@ gc_add_tconcs(gc_t* gc){
} }
ikpages* qu = gc->tconc_queue; ikpages* qu = gc->tconc_queue;
while(qu){ while(qu){
ikp p = qu->base; ikptr p = qu->base;
ikp q = p + qu->size; ikptr q = p + qu->size;
while(p < q){ while(p < q){
add_one_tconc(pcb, p); add_one_tconc(pcb, p);
p += 2*wordsize; p += 2*wordsize;

125
src/ikarus-data.h
View File

@ -90,16 +90,17 @@ 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 unsigned char* ikp; typedef char* ikptr;
void ik_error(ikp args);
void ik_error(ikptr args);
typedef struct ikpage{ typedef struct ikpage{
ikp base; ikptr base;
struct ikpage* next; struct ikpage* next;
} ikpage; } ikpage;
typedef struct ikpages{ typedef struct ikpages{
ikp base; ikptr base;
int size; int size;
struct ikpages* next; struct ikpages* next;
} ikpages; } ikpages;
@ -111,55 +112,55 @@ typedef struct ikdl{ /* double-link */
#define ik_ptr_page_size \ #define ik_ptr_page_size \
((pagesize - sizeof(int) - sizeof(struct ik_ptr_page*))/sizeof(ikp)) ((pagesize - sizeof(int) - sizeof(struct ik_ptr_page*))/sizeof(ikptr))
typedef struct ik_ptr_page{ typedef struct ik_ptr_page{
int count; int count;
struct ik_ptr_page* next; struct ik_ptr_page* next;
ikp ptr[ik_ptr_page_size]; ikptr ptr[ik_ptr_page_size];
} ik_ptr_page; } ik_ptr_page;
typedef struct ikpcb{ typedef struct ikpcb{
/* the first locations may be accessed by some */ /* the first locations may be accessed by some */
/* compiled code to perform overflow/underflow ops */ /* compiled code to perform overflow/underflow ops */
ikp allocation_pointer; /* offset = 0 */ ikptr allocation_pointer; /* offset = 0 */
ikp allocation_redline; /* offset = 4 */ ikptr allocation_redline; /* offset = 4 */
ikp frame_pointer; /* offset = 8 */ ikptr frame_pointer; /* offset = 8 */
ikp frame_base; /* offset = 12 */ ikptr frame_base; /* offset = 12 */
ikp frame_redline; /* offset = 16 */ ikptr frame_redline; /* offset = 16 */
ikp next_k; /* offset = 20 */ ikptr next_k; /* offset = 20 */
void* system_stack; /* offset = 24 */ void* system_stack; /* offset = 24 */
unsigned int* dirty_vector; /* offset = 28 */ unsigned int* dirty_vector; /* offset = 28 */
ikp 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 */
ikp base_rtd; /* offset = 44 */ ikptr base_rtd; /* offset = 44 */
ikp 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 */
/* they only support the runtime system (gc, etc.) */ /* they only support the runtime system (gc, etc.) */
ikp* root0; ikptr* root0;
ikp* root1; ikptr* root1;
unsigned int* segment_vector; unsigned int* segment_vector;
ikp weak_pairs_ap; ikptr weak_pairs_ap;
ikp weak_pairs_ep; ikptr weak_pairs_ep;
ikp heap_base; ikptr heap_base;
int heap_size; int heap_size;
ikpages* heap_pages; ikpages* heap_pages;
ikpage* cached_pages; /* pages cached so that we don't map/unmap */ ikpage* cached_pages; /* pages cached so that we don't map/unmap */
ikpage* uncached_pages; /* ikpages cached so that we don't malloc/free */ ikpage* uncached_pages; /* ikpages cached so that we don't malloc/free */
ikp cached_pages_base; ikptr cached_pages_base;
int cached_pages_size; int cached_pages_size;
ikp stack_base; ikptr stack_base;
int stack_size; int stack_size;
ikp symbol_table; ikptr symbol_table;
ikp gensym_table; ikptr gensym_table;
ik_ptr_page* guardians[generation_count]; ik_ptr_page* guardians[generation_count];
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;
unsigned char* memory_base; char* memory_base;
unsigned char* memory_end; char* memory_end;
int collection_id; int collection_id;
int allocation_count_minor; int allocation_count_minor;
int allocation_count_major; int allocation_count_major;
@ -181,28 +182,28 @@ void* ik_mmap_data(int size, int gen, ikpcb*);
void* ik_mmap_code(int size, int gen, ikpcb*); void* ik_mmap_code(int size, int gen, ikpcb*);
void* ik_mmap_mixed(int size, ikpcb*); void* ik_mmap_mixed(int size, ikpcb*);
void ik_munmap(void*, int); void ik_munmap(void*, int);
void ik_munmap_from_segment(unsigned char*, int, ikpcb*); void ik_munmap_from_segment(char*, 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);
void ik_fasl_load(ikpcb* pcb, char* filename); void ik_fasl_load(ikpcb* pcb, char* filename);
void ik_relocate_code(ikp); void ik_relocate_code(ikptr);
ikp ik_exec_code(ikpcb* pcb, ikp code_ptr); ikptr ik_exec_code(ikpcb* pcb, ikptr code_ptr);
void ik_print(ikp x); void ik_print(ikptr x);
void ik_fprint(FILE*, ikp x); void ik_fprint(FILE*, ikptr x);
ikp ikrt_string_to_symbol(ikp, ikpcb*); ikptr ikrt_string_to_symbol(ikptr, ikpcb*);
ikp ikrt_strings_to_gensym(ikp, ikp, ikpcb*); ikptr ikrt_strings_to_gensym(ikptr, ikptr, ikpcb*);
ikp ik_cstring_to_symbol(char*, ikpcb*); ikptr ik_cstring_to_symbol(char*, ikpcb*);
ikp ik_asm_enter(ikpcb*, ikp code_object, ikp arg); ikptr ik_asm_enter(ikpcb*, ikptr code_object, ikptr arg);
ikp ik_asm_reenter(ikpcb*, ikp code_object, ikp val); ikptr ik_asm_reenter(ikpcb*, ikptr code_object, ikptr val);
ikp ik_underflow_handler(ikpcb*); ikptr ik_underflow_handler(ikpcb*);
ikp ik_unsafe_alloc(ikpcb* pcb, int size); ikptr ik_unsafe_alloc(ikpcb* pcb, int size);
ikp ik_safe_alloc(ikpcb* pcb, int size); ikptr ik_safe_alloc(ikpcb* pcb, int size);
#define IK_FASL_HEADER "#@IK01" #define IK_FASL_HEADER "#@IK01"
@ -210,7 +211,7 @@ ikp ik_safe_alloc(ikpcb* pcb, int size);
#define IK_FASL_CODE_HEADER_SIZE 12 #define IK_FASL_CODE_HEADER_SIZE 12
#define code_pri_tag vector_tag #define code_pri_tag vector_tag
#define code_tag ((ikp)0x2F) #define code_tag ((ikptr)0x2F)
#define disp_code_code_size 4 #define disp_code_code_size 4
#define disp_code_reloc_vector 8 #define disp_code_reloc_vector 8
#define disp_code_freevars 12 #define disp_code_freevars 12
@ -237,17 +238,17 @@ ikp ik_safe_alloc(ikpcb* pcb, int size);
#define fx_shift 2 #define fx_shift 2
#define fx_mask 3 #define fx_mask 3
#define unfix(x) (((int)(x)) >> fx_shift) #define unfix(x) (((int)(x)) >> fx_shift)
#define fix(x) ((ikp)((x) << fx_shift)) #define fix(x) ((ikptr)((x) << fx_shift))
#define is_fixnum(x) ((((int)(x)) & fx_mask) == 0) #define is_fixnum(x) ((((int)(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) \
(((ikp*)(((char*)(x)) + ((int)(n))))[0]) (((ikptr*)(((char*)(x)) + ((int)(n))))[0])
#define ref(x,n) \ #define ref(x,n) \
(((ikp*)(((char*)(x)) + ((int)(n))))[0]) (((ikptr*)(((char*)(x)) + ((int)(n))))[0])
#define IK_MASK(x,m) (((int)(x)) & ((int)(m))) #define IK_MASK(x,m) (((int)(x)) & ((int)(m)))
#define IK_PTAG(x) (((int)(x)) & 7) #define IK_PTAG(x) (((int)(x)) & 7)
@ -257,30 +258,30 @@ ikp ik_safe_alloc(ikpcb* pcb, int size);
#define immediate_tag 7 #define immediate_tag 7
#define IK_UNFIX(x) (((int)(x)) >> IK_FX_SHIFT) #define IK_UNFIX(x) (((int)(x)) >> IK_FX_SHIFT)
#define IK_FIX(x) ((ikp)((x) << IK_FX_SHIFT)) #define IK_FIX(x) ((ikptr)((x) << IK_FX_SHIFT))
#define fix(x) ((ikp)((x) << fx_shift)) #define fix(x) ((ikptr)((x) << fx_shift))
#define IK_CODE_P(x) \ #define IK_CODE_P(x) \
((IK_PTAG(x) == IK_CODE_PRI_TAG) && (IK_STAG(x) == IK_CODE_SEC_TAG)) ((IK_PTAG(x) == IK_CODE_PRI_TAG) && (IK_STAG(x) == IK_CODE_SEC_TAG))
#define IK_FALSE_OBJECT ((ikp)0x2F) #define IK_FALSE_OBJECT ((ikptr)0x2F)
#define IK_TRUE_OBJECT ((ikp)0x3F) #define IK_TRUE_OBJECT ((ikptr)0x3F)
#define false_object ((ikp)0x2F) #define false_object ((ikptr)0x2F)
#define true_object ((ikp)0x3F) #define true_object ((ikptr)0x3F)
#define IK_NULL_OBJECT ((ikp)0x4F) #define IK_NULL_OBJECT ((ikptr)0x4F)
#define null_object ((ikp)0x4F) #define null_object ((ikptr)0x4F)
#define void_object ((ikp)0x7F) #define void_object ((ikptr)0x7F)
#define bwp_object ((ikp)0x8F) #define bwp_object ((ikptr)0x8F)
#define unbound_object ((ikp)0x6F) #define unbound_object ((ikptr)0x6F)
#define IK_CHAR_TAG 0x0F #define IK_CHAR_TAG 0x0F
#define IK_CHAR_MASK 0xFF #define IK_CHAR_MASK 0xFF
#define IK_CHAR_SHIFT 8 #define IK_CHAR_SHIFT 8
#define IK_CHAR_VAL(x) (((int)(x)) >> IK_CHAR_SHIFT) #define IK_CHAR_VAL(x) (((int)(x)) >> IK_CHAR_SHIFT)
#define int_to_scheme_char(x) ((ikp)(((x) << IK_CHAR_SHIFT) | IK_CHAR_TAG)) #define int_to_scheme_char(x) ((ikptr)(((x) << IK_CHAR_SHIFT) | IK_CHAR_TAG))
#define IK_PAIR_SIZE 8 #define IK_PAIR_SIZE 8
#define pair_size 8 #define pair_size 8
#define pair_tag 1 #define pair_tag 1
@ -309,8 +310,8 @@ ikp ik_safe_alloc(ikpcb* pcb, int size);
// ((((unsigned char*)(x)) + off_string_data + (int)(i))[0] = // ((((unsigned char*)(x)) + off_string_data + (int)(i))[0] =
// (((int)(c)) >> IK_CHAR_SHIFT)) // (((int)(c)) >> IK_CHAR_SHIFT))
#define string_set(x,i,c) \ #define string_set(x,i,c) \
(((ikp*)(((ikp)(x)) + off_string_data))[i] = ((ikp)(c))) (((ikptr*)(((ikptr)(x)) + off_string_data))[i] = ((ikptr)(c)))
#define integer_to_char(x) ((ikp)((((int)(x)) << IK_CHAR_SHIFT) + IK_CHAR_TAG)) #define integer_to_char(x) ((ikptr)((((int)(x)) << IK_CHAR_SHIFT) + IK_CHAR_TAG))
#define string_char_size 4 #define string_char_size 4
#define vector_tag 5 #define vector_tag 5
@ -347,7 +348,7 @@ ikp ik_safe_alloc(ikpcb* pcb, int size);
#define off_bytevector_length (disp_bytevector_length - bytevector_tag) #define off_bytevector_length (disp_bytevector_length - bytevector_tag)
#define off_bytevector_data (disp_bytevector_data - bytevector_tag) #define off_bytevector_data (disp_bytevector_data - bytevector_tag)
#define symbol_record_tag ((ikp) 0x5F) #define symbol_record_tag ((ikptr) 0x5F)
#define disp_symbol_record_string 4 #define disp_symbol_record_string 4
#define disp_symbol_record_ustring 8 #define disp_symbol_record_ustring 8
#define disp_symbol_record_value 12 #define disp_symbol_record_value 12
@ -393,7 +394,7 @@ ikp ik_safe_alloc(ikpcb* pcb, int size);
#define off_rtd_printer (disp_rtd_printer - rtd_tag) #define off_rtd_printer (disp_rtd_printer - rtd_tag)
#define off_rtd_symbol (disp_rtd_symbol - rtd_tag) #define off_rtd_symbol (disp_rtd_symbol - rtd_tag)
#define continuation_tag ((ikp)0x1F) #define continuation_tag ((ikptr)0x1F)
#define disp_continuation_top 4 #define disp_continuation_top 4
#define disp_continuation_size 8 #define disp_continuation_size 8
#define disp_continuation_next 12 #define disp_continuation_next 12
@ -435,13 +436,13 @@ ikp ik_safe_alloc(ikpcb* pcb, int size);
#define disp_bignum_data wordsize #define disp_bignum_data wordsize
#define off_bignum_data (disp_bignum_data - vector_tag) #define off_bignum_data (disp_bignum_data - vector_tag)
#define flonum_tag ((ikp)0x17) #define flonum_tag ((ikptr)0x17)
#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*)(((ikp)(x))+off_flonum_data))) #define flonum_data(x) (*((double*)(((ikptr)(x))+off_flonum_data)))
#define ratnum_tag ((ikp) 0x27) #define ratnum_tag ((ikptr) 0x27)
#define ratnum_size 16 #define ratnum_size 16
#define disp_ratnum_num 4 #define disp_ratnum_num 4
#define disp_ratnum_den 8 #define disp_ratnum_den 8

22
src/ikarus-exec.c
View File

@ -23,20 +23,20 @@
#include <string.h> #include <string.h>
typedef struct { typedef struct {
ikp tag; ikptr tag;
ikp top; ikptr top;
int size; int size;
ikp next; ikptr next;
} cont; } cont;
ikp ik_exec_code(ikpcb* pcb, ikp code_ptr){ ikptr ik_exec_code(ikpcb* pcb, ikptr code_ptr){
ikp argc = ik_asm_enter(pcb, code_ptr+off_code_data,0); ikptr argc = ik_asm_enter(pcb, code_ptr+off_code_data,0);
ikp 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*)(next_k - vector_tag);
ikp top = k->top; ikptr top = k->top;
ikp rp = ref(top, 0); ikptr rp = ref(top, 0);
int framesize = (int) ref(rp, disp_frame_size); int framesize = (int) ref(rp, disp_frame_size);
if(framesize <= 0){ if(framesize <= 0){
fprintf(stderr, "invalid framesize %d\n", framesize); fprintf(stderr, "invalid framesize %d\n", framesize);
@ -49,14 +49,14 @@ ikp ik_exec_code(ikpcb* pcb, ikp code_ptr){
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 + (ikp)nk; k->next = vector_tag + (ikptr)nk;
/* record side effect */ /* record side effect */
unsigned int idx = ((unsigned int)(&k->next)) >> pageshift; unsigned int idx = ((unsigned int)(&k->next)) >> pageshift;
pcb->dirty_vector[idx] = -1; pcb->dirty_vector[idx] = -1;
} }
pcb->next_k = k->next; pcb->next_k = k->next;
ikp fbase = pcb->frame_base - wordsize; ikptr fbase = pcb->frame_base - wordsize;
ikp new_fbase = fbase - framesize; ikptr new_fbase = fbase - framesize;
memmove(new_fbase + (int)argc, memmove(new_fbase + (int)argc,
fbase + (int)argc, fbase + (int)argc,
-(int)argc); -(int)argc);

124
src/ikarus-fasl.c
View File

@ -41,13 +41,13 @@ typedef struct {
char* membase; char* membase;
char* memp; char* memp;
char* memq; char* memq;
ikp code_ap; ikptr code_ap;
ikp code_ep; ikptr code_ep;
ikp* marks; ikptr* marks;
int marks_size; int marks_size;
} fasl_port; } fasl_port;
static ikp ik_fasl_read(ikpcb* pcb, fasl_port* p); static ikptr ik_fasl_read(ikpcb* pcb, fasl_port* p);
void ik_fasl_load(ikpcb* pcb, char* fasl_file){ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
int fd = open(fasl_file, O_RDONLY); int fd = open(fasl_file, O_RDONLY);
@ -96,9 +96,9 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
while(p.memp < p.memq){ while(p.memp < p.memq){
p.code_ap = 0; p.code_ap = 0;
p.code_ep = 0; p.code_ep = 0;
ikp 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(ikp*)); ik_munmap((unsigned char*) p.marks, p.marks_size*sizeof(ikptr*));
p.marks = 0; p.marks = 0;
p.marks_size = 0; p.marks_size = 0;
} }
@ -110,7 +110,7 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
} }
close(fd); close(fd);
} }
ikp val = ik_exec_code(pcb, v); ikptr val = ik_exec_code(pcb, v);
val = void_object; val = void_object;
if(val != void_object){ if(val != void_object){
/* this is from revision 1 /* this is from revision 1
@ -125,16 +125,16 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
} }
} }
static ikp static ikptr
alloc_code(int size, ikpcb* pcb, fasl_port* p){ alloc_code(int size, ikpcb* pcb, fasl_port* p){
int asize = align(size); int asize = align(size);
ikp ap = p->code_ap; ikptr ap = p->code_ap;
ikp nap = ap + asize; ikptr nap = ap + asize;
if(nap <= p->code_ep){ if(nap <= p->code_ep){
p->code_ap = nap; p->code_ap = nap;
return ap; return ap;
} else if (asize < pagesize){ } else if (asize < pagesize){
ikp mem = ik_mmap_code(pagesize, 0, pcb); ikptr mem = ik_mmap_code(pagesize, 0, pcb);
int bytes_remaining = pagesize - asize; int bytes_remaining = pagesize - asize;
int previous_bytes = int previous_bytes =
((unsigned int)p->code_ep) - ((unsigned int)ap); ((unsigned int)p->code_ep) - ((unsigned int)ap);
@ -147,19 +147,19 @@ alloc_code(int size, ikpcb* pcb, fasl_port* p){
} }
} else { } else {
int asize = align_to_next_page(size); int asize = align_to_next_page(size);
ikp mem = ik_mmap_code(asize, 0, pcb); ikptr mem = ik_mmap_code(asize, 0, pcb);
return mem; return mem;
} }
} }
void void
ik_relocate_code(ikp code){ ik_relocate_code(ikptr code){
ikp vec = ref(code, disp_code_reloc_vector); ikptr vec = ref(code, disp_code_reloc_vector);
ikp size = ref(vec, off_vector_length); ikptr size = ref(vec, off_vector_length);
ikp data = code + disp_code_data; ikptr data = code + disp_code_data;
ikp p = vec + off_vector_data; ikptr p = vec + off_vector_data;
ikp q = p + (int)size; ikptr q = p + (int)size;
while(p < q){ while(p < q){
int r = unfix(ref(p, 0)); int r = unfix(ref(p, 0));
if(r == 0){ if(r == 0){
@ -176,23 +176,23 @@ ik_relocate_code(ikp code){
else if(tag == 2){ else if(tag == 2){
/* displaced object */ /* displaced object */
int obj_off = unfix(ref(p, wordsize)); int obj_off = unfix(ref(p, wordsize));
ikp obj = ref(p, 2*wordsize); ikptr obj = ref(p, 2*wordsize);
ref(data, code_off) = obj + obj_off; ref(data, code_off) = obj + obj_off;
p += (3*wordsize); p += (3*wordsize);
} }
else if(tag == 3){ else if(tag == 3){
/* jump label */ /* jump label */
int obj_off = unfix(ref(p, wordsize)); int obj_off = unfix(ref(p, wordsize));
ikp obj = ref(p, 2*wordsize); ikptr obj = ref(p, 2*wordsize);
ikp displaced_object = obj + obj_off; ikptr displaced_object = obj + obj_off;
ikp next_word = data + code_off + wordsize; ikptr next_word = data + code_off + wordsize;
ikp relative_distance = displaced_object - (int)next_word; ikptr relative_distance = displaced_object - (int)next_word;
ref(next_word, -wordsize) = relative_distance; ref(next_word, -wordsize) = relative_distance;
p += (3*wordsize); p += (3*wordsize);
} }
else if(tag == 1){ else if(tag == 1){
/* foreign object */ /* foreign object */
ikp str = ref(p, wordsize); ikptr str = ref(p, wordsize);
char* name; char* name;
if(tagof(str) == bytevector_tag){ if(tagof(str) == bytevector_tag){
name = (char*) str + off_bytevector_data; name = (char*) str + off_bytevector_data;
@ -241,12 +241,12 @@ static void fasl_read_buf(fasl_port* p, void* buf, int n){
typedef struct{ typedef struct{
int code_size; int code_size;
int reloc_size; int reloc_size;
ikp closure_size; ikptr closure_size;
} code_header; } code_header;
static ikp do_read(ikpcb* pcb, fasl_port* p){ static ikptr do_read(ikpcb* pcb, fasl_port* p){
char c = fasl_read_byte(p); char c = fasl_read_byte(p);
int put_mark_index = 0; int put_mark_index = 0;
if(c == '>'){ if(c == '>'){
@ -273,18 +273,18 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
} }
else { else {
/* allocate marks */ /* allocate marks */
p->marks = (ikp*)ik_mmap(pagesize*sizeof(ikp*)); p->marks = (ikptr*)ik_mmap(pagesize*sizeof(ikptr*));
bzero(p->marks, pagesize*sizeof(ikp*)); bzero(p->marks, pagesize*sizeof(ikptr*));
p->marks_size = pagesize; p->marks_size = pagesize;
} }
} }
if(c == 'x'){ if(c == 'x'){
int code_size; int code_size;
ikp freevars; ikptr freevars;
fasl_read_buf(p, &code_size, sizeof(int)); fasl_read_buf(p, &code_size, sizeof(int));
fasl_read_buf(p, &freevars, sizeof(ikp)); fasl_read_buf(p, &freevars, sizeof(ikptr));
ikp annotation = do_read(pcb, p); ikptr annotation = do_read(pcb, p);
ikp code = alloc_code(align(code_size+disp_code_data), pcb, p); ikptr code = alloc_code(align(code_size+disp_code_data), pcb, p);
ref(code, 0) = code_tag; ref(code, 0) = code_tag;
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;
@ -298,7 +298,7 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
return code+vector_tag; return code+vector_tag;
} }
else if(c == 'P'){ else if(c == 'P'){
ikp pair = ik_unsafe_alloc(pcb, pair_size) + pair_tag; ikptr pair = ik_unsafe_alloc(pcb, pair_size) + pair_tag;
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = pair; p->marks[put_mark_index] = pair;
} }
@ -308,8 +308,8 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
} }
else if(c == 'M'){ else if(c == 'M'){
/* symbol */ /* symbol */
ikp str = do_read(pcb, p); ikptr str = do_read(pcb, p);
ikp sym = ikrt_string_to_symbol(str, pcb); ikptr sym = ikrt_string_to_symbol(str, pcb);
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = sym; p->marks[put_mark_index] = sym;
} }
@ -320,12 +320,12 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
int len; int len;
fasl_read_buf(p, &len, sizeof(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);
ikp 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, str+off_string_data, len);
{ {
unsigned char* pi = (unsigned char*) (str+off_string_data); unsigned char* pi = (unsigned char*) (str+off_string_data);
ikp* pj = (ikp*) (str+off_string_data); ikptr* pj = (ikptr*) (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]);
@ -342,7 +342,7 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
int len; int len;
fasl_read_buf(p, &len, sizeof(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);
ikp 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);
int i; int i;
for(i=0; i<len; i++){ for(i=0; i<len; i++){
@ -361,7 +361,7 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
int len; int len;
fasl_read_buf(p, &len, sizeof(int)); fasl_read_buf(p, &len, sizeof(int));
int size = align(len * wordsize + disp_vector_data); int size = align(len * wordsize + disp_vector_data);
ikp vec = ik_unsafe_alloc(pcb, size) + vector_tag; ikptr vec = ik_unsafe_alloc(pcb, size) + vector_tag;
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = vec; p->marks[put_mark_index] = vec;
} }
@ -373,7 +373,7 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
return vec; return vec;
} }
else if(c == 'I'){ else if(c == 'I'){
ikp fixn; ikptr fixn;
fasl_read_buf(p, &fixn, sizeof(int)); fasl_read_buf(p, &fixn, sizeof(int));
return fixn; return fixn;
} }
@ -392,25 +392,25 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
} }
else if(c == 'G'){ else if(c == 'G'){
/* G is for gensym */ /* G is for gensym */
ikp pretty = do_read(pcb, p); ikptr pretty = do_read(pcb, p);
ikp unique = do_read(pcb, p); ikptr unique = do_read(pcb, p);
ikp sym = ikrt_strings_to_gensym(pretty, unique, pcb); ikptr sym = ikrt_strings_to_gensym(pretty, unique, pcb);
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = sym; p->marks[put_mark_index] = sym;
} }
return sym; return sym;
} }
else if(c == 'R'){ /* R is for RTD */ else if(c == 'R'){ /* R is for RTD */
ikp name = do_read(pcb, p); ikptr name = do_read(pcb, p);
ikp symb = do_read(pcb, p); ikptr symb = do_read(pcb, p);
int i, n; int i, n;
fasl_read_buf(p, &n, sizeof(int)); fasl_read_buf(p, &n, sizeof(int));
ikp fields; ikptr fields;
if(n == 0){ if(n == 0){
fields = null_object; fields = null_object;
} else { } else {
fields = ik_unsafe_alloc(pcb, n * align(pair_size)) + pair_tag; fields = ik_unsafe_alloc(pcb, n * align(pair_size)) + pair_tag;
ikp ptr = fields; ikptr ptr = fields;
for(i=0; i<n; i++){ for(i=0; i<n; i++){
ref(ptr, off_car) = do_read(pcb, p); ref(ptr, off_car) = do_read(pcb, p);
ref(ptr, off_cdr) = ptr + align(pair_size); ref(ptr, off_cdr) = ptr + align(pair_size);
@ -419,11 +419,11 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
ptr -= pair_size; ptr -= pair_size;
ref(ptr, off_cdr) = null_object; ref(ptr, off_cdr) = null_object;
} }
ikp gensym_val = ref(symb, off_symbol_record_value); ikptr gensym_val = ref(symb, off_symbol_record_value);
ikp rtd; ikptr rtd;
if(gensym_val == unbound_object){ if(gensym_val == unbound_object){
rtd = ik_unsafe_alloc(pcb, align(rtd_size)) + vector_tag; rtd = ik_unsafe_alloc(pcb, align(rtd_size)) + vector_tag;
ikp base_rtd = pcb->base_rtd; ikptr base_rtd = pcb->base_rtd;
ref(rtd, off_rtd_rtd) = base_rtd; ref(rtd, off_rtd_rtd) = base_rtd;
ref(rtd, off_rtd_name) = name; ref(rtd, off_rtd_name) = name;
ref(rtd, off_rtd_length) = fix(n); ref(rtd, off_rtd_length) = fix(n);
@ -441,11 +441,11 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
return rtd; return rtd;
} }
else if(c == 'Q'){ /* thunk */ else if(c == 'Q'){ /* thunk */
ikp proc = ik_unsafe_alloc(pcb, align(disp_closure_data)) + closure_tag; ikptr proc = ik_unsafe_alloc(pcb, align(disp_closure_data)) + closure_tag;
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = proc; p->marks[put_mark_index] = proc;
} }
ikp code = do_read(pcb, p); ikptr code = do_read(pcb, p);
ref(proc, -closure_tag) = code + off_code_data; ref(proc, -closure_tag) = code + off_code_data;
return proc; return proc;
} }
@ -460,7 +460,7 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
fprintf(stderr, "invalid index for ref %d\n", idx); fprintf(stderr, "invalid index for ref %d\n", idx);
exit(-1); exit(-1);
} }
ikp obj = p->marks[idx]; ikptr obj = p->marks[idx];
if(obj){ if(obj){
return obj; return obj;
} else { } else {
@ -473,7 +473,7 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
int len; int len;
fasl_read_buf(p, &len, sizeof(int)); fasl_read_buf(p, &len, sizeof(int));
int size = align(len + disp_bytevector_data + 1); int size = align(len + disp_bytevector_data + 1);
ikp 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, x+off_bytevector_data, len);
x[off_bytevector_data+len] = 0; x[off_bytevector_data+len] = 0;
@ -488,11 +488,11 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
fprintf(stderr, "invalid len=%d\n", len); fprintf(stderr, "invalid len=%d\n", len);
exit(-1); exit(-1);
} }
ikp pair = ik_unsafe_alloc(pcb, pair_size * (len+1)) + pair_tag; ikptr pair = ik_unsafe_alloc(pcb, pair_size * (len+1)) + pair_tag;
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = pair; p->marks[put_mark_index] = pair;
} }
int i; ikp pt = pair; int i; ikptr pt = pair;
for(i=0; i<len; i++){ for(i=0; i<len; i++){
ref(pt, off_car) = do_read(pcb, p); ref(pt, off_car) = do_read(pcb, p);
ref(pt, off_cdr) = pt + pair_size; ref(pt, off_cdr) = pt + pair_size;
@ -509,11 +509,11 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
fprintf(stderr, "invalid len=%d\n", len); fprintf(stderr, "invalid len=%d\n", len);
exit(-1); exit(-1);
} }
ikp pair = ik_unsafe_alloc(pcb, pair_size * (len+1)) + pair_tag; ikptr pair = ik_unsafe_alloc(pcb, pair_size * (len+1)) + pair_tag;
if(put_mark_index){ if(put_mark_index){
p->marks[put_mark_index] = pair; p->marks[put_mark_index] = pair;
} }
int i; ikp pt = pair; int i; ikptr pt = pair;
for(i=0; i<len; i++){ for(i=0; i<len; i++){
ref(pt, off_car) = do_read(pcb, p); ref(pt, off_car) = do_read(pcb, p);
ref(pt, off_cdr) = pt + pair_size; ref(pt, off_cdr) = pt + pair_size;
@ -524,7 +524,7 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
return pair; return pair;
} }
else if(c == 'f'){ else if(c == 'f'){
ikp 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, x+disp_flonum_data-vector_tag, 8);
if(put_mark_index){ if(put_mark_index){
@ -551,8 +551,8 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
} }
unsigned int tag = bignum_tag | (sign << bignum_sign_shift) | unsigned int tag = bignum_tag | (sign << bignum_sign_shift) |
((len >> 2) << bignum_length_shift); ((len >> 2) << bignum_length_shift);
ikp 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) = (ikp) tag; ref(x, -vector_tag) = (ikptr) tag;
fasl_read_buf(p, x+off_bignum_data, len); fasl_read_buf(p, 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;
@ -566,7 +566,7 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
} }
static ikp ik_fasl_read(ikpcb* pcb, fasl_port* p){ static ikptr ik_fasl_read(ikpcb* pcb, fasl_port* p){
/* first check the header */ /* first check the header */
char buf[IK_FASL_HEADER_LEN]; char buf[IK_FASL_HEADER_LEN];
fasl_read_buf(p, buf, IK_FASL_HEADER_LEN); fasl_read_buf(p, buf, IK_FASL_HEADER_LEN);

208
src/ikarus-flonums.c
View File

@ -23,20 +23,20 @@
#include <errno.h> #include <errno.h>
#include <math.h> #include <math.h>
ikp ikptr
ikrt_fl_round(ikp x, ikp y){ ikrt_fl_round(ikptr x, ikptr y){
flonum_data(y) = round(flonum_data(x)); flonum_data(y) = round(flonum_data(x));
return y; return y;
} }
ikp ikptr
ikrt_fl_exp(ikp x, ikp y){ ikrt_fl_exp(ikptr x, ikptr y){
flonum_data(y) = exp(flonum_data(x)); flonum_data(y) = exp(flonum_data(x));
return y; return y;
} }
ikp ikptr
ikrt_flfl_expt(ikp a, ikp b, ikp z){ ikrt_flfl_expt(ikptr a, ikptr b, ikptr z){
flonum_data(z) = exp(flonum_data(b) * log(flonum_data(a))); flonum_data(z) = exp(flonum_data(b) * log(flonum_data(a)));
return z; return z;
} }
@ -45,100 +45,100 @@ ikrt_flfl_expt(ikp a, ikp b, ikp z){
ikp ikptr
ikrt_bytevector_to_flonum(ikp x, ikpcb* pcb){ ikrt_bytevector_to_flonum(ikptr x, ikpcb* pcb){
double v = strtod((char*)x+off_bytevector_data, NULL); double v = strtod((char*)x+off_bytevector_data, NULL);
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = v; flonum_data(r) = v;
return r; return r;
} }
ikp ikptr
ikrt_fl_plus(ikp x, ikp y,ikpcb* pcb){ ikrt_fl_plus(ikptr x, ikptr y,ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = flonum_data(x) + flonum_data(y); flonum_data(r) = flonum_data(x) + flonum_data(y);
return r; return r;
} }
ikp ikptr
ikrt_fl_minus(ikp x, ikp y,ikpcb* pcb){ ikrt_fl_minus(ikptr x, ikptr y,ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = flonum_data(x) - flonum_data(y); flonum_data(r) = flonum_data(x) - flonum_data(y);
return r; return r;
} }
ikp ikptr
ikrt_fl_times(ikp x, ikp y,ikpcb* pcb){ ikrt_fl_times(ikptr x, ikptr y,ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = flonum_data(x) * flonum_data(y); flonum_data(r) = flonum_data(x) * flonum_data(y);
return r; return r;
} }
ikp ikptr
ikrt_fl_div(ikp x, ikp y,ikpcb* pcb){ ikrt_fl_div(ikptr x, ikptr y,ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = flonum_data(x) / flonum_data(y); flonum_data(r) = flonum_data(x) / flonum_data(y);
return r; return r;
} }
ikp ikptr
ikrt_fl_invert(ikp x, ikpcb* pcb){ ikrt_fl_invert(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = 1.0 / flonum_data(x); flonum_data(r) = 1.0 / flonum_data(x);
return r; return r;
} }
ikp ikptr
ikrt_fl_sin(ikp x, ikpcb* pcb){ ikrt_fl_sin(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = sin(flonum_data(x)); flonum_data(r) = sin(flonum_data(x));
return r; return r;
} }
ikp ikptr
ikrt_fl_cos(ikp x, ikpcb* pcb){ ikrt_fl_cos(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = cos(flonum_data(x)); flonum_data(r) = cos(flonum_data(x));
return r; return r;
} }
ikp ikptr
ikrt_fl_tan(ikp x, ikpcb* pcb){ ikrt_fl_tan(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = tan(flonum_data(x)); flonum_data(r) = tan(flonum_data(x));
return r; return r;
} }
ikp ikptr
ikrt_fl_asin(ikp x, ikpcb* pcb){ ikrt_fl_asin(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = asin(flonum_data(x)); flonum_data(r) = asin(flonum_data(x));
return r; return r;
} }
ikp ikptr
ikrt_fl_acos(ikp x, ikpcb* pcb){ ikrt_fl_acos(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = acos(flonum_data(x)); flonum_data(r) = acos(flonum_data(x));
return r; return r;
} }
ikp ikptr
ikrt_fl_atan(ikp x, ikpcb* pcb){ ikrt_fl_atan(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = atan(flonum_data(x)); flonum_data(r) = atan(flonum_data(x));
return r; return r;
} }
@ -146,99 +146,99 @@ ikrt_fl_atan(ikp x, ikpcb* pcb){
ikp ikptr
ikrt_fl_sqrt(ikp x, ikpcb* pcb){ ikrt_fl_sqrt(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = sqrt(flonum_data(x)); flonum_data(r) = sqrt(flonum_data(x));
return r; return r;
} }
ikp ikptr
ikrt_fl_log(ikp x, ikpcb* pcb){ ikrt_fl_log(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = log(flonum_data(x)); flonum_data(r) = log(flonum_data(x));
return r; return r;
} }
ikp ikptr
ikrt_fx_sin(ikp x, ikpcb* pcb){ ikrt_fx_sin(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = sin(unfix(x)); flonum_data(r) = sin(unfix(x));
return r; return r;
} }
ikp ikptr
ikrt_fx_cos(ikp x, ikpcb* pcb){ ikrt_fx_cos(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = cos(unfix(x)); flonum_data(r) = cos(unfix(x));
return r; return r;
} }
ikp ikptr
ikrt_fx_tan(ikp x, ikpcb* pcb){ ikrt_fx_tan(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = tan(unfix(x)); flonum_data(r) = tan(unfix(x));
return r; return r;
} }
ikp ikptr
ikrt_fx_asin(ikp x, ikpcb* pcb){ ikrt_fx_asin(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = asin(unfix(x)); flonum_data(r) = asin(unfix(x));
return r; return r;
} }
ikp ikptr
ikrt_fx_acos(ikp x, ikpcb* pcb){ ikrt_fx_acos(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = acos(unfix(x)); flonum_data(r) = acos(unfix(x));
return r; return r;
} }
ikp ikptr
ikrt_fx_atan(ikp x, ikpcb* pcb){ ikrt_fx_atan(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = atan(unfix(x)); flonum_data(r) = atan(unfix(x));
return r; return r;
} }
ikp ikptr
ikrt_fx_sqrt(ikp x, ikpcb* pcb){ ikrt_fx_sqrt(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = sqrt(unfix(x)); flonum_data(r) = sqrt(unfix(x));
return r; return r;
} }
ikp ikptr
ikrt_fx_log(ikp x, ikpcb* pcb){ ikrt_fx_log(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = log(unfix(x)); flonum_data(r) = log(unfix(x));
return r; return r;
} }
ikp ikptr
ikrt_fixnum_to_flonum(ikp x, ikpcb* pcb){ ikrt_fixnum_to_flonum(ikptr x, ikpcb* pcb){
ikp r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag; ikptr r = ik_unsafe_alloc(pcb, flonum_size) + vector_tag;
ref(r, -vector_tag) = (ikp)flonum_tag; ref(r, -vector_tag) = (ikptr)flonum_tag;
flonum_data(r) = unfix(x); flonum_data(r) = unfix(x);
return r; return r;
} }
ikp ikptr
ikrt_fl_equal(ikp x, ikp y){ ikrt_fl_equal(ikptr x, ikptr y){
if(flonum_data(x) == flonum_data(y)){ if(flonum_data(x) == flonum_data(y)){
return true_object; return true_object;
} else { } else {
@ -246,8 +246,8 @@ ikrt_fl_equal(ikp x, ikp y){
} }
} }
ikp ikptr
ikrt_fl_less_or_equal(ikp x, ikp y){ ikrt_fl_less_or_equal(ikptr x, ikptr y){
if(flonum_data(x) <= flonum_data(y)){ if(flonum_data(x) <= flonum_data(y)){
return true_object; return true_object;
} else { } else {
@ -255,8 +255,8 @@ ikrt_fl_less_or_equal(ikp x, ikp y){
} }
} }
ikp ikptr
ikrt_fl_less(ikp x, ikp y){ ikrt_fl_less(ikptr x, ikptr y){
if(flonum_data(x) < flonum_data(y)){ if(flonum_data(x) < flonum_data(y)){
return true_object; return true_object;
} else { } else {

22
src/ikarus-io.c
View File

@ -8,7 +8,7 @@
#include "ikarus-data.h" #include "ikarus-data.h"
ikp ikptr
ikrt_io_error(){ ikrt_io_error(){
switch(errno){ switch(errno){
case EBADF : return fix(-2); case EBADF : return fix(-2);
@ -36,8 +36,8 @@ ikrt_io_error(){
} }
ikp ikptr
ikrt_close_fd(ikp fd, ikpcb* pcb){ ikrt_close_fd(ikptr fd, ikpcb* pcb){
int err = close(unfix(fd)); int err = close(unfix(fd));
if(err == -1){ if(err == -1){
return ikrt_io_error(); return ikrt_io_error();
@ -46,8 +46,8 @@ ikrt_close_fd(ikp fd, ikpcb* pcb){
} }
} }
ikp ikptr
ikrt_open_input_fd(ikp 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*)(fn+off_bytevector_data), O_RDONLY, 0);
if(fh > 0){ if(fh > 0){
return fix(fh); return fix(fh);
@ -56,8 +56,8 @@ ikrt_open_input_fd(ikp fn, ikpcb* pcb){
} }
} }
ikp ikptr
ikrt_open_output_fd(ikp fn, ikp ikopts, ikpcb* pcb){ ikrt_open_output_fd(ikptr fn, ikptr ikopts, ikpcb* pcb){
int opts = unfix(ikopts); int opts = unfix(ikopts);
int mode = 0; int mode = 0;
switch (opts){ switch (opts){
@ -86,8 +86,8 @@ ikrt_open_output_fd(ikp fn, ikp ikopts, ikpcb* pcb){
ikp ikptr
ikrt_read_fd(ikp fd, ikp bv, ikp off, ikp 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*)(bv+off_bytevector_data+unfix(off)),
@ -99,8 +99,8 @@ ikrt_read_fd(ikp fd, ikp bv, ikp off, ikp cnt, ikpcb* pcb){
} }
} }
ikp ikptr
ikrt_write_fd(ikp fd, ikp bv, ikp off, ikp 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*)(bv+off_bytevector_data+unfix(off)),

6
src/ikarus-main.c
View File

@ -158,12 +158,12 @@ int main(int argc, char** argv){
ikpcb* pcb = ik_make_pcb(); ikpcb* pcb = ik_make_pcb();
the_pcb = pcb; the_pcb = pcb;
{ /* set up arg_list */ { /* set up arg_list */
ikp arg_list = null_object; ikptr arg_list = null_object;
int i = argc-1; int i = argc-1;
while(i > 0){ while(i > 0){
char* s = argv[i]; char* s = argv[i];
int n = strlen(s); int n = strlen(s);
ikp str = ik_unsafe_alloc(pcb, align(n*string_char_size+disp_string_data+1)) ikptr str = ik_unsafe_alloc(pcb, align(n*string_char_size+disp_string_data+1))
+ string_tag; + string_tag;
ref(str, off_string_length) = fix(n); ref(str, off_string_length) = fix(n);
{ {
@ -172,7 +172,7 @@ int main(int argc, char** argv){
string_set(str, i, integer_to_char(s[i])); string_set(str, i, integer_to_char(s[i]));
} }
} }
ikp p = ik_unsafe_alloc(pcb, pair_size); ikptr p = ik_unsafe_alloc(pcb, pair_size);
ref(p, disp_car) = str; ref(p, disp_car) = str;
ref(p, disp_cdr) = arg_list; ref(p, disp_cdr) = arg_list;
arg_list = p+pair_tag; arg_list = p+pair_tag;

380
src/ikarus-numerics.c
View File

File diff suppressed because it is too large Load Diff

20
src/ikarus-print.c
View File

@ -22,13 +22,13 @@
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
static void print(FILE* fh, ikp x); static void print(FILE* fh, ikptr x);
void ik_fprint(FILE* fh, ikp x){ void ik_fprint(FILE* fh, ikptr x){
print(fh, x); print(fh, x);
} }
void ik_print(ikp x){ void ik_print(ikptr x){
print(stdout, x); print(stdout, x);
fprintf(stdout, "\n"); fprintf(stdout, "\n");
} }
@ -56,7 +56,7 @@ static char* char_string[128] = {
static void static void
print(FILE* fh, ikp x){ print(FILE* fh, ikptr x){
if(IK_FIXNUMP(x)){ if(IK_FIXNUMP(x)){
fprintf(fh, "%d", IK_UNFIX(x)); fprintf(fh, "%d", IK_UNFIX(x));
} }
@ -74,19 +74,19 @@ print(FILE* fh, ikp x){
} }
#if 0 #if 0
else if(tagof(x) == symbol_tag){ else if(tagof(x) == symbol_tag){
ikp str = ref(x, off_symbol_string); ikptr str = ref(x, off_symbol_string);
fprintf(fh, "%s", str+off_string_data); fprintf(fh, "%s", str+off_string_data);
} }
#endif #endif
else if(tagof(x) == vector_tag){ else if(tagof(x) == vector_tag){
ikp len = ref(x, off_vector_length); ikptr len = ref(x, off_vector_length);
if(len == 0){ if(len == 0){
fprintf(fh, "#()"); fprintf(fh, "#()");
} else { } else {
fprintf(fh, "#("); fprintf(fh, "#(");
ikp data = x + off_vector_data; ikptr data = x + off_vector_data;
print(fh, ref(data, 0)); print(fh, ref(data, 0));
ikp i = (ikp)wordsize; ikptr i = (ikptr)wordsize;
while(i<len){ while(i<len){
fprintf(fh, " "); fprintf(fh, " ");
print(fh, ref(data,i)); print(fh, ref(data,i));
@ -101,7 +101,7 @@ print(FILE* fh, ikp x){
else if(IK_PAIRP(x)){ else if(IK_PAIRP(x)){
fprintf(fh, "("); fprintf(fh, "(");
print(fh, REF(x, IK_OFF_CAR)); print(fh, REF(x, IK_OFF_CAR));
ikp d = REF(x, IK_OFF_CDR); ikptr d = REF(x, IK_OFF_CDR);
fprintf(stderr, "d=0x%08x\n", (int)d); fprintf(stderr, "d=0x%08x\n", (int)d);
while(1){ while(1){
if(IK_PAIRP(d)){ if(IK_PAIRP(d)){
@ -122,7 +122,7 @@ print(FILE* fh, ikp x){
} }
} }
else if(tagof(x) == string_tag){ else if(tagof(x) == string_tag){
ikp fxlen = ref(x, off_string_length); ikptr fxlen = ref(x, off_string_length);
int len = unfix(fxlen); int len = unfix(fxlen);
fprintf(stderr, "bug: printer busted!\n"); fprintf(stderr, "bug: printer busted!\n");
exit(-1); exit(-1);

14
src/ikarus-process.c
View File

@ -6,10 +6,10 @@
#include "ikarus-data.h" #include "ikarus-data.h"
#include <errno.h> #include <errno.h>
extern ikp ikrt_io_error(); extern ikptr ikrt_io_error();
static int static int
list_length(ikp x){ list_length(ikptr x){
int n = 0; int n = 0;
while(tagof(x) == pair_tag){ while(tagof(x) == pair_tag){
n++; n++;
@ -19,7 +19,7 @@ list_length(ikp x){
} }
static char** static char**
list_to_vec(ikp x){ list_to_vec(ikptr x){
int n = list_length(x); int n = list_length(x);
char** vec = malloc((n+1) * sizeof(char*)); char** vec = malloc((n+1) * sizeof(char*));
if (vec == NULL) exit(-1); if (vec == NULL) exit(-1);
@ -32,8 +32,8 @@ list_to_vec(ikp x){
return vec; return vec;
} }
ikp ikptr
ikrt_process(ikp rvec, ikp cmd, ikp argv, ikpcb* pcb){ ikrt_process(ikptr rvec, ikptr cmd, ikptr argv, ikpcb* pcb){
int infds[2]; int infds[2];
int outfds[2]; int outfds[2];
int errfds[2]; int errfds[2];
@ -72,8 +72,8 @@ ikrt_process(ikp rvec, ikp cmd, ikp argv, ikpcb* pcb){
} }
} }
ikp ikptr
ikrt_waitpid(ikp pid, ikpcb* pcb){ ikrt_waitpid(ikptr pid, ikpcb* pcb){
int status; int status;
waitpid(unfix(pid), &status, 0); waitpid(unfix(pid), &status, 0);
return fix(status); return fix(status);

196
src/ikarus-runtime.c
View File

@ -50,9 +50,9 @@ void* ik_mmap(int size);
void ik_munmap(void* mem, int size); void ik_munmap(void* mem, int size);
static void static void
extend_table_maybe(unsigned char*p, int size, ikpcb* pcb){ extend_table_maybe(char*p, int size, ikpcb* pcb){
assert(size == align_to_next_page(size)); assert(size == align_to_next_page(size));
unsigned char* q = p + size; char* q = p + size;
if(p < pcb->memory_base){ if(p < pcb->memory_base){
int new_lo = segment_index(p); int new_lo = segment_index(p);
int old_lo = segment_index(pcb->memory_base); int old_lo = segment_index(pcb->memory_base);
@ -65,13 +65,13 @@ extend_table_maybe(unsigned char*p, int size, ikpcb* pcb){
ik_munmap(pcb->dirty_vector_base, old_vec_size); ik_munmap(pcb->dirty_vector_base, old_vec_size);
pcb->dirty_vector_base = (unsigned int*) v; pcb->dirty_vector_base = (unsigned int*) v;
pcb->dirty_vector = (unsigned int*)(v - new_lo * pagesize); pcb->dirty_vector = (unsigned int*)(v - new_lo * pagesize);
unsigned char* s = ik_mmap(new_vec_size); char* s = ik_mmap(new_vec_size);
bzero(s, new_vec_size - old_vec_size); bzero(s, new_vec_size - old_vec_size);
memcpy(s+new_vec_size-old_vec_size, pcb->segment_vector_base, old_vec_size); memcpy(s+new_vec_size-old_vec_size, pcb->segment_vector_base, old_vec_size);
ik_munmap(pcb->segment_vector_base, old_vec_size); ik_munmap(pcb->segment_vector_base, old_vec_size);
pcb->segment_vector_base = (unsigned int*) s; pcb->segment_vector_base = (unsigned int*) s;
pcb->segment_vector = (unsigned int*)(s - new_lo * pagesize); pcb->segment_vector = (unsigned int*)(s - new_lo * pagesize);
pcb->memory_base = (unsigned char*)(new_lo * segment_size); pcb->memory_base = (char*)(new_lo * segment_size);
} }
else if (q > pcb->memory_end){ else if (q > pcb->memory_end){
int lo = segment_index(pcb->memory_base); int lo = segment_index(pcb->memory_base);
@ -79,25 +79,25 @@ extend_table_maybe(unsigned char*p, int size, ikpcb* pcb){
int new_hi = segment_index(q+segment_size-1); int new_hi = segment_index(q+segment_size-1);
int new_vec_size = (new_hi - lo) * pagesize; int new_vec_size = (new_hi - lo) * pagesize;
int old_vec_size = (old_hi - lo) * pagesize; int old_vec_size = (old_hi - lo) * pagesize;
unsigned char* v = ik_mmap(new_vec_size); char* v = ik_mmap(new_vec_size);
memcpy(v, pcb->dirty_vector_base, old_vec_size); memcpy(v, pcb->dirty_vector_base, old_vec_size);
bzero(v+old_vec_size, new_vec_size - old_vec_size); bzero(v+old_vec_size, new_vec_size - old_vec_size);
ik_munmap(pcb->dirty_vector_base, old_vec_size); ik_munmap(pcb->dirty_vector_base, old_vec_size);
pcb->dirty_vector_base = (unsigned int*) v; pcb->dirty_vector_base = (unsigned int*) v;
pcb->dirty_vector = (unsigned int*)(v - lo * pagesize); pcb->dirty_vector = (unsigned int*)(v - lo * pagesize);
unsigned char* s = ik_mmap(new_vec_size); char* s = ik_mmap(new_vec_size);
memcpy(s, pcb->segment_vector_base, old_vec_size); memcpy(s, pcb->segment_vector_base, old_vec_size);
bzero(s+old_vec_size, new_vec_size - old_vec_size); bzero(s+old_vec_size, new_vec_size - old_vec_size);
ik_munmap(pcb->segment_vector_base, old_vec_size); ik_munmap(pcb->segment_vector_base, old_vec_size);
pcb->segment_vector_base = (unsigned int*) s; pcb->segment_vector_base = (unsigned int*) s;
pcb->segment_vector = (unsigned int*)(s - lo * pagesize); pcb->segment_vector = (unsigned int*)(s - lo * pagesize);
pcb->memory_end = (unsigned char*)(new_hi * segment_size); pcb->memory_end = (char*)(new_hi * segment_size);
} }
} }
static void static void
set_segment_type(unsigned char* base, int size, unsigned int type, ikpcb* pcb){ set_segment_type(char* 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,7 +110,7 @@ set_segment_type(unsigned char* base, int size, unsigned int type, ikpcb* pcb){
} }
void void
ik_munmap_from_segment(unsigned char* base, int size, ikpcb* pcb){ ik_munmap_from_segment(char* 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));
@ -147,7 +147,7 @@ ik_munmap_from_segment(unsigned char* base, int size, ikpcb* pcb){
void* void*
ik_mmap_typed(int size, unsigned int type, ikpcb* pcb){ ik_mmap_typed(int size, unsigned int type, ikpcb* pcb){
unsigned char* p; char* p;
if(size == pagesize) { if(size == pagesize) {
ikpage* s = pcb->cached_pages; ikpage* s = pcb->cached_pages;
if(s){ if(s){
@ -180,7 +180,7 @@ ik_mmap_data(int size, int gen, ikpcb* pcb){
void* void*
ik_mmap_code(int size, int gen, ikpcb* pcb){ ik_mmap_code(int size, int gen, ikpcb* pcb){
ikp 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){
set_segment_type(p+pagesize, size-pagesize, data_mt|gen, pcb); set_segment_type(p+pagesize, size-pagesize, data_mt|gen, pcb);
} }
@ -295,7 +295,7 @@ ikpcb* ik_make_pcb(){
{ /* make cache ikpage */ { /* make cache ikpage */
ikpage* p = ik_mmap(CACHE_SIZE * sizeof(ikpage)); ikpage* p = ik_mmap(CACHE_SIZE * sizeof(ikpage));
pcb->cached_pages_base = (ikp)p; pcb->cached_pages_base = (ikptr)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 +309,8 @@ ikpcb* ik_make_pcb(){
{ {
/* compute extent of heap and stack */ /* compute extent of heap and stack */
unsigned char* lo_mem; char* lo_mem;
unsigned char* hi_mem; char* 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;
@ -330,8 +330,8 @@ ikpcb* ik_make_pcb(){
bzero(svec, vec_size); bzero(svec, vec_size);
pcb->segment_vector_base = (unsigned int*) (svec); pcb->segment_vector_base = (unsigned int*) (svec);
pcb->segment_vector = (unsigned int*) (svec - lo_seg * pagesize); pcb->segment_vector = (unsigned int*) (svec - lo_seg * pagesize);
pcb->memory_base = (unsigned char*)(lo_seg * segment_size); pcb->memory_base = (char*)(lo_seg * segment_size);
pcb->memory_end = (unsigned char*)(hi_seg * segment_size); pcb->memory_end = (char*)(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,
@ -343,9 +343,9 @@ ikpcb* ik_make_pcb(){
} }
/* initialize base rtd */ /* initialize base rtd */
{ {
ikp r = ik_unsafe_alloc(pcb, align(rtd_size)) + rtd_tag; ikptr r = ik_unsafe_alloc(pcb, align(rtd_size)) + rtd_tag;
ref(r, off_rtd_rtd) = r; ref(r, off_rtd_rtd) = r;
ref(r, off_rtd_length) = (ikp) (rtd_size-wordsize); ref(r, off_rtd_length) = (ikptr) (rtd_size-wordsize);
ref(r, off_rtd_name) = 0; ref(r, off_rtd_name) = 0;
ref(r, off_rtd_fields) = 0; ref(r, off_rtd_fields) = 0;
ref(r, off_rtd_printer) = 0; ref(r, off_rtd_printer) = 0;
@ -375,15 +375,15 @@ void ik_delete_pcb(ikpcb* pcb){
} }
} }
} }
unsigned char* base = pcb->memory_base; char* base = pcb->memory_base;
unsigned char* end = pcb->memory_end; char* end = pcb->memory_end;
unsigned int* segment_vec = pcb->segment_vector; unsigned int* segment_vec = pcb->segment_vector;
int i = page_index(base); int i = page_index(base);
int j = page_index(end); int j = page_index(end);
while(i < j){ while(i < j){
unsigned int t = segment_vec[i]; unsigned int t = segment_vec[i];
if(t != hole_mt){ if(t != hole_mt){
ik_munmap((ikp)(i<<pageshift), pagesize); ik_munmap((ikptr)(i<<pageshift), pagesize);
} }
i++; i++;
} }
@ -393,21 +393,21 @@ void ik_delete_pcb(ikpcb* pcb){
ik_free(pcb, sizeof(ikpcb)); ik_free(pcb, sizeof(ikpcb));
} }
ikp ikptr
ik_safe_alloc(ikpcb* pcb, int size){ ik_safe_alloc(ikpcb* pcb, int size){
assert(size == align(size)); assert(size == align(size));
ikp ap = pcb->allocation_pointer; ikptr ap = pcb->allocation_pointer;
ikp ep = pcb->heap_base + pcb->heap_size; ikptr ep = pcb->heap_base + pcb->heap_size;
ikp nap = ap + size; ikptr nap = ap + size;
if(nap < ep){ if(nap < ep){
pcb->allocation_pointer = nap; pcb->allocation_pointer = nap;
return ap; return ap;
} }
else { else {
ik_collect(size, pcb); ik_collect(size, pcb);
ikp ap = pcb->allocation_pointer; ikptr ap = pcb->allocation_pointer;
ikp ep = pcb->heap_base + pcb->heap_size; ikptr ep = pcb->heap_base + pcb->heap_size;
ikp nap = ap + size; ikptr nap = ap + size;
if(nap < ep){ if(nap < ep){
pcb->allocation_pointer = nap; pcb->allocation_pointer = nap;
return ap; return ap;
@ -423,12 +423,12 @@ ik_safe_alloc(ikpcb* pcb, int size){
ikp ikptr
ik_unsafe_alloc(ikpcb* pcb, int size){ ik_unsafe_alloc(ikpcb* pcb, int size){
assert(size == align(size)); assert(size == align(size));
ikp ap = pcb->allocation_pointer; ikptr ap = pcb->allocation_pointer;
ikp ep = pcb->heap_base + pcb->heap_size; ikptr ep = pcb->heap_base + pcb->heap_size;
ikp nap = ap + size; ikptr nap = ap + size;
if(nap < ep){ if(nap < ep){
pcb->allocation_pointer = nap; pcb->allocation_pointer = nap;
return ap; return ap;
@ -468,7 +468,7 @@ ik_unsafe_alloc(ikpcb* pcb, int size){
void ik_error(ikp args){ void ik_error(ikptr args){
fprintf(stderr, "Error: "); fprintf(stderr, "Error: ");
ik_fprint(stderr, args); ik_fprint(stderr, args);
fprintf(stderr, "\n"); fprintf(stderr, "\n");
@ -482,13 +482,13 @@ void ik_stack_overflow(ikpcb* pcb){
#endif #endif
set_segment_type(pcb->stack_base, pcb->stack_size, data_mt, pcb); set_segment_type(pcb->stack_base, pcb->stack_size, data_mt, pcb);
ikp frame_base = pcb->frame_base; ikptr frame_base = pcb->frame_base;
ikp underflow_handler = ref(frame_base, -wordsize); ikptr underflow_handler = ref(frame_base, -wordsize);
#ifndef NDEBUG #ifndef NDEBUG
fprintf(stderr, "underflow_handler = 0x%08x\n", (int)underflow_handler); fprintf(stderr, "underflow_handler = 0x%08x\n", (int)underflow_handler);
#endif #endif
/* capture continuation and set it as next_k */ /* capture continuation and set it as next_k */
ikp k = ik_unsafe_alloc(pcb, align(continuation_size)) + vector_tag; ikptr k = ik_unsafe_alloc(pcb, align(continuation_size)) + vector_tag;
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) =
@ -520,7 +520,7 @@ char* ik_uuid(char* str){
static const char* uuid_chars = static const char* uuid_chars =
"!$%&/0123456789<=>?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"; "!$%&/0123456789<=>?ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
static int uuid_strlen = 1; static int uuid_strlen = 1;
ikp ik_uuid(ikp str){ ikptr ik_uuid(ikptr str){
static int fd = -1; static int fd = -1;
if(fd == -1){ if(fd == -1){
fd = open("/dev/urandom", O_RDONLY); fd = open("/dev/urandom", O_RDONLY);
@ -530,10 +530,10 @@ ikp ik_uuid(ikp str){
uuid_strlen = strlen(uuid_chars); uuid_strlen = strlen(uuid_chars);
} }
int n = unfix(ref(str, off_bytevector_length)); int n = unfix(ref(str, off_bytevector_length));
unsigned char* data = str+off_bytevector_data; char* data = str+off_bytevector_data;
read(fd, data, n); read(fd, data, n);
unsigned char* p = data; char* p = data;
unsigned char* q = data + n; char* q = data + n;
while(p < q){ while(p < q){
*p = uuid_chars[*p % uuid_strlen]; *p = uuid_chars[*p % uuid_strlen];
p++; p++;
@ -563,8 +563,8 @@ ERRORS
[EIO] An I/O error occurred while reading from or writing to [EIO] An I/O error occurred while reading from or writing to
the file system. the file system.
*/ */
ikp ikptr
ikrt_file_exists(ikp 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*)filename + off_bytevector_data;
@ -634,8 +634,8 @@ ikrt_file_exists(ikp filename){
*/ */
ikp ikptr
ikrt_delete_file(ikp 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*) filename + off_bytevector_data;
@ -665,8 +665,8 @@ ikrt_delete_file(ikp filename){
ikp ikptr
ik_system(ikp 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*)str+off_bytevector_data));
} else { } else {
@ -686,14 +686,14 @@ mtname(unsigned int n){
return "WHAT_T"; return "WHAT_T";
} }
ikp 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;
unsigned char* p = pcb->memory_base; char* p = pcb->memory_base;
unsigned char* hi = pcb->memory_end; char* hi = pcb->memory_end;
while(p < hi){ while(p < hi){
unsigned int t = *s & type_mask; unsigned int t = *s & type_mask;
unsigned char* start = p; char* start = p;
p += pagesize; p += pagesize;
s++; s++;
while((p < hi) && ((*s & type_mask) == t)){ while((p < hi) && ((*s & type_mask) == t)){
@ -708,14 +708,14 @@ ik_dump_metatable(ikpcb* pcb){
return void_object; return void_object;
} }
ikp 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;
unsigned char* p = pcb->memory_base; char* p = pcb->memory_base;
unsigned char* hi = pcb->memory_end; char* hi = pcb->memory_end;
while(p < hi){ while(p < hi){
unsigned int t = *s; unsigned int t = *s;
unsigned char* start = p; char* start = p;
p += pagesize; p += pagesize;
s++; s++;
while((p < hi) && (*s == t)){ while((p < hi) && (*s == t)){
@ -730,12 +730,12 @@ ik_dump_dirty_vector(ikpcb* pcb){
return void_object; return void_object;
} }
ikp ikptr
ikrt_make_code(ikp codesizeptr, ikp freevars, ikp 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); int code_size = unfix(codesizeptr);
int memreq = align_to_next_page(code_size + disp_code_data); int memreq = align_to_next_page(code_size + disp_code_data);
ikp mem = ik_mmap_code(memreq, 0, pcb); ikptr mem = ik_mmap_code(memreq, 0, pcb);
bzero(mem, memreq); bzero(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;
@ -746,16 +746,16 @@ ikrt_make_code(ikp codesizeptr, ikp freevars, ikp rvec, ikpcb* pcb){
return mem+vector_tag; return mem+vector_tag;
} }
ikp ikptr
ikrt_set_code_reloc_vector(ikp code, ikp 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; pcb->dirty_vector[page_index(code)] = -1;
return void_object; return void_object;
} }
ikp ikptr
ikrt_set_code_annotation(ikp code, ikp 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; pcb->dirty_vector[page_index(code)] = -1;
return void_object; return void_object;
@ -763,8 +763,8 @@ ikrt_set_code_annotation(ikp code, ikp annot, ikpcb* pcb){
ikp ikptr
ikrt_bvftime(ikp outbv, ikp fmtbv){ ikrt_bvftime(ikptr outbv, ikptr fmtbv){
time_t t; time_t t;
struct tm* tmp; struct tm* tmp;
t = time(NULL); t = time(NULL);
@ -783,8 +783,8 @@ ikrt_bvftime(ikp outbv, ikp fmtbv){
return fix(rv); return fix(rv);
} }
ikp ikptr
ikrt_register_guardian_pair(ikp p0, ikpcb* pcb){ 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);
@ -798,9 +798,9 @@ ikrt_register_guardian_pair(ikp p0, ikpcb* pcb){
return void_object; return void_object;
} }
ikp ikptr
ikrt_register_guardian(ikp tc, ikp obj, ikpcb* pcb){ ikrt_register_guardian(ikptr tc, ikptr obj, ikpcb* pcb){
ikp p0 = ik_unsafe_alloc(pcb, pair_size) + pair_tag; ikptr p0 = ik_unsafe_alloc(pcb, pair_size) + pair_tag;
ref(p0, off_car) = tc; ref(p0, off_car) = tc;
ref(p0, off_cdr) = obj; ref(p0, off_cdr) = obj;
return ikrt_register_guardian_pair(p0, pcb); return ikrt_register_guardian_pair(p0, pcb);
@ -809,8 +809,8 @@ ikrt_register_guardian(ikp tc, ikp obj, ikpcb* pcb){
ikp ikptr
ikrt_stats_now(ikp t, ikpcb* pcb){ ikrt_stats_now(ikptr t, ikpcb* pcb){
struct rusage r; struct rusage r;
struct timeval s; struct timeval s;
@ -832,8 +832,8 @@ ikrt_stats_now(ikp t, ikpcb* pcb){
return void_object; return void_object;
} }
ikp ikptr
ikrt_current_time(ikp t){ ikrt_current_time(ikptr t){
struct timeval s; struct timeval s;
gettimeofday(&s, 0); gettimeofday(&s, 0);
/* this will break in 8,727,224 years if we stay in 32-bit ptrs */ /* this will break in 8,727,224 years if we stay in 32-bit ptrs */
@ -843,8 +843,8 @@ ikrt_current_time(ikp t){
return t; return t;
} }
ikp ikptr
ikrt_gmt_offset(ikp t){ ikrt_gmt_offset(ikptr t){
time_t clock = time_t clock =
unfix(ref(t, off_record_data + 0*wordsize)) * 1000000 unfix(ref(t, off_record_data + 0*wordsize)) * 1000000
+ unfix(ref(t, off_record_data + 1*wordsize)); + unfix(ref(t, off_record_data + 1*wordsize));
@ -853,7 +853,7 @@ ikrt_gmt_offset(ikp t){
return fix(clock - gmtclock); return fix(clock - gmtclock);
/* /*
struct tm* m = localtime(&clock); struct tm* m = localtime(&clock);
ikp r = fix(m->tm_gmtoff); ikptr r = fix(m->tm_gmtoff);
return r; return r;
*/ */
} }
@ -861,7 +861,7 @@ ikrt_gmt_offset(ikp t){
ikp ikptr
ikrt_bytes_allocated(ikpcb* pcb){ ikrt_bytes_allocated(ikpcb* pcb){
int bytes_in_heap = ((int) pcb->allocation_pointer) - int bytes_in_heap = ((int) pcb->allocation_pointer) -
((int) pcb->heap_base); ((int) pcb->heap_base);
@ -870,13 +870,13 @@ ikrt_bytes_allocated(ikpcb* pcb){
} }
ikp ikptr
ikrt_bytes_allocated_major(ikpcb* pcb){ ikrt_bytes_allocated_major(ikpcb* pcb){
return fix(pcb->allocation_count_major); return fix(pcb->allocation_count_major);
} }
ikp ikptr
ikrt_fork(){ ikrt_fork(){
int pid = fork(); int pid = fork();
return fix(pid); return fix(pid);
@ -884,19 +884,19 @@ ikrt_fork(){
ikp ikptr
ikrt_getenv(ikp bv, ikpcb* pcb){ ikrt_getenv(ikptr bv, ikpcb* pcb){
char* v = getenv((char*)bv + off_bytevector_data); char* v = getenv((char*)bv + off_bytevector_data);
if(v){ if(v){
int n = strlen(v); int n = strlen(v);
ikp 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(s+off_bytevector_data, v, n+1);
return s; return s;
} }
else { else {
ikp s = ik_safe_alloc(pcb, align(disp_bytevector_data+1)) ikptr s = ik_safe_alloc(pcb, align(disp_bytevector_data+1))
+ bytevector_tag; + bytevector_tag;
ref(s, -bytevector_tag) = fix(0); ref(s, -bytevector_tag) = fix(0);
ref(s, off_bytevector_data) = 0; ref(s, off_bytevector_data) = 0;
@ -904,10 +904,10 @@ ikrt_getenv(ikp bv, ikpcb* pcb){
} }
} }
ikp ikptr
ikrt_make_vector1(ikp len, ikpcb* pcb){ ikrt_make_vector1(ikptr len, ikpcb* pcb){
if(is_fixnum(len) && (((int)len) >= 0)){ if(is_fixnum(len) && (((int)len) >= 0)){
ikp s = ik_safe_alloc(pcb, align(((int)len) + disp_vector_data)); ikptr s = ik_safe_alloc(pcb, align(((int)len) + disp_vector_data));
ref(s, 0) = len; ref(s, 0) = len;
memset(s+disp_vector_data, 0, (int)len); memset(s+disp_vector_data, 0, (int)len);
return s+vector_tag; return s+vector_tag;
@ -917,11 +917,11 @@ ikrt_make_vector1(ikp len, ikpcb* pcb){
} }
#if 0 #if 0
ikp ikptr
ikrt_make_vector2(ikp len, ikp obj, ikpcb* pcb){ ikrt_make_vector2(ikptr len, ikptr obj, ikpcb* pcb){
if(is_fixnum(len) && ((len >> 31)!=0)){ if(is_fixnum(len) && ((len >> 31)!=0)){
pcb->root0 = &obj; pcb->root0 = &obj;
ikp s = ik_safe_alloc(pcb, align(((int)len) + disp_vector_data)); ikptr s = ik_safe_alloc(pcb, align(((int)len) + disp_vector_data));
pcb->root0 = 0; pcb->root0 = 0;
ref(s, 0) = len; ref(s, 0) = len;
memset(s+disp_vector_data, 0, (int)len); memset(s+disp_vector_data, 0, (int)len);
@ -933,8 +933,8 @@ ikrt_make_vector2(ikp len, ikp obj, ikpcb* pcb){
#endif #endif
ikp ikptr
ikrt_setenv(ikp key, ikp val, ikp 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*)key+off_bytevector_data,
@ -948,19 +948,19 @@ ikrt_setenv(ikp key, ikp val, ikp overwrite){
} }
ikp ikptr
ikrt_environ(ikpcb* pcb){ ikrt_environ(ikpcb* pcb){
fprintf(stderr, "environ busted!\n"); fprintf(stderr, "environ busted!\n");
exit(-1); exit(-1);
char** es = environ; char** es = environ;
int i; char* e; int i; char* e;
ikp 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); int n = strlen(e);
ikp 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(s+off_string_data, e, n+1);
ikp 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;
ac = p; ac = p;
@ -968,8 +968,8 @@ ikrt_environ(ikpcb* pcb){
return ac; return ac;
} }
ikp ikptr
ikrt_exit(ikp status, ikpcb* pcb){ ikrt_exit(ikptr status, ikpcb* pcb){
ik_delete_pcb(pcb); ik_delete_pcb(pcb);
assert(total_allocated_pages == 0); assert(total_allocated_pages == 0);
if(is_fixnum(status)){ if(is_fixnum(status)){
@ -979,8 +979,8 @@ ikrt_exit(ikp status, ikpcb* pcb){
} }
} }
ikp ikptr
ikrt_debug(ikp x){ ikrt_debug(ikptr x){
fprintf(stderr, "DEBUG 0x%08x\n", (int)x); fprintf(stderr, "DEBUG 0x%08x\n", (int)x);
return 0; return 0;
}; };

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

@ -22,18 +22,18 @@
#include <string.h> #include <string.h>
#include <stdlib.h> #include <stdlib.h>
static ikp static ikptr
make_symbol_table(ikpcb* pcb){ 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);
ikp 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(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;
} }
static int static int
compute_hash(ikp str){ compute_hash(ikptr str){
int len = unfix(ref(str, off_string_length)); int len = unfix(ref(str, off_string_length));
char* data = (char*) str + off_string_data; char* data = (char*) str + off_string_data;
int h = len; int h = len;
@ -51,13 +51,13 @@ compute_hash(ikp str){
return h; return h;
} }
ikp ikptr
ikrt_string_hash(ikp str){ ikrt_string_hash(ikptr str){
return (ikp)(compute_hash(str) & (~ fx_mask)); return (ikptr)(compute_hash(str) & (~ fx_mask));
} }
static int strings_eqp(ikp str1, ikp str2){ static int strings_eqp(ikptr str1, ikptr str2){
ikp 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(str1+off_string_data,
@ -69,9 +69,9 @@ static int strings_eqp(ikp str1, ikp str2){
} }
#if 0 #if 0
static ikp static ikptr
ik_make_symbol(ikp str, ikp ustr, ikpcb* pcb){ ik_make_symbol(ikptr str, ikptr ustr, ikpcb* pcb){
ikp sym = ik_unsafe_alloc(pcb, symbol_size) + symbol_tag; ikptr sym = ik_unsafe_alloc(pcb, symbol_size) + symbol_tag;
ref(sym, off_symbol_string) = str; ref(sym, off_symbol_string) = str;
ref(sym, off_symbol_ustring) = ustr; ref(sym, off_symbol_ustring) = ustr;
ref(sym, off_symbol_value) = unbound_object; ref(sym, off_symbol_value) = unbound_object;
@ -84,9 +84,9 @@ ik_make_symbol(ikp str, ikp ustr, ikpcb* pcb){
} }
#endif #endif
static ikp static ikptr
ik_make_symbol(ikp str, ikp ustr, ikpcb* pcb){ ik_make_symbol(ikptr str, ikptr ustr, ikpcb* pcb){
ikp sym = ik_unsafe_alloc(pcb, symbol_record_size) + record_tag; ikptr sym = ik_unsafe_alloc(pcb, symbol_record_size) + record_tag;
ref(sym, -record_tag) = symbol_record_tag; ref(sym, -record_tag) = symbol_record_tag;
ref(sym, off_symbol_record_string) = str; ref(sym, off_symbol_record_string) = str;
ref(sym, off_symbol_record_ustring) = ustr; ref(sym, off_symbol_record_ustring) = ustr;
@ -98,21 +98,21 @@ ik_make_symbol(ikp str, ikp ustr, ikpcb* pcb){
static ikp static ikptr
intern_string(ikp str, ikp st, ikpcb* pcb){ intern_string(ikptr str, ikptr st, ikpcb* pcb){
int h = compute_hash(str); int h = compute_hash(str);
int idx = h & (unfix(ref(st, off_vector_length)) - 1); int idx = h & (unfix(ref(st, off_vector_length)) - 1);
ikp bckt = ref(st, off_vector_data + idx*wordsize); ikptr bckt = ref(st, off_vector_data + idx*wordsize);
ikp b = bckt; ikptr b = bckt;
while(b){ while(b){
ikp sym = ref(b, off_car); ikptr sym = ref(b, off_car);
ikp sym_str = ref(sym, off_symbol_record_string); ikptr sym_str = ref(sym, off_symbol_record_string);
if(strings_eqp(sym_str, str)){ if(strings_eqp(sym_str, str)){
return sym; return sym;
} }
b = ref(b, off_cdr); b = ref(b, off_cdr);
} }
ikp sym = ik_make_symbol(str, false_object, pcb); ikptr sym = ik_make_symbol(str, false_object, pcb);
b = ik_unsafe_alloc(pcb, pair_size) + pair_tag; b = ik_unsafe_alloc(pcb, pair_size) + pair_tag;
ref(b, off_car) = sym; ref(b, off_car) = sym;
ref(b, off_cdr) = bckt; ref(b, off_cdr) = bckt;
@ -121,21 +121,21 @@ intern_string(ikp str, ikp st, ikpcb* pcb){
return sym; return sym;
} }
static ikp static ikptr
intern_unique_string(ikp str, ikp ustr, ikp st, ikpcb* pcb){ intern_unique_string(ikptr str, ikptr ustr, ikptr st, ikpcb* pcb){
int h = compute_hash(ustr); int h = compute_hash(ustr);
int idx = h & (unfix(ref(st, off_vector_length)) - 1); int idx = h & (unfix(ref(st, off_vector_length)) - 1);
ikp bckt = ref(st, off_vector_data + idx*wordsize); ikptr bckt = ref(st, off_vector_data + idx*wordsize);
ikp b = bckt; ikptr b = bckt;
while(b){ while(b){
ikp sym = ref(b, off_car); ikptr sym = ref(b, off_car);
ikp sym_ustr = ref(sym, off_symbol_record_ustring); ikptr sym_ustr = ref(sym, off_symbol_record_ustring);
if(strings_eqp(sym_ustr, ustr)){ if(strings_eqp(sym_ustr, ustr)){
return sym; return sym;
} }
b = ref(b, off_cdr); b = ref(b, off_cdr);
} }
ikp sym = ik_make_symbol(str, ustr, pcb); ikptr sym = ik_make_symbol(str, ustr, pcb);
b = ik_unsafe_alloc(pcb, pair_size) + pair_tag; b = ik_unsafe_alloc(pcb, pair_size) + pair_tag;
ref(b, off_car) = sym; ref(b, off_car) = sym;
ref(b, off_cdr) = bckt; ref(b, off_cdr) = bckt;
@ -144,21 +144,21 @@ intern_unique_string(ikp str, ikp ustr, ikp st, ikpcb* pcb){
return sym; return sym;
} }
ikp ikptr
ikrt_intern_gensym(ikp sym, ikpcb* pcb){ ikrt_intern_gensym(ikptr sym, ikpcb* pcb){
ikp st = pcb->gensym_table; ikptr st = pcb->gensym_table;
if(st == 0){ if(st == 0){
st = make_symbol_table(pcb); st = make_symbol_table(pcb);
pcb->gensym_table = st; pcb->gensym_table = st;
} }
ikp ustr = ref(sym, off_symbol_record_ustring); ikptr ustr = ref(sym, off_symbol_record_ustring);
int h = compute_hash(ustr); int h = compute_hash(ustr);
int idx = h & (unfix(ref(st, off_vector_length)) - 1); int idx = h & (unfix(ref(st, off_vector_length)) - 1);
ikp bckt = ref(st, off_vector_data + idx*wordsize); ikptr bckt = ref(st, off_vector_data + idx*wordsize);
ikp b = bckt; ikptr b = bckt;
while(b){ while(b){
ikp sym = ref(b, off_car); ikptr sym = ref(b, off_car);
ikp sym_ustr = ref(sym, off_symbol_record_ustring); ikptr sym_ustr = ref(sym, off_symbol_record_ustring);
if(strings_eqp(sym_ustr, ustr)){ if(strings_eqp(sym_ustr, ustr)){
return false_object; return false_object;
} }
@ -175,9 +175,9 @@ ikrt_intern_gensym(ikp sym, ikpcb* pcb){
ikp ikptr
ikrt_string_to_symbol(ikp str, ikpcb* pcb){ ikrt_string_to_symbol(ikptr str, ikpcb* pcb){
ikp st = pcb->symbol_table; ikptr st = pcb->symbol_table;
if(st == 0){ if(st == 0){
st = make_symbol_table(pcb); st = make_symbol_table(pcb);
pcb->symbol_table = st; pcb->symbol_table = st;
@ -185,14 +185,14 @@ ikrt_string_to_symbol(ikp str, ikpcb* pcb){
return intern_string(str, st, pcb); return intern_string(str, st, pcb);
} }
ikp ikptr
ik_intern_string(ikp str, ikpcb* pcb){ ik_intern_string(ikptr str, ikpcb* pcb){
return ikrt_string_to_symbol(str, pcb); return ikrt_string_to_symbol(str, pcb);
} }
ikp ikptr
ikrt_strings_to_gensym(ikp str, ikp ustr, ikpcb* pcb){ ikrt_strings_to_gensym(ikptr str, ikptr ustr, ikpcb* pcb){
ikp st = pcb->gensym_table; ikptr st = pcb->gensym_table;
if(st == 0){ if(st == 0){
st = make_symbol_table(pcb); st = make_symbol_table(pcb);
pcb->gensym_table = st; pcb->gensym_table = st;
@ -202,14 +202,14 @@ ikrt_strings_to_gensym(ikp str, ikp ustr, ikpcb* pcb){
#if 0 #if 0
ikp ikptr
ik_cstring_to_symbol(char* str, ikpcb* pcb){ ik_cstring_to_symbol(char* str, ikpcb* pcb){
int n = strlen(str); int n = strlen(str);
int size = n + disp_string_data + 1; int size = n + disp_string_data + 1;
ikp s = ik_unsafe_alloc(pcb, align(size)) + string_tag; ikptr s = ik_unsafe_alloc(pcb, align(size)) + string_tag;
ref(s, off_string_length) = fix(n); ref(s, off_string_length) = fix(n);
memcpy(s+off_string_data, str, n+1); memcpy(s+off_string_data, str, n+1);
ikp sym = ikrt_string_to_symbol(s, pcb); ikptr sym = ikrt_string_to_symbol(s, pcb);
return sym; return sym;
} }
#endif #endif

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

@ -22,7 +22,7 @@
#include <assert.h> #include <assert.h>
static int static int
page_idx(unsigned char* x){ page_idx(char* x){
unsigned int xi = (unsigned int) x; unsigned int xi = (unsigned int) x;
return xi >> pageshift; return xi >> pageshift;
} }
@ -32,11 +32,11 @@ page_idx(unsigned char* x){
#ifndef NDEBUG #ifndef NDEBUG
static int isa_fixnum(ikp x){ static int isa_fixnum(ikptr x){
return ((fixnum_mask & (int)x) == 0); return ((fixnum_mask & (int)x) == 0);
} }
static int isa_vector(ikp x){ static int isa_vector(ikptr x){
return ( (tagof(x) == vector_tag) && return ( (tagof(x) == vector_tag) &&
isa_fixnum(ref(x, -vector_tag))); isa_fixnum(ref(x, -vector_tag)));
} }
@ -46,15 +46,15 @@ static int isa_vector(ikp x){
static void static void
verify_code(unsigned char* x, unsigned char* base, unsigned int* svec, unsigned int* dvec){ verify_code(char* x, char* base, unsigned int* svec, unsigned int* dvec){
assert(ref(x, 0) == code_tag); assert(ref(x, 0) == code_tag);
ikp rvec = ref(x, disp_code_reloc_vector); ikptr rvec = ref(x, disp_code_reloc_vector);
assert(isa_vector(rvec)); assert(isa_vector(rvec));
ikp codesize = ref(x, disp_code_code_size); ikptr codesize = ref(x, disp_code_code_size);
codesize += 0; codesize += 0;
assert(unfix(codesize) >= 0); assert(unfix(codesize) >= 0);
assert(isa_fixnum(codesize)); assert(isa_fixnum(codesize));
ikp freevars = ref(x, disp_code_freevars); ikptr freevars = ref(x, disp_code_freevars);
freevars += 0; freevars += 0;
assert(isa_fixnum(freevars)); assert(isa_fixnum(freevars));
assert(unfix(freevars) >= 0); assert(unfix(freevars) >= 0);
@ -73,17 +73,17 @@ verify_code(unsigned char* x, unsigned char* base, unsigned int* svec, unsigned
} }
static void static void
verify_object(ikp x, unsigned char* base, unsigned int* svec, unsigned int* dvec){ verify_object(ikptr x, char* base, unsigned int* svec, unsigned int* dvec){
} }
static unsigned char* static char*
verify_code_small(unsigned char* p, unsigned int s, unsigned int d, verify_code_small(char* p, int s, unsigned int d,
unsigned char* base, unsigned int* svec, unsigned int* dvec){ char* base, unsigned int* svec, unsigned int* dvec){
ikp q = p + pagesize; ikptr q = p + pagesize;
while(p < q){ while(p < q){
ikp fst = ref(p, 0); ikptr fst = ref(p, 0);
if(fst == code_tag){ if(fst == code_tag){
assert(is_fixnum(ref(p, disp_code_code_size))); assert(is_fixnum(ref(p, disp_code_code_size)));
int code_size = unfix(ref(p, disp_code_code_size)); int code_size = unfix(ref(p, disp_code_code_size));
@ -101,24 +101,24 @@ verify_code_small(unsigned char* p, unsigned int s, unsigned int d,
return q; return q;
} }
static unsigned char* static char*
verify_code_large(unsigned char* p, unsigned int s, unsigned int d, verify_code_large(char* p, unsigned int s, unsigned int d,
unsigned char* base, unsigned int* svec, unsigned int* dvec){ char* base, unsigned int* svec, unsigned int* dvec){
ikp fst = ref(p, 0); ikptr fst = ref(p, 0);
fst += 0; fst += 0;
assert(fst == code_tag); assert(fst == code_tag);
int code_size = unfix(ref(p, disp_code_code_size)); int code_size = unfix(ref(p, disp_code_code_size));
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);
ikp end = p + code_size + disp_code_data; ikptr end = p + code_size + disp_code_data;
return((unsigned char*)align_to_next_page(end)); return((char*)align_to_next_page(end));
} }
static unsigned char* static char*
verify_code_page(unsigned char* p, unsigned int s, unsigned int d, verify_code_page(char* p, unsigned int s, unsigned int d,
unsigned char* base, unsigned int* svec, unsigned int* dvec){ char* base, unsigned int* svec, unsigned int* dvec){
ikp 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", fst);
@ -127,7 +127,7 @@ verify_code_page(unsigned char* p, unsigned int s, unsigned int d,
int code_size = unfix(ref(p, disp_code_code_size)); int code_size = unfix(ref(p, disp_code_code_size));
assert(code_size >= 0); assert(code_size >= 0);
int obj_size = align(code_size + disp_code_data); int obj_size = align(code_size + disp_code_data);
unsigned char* result; char* result;
if(obj_size <= pagesize){ if(obj_size <= pagesize){
result = verify_code_small(p,s,d,base,svec,dvec); result = verify_code_small(p,s,d,base,svec,dvec);
} else { } else {
@ -140,9 +140,9 @@ verify_code_page(unsigned char* p, unsigned int s, unsigned int d,
static unsigned char* static char*
verify_pointers_page(unsigned char* p, unsigned int s, unsigned int d, verify_pointers_page(char* p, unsigned int s, unsigned int d,
unsigned char* base, unsigned int* svec, unsigned int* dvec){ char* base, unsigned int* svec, unsigned int* dvec){
{ {
int i = 0; int i = 0;
while(i < pagesize){ while(i < pagesize){
@ -154,8 +154,8 @@ verify_pointers_page(unsigned char* p, unsigned int s, unsigned int d,
return p+pagesize; return p+pagesize;
} }
static unsigned char* static char*
verify_page(unsigned char* p, unsigned char* base, unsigned int* svec, unsigned int* dvec){ verify_page(char* p, char* base, unsigned int* svec, unsigned int* dvec){
int idx = page_idx(p) - page_idx(base); int idx = page_idx(p) - page_idx(base);
unsigned int s = svec[idx]; unsigned int s = svec[idx];
unsigned int d = dvec[idx]; unsigned int d = dvec[idx];
@ -198,11 +198,11 @@ verify_page(unsigned char* p, unsigned char* base, unsigned int* svec, unsigned
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);
unsigned char* mem_base = pcb->memory_base; char* mem_base = pcb->memory_base;
unsigned char* mem_end = pcb->memory_end; char* mem_end = 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;
unsigned char* mem = mem_base; char* mem = mem_base;
while(mem < mem_end){ while(mem < mem_end){
mem = verify_page(mem, mem_base, seg_vec, dir_vec); mem = verify_page(mem, mem_base, seg_vec, dir_vec);
} }

16
src/ikarus-weak-pairs.c
View File

@ -19,13 +19,13 @@
#include "ikarus-data.h" #include "ikarus-data.h"
ikp ikptr
ikrt_weak_cons(ikp a, ikp d, ikpcb* pcb){ ikrt_weak_cons(ikptr a, ikptr d, ikpcb* pcb){
ikp ap = pcb->weak_pairs_ap; ikptr ap = pcb->weak_pairs_ap;
ikp nap = ap + pair_size; ikptr nap = ap + pair_size;
ikp p; ikptr p;
if(nap > pcb->weak_pairs_ep){ if(nap > pcb->weak_pairs_ep){
ikp mem = ik_mmap_typed(pagesize, weak_pairs_mt, pcb); ikptr mem = ik_mmap_typed(pagesize, weak_pairs_mt, pcb);
pcb->weak_pairs_ap = mem + pair_size; pcb->weak_pairs_ap = mem + pair_size;
pcb->weak_pairs_ep = mem + pagesize; pcb->weak_pairs_ep = mem + pagesize;
p = mem + pair_tag; p = mem + pair_tag;
@ -39,8 +39,8 @@ ikrt_weak_cons(ikp a, ikp d, ikpcb* pcb){
return p; return p;
} }
ikp ikptr
ikrt_is_weak_pair(ikp x, ikpcb* pcb){ ikrt_is_weak_pair(ikptr x, ikpcb* pcb){
if(tagof(x) != pair_tag){ if(tagof(x) != pair_tag){
return false_object; return false_object;
} }