old accessors
parent
235cf7e1b8
commit
5da65cf7fd
|
@ -15,7 +15,7 @@ TUPLE: frame-required n ;
|
||||||
|
|
||||||
: stack-frame-size ( code -- n )
|
: stack-frame-size ( code -- n )
|
||||||
no-stack-frame [
|
no-stack-frame [
|
||||||
dup frame-required? [ frame-required-n max ] [ drop ] if
|
dup frame-required? [ n>> max ] [ drop ] if
|
||||||
] reduce ;
|
] reduce ;
|
||||||
|
|
||||||
GENERIC: fixup* ( frame-size obj -- frame-size )
|
GENERIC: fixup* ( frame-size obj -- frame-size )
|
||||||
|
|
|
@ -102,12 +102,12 @@ TUPLE: cached loc vreg ;
|
||||||
|
|
||||||
C: <cached> cached
|
C: <cached> cached
|
||||||
|
|
||||||
M: cached set-operand-class cached-vreg set-operand-class ;
|
M: cached set-operand-class vreg>> set-operand-class ;
|
||||||
M: cached operand-class* cached-vreg operand-class* ;
|
M: cached operand-class* vreg>> operand-class* ;
|
||||||
M: cached move-spec drop cached ;
|
M: cached move-spec drop cached ;
|
||||||
M: cached live-vregs* cached-vreg live-vregs* ;
|
M: cached live-vregs* 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 vreg>> r> (lazy-load) ;
|
||||||
M: cached lazy-store
|
M: cached lazy-store
|
||||||
2dup cached-loc live-loc?
|
2dup cached-loc live-loc?
|
||||||
[ "live-locs" get at %move ] [ 2drop ] if ;
|
[ "live-locs" get at %move ] [ 2drop ] if ;
|
||||||
|
@ -169,7 +169,7 @@ INSTANCE: unboxed-c-ptr value
|
||||||
! A constant value
|
! A constant value
|
||||||
TUPLE: constant value ;
|
TUPLE: constant value ;
|
||||||
C: <constant> constant
|
C: <constant> constant
|
||||||
M: constant operand-class* constant-value class ;
|
M: constant operand-class* value>> class ;
|
||||||
M: constant move-spec class ;
|
M: constant move-spec class ;
|
||||||
|
|
||||||
INSTANCE: constant value
|
INSTANCE: constant value
|
||||||
|
@ -204,7 +204,7 @@ INSTANCE: constant value
|
||||||
{ { f unboxed-c-ptr } [ %move-bug ] }
|
{ { f unboxed-c-ptr } [ %move-bug ] }
|
||||||
{ { f unboxed-byte-array } [ %move-bug ] }
|
{ { f unboxed-byte-array } [ %move-bug ] }
|
||||||
|
|
||||||
{ { f constant } [ constant-value swap load-literal ] }
|
{ { f constant } [ value>> swap load-literal ] }
|
||||||
|
|
||||||
{ { f float } [ %box-float ] }
|
{ { f float } [ %box-float ] }
|
||||||
{ { f unboxed-alien } [ %box-alien ] }
|
{ { f unboxed-alien } [ %box-alien ] }
|
||||||
|
@ -420,7 +420,7 @@ M: loc lazy-store
|
||||||
#! 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
|
swap dup cached? [ vreg>> ] when %move
|
||||||
] assoc-each
|
] assoc-each
|
||||||
] keep >hashtable do-shuffle ;
|
] keep >hashtable do-shuffle ;
|
||||||
|
|
||||||
|
@ -480,7 +480,7 @@ M: loc lazy-store
|
||||||
: substitute-vreg? ( old new -- ? )
|
: substitute-vreg? ( old new -- ? )
|
||||||
#! We don't substitute locs for float or alien vregs,
|
#! We don't substitute locs for float or alien vregs,
|
||||||
#! since in those cases the boxing overhead might kill us.
|
#! since in those cases the boxing overhead might kill us.
|
||||||
cached-vreg tagged? >r loc? r> and ;
|
vreg>> tagged? >r loc? r> and ;
|
||||||
|
|
||||||
: substitute-vregs ( values vregs -- )
|
: substitute-vregs ( values vregs -- )
|
||||||
[ vreg-substitution ] 2map
|
[ vreg-substitution ] 2map
|
||||||
|
@ -488,7 +488,7 @@ M: loc lazy-store
|
||||||
[ >r stack>> r> substitute-here ] curry each-phantom ;
|
[ >r stack>> r> substitute-here ] curry each-phantom ;
|
||||||
|
|
||||||
: set-operand ( value var -- )
|
: set-operand ( value var -- )
|
||||||
>r dup constant? [ constant-value ] when r> set ;
|
>r dup constant? [ value>> ] when r> set ;
|
||||||
|
|
||||||
: lazy-load ( values template -- )
|
: lazy-load ( values template -- )
|
||||||
#! Set operand vars here.
|
#! Set operand vars here.
|
||||||
|
@ -506,7 +506,7 @@ M: loc lazy-store
|
||||||
|
|
||||||
: clash? ( seq -- ? )
|
: clash? ( seq -- ? )
|
||||||
phantoms [ stack>> ] bi@ append [
|
phantoms [ stack>> ] bi@ append [
|
||||||
dup cached? [ cached-vreg ] when swap member?
|
dup cached? [ vreg>> ] when swap member?
|
||||||
] with contains? ;
|
] with contains? ;
|
||||||
|
|
||||||
: outputs-clash? ( -- ? )
|
: outputs-clash? ( -- ? )
|
||||||
|
@ -516,7 +516,7 @@ M: loc lazy-store
|
||||||
|
|
||||||
: count-input-vregs ( phantom spec -- )
|
: count-input-vregs ( phantom spec -- )
|
||||||
phantom&spec [
|
phantom&spec [
|
||||||
>r dup cached? [ cached-vreg ] when r> first allocation
|
>r dup cached? [ vreg>> ] when r> first allocation
|
||||||
] 2map count-vregs ;
|
] 2map count-vregs ;
|
||||||
|
|
||||||
: count-scratch-regs ( spec -- )
|
: count-scratch-regs ( spec -- )
|
||||||
|
@ -557,7 +557,7 @@ M: loc lazy-store
|
||||||
#! the value is always good.
|
#! the value is always good.
|
||||||
dup quotation? [
|
dup quotation? [
|
||||||
over constant?
|
over constant?
|
||||||
[ >r constant-value r> call ] [ 2drop f ] if
|
[ >r value>> r> call ] [ 2drop f ] if
|
||||||
] [
|
] [
|
||||||
2drop t
|
2drop t
|
||||||
] if ;
|
] if ;
|
||||||
|
|
Loading…
Reference in New Issue