# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1615431701 18000
# Node ID 01ba812a486a5a1fe805c89a0fb92c503f40ab8f
# Parent  37b7eecfdf6ec460a604d9d6215dc8857ebd233a
More binary primitives

diff -r 37b7eecfdf6e -r 01ba812a486a Makefile
--- a/Makefile	Thu Mar 04 20:25:44 2021 -0500
+++ b/Makefile	Wed Mar 10 22:01:41 2021 -0500
@@ -1,3 +1,3 @@
-prog: prog.s runtime.c
-	gcc runtime.c prog.s -o prog
+prog: prog.s runtime.c Makefile
+	gcc -ggdb runtime.c prog.s -o prog
 
diff -r 37b7eecfdf6e -r 01ba812a486a iacc.lisp
--- a/iacc.lisp	Thu Mar 04 20:25:44 2021 -0500
+++ b/iacc.lisp	Wed Mar 10 22:01:41 2021 -0500
@@ -5,6 +5,9 @@
   (:use :cl)
   (:export :compile-program
     :fxadd1 :fxsub1 :fxzero? :fxlognot
+    :fx+ :fx- :fx* :fxlogand :fxlogor
+    :fx= :fx< :fx<= :fx> :fx>=
+    :char= :char< :char<= :char> :char>=
     :fixnum? :char? :null? boolean?
     :char->fixnum :fixnum->char
     )
