summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/language/cps/closure-conversion.scm19
-rw-r--r--module/language/cps/compile-bytecode.scm18
-rw-r--r--module/language/cps/cse.scm4
-rw-r--r--module/language/cps/dce.scm3
-rw-r--r--module/language/cps/effects-analysis.scm11
-rw-r--r--module/language/cps/reify-primitives.scm3
-rw-r--r--module/language/cps/slot-allocation.scm2
-rw-r--r--module/language/cps/specialize-primcalls.scm3
-rw-r--r--module/language/cps/types.scm50
-rw-r--r--module/system/vm/assembler.scm9
10 files changed, 18 insertions, 104 deletions
diff --git a/module/language/cps/closure-conversion.scm b/module/language/cps/closure-conversion.scm
index 2e5a910ed..550e1f9ab 100644
--- a/module/language/cps/closure-conversion.scm
+++ b/module/language/cps/closure-conversion.scm
@@ -35,6 +35,7 @@
filter-map
))
#:use-module (srfi srfi-11)
+ #:use-module (system base types internal)
#:use-module (language cps)
#:use-module (language cps utils)
#:use-module (language cps with-cps)
@@ -536,10 +537,20 @@ term."
(unless (> nfree 2)
(error "unexpected well-known nullary, unary, or binary closure"))
(with-cps cps
- ($ (with-cps-constants ((false #f))
- (build-term
- ($continue k src
- ($primcall 'make-vector/immediate nfree (false))))))))))
+ (letv v w0)
+ (letk k* ($kargs () () ($continue k src ($values (v)))))
+ (letk ktag1
+ ($kargs ('w0) (w0)
+ ($continue k* src
+ ($primcall 'word-set!/immediate '(vector . 0) (v w0)))))
+ (letk ktag0
+ ($kargs ('v) (v)
+ ($continue ktag1 src
+ ($primcall 'load-u64 (+ %tc7-vector (ash nfree 8)) ()))))
+ (build-term
+ ($continue ktag0 src
+ ($primcall 'allocate-words/immediate `(vector . ,(1+ nfree))
+ ())))))))
(define (init-closure cps k src var known? free)
"Initialize the free variables @var{closure-free} in a closure
diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm
index 79459cf0e..ec93eaa5c 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -175,18 +175,6 @@
idx))
(($ $primcall 'free-ref idx (closure))
(emit-free-ref asm (from-sp dst) (from-sp (slot closure)) idx))
- (($ $primcall 'vector-ref #f (vector index))
- (emit-vector-ref asm (from-sp dst) (from-sp (slot vector))
- (from-sp (slot index))))
- (($ $primcall 'make-vector #f (length init))
- (emit-make-vector asm (from-sp dst) (from-sp (slot length))
- (from-sp (slot init))))
- (($ $primcall 'make-vector/immediate length (init))
- (emit-make-vector/immediate asm
- (from-sp dst) length (from-sp (slot init))))
- (($ $primcall 'vector-ref/immediate index (vector))
- (emit-vector-ref/immediate asm
- (from-sp dst) (from-sp (slot vector)) index))
(($ $primcall 'allocate-struct #f (vtable nfields))
(emit-allocate-struct asm (from-sp dst) (from-sp (slot vtable))
(from-sp (slot nfields))))
@@ -336,12 +324,6 @@
(($ $primcall 'struct-set!/immediate idx (struct value))
(emit-struct-set!/immediate asm (from-sp (slot struct)) idx
(from-sp (slot value))))
- (($ $primcall 'vector-set! #f (vector index value))
- (emit-vector-set! asm (from-sp (slot vector)) (from-sp (slot index))
- (from-sp (slot value))))
- (($ $primcall 'vector-set!/immediate index (vector value))
- (emit-vector-set!/immediate asm (from-sp (slot vector))
- index (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 2b1a229ca..f3c333c1a 100644
--- a/module/language/cps/cse.scm
+++ b/module/language/cps/cse.scm
@@ -263,10 +263,6 @@ false. It could be that both true and false proofs are available."
((set-car! #f o x) (x <- car #f o))
((set-cdr! #f o y) (y <- cdr #f o))
- ;; FIXME: how to propagate make-vector/immediate -> vector-length?
- ((v <- make-vector #f n x) (n <- vector-length #f v))
- ((vector-set! #f v i x) (x <- vector-ref #f v i))
- ((vector-set!/immediate i v x) (x <- vector-ref/immediate i v))
((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))
diff --git a/module/language/cps/dce.scm b/module/language/cps/dce.scm
index 0de6101d7..0a3a311df 100644
--- a/module/language/cps/dce.scm
+++ b/module/language/cps/dce.scm
@@ -188,8 +188,7 @@ sites."
(and (causes-effect? fx &write)
(match exp
(($ $primcall
- (or 'vector-set! 'vector-set!/immediate
- 'set-car! 'set-cdr!
+ (or 'set-car! 'set-cdr!
'box-set!
'scm-set! 'scm-set!/tag 'scm-set!/immediate
'word-set! 'word-set!/immediate) _
diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm
index 473b280ba..87c2540a2 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -402,17 +402,6 @@ the LABELS that are clobbered by the effects of LABEL."
((box-ref v) (&read-object &box) &type-check)
((box-set! v x) (&write-object &box) &type-check))
-;; Vectors.
-(define-primitive-effects* param
- ((vector . _) (&allocate &vector))
- ((make-vector n init) (&allocate &vector))
- ((make-vector/immediate init) (&allocate &vector))
- ((vector-ref v n) (&read-object &vector) &type-check)
- ((vector-ref/immediate v) (&read-field &vector param) &type-check)
- ((vector-set! v n x) (&write-object &vector) &type-check)
- ((vector-set!/immediate v x) (&write-field &vector param) &type-check)
- ((vector-length v) &type-check))
-
;; Structs.
(define-primitive-effects* param
((allocate-struct vt n) (&allocate &struct) &type-check)
diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm
index 2dc813694..4580f837e 100644
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/reify-primitives.scm
@@ -310,9 +310,6 @@
((sub/immediate (u8? y) x) (sub x y))
(_
(reify-u64-constants
- ((make-vector/immediate (u8? size) init) (make-vector size init))
- ((vector-ref/immediate (u8? idx) v) (vector-ref v idx))
- ((vector-set!/immediate (u8? idx) v val) (vector-set! v idx val))
((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))
diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm
index 48d98771e..3f73a209e 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -752,7 +752,7 @@ are comparable with eqv?. A tmp slot may be used."
(intmap-add representations var 'f64))
(($ $primcall (or 'scm->u64 'scm->u64/truncate 'load-u64
'char->integer 's64->u64
- 'bv-length 'vector-length 'string-length
+ 'bv-length 'string-length
'uadd 'usub 'umul
'ulogand 'ulogior 'ulogxor 'ulogsub 'ursh 'ulsh
'uadd/immediate 'usub/immediate 'umul/immediate
diff --git a/module/language/cps/specialize-primcalls.scm b/module/language/cps/specialize-primcalls.scm
index b791a2012..5d578053a 100644
--- a/module/language/cps/specialize-primcalls.scm
+++ b/module/language/cps/specialize-primcalls.scm
@@ -121,9 +121,6 @@
...
(_ #f)))
(specialize-case
- (('make-vector (? uint? n) init) (make-vector/immediate n (init)))
- (('vector-ref v (? uint? n)) (vector-ref/immediate n (v)))
- (('vector-set! v (? uint? n) x) (vector-set!/immediate n (v x)))
(('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)))
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 0c9ce845c..230c1ebc0 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -834,56 +834,6 @@ minimum, and maximum."
;;;
-;;; Vectors.
-;;;
-
-(define-syntax-rule (&max/vector x)
- (min (&max x) (target-max-vector-length)))
-
-(define-simple-type-checker (make-vector (&u64 0 (target-max-vector-length))
- &all-types))
-(define-type-inferrer (make-vector size init result)
- (restrict! size &u64 0 (target-max-vector-length))
- (define! result &vector (&min/0 size) (&max/vector size)))
-
-(define-type-checker (vector-ref v idx)
- (and (check-type v &vector 0 (target-max-vector-length))
- (check-type idx &u64 0 (1- (&min v)))))
-(define-type-inferrer (vector-ref v idx result)
- (restrict! v &vector (1+ (&min/0 idx)) (target-max-vector-length))
- (restrict! idx &u64 0 (1- (&max/vector v)))
- (define! result &all-types -inf.0 +inf.0))
-
-(define-type-checker (vector-set! v idx val)
- (and (check-type v &vector 0 (target-max-vector-length))
- (check-type idx &u64 0 (1- (&min v)))))
-(define-type-inferrer (vector-set! v idx val)
- (restrict! v &vector (1+ (&min/0 idx)) (target-max-vector-length))
- (restrict! idx &u64 0 (1- (&max/vector v))))
-
-(define-type-inferrer/param (make-vector/immediate size init result)
- (define! result &vector size size))
-
-(define-type-checker/param (vector-ref/immediate idx v)
- (and (check-type v &vector 0 (target-max-vector-length)) (< idx (&min v))))
-(define-type-inferrer/param (vector-ref/immediate idx v result)
- (restrict! v &vector (1+ idx) (target-max-vector-length))
- (define! result &all-types -inf.0 +inf.0))
-
-(define-type-checker/param (vector-set!/immediate idx v val)
- (and (check-type v &vector 0 (target-max-vector-length)) (< idx (&min v))))
-(define-type-inferrer/param (vector-set!/immediate idx v val)
- (restrict! v &vector (1+ idx) (target-max-vector-length)))
-
-(define-simple-type-checker (vector-length &vector))
-(define-type-inferrer (vector-length v result)
- (restrict! v &vector 0 (target-max-vector-length))
- (define! result &u64 (&min/0 v) (&max/vector v)))
-
-
-
-
-;;;
;;; Structs.
;;;
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 7af7050db..489bfd56f 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1,6 +1,6 @@
;;; Guile bytecode assembler
-;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014, 2015, 2017 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014, 2015, 2017, 2018 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -243,13 +243,6 @@
emit-ulsh/immediate
emit-char->integer
emit-integer->char
- emit-make-vector
- emit-make-vector/immediate
- emit-vector-length
- emit-vector-ref
- emit-vector-ref/immediate
- emit-vector-set!
- emit-vector-set!/immediate
emit-struct-vtable
emit-allocate-struct/immediate
emit-struct-ref/immediate