diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm index aa33b688c..2b3b23fef 100644 --- a/module/language/cps/compile-bytecode.scm +++ b/module/language/cps/compile-bytecode.scm @@ -27,7 +27,6 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (language cps) - #:use-module (language cps primitives) #:use-module (language cps slot-allocation) #:use-module (language cps utils) #:use-module (language cps closure-conversion) @@ -476,10 +475,10 @@ (op asm (from-sp (slot a)) b) (emit-branch emit-jl emit-jnl)) (match exp + ;; Immediate type tag predicates. + (($ $primcall 'fixnum? #f (a)) (unary emit-fixnum? a)) (($ $primcall 'heap-object? #f (a)) (unary emit-heap-object? a)) - (($ $primcall 'null? #f (a)) (unary emit-null? a)) - (($ $primcall 'nil? #f (a)) (unary emit-nil? a)) - (($ $primcall 'false? #f (a)) (unary emit-false? a)) + (($ $primcall 'char? #f (a)) (unary emit-char? a)) (($ $primcall 'eq-false? #f (a)) (unary emit-eq-false? a)) (($ $primcall 'eq-nil? #f (a)) (unary emit-eq-nil? a)) (($ $primcall 'eq-null? #f (a)) (unary emit-eq-null? a)) @@ -487,22 +486,40 @@ (($ $primcall 'unspecified? #f (a)) (unary emit-unspecified? a)) (($ $primcall 'undefined? #f (a)) (unary emit-undefined? a)) (($ $primcall 'eof-object? #f (a)) (unary emit-eof-object? a)) + (($ $primcall 'null? #f (a)) (unary emit-null? a)) + (($ $primcall 'false? #f (a)) (unary emit-false? a)) + (($ $primcall 'nil? #f (a)) (unary emit-nil? a)) + ;; Heap type tag predicates. (($ $primcall 'pair? #f (a)) (unary emit-pair? a)) (($ $primcall 'struct? #f (a)) (unary emit-struct? a)) - (($ $primcall 'char? #f (a)) (unary emit-char? a)) (($ $primcall 'symbol? #f (a)) (unary emit-symbol? a)) (($ $primcall 'variable? #f (a)) (unary emit-variable? a)) (($ $primcall 'vector? #f (a)) (unary emit-vector? a)) (($ $primcall 'string? #f (a)) (unary emit-string? a)) - (($ $primcall 'bytevector? #f (a)) (unary emit-bytevector? a)) - (($ $primcall 'bitvector? #f (a)) (unary emit-bitvector? a)) - (($ $primcall 'keyword? #f (a)) (unary emit-keyword? a)) (($ $primcall 'heap-number? #f (a)) (unary emit-heap-number? a)) - (($ $primcall 'fixnum? #f (a)) (unary emit-fixnum? a)) + (($ $primcall 'hash-table? #f (a)) (unary emit-hash-table? a)) + (($ $primcall 'pointer? #f (a)) (unary emit-pointer? a)) + (($ $primcall 'fluid? #f (a)) (unary emit-fluid? a)) + (($ $primcall 'stringbuf? #f (a)) (unary emit-stringbuf? a)) + (($ $primcall 'dynamic-state? #f (a)) (unary emit-dynamic-state? a)) + (($ $primcall 'frame? #f (a)) (unary emit-frame? a)) + (($ $primcall 'keyword? #f (a)) (unary emit-keyword? a)) + (($ $primcall 'atomic-box? #f (a)) (unary emit-atomic-box? a)) + (($ $primcall 'syntax? #f (a)) (unary emit-syntax? a)) + (($ $primcall 'program? #f (a)) (unary emit-program? a)) + (($ $primcall 'vm-continuation? #f (a)) (unary emit-vm-continuation? a)) + (($ $primcall 'bytevector? #f (a)) (unary emit-bytevector? a)) + (($ $primcall 'weak-set? #f (a)) (unary emit-weak-set? a)) + (($ $primcall 'weak-table? #f (a)) (unary emit-weak-table? a)) + (($ $primcall 'array? #f (a)) (unary emit-array? a)) + (($ $primcall 'bitvector? #f (a)) (unary emit-bitvector? a)) + (($ $primcall 'smob? #f (a)) (unary emit-smob? a)) + (($ $primcall 'port? #f (a)) (unary emit-port? a)) (($ $primcall 'bignum? #f (a)) (unary emit-bignum? a)) - ;; Add more TC7 tests here. Keep in sync with - ;; *branching-primcall-arities* in (language cps primitives) and - ;; the set of macro-instructions in assembly.scm. + (($ $primcall 'flonum? #f (a)) (unary emit-flonum? a)) + (($ $primcall 'compnum? #f (a)) (unary emit-compnum? a)) + (($ $primcall 'fracnum? #f (a)) (unary emit-fracnum? a)) + ;; Binary predicates. (($ $primcall 'eq? #f (a b)) (binary-test emit-eq? a b)) (($ $primcall 'heap-numbers-equal? #f (a b)) (binary-test emit-heap-numbers-equal? a b))