steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Another compiler fix

release
Slava Pestov 2007-10-01 06:56:45 -04:00
parent 8048a4235a
commit 88168656dd
3 changed files with 44 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
core/compiler/test/templates-early.factor
View File

@ -157,3 +157,33 @@ SYMBOL: template-chosen
! This is empty since we didn't change the stack ! This is empty since we didn't change the stack
[ t ] [ [ end-basic-block ] { } make empty? ] unit-test [ t ] [ [ end-basic-block ] { } make empty? ] unit-test
] with-scope ] with-scope
! Regression
[
[ ] [ init-templates ] unit-test
[ ] [ { object object } set-operand-classes ] unit-test
! 2dup
[ ] [
T{ effect f { "x" "y" } { "x" "y" "x" "y" } }
phantom-shuffle
] unit-test
[ ] [
2 phantom-d get phantom-input
[ { { f "a" } { f "b" } } lazy-load ] { } make drop
] unit-test
[ t ] [
phantom-d get [ cached? ] all?
] unit-test
! >r
[ ] [
1 phantom->r
] unit-test
! This should not fail
[ ] [ [ end-basic-block ] { } make drop ] unit-test
] with-scope

5
core/compiler/test/templates.factor
View File

@ -213,3 +213,8 @@ TUPLE: my-tuple ;
0 alien-cell type 0 alien-cell type
] compile-1 alien type-number = ] compile-1 alien type-number =
] unit-test ] unit-test
[ 2 1 ] [
2 1
[ 2dup fixnum< [ >r die r> ] when ] compile-1
] unit-test

16
core/generator/registers/registers.factor
View File

@ -116,8 +116,8 @@ M: cached live-vregs* cached-vreg live-vregs* ;
M: cached live-loc? cached-loc live-loc? ; M: cached live-loc? cached-loc live-loc? ;
M: cached (lazy-load) >r cached-vreg r> (lazy-load) ; M: cached (lazy-load) >r cached-vreg r> (lazy-load) ;
M: cached lazy-store M: cached lazy-store
2dup cached-loc = 2dup cached-loc live-loc?
[ 2drop ] [ "live-locs" get at %move ] if ; [ "live-locs" get at %move ] [ 2drop ] if ;
M: cached minimal-ds-loc* cached-loc minimal-ds-loc* ; M: cached minimal-ds-loc* cached-loc minimal-ds-loc* ;
INSTANCE: cached value INSTANCE: cached value
@ -433,17 +433,19 @@ M: loc lazy-store
#! We don't have enough free registers to load all shuffle #! We don't have enough free registers to load all shuffle
#! inputs, so we use a single temporary register, together #! inputs, so we use a single temporary register, together
#! with the area of the data stack above the stack pointer #! with the area of the data stack above the stack pointer
find-tmp-loc slow-shuffle-mapping find-tmp-loc slow-shuffle-mapping [
[ [
[ swap dup cached? [ cached-vreg ] when %move ] assoc-each swap dup cached? [ cached-vreg ] when %move
] keep ] assoc-each
>hashtable do-shuffle ; ] keep >hashtable do-shuffle ;
: fast-shuffle? ( live-locs -- ? ) : fast-shuffle? ( live-locs -- ? )
#! Test if we have enough free registers to load all #! Test if we have enough free registers to load all
#! shuffle inputs at once. #! shuffle inputs at once.
T{ int-regs } free-vregs [ length ] 2apply <= ; T{ int-regs } free-vregs [ length ] 2apply <= ;
USING: io prettyprint ;
: finalize-locs ( -- ) : finalize-locs ( -- )
#! Perform any deferred stack shuffling. #! Perform any deferred stack shuffling.
[ [