~ chicken-core (chicken-5) cc3c804a25419f46d20681e17c9f3e8b3763ac0d
commit cc3c804a25419f46d20681e17c9f3e8b3763ac0d
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Dec 14 16:49:22 2009 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Dec 14 16:49:22 2009 +0100
removed rest-arg-as-vector optimization, since it can conflict with inlining
diff --git a/c-backend.scm b/c-backend.scm
index d8f3bd0e..50beea88 100644
--- a/c-backend.scm
+++ b/c-backend.scm
@@ -615,9 +615,7 @@
(gen ");}") ]
[(or rest (> (lambda-literal-allocated ll) 0) (lambda-literal-external ll))
(if (and rest (not (eq? rest-mode 'none)))
- (if (eq? rest-mode 'vector)
- (set! nsrv (lset-adjoin = nsrv argc))
- (set! nsr (lset-adjoin = nsr argc)) )
+ (set! nsr (lset-adjoin = nsr argc))
(set! ns (lset-adjoin = ns argc)) ) ] ) ) ) )
lambdas)
(for-each
@@ -842,7 +840,6 @@
;; [(= nec 1) (gen #t "C_save(" (if empty-closure "t1" "t0") ");")] )
(cond [rest
(gen #t (if (> nec 0) "C_save_and_reclaim" "C_reclaim") "((void*)tr" n #\r)
- (when (eq? rest-mode 'vector) (gen #\v))
(gen ",(void*)" id "r")
(when (> nec 0)
(gen #\, nec #\,)
@@ -850,9 +847,7 @@
(gen ");}"
#t "else{"
#t "a=C_alloc((c-" n ")*3);")
- (case rest-mode
- [(list #f) (gen #t "t" n "=C_restore_rest(a,C_rest_count(0));")]
- [(vector) (gen #t "t" n "=C_restore_rest_vector(a,C_rest_count(0));")] )
+ (gen #t "t" n "=C_restore_rest(a,C_rest_count(0));")
(gen #t id "r(")
(apply gen (intersperse (make-argument-list n "t") #\,))
(gen ",t" n ");}}")
diff --git a/c-platform.scm b/c-platform.scm
index 215acb88..343a7749 100644
--- a/c-platform.scm
+++ b/c-platform.scm
@@ -70,8 +70,6 @@
(define unlikely-variables '(unquote unquote-splicing))
(define eq-inline-operator "C_eqp")
-(define optimizable-rest-argument-operators
- '(car cadr caddr cadddr length pair? null? list-ref))
(define membership-test-operators
'(("C_i_memq" . "C_eqp") ("C_u_i_memq" . "C_eqp") ("C_i_member" . "C_i_equalp")
("C_i_memv" . "C_i_eqvp") ) )
diff --git a/compiler-namespace.scm b/compiler-namespace.scm
index 5945ea16..b2bc6a3c 100644
--- a/compiler-namespace.scm
+++ b/compiler-namespace.scm
@@ -210,7 +210,6 @@
node->sexpr
non-foldable-bindings
nonwinding-call/cc
- optimizable-rest-argument-operators
optimization-iterations
original-program-size
output
diff --git a/compiler.scm b/compiler.scm
index 6ca7265c..4635167c 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -233,8 +233,7 @@
; standard-binding -> <boolean> If true: variable names a standard binding
; extended-binding -> <boolean> If true: variable names an extended binding
; unused -> <boolean> If true: variable is a formal parameter that is never used
-; rest-parameter -> #f | 'vector | 'list If true: variable holds rest-argument list mode
-; o-r/access-count -> <n> Contains number of references as arguments of optimizable rest operators
+; rest-parameter -> #f | 'list If true: variable holds rest-argument list
; constant -> <boolean> If true: variable has fixed value
; hidden-refs -> <boolean> If true: procedure that refers to hidden global variables
; inline-transient -> <boolean> If true: was introduced during inlining
@@ -351,7 +350,6 @@
(define current-program-size 0)
(define line-number-database-2 #f)
(define immutable-constants '())
-(define rest-parameters-promoted-to-vector '())
(define inline-table #f)
(define inline-table-used #f)
(define constant-table #f)
@@ -1724,18 +1722,9 @@
((##core#call)
(grow 1)
(let ([fun (car subs)])
- (if (eq? '##core#variable (node-class fun))
- (let ([name (first (node-parameters fun))])
- (collect! db name 'call-sites (cons here n))
- ;; If call to standard-binding & optimizable rest-arg operator: decrease access count:
- (if (and (intrinsic? name)
- (memq name optimizable-rest-argument-operators) )
- (for-each
- (lambda (arg)
- (and-let* ([(eq? '##core#variable (node-class arg))]
- [var (first (node-parameters arg))] )
- (when (get db var 'rest-parameter) (count! db var 'o-r/access-count)) ) )
- (cdr subs) ) ) ) )
+ (when (eq? '##core#variable (node-class fun))
+ (let ([name (first (node-parameters fun))])
+ (collect! db name 'call-sites (cons here n))))
(walk (first subs) env localenv here #t)
(walkeach (cdr subs) env localenv here #f) ) )
@@ -1780,10 +1769,7 @@
(put! db var 'unknown #t) )
vars)
(when rest
- (put! db rest 'rest-parameter
- (if (memq rest rest-parameters-promoted-to-vector)
- 'vector
- 'list) ) )
+ (put! db rest 'rest-parameter 'list) )
(when (simple-lambda-node? n) (put! db id 'simple #t))
(let ([tl toplevel-scope])
(unless toplevel-lambda-id (set! toplevel-lambda-id id))
@@ -1886,7 +1872,6 @@
[assigned-locally #f]
[undefined #f]
[global #f]
- [o-r/access-count 0]
[rest-parameter #f]
[nreferences 0]
[ncall-sites 0] )
@@ -1909,7 +1894,6 @@
[(global) (set! global #t)]
[(value) (set! value (cdr prop))]
[(local-value) (set! local-value (cdr prop))]
- [(o-r/access-count) (set! o-r/access-count (cdr prop))]
[(rest-parameter) (set! rest-parameter #t)] ) )
plist)
@@ -2072,25 +2056,10 @@
(eq? (first llist) (first (node-parameters v2))) )
(let ([kvar (first (node-parameters v1))])
(quick-put! plist 'replacable kvar)
- (put! db kvar 'replacing #t) ) ) ) ) ) ) ) ) ) )
-
- ;; If a rest-argument, convert 'rest-parameter property to 'vector, if the variable is never
- ;; assigned, and the number of references is identical to the number of accesses in optimizable
- ;; rest-argument operators:
- ;; - Add variable to "rest-parameters-promoted-to-vector", because subsequent optimization will
- ;; change variables context (operators applied to it).
- (when (and rest-parameter
- (not assigned)
- (= nreferences o-r/access-count) )
- (set! rest-parameters-promoted-to-vector (lset-adjoin eq? rest-parameters-promoted-to-vector sym))
- (put! db sym 'rest-parameter 'vector) ) ) )
+ (put! db kvar 'replacing #t) ) ) ) ) ) ) ) ) ) ) ) )
db)
- ;; Remove explicitly consed rest parameters from promoted ones:
- (set! rest-parameters-promoted-to-vector
- (lset-difference eq? rest-parameters-promoted-to-vector explicitly-consed) )
-
;; Set original program-size, if this is the first analysis-pass:
(unless original-program-size
(set! original-program-size current-program-size) )
@@ -2371,7 +2340,7 @@
(closure-size lambda-literal-closure-size) ; integer
(looping lambda-literal-looping) ; boolean
(customizable lambda-literal-customizable) ; boolean
- (rest-argument-mode lambda-literal-rest-argument-mode) ; #f | LIST | VECTOR | UNUSED
+ (rest-argument-mode lambda-literal-rest-argument-mode) ; #f | LIST | NONE
(body lambda-literal-body) ; expression
(direct lambda-literal-direct)) ; boolean
@@ -2488,9 +2457,8 @@
vars)
id
'()) ] )
- (case rest-mode
- [(none) (debugging 'o "unused rest argument" rest id)]
- [(vector) (debugging 'o "rest argument accessed as vector" rest id)] )
+ (when (eq? rest-mode 'none)
+ (debugging 'o "unused rest argument" rest id))
(when (and direct rest)
(bomb "bad direct lambda" id allocated rest) )
(set! lambdas
diff --git a/optimizer.scm b/optimizer.scm
index 9becaf38..edcc685f 100644
--- a/optimizer.scm
+++ b/optimizer.scm
@@ -1,7 +1,7 @@
;;;; optimizer.scm - The CHICKEN Scheme compiler (optimizations)
;
-; Copyright (c) 2000-2007, Felix L. Winkelmann
; Copyright (c) 2008-2009, The Chicken Team
+; Copyright (c) 2000-2007, Felix L. Winkelmann
; All rights reserved.
;
; Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following
diff --git a/support.scm b/support.scm
index 51493735..767a4168 100644
--- a/support.scm
+++ b/support.scm
@@ -427,7 +427,7 @@
((potential-value)
(set! pval (cdar es)) )
((replacable home contains contained-in use-expr closure-size rest-parameter
- o-r/access-count captured-variables explicit-rest)
+ captured-variables explicit-rest)
(printf "\t~a=~s" (caar es) (cdar es)) )
((references)
(set! refs (cdar es)) )
diff --git a/tests/runtests.sh b/tests/runtests.sh
index f2267793..2b706893 100644
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -211,7 +211,7 @@ $compile -e embedded2.scm
./a.out
echo "======================================== timing compilation ..."
-time $compile compiler.scm -S -O5 -debug pb -v
+time $compile compiler.scm -O5 -debug pb -v
time ./a.out
echo "======================================== running floating-point benchmark ..."
Trap