[Guile-commits] 04/07: Remove optimizer and backend support for struct ops

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit dd203e5d7d3a2c59bbba00726c47f47331048e15
Author: Andy Wingo <address@hidden>
Date:   Mon Jan 22 07:37:16 2018 +0100

    Remove optimizer and backend support for struct ops
    
    * module/language/cps/compile-bytecode.scm:
    * module/language/cps/cse.scm:
    * module/language/cps/effects-analysis.scm:
    * module/language/cps/reify-primitives.scm:
    * module/language/cps/specialize-primcalls.scm:
    * module/language/cps/types.scm:
    * module/language/tree-il/cps-primitives.scm:
    * module/system/vm/assembler.scm: Remove support for struct-ref,
      struct-set!, allocate-struct, struct-vtable CPS primcalls and bytecode
      instructions.
---
 module/language/cps/compile-bytecode.scm     | 22 ------------
 module/language/cps/cse.scm                  |  4 ---
 module/language/cps/effects-analysis.scm     | 11 ------
 module/language/cps/reify-primitives.scm     |  3 --
 module/language/cps/specialize-primcalls.scm |  3 --
 module/language/cps/types.scm                | 53 ----------------------------
 module/language/tree-il/cps-primitives.scm   |  1 -
 module/system/vm/assembler.scm               |  7 ----
 8 files changed, 104 deletions(-)

