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

%box-displaced-alien: fix clobberage found by Doug

db4
Slava Pestov 2009-08-30 05:11:08 -05:00
parent 0db01f6d5f
commit 9595be4bf9
11 changed files with 49 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/compiler/cfg/def-use/def-use.factor
View File

@ -21,7 +21,7 @@ M: ##slot temp-vregs temp>> 1array ;
M: ##set-slot temp-vregs temp>> 1array ;
M: ##string-nth temp-vregs temp>> 1array ;
M: ##set-string-nth-fast temp-vregs temp>> 1array ;
M: ##box-displaced-alien temp-vregs temp>> 1array ;
M: ##box-displaced-alien temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
M: ##compare temp-vregs temp>> 1array ;
M: ##compare-imm temp-vregs temp>> 1array ;
M: ##compare-float temp-vregs temp>> 1array ;

2
basis/compiler/cfg/hats/hats.factor
View File

@ -58,7 +58,7 @@ IN: compiler.cfg.hats
: ^^allot-byte-array ( n -- dst ) 2 cells + byte-array ^^allot ; inline
: ^^box-alien ( src -- dst ) ^^r1 next-vreg ##box-alien ; inline
: ^^box-displaced-alien ( base displacement base-class -- dst )
^^r3 [ next-vreg ] dip ##box-displaced-alien ; inline
^^r3 [ next-vreg next-vreg ] dip ##box-displaced-alien ; inline
: ^^unbox-alien ( src -- dst ) ^^r1 ##unbox-alien ; inline
: ^^unbox-c-ptr ( src class -- dst ) ^^r2 next-vreg ##unbox-c-ptr ;
: ^^alien-unsigned-1 ( src -- dst ) ^^r1 ##alien-unsigned-1 ; inline

2
basis/compiler/cfg/instructions/instructions.factor
View File

@ -126,7 +126,7 @@ INSN: ##unbox-float < ##unary ;
INSN: ##unbox-any-c-ptr < ##unary/temp ;
INSN: ##box-float < ##unary/temp ;
INSN: ##box-alien < ##unary/temp ;
INSN: ##box-displaced-alien < ##binary temp base-class ;
INSN: ##box-displaced-alien < ##binary temp1 temp2 base-class ;
: ##unbox-f ( dst src -- ) drop 0 ##load-immediate ;
: ##unbox-byte-array ( dst src -- ) byte-array-offset ##add-imm ;

4
basis/compiler/cfg/renaming/functor/functor.factor
View File

@ -141,7 +141,9 @@ M: ##set-string-nth-fast rename-insn-temps
TEMP-QUOT change-temp drop ;
M: ##box-displaced-alien rename-insn-temps
TEMP-QUOT change-temp drop ;
TEMP-QUOT change-temp1
TEMP-QUOT change-temp2
drop ;
M: ##compare rename-insn-temps
TEMP-QUOT change-temp drop ;

2
basis/compiler/cfg/representations/preferred/preferred.factor
View File

@ -25,7 +25,7 @@ M: ##slot temp-vreg-reps drop { int-rep } ;
M: ##set-slot temp-vreg-reps drop { int-rep } ;
M: ##string-nth temp-vreg-reps drop { int-rep } ;
M: ##set-string-nth-fast temp-vreg-reps drop { int-rep } ;
M: ##box-displaced-alien temp-vreg-reps drop { int-rep } ;
M: ##box-displaced-alien temp-vreg-reps drop { int-rep int-rep } ;
M: ##compare temp-vreg-reps drop { int-rep } ;
M: ##compare-imm temp-vreg-reps drop { int-rep } ;
M: ##compare-float temp-vreg-reps drop { int-rep } ;

2
basis/compiler/codegen/codegen.factor
View File

@ -193,7 +193,7 @@ M: ##box-float generate-insn dst/src/temp %box-float ;
M: ##box-alien generate-insn dst/src/temp %box-alien ;
M: ##box-displaced-alien generate-insn
[ dst/src1/src2 ] [ temp>> ] bi %box-displaced-alien ;
[ dst/src1/src2 ] [ temp1>> ] [ temp2>> ] tri %box-displaced-alien ;
M: ##alien-unsigned-1 generate-insn dst/src %alien-unsigned-1 ;
M: ##alien-unsigned-2 generate-insn dst/src %alien-unsigned-2 ;

8
basis/compiler/tests/intrinsics.factor
View File

