crook

cmsc430 · Dec 13, 2024 · d4bdebc · d4bdebc
1 parent 1b39899
commit d4bdebc
Show file tree

Hide file tree

Showing 3 changed files with 17 additions and 27 deletions.
diff --git a/iniquity-plus/compile-ops.rkt b/iniquity-plus/compile-ops.rkt
@@ -65,16 +65,13 @@
           (Add rbx 8))]
     ['unbox
      (seq (assert-box rax)
-          (Xor rax type-box)
-          (Mov rax (Offset rax 0)))]
+          (Mov rax (Offset rax (- type-box))))]
     ['car
      (seq (assert-cons rax)
-          (Xor rax type-cons)
-          (Mov rax (Offset rax 8)))]
+          (Mov rax (Offset rax (- 8 type-cons))))]
     ['cdr
      (seq (assert-cons rax)
-          (Xor rax type-cons)
-          (Mov rax (Offset rax 0)))]
+          (Mov rax (Offset rax (- type-cons))))]
 
     ['empty? (seq (Cmp rax (value->bits '())) if-equal)]
     ['cons? (type-pred ptr-mask type-cons)]
@@ -85,10 +82,9 @@
      (let ((zero (gensym))
            (done (gensym)))
        (seq (assert-vector rax)
-            (Xor rax type-vect)
-            (Cmp rax 0)
+            (Cmp rax type-vect)
             (Je zero)
-            (Mov rax (Offset rax 0))
+            (Mov rax (Offset rax (- type-vect)))
             (Sal rax int-shift)
             (Jmp done)
             (Label zero)
@@ -98,10 +94,9 @@
      (let ((zero (gensym))
            (done (gensym)))
        (seq (assert-string rax)
-            (Xor rax type-str)
-            (Cmp rax 0)
+            (Cmp rax type-str)
             (Je zero)
-            (Mov rax (Offset rax 0))
+            (Mov rax (Offset rax (- type-str)))
             (Sal rax int-shift)
             (Jmp done)
             (Label zero)

diff --git a/knock-plus/compile-ops.rkt b/knock-plus/compile-ops.rkt
@@ -65,16 +65,13 @@
           (Add rbx 8))]
     ['unbox
      (seq (assert-box rax)
-          (Xor rax type-box)
-          (Mov rax (Offset rax 0)))]
+          (Mov rax (Offset rax (- type-box))))]
     ['car
      (seq (assert-cons rax)
-          (Xor rax type-cons)
-          (Mov rax (Offset rax 8)))]
+          (Mov rax (Offset rax (- 8 type-cons))))]
     ['cdr
      (seq (assert-cons rax)
-          (Xor rax type-cons)
-          (Mov rax (Offset rax 0)))]
+          (Mov rax (Offset rax (- type-cons))))]
 
     ['empty? (seq (Cmp rax (value->bits '())) if-equal)]
     ['cons? (type-pred ptr-mask type-cons)]
@@ -85,10 +82,9 @@
      (let ((zero (gensym))
            (done (gensym)))
        (seq (assert-vector rax)
-            (Xor rax type-vect)
-            (Cmp rax 0)
+            (Cmp rax type-vect)
             (Je zero)
-            (Mov rax (Offset rax 0))
+            (Mov rax (Offset rax (- type-vect)))
             (Sal rax int-shift)
             (Jmp done)
             (Label zero)
@@ -98,10 +94,9 @@
      (let ((zero (gensym))
            (done (gensym)))
        (seq (assert-string rax)
-            (Xor rax type-str)
-            (Cmp rax 0)
+            (Cmp rax type-str)
             (Je zero)
-            (Mov rax (Offset rax 0))
+            (Mov rax (Offset rax (- type-str)))
             (Sal rax int-shift)
             (Jmp done)
             (Label zero)

diff --git a/knock-plus/compile.rkt b/knock-plus/compile.rkt
@@ -3,7 +3,8 @@
          compile-e
          compile-es
          compile-define
-         compile-match)
+         compile-match
+         compile-match-clause)
 
 (require "ast.rkt")
 (require "compile-ops.rkt")
@@ -275,8 +276,7 @@
                 (Add rsp (* 8 (length cm))) ; haven't pushed anything yet
                 (Jmp next)
                 (Label ok)
-                (Xor rax type-box)
-                (Mov rax (Offset rax 0))
+                (Mov rax (Offset rax (- type-box)))
                 i1)
            cm1))])]
     [(Cons p1 p2)