diff --git a/module/language/cps/compile-bytecode.scm 
b/module/language/cps/compile-bytecode.scm
index 0034cc1..f14f48f 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -172,24 +172,8 @@
          (emit-word-ref/immediate asm (from-sp dst) (from-sp (slot obj)) idx))
         (($ $primcall 'pointer-ref/immediate (annotation . idx) (obj))
          (emit-pointer-ref/immediate asm (from-sp dst) (from-sp (slot obj)) 
idx))
-        (($ $primcall 'struct-ref/immediate idx (struct))
-         (emit-struct-ref/immediate asm (from-sp dst) (from-sp (slot struct))
-                                    idx))
         (($ $primcall 'free-ref idx (closure))
          (emit-free-ref asm (from-sp dst) (from-sp (slot closure)) idx))
-        (($ $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 nfields (vtable))
-         (emit-allocate-struct/immediate asm (from-sp dst)
-                                         (from-sp (slot vtable))
-                                         nfields))
-        (($ $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 idx (struct))
-         (emit-struct-ref/immediate asm (from-sp dst) (from-sp (slot struct))
-                                    idx))
         (($ $primcall 'char->integer #f (src))
          (emit-char->integer asm (from-sp dst) (from-sp (slot src))))
         (($ $primcall 'integer->char #f (src))
@@ -321,12 +305,6 @@
         (($ $primcall 'free-set! idx (closure value))
          (emit-free-set! asm (from-sp (slot closure)) (from-sp (slot value))
                          idx))
-        (($ $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 idx (struct value))
-         (emit-struct-set!/immediate asm (from-sp (slot struct)) idx
-                                     (from-sp (slot value))))
         (($ $primcall 'string-set! #f (string index char))
          (emit-string-set! asm (from-sp (slot string)) (from-sp (slot index))
                            (from-sp (slot char))))
diff --git a/module/language/cps/cse.scm b/module/language/cps/cse.scm
index 95d9c07..d4a294c 100644
--- a/module/language/cps/cse.scm
+++ b/module/language/cps/cse.scm
@@ -258,10 +258,6 @@ false.  It could be that both true and false proofs are 
available."
            ((word-set!/immediate p s x)      (x <- word-ref/immediate p s))
            ((pointer-set!/immediate p s x)   (x <- pointer-ref/immediate p s))
 
-           ((s <- allocate-struct #f v n)    (v <- struct-vtable #f s))
-           ((s <- allocate-struct/immediate n v) (v <- struct-vtable #f s))
-           ((struct-set! #f s i x)           (x <- struct-ref #f s i))
-           ((struct-set!/immediate i s x)    (x <- struct-ref/immediate i s))
            ((u <- scm->f64 #f s)             (s <- f64->scm #f u))
            ((s <- f64->scm #f u)             (u <- scm->f64 #f s))
            ((u <- scm->u64 #f s)             (s <- u64->scm #f u))
diff --git a/module/language/cps/effects-analysis.scm 
b/module/language/cps/effects-analysis.scm
index f2066f4..aea0d58 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -396,17 +396,6 @@ the LABELS that are clobbered by the effects of LABEL."
                                       (&write-field
                                        (annotation->memory-kind ann) idx)))))
 
-;; Structs.
-(define-primitive-effects* param
-  ((allocate-struct vt n)          (&allocate &struct)         &type-check)
-  ((allocate-struct/immediate vt)  (&allocate &struct)         &type-check)
-  ((make-struct/no-tail vt . _)    (&allocate &struct)         &type-check)
-  ((struct-ref s n)                (&read-object &struct)      &type-check)
-  ((struct-ref/immediate s)        (&read-field &struct param) &type-check)
-  ((struct-set! s n x)             (&write-object &struct)     &type-check)
-  ((struct-set!/immediate s x)     (&write-field &struct param) &type-check)
-  ((struct-vtable s)                                           &type-check))
-
 ;; Strings.
 (define-primitive-effects
   ((string-ref s n)                (&read-object &string)      &type-check)
diff --git a/module/language/cps/reify-primitives.scm 
b/module/language/cps/reify-primitives.scm
index 327700d..7436422 100644
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/reify-primitives.scm
@@ -316,9 +316,6 @@
             ((sub/immediate (u8? y) x) (sub x y))
             (_
              (reify-u64-constants
-              ((allocate-struct/immediate (u8? size) vt) (allocate-struct vt 
size))
-              ((struct-ref/immediate (u8? idx) s) (struct-ref s idx))
-              ((struct-set!/immediate (u8? idx) s val) (struct-set! s idx val))
               ((uadd/immediate (u8? y) x) (uadd x y))
               ((usub/immediate (u8? y) x) (usub x y))
               ((umul/immediate (u8? y) x) (umul x y))
diff --git a/module/language/cps/specialize-primcalls.scm 
b/module/language/cps/specialize-primcalls.scm
index 81692de..96d7e11 100644
--- a/module/language/cps/specialize-primcalls.scm
+++ b/module/language/cps/specialize-primcalls.scm
@@ -121,9 +121,6 @@
           ...
           (_ #f)))
       (specialize-case
-        (('allocate-struct v (? uint? n)) (allocate-struct/immediate n (v)))
-        (('struct-ref s (? uint? n)) (struct-ref/immediate n (s)))
-        (('struct-set! s (? uint? n) x) (struct-set!/immediate n (s x)))
         (('allocate-words (? uint? n)) (allocate-words/immediate n ()))
         (('scm-ref o (? uint? i)) (scm-ref/immediate i (o)))
         (('scm-set! o (? uint? i) x) (scm-set!/immediate i (o x)))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index d3d738d..225b99c 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -826,59 +826,6 @@ minimum, and maximum."
 
 
 ;;;
-;;; Structs.
-;;;
-
-;; No type-checker for allocate-struct, as we can't currently check that
-;; vt is actually a vtable.
-(define-type-inferrer (allocate-struct vt size result)
-  (restrict! vt &struct vtable-offset-user (target-max-size-t/scm))
-  (restrict! size &u64 0 (target-max-size-t/scm))
-  (define! result &struct (&min/0 size) (&max/scm-size size)))
-
-(define-type-checker (struct-ref s idx)
-  (and (check-type s &struct 0 (target-max-size-t/scm))
-       (check-type idx &u64 0 (target-max-size-t/scm))
-       ;; FIXME: is the field boxed?
-       (< (&max idx) (&min s))))
-(define-type-inferrer (struct-ref s idx result)
-  (restrict! s &struct (1+ (&min/0 idx)) (target-max-size-t/scm))
-  (restrict! idx &u64 0 (1- (&max/scm-size s)))
-  (define! result &all-types -inf.0 +inf.0))
-
-(define-type-checker (struct-set! s idx val)
-  (and (check-type s &struct 0 (target-max-size-t/scm))
-       (check-type idx &u64 0 (target-max-size-t/scm))
-       ;; FIXME: is the field boxed?
-       (< (&max idx) (&min s))))
-(define-type-inferrer (struct-set! s idx val)
-  (restrict! s &struct (1+ (&min/0 idx)) (target-max-size-t/scm))
-  (restrict! idx &u64 0 (1- (&max/scm-size s))))
-
-(define-type-inferrer/param (allocate-struct/immediate size vt result)
-  (restrict! vt &struct vtable-offset-user (target-max-size-t/scm))
-  (define! result &struct size size))
-
-(define-type-checker/param (struct-ref/immediate idx s)
-  ;; FIXME: is the field boxed?
-  (and (check-type s &struct 0 (target-max-size-t/scm)) (< idx (&min s))))
-(define-type-inferrer/param (struct-ref/immediate idx s result)
-  (restrict! s &struct (1+ idx) (target-max-size-t/scm))
-  (define! result &all-types -inf.0 +inf.0))
-
-(define-type-checker/param (struct-set!/immediate idx s val)
-  ;; FIXME: is the field boxed?
-  (and (check-type s &struct 0 (target-max-size-t/scm)) (< idx (&min s))))
-(define-type-inferrer/param (struct-set!/immediate idx s val)
-  (restrict! s &struct (1+ idx) (target-max-size-t/scm)))
-
-(define-simple-type (struct-vtable (&struct 0 (target-max-size-t/scm)))
-  (&struct vtable-offset-user (target-max-size-t/scm)))
-
-
-
-
-;;;
 ;;; Strings.
 ;;;
 
diff --git a/module/language/tree-il/cps-primitives.scm 
b/module/language/tree-il/cps-primitives.scm
index 2d14f2e..b9f2fe9 100644
--- a/module/language/tree-il/cps-primitives.scm
+++ b/module/language/tree-il/cps-primitives.scm
@@ -104,7 +104,6 @@
 (define-cps-primitive struct-vtable 1 1)
 (define-cps-primitive allocate-struct 2 1)
 (define-cps-primitive struct-ref 2 1)
-
 ;; Unhappily, and undocumentedly, struct-set! returns the value that was
 ;; set.  There is code that relies on this.  The struct-set! lowering
 ;; routines ensure this return arity.
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index cf64ef0..da12511 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -260,13 +260,6 @@
             emit-ulsh/immediate
             emit-char->integer
             emit-integer->char
-            emit-struct-vtable
-            emit-allocate-struct/immediate
-            emit-struct-ref/immediate
-            emit-struct-set!/immediate
-            emit-allocate-struct
-            emit-struct-ref
-            emit-struct-set!
             emit-class-of
             emit-make-array
             emit-scm->f64