[Guile-commits] 12/13: Remove optimizer and backend support for bv-u8-ref et al

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 8573d94404c1d7803524a903b5bf437c675fc9cf
Author: Andy Wingo <address@hidden>
Date:   Tue Jan 16 16:27:25 2018 +0100

    Remove optimizer and backend support for bv-u8-ref et al
    
    * module/language/cps/compile-bytecode.scm (compile-function):
    * module/language/cps/effects-analysis.scm:
    * module/language/cps/slot-allocation.scm (compute-var-representations):
    * module/language/cps/types.scm:
    * module/system/vm/assembler.scm: Remove optimizer and backend support
      for bv- ops.
---
 module/language/cps/compile-bytecode.scm | 63 --------------------------------
 module/language/cps/effects-analysis.scm | 26 -------------
 module/language/cps/slot-allocation.scm  |  7 +---
 module/language/cps/types.scm            | 48 ------------------------
 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 b68f90a..0034cc1 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 4fa00db..bfa95cb 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 2729c03..a378c5c 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 5f15f3a..d3d738d 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 2e2cd69..cf64ef0 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!