diff --git a/.bzrignore b/.bzrignore index 3c42d39..a9d746d 100644 --- a/.bzrignore +++ b/.bzrignore @@ -1,2 +1,3 @@ *.tmp *.out +*.fasl diff --git a/src/ikarus.fasl b/src/ikarus.fasl index 417845b..dbf68fc 100644 Binary files a/src/ikarus.fasl and b/src/ikarus.fasl differ diff --git a/src/libassembler.ss b/src/libassembler.ss index ada0aa2..0c4ae77 100644 Binary files a/src/libassembler.ss and b/src/libassembler.ss differ diff --git a/src/libcafe.fasl b/src/libcafe.fasl deleted file mode 100644 index 379812f..0000000 Binary files a/src/libcafe.fasl and /dev/null differ diff --git a/src/libcollect.fasl b/src/libcollect.fasl deleted file mode 100644 index 0a42a3e..0000000 Binary files a/src/libcollect.fasl and /dev/null differ diff --git a/src/libcontrol.fasl b/src/libcontrol.fasl deleted file mode 100644 index 32f5af5..0000000 Binary files a/src/libcontrol.fasl and /dev/null differ diff --git a/src/libcore.fasl b/src/libcore.fasl deleted file mode 100644 index c6b5b55..0000000 Binary files a/src/libcore.fasl and /dev/null differ diff --git a/src/libcxr.fasl b/src/libcxr.fasl deleted file mode 100644 index fa9ce73..0000000 Binary files a/src/libcxr.fasl and /dev/null differ diff --git a/src/libhandlers.fasl b/src/libhandlers.fasl deleted file mode 100644 index 61b65e1..0000000 Binary files a/src/libhandlers.fasl and /dev/null differ diff --git a/src/libinterpret.fasl b/src/libinterpret.fasl deleted file mode 100644 index ea77e62..0000000 Binary files a/src/libinterpret.fasl and /dev/null differ diff --git a/src/librecord.fasl b/src/librecord.fasl deleted file mode 100644 index d5bb189..0000000 Binary files a/src/librecord.fasl and /dev/null differ diff --git a/src/libtokenizer.fasl b/src/libtokenizer.fasl deleted file mode 100644 index bf05eab..0000000 Binary files a/src/libtokenizer.fasl and /dev/null differ diff --git a/src/libtoplevel.fasl b/src/libtoplevel.fasl deleted file mode 100644 index 072360a..0000000 Binary files a/src/libtoplevel.fasl and /dev/null differ diff --git a/src/libwriter.fasl b/src/libwriter.fasl deleted file mode 100644 index 18b4f9e..0000000 Binary files a/src/libwriter.fasl and /dev/null differ diff --git a/src/runtime/Makefile b/src/runtime/Makefile index 3569150..8e7e7b5 100644 --- a/src/runtime/Makefile +++ b/src/runtime/Makefile @@ -1,22 +1,26 @@ CFLAGS = -Wall -DNDEBUG -O3 #CFLAGS = -Wall -g -LDFLAGS = -g -ldl -lgmp -rdynamic +LDFLAGS = -g -ldl -lgmp -dynamic CC = gcc all: ikarus ikarus: ikarus-collect.o ikarus-runtime.o ikarus-main.o ikarus-fasl.o \ - ikarus-exec.o ikarus-print.o ikarus-enter.s ikarus-symbol-table.o \ + ikarus-exec.o ikarus-print.o ikarus-enter.o ikarus-symbol-table.o \ ikarus-weak-pairs.o ikarus-numerics.o $(CC) $(LDFLAGS) -o ikarus \ ikarus-main.o ikarus-runtime.o \ - ikarus-fasl.o ikarus-exec.o ikarus-print.o ikarus-enter.s \ + ikarus-fasl.o ikarus-exec.o ikarus-print.o ikarus-enter.o \ ikarus-symbol-table.o ikarus-collect.o ikarus-weak-pairs.o \ ikarus-numerics.o ikarus-main.o: ikarus-main.c ikarus.h $(CC) $(CFLAGS) -c ikarus-main.c +ikarus-enter.o: ikarus-enter.s ikarus.h + $(CC) $(CFLAGS) -c ikarus-enter.s + + ikarus-runtime.o: ikarus-runtime.c ikarus.h $(CC) $(CFLAGS) -c ikarus-runtime.c diff --git a/src/runtime/ikarus b/src/runtime/ikarus index 1dc00bd..a533502 100755 Binary files a/src/runtime/ikarus and b/src/runtime/ikarus differ diff --git a/src/runtime/ikarus-enter.s b/src/runtime/ikarus-enter.s index 36bb7ec..fa12736 100644 --- a/src/runtime/ikarus-enter.s +++ b/src/runtime/ikarus-enter.s @@ -1,11 +1,11 @@ .text -.globl ik_asm_enter +.globl _ik_asm_enter .globl ik_underflow_handler -.globl ik_foreign_call -.globl ik_asm_reenter +.globl _ik_foreign_call +.globl _ik_asm_reenter .align 8 -ik_asm_enter: +_ik_asm_enter: # ignored value is the third arg 12(%esp) # code is the second arg 8(%esp) # pcb is the first arg 4(%esp) @@ -15,7 +15,8 @@ ik_asm_enter: movl 4(%esp), %esi movl 0(%esi), %ebp # allocation pointer is at 0(pcb) movl %esp, %eax - subl $16, %esp + subl $16, %esp # 24 for alignment +set_stack: movl %esp, 24(%esi) # save esp in pcb->system_stack movl 8(%esi), %esp # load scheme stack from pcb->frame_pinter jmp L_call @@ -40,7 +41,7 @@ L_do_underflow: movl %esp, 8(%esi) # store scheme stack in pcb->frame_pointer movl %ebp, 0(%esi) # store allocation pointer movl 24(%esi), %esp # restore system stack - addl $16, %esp + addl $16, %esp # 24 for alignment (>= 16) movl -4(%esp), %esi # restore callee-save registers movl -8(%esp), %ebp # ret # back to C, which handled the underflow @@ -49,7 +50,7 @@ L_multivalue_underflow: jmp L_do_underflow .align 8 -ik_asm_reenter: +_ik_asm_reenter: # argc is at 12(%esp) # scheme stack is third arg 8(%esp) # pcb is the first arg 4(%esp) @@ -60,7 +61,7 @@ ik_asm_reenter: movl %ebp, -8(%esp) movl 4(%esp), %esi movl 0(%esi), %ebp # allocation pointer is at 0(pcb) - subl $16, %esp + subl $16, %esp # 24 for alignment movl %esp, 24(%esi) # save esp in pcb->system_stack movl %ebx, %esp # load scheme stack from second arg cmpl $-4, %eax @@ -73,11 +74,34 @@ L_multi_reentry: .align 8 -ik_foreign_call: +_ik_foreign_call: movl %esp, 8(%esi) # (movl fpr (pcb-ref 'frame-pointer)) movl %ebp, 0(%esi) # (movl apr (pcb-ref 'allocation-pointer)) movl %esp, %ebx # (movl fpr ebx) movl 24(%esi), %esp # (movl (pcb-ref 'system-stack) esp) + # %esp is the system stack, %eax is the index to the last arg, + # %esi is the pcb. + # Now, the value of %esp is 16-byte aligned + # we always push %esi (4 bytes) and do a call (4 bytes), + # 0 args require 6 (2) pushes => argc= 0 (0000): %esp += -8 + # 1 args require 5 (1) pushes => argc= -4 (1100): %esp += -4 + # 2 args require 4 (0) pushes => argc= -8 (1000): %esp += 0 + # 3 args require 3 (3) pushes => argc= -12 (0100): %esp += -12 + movl %eax, %ecx + andl $15, %ecx +check_ecx: + cmpl $8, %ecx + je L_zero + cmpl $12, %ecx + je L_one + cmpl $0, %ecx + je L_two + pushl $0 +L_two: + pushl $0 +L_one: + pushl $0 +L_zero: pushl %esi # (pushl pcr) cmpl $0, %eax # (cmpl (int 0) eax) je L_set # (je (label Lset)) @@ -93,4 +117,3 @@ L_set: # (label Lset) movl 0(%esi), %ebp # (movl (pcb-ref 'allocation-pointer) apr) ret # (ret))) - diff --git a/src/runtime/ikarus-fasl.c b/src/runtime/ikarus-fasl.c index d9fdf0c..a048202 100644 --- a/src/runtime/ikarus-fasl.c +++ b/src/runtime/ikarus-fasl.c @@ -146,7 +146,7 @@ ik_relocate_code(ikp code){ /* foreign object */ ikp str = ref(p, wordsize); char* name = string_data(str); - void* sym = dlsym(NULL, name); + void* sym = dlsym(RTLD_DEFAULT, name); char* err = dlerror(); if(err){ fprintf(stderr, "failed to find foreign name %s: %s\n", name, err); @@ -242,78 +242,6 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){ ik_relocate_code(code); return code+vector_tag; } - if(c == 'X'){ - assert(0); -#if 0 - code_header ch; - fasl_read_buf(p, &ch, sizeof(ch)); - ikp code = ik_make_code(ch.code_size, ch.reloc_size, ch.closure_size, pcb); - if(put_mark_index){ - p->marks[put_mark_index] = code; - } - ikp code_data = code + IK_OFF_CODE_DATA; - fasl_read_buf(p, code_data, ch.code_size); - ikp reloc_table = code_data + ch.code_size; - int i = 0; - while(i < ch.reloc_size){ - char t = fasl_read_byte(p); - if(t == 'O'){ - int offset; - fasl_read_buf(p, &offset, sizeof(int)); - ikp object = do_read(pcb, p); - ref(code_data,offset) = object; - ref(reloc_table, i) = (ikp)(offset << 2); - i += wordsize; - } - else if(t == 'F'){ /* foreign call */ - int offset; - fasl_read_buf(p, &offset, sizeof(int)); - ikp str = do_read(pcb, p); - char* name = string_data(str); - void* sym = dlsym(NULL, name); - char* err = dlerror(); - if(err){ - fprintf(stderr, "failed to find foreign name %s: %s\n", name, err); - exit(-1); - } - ref(code_data,offset) = sym; - ref(reloc_table, i) = (ikp)((offset << 2) | 3); - ref(reloc_table, i+wordsize) = str; - i += 2*wordsize; - } - else if(t == 'D'){ /* displaced reloc */ - int code_offset; - int object_offset; - fasl_read_buf(p, &code_offset, sizeof(int)); - fasl_read_buf(p, &object_offset, sizeof(int)); - ikp object = do_read(pcb, p); - ref(reloc_table, i) = (ikp)((code_offset << 2) | 1); - ref(reloc_table, i+wordsize) = (ikp)object_offset; - ref(code_data, code_offset) = object + object_offset; - i += (2*wordsize); - } - else if(t == 'J'){ /* jump reloc */ - int code_offset; - int object_offset; - fasl_read_buf(p, &code_offset, sizeof(int)); - fasl_read_buf(p, &object_offset, sizeof(int)); - ikp object = do_read(pcb, p); - ref(reloc_table, i) = (ikp)((code_offset << 2) | 2); - ref(reloc_table, i+wordsize) = (ikp)object_offset; - ikp next_word = code_data + code_offset + wordsize; - ikp displaced_object = object + object_offset; - ref(next_word, -wordsize) = displaced_object - (int) next_word; - i += (2*wordsize); - } - else { - fprintf(stderr, "invalid reloc type '%c'\n", t); - exit(-1); - } - } - assert(i==ch.reloc_size); - return code; -#endif - } else if(c == 'P'){ ikp pair = ik_alloc(pcb, pair_size) + pair_tag; if(put_mark_index){ diff --git a/src/runtime/ikarus-main.c b/src/runtime/ikarus-main.c index 1ebbe49..61b7f58 100644 --- a/src/runtime/ikarus-main.c +++ b/src/runtime/ikarus-main.c @@ -28,11 +28,11 @@ int main(int argc, char** argv){ ik_fasl_load(pcb, fasl_file); } fprintf(stderr, "collect time: %d.%03d utime, %d.%03d stime (%d collections)\n", - pcb->collect_utime.tv_sec, - pcb->collect_utime.tv_usec/1000, - pcb->collect_stime.tv_sec, - pcb->collect_stime.tv_usec/1000, - pcb->collection_id ); + pcb->collect_utime.tv_sec, + pcb->collect_utime.tv_usec/1000, + pcb->collect_stime.tv_sec, + pcb->collect_stime.tv_usec/1000, + pcb->collection_id ); ik_delete_pcb(pcb); return 0; } diff --git a/src/runtime/ikarus-runtime.c b/src/runtime/ikarus-runtime.c index 59d8841..eb87f56 100644 --- a/src/runtime/ikarus-runtime.c +++ b/src/runtime/ikarus-runtime.c @@ -45,12 +45,24 @@ extend_table_maybe(unsigned char*p, int size, ikpcb* pcb){ pcb->memory_base = (unsigned char*)(new_lo * segment_size); } else if (q > pcb->memory_end){ - fprintf(stderr, "must extend segment table upwards!\n"); - fprintf(stderr, "mem: 0x%08x ... 0x%08x\n", - (int)pcb->memory_base, (int)pcb->memory_end-1); - fprintf(stderr, "new: 0x%08x ... 0x%08x\n", - (int)p, (int)q-1); - exit(-1); + int lo = segment_index(pcb->memory_base); + int old_hi = segment_index(pcb->memory_end); + int new_hi = segment_index(q+segment_size-1); + int new_vec_size = (new_hi - lo) * pagesize; + int old_vec_size = (old_hi - lo) * pagesize; + unsigned char* v = ik_mmap(new_vec_size); + memcpy(v, pcb->dirty_vector_base, old_vec_size); + bzero(v+old_vec_size, new_vec_size - old_vec_size); + ik_munmap(pcb->dirty_vector_base, old_vec_size); + pcb->dirty_vector_base = (unsigned int*) v; + pcb->dirty_vector = (unsigned int*)(v - lo * pagesize); + unsigned char* s = ik_mmap(new_vec_size); + memcpy(s, pcb->segment_vector_base, old_vec_size); + bzero(s+old_vec_size, new_vec_size - old_vec_size); + ik_munmap(pcb->segment_vector_base, old_vec_size); + pcb->segment_vector_base = (unsigned int*) s; + pcb->segment_vector = (unsigned int*)(s - lo * pagesize); + pcb->memory_end = (unsigned char*)(new_hi * segment_size); } } @@ -139,7 +151,7 @@ ik_mmap(int size){ 0, mapsize, PROT_READ | PROT_WRITE, - MAP_PRIVATE | MAP_ANONYMOUS, + MAP_PRIVATE | MAP_ANON, -1, 0); if(mem == MAP_FAILED){ @@ -419,6 +431,7 @@ ikp ik_read(ikp fdptr, ikp bufptr, ikp lenptr){ ikp ik_write(ikp fdptr, ikp idx, ikp str){ + fprintf(stderr, "IK_WRITE\n"); int fd = unfix(fdptr); int len = unfix(idx); char* buf = (char*)(str+disp_string_data-string_tag);