mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 16:20:17 +02:00
Code Activity

$primcall has a "param" member

Browse source 
* module/language/cps.scm ($primcall): Add "param" member, which will be
  a constant parameter to the primcall.  The idea is that constants used
  by primcalls as immediates don't need to participate in optimizations
  in any way -- they should not participate in CSE, have the same
  lifetime as the primcall so not part of DCE either, and don't need
  slot allocation.  Indirecting them through a named $const binding is
  complication for no benefit.  This change should eventually improve
  compilation time and memory usage, once we fully take advantage of it,
  as the number of labels and variables will go down.
* module/language/cps/closure-conversion.scm:
* module/language/cps/compile-bytecode.scm:
* module/language/cps/constructors.scm:
* module/language/cps/contification.scm:
* module/language/cps/cse.scm:
* module/language/cps/dce.scm:
* module/language/cps/effects-analysis.scm:
* module/language/cps/elide-values.scm:
* module/language/cps/handle-interrupts.scm:
* module/language/cps/licm.scm:
* module/language/cps/peel-loops.scm:
* module/language/cps/prune-bailouts.scm:
* module/language/cps/prune-top-level-scopes.scm:
* module/language/cps/reify-primitives.scm:
* module/language/cps/renumber.scm:
* module/language/cps/rotate-loops.scm:
* module/language/cps/self-references.scm:
* module/language/cps/simplify.scm:
* module/language/cps/slot-allocation.scm:
* module/language/cps/specialize-numbers.scm:
* module/language/cps/specialize-primcalls.scm:
* module/language/cps/split-rec.scm:
* module/language/cps/type-checks.scm:
* module/language/cps/type-fold.scm:
* module/language/cps/types.scm:
* module/language/cps/utils.scm:
* module/language/cps/verify.scm:
* module/language/tree-il/compile-cps.scm: Adapt all users.
This commit is contained in:
Andy Wingo 2017-11-01 11:57:16 +01:00
parent 2d8c75f9f2
commit c54c151eb6
29 changed files with 427 additions and 420 deletions
Download patch file Download diff file Expand all files Collapse all files

234
module/language/cps/compile-bytecode.scm
View file

