# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1614825212 18000
# Node ID 87674bc4c2203de2dac80461a392ba8abb3022d8
# Parent  de18bb93f9ec3a923d87d8b6e5e2aa29d8f69d39
Add remaining unary primitives, fix large immediate representation

diff -r de18bb93f9ec -r 87674bc4c220 iacc.lisp
--- 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 -----------------------------------------------------------------
diff -r de18bb93f9ec -r 87674bc4c220 runtime.c
--- 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));
diff -r de18bb93f9ec -r 87674bc4c220 test.lisp
--- 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"))
 
+