@@ -28,9 +31,19 @@
 (deftype boolean   () '(member :true :false))
 (deftype immediate () '(or fixnum character boolean null))
 (deftype primitive () '(satisfies primitivep))
-(deftype primitive-expression () '(cons primitive *))
-(deftype conditional-expression () '(specific-list (eql if) * * *))
-(deftype expression () '(or immediate primitive-expression conditional-expression))
+
+(deftype unary-primitive-expression  () '(specific-list primitive *))
+(deftype binary-primitive-expression () '(specific-list primitive * *))
+
+(deftype primitive-expression ()
+  '(or unary-primitive-expression binary-primitive-expression))
+
+(deftype conditional-expression ()
+  '(specific-list (eql if) * * *))
+
+(deftype expression ()
+  '(or immediate primitive-expression conditional-expression))
+
 (deftype program () 'expression)
 
 
@@ -59,6 +72,8 @@
 
 
 ;;;; Basic Emitters -----------------------------------------------------------
+(defparameter *stack-index* 0)
+
 (defun emit (string &rest args)
   (apply #'format *standard-output* string args)
   (terpri *standard-output*))
@@ -80,20 +95,21 @@
 
 (defun emit-if (expr)
   (destructuring-bind (condition consequent alternative) (rest expr)
-    (alexandria:with-gensyms (else endif)
-      (losh:if-let ((pce (predicate-comparison-emitter condition)))
+    (alexandria:with-gensyms (then endif)
+      (losh:if-let ((pce (predicate-comparison-emitter condition))
+                    (cond (predicate-cond condition)))
         ;; Instead of doing the check, converting to a boolean, then checking
         ;; if the boolean is false, we can fuse the predicate into the if to
         ;; avoid all that unnecessary booleanization.
         (progn (apply pce (rest condition))
-               (emit "    bne ~A" else))
+               (emit "    b~A ~A ~40T// if" cond then))
         (progn (emit-expr condition)
-               (emit "    cmp x0, ~D ~30T// if" +false+)
-               (emit "    beq ~A" else)))
+               (emit "    cmp x0, ~D ~40T// if" +false+)
+               (emit "    bne ~A" then)))
+      (emit-expr alternative)
+      (emit "    b ~A" endif)
+      (emit "~A:" then)
       (emit-expr consequent)
-      (emit "    b ~A" endif)
-      (emit "~A:" else)
-      (emit-expr alternative)
       (emit "~A:" endif))))
 
 (defun emit-expr (expr)
@@ -105,8 +121,17 @@
 (defun emit-program (p)
   (check-type p program)
   (emit "   .text")
+  (emit-function-header "L_scheme_entry")
+  (let ((*stack-index* 16))
+    (emit-expr p))
+  (emit "    ret")
   (emit-function-header "scheme_entry")
-  (emit-expr p)
+  (emit "    stp x29, x30, [sp, #-16]! ~40T// Save link register")
+  (emit "    mov x2, sp ~40T// Save C stack pointer")
+  (emit "    mov sp, x0 ~40T// Switch to Lisp stack")
+  (emit "    bl L_scheme_entry")
+  (emit "    mov sp, x2 ~40T// Restore C stack pointer")
+  (emit "    ldp x29, x30, [sp], #16 ~40T// Restore link register")
   (emit "    ret"))
 
 
@@ -120,13 +145,17 @@
              (get ',name 'emitter) #',function-name)
        ',name)))
 
-(defmacro define-predicate (name arglist &body body)
-  `(progn (define-primitive ,name ,arglist
-            ,@body
-            (emit-booleanize))
-          (setf (get ',name 'predicate-comparison-emitter)
-                (lambda ,arglist ,@body))
-          ',name))
+(defmacro define-predicate (name-and-options arglist &body body)
+  (destructuring-bind (name &key (cond "eq"))
+      (alexandria:ensure-list name-and-options)
+    `(progn (define-primitive ,name ,arglist
+              ,@body
+              (emit-booleanize ,cond))
+       (setf (get ',name 'predicate-comparison-emitter)
+             (lambda ,arglist ,@body)
+             (get ',name 'predicate-cond)
+             ,cond)
+       ',name)))
 
 (defun primitivep (symbol)
   (and (typep symbol 'symbol) (get symbol 'primitive)))
@@ -141,6 +170,10 @@
   (when (typep expr '(cons symbol *))
     (get (car expr) 'predicate-comparison-emitter)))
 
+(defun predicate-cond (expr)
+  (when (typep expr '(cons symbol *))
+    (get (car expr) 'predicate-cond)))
+
 (defun emit-primitive (expr)
   (destructuring-bind (primitive &rest args) expr
     (assert (= (primitive-arg-count primitive) (length args)) ()
@@ -151,63 +184,135 @@
 
 (defun emit-booleanize (&optional (cond "eq"))
   "Turn x0 into a boolean, assuming we just did a `cmp` operation."
-  (emit "    cset x0, ~A ~30T// ~40Tbooleanize" cond)
+  (emit "    cset x0, ~A ~40T// booleanize" cond)
   (emit "    lsl x0, x0, 5")
   (emit "    orr x0, x0, ~D" #b00011111))
 
 (define-primitive fxadd1 (arg)
   (emit-expr arg)
-  (emit "    add x0, x0, ~D ~30T// fxadd1" (immediate-rep 1)))
+  (emit "    add x0, x0, ~D ~40T// fxadd1" (immediate-rep 1)))
 
 (define-primitive fxsub1 (arg)
   (emit-expr arg)
-  (emit "    sub x0, x0, ~D ~30T// fxsub1" (immediate-rep 1)))
+  (emit "    sub x0, x0, ~D ~40T// fxsub1" (immediate-rep 1)))
 
 (define-predicate fxzero? (arg)
   (emit-expr arg)
-  (emit "    cmp x0, 0x00 ~30T// fxzero?")) ; Zero is 0, plus tags bits of 0.  So just 0.
+  (emit "    cmp x0, 0x00 ~40T// fxzero?")) ; Zero is 0, plus tags bits of 0.  So just 0.
 
 (define-primitive char->fixnum (arg)
   (emit-expr arg)
-  (emit "    lsr x0, x0, #6 ~30T// char->fixnum"))
+  (emit "    lsr x0, x0, #6 ~40T// char->fixnum"))
 
 (define-primitive fixnum->char (arg)
   (emit-expr arg)
-  (emit "    lsl x0, x0, #6 ~30T// fixnum->char")
+  (emit "    lsl x0, x0, #6 ~40T// fixnum->char")
   (emit "    orr x0, x0, 0x0F"))
 
 
 (define-predicate null? (arg)
   (emit-expr arg)
-  (emit "    cmp x0, ~D ~30T// null?" +nil+))
+  (emit "    cmp x0, ~D ~40T// null?" +nil+))
 
 (define-predicate fixnum? (arg)
   (emit-expr arg)
-  (emit "    and x0, x0, ~D ~30T// fixnum?" #b11) ; mask off all but the tag bits
+  (emit "    and x0, x0, ~D ~40T// fixnum?" #b11) ; mask off all but the tag bits
   (emit "    cmp x0, ~D" #b00)) ; check the remaining tag bits
 
 (define-predicate boolean? (arg)
   (emit-expr arg)
   ;; xxxxxxxx…0001 1111 false
   ;; xxxxxxxx…0011 1111 true
-  (emit "    bic x0, x0, ~D ~30T// boolean?" #b00100000) ; turn true into false
+  (emit "    bic x0, x0, ~D ~40T// boolean?" #b00100000) ; turn true into false
   (emit "    cmp x0, ~D" #b00011111)) ; check for false
 
 (define-predicate char? (arg)
   (emit-expr arg)
-  (emit "    and x0, x0, ~D ~30T// char?" #b11111111) ; mask off all but the tag bits
+  (emit "    and x0, x0, ~D ~40T// char?" #b11111111) ; mask off all but the tag bits
   (emit "    cmp x0, ~D" #b00001111)) ; check the remaining tag bits
 
 (define-predicate not (arg)
   (emit-expr arg)
-  (emit "    cmp x0, ~D ~30T// not" +false+))
+  (emit "    cmp x0, ~D ~40T// not" +false+))
 
 (define-primitive fxlognot (arg)
   (emit-expr arg)
-  (emit "    mvn x0, x0 ~30T// fxlognot")
+  (emit "    mvn x0, x0 ~40T// fxlognot")
   (emit "    and x0, x0, ~D" (lognot #b11)))
 
 
+(defmacro with-stack-saved ((reg1 &optional (reg2 "xzr")) &body body)
+  "Save the two registers to the stack, perform `body`, then restore.
+
+  Each register can be a string, in which case the value will be saved from and
+  restored to that register.  It can also be a list of `(from to)` to allow
+  restoring to a different register than the source.
+
+  "
+  (destructuring-bind (reg1-from &optional (reg1-to reg1-from))
+      (alexandria:ensure-list reg1)
+    (destructuring-bind (reg2-from &optional (reg2-to reg2-from))
+        (alexandria:ensure-list reg2)
+      (alexandria:once-only (reg1-from reg1-to reg2-from reg2-to)
+        `(progn
+           (emit "    stp ~A, ~A, [sp, #-~D]" ,reg1-from ,reg2-from *stack-index*)
+           (let ((*stack-index* (+ *stack-index* 16)))
+             ,@body)
+           (emit "    ldp ~A, ~A, [sp, #-~D]" ,reg1-to ,reg2-to *stack-index*))))))
+
+
+(define-primitive fx+ (a b)
+  (emit-expr a)
+  (with-stack-saved (("x0" "x1"))
+    (emit-expr b))
+  (emit "    add x0, x1, x0 ~40T// fx+"))
+
+(define-primitive fx- (a b)
+  (emit-expr a)
+  (with-stack-saved (("x0" "x1"))
+    (emit-expr b))
+  (emit "    sub x0, x1, x0 ~40T// fx-"))
+
+(define-primitive fx* (a b)
+  (emit-expr a)
+  (with-stack-saved (("x0" "x1"))
+    (emit-expr b))
+  (emit "    asr x0, x0, #2 ~40T// fx*")
+  (emit "    mul x0, x1, x0"))
+
+(define-primitive fxlogand (a b)
+  (emit-expr a)
+  (with-stack-saved (("x0" "x1"))
+    (emit-expr b))
+  (emit "    and x0, x1, x0 ~40T// fxlogand"))
+
+(define-primitive fxlogor (a b)
+  (emit-expr a)
+  (with-stack-saved (("x0" "x1"))
+    (emit-expr b))
+  (emit "    orr x0, x1, x0 ~40T// fxlogor"))
+
+
+(macrolet ((define-primitive-binary-predicate (name cond)
+             `(define-predicate (,name :cond ,cond) (a b)
+                (emit-expr a)
+                (with-stack-saved (("x0" "x1"))
+                  (emit-expr b))
+                (emit "    cmp x1, x0 ~40T// ~A" ,(string-downcase name)))))
+  (define-primitive-binary-predicate fx=  "eq")
+  (define-primitive-binary-predicate fx<  "lt")
+  (define-primitive-binary-predicate fx<= "le")
+  (define-primitive-binary-predicate fx>  "gt")
+  (define-primitive-binary-predicate fx>= "ge")
+  ;; If we assume both have the same tag bits of character, we can just compare
+  ;; them directly without bothering to strip off the tag.
+  (define-primitive-binary-predicate char=  "eq")
+  (define-primitive-binary-predicate char<  "lt")
+  (define-primitive-binary-predicate char<= "le")
+  (define-primitive-binary-predicate char>  "gt")
+  (define-primitive-binary-predicate char>= "ge"))
+
+
 ;;;; Toplevel -----------------------------------------------------------------
 (defun compile-program (program)
   (with-open-file (*standard-output* "prog.s" :direction :output :if-exists :supersede)
diff -r 37b7eecfdf6e -r 01ba812a486a runtime.c
--- a/runtime.c	Thu Mar 04 20:25:44 2021 -0500
+++ b/runtime.c	Wed Mar 10 22:01:41 2021 -0500
@@ -1,5 +1,7 @@
 #include <stdio.h>
 #include <stdint.h>
+#include <sys/mman.h>
+#include <unistd.h>
 
 // Bools
 #define bool_f 0x1F
@@ -20,7 +22,7 @@
 
 typedef uint64_t ptr;
 
-ptr scheme_entry();
+ptr scheme_entry(char*);
 
 static void print_ptr(ptr x) {
     if ((x & fx_mask) == fx_tag) {
@@ -40,8 +42,41 @@
     printf("\n");
 }
 
+static char* allocate_protected_space(int size) {
+    int page = getpagesize();
+    int status;
+    int aligned_size = ((size + page - 1) / page) * page;
+
+    char* p = mmap(0, aligned_size + 2 * page,
+                   PROT_READ | PROT_WRITE,
+                   MAP_ANONYMOUS | MAP_PRIVATE,
+                   0, 0);
+   if (p == MAP_FAILED) _exit(4);
+
+   status = mprotect(p, page, PROT_NONE);
+   if (status != 0) _exit(5);
+
+   status = mprotect(p + page + aligned_size, page, PROT_NONE);
+   if (status != 0) _exit(6);
+
+   return (p + page);
+}
+
+static void deallocate_protected_space(char* p, int size) {
+    int page = getpagesize();
+    int status;
+    int aligned_size = ((size + page - 1) / page) * page;
+
+    status = munmap(p - page, aligned_size + 2 * page);
+    if (status != 0) _exit(7);
+}
+
 int main(int argc, char** argv) {
-    print_ptr(scheme_entry());
+    int stack_size = (16 * 4096);
+    char* stack_top = allocate_protected_space(stack_size);
+    char* stack_base = stack_top + stack_size;
+    print_ptr(scheme_entry(stack_base));
+    deallocate_protected_space(stack_top, stack_size);
     return 0;
 }
 
diff -r 37b7eecfdf6e -r 01ba812a486a sync
--- a/sync	Thu Mar 04 20:25:44 2021 -0500
+++ b/sync	Wed Mar 10 22:01:41 2021 -0500
@@ -3,3 +3,4 @@
 set -eu
 
 rsync -av ./ pine:src/iacc/ --exclude='.hg' --exclude='*.fasl'
+ban done
diff -r 37b7eecfdf6e -r 01ba812a486a test.lisp
--- a/test.lisp	Thu Mar 04 20:25:44 2021 -0500
+++ b/test.lisp	Wed Mar 10 22:01:41 2021 -0500
@@ -24,6 +24,10 @@
 (defun reload ()
   (load (compile-file "test.lisp")))
 
+(defun run-tests ()
+  (let ((*print-level* 50))
+    (time (1am:run))))
+
 
 (defmacro define-test (name &body body)
   `(1am:test ,(intern (concatenate 'string (symbol-name 'test/) (symbol-name name)))
@@ -60,14 +64,31 @@
   (check '(fxadd1 0) "1")
   (check '(fxadd1 99) "100")
   (check '(fxadd1 (fxadd1 202)) "204")
-  (check '(fxadd1 (fxadd1 -6)) "-4"))
+  (check '(fxadd1 (fxadd1 -6)) "-4")
+  (check '(fxadd1 -1) "0")
+  (check '(fxadd1 1) "2")
+  (check '(fxadd1 -100) "-99")
+  (check '(fxadd1 1000) "1001")
+  (check '(fxadd1 536870910) "536870911")
+  (check '(fxadd1 -536870912) "-536870911")
+  (check '(fxadd1 (fxadd1 0)) "2")
+  (check '(fxadd1 (fxadd1 (fxadd1 (fxadd1 (fxadd1 (fxadd1 12)))))) "18"))
 
 (define-test primitives/fxsub1
   (check '(fxsub1 1) "0")
   (check '(fxsub1 0) "-1")
+  (check '(fxsub1 -1) "-2")
   (check '(fxsub1 99) "98")
   (check '(fxsub1 (fxsub1 202)) "200")
-  (check '(fxsub1 (fxadd1 -6)) "-6"))
+  (check '(fxsub1 (fxadd1 -6)) "-6")
+  (check '(fxsub1 -100) "-101")
+  (check '(fxsub1 1000) "999")
+  (check '(fxsub1 536870911) "536870910")
+  (check '(fxsub1 -536870911) "-536870912")
+  (check '(fxsub1 (fxsub1 0)) "-2")
+  (check '(fxsub1 (fxsub1 (fxsub1 (fxsub1 (fxsub1 (fxsub1 12)))))) "6")
+  (check '(fxsub1 (fxadd1 0)) "0"))
+
 (define-test primitives/fxlognot
   (check '(fxlognot 0) "-1")
   (check '(fxlognot -1) "0")
@@ -78,9 +99,21 @@
   (check '(fxlognot (fxlognot 237463)) "237463"))
 
 (define-test primitives/char-fixnum-conversion
-  (check '(char->fixnum #\A) "65")
+  (check '(fixnum->char (fxadd1 (char->fixnum #\A))) "#\\B")
   (check '(fixnum->char 65) "#\\A")
-  (check '(fixnum->char (fxadd1 (char->fixnum #\A))) "#\\B"))
+  (check '(fixnum->char 97) "#\\a")
+  (check '(fixnum->char 122) "#\\z")
+  (check '(fixnum->char 90) "#\\Z")
+  (check '(fixnum->char 48) "#\\0")
+  (check '(fixnum->char 57) "#\\9")
+  (check '(char->fixnum #\A) "65")
+  (check '(char->fixnum #\a) "97")
+  (check '(char->fixnum #\z) "122")
+  (check '(char->fixnum #\Z) "90")
+  (check '(char->fixnum #\0) "48")
+  (check '(char->fixnum #\9) "57")
+  (check '(char->fixnum (fixnum->char 12)) "12")
+  (check '(fixnum->char (char->fixnum #\x)) "#\\x"))
 
 (define-test primitives/fixnum?
   (check '(fixnum? 1)      "#t")
@@ -89,7 +122,16 @@
   (check '(fixnum? nil)    "#f")
   (check '(fixnum? :true)  "#f")
   (check '(fixnum? :false) "#f")
-  (check '(fixnum? #\A)    "#f"))
+  (check '(fixnum? #\A)    "#f")
+  (check '(fixnum? 37287) "#t")
+  (check '(fixnum? -23873) "#t")
+  (check '(fixnum? 536870911) "#t")
+  (check '(fixnum? -536870912) "#t")
+  (check '(fixnum? (fixnum? 12)) "#f")
+  (check '(fixnum? (fixnum? :false)) "#f")
+  (check '(fixnum? (fixnum? #\A)) "#f")
+  (check '(fixnum? (char->fixnum #\r)) "#t")
+  (check '(fixnum? (fixnum->char 12)) "#f"))
 
 (define-test primitives/boolean?
   (check '(boolean? 1)      "#f")
@@ -134,12 +176,46 @@
   (check '(not nil)    "#f")
   (check '(not :true)  "#f")
   (check '(not :false) "#t")
-  (check '(not #\A)    "#f"))
+  (check '(not #\A)    "#f")
+  (check '(not (not :true)) "#t")
+  (check '(not (not :false)) "#f")
+  (check '(not (not 15)) "#t")
+  (check '(not (fixnum? 15)) "#f")
+  (check '(not (fixnum? :false)) "#t"))
 
 (define-test if
   (check '(if :true 1 2) "1")
   (check '(if :false 1 2) "2")
-  (check '(if nil 1 2) "1"))
+  (check '(if nil 1 2) "1")
+  (check '(if :true 12 13) "12")
+  (check '(if :false 12 13) "13")
+  (check '(if 0 12 13)  "12")
+  (check '(if () 43 ()) "43")
+  (check '(if :true (if 12 13 4) 17) "13")
+  (check '(if :false 12 (if :false 13 4)) "4")
+  (check '(if #\X (if 1 2 3) (if 4 5 6)) "2")
+  (check '(if (not (boolean? :true)) 15 (boolean? :false)) "#t")
+  (check '(if (if (char? #\a) (boolean? #\b) (fixnum? #\c)) 119 -23) "-23")
+  (check '(if (if (if (not 1) (not 2) (not 3)) 4 5) 6 7) "6")
+  (check '(if (not (if (if (not 1) (not 2) (not 3)) 4 5)) 6 7) "7")
+  (check '(not (if (not (if (if (not 1) (not 2) (not 3)) 4 5)) 6 7)) "#f")
+  (check '(if (char? 12) 13 14) "14")
+  (check '(if (char? #\a) 13 14) "13")
+  (check '(fxadd1 (if (fxsub1 1) (fxsub1 13) 14)) "13")
+  (check '(if (fx= 12 13) 12 13) "13")
+  (check '(if (fx= 12 12) 13 14) "13")
+  (check '(if (fx< 12 13) 12 13) "12")
+  (check '(if (fx< 12 12) 13 14) "14")
+  (check '(if (fx< 13 12) 13 14) "14")
+  (check '(if (fx<= 12 13) 12 13) "12")
+  (check '(if (fx<= 12 12) 12 13) "12")
+  (check '(if (fx<= 13 12) 13 14) "14")
+  (check '(if (fx> 12 13) 12 13) "13")
+  (check '(if (fx> 12 12) 12 13) "13")
+  (check '(if (fx> 13 12) 13 14) "13")
+  (check '(if (fx>= 12 13) 12 13) "13")
+  (check '(if (fx>= 12 12) 12 13) "12")
+  (check '(if (fx>= 13 12) 13 14) "13"))
 
 (define-test if/predicate-fusion
   (check '(if (null? nil) 1 2) "1")
@@ -158,7 +234,27 @@
   (check '(if (not :true) 1 2) "2")
   (check '(if (not nil) 1 2) "2")
   (check '(if (not (fixnum? 0)) 1 2) "2")
-  (check '(if (not (fixnum? #\x)) 1 2) "1"))
+  (check '(if (not (fixnum? #\x)) 1 2) "1")
+
+  (check '(if (fx= 6 0) 1 2) "2")
+  (check '(if (fx= 0 6) 1 2) "2")
+  (check '(if (fx= 0 0) 1 2) "1")
+
+  (check '(if (fx< 6 0) 1 2) "2")
+  (check '(if (fx< 0 6) 1 2) "1")
+  (check '(if (fx< 0 0) 1 2) "2")
+
+  (check '(if (fx> 6 0) 1 2) "1")
+  (check '(if (fx> 0 6) 1 2) "2")
+  (check '(if (fx> 0 0) 1 2) "2")
+
+  (check '(if (fx>= 6 0) 1 2) "1")
+  (check '(if (fx>= 0 6) 1 2) "2")
+  (check '(if (fx>= 0 0) 1 2) "1")
+
+  (check '(if (fx<= 6 0) 1 2) "2")
+  (check '(if (fx<= 0 6) 1 2) "1")
+  (check '(if (fx<= 0 0) 1 2) "1"))
 
 (define-test primitives/simple-combos
   (check '(fxzero? (fxsub1 (fxadd1 0))) "#t")
@@ -170,4 +266,298 @@
   (check '(not (boolean? (not 1))) "#f")
   (check '(not (not (boolean? (not 1)))) "#t"))
 
+(define-test primitives/fx+
+  (check '(fx+ 1 2) "3")
+  (check '(fx+ 1 -2) "-1")
+  (check '(fx+ -1 2) "1")
+  (check '(fx+ -1 -2) "-3")
+  (check '(fx+ 536870911 -1) "536870910")
+  (check '(fx+ 536870910 1) "536870911")
+  (check '(fx+ -536870912 1) "-536870911")
+  (check '(fx+ -536870911 -1) "-536870912")
+  (check '(fx+ 536870911 -536870912) "-1")
+  (check '(fx+ 1 (fx+ 2 3)) "6")
+  (check '(fx+ 1 (fx+ 2 -3)) "0")
+  (check '(fx+ 1 (fx+ -2 3)) "2")
+  (check '(fx+ 1 (fx+ -2 -3)) "-4")
+  (check '(fx+ -1 (fx+ 2 3)) "4")
+  (check '(fx+ -1 (fx+ 2 -3)) "-2")
+  (check '(fx+ -1 (fx+ -2 3)) "0")
+  (check '(fx+ -1 (fx+ -2 -3)) "-6")
+  (check '(fx+ (fx+ 1 2) 3) "6")
+  (check '(fx+ (fx+ 1 2) -3) "0")
+  (check '(fx+ (fx+ 1 -2) 3) "2")
+  (check '(fx+ (fx+ 1 -2) -3) "-4")
+  (check '(fx+ (fx+ -1 2) 3) "4")
+  (check '(fx+ (fx+ -1 2) -3) "-2")
+  (check '(fx+ (fx+ -1 -2) 3) "0")
+  (check '(fx+ (fx+ -1 -2) -3) "-6")
+  (check '(fx+ (fx+ (fx+ (fx+ (fx+ (fx+ (fx+ (fx+ 1 2) 3) 4) 5) 6) 7) 8) 9) "45")
+  (check '(fx+ 1 (fx+ 2 (fx+ 3 (fx+ 4 (fx+ 5 (fx+ 6 (fx+ 7 (fx+ 8 9)))))))) "45"))
 
+(define-test primitives/fx-
+  (check '(fx- 1 2) "-1")
+  (check '(fx- 1 -2) "3")
+  (check '(fx- -1 2) "-3")
+  (check '(fx- -1 -2) "1")
+  (check '(fx- 536870910 -1) "536870911")
+  (check '(fx- 536870911 1) "536870910")
+  (check '(fx- -536870911 1) "-536870912")
+  (check '(fx- -536870912 -1) "-536870911")
+  (check '(fx- 1 536870911) "-536870910")
+  (check '(fx- -1 536870911) "-536870912")
+  (check '(fx- 1 -536870910) "536870911")
+  (check '(fx- -1 -536870912) "536870911")
+  (check '(fx- 536870911 536870911) "0")
+  (check '(fx- -536870911 -536870912) "1")
+  (check '(fx- 1 (fx- 2 3)) "2")
+  (check '(fx- 1 (fx- 2 -3)) "-4")
+  (check '(fx- 1 (fx- -2 3)) "6")
+  (check '(fx- 1 (fx- -2 -3)) "0")
+  (check '(fx- -1 (fx- 2 3)) "0")
+  (check '(fx- -1 (fx- 2 -3)) "-6")
+  (check '(fx- -1 (fx- -2 3)) "4")
+  (check '(fx- -1 (fx- -2 -3)) "-2")
+  (check '(fx- 0 (fx- -2 -3)) "-1")
+  (check '(fx- (fx- 1 2) 3) "-4")
+  (check '(fx- (fx- 1 2) -3) "2")
+  (check '(fx- (fx- 1 -2) 3) "0")
+  (check '(fx- (fx- 1 -2) -3) "6")
+  (check '(fx- (fx- -1 2) 3) "-6")
+  (check '(fx- (fx- -1 2) -3) "0")
+  (check '(fx- (fx- -1 -2) 3) "-2")
+  (check '(fx- (fx- -1 -2) -3) "4")
+  (check '(fx- (fx- (fx- (fx- (fx- (fx- (fx- (fx- 1 2) 3) 4) 5) 6) 7) 8) 9) "-43")
+  (check '(fx- 1 (fx- 2 (fx- 3 (fx- 4 (fx- 5 (fx- 6 (fx- 7 (fx- 8 9)))))))) "5"))
+
+(define-test primitives/fx*
+  (check '(fx* 2 3) "6")
+  (check '(fx* 2 -3) "-6")
+  (check '(fx* -2 3) "-6")
+  (check '(fx* -2 -3) "6")
+  (check '(fx* 536870911 1) "536870911")
+  (check '(fx* 536870911 -1) "-536870911")
+  (check '(fx* -536870912 1) "-536870912")
+  (check '(fx* -536870911 -1) "536870911")
+  (check '(fx* 2 (fx* 3 4)) "24")
+  (check '(fx* (fx* 2 3) 4) "24")
+  (check '(fx* (fx* (fx* (fx* (fx* 2 3) 4) 5) 6) 7) "5040")
+  (check '(fx* 2 (fx* 3 (fx* 4 (fx* 5 (fx* 6 7))))) "5040"))
+
+(define-test primitives/fxbitops
+  (check '(fxlogand 3 7) "3")
+  (check '(fxlogand 3 5) "1")
+  (check '(fxlogand 2346 (fxlognot 2346)) "0")
+  (check '(fxlogand (fxlognot 2346) 2346) "0")
+  (check '(fxlogand 2376 2376) "2376")
+  (check '(fxlogor 3 16) "19")
+  (check '(fxlogor 3 5)  "7")
+  (check '(fxlogor 3 7)  "7")
+  (check '(fxlognot (fxlogor (fxlognot 7) 1)) "6")
+  (check '(fxlognot (fxlogor 1 (fxlognot 7))) "6"))
+
+(define-test primitives/fx=
+  (check '(fx= 0 0)            "#t")
+  (check '(fx= 0 1)            "#f")
+  (check '(fx= (fx+ 1 2) 3)    "#t")
+  (check '(fx= 3 (fx+ 1 2))    "#t")
+  (check '(fx= (fx+ 2 2) 3)    "#f")
+  (check '(fx= 3 (fx+ 2 2))    "#f")
+  (check '(fx= 12 13)          "#f")
+  (check '(fx= 12 12)          "#t")
+  (check '(fx= 16 (fx+ 13 3))  "#t")
+  (check '(fx= 16 (fx+ 13 13)) "#f")
+  (check '(fx= (fx+ 13 3) 16)  "#t")
+  (check '(fx= (fx+ 13 13) 16) "#f"))
+
+(define-test primitives/fx<
+  (check '(fx< 0 0)         "#f")
+  (check '(fx< 0 1)         "#t")
+  (check '(fx< 1 0)         "#f")
+  (check '(fx< (fx+ 1 2) 3) "#f")
+  (check '(fx< (fx+ 1 2) 4) "#t")
+  (check '(fx< -3 1)        "#t")
+  (check '(fx< 1 -3)        "#f")
+  (check '(fx< 12 13) "#t")
+  (check '(fx< 12 12) "#f")
+  (check '(fx< 13 12) "#f")
+  (check '(fx< 16 (fx+ 13 1)) "#f")
+  (check '(fx< 16 (fx+ 13 3)) "#f")
+  (check '(fx< 16 (fx+ 13 13)) "#t")
+  (check '(fx< (fx+ 13 1) 16) "#t")
+  (check '(fx< (fx+ 13 3) 16) "#f")
+  (check '(fx< (fx+ 13 13) 16) "#f"))
+
+(define-test primitives/fx<=
+  (check '(fx<= 0 0)         "#t")
+  (check '(fx<= 0 1)         "#t")
+  (check '(fx<= 1 0)         "#f")
+  (check '(fx<= (fx+ 1 2) 3) "#t")
+  (check '(fx<= (fx+ 1 2) 4) "#t")
+  (check '(fx<= (fx+ 9 2) 4) "#f")
+  (check '(fx<= -3 1)        "#t")
+  (check '(fx<= 1 -3)        "#f")
+  (check '(fx<= 12 13) "#t")
+  (check '(fx<= 12 12) "#t")
+  (check '(fx<= 13 12) "#f")
+  (check '(fx<= 16 (fx+ 13 1)) "#f")
+  (check '(fx<= 16 (fx+ 13 3)) "#t")
+  (check '(fx<= 16 (fx+ 13 13)) "#t")
+  (check '(fx<= (fx+ 13 1) 16) "#t")
+  (check '(fx<= (fx+ 13 3) 16) "#t")
+  (check '(fx<= (fx+ 13 13) 16) "#f"))
+
+(define-test primitives/fx>
+  (check '(fx> 0 0)         "#f")
+  (check '(fx> 1 0)         "#t")
+  (check '(fx> 0 1)         "#f")
+  (check '(fx> 3 (fx+ 1 2)) "#f")
+  (check '(fx> 4 (fx+ 1 2)) "#t")
+  (check '(fx> 1 -3)        "#t")
+  (check '(fx> -3 1)        "#f")
+  (check '(fx<= 12 13) "#t")
+  (check '(fx<= 12 12) "#t")
+  (check '(fx<= 13 12) "#f")
+  (check '(fx<= 16 (fx+ 13 1)) "#f")
+  (check '(fx<= 16 (fx+ 13 3)) "#t")
+  (check '(fx<= 16 (fx+ 13 13)) "#t")
+  (check '(fx<= (fx+ 13 1) 16) "#t")
+  (check '(fx<= (fx+ 13 3) 16) "#t")
+  (check '(fx<= (fx+ 13 13) 16) "#f"))
+
+(define-test primitives/fx>=
+  (check '(fx>= 0 0)         "#t")
+  (check '(fx>= 1 0)         "#t")
+  (check '(fx>= 0 1)         "#f")
+  (check '(fx>= 3 (fx+ 1 2)) "#t")
+  (check '(fx>= 4 (fx+ 1 2)) "#t")
+  (check '(fx>= 4 (fx+ 9 2)) "#f")
+  (check '(fx>= 1 -3)        "#t")
+  (check '(fx>= -3 1)        "#f")
+  (check '(fx>= 12 13) "#f")
+  (check '(fx>= 12 12) "#t")
+  (check '(fx>= 13 12) "#t")
+  (check '(fx>= 16 (fx+ 13 1)) "#t")
+  (check '(fx>= 16 (fx+ 13 3)) "#t")
+  (check '(fx>= 16 (fx+ 13 13)) "#f")
+  (check '(fx>= (fx+ 13 1) 16) "#f")
+  (check '(fx>= (fx+ 13 3) 16) "#t")
+  (check '(fx>= (fx+ 13 13) 16) "#t"))
+
+(define-test primitives/binary-combos
+  (check '(fxlognot -7) "6")
+  (check '(fxlognot (fxlogor (fxlognot 7) 1)) "6")
+  (check '(fxlognot (fxlogor (fxlognot 7) (fxlognot 2))) "2")
+  (check '(fxlogand (fxlognot (fxlognot 12)) (fxlognot (fxlognot 12))) "12")
+  (check '(fx+ (fx+ 1 2) (fx+ 3 4)) "10")
+  (check '(fx+ (fx+ 1 2) (fx+ 3 -4)) "2")
+  (check '(fx+ (fx+ 1 2) (fx+ -3 4)) "4")
+  (check '(fx+ (fx+ 1 2) (fx+ -3 -4)) "-4")
+  (check '(fx+ (fx+ 1 -2) (fx+ 3 4)) "6")
+  (check '(fx+ (fx+ 1 -2) (fx+ 3 -4)) "-2")
+  (check '(fx+ (fx+ 1 -2) (fx+ -3 4)) "0")
+  (check '(fx+ (fx+ 1 -2) (fx+ -3 -4)) "-8")
+  (check '(fx+ (fx+ -1 2) (fx+ 3 4)) "8")
+  (check '(fx+ (fx+ -1 2) (fx+ 3 -4)) "0")
+  (check '(fx+ (fx+ -1 2) (fx+ -3 4)) "2")
+  (check '(fx+ (fx+ -1 2) (fx+ -3 -4)) "-6")
+  (check '(fx+ (fx+ -1 -2) (fx+ 3 4)) "4")
+  (check '(fx+ (fx+ -1 -2) (fx+ 3 -4)) "-4")
+  (check '(fx+ (fx+ -1 -2) (fx+ -3 4)) "-2")
+  (check '(fx+ (fx+ -1 -2) (fx+ -3 -4)) "-10")
+  (check '(fx+ (fx+ (fx+ (fx+ (fx+ (fx+ (fx+ (fx+ 1 2) 3) 4) 5) 6) 7) 8) 9) "45")
+  (check '(fx+ 1 (fx+ 2 (fx+ 3 (fx+ 4 (fx+ 5 (fx+ 6 (fx+ 7 (fx+ 8 9)))))))) "45")
+  (check '(fx+ (fx+ (fx+ (fx+ 1 2) (fx+ 3 4)) (fx+ (fx+ 5 6) (fx+ 7 8))) (fx+ (fx+ (fx+ 9 10) (fx+ 11 12)) (fx+ (fx+ 13 14) (fx+ 15 16)))) "136")
+  (check '(fx- (fx- 1 2) (fx- 3 4)) "0")
+  (check '(fx- (fx- 1 2) (fx- 3 -4)) "-8")
+  (check '(fx- (fx- 1 2) (fx- -3 4)) "6")
+  (check '(fx- (fx- 1 2) (fx- -3 -4)) "-2")
+  (check '(fx- (fx- 1 -2) (fx- 3 4)) "4")
+  (check '(fx- (fx- 1 -2) (fx- 3 -4)) "-4")
+  (check '(fx- (fx- 1 -2) (fx- -3 4)) "10")
+  (check '(fx- (fx- 1 -2) (fx- -3 -4)) "2")
+  (check '(fx- (fx- -1 2) (fx- 3 4)) "-2")
+  (check '(fx- (fx- -1 2) (fx- 3 -4)) "-10")
+  (check '(fx- (fx- -1 2) (fx- -3 4)) "4")
+  (check '(fx- (fx- -1 2) (fx- -3 -4)) "-4")
+  (check '(fx- (fx- -1 -2) (fx- 3 4)) "2")
+  (check '(fx- (fx- -1 -2) (fx- 3 -4)) "-6")
+  (check '(fx- (fx- -1 -2) (fx- -3 4)) "8")
+  (check '(fx- (fx- -1 -2) (fx- -3 -4)) "0")
+  (check '(fx- (fx- (fx- (fx- (fx- (fx- (fx- (fx- 1 2) 3) 4) 5) 6) 7) 8) 9) "-43")
+  (check '(fx- 1 (fx- 2 (fx- 3 (fx- 4 (fx- 5 (fx- 6 (fx- 7 (fx- 8 9)))))))) "5")
+  (check '(fx- (fx- (fx- (fx- 1 2) (fx- 3 4)) (fx- (fx- 5 6) (fx- 7 8)))
+            (fx- (fx- (fx- 9 10) (fx- 11 12)) (fx- (fx- 13 14) (fx- 15 16))))
+         "0")
+  (check '(fx* (fx* (fx* (fx* 2 3) (fx* 4 5)) (fx* (fx* 6 7) (fx* 8 9))) (fx* (fx* (fx* 2 3) (fx* 2 3)) (fx* (fx* 2 3) (fx* 2 3)))) "470292480")
+  (check '(fxlognot (fxlogor (fxlognot 7) 1)) "6")
+  (check '(fxlognot (fxlogor (fxlognot 7) (fxlognot 2))) "2")
+  (check '(fxlogand (fxlognot (fxlognot 12)) (fxlognot (fxlognot 12))) "12")
+  (check '(fx= (fx+ 13 3) (fx+ 10 6)) "#t")
+  (check '(fx= (fx+ 13 0) (fx+ 10 6)) "#f")
+  (check '(fx= (fx+ 12 1) (fx+ -12 -1)) "#f")
+  (check '(fx< (fx+ 10 6) (fx+ 13 1)) "#f")
+  (check '(fx< (fx+ 10 6) (fx+ 13 3)) "#f")
+  (check '(fx< (fx+ 10 6) (fx+ 13 31)) "#t")
+  (check '(fx< (fx+ 12 1) (fx+ -12 -1)) "#f")
+  (check '(fx< (fx+ -12 -1) (fx+ 12 1)) "#t")
+  (check '(fx<= (fx+ 10 6) (fx+ 13 1)) "#f")
+  (check '(fx<= (fx+ 10 6) (fx+ 13 3)) "#t")
+  (check '(fx<= (fx+ 10 6) (fx+ 13 31)) "#t")
+  (check '(fx<= (fx+ 12 1) (fx+ -12 -1)) "#f")
+  (check '(fx<= (fx+ -12 -1) (fx+ 12 1)) "#t")
+  (check '(fx> (fx+ 10 6) (fx+ 13 1)) "#t")
+  (check '(fx> (fx+ 10 6) (fx+ 13 3)) "#f")
+  (check '(fx> (fx+ 10 6) (fx+ 13 31)) "#f")
+  (check '(fx> (fx+ 12 1) (fx+ -12 -1)) "#t")
+  (check '(fx> (fx+ -12 -1) (fx+ 12 1)) "#f")
+  (check '(fx>= (fx+ 10 6) (fx+ 13 1)) "#t")
+  (check '(fx>= (fx+ 10 6) (fx+ 13 3)) "#t")
+  (check '(fx>= (fx+ 10 6) (fx+ 13 31)) "#f")
+  (check '(fx>= (fx+ 12 1) (fx+ -12 -1)) "#t")
+  (check '(fx>= (fx+ -12 -1) (fx+ 12 1)) "#f"))
+
+(define-test primitives/char=
+  (check '(char= #\A #\A)             "#t")
+  (check '(char= #\A #\B)             "#f")
+  (check '(char= #\B #\A)             "#f")
+  (check '(char= #\a #\A)             "#f")
+  (check '(char= #\newline #\x)       "#f")
+  (check '(char= #\x #\newline)       "#f")
+  (check '(char= #\newline #\newline) "#t"))
+
+(define-test primitives/char<
+  (check '(char< #\A #\A)             "#f")
+  (check '(char< #\A #\B)             "#t")
+  (check '(char< #\B #\A)             "#f")
+  (check '(char< #\a #\A)             "#f")
+  (check '(char< #\newline #\x)       "#t")
+  (check '(char< #\x #\newline)       "#f")
+  (check '(char< #\newline #\newline) "#f"))
+
+(define-test primitives/char>
+  (check '(char> #\A #\A)             "#f")
+  (check '(char> #\B #\A)             "#t")
+  (check '(char> #\A #\B)             "#f")
+  (check '(char> #\A #\a)             "#f")
+  (check '(char> #\x #\newline)       "#t")
+  (check '(char> #\newline #\x)       "#f")
+  (check '(char> #\newline #\newline) "#f"))
+
+(define-test primitives/char<=
+  (check '(char<= #\A #\A)             "#t")
+  (check '(char<= #\A #\B)             "#t")
+  (check '(char<= #\B #\A)             "#f")
+  (check '(char<= #\a #\A)             "#f")
+  (check '(char<= #\newline #\x)       "#t")
+  (check '(char<= #\x #\newline)       "#f")
+  (check '(char<= #\newline #\newline) "#t"))
+
+(define-test primitives/char>
+  (check '(char>= #\A #\A)             "#t")
+  (check '(char>= #\B #\A)             "#t")
+  (check '(char>= #\A #\B)             "#f")
+  (check '(char>= #\A #\a)             "#f")
+  (check '(char>= #\x #\newline)       "#t")
+  (check '(char>= #\newline #\x)       "#f")
+  (check '(char>= #\newline #\newline) "#t"))