compiler.cfg.liveness: Add parallel-copy method for lookup-base-pointer*. Adjust lookup-base-pointer* stack effect to take two parameters. Still retain stack overflows, but more correct now...

db4
Doug Coleman 2013-01-01 14:16:51 -08:00
parent 262eb73ea6
commit 125e4befd3
1 changed files with 15 additions and 11 deletions

View File

@ -68,36 +68,40 @@ M: vreg-insn visit-insn
DEFER: lookup-base-pointer
GENERIC: lookup-base-pointer* ( insn -- vreg/f )
GENERIC: lookup-base-pointer* ( vreg insn -- vreg/f )
M: ##tagged>integer lookup-base-pointer* src>> ;
M: ##tagged>integer lookup-base-pointer* nip src>> ;
M: ##unbox-any-c-ptr lookup-base-pointer*
! If the input to unbox-any-c-ptr was an alien and not a
! byte array, then the derived pointer will be outside of
! the data heap. The GC has to handle this case and ignore
! it.
src>> ;
nip src>> ;
M: ##copy lookup-base-pointer* src>> lookup-base-pointer ;
M: ##copy lookup-base-pointer* nip src>> lookup-base-pointer ;
M: ##add-imm lookup-base-pointer* src1>> lookup-base-pointer ;
M: ##add-imm lookup-base-pointer* nip src1>> lookup-base-pointer ;
M: ##sub-imm lookup-base-pointer* src1>> lookup-base-pointer ;
M: ##sub-imm lookup-base-pointer* nip src1>> lookup-base-pointer ;
M: ##parallel-copy lookup-base-pointer* values>> value-at ;
M: ##add lookup-base-pointer*
! If both operands have a base pointer, then the user better
! not be doing memory reads and writes on the object, since
! we don't give it a base pointer in that case at all.
[ src1>> ] [ src2>> ] bi [ lookup-base-pointer ] bi@ xor ;
nip [ src1>> ] [ src2>> ] bi [ lookup-base-pointer ] bi@ xor ;
M: ##sub lookup-base-pointer*
src1>> lookup-base-pointer ;
nip src1>> lookup-base-pointer ;
M: vreg-insn lookup-base-pointer* drop f ;
M: vreg-insn lookup-base-pointer* 2drop f ;
: lookup-base-pointer ( vreg -- vreg/f )
base-pointers get [ ?leader insn-of lookup-base-pointer* ] cache ;
: lookup-base-pointer ( vreg -- vregs/f )
base-pointers get [
dup ?leader insn-of lookup-base-pointer*
] cache ;
:: visit-derived-root ( vreg derived-roots gc-roots -- )
vreg lookup-base-pointer :> base