Added large object support for collecting large vectors

bin/ikarus-collect.c

@@ -57,7 +57,7 @@ static int extension_amount[meta_count] = {
   1 * pagesize,
   1 * pagesize,
   1 * pagesize,
-  1 * pagesize
+  1 * pagesize,
 };
 
 static unsigned int meta_mt[meta_count] = {
@@ -149,6 +149,43 @@ gc_alloc_new_ptr(int size, int old_gen, gc_t* gc){
   return meta_alloc(size, old_gen, gc, meta_ptrs);
 }
 
+static inline ikp 
+gc_alloc_new_large_ptr(int size, int old_gen, gc_t* gc){
+  int memreq = align_to_next_page(size);
+  ikp mem = 
+      ik_mmap_typed(memreq, 
+        pointers_mt | large_object_tag | next_gen_tag[old_gen],
+        gc->pcb);
+  gc->segment_vector = gc->pcb->segment_vector;
+  qupages_t* p = ik_malloc(sizeof(qupages_t));
+  p->p = mem;
+  p->q = mem+size;
+  bzero(mem+size, memreq-size);
+  p->next = gc->queues[meta_ptrs];
+  gc->queues[meta_ptrs] = p;
+  return mem;
+}
+
+
+static inline void 
+enqueue_large_ptr(ikp mem, int size, int old_gen, gc_t* gc){
+  int i = page_index(mem);
+  int j = page_index(mem+size-1);
+  while(i<=j){
+    gc->segment_vector[i] = 
+      pointers_mt | large_object_tag | next_gen_tag[old_gen];
+    i++;
+  }
+  qupages_t* p = ik_malloc(sizeof(qupages_t));
+  p->p = mem;
+  p->q = mem+size;
+  p->next = gc->queues[meta_ptrs];
+  gc->queues[meta_ptrs] = p;
+}
+
+
+
+
 #if 0
 static inline ikp 
 gc_alloc_new_symbol(int old_gen, gc_t* gc){
@@ -221,6 +258,9 @@ gc_alloc_new_code(int size, int old_gen, gc_t* gc){
   }
 }
 
+
+
+
 static void
 gc_tconc_push_extending(gc_t* gc, ikp tcbucket){
   if(gc->tconc_base){
@@ -989,16 +1029,32 @@ add_object_proc(gc_t* gc, ikp x)
       int size = (int)fst;
       assert(size >= 0);
       int memreq = align(size + disp_vector_data);
-      ikp y = gc_alloc_new_ptr(memreq, gen, gc) + vector_tag;
-      ref(y, disp_vector_length-vector_tag) = fst;
-      ref(y, memreq-vector_tag-wordsize) = 0;
-      memcpy(y+off_vector_data, x+off_vector_data, size);
-      ref(x,-vector_tag) = forward_ptr;
-      ref(x,wordsize-vector_tag) = y;
+      if(memreq >= pagesize){
+        if((t & large_object_mask) == large_object_tag){
+          enqueue_large_ptr(x-vector_tag, size+disp_vector_data, gen, gc);
+          return x;
+        } else {
+          ikp y = gc_alloc_new_large_ptr(size+disp_vector_data, gen, gc) +
+            vector_tag;
+          ref(y, disp_vector_length-vector_tag) = fst;
+          ref(y, memreq-vector_tag-wordsize) = 0;
+          memcpy(y+off_vector_data, x+off_vector_data, size);
+          ref(x,-vector_tag) = forward_ptr;
+          ref(x,wordsize-vector_tag) = y;
+          return y;
+        }
+      } else {
+        ikp y = gc_alloc_new_ptr(memreq, gen, gc) + vector_tag;
+        ref(y, disp_vector_length-vector_tag) = fst;
+        ref(y, memreq-vector_tag-wordsize) = 0;
+        memcpy(y+off_vector_data, x+off_vector_data, size);
+        ref(x,-vector_tag) = forward_ptr;
+        ref(x,wordsize-vector_tag) = y;
+        return y;
+      }
 #if accounting
       vector_count++;
 #endif
-      return y;
     } 
     else if(fst == symbol_record_tag){
       ikp y = gc_alloc_new_symbol_record(gen, gc) + record_tag;

bin/ikarus.h

@@ -14,21 +14,22 @@ extern int hash_table_count;
 
 #define most_bytes_in_minor 0x10000000
 
-#define old_gen_mask    0x00000007
-#define new_gen_mask    0x00000008
-#define gen_mask        0x0000000F
-#define new_gen_tag     0x00000008
-#define meta_dirty_mask 0x000000F0
-#define type_mask       0x00000F00
-#define scannable_mask  0x0000F000
-#define dealloc_mask    0x000F0000
+#define old_gen_mask       0x00000007
+#define new_gen_mask       0x00000008
+#define gen_mask           0x0000000F
+#define new_gen_tag        0x00000008
+#define meta_dirty_mask    0x000000F0
+#define type_mask          0x00000F00
+#define scannable_mask     0x0000F000
+#define dealloc_mask       0x000F0000
+#define large_object_mask  0x00100000
 #define meta_dirty_shift 4
 
 #define hole_type       0x00000000
 #define mainheap_type   0x00000100
 #define mainstack_type  0x00000200
 #define pointers_type   0x00000300
-#define dat_type       0x00000400
+#define dat_type        0x00000400
 #define code_type       0x00000500
 #define weak_pairs_type 0x00000600
 #define symbols_type    0x00000700
@@ -39,6 +40,8 @@ extern int hash_table_count;
 #define dealloc_tag     0x00010000
 #define retain_tag      0x00000000
 
+#define large_object_tag   0x00100000
+
 #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)