@ -519,6 +519,14 @@ cell 8 = [
underlying>>
] unit-test
[ ALIEN: 1234 ALIEN: 2234 ] [
ALIEN: 234 [
{ c-ptr } declare
[ 1000 swap <displaced-alien> ]
[ 2000 swap <displaced-alien> ] bi
] compile-call
] unit-test
[
B{ 0 0 0 0 } [ { byte-array } declare <void*> ] compile-call
] must-fail

2
basis/cpu/architecture/architecture.factor
View File

@ -126,7 +126,7 @@ HOOK: %unbox-float cpu ( dst src -- )
HOOK: %unbox-any-c-ptr cpu ( dst src temp -- )
HOOK: %box-float cpu ( dst src temp -- )
HOOK: %box-alien cpu ( dst src temp -- )
HOOK: %box-displaced-alien cpu ( dst displacement base temp -- )
HOOK: %box-displaced-alien cpu ( dst displacement base temp1 temp2 -- )
HOOK: %alien-unsigned-1 cpu ( dst src -- )
HOOK: %alien-unsigned-2 cpu ( dst src -- )

19
basis/cpu/ppc/ppc.factor
View File

@ -335,7 +335,7 @@ M:: ppc %box-alien ( dst src temp -- )
"f" resolve-label
] with-scope ;
M:: ppc %box-displaced-alien ( dst displacement base temp -- )
M:: ppc %box-displaced-alien ( dst displacement base displacement' base' -- )
[
"end" define-label
"ok" define-label
@ -343,7 +343,12 @@ M:: ppc %box-displaced-alien ( dst displacement base temp -- )
dst base MR
0 displacement 0 CMPI
"end" get BEQ
! Quickly use displacement' before its needed for real, as allot temporary
displacement' :> temp
dst 4 cells alien temp %allot
! If base is already a displaced alien, unpack it
base' base MR
displacement' displacement MR
0 base \ f tag-number CMPI
"ok" get BEQ
temp base header-offset LWZ
@ -351,11 +356,17 @@ M:: ppc %box-displaced-alien ( dst displacement base temp -- )
"ok" get BNE
! displacement += base.displacement
temp base 3 alien@ LWZ
displacement displacement temp ADD
displacement' displacement temp ADD
! base = base.base
base base 1 alien@ LWZ
base' base 1 alien@ LWZ
"ok" resolve-label
dst displacement base temp %allot-alien
! Store underlying-alien slot
base' dst 1 alien@ STW
! Store offset
displacement' dst 3 alien@ STW
! Store expired slot (its ok to clobber displacement')
temp \ f tag-number %load-immediate
temp dst 2 alien@ STW
"end" resolve-label
] with-scope ;

14
basis/cpu/x86/x86.factor
View File

@ -278,7 +278,7 @@ M:: x86 %box-alien ( dst src temp -- )
"end" resolve-label
] with-scope ;
M:: x86 %box-displaced-alien ( dst displacement base temp -- )
M:: x86 %box-displaced-alien ( dst displacement base displacement' base' -- )
[
"end" define-label
"ok" define-label
@ -286,17 +286,23 @@ M:: x86 %box-displaced-alien ( dst displacement base temp -- )
dst base MOV
displacement 0 CMP
"end" get JE
! Quickly use displacement' before its needed for real, as allot temporary
dst 4 cells alien displacement' %allot
! If base is already a displaced alien, unpack it
base' base MOV
displacement' displacement MOV
base \ f tag-number CMP
"ok" get JE
base header-offset [+] alien type-number tag-fixnum CMP
"ok" get JNE
! displacement += base.displacement
displacement base 3 alien@ ADD
displacement' base 3 alien@ ADD
! base = base.base
base base 1 alien@ MOV
base' base 1 alien@ MOV
"ok" resolve-label
dst displacement base temp %allot-alien
dst 1 alien@ base' MOV ! alien
dst 2 alien@ \ f tag-number MOV ! expired
dst 3 alien@ displacement' MOV ! displacement
"end" resolve-label
] with-scope ;

7
basis/struct-arrays/struct-arrays-tests.factor
View File

@ -44,3 +44,10 @@ STRUCT: test-struct-array
S{ test-struct-array f 20 20 }
} second
] unit-test
! Regression
STRUCT: fixed-string { text char[100] } ;
[ { ALIEN: 123 ALIEN: 223 ALIEN: 323 ALIEN: 423 } ] [
ALIEN: 123 4 fixed-string <direct-struct-array> [ (underlying)>> ] { } map-as
] unit-test