mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00
Code Activity

Flesh out compile-bytecode for all heap objects

Browse source 
* module/language/cps/compile-bytecode.scm (compile-function): Organize
  emitters and flesh out with more heap type tag predicates.  Remove
  now-needless (language cps primitives) import.
This commit is contained in:
Andy Wingo 2017-12-27 12:11:07 +01:00
parent 140b69dfc6
commit 549ad3ce8c
1 changed files with 29 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -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))