summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2018-01-22 07:37:16 +0100
committerAndy Wingo <wingo@pobox.com>2018-01-22 07:51:08 +0100
commitdd203e5d7d3a2c59bbba00726c47f47331048e15 (patch)
tree1f1a8de2f1bf8c6a2b99070c7f803702af4460cd /module
parent91bf9b1db30754f94f448c71158f556c9f2327bc (diff)
downloadguile-dd203e5d7d3a2c59bbba00726c47f47331048e15.tar.gz
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.
Diffstat (limited to 'module')
-rw-r--r--module/language/cps/compile-bytecode.scm22
-rw-r--r--module/language/cps/cse.scm4
-rw-r--r--module/language/cps/effects-analysis.scm11
-rw-r--r--module/language/cps/reify-primitives.scm3
-rw-r--r--module/language/cps/specialize-primcalls.scm3
-rw-r--r--module/language/cps/types.scm53
-rw-r--r--module/language/tree-il/cps-primitives.scm1
-rw-r--r--module/system/vm/assembler.scm7
8 files changed, 0 insertions, 104 deletions
diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm
index 0034cc199..f14f48f43 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 95d9c07d1..d4a294c47 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 f2066f46e..aea0d5803 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 327700de4..7436422fc 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 81692de0d..96d7e118a 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 d3d738d6f..225b99c67 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 2d14f2edb..b9f2fe95b 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 cf64ef076..da125119d 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