Fix up heap-bits interpreter.

hustle/heap-bits.rkt

@@ -11,16 +11,16 @@
     [(heap n bs)
      (heap-set! h n v)
      (set-heap-n! h (+ n 8))
-     (bitwise-xor n type-box)]))
+     (bitwise-xor (arithmetic-shift n 16) type-mutable-box)]))
 
 ;; Value* Value* Heap -> Value*
 (define (alloc-cons v1 v2 h)
   (match h
     [(heap n bs)
-     (heap-set! h (+ n 0) v1)
-     (heap-set! h (+ n 8) v2)
+     (heap-set! h (+ n 0) v2)
+     (heap-set! h (+ n 8) v1)
      (set-heap-n! h (+ n 16))
-     (bitwise-xor n type-cons)]))
+     (bitwise-xor (arithmetic-shift n 16) type-cons)]))
 
 ;; Heap Address -> Value*
 (define (heap-ref h a)

hustle/interp-prims-heap-bits.rkt

@@ -32,11 +32,11 @@
             (value->bits (void)))]
     [(list 'box v) (alloc-box v h)]
     [(list 'unbox (? box-bits? i))
-     (heap-ref h (bitwise-xor i type-box))]
+     (heap-ref h (box-pointer i))]
     [(list 'car (? cons-bits? i))
-     (heap-ref h (bitwise-xor i type-cons))]
+     (heap-ref h (cons-car-pointer i))]
     [(list 'cdr (? cons-bits? i))
-     (heap-ref h (bitwise-xor (+ i 8) type-cons))]
+     (heap-ref h (cons-cdr-pointer i))]
     [(list 'empty? v)
      (value->bits (= (value->bits '()) v))]
     [_ 'err]))

hustle/types.rkt

@@ -39,12 +39,10 @@
         [(char-bits? b)
          (integer->char (arithmetic-shift b (- char-shift)))]
         [(box-bits? b)
-         (define p (untag b))
-         (box (bits->value (mem-ref p)))]
+         (box (bits->value (mem-ref (box-pointer b))))]
         [(cons-bits? b)
-         (define p (untag b))
-         (cons (bits->value (mem-ref (+ p 8)))
-               (bits->value (mem-ref p)))]
+         (cons (bits->value (mem-ref (cons-car-pointer b)))
+               (bits->value (mem-ref (cons-cdr-pointer b))))]
         [else (error "invalid bits")]))
 
 (define (value->bits v)
@@ -72,6 +70,18 @@
   (or (= type-mutable-box (bitwise-and v #xFF))
       (= type-immutable-box (bitwise-and v #xFF))))
 
+;; BoxValue* -> Address
+(define (box-pointer v)
+  (untag v))
+
+;; ConsValue* -> Address
+(define (cons-car-pointer v)
+  (+ (untag v) 8))
+
+;; ConsValue* -> Address
+(define (cons-cdr-pointer v)
+  (untag v))
+
 (define (untag i)
   (arithmetic-shift i -16))
 

hustle/unload-bits.rkt

@@ -13,11 +13,9 @@
 (define (unload-value v h)
   (match v
     [(? box-bits?)
-     (define p (bitwise-xor v type-box))
-     (box (unload-value (heap-ref h p) h))]
+     (box (unload-value (heap-ref h (box-pointer v)) h))]
     [(? cons-bits?)
-     (define p (bitwise-xor v type-cons))
-     (cons (unload-value (heap-ref h (+ p 0)) h)
-           (unload-value (heap-ref h (+ p 8)) h))]
+     (cons (unload-value (heap-ref h (cons-car-pointer v)) h)
+           (unload-value (heap-ref h (cons-cdr-pointer v)) h))]
     [_ (bits->value v)]))