summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/language/cps/compile-bytecode.scm63
-rw-r--r--module/language/cps/effects-analysis.scm26
-rw-r--r--module/language/cps/slot-allocation.scm7
-rw-r--r--module/language/cps/types.scm48
-rw-r--r--module/system/vm/assembler.scm21
5 files changed, 2 insertions, 163 deletions
diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm
index b68f90a67..0034cc199 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -240,38 +240,6 @@
(emit-load-s64 asm (from-sp dst) val))
(($ $primcall 's64->scm #f (src))
(emit-s64->scm asm (from-sp dst) (from-sp (slot src))))
- (($ $primcall 'bv-length #f (bv))
- (emit-bv-length asm (from-sp dst) (from-sp (slot bv))))
- (($ $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 #f (bv idx))
- (emit-bv-s8-ref asm (from-sp dst) (from-sp (slot bv))
- (from-sp (slot 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 #f (bv idx))
- (emit-bv-s16-ref asm (from-sp dst) (from-sp (slot bv))
- (from-sp (slot idx))))
- (($ $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 #f (bv idx val))
- (emit-bv-s32-ref asm (from-sp dst) (from-sp (slot bv))
- (from-sp (slot idx))))
- (($ $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 #f (bv idx val))
- (emit-bv-s64-ref asm (from-sp dst) (from-sp (slot bv))
- (from-sp (slot idx))))
- (($ $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 #f (bv idx val))
- (emit-bv-f64-ref asm (from-sp dst) (from-sp (slot bv))
- (from-sp (slot idx))))
(($ $primcall 'u8-ref ann (obj ptr idx))
(emit-u8-ref asm (from-sp dst) (from-sp (slot ptr))
@@ -373,37 +341,6 @@
(($ $primcall 'wind #f (winder unwinder))
(emit-wind asm (from-sp (slot winder)) (from-sp (slot unwinder))))
- (($ $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! #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! #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! #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! #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! #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! #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! #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! #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! #f (bv idx val))
- (emit-bv-f64-set! asm (from-sp (slot bv)) (from-sp (slot idx))
- (from-sp (slot val))))
-
(($ $primcall 'u8-set! ann (obj ptr idx val))
(emit-u8-set! asm (from-sp (slot ptr)) (from-sp (slot idx))
(from-sp (slot val))))
diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm
index 4fa00dbe9..bfa95cb7b 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -433,32 +433,6 @@ the LABELS that are clobbered by the effects of LABEL."
((tag-fixnum _))
((tag-fixnum/unlikely _)))
-;; Bytevectors.
-(define-primitive-effects
- ((bv-length _) &type-check)
-
- ((bv-u8-ref bv n) (&read-object &bytevector) &type-check)
- ((bv-s8-ref bv n) (&read-object &bytevector) &type-check)
- ((bv-u16-ref bv n) (&read-object &bytevector) &type-check)
- ((bv-s16-ref bv n) (&read-object &bytevector) &type-check)
- ((bv-u32-ref bv n) (&read-object &bytevector) &type-check)
- ((bv-s32-ref bv n) (&read-object &bytevector) &type-check)
- ((bv-u64-ref bv n) (&read-object &bytevector) &type-check)
- ((bv-s64-ref bv n) (&read-object &bytevector) &type-check)
- ((bv-f32-ref bv n) (&read-object &bytevector) &type-check)
- ((bv-f64-ref bv n) (&read-object &bytevector) &type-check)
-
- ((bv-u8-set! bv n x) (&write-object &bytevector) &type-check)
- ((bv-s8-set! bv n x) (&write-object &bytevector) &type-check)
- ((bv-u16-set! bv n x) (&write-object &bytevector) &type-check)
- ((bv-s16-set! bv n x) (&write-object &bytevector) &type-check)
- ((bv-u32-set! bv n x) (&write-object &bytevector) &type-check)
- ((bv-s32-set! bv n x) (&write-object &bytevector) &type-check)
- ((bv-u64-set! bv n x) (&write-object &bytevector) &type-check)
- ((bv-s64-set! bv n x) (&write-object &bytevector) &type-check)
- ((bv-f32-set! bv n x) (&write-object &bytevector) &type-check)
- ((bv-f64-set! bv n x) (&write-object &bytevector) &type-check))
-
;; Pointers.
(define-primitive-effects* param
((u8-ref obj bv n) (&read-object (annotation->memory-kind param)))
diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm
index 2729c034a..a378c5c39 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -748,27 +748,24 @@ are comparable with eqv?. A tmp slot may be used."
(intmap-ref representations arg)))
(($ $primcall (or 'scm->f64 'load-f64
'f32-ref 'f64-ref
- 'bv-f32-ref 'bv-f64-ref
'fadd 'fsub 'fmul 'fdiv))
(intmap-add representations var 'f64))
(($ $primcall (or 'scm->u64 'scm->u64/truncate 'load-u64
'char->integer 's64->u64
- 'bv-length 'string-length
+ 'string-length
'assume-u64
'uadd 'usub 'umul
'ulogand 'ulogior 'ulogxor 'ulogsub 'ursh 'ulsh
'uadd/immediate 'usub/immediate 'umul/immediate
'ursh/immediate 'ulsh/immediate
'u8-ref 'u16-ref 'u32-ref 'u64-ref
- 'bv-u8-ref 'bv-u16-ref 'bv-u32-ref 'bv-u64-ref
'word-ref 'word-ref/immediate))
(intmap-add representations var 'u64))
(($ $primcall (or 'untag-fixnum
'assume-s64
'scm->s64 'load-s64 'u64->s64
'srsh 'srsh/immediate
- 's8-ref 's16-ref 's32-ref 's64-ref
- 'bv-s8-ref 'bv-s16-ref 'bv-s32-ref 'bv-s64-ref))
+ 's8-ref 's16-ref 's32-ref 's64-ref))
(intmap-add representations var 's64))
(($ $primcall (or 'pointer-ref/immediate))
(intmap-add representations var 'ptr))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 5f15f3a0b..d3d738d6f 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -970,54 +970,6 @@ minimum, and maximum."
;;;
-;;; Bytevectors.
-;;;
-
-(define-simple-type-checker (bv-length &bytevector))
-(define-type-inferrer (bv-length bv result)
- (restrict! bv &bytevector 0 (target-max-size-t))
- (define! result &u64 (&min/0 bv) (&max/size bv)))
-
-(define-syntax-rule (define-bytevector-accessors ref set type size lo hi)
- (begin
- (define-type-checker (ref bv idx)
- (and (check-type bv &bytevector 0 (target-max-size-t))
- (check-type idx &u64 0 (target-max-size-t))
- (< (&max idx) (- (&min bv) size))))
- (define-type-inferrer (ref bv idx result)
- (restrict! bv &bytevector (+ (&min/0 idx) size) (target-max-size-t))
- (restrict! idx &u64 0 (- (&max/size bv) size))
- (define! result type lo hi))
- (define-type-checker (set bv idx val)
- (and (check-type bv &bytevector 0 (target-max-size-t))
- (check-type idx &u64 0 (target-max-size-t))
- (check-type val type lo hi)
- (< (&max idx) (- (&min bv) size))))
- (define-type-inferrer (set! bv idx val)
- (restrict! bv &bytevector (+ (&min/0 idx) size) (target-max-size-t))
- (restrict! idx &u64 0 (- (&max/size bv) size))
- (restrict! val type lo hi))))
-
-(define-bytevector-accessors bv-u8-ref bv-u8-set! &u64 1 0 #xff)
-(define-bytevector-accessors bv-s8-ref bv-s8-set! &s64 1 (- #x80) #x7f)
-
-(define-bytevector-accessors bv-u16-ref bv-u16-set! &u64 2 0 #xffff)
-(define-bytevector-accessors bv-s16-ref bv-s16-set! &s64 2 (- #x8000) #x7fff)
-
-(define-bytevector-accessors bv-u32-ref bv-u32-set! &u64 4 0 #xffffffff)
-(define-bytevector-accessors bv-s32-ref bv-s32-set! &s64 4
- (- #x80000000) #x7fffffff)
-
-(define-bytevector-accessors bv-u64-ref bv-u64-set! &u64 8 0 &u64-max)
-(define-bytevector-accessors bv-s64-ref bv-s64-set! &s64 8 &s64-min &s64-max)
-
-(define-bytevector-accessors bv-f32-ref bv-f32-set! &f64 4 -inf.0 +inf.0)
-(define-bytevector-accessors bv-f64-ref bv-f64-set! &f64 8 -inf.0 +inf.0)
-
-
-
-
-;;;
;;; Pointers
;;;
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 2e2cd6915..cf64ef076 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -279,27 +279,6 @@
emit-scm->s64
emit-load-s64
emit-s64->scm
- emit-bv-length
- emit-bv-u8-ref
- emit-bv-s8-ref
- emit-bv-u16-ref
- emit-bv-s16-ref
- emit-bv-u32-ref
- emit-bv-s32-ref
- emit-bv-u64-ref
- emit-bv-s64-ref
- emit-bv-f32-ref
- emit-bv-f64-ref
- emit-bv-u8-set!
- emit-bv-s8-set!
- emit-bv-u16-set!
- emit-bv-s16-set!
- emit-bv-u32-set!
- emit-bv-s32-set!
- emit-bv-u64-set!
- emit-bv-s64-set!
- emit-bv-f32-set!
- emit-bv-f64-set!
emit-make-atomic-box
emit-atomic-box-ref
emit-atomic-box-set!