@ -143,138 +143,138 @@
(emit-current-module asm (from-sp dst)))
(($ $primcall 'current-thread)
(emit-current-thread asm (from-sp dst)))
(($ $primcall 'cached-toplevel-box (scope name bound?))
(($ $primcall 'cached-toplevel-box #f (scope name bound?))
(emit-cached-toplevel-box asm (from-sp dst)
(constant scope) (constant name)
(constant bound?)))
(($ $primcall 'cached-module-box (mod name public? bound?))
(($ $primcall 'cached-module-box #f (mod name public? bound?))
(emit-cached-module-box asm (from-sp dst)
(constant mod) (constant name)
(constant public?) (constant bound?)))
(($ $primcall 'define! (sym))
(($ $primcall 'define! #f (sym))
(emit-define! asm (from-sp dst) (from-sp (slot sym))))
(($ $primcall 'resolve (name bound?))
(($ $primcall 'resolve #f (name bound?))
(emit-resolve asm (from-sp dst) (constant bound?)
(from-sp (slot name))))
(($ $primcall 'free-ref (closure idx))
(($ $primcall 'free-ref #f (closure idx))
(emit-free-ref asm (from-sp dst) (from-sp (slot closure))
(constant idx)))
(($ $primcall 'vector-ref (vector index))
(($ $primcall 'vector-ref #f (vector index))
(emit-vector-ref asm (from-sp dst) (from-sp (slot vector))
(from-sp (slot index))))
(($ $primcall 'make-vector (length init))
(($ $primcall 'make-vector #f (length init))
(emit-make-vector asm (from-sp dst) (from-sp (slot length))
(from-sp (slot init))))
(($ $primcall 'make-vector/immediate (length init))
(($ $primcall 'make-vector/immediate #f (length init))
(emit-make-vector/immediate asm (from-sp dst) (constant length)
(from-sp (slot init))))
(($ $primcall 'vector-ref/immediate (vector index))
(($ $primcall 'vector-ref/immediate #f (vector index))
(emit-vector-ref/immediate asm (from-sp dst) (from-sp (slot vector))
(constant index)))
(($ $primcall 'allocate-struct (vtable nfields))
(($ $primcall 'allocate-struct #f (vtable nfields))
(emit-allocate-struct asm (from-sp dst) (from-sp (slot vtable))
(from-sp (slot nfields))))
(($ $primcall 'allocate-struct/immediate (vtable nfields))
(($ $primcall 'allocate-struct/immediate #f (vtable nfields))
(emit-allocate-struct/immediate asm (from-sp dst)
(from-sp (slot vtable))
(constant nfields)))
(($ $primcall 'struct-ref (struct n))
(($ $primcall 'struct-ref #f (struct n))
(emit-struct-ref asm (from-sp dst) (from-sp (slot struct))
(from-sp (slot n))))
(($ $primcall 'struct-ref/immediate (struct n))
(($ $primcall 'struct-ref/immediate #f (struct n))
(emit-struct-ref/immediate asm (from-sp dst) (from-sp (slot struct))
(constant n)))
(($ $primcall 'char->integer (src))
(($ $primcall 'char->integer #f (src))
(emit-char->integer asm (from-sp dst) (from-sp (slot src))))
(($ $primcall 'integer->char (src))
(($ $primcall 'integer->char #f (src))
(emit-integer->char asm (from-sp dst) (from-sp (slot src))))
(($ $primcall 'add/immediate (x y))
(($ $primcall 'add/immediate #f (x y))
(emit-add/immediate asm (from-sp dst) (from-sp (slot x)) (constant y)))
(($ $primcall 'sub/immediate (x y))
(($ $primcall 'sub/immediate #f (x y))
(emit-sub/immediate asm (from-sp dst) (from-sp (slot x)) (constant y)))
(($ $primcall 'uadd/immediate (x y))
(($ $primcall 'uadd/immediate #f (x y))
(emit-uadd/immediate asm (from-sp dst) (from-sp (slot x))
(constant y)))
(($ $primcall 'usub/immediate (x y))
(($ $primcall 'usub/immediate #f (x y))
(emit-usub/immediate asm (from-sp dst) (from-sp (slot x))
(constant y)))
(($ $primcall 'umul/immediate (x y))
(($ $primcall 'umul/immediate #f (x y))
(emit-umul/immediate asm (from-sp dst) (from-sp (slot x))
(constant y)))
(($ $primcall 'ursh/immediate (x y))
(($ $primcall 'ursh/immediate #f (x y))
(emit-ursh/immediate asm (from-sp dst) (from-sp (slot x))
(constant y)))
(($ $primcall 'ulsh/immediate (x y))
(($ $primcall 'ulsh/immediate #f (x y))
(emit-ulsh/immediate asm (from-sp dst) (from-sp (slot x))
(constant y)))
(($ $primcall 'builtin-ref (name))
(($ $primcall 'builtin-ref #f (name))
(emit-builtin-ref asm (from-sp dst) (constant name)))
(($ $primcall 'scm->f64 (src))
(($ $primcall 'scm->f64 #f (src))
(emit-scm->f64 asm (from-sp dst) (from-sp (slot src))))
(($ $primcall 'load-f64 (src))
(($ $primcall 'load-f64 #f (src))
(emit-load-f64 asm (from-sp dst) (constant src)))
(($ $primcall 'f64->scm (src))
(($ $primcall 'f64->scm #f (src))
(emit-f64->scm asm (from-sp dst) (from-sp (slot src))))
(($ $primcall 'scm->u64 (src))
(($ $primcall 'scm->u64 #f (src))
(emit-scm->u64 asm (from-sp dst) (from-sp (slot src))))
(($ $primcall 'scm->u64/truncate (src))
(($ $primcall 'scm->u64/truncate #f (src))
(emit-scm->u64/truncate asm (from-sp dst) (from-sp (slot src))))
(($ $primcall 'load-u64 (src))
(($ $primcall 'load-u64 #f (src))
(emit-load-u64 asm (from-sp dst) (constant src)))
(($ $primcall (or 'u64->scm 'u64->scm/unlikely) (src))
(($ $primcall (or 'u64->scm 'u64->scm/unlikely) #f (src))
(emit-u64->scm asm (from-sp dst) (from-sp (slot src))))
(($ $primcall 'scm->s64 (src))
(($ $primcall 'scm->s64 #f (src))
(emit-scm->s64 asm (from-sp dst) (from-sp (slot src))))
(($ $primcall 'load-s64 (src))
(($ $primcall 'load-s64 #f (src))
(emit-load-s64 asm (from-sp dst) (constant src)))
(($ $primcall (or 's64->scm 's64->scm/unlikely) (src))
(($ $primcall (or 's64->scm 's64->scm/unlikely) #f (src))
(emit-s64->scm asm (from-sp dst) (from-sp (slot src))))
(($ $primcall 'bv-length (bv))
(($ $primcall 'bv-length #f (bv))
(emit-bv-length asm (from-sp dst) (from-sp (slot bv))))
(($ $primcall 'bv-u8-ref (bv idx))
(($ $primcall 'bv-u8-ref #f (bv idx))
(emit-bv-u8-ref asm (from-sp dst) (from-sp (slot bv))
(from-sp (slot idx))))
(($ $primcall 'bv-s8-ref (bv idx))
(($ $primcall 'bv-s8-ref #f (bv idx))
(emit-bv-s8-ref asm (from-sp dst) (from-sp (slot bv))
(from-sp (slot idx))))
(($ $primcall 'bv-u16-ref (bv idx))
(($ $primcall 'bv-u16-ref #f (bv idx))
(emit-bv-u16-ref asm (from-sp dst) (from-sp (slot bv))
(from-sp (slot idx))))
(($ $primcall 'bv-s16-ref (bv idx))
(($ $primcall 'bv-s16-ref #f (bv idx))
(emit-bv-s16-ref asm (from-sp dst) (from-sp (slot bv))
(from-sp (slot idx))))
(($ $primcall 'bv-u32-ref (bv idx val))
(($ $primcall 'bv-u32-ref #f (bv idx val))
(emit-bv-u32-ref asm (from-sp dst) (from-sp (slot bv))
(from-sp (slot idx))))
(($ $primcall 'bv-s32-ref (bv idx val))
(($ $primcall 'bv-s32-ref #f (bv idx val))
(emit-bv-s32-ref asm (from-sp dst) (from-sp (slot bv))
(from-sp (slot idx))))
(($ $primcall 'bv-u64-ref (bv idx val))
(($ $primcall 'bv-u64-ref #f (bv idx val))
(emit-bv-u64-ref asm (from-sp dst) (from-sp (slot bv))
(from-sp (slot idx))))
(($ $primcall 'bv-s64-ref (bv idx val))
(($ $primcall 'bv-s64-ref #f (bv idx val))
(emit-bv-s64-ref asm (from-sp dst) (from-sp (slot bv))
(from-sp (slot idx))))
(($ $primcall 'bv-f32-ref (bv idx val))
(($ $primcall 'bv-f32-ref #f (bv idx val))
(emit-bv-f32-ref asm (from-sp dst) (from-sp (slot bv))
(from-sp (slot idx))))
(($ $primcall 'bv-f64-ref (bv idx val))
(($ $primcall 'bv-f64-ref #f (bv idx val))
(emit-bv-f64-ref asm (from-sp dst) (from-sp (slot bv))
(from-sp (slot idx))))
(($ $primcall 'make-atomic-box (init))
(($ $primcall 'make-atomic-box #f (init))
(emit-make-atomic-box asm (from-sp dst) (from-sp (slot init))))
(($ $primcall 'atomic-box-ref (box))
(($ $primcall 'atomic-box-ref #f (box))
(emit-atomic-box-ref asm (from-sp dst) (from-sp (slot box))))
(($ $primcall 'atomic-box-swap! (box val))
(($ $primcall 'atomic-box-swap! #f (box val))
(emit-atomic-box-swap! asm (from-sp dst) (from-sp (slot box))
(from-sp (slot val))))
(($ $primcall 'atomic-box-compare-and-swap! (box expected desired))
(($ $primcall 'atomic-box-compare-and-swap! #f (box expected desired))
(emit-atomic-box-compare-and-swap!
asm (from-sp dst) (from-sp (slot box))
(from-sp (slot expected)) (from-sp (slot desired))))
(($ $primcall 'untag-fixnum (src))
(($ $primcall 'untag-fixnum #f (src))
(emit-untag-fixnum asm (from-sp dst) (from-sp (slot src))))
(($ $primcall name args)
(($ $primcall name #f args)
;; FIXME: Inline all the cases.
(let ((inst (prim-instruction name)))
(emit-text asm `((,inst ,(from-sp dst)
@ -305,79 +305,79 @@
(lookup-parallel-moves handler allocation))
(emit-reset-frame asm frame-size)
(emit-j asm (forward-label khandler-body))))))
(($ $primcall 'cache-current-module! (sym scope))
(($ $primcall 'cache-current-module! #f (sym scope))
(emit-cache-current-module! asm (from-sp (slot sym)) (constant scope)))
(($ $primcall 'free-set! (closure idx value))
(($ $primcall 'free-set! #f (closure idx value))
(emit-free-set! asm (from-sp (slot closure)) (from-sp (slot value))
(constant idx)))
(($ $primcall 'box-set! (box value))
(($ $primcall 'box-set! #f (box value))
(emit-box-set! asm (from-sp (slot box)) (from-sp (slot value))))
(($ $primcall 'struct-set! (struct index value))
(($ $primcall 'struct-set! #f (struct index value))
(emit-struct-set! asm (from-sp (slot struct)) (from-sp (slot index))
(from-sp (slot value))))
(($ $primcall 'struct-set!/immediate (struct index value))
(($ $primcall 'struct-set!/immediate #f (struct index value))
(emit-struct-set!/immediate asm (from-sp (slot struct))
(constant index) (from-sp (slot value))))
(($ $primcall 'vector-set! (vector index value))
(($ $primcall 'vector-set! #f (vector index value))
(emit-vector-set! asm (from-sp (slot vector)) (from-sp (slot index))
(from-sp (slot value))))
(($ $primcall 'vector-set!/immediate (vector index value))
(($ $primcall 'vector-set!/immediate #f (vector index value))
(emit-vector-set!/immediate asm (from-sp (slot vector))
(constant index) (from-sp (slot value))))
(($ $primcall 'string-set! (string index char))
(($ $primcall 'string-set! #f (string index char))
(emit-string-set! asm (from-sp (slot string)) (from-sp (slot index))
(from-sp (slot char))))
(($ $primcall 'set-car! (pair value))
(($ $primcall 'set-car! #f (pair value))
(emit-set-car! asm (from-sp (slot pair)) (from-sp (slot value))))
(($ $primcall 'set-cdr! (pair value))
(($ $primcall 'set-cdr! #f (pair value))
(emit-set-cdr! asm (from-sp (slot pair)) (from-sp (slot value))))
(($ $primcall 'push-fluid (fluid val))
(($ $primcall 'push-fluid #f (fluid val))
(emit-push-fluid asm (from-sp (slot fluid)) (from-sp (slot val))))
(($ $primcall 'pop-fluid ())
(($ $primcall 'pop-fluid #f ())
(emit-pop-fluid asm))
(($ $primcall 'push-dynamic-state (state))
(($ $primcall 'push-dynamic-state #f (state))
(emit-push-dynamic-state asm (from-sp (slot state))))
(($ $primcall 'pop-dynamic-state ())
(($ $primcall 'pop-dynamic-state #f ())
(emit-pop-dynamic-state asm))
(($ $primcall 'wind (winder unwinder))
(($ $primcall 'wind #f (winder unwinder))
(emit-wind asm (from-sp (slot winder)) (from-sp (slot unwinder))))
(($ $primcall 'bv-u8-set! (bv idx val))
(($ $primcall 'bv-u8-set! #f (bv idx val))
(emit-bv-u8-set! asm (from-sp (slot bv)) (from-sp (slot idx))
(from-sp (slot val))))
(($ $primcall 'bv-s8-set! (bv idx val))
(($ $primcall 'bv-s8-set! #f (bv idx val))
(emit-bv-s8-set! asm (from-sp (slot bv)) (from-sp (slot idx))
(from-sp (slot val))))
(($ $primcall 'bv-u16-set! (bv idx val))
(($ $primcall 'bv-u16-set! #f (bv idx val))
(emit-bv-u16-set! asm (from-sp (slot bv)) (from-sp (slot idx))
(from-sp (slot val))))
(($ $primcall 'bv-s16-set! (bv idx val))
(($ $primcall 'bv-s16-set! #f (bv idx val))
(emit-bv-s16-set! asm (from-sp (slot bv)) (from-sp (slot idx))
(from-sp (slot val))))
(($ $primcall 'bv-u32-set! (bv idx val))
(($ $primcall 'bv-u32-set! #f (bv idx val))
(emit-bv-u32-set! asm (from-sp (slot bv)) (from-sp (slot idx))
(from-sp (slot val))))
(($ $primcall 'bv-s32-set! (bv idx val))
(($ $primcall 'bv-s32-set! #f (bv idx val))
(emit-bv-s32-set! asm (from-sp (slot bv)) (from-sp (slot idx))
(from-sp (slot val))))
(($ $primcall 'bv-u64-set! (bv idx val))
(($ $primcall 'bv-u64-set! #f (bv idx val))
(emit-bv-u64-set! asm (from-sp (slot bv)) (from-sp (slot idx))
(from-sp (slot val))))
(($ $primcall 'bv-s64-set! (bv idx val))
(($ $primcall 'bv-s64-set! #f (bv idx val))
(emit-bv-s64-set! asm (from-sp (slot bv)) (from-sp (slot idx))
(from-sp (slot val))))
(($ $primcall 'bv-f32-set! (bv idx val))
(($ $primcall 'bv-f32-set! #f (bv idx val))
(emit-bv-f32-set! asm (from-sp (slot bv)) (from-sp (slot idx))
(from-sp (slot val))))
(($ $primcall 'bv-f64-set! (bv idx val))
(($ $primcall 'bv-f64-set! #f (bv idx val))
(emit-bv-f64-set! asm (from-sp (slot bv)) (from-sp (slot idx))
(from-sp (slot val))))
(($ $primcall 'unwind ())
(($ $primcall 'unwind #f ())
(emit-unwind asm))
(($ $primcall 'fluid-set! (fluid value))
(($ $primcall 'fluid-set! #f (fluid value))
(emit-fluid-set! asm (from-sp (slot fluid)) (from-sp (slot value))))
(($ $primcall 'atomic-box-set! (box val))
(($ $primcall 'atomic-box-set! #f (box val))
(emit-atomic-box-set! asm (from-sp (slot box)) (from-sp (slot val))))
(($ $primcall 'handle-interrupts ())
(($ $primcall 'handle-interrupts #f ())
(emit-handle-interrupts asm))))
(define (compile-values label exp syms)
@ -417,48 +417,48 @@
(define (binary-test op a b)
(binary op emit-je emit-jne a b))
(match exp
(($ $primcall 'heap-object? (a)) (unary emit-heap-object? a))
(($ $primcall 'null? (a)) (unary emit-null? a))
(($ $primcall 'nil? (a)) (unary emit-nil? a))
(($ $primcall 'false? (a)) (unary emit-false? a))
(($ $primcall 'pair? (a)) (unary emit-pair? a))
(($ $primcall 'struct? (a)) (unary emit-struct? a))
(($ $primcall 'char? (a)) (unary emit-char? a))
(($ $primcall 'symbol? (a)) (unary emit-symbol? a))
(($ $primcall 'variable? (a)) (unary emit-variable? a))
(($ $primcall 'vector? (a)) (unary emit-vector? a))
(($ $primcall 'string? (a)) (unary emit-string? a))
(($ $primcall 'bytevector? (a)) (unary emit-bytevector? a))
(($ $primcall 'bitvector? (a)) (unary emit-bitvector? a))
(($ $primcall 'keyword? (a)) (unary emit-keyword? a))
(($ $primcall 'heap-number? (a)) (unary emit-heap-number? a))
(($ $primcall 'fixnum? (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 '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))
;; 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 'eq? (a b)) (binary-test emit-eq? a b))
(($ $primcall 'heap-numbers-equal? (a b))
(($ $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))
(($ $primcall '< (a b)) (binary emit-<? emit-jl emit-jnl a b))
(($ $primcall '<= (a b)) (binary emit-<? emit-jge emit-jnge b a))
(($ $primcall '= (a b)) (binary-test emit-=? a b))
(($ $primcall '>= (a b)) (binary emit-<? emit-jge emit-jnge a b))
(($ $primcall '> (a b)) (binary emit-<? emit-jl emit-jnl b a))
(($ $primcall 'u64-< (a b)) (binary emit-u64<? emit-jl emit-jnl a b))
(($ $primcall 'u64-<= (a b)) (binary emit-u64<? emit-jnl emit-jl b a))
(($ $primcall 'u64-= (a b)) (binary-test emit-u64=? a b))
(($ $primcall 'u64->= (a b)) (binary emit-u64<? emit-jnl emit-jl a b))
(($ $primcall 'u64-> (a b)) (binary emit-u64<? emit-jl emit-jnl b a))
(($ $primcall 's64-< (a b)) (binary emit-s64<? emit-jl emit-jnl a b))
(($ $primcall 's64-<= (a b)) (binary emit-s64<? emit-jnl emit-jl b a))
(($ $primcall 's64-= (a b)) (binary-test emit-s64=? a b))
(($ $primcall 's64->= (a b)) (binary emit-s64<? emit-jnl emit-jl a b))
(($ $primcall 's64-> (a b)) (binary emit-s64<? emit-jl emit-jnl b a))
(($ $primcall 'f64-< (a b)) (binary emit-f64<? emit-jl emit-jnl a b))
(($ $primcall 'f64-<= (a b)) (binary emit-f64<? emit-jge emit-jnge b a))
(($ $primcall 'f64-= (a b)) (binary-test emit-f64=? a b))
(($ $primcall 'f64->= (a b)) (binary emit-f64<? emit-jge emit-jnge a b))
(($ $primcall 'f64-> (a b)) (binary emit-f64<? emit-jl emit-jnl b a))))
(($ $primcall '< #f (a b)) (binary emit-<? emit-jl emit-jnl a b))
(($ $primcall '<= #f (a b)) (binary emit-<? emit-jge emit-jnge b a))
(($ $primcall '= #f (a b)) (binary-test emit-=? a b))
(($ $primcall '>= #f (a b)) (binary emit-<? emit-jge emit-jnge a b))
(($ $primcall '> #f (a b)) (binary emit-<? emit-jl emit-jnl b a))
(($ $primcall 'u64-< #f (a b)) (binary emit-u64<? emit-jl emit-jnl a b))
(($ $primcall 'u64-<= #f (a b)) (binary emit-u64<? emit-jnl emit-jl b a))
(($ $primcall 'u64-= #f (a b)) (binary-test emit-u64=? a b))
(($ $primcall 'u64->= #f (a b)) (binary emit-u64<? emit-jnl emit-jl a b))
(($ $primcall 'u64-> #f (a b)) (binary emit-u64<? emit-jl emit-jnl b a))
(($ $primcall 's64-< #f (a b)) (binary emit-s64<? emit-jl emit-jnl a b))
(($ $primcall 's64-<= #f (a b)) (binary emit-s64<? emit-jnl emit-jl b a))
(($ $primcall 's64-= #f (a b)) (binary-test emit-s64=? a b))
(($ $primcall 's64->= #f (a b)) (binary emit-s64<? emit-jnl emit-jl a b))
(($ $primcall 's64-> #f (a b)) (binary emit-s64<? emit-jl emit-jnl b a))
(($ $primcall 'f64-< #f (a b)) (binary emit-f64<? emit-jl emit-jnl a b))
(($ $primcall 'f64-<= #f (a b)) (binary emit-f64<? emit-jge emit-jnge b a))
(($ $primcall 'f64-= #f (a b)) (binary-test emit-f64=? a b))
(($ $primcall 'f64->= #f (a b)) (binary emit-f64<? emit-jge emit-jnge a b))
(($ $primcall 'f64-> #f (a b)) (binary emit-f64<? emit-jl emit-jnl b a))))
(define (compile-trunc label k exp nreq rest-var)
(define (do-call proc args emit-call)