GC from today.

Author: dvanhorn

langs/iniquity-gc/compile-ops.rkt

@@ -6,11 +6,16 @@
 (define eax 'eax) ; 32-bit load/store
 (define rbx 'rbx) ; heap
 (define rdi 'rdi) ; arg
+(define rsi 'rsi) ; arg
+(define rdx 'rdx) ; arg
+(define rcx 'rcx) ; arg
 (define r8  'r8)  ; scratch
 (define r9  'r9)  ; scratch
 (define r10 'r10) ; scratch
+(define r14 'r14) ; stack pad (non-volatile)
 (define r15 'r15) ; stack pad (non-volatile)
 (define rsp 'rsp) ; stack
+(define rbp 'rbp) ; base stack
 
 ;; Op0 -> Asm
 (define (compile-op0 p)
@@ -24,22 +29,21 @@
                      unpad-stack)]
     ['dump-memory-stats
      (seq (Mov rdi rsp)
-          (Mov 'rsi 'rbp)
-          (Mov 'rdx rbx)
+          (Mov rsi rbp)
+          (Mov rdx rbx)
           pad-stack
           (Call 'print_memory)
-          (Mov rax 0)
-          unpad-stack)]
+          unpad-stack
+          (Mov rax val-void))]
     ['collect-garbage
      (seq (Mov rdi rsp)
-          (Mov 'rsi 'rbp)
-          (Mov 'rdx rbx)
+          (Mov rsi rbp)
+          (Mov rdx rbx)
           pad-stack
           (Call 'collect_garbage)
           unpad-stack
           (Mov rbx rax)
           (Mov rax val-void))]))
-           
 
 ;; Op1 -> Asm
 (define (compile-op1 p)
@@ -73,7 +77,8 @@
           unpad-stack
           (Mov rax val-void))]
     ['box
-     (seq (Mov (Offset rbx 0) rax)
+     (seq (allocate 1)
+          (Mov (Offset rbx 0) rax)
           (Mov rax rbx)
           (Or rax type-box)
           (Add rbx 8))]
@@ -125,6 +130,20 @@
             (Mov rax 0)
             (Label done)))]))
 
+(define (allocate n)
+  (seq)
+  #;
+  (seq (Mov r15 rax) ; save rax
+       (Mov rdi rsp)
+       (Mov rsi rbp)
+       (Mov rdx rbx)
+       (Mov rcx n)
+       pad-stack
+       (Call 'alloc_val)
+       unpad-stack
+       ;(Mov rbx rax)
+       (Mov rax r15)))
+         
 ;; Op2 -> Asm
 (define (compile-op2 p)
   (match p
@@ -160,7 +179,8 @@
                  (Mov rax val-false)
                  (Label true))))]    
     ['cons
-     (seq (Mov (Offset rbx 0) rax)
+     (seq (allocate 2)
+          (Mov (Offset rbx 0) rax) ;; ALLOCATE
           (Pop rax)
           (Mov (Offset rbx 8) rax)
           (Mov rax rbx)
@@ -173,23 +193,28 @@
      (let ((loop (gensym))
            (done (gensym))
            (empty (gensym)))
-       (seq (Pop r8)
-            (assert-natural r8)
-            (Cmp r8 0) ; special case empty vector
+       (seq (Pop r14)
+            (assert-natural r14)
+            (Cmp r14 0) ; special case empty vector
             (Je empty)
+            
+            (Sar r14 int-shift)
+
+            (Add r14 1)
+            (allocate r14)
+            (Sub r14 1)
 
             (Mov r9 rbx)
             (Or r9 type-vect)
-
-            (Sar r8 int-shift)
-            (Mov (Offset rbx 0) r8)
-            (Add rbx 8)
+            
+            (Mov (Offset rbx 0) r14)
+            (Add rbx 8)  ;; ALLOCATE
 
             (Label loop)
             (Mov (Offset rbx 0) rax)
-            (Add rbx 8)
-            (Sub r8 1)
-            (Cmp r8 0)
+            (Add rbx 8)  ;; ALLOCATE
+            (Sub r14 1)
+            (Cmp r14 0)
             (Jne loop)
 
             (Mov rax r9)
@@ -230,7 +255,7 @@
 
             (Sar r8 int-shift)
             (Mov (Offset rbx 0) r8)
-            (Add rbx 8)
+            (Add rbx 8) ;; ALLOCATE
 
             (Sar rax char-shift)
 
@@ -240,7 +265,7 @@
 
             (Label loop)
             (Mov (Offset rbx 0) eax)
-            (Add rbx 4)
+            (Add rbx 4) ;; ALLOCATE
             (Sub r8 1)
             (Cmp r8 0)
             (Jne loop)

langs/iniquity-gc/compile.rkt

@@ -34,7 +34,8 @@
        (Extern 'write_byte)
        (Extern 'raise_error)
        (Extern 'print_memory)
-       (Extern 'collect_garbage)))
+       (Extern 'collect_garbage)
+       (Extern 'alloc_val)))
 
 ;; [Listof Defn] -> Asm
 (define (compile-defines ds)

langs/iniquity-gc/gc.c

@@ -21,7 +21,7 @@ const char* val_typeof_string(int64_t t) {
   }
 }
 
-void step(val_t* to, val_t* from, val_t** to_curr, val_t** to_next, int count, int* t_back) {
+void step(val_t** to_curr, val_t** to_next, int count, int* t_back) {
   type_t t;
   int i;
   int size;
@@ -72,20 +72,16 @@ void step(val_t* to, val_t* from, val_t** to_curr, val_t** to_next, int count, i
 int64_t* collect_garbage(int64_t* rsp, int64_t *rbp, int64_t* rbx) {
   int stack_count = rbp - rsp;
 
-  val_t *from = heap + ((rbx < (heap + heap_size)) ? 0 : heap_size);
-  val_t *to   = heap + ((rbx < (heap + heap_size)) ? heap_size : 0);
-
+  val_t *tmp;
   val_t *to_next = to;
   val_t *to_curr = to;
 
   int t_back = 0;
   int t_front = 0;
 
   // Step through everything on the stack
-  val_t * rsp_curr = rsp;
-  step(to, from, &rsp_curr, &to_next, stack_count, &t_back);
-
-  printf("DONE STACK\n");
+  val_t *rsp_curr = rsp;
+  step(&rsp_curr, &to_next, stack_count, &t_back);
 
   int vi;
   // now play catch up between to_curr and to_next
@@ -94,13 +90,13 @@ int64_t* collect_garbage(int64_t* rsp, int64_t *rbp, int64_t* rbx) {
     case T_VECT:
       vi = to_curr[0];
       to_curr++;
-      step(to, from, &to_curr, &to_next, vi, &t_back);
+      step(&to_curr, &to_next, vi, &t_back);
       break;
     case T_BOX:
-      step(to, from, &to_curr, &to_next, 1, &t_back);
+      step(&to_curr, &to_next, 1, &t_back);
       break;
     case T_CONS:
-      step(to, from, &to_curr, &to_next, 2, &t_back);
+      step(&to_curr, &to_next, 2, &t_back);
       break;
     case T_STR:
       to_curr = to_curr + 1 + ((*to_curr + 1) / 2);
@@ -110,16 +106,18 @@ int64_t* collect_garbage(int64_t* rsp, int64_t *rbp, int64_t* rbx) {
       break;
     }
   }
+
+  tmp = from;
+  from = to;
+  to = tmp;
   return to_next;
 }
 
 
 void print_memory(int64_t* rsp, int64_t* rbp, int64_t* rbx) {
 
-  val_t* h = heap + ((rbx < (heap + heap_size)) ? 0 : heap_size);
-
   int stack_count = rbp - rsp;
-  int heap_count  = rbx - h;
+  int heap_count  = rbx - from;
 
   printf("----------------------------------------------------------------\n");
   int i;
@@ -132,6 +130,17 @@ void print_memory(int64_t* rsp, int64_t* rbp, int64_t* rbx) {
   printf("HEAP:\n");
   for (i = 0; i < heap_count; i++) {
     printf("[%" PRIx64 "] = %016" PRIx64 ", %s\n",
-	   (int64_t)h + 8*i, h[i], val_typeof_string(h[i]));
+	   (int64_t)from + 8*i, from[i], val_typeof_string(from[i]));
+  }
+}
+
+int64_t* alloc_val(int64_t* rsp, int64_t* rbp, int64_t* rbx, int words) {
+  if (rbx + words >= from + heap_size) {
+    rbx = collect_garbage(rsp, rbp, rbx);
+    if (rbx + words >= from + heap_size) {
+      printf("OUT OF MEMORY!!\n");
+      exit(1);
+    }
   }
+  return rbx;
 }

langs/iniquity-gc/main.c

@@ -9,6 +9,8 @@ FILE* in;
 FILE* out;
 void (*error_handler)();
 val_t *heap;
+val_t *to;
+val_t *from;
 type_t *types;
 
 void error_exit()
@@ -28,6 +30,8 @@ int main(int argc, char** argv)
   out = stdout;
   error_handler = &error_exit;
   heap = malloc(2 * 8 * heap_size);
+  from = heap;
+  to = heap + heap_size;
   types = malloc(sizeof(type_t) * heap_size);
 
   val_t result;

langs/iniquity-gc/runtime.h

@@ -8,5 +8,8 @@ extern void (*error_handler)();
 // in words
 #define heap_size 10000
 extern int64_t *heap;
+extern val_t *from;
+extern val_t *to;
+
 extern type_t *types;
 #endif /* RUNTIME_H */