--- a/iacc.lisp Tue Mar 02 21:42:58 2021 -0500
+++ b/iacc.lisp Wed Mar 03 21:33:32 2021 -0500
@@ -4,7 +4,7 @@
(defpackage :iacc
(:use :cl)
(:export :compile-program
- :fxadd1 :fxsub1 :fxzero?
+ :fxadd1 :fxsub1 :fxzero? :fxlognot
:fixnum? :char? :null? boolean?
:char->fixnum :fixnum->char
)
@@ -57,7 +57,13 @@
(emit "~A:" name))
(defun emit-immediate (expr)
- (emit " mov x0, ~D" (immediate-rep expr)))
+ ;; TODO: Optimize if it can be moved easily.
+ (let ((bits (immediate-rep expr)))
+ (emit " mov x0, ~D" (ldb (byte 16 0) bits))
+ (loop :for pos :from 16 :to 48 :by 16
+ :for chunk = (ldb (byte 16 pos) bits)
+ :unless (zerop chunk)
+ :do (emit " movk x0, 0x~4,'0X, lsl #~D" chunk pos))))
(defun emit-expr (expr)
(etypecase expr
@@ -116,17 +122,35 @@
(emit-expr arg)
(emit " sub x0, x0, ~D ~30T// fxsub1" (immediate-rep 1)))
-(define-primitive fxzero? (arg) (TODO))
+(define-primitive fxzero? (arg)
+ (alexandria:with-gensyms (false)
+ ;; false #b00101111
+ ;; true #b01101111
+ (emit-expr arg)
+ (emit " cmp x0, 0x00 ~30T// fxzero?") ; Zero is 0, plus tags bits of 0. So just 0.
+ (emit " mov x0, ~D" #b00101111) ; start with false
+ (emit " bne ~A" false)
+ (emit " orr x0, x0, ~D" #b01000000) ; make it true
+ (emit "~A:" false)))
-(define-primitive null? (arg) (TODO))
+(define-primitive null? (arg)
+ (alexandria:with-gensyms (false)
+ ;; false #b00101111
+ ;; true #b01101111
+ (emit-expr arg)
+ (emit " cmp x0, ~D ~30T// null?" #b00111111)
+ (emit " mov x0, ~D" #b00101111) ; start with false
+ (emit " bne ~A" false)
+ (emit " orr x0, x0, ~D" #b01000000) ; make it true
+ (emit "~A:" false)))
(define-primitive fixnum? (arg)
(alexandria:with-gensyms (false)
;; false #b00101111
;; true #b01101111
(emit-expr arg)
- (emit " and x0, x0, 0x03 ~30T// fixnum?") ; mask off all but the tag bits
- (emit " cmp x0, 0x00") ; check the remaining tag bits
+ (emit " and x0, x0, ~D ~30T// fixnum?" #b11) ; mask off all but the tag bits
+ (emit " cmp x0, ~D" #b00) ; check the remaining tag bits
(emit " mov x0, ~D" #b00101111) ; start with false
(emit " bne ~A" false)
(emit " orr x0, x0, ~D" #b01000000) ; make it true
@@ -145,9 +169,33 @@
(emit " orr x0, x0, ~D" #b01000000) ; make it true
(emit "~A:" false)))
-(define-primitive char? (arg) (TODO))
+(define-primitive char? (arg)
+ (alexandria:with-gensyms (false)
+ ;; false #b00101111
+ ;; true #b01101111
+ (emit-expr arg)
+ (emit " and x0, x0, ~D ~30T// char?" #b11111111) ; mask off all but the tag bits
+ (emit " cmp x0, ~D" #b00001111) ; check the remaining tag bits
+ (emit " mov x0, ~D" #b00101111) ; start with false
+ (emit " bne ~A" false)
+ (emit " orr x0, x0, ~D" #b01000000) ; make it true
+ (emit "~A:" false)))
-(define-primitive not (arg) (TODO))
+(define-primitive not (arg)
+ (alexandria:with-gensyms (false)
+ ;; false #b00101111
+ ;; true #b01101111
+ (emit-expr arg)
+ (emit " cmp x0, ~D ~30T// not" #b00101111)
+ (emit " mov x0, ~D" #b00101111) ; start with false
+ (emit " bne ~A" false)
+ (emit " orr x0, x0, ~D" #b01000000) ; make it true
+ (emit "~A:" false)))
+
+(define-primitive fxlognot (arg)
+ (emit-expr arg)
+ (emit " mvn x0, x0 ~30T// fxlognot")
+ (emit " and x0, x0, ~D" (lognot #b11)))
;;;; Toplevel -----------------------------------------------------------------
--- a/runtime.c Tue Mar 02 21:42:58 2021 -0500
+++ b/runtime.c Wed Mar 03 21:33:32 2021 -0500
@@ -20,6 +20,8 @@
typedef uint64_t ptr;
+ptr scheme_entry();
+
static void print_ptr(ptr x) {
if ((x & fx_mask) == fx_tag) {
printf("%ld", ((int64_t)x >> fx_shift));
--- a/test.lisp Tue Mar 02 21:42:58 2021 -0500
+++ b/test.lisp Wed Mar 03 21:33:32 2021 -0500
@@ -57,6 +57,14 @@
(check '(fxsub1 99) "98")
(check '(fxsub1 (fxsub1 202)) "200")
(check '(fxsub1 (fxadd1 -6)) "-6"))
+(define-test primitives/fxlognot
+ (check '(fxlognot 0) "-1")
+ (check '(fxlognot -1) "0")
+ (check '(fxlognot 1) "-2")
+ (check '(fxlognot -2) "1")
+ (check '(fxlognot 536870911) "-536870912")
+ (check '(fxlognot -536870912) "536870911")
+ (check '(fxlognot (fxlognot 237463)) "237463"))
(define-test primitives/char-fixnum-conversion
(check '(char->fixnum #\A) "65")
@@ -64,25 +72,67 @@
(check '(fixnum->char (fxadd1 (char->fixnum #\A))) "#\\B"))
(define-test primitives/fixnum?
- (check '(fixnum? 1) "#t")
- (check '(fixnum? 0) "#t")
- (check '(fixnum? -1) "#t")
- (check '(fixnum? nil) "#f")
- (check '(fixnum? :true) "#f")
+ (check '(fixnum? 1) "#t")
+ (check '(fixnum? 0) "#t")
+ (check '(fixnum? -1) "#t")
+ (check '(fixnum? nil) "#f")
+ (check '(fixnum? :true) "#f")
(check '(fixnum? :false) "#f")
- (check '(fixnum? #\A) "#f"))
+ (check '(fixnum? #\A) "#f"))
(define-test primitives/boolean?
- (check '(boolean? 1) "#f")
- (check '(boolean? 0) "#f")
- (check '(boolean? -1) "#f")
- (check '(boolean? nil) "#f")
- (check '(boolean? :true) "#t")
+ (check '(boolean? 1) "#f")
+ (check '(boolean? 0) "#f")
+ (check '(boolean? -1) "#f")
+ (check '(boolean? nil) "#f")
+ (check '(boolean? :true) "#t")
(check '(boolean? :false) "#t")
- (check '(boolean? #\A) "#f"))
+ (check '(boolean? #\A) "#f"))
+
+(define-test primitives/char?
+ (check '(char? 1) "#f")
+ (check '(char? 0) "#f")
+ (check '(char? -1) "#f")
+ (check '(char? nil) "#f")
+ (check '(char? :true) "#f")
+ (check '(char? :false) "#f")
+ (check '(char? #\A) "#t"))
+
+(define-test primitives/null?
+ (check '(null? 1) "#f")
+ (check '(null? 0) "#f")
+ (check '(null? -1) "#f")
+ (check '(null? nil) "#t")
+ (check '(null? :true) "#f")
+ (check '(null? :false) "#f")
+ (check '(null? #\A) "#f"))
+
+(define-test primitives/fxzero?
+ (check '(fxzero? 1) "#f")
+ (check '(fxzero? 0) "#t")
+ (check '(fxzero? -1) "#f")
+ (check '(fxzero? nil) "#f")
+ (check '(fxzero? :true) "#f")
+ (check '(fxzero? :false) "#f")
+ (check '(fxzero? #\A) "#f"))
+
+(define-test primitives/not
+ (check '(not 1) "#f")
+ (check '(not 0) "#f")
+ (check '(not -1) "#f")
+ (check '(not nil) "#f")
+ (check '(not :true) "#f")
+ (check '(not :false) "#t")
+ (check '(not #\A) "#f"))
(define-test primitives/simple-combos
+ (check '(fxzero? (fxsub1 (fxadd1 0))) "#t")
(check '(boolean? (fixnum? 1)) "#t")
(check '(boolean? (boolean? 1)) "#t")
- (check '(fixnum? (char->fixnum #\A)) "#t"))
+ (check '(fixnum? (char->fixnum #\A)) "#t")
+ (check '(char? (fixnum->char (fxadd1 65))) "#t")
+ (check '(boolean? (not 1)) "#t")
+ (check '(not (boolean? (not 1))) "#f")
+ (check '(not (not (boolean? (not 1)))) "#t"))
+