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

old accessors

db4
Doug Coleman 2008-08-29 15:55:19 -05:00
parent 235cf7e1b8
commit 5da65cf7fd
2 changed files with 13 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/compiler/generator/fixup/fixup.factor
View File

@ -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 )

24
basis/compiler/generator/registers/registers.factor
View File

@ -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 ;