imported compiler5-osx

.bzrignore

@@ -1,2 +1,3 @@
 *.tmp
 *.out
+*.fasl

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
 

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)))
 
-

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){

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;
 }

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);