%box-displaced-alien: fix clobberage found by Doug
parent
0db01f6d5f
commit
9595be4bf9
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 } ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 -- )
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue