fix set-length performance regression

cvs
Slava Pestov 2005-09-10 04:26:12 +00:00
parent 9531e60cd3
commit 55299ac101
5 changed files with 33 additions and 15 deletions

View File

@ -4,16 +4,33 @@
<head><title>Factor change log</title></head> <head><title>Factor change log</title></head>
<body> <body>
<h1>Factor 0.78:</h1> <h1>Factor 0.79:</h1>
<ul> <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: <li>Sequences:
<ul> <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>
<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> </ul>
<h1>Factor 0.78:</h1> <h1>Factor 0.78:</h1>

View File

@ -324,7 +324,7 @@ null null define-class
"vector?" "vectors" create t "inline" set-word-prop "vector?" "vectors" create t "inline" set-word-prop
"vector" "vectors" create 11 "vector?" "vectors" create "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" } } { 2 { "underlying" "kernel-internals" } { "set-underlying" "kernel-internals" } }
} define-builtin } define-builtin
@ -338,7 +338,7 @@ null null define-class
"sbuf?" "strings" create t "inline" set-word-prop "sbuf?" "strings" create t "inline" set-word-prop
"sbuf" "strings" create 13 "sbuf?" "strings" create "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" } } { 2 { "underlying" "kernel-internals" } { "set-underlying" "kernel-internals" } }
} define-builtin } define-builtin

View File

@ -7,7 +7,12 @@ USING: errors kernel math math-internals sequences ;
GENERIC: underlying GENERIC: underlying
GENERIC: set-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 -- ) : expand ( len seq -- )
[ underlying resize ] keep set-underlying ; [ underlying resize ] keep set-underlying ;
@ -18,20 +23,19 @@ GENERIC: set-capacity
#! optimistic doubling of its size. #! optimistic doubling of its size.
2dup length fixnum>= [ 2dup length fixnum>= [
>r 1 fixnum+ r> >r 1 fixnum+ r>
2dup underlying length fixnum> [ 2dup capacity fixnum> [
over 2 fixnum* over expand over 2 fixnum* over expand
] when ] when
set-capacity set-fill
] [ ] [
2drop 2drop
] ifte ; ] ifte ;
: grow-length ( len seq -- ) : grow-length ( len seq -- )
growable-check 2dup length > [ 2dup expand ] when growable-check 2dup capacity > [ 2dup expand ] when set-fill ;
set-capacity ;
! We need this pretty early on. ! We need this pretty early on.
IN: vectors IN: vectors
: empty-vector ( len -- vec ) : empty-vector ( len -- vec )
dup <vector> [ set-capacity ] keep ; inline dup <vector> [ set-fill ] keep ; inline

View File

@ -27,7 +27,7 @@ words ;
"compile" get [ word compile ] when ; parsing "compile" get [ word compile ] when ; parsing
: try-compile ( word -- ) : try-compile ( word -- )
[ compile ] [ error. ] catch ; [ compile ] [ [ error. drop ] when* ] catch ;
: compile-all ( -- ) [ try-compile ] each-word ; : compile-all ( -- ) [ try-compile ] each-word ;

View File

@ -18,13 +18,10 @@ SYMBOL: compiled-xts
: save-xt ( word -- ) : save-xt ( word -- )
compiled-offset swap compiled-xts [ acons ] change ; compiled-offset swap compiled-xts [ acons ] change ;
: commit-xt ( xt word -- )
dup t "compiled" set-word-prop set-word-xt ;
: commit-xts ( -- ) : commit-xts ( -- )
#! We must flush the instruction cache on PowerPC. #! We must flush the instruction cache on PowerPC.
flush-icache flush-icache
compiled-xts get [ unswons commit-xt ] each compiled-xts get [ unswons set-word-xt ] each
compiled-xts off ; compiled-xts off ;
: compiled-xt ( word -- xt ) : compiled-xt ( word -- xt )