From 55299ac101b7cedd9dfe951d4603134b95ac893e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Sat, 10 Sep 2005 04:26:12 +0000
Subject: [PATCH] fix set-length performance regression

---
 CHANGES.html                        | 21 +++++++++++++++++++--
 library/bootstrap/primitives.factor |  4 ++--
 library/collections/growable.factor | 16 ++++++++++------
 library/compiler/compiler.factor    |  2 +-
 library/compiler/xt.factor          |  5 +----
 5 files changed, 33 insertions(+), 15 deletions(-)
diff --git a/CHANGES.html b/CHANGES.html
index 96ab66f83b..7cbed35067 100644
--- a/CHANGES.html
+++ b/CHANGES.html
@@ -4,16 +4,33 @@
 <head><title>Factor change log</title></head>
 <body>
 
-<h1>Factor 0.78:</h1>
+<h1>Factor 0.79:</h1>
 
 <ul>
 
+<li>Compiler:
+
+<ul>
+<li>New basic block optimizer performs more aggressive dead load and store elimination.</li>
+<li>Stack shuffles are compiled more efficiently.</li>
+<li>Pushing literals on either side of a stack shuffle is now compiled more efficiently.</li>
+<li>Tail-recursive inlined words are compiled in a new way, saving a few instructions.</li>
+</ul>
+
+</li>
+
 <li>Sequences:
 
 <ul>
-<li>Faster <code>map</code>, <code>2each</code> and <code>2map</code></li>
+<li>Faster <code>map</code>, <code>2each</code> and <code>2map</code>.</li>
 </li>
 
+<li>Everything else:
+
+<ul>
+<li>The distinct <code>t</code> type is gone. Now, the <code>t</code> object is just a symbol.</li>
+</ul>
+
 </ul>
 
 <h1>Factor 0.78:</h1>
diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index 6b93eab47c..2f3a93eb32 100644
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -324,7 +324,7 @@ null null define-class
 "vector?" "vectors" create t "inline" set-word-prop
 "vector" "vectors" create 11 "vector?" "vectors" create
 {
-    { 1 { "length" "sequences" } { "set-capacity" "kernel-internals" } }
+    { 1 { "length" "sequences" } { "set-fill" "kernel-internals" } }
     { 2 { "underlying" "kernel-internals" } { "set-underlying" "kernel-internals" } }
 } define-builtin
 
@@ -338,7 +338,7 @@ null null define-class
 "sbuf?" "strings" create t "inline" set-word-prop 
 "sbuf" "strings" create 13 "sbuf?" "strings" create
 {
-    { 1 { "length" "sequences" } { "set-capacity" "kernel-internals" } }
+    { 1 { "length" "sequences" } { "set-fill" "kernel-internals" } }
     { 2 { "underlying" "kernel-internals" } { "set-underlying" "kernel-internals" } }
 } define-builtin
 
diff --git a/library/collections/growable.factor b/library/collections/growable.factor
index b5a13ebe91..960c9b238c 100644
--- a/library/collections/growable.factor
+++ b/library/collections/growable.factor
@@ -7,7 +7,12 @@ USING: errors kernel math math-internals sequences ;
 
 GENERIC: underlying
 GENERIC: set-underlying
-GENERIC: set-capacity
+
+! fill pointer mutation. user code should use set-length
+! instead, since it will also resize the underlying sequence.
+GENERIC: set-fill
+
+: capacity ( seq -- n ) underlying length ; inline
 
 : expand ( len seq -- )
     [ underlying resize ] keep set-underlying ;
@@ -18,20 +23,19 @@ GENERIC: set-capacity
     #! optimistic doubling of its size.
     2dup length fixnum>= [
         >r 1 fixnum+ r>
-        2dup underlying length fixnum> [
+        2dup capacity fixnum> [
             over 2 fixnum* over expand
         ] when
-        set-capacity
+        set-fill
     ] [
         2drop
     ] ifte ;
 
 : grow-length ( len seq -- )
-    growable-check 2dup length > [ 2dup expand ] when
-    set-capacity ;
+    growable-check 2dup capacity > [ 2dup expand ] when set-fill ;
 
 ! We need this pretty early on.
 IN: vectors
 
 : empty-vector ( len -- vec )
-    dup <vector> [ set-capacity ] keep ; inline
+    dup <vector> [ set-fill ] keep ; inline
diff --git a/library/compiler/compiler.factor b/library/compiler/compiler.factor
index d552e38e31..6b48b94a9e 100644
--- a/library/compiler/compiler.factor
+++ b/library/compiler/compiler.factor
@@ -27,7 +27,7 @@ words ;
     "compile" get [ word compile ] when ; parsing
 
 : try-compile ( word -- )
-    [ compile ] [ error. ] catch ;
+    [ compile ] [ [ error. drop ] when* ] catch ;
 
 : compile-all ( -- ) [ try-compile ] each-word ;
 
diff --git a/library/compiler/xt.factor b/library/compiler/xt.factor
index db7f16cb7f..ee8052de17 100644
--- a/library/compiler/xt.factor
+++ b/library/compiler/xt.factor
@@ -18,13 +18,10 @@ SYMBOL: compiled-xts
 : save-xt ( word -- )
     compiled-offset swap compiled-xts [ acons ] change ;
 
-: commit-xt ( xt word -- )
-    dup t "compiled" set-word-prop  set-word-xt ;
-
 : commit-xts ( -- )
     #! We must flush the instruction cache on PowerPC.
     flush-icache
-    compiled-xts get [ unswons commit-xt ] each
+    compiled-xts get [ unswons set-word-xt ] each
     compiled-xts off ;
 
 : compiled-xt ( word -- xt )
