diff options
-rw-r--r-- | module/language/cps/compile-bytecode.scm | 63 | ||||
-rw-r--r-- | module/language/cps/effects-analysis.scm | 26 | ||||
-rw-r--r-- | module/language/cps/slot-allocation.scm | 7 | ||||
-rw-r--r-- | module/language/cps/types.scm | 48 | ||||
-rw-r--r-- | module/system/vm/assembler.scm | 21 |
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! |