Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

crook #34

Merged
merged 2 commits into from
Dec 13, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
19 changes: 7 additions & 12 deletions hoax/compile-ops.rkt
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
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
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
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
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
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
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
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