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>
<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>

View File

@ -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

View File

@ -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

View File

@ -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 ;

View File

@ -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 )