Skip to content

Commit

Permalink
Merge pull request #34 from cmsc430/main-crook
Browse files Browse the repository at this point in the history 
crook
  • Loading branch information
@dvanhorn
dvanhorn authored Dec 13, 2024
2 parents c9c0b86 + 9658ed8 commit 7468b7a
Show file tree
Hide file tree
Showing 8 changed files with 47 additions and 78 deletions.
19 changes: 7 additions & 12 deletions hoax/compile-ops.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)]
Expand All @@ -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)
Expand All @@ -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)
Expand Down
9 changes: 3 additions & 6 deletions hustle/compile-ops.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -63,16 +63,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)]
Expand Down
19 changes: 7 additions & 12 deletions iniquity/compile-ops.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)]
Expand All @@ -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)
Expand All @@ -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)
Expand Down
19 changes: 7 additions & 12 deletions jig/compile-ops.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)]
Expand All @@ -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)
Expand All @@ -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)
Expand Down
19 changes: 7 additions & 12 deletions knock/compile-ops.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)]
Expand All @@ -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)
Expand All @@ -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)
Expand Down
8 changes: 4 additions & 4 deletions knock/compile.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,10 +4,11 @@
compile-es
compile-define
compile-match
; for notes
compile-pattern
compile-match-clause)

; for notes
(provide compile-pattern)

(require "ast.rkt")
(require "compile-ops.rkt")
(require "types.rkt")
Expand Down Expand Up @@ -272,8 +273,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)
Expand Down
19 changes: 7 additions & 12 deletions loot/compile-ops.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)]
Expand All @@ -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)
Expand All @@ -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)
Expand Down
13 changes: 5 additions & 8 deletions loot/compile.rkt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,7 @@
compile-es
compile-define
compile-match
compile-match-clause
compile-lambda-define
compile-string ; for notes
copy-env-to-stack
Expand Down Expand Up @@ -86,7 +87,6 @@
(let ((env (append (reverse fvs) (reverse xs) (list #f))))
(seq (Label (symbol->label f))
(Mov rax (Offset rsp (* 8 (length xs))))
(Xor rax type-proc)
(copy-env-to-stack fvs 8)
(compile-e e env #t)
(Add rsp (* 8 (length env))) ; pop env
Expand All @@ -98,7 +98,7 @@
(match fvs
['() (seq)]
[(cons _ fvs)
(seq (Mov r9 (Offset rax off))
(seq (Mov r9 (Offset rax (- off type-proc)))
(Push r9)
(copy-env-to-stack fvs (+ 8 off)))]))

Expand Down Expand Up @@ -219,8 +219,7 @@
(Add rsp (* 8 (length c)))
(Mov rax (Offset rsp (* 8 (length es))))
(assert-proc rax)
(Xor rax type-proc)
(Mov rax (Offset rax 0))
(Mov rax (Offset rax (- type-proc)))
(Jmp rax)))

;; Integer Integer -> Asm
Expand All @@ -243,8 +242,7 @@
(compile-es (cons e es) (cons #f c))
(Mov rax (Offset rsp i))
(assert-proc rax)
(Xor rax type-proc)
(Mov rax (Offset rax 0)) ; fetch the code label
(Mov rax (Offset rax (- type-proc))) ; fetch the code label
(Jmp rax)
(Label r))))

Expand Down Expand Up @@ -387,8 +385,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)
Expand Down

0 comments on commit 7468b7a

Please sign in to comment.