diff --git a/hustle/heap-bits.rkt b/hustle/heap-bits.rkt index 43cd566..c8bf860 100644 --- a/hustle/heap-bits.rkt +++ b/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) diff --git a/hustle/interp-prims-heap-bits.rkt b/hustle/interp-prims-heap-bits.rkt index 393eeac..b29159d 100644 --- a/hustle/interp-prims-heap-bits.rkt +++ b/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])) diff --git a/hustle/types.rkt b/hustle/types.rkt index 35aaea9..1e1ff7c 100644 --- a/hustle/types.rkt +++ b/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)) diff --git a/hustle/unload-bits.rkt b/hustle/unload-bits.rkt index d9b0a73..895232d 100644 --- a/hustle/unload-bits.rkt +++ b/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)]))