* removed all calls to mprotect from the runtime system.

bin/Makefile

@@ -1,5 +1,5 @@
 
-CFLAGS = -I/opt/local/include -Wall -DNDEBUG -O3 
+CFLAGS = -I/opt/local/include -Wall -DNDEBUG -DHAS_ALT_STACK -O3 
 #CFLAGS = -I/opt/local/include -Wall -g
 LDFLAGS = -L/opt/local/lib -g -ldl -lgmp -lm
 CC = gcc
@@ -11,7 +11,7 @@ endif
 objects = ikarus-collect.o ikarus-runtime.o ikarus-main.o ikarus-fasl.o \
   ikarus-exec.o ikarus-print.o ikarus-enter.o ikarus-symbol-table.o  \
   ikarus-weak-pairs.o ikarus-numerics.o ikarus-flonums.o \
-  verify-integrity.o ikarus.at.o
+  verify-integrity.o 
 
 all: ikarus
 
@@ -54,9 +54,6 @@ ikarus-numerics.o: ikarus-numerics.c ikarus.h
 ikarus-flonums.o: ikarus-flonums.c ikarus.h
 	$(CC) $(CFLAGS) -c ikarus-flonums.c
 
-ikarus.at.o: ikarus.at.c ikarus.h
-	$(CC) $(CFLAGS) -c ikarus.at.c
-
 ikarus.h: ikarus-data.h
 	touch ikarus.h
 

bin/ikarus-collect.c

@@ -813,8 +813,7 @@ forward_guardians(gc_t* gc){
       int i;
       int n = src->count;
       for(i=0; i<n; i++){
-        dst = move_guardian(add_object(gc, src->ptr[i], "g4"), dst,
+        dst = move_guardian(add_object(gc, src->ptr[i], "g4"), dst, &cache);
-            &cache);
       }
       ik_ptr_page* next = src->next;
       src->next = cache;
@@ -826,7 +825,7 @@ forward_guardians(gc_t* gc){
   collect_loop(gc);
   while(cache){
     ik_ptr_page* next = cache->next;
-    ik_munmap(cache, sizeof(ik_ptr_page));
+    ik_munmap((unsigned char*)cache, sizeof(ik_ptr_page));
     cache = next;
   }
 }
@@ -864,7 +863,7 @@ empty_dropped_guardians(gc_t* gc){
         }
       }
       ik_ptr_page* next = src->next;
-      ik_munmap(src, sizeof(ik_ptr_page));
+      ik_munmap((unsigned char*) src, sizeof(ik_ptr_page));
       src = next;
     }
     pcb->guardians_dropped[gen] = 0;
@@ -1898,11 +1897,13 @@ fix_new_pages(gc_t* gc){
         ikp page_base = (ikp)(i << pageshift);
         ikp p = page_base;
         ikp q = p + pagesize;
-        int err = mprotect(page_base, pagesize, PROT_READ|PROT_WRITE|PROT_EXEC);
+#if 0
+        junk int err = mprotect(page_base, pagesize, PROT_READ|PROT_WRITE|PROT_EXEC);
         if(err){
           fprintf(stderr, "cannot protect code page: %s\n", strerror(errno));
           exit(-1);
         }
+#endif
         unsigned int d = 0;
         while(p < q){
           if(ref(p, 0) != code_tag){

bin/ikarus-fasl.c

@@ -36,6 +36,7 @@ static ikp ik_fasl_read(ikpcb* pcb, fasl_port* p);
 
 #if USE_ZLIB
 void ik_fasl_load(ikpcb* pcb, char* fasl_file){
+  dead!!!
   gzFile fh = gzopen(fasl_file, "rb");
   if(fh == NULL){
     fprintf(stderr, "cannot open %s\n", fasl_file);
@@ -94,12 +95,14 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
   p.membase = mem;
   p.memp = mem;
   p.memq = mem + filesize;
-  p.marks = NULL;
+  p.marks = 0;
   p.marks_size = 0;
   while(p.memp < p.memq){
     ikp v = ik_fasl_read(pcb, &p);
-    if(p.marks){
+    if(p.marks_size){
-      bzero(p.marks, p.marks_size * sizeof(ikp*));
+      ik_munmap((unsigned char*) p.marks, p.marks_size*sizeof(ikp*));
+      p.marks = 0;
+      p.marks_size = 0;
     }
     ikp val = ik_exec_code(pcb, v);
     val = void_object;
@@ -111,9 +114,6 @@ void ik_fasl_load(ikpcb* pcb, char* fasl_file){
     fprintf(stderr, "fasl-read did not reach eof!\n");
     exit(-10);
   }
-  if(p.marks){
-    ik_munmap(p.marks, p.marks_size*sizeof(ikp*));
-  }
   {
     int err = munmap(mem, mapsize);
     if(err != 0){
@@ -266,7 +266,7 @@ static ikp do_read(ikpcb* pcb, fasl_port* p){
     }
     else {
       /* allocate marks */
-      p->marks = ik_mmap(pagesize*sizeof(ikp*));
+      p->marks = (ikp*)ik_mmap(pagesize*sizeof(ikp*));
       bzero(p->marks, pagesize*sizeof(ikp*));
       p->marks_size = pagesize;
     }

bin/ikarus-main.c

@@ -10,6 +10,7 @@
 #include <errno.h>
 #include <gmp.h>
 #include <signal.h>
+#include <sys/mman.h>
 
 void register_handlers();
 void register_alt_stack();
@@ -227,8 +228,10 @@ SYNOPSIS
 
 void
 register_alt_stack(){
-  char* stk = ik_mmap(SIGSTKSZ);
+#ifdef HAS_ALT_STACK
-  if(stk == 0){
+  char* stk = mmap(0, SIGSTKSZ, PROT_READ|PROT_WRITE|PROT_EXEC, MAP_ANON, -1, 0);
+//  char* stk = ik_mmap(SIGSTKSZ);
+  if(stk == (char*)-1){
     fprintf(stderr, "Cannot maloc an alt stack\n");
     exit(-1);
   }
@@ -242,4 +245,5 @@ register_alt_stack(){
     fprintf(stderr, "Cannot set alt stack: %s\n", strerror(errno));
     exit(-1);
   }
+#endif
 }

bin/ikarus-runtime.c

@@ -15,6 +15,7 @@
 #include <sys/resource.h>
 #include <sys/wait.h>
 
+
 int total_allocated_pages = 0;
          
 extern char **environ;
@@ -24,6 +25,9 @@ extern char **environ;
 #define segment_shift (pageshift+pageshift-wordshift)
 #define segment_index(x) (((unsigned int)(x)) >> segment_shift)
 
+void* ik_mmap(int size);
+void ik_munmap(void* mem, int size);
+
 static void
 extend_table_maybe(unsigned char*p,  int size, ikpcb* pcb){
   assert(size == align_to_next_page(size));
@@ -159,11 +163,13 @@ ik_mmap_code(int size, int gen, ikpcb* pcb){
   if(size > pagesize){
     set_segment_type(p+pagesize, size-pagesize, data_mt|gen, pcb);
   }
-  int err = mprotect(p, size, PROT_READ | PROT_WRITE | PROT_EXEC);
+#if 0
+  junk int err = mprotect(p, size, PROT_READ | PROT_WRITE | PROT_EXEC);
   if(err){
     fprintf(stderr, "cannot mprotect code: %s\n", strerror(errno));
     exit(-1);
   }
+#endif
   return p;
 }
 
@@ -185,7 +191,7 @@ ik_mmap(int size){
   char* mem = mmap(
       0,
       mapsize,
-      PROT_READ | PROT_WRITE,
+      PROT_READ | PROT_WRITE | PROT_EXEC,
       MAP_PRIVATE | MAP_ANON,
       -1,
       0);
@@ -237,25 +243,6 @@ void ik_free(void* x, int size){
   free(x);
 }
 
-ikp ik_mmap_protected(int size){
-  ikp x = ik_mmap(size + 2*pagesize);
-  {
-    int err = mprotect(x, pagesize, PROT_NONE);
-    if(err){
-      fprintf(stderr, "mprotect failed: %s\n", strerror(errno));
-      exit(-1);
-    }
-  }
-  {
-    int err = mprotect(x+pagesize+size, pagesize, PROT_NONE);
-    if(err){
-      fprintf(stderr, "mprotect failed: %s\n", strerror(errno));
-      exit(-1);
-    }
-  }
-  return x+pagesize;
-}
-
 
 #define CACHE_SIZE (pagesize * 8) /* must be multiple of pagesize*/
 
@@ -266,7 +253,7 @@ ikpcb* ik_make_pcb(){
   #define HEAPSIZE (1024 * 4096)
   #define STAKSIZE (1024 * 4096)
   //#define STAKSIZE (256 * 4096)
-  pcb->heap_base = ik_mmap_protected(HEAPSIZE);
+  pcb->heap_base = ik_mmap(HEAPSIZE);
   pcb->heap_size = HEAPSIZE;
   pcb->allocation_pointer = pcb->heap_base;
   pcb->allocation_redline = pcb->heap_base + HEAPSIZE - 2 * 4096;
@@ -317,8 +304,8 @@ ikpcb* ik_make_pcb(){
     pcb->segment_vector = (unsigned int*) (svec - lo_seg * pagesize);
     pcb->memory_base = (unsigned char*)(lo_seg * segment_size);
     pcb->memory_end = (unsigned char*)(hi_seg * segment_size);
-    set_segment_type(pcb->heap_base-pagesize, 
+    set_segment_type(pcb->heap_base, 
-        pcb->heap_size+2*pagesize, 
+        pcb->heap_size,
         mainheap_mt,
         pcb);
     set_segment_type(pcb->stack_base, 
@@ -375,7 +362,6 @@ void ik_delete_pcb(ikpcb* pcb){
   int vecsize = (segment_index(end) - segment_index(base)) * pagesize;
   ik_munmap(pcb->dirty_vector_base, vecsize);
   ik_munmap(pcb->segment_vector_base, vecsize);
-   
   ik_free(pcb, sizeof(ikpcb));
 }
 

bin/ikarus.at.c

@@ -1,4 +1,6 @@
 
+junk junk junk
+
 #include "ikarus.at.h"
 #include <stdio.h>
 #include <strings.h>
@@ -20,11 +22,12 @@ static int malloc_count = 0;
 static unsigned int mmap_count = 0;
 static void ikat_malloc_count(size_t n){
   malloc_count += n;
+  fprintf(stderr, "ikat_malloc_count=0x%08x (%ld)\n", malloc_count, n);
   assert(malloc_count >= 0);
 }
 static void ikat_mmap_count(size_t n){
   mmap_count += n;
-  fprintf(stderr, "mmap_count=0x%08x\n", mmap_count);
+  fprintf(stderr, "ikat_mmap_count=0x%08x (%ld)\n", mmap_count, n);
   assert(mmap_count >= 0);
 }
 
@@ -49,6 +52,7 @@ ikat_malloc(size_t n){
   exit(-1);
 }
 
+
 static inline void
 ikat_free(void* addr, size_t n){
   ikat_malloc_count(-n);
@@ -68,40 +72,76 @@ ikat_mmap(size_t n){
   exit(-1);
 }
 
+
 static inline void
 ikat_munmap(void* addr, size_t n){
+  fprintf(stderr, "unmap: ");
   ikat_mmap_count(-n);
   munmap(addr, n);
 }
 
 
 ikat*
-ikat_make_allocation_table(int types){
+ikat_make_allocation_table(unsigned int types){
   unsigned int* tbl = ikat_mmap(segment_size);
   bzero(tbl, segment_size);
   ikat* x = ikat_malloc(sizeof(ikat));
   bzero(x, sizeof(ikat));
   x->alloc_table = tbl;
-  ikat_meta** meta = ikat_malloc(types * sizeof(ikat_meta));
+  ikat_ll** lls = ikat_malloc(types * sizeof(ikat_ll*));
-  bzero(meta, types * sizeof(ikat_meta));
+  bzero(lls, types * sizeof(ikat_ll*));
-  x->meta_count = types;
+  x->lls_count = types;
-  x->meta = meta;
+  x->lls = lls;
   return x;
 }
 
+static void
+ikat_free_ll(ikat* x, ikat_ll* p){
+  while(p){
+    ikat_ll* next = p->next;
+    ikat_unmap(x, p->base, p->size);
+    ikat_free(p, sizeof(ikat_ll));
+    p = next;
+  }
+}
+
+
 void 
 ikat_free_allocation_table(ikat* x){
+  int i;
+  for(i=0; i<x->lls_count; i++){
+    ikat_free_ll(x, x->lls[i]);
+  }
+  ikat_free_ll(x, x->llcache);
+  ikat_free(x->lls, x->lls_count * sizeof(ikat_ll*));
   ikat_munmap(x->alloc_table, segment_size);
   ikat_free(x, sizeof(ikat));
   ikat_done();
 }
 
 
-
 unsigned char*
 ikat_map_bigpage(ikat* x, size_t size){
   assert(size == align_to_next_segment(size));
   unsigned char* p = ikat_mmap(size);
+  
+  if((unsigned int)p != align_to_next_segment((unsigned int)p)){
+    ikat_munmap(p, size);
+    p = ikat_mmap(size+segment_size);
+    unsigned char* q = (unsigned char*)align_to_next_segment((unsigned int)p);
+    if(p == q){
+      fprintf(stderr, "retry1\n");
+      ikat_munmap(p+size, segment_size);
+    } else {
+      fprintf(stderr, "retry2\n");
+      size_t fst = q - p;
+      ikat_munmap(p, fst);
+      ikat_munmap(q+size, segment_size-fst);
+      p = q;
+    }
+  } else {
+    fprintf(stderr, "noretry\n");
+  }
   unsigned int idx = segment_index(p);
   unsigned int idx_hi = idx + size/segment_size;
   while(idx < idx_hi){
@@ -111,64 +151,87 @@ ikat_map_bigpage(ikat* x, size_t size){
   return p;
 }
 
-void
-ikat_unmap(ikat* x, unsigned char* addr, size_t size, unsigned int type){
-  fprintf(stderr, "ikat_unmap\n");
-}
 
-unsigned char*
+void
-ikat_map(ikat* x, size_t size, unsigned int type){
+ikat_unmap(ikat* x, unsigned char* addr, size_t size){
-  ikat_meta* llp = x->meta[type];
   assert(size == align_to_next_page(size));
   size_t pages = page_index(size);
   if(pages < segment_pages){
-    ikat_ll* ll = llp->segments[pages];
+    size_t segment = segment_index(addr);
-    unsigned int pages_mask = (1 << pages) - 1;
+    size_t page_offset = page_index(addr) & (segment_pages-1);
+    unsigned int alloc_bits = x->alloc_table[segment];
+    unsigned int this_bits = ((1 << pages) - 1) << page_offset;
+    unsigned int new_bits = alloc_bits & ~ this_bits;
+    fprintf(stderr, "0x%08x bits=0x%08x ^~ 0x%08x = 0x%08x    pages=%d/%d, m=0x%08x\n", 
+        addr, alloc_bits, this_bits, new_bits, pages, size, ((1<<pages)-1));
+    assert((alloc_bits & this_bits) == this_bits);
+    x->alloc_table[segment] = new_bits;
+    if(new_bits == 0){
+      ikat_munmap((unsigned char*)(segment * segment_size), segment_size);
+    }
+  } else {
+    fprintf(stderr, "ikat_unmap large\n");
+    exit(-1);
+  }
+}
+
+
+unsigned char*
+ikat_map(ikat* x, size_t size, unsigned int type){
+  assert(size == align_to_next_page(size));
+  assert(type < x->lls_count);
+  ikat_ll* llp = x->lls[type];
+  size_t pages = page_index(size);
+  if(pages < segment_pages){
+    ikat_ll* ll = llp;
+    ikat_ll** prev = &(x->lls[type]);
     while(ll){
-      unsigned char* base = ll->base;
+      size_t lsize = ll->size;
-      llp->segments[pages] = ll->next;
+      if(lsize == size){
-      ll->next = x->llcache;
+        /* unwire */
-      x->llcache = ll;
+        *prev = ll->next;
-      size_t seg_idx = segment_index(base);
+        ll->next = x->llcache;
-      unsigned int alloc_bits = x->alloc_table[seg_idx];
+        x->llcache = ll;
-      if(alloc_bits != 0){
+        return ll->base;
-        unsigned int page_idx = (page_index(base) & (segment_size-1));
+      } else if (lsize > size){
-        unsigned int new_bits = pages_mask << page_idx;
+        unsigned char* addr = ll->base;
-        assert((new_bits & alloc_bits) == 0);
+        ll->size -= size;
-        x->alloc_table[seg_idx] = alloc_bits | new_bits;
+        ll->base += size;
-        return base;
+        return addr;
+      } else {
+        prev = &(ll->next);
+        ll = ll->next;
       }
     }
     unsigned char* base = ikat_map_bigpage(x, segment_size);
-    size_t seg_idx = segment_index(base);
-    x->alloc_table[seg_idx] = pages_mask;
     ikat_ll* cache = x->llcache;
     if(cache){
       x->llcache = cache->next;
     } else {
       cache = ikat_malloc(sizeof(ikat_ll));
     }
-    cache->base = base + pages * page_size;
+    cache->base = base + size;
-    cache->next = llp->segments[segment_pages - pages];
+    cache->size = segment_size - size;
-    llp->segments[segment_pages - pages] = cache;
+    cache->next = x->lls[type];
+    x->lls[type] = cache;
     return base;
   } else {
     size_t aligned_size = align_to_next_segment(size);
-    unsigned char* mem = ikat_mmap(aligned_size);
+    unsigned char* base = ikat_map_bigpage(x, aligned_size);
-    unsigned int idx = segment_index(mem);
-    unsigned int sz = segment_index(size);
-    while(idx < sz){
-      x->alloc_table[idx] = -1;
-      idx++;
-    }
     if(aligned_size != size){
-      ikat_unmap(x, mem+size, aligned_size-size, type);
+      ikat_ll* cache = x->llcache;
+      if(cache){
+        x->llcache = cache->next;
+      } else {
+        cache = ikat_malloc(sizeof(ikat_ll));
+      }
+      cache->base = base + size;
+      cache->size = aligned_size - size;
+      cache->next = x->lls[type];
+      x->lls[type] = cache;
     }
-    return mem;
+    return base;
   }
 }
 
 
-
-
-

bin/ikarus.at.h

@@ -9,21 +9,20 @@
 
 typedef struct ikat_ll{
   unsigned char* base;
+  size_t size;
   struct ikat_ll* next;
 } ikat_ll;
 
-typedef struct ikat_meta{
-  ikat_ll* segments[segment_pages];
-} ikat_meta;
-
 typedef struct {
   unsigned int* alloc_table;
-  ikat_meta** meta;
+  ikat_ll** lls;
-  int meta_count;
+  int lls_count;
+  unsigned char* ap;
+  unsigned char* ep;
   ikat_ll* llcache;
 } ikat;
 
-ikat* ikat_make_allocation_table();
+ikat* ikat_make_allocation_table(unsigned int types);
 
 void ikat_free_allocation_table(ikat*);
 
@@ -33,7 +32,7 @@ unsigned char* ikat_map(ikat*, size_t size, unsigned int type);
 
 unsigned char* ikat_map_code(ikat*, size_t size, unsigned int type);
 
-void ikat_unmap(ikat*, unsigned char* addr, size_t size, unsigned int type);
+void ikat_unmap(ikat*, unsigned char* addr, size_t size);
 
 #endif
 

bin/ikarus.h

@@ -37,7 +37,8 @@ extern int hash_table_count;
 #define scannable_tag   0x00001000
 #define unscannable_tag 0x00000000
 
-#define dealloc_tag     0x00010000
+#define dealloc_tag_un  0x00010000
+#define dealloc_tag_at  0x00020000
 #define retain_tag      0x00000000
 
 #define large_object_tag   0x00100000
@@ -45,11 +46,11 @@ extern int hash_table_count;
 #define hole_mt         (hole_type       | unscannable_tag | retain_tag)
 #define mainheap_mt     (mainheap_type   | unscannable_tag | retain_tag)
 #define mainstack_mt    (mainstack_type  | unscannable_tag | retain_tag)
-#define pointers_mt     (pointers_type   | scannable_tag   | dealloc_tag)
+#define pointers_mt     (pointers_type   | scannable_tag   | dealloc_tag_un)
-#define symbols_mt      (symbols_type    | scannable_tag   | dealloc_tag)
+#define symbols_mt      (symbols_type    | scannable_tag   | dealloc_tag_un)
-#define data_mt         (dat_type        | unscannable_tag | dealloc_tag)
+#define data_mt         (dat_type        | unscannable_tag | dealloc_tag_un)
-#define code_mt         (code_type       | scannable_tag   | dealloc_tag)
+#define code_mt         (code_type       | scannable_tag   | dealloc_tag_un)
-#define weak_pairs_mt   (weak_pairs_type | scannable_tag   | dealloc_tag)
+#define weak_pairs_mt   (weak_pairs_type | scannable_tag   | dealloc_tag_un)
 
 
 static int