Merge branch 'master' of git://factorcode.org/git/factor
Joe Groff
commit
3003b9e5d0
|
|
@ -533,6 +533,10 @@ INSN: ##gc
|
|||
temp: temp1/int-rep temp2/int-rep
|
||||
literal: data-values tagged-values uninitialized-locs ;
|
||||
|
||||
INSN: ##save-context
|
||||
temp: temp1/int-rep temp2/int-rep
|
||||
literal: callback-allowed? ;
|
||||
|
||||
! Instructions used by machine IR only.
|
||||
INSN: _prologue
|
||||
literal: stack-frame ;
|
||||
|
|
|
|||
|
|
@ -41,11 +41,11 @@ TUPLE: insn-slot-spec type name rep ;
|
|||
"insn-slots" word-prop
|
||||
[ type>> def eq? ] find nip ;
|
||||
|
||||
: insn-use-slots ( class -- slot/f )
|
||||
: insn-use-slots ( class -- slots )
|
||||
"insn-slots" word-prop
|
||||
[ type>> use eq? ] filter ;
|
||||
|
||||
: insn-temp-slots ( class -- slot/f )
|
||||
: insn-temp-slots ( class -- slots )
|
||||
"insn-slots" word-prop
|
||||
[ type>> temp eq? ] filter ;
|
||||
|
||||
|
|
|
|||
|
|
@ -13,6 +13,7 @@ compiler.cfg.dce
|
|||
compiler.cfg.write-barrier
|
||||
compiler.cfg.representations
|
||||
compiler.cfg.two-operand
|
||||
compiler.cfg.save-contexts
|
||||
compiler.cfg.ssa.destruction
|
||||
compiler.cfg.empty-blocks
|
||||
compiler.cfg.checker ;
|
||||
|
|
@ -38,6 +39,7 @@ SYMBOL: check-optimizer?
|
|||
eliminate-write-barriers
|
||||
select-representations
|
||||
convert-two-operand
|
||||
insert-save-contexts
|
||||
destruct-ssa
|
||||
delete-empty-blocks
|
||||
?check ;
|
||||
|
|
|
|||
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
USING: accessors compiler.cfg.debugger
|
||||
compiler.cfg.instructions compiler.cfg.save-contexts namespaces
|
||||
tools.test ;
|
||||
IN: compiler.cfg.save-contexts.tests
|
||||
|
||||
V{
|
||||
T{ ##save-context f 0 1 f }
|
||||
T{ ##save-context f 0 1 t }
|
||||
T{ ##branch }
|
||||
} 0 test-bb
|
||||
|
||||
0 get combine-in-block
|
||||
|
||||
[
|
||||
V{
|
||||
T{ ##save-context f 0 1 t }
|
||||
T{ ##branch }
|
||||
}
|
||||
] [
|
||||
0 get instructions>>
|
||||
] unit-test
|
||||
|
||||
V{
|
||||
T{ ##add f 1 2 3 }
|
||||
T{ ##branch }
|
||||
} 0 test-bb
|
||||
|
||||
0 get combine-in-block
|
||||
|
||||
[
|
||||
V{
|
||||
T{ ##add f 1 2 3 }
|
||||
T{ ##branch }
|
||||
}
|
||||
] [
|
||||
0 get instructions>>
|
||||
] unit-test
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors combinators.short-circuit
|
||||
compiler.cfg.instructions compiler.cfg.registers
|
||||
compiler.cfg.rpo cpu.architecture kernel sequences vectors ;
|
||||
IN: compiler.cfg.save-contexts
|
||||
|
||||
! Insert context saves.
|
||||
|
||||
: needs-save-context? ( insns -- ? )
|
||||
[
|
||||
{
|
||||
[ ##unary-float-function? ]
|
||||
[ ##binary-float-function? ]
|
||||
[ ##alien-invoke? ]
|
||||
[ ##alien-indirect? ]
|
||||
} 1||
|
||||
] any? ;
|
||||
|
||||
: needs-callback-context? ( insns -- ? )
|
||||
[
|
||||
{
|
||||
[ ##alien-invoke? ]
|
||||
[ ##alien-indirect? ]
|
||||
} 1||
|
||||
] any? ;
|
||||
|
||||
: insert-save-context ( bb -- )
|
||||
dup instructions>> dup needs-save-context? [
|
||||
int-rep next-vreg-rep
|
||||
int-rep next-vreg-rep
|
||||
pick needs-callback-context?
|
||||
\ ##save-context new-insn prefix
|
||||
>>instructions drop
|
||||
] [ 2drop ] if ;
|
||||
|
||||
: insert-save-contexts ( cfg -- cfg' )
|
||||
dup [ insert-save-context ] each-basic-block ;
|
||||
|
|
@ -201,6 +201,7 @@ CODEGEN: ##compare %compare
|
|||
CODEGEN: ##compare-imm %compare-imm
|
||||
CODEGEN: ##compare-float-ordered %compare-float-ordered
|
||||
CODEGEN: ##compare-float-unordered %compare-float-unordered
|
||||
CODEGEN: ##save-context %save-context
|
||||
|
||||
CODEGEN: _fixnum-add %fixnum-add
|
||||
CODEGEN: _fixnum-sub %fixnum-sub
|
||||
|
|
@ -254,6 +255,7 @@ M: _gc generate-insn
|
|||
[ [ uninitialized-locs>> ] [ temp1>> ] bi wipe-locs ]
|
||||
[ data-values>> save-data-regs ]
|
||||
[ [ tagged-values>> ] [ temp1>> ] bi save-gc-roots ]
|
||||
[ [ temp1>> ] [ temp2>> ] bi t %save-context ]
|
||||
[ tagged-values>> length %call-gc ]
|
||||
[ [ tagged-values>> ] [ temp1>> ] bi load-gc-roots ]
|
||||
[ data-values>> load-data-regs ]
|
||||
|
|
@ -396,8 +398,6 @@ M: long-long-type flatten-value-type ( type -- types )
|
|||
|
||||
M: ##alien-invoke generate-insn
|
||||
params>>
|
||||
! Save registers for GC
|
||||
%prepare-alien-invoke
|
||||
! Unbox parameters
|
||||
dup objects>registers
|
||||
%prepare-var-args
|
||||
|
|
@ -410,8 +410,6 @@ M: ##alien-invoke generate-insn
|
|||
! ##alien-indirect
|
||||
M: ##alien-indirect generate-insn
|
||||
params>>
|
||||
! Save registers for GC
|
||||
%prepare-alien-invoke
|
||||
! Save alien at top of stack to temporary storage
|
||||
%prepare-alien-indirect
|
||||
! Unbox parameters
|
||||
|
|
|
|||
|
|
@ -289,7 +289,7 @@ HOOK: %save-param-reg cpu ( stack reg rep -- )
|
|||
|
||||
HOOK: %load-param-reg cpu ( stack reg rep -- )
|
||||
|
||||
HOOK: %prepare-alien-invoke cpu ( -- )
|
||||
HOOK: %save-context cpu ( temp1 temp2 callback-allowed? -- )
|
||||
|
||||
HOOK: %prepare-var-args cpu ( -- )
|
||||
|
||||
|
|
|
|||
|
|
@ -468,7 +468,6 @@ M:: ppc %load-gc-root ( gc-root register -- )
|
|||
register 1 gc-root gc-root@ LWZ ;
|
||||
|
||||
M:: ppc %call-gc ( gc-root-count -- )
|
||||
%prepare-alien-invoke
|
||||
3 1 gc-root-base local@ ADDI
|
||||
gc-root-count 4 LI
|
||||
"inline_gc" f %alien-invoke ;
|
||||
|
|
@ -670,15 +669,17 @@ M: ppc %box-large-struct ( n c-type -- )
|
|||
! Call the function
|
||||
"box_value_struct" f %alien-invoke ;
|
||||
|
||||
M: ppc %prepare-alien-invoke
|
||||
M:: ppc %save-context ( temp1 temp2 callback-allowed? -- )
|
||||
#! Save Factor stack pointers in case the C code calls a
|
||||
#! callback which does a GC, which must reliably trace
|
||||
#! all roots.
|
||||
scratch-reg "stack_chain" f %alien-global
|
||||
scratch-reg scratch-reg 0 LWZ
|
||||
1 scratch-reg 0 STW
|
||||
ds-reg scratch-reg 8 STW
|
||||
rs-reg scratch-reg 12 STW ;
|
||||
temp1 "stack_chain" f %alien-global
|
||||
temp1 temp1 0 LWZ
|
||||
1 temp1 0 STW
|
||||
callback-allowed? [
|
||||
ds-reg temp1 8 STW
|
||||
rs-reg temp1 12 STW
|
||||
] when ;
|
||||
|
||||
M: ppc %alien-invoke ( symbol dll -- )
|
||||
[ 11 ] 2dip %alien-global 11 MTLR BLRL ;
|
||||
|
|
|
|||
|
|
@ -610,7 +610,6 @@ M:: x86 %call-gc ( gc-root-count -- )
|
|||
! Pass number of roots as second parameter
|
||||
param-reg-2 gc-root-count MOV
|
||||
! Call GC
|
||||
%prepare-alien-invoke
|
||||
"inline_gc" f %alien-invoke ;
|
||||
|
||||
M: x86 %alien-global
|
||||
|
|
@ -739,16 +738,18 @@ M:: x86 %reload ( dst rep n -- )
|
|||
|
||||
M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
|
||||
|
||||
M: x86 %prepare-alien-invoke
|
||||
M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
|
||||
#! Save Factor stack pointers in case the C code calls a
|
||||
#! callback which does a GC, which must reliably trace
|
||||
#! all roots.
|
||||
temp-reg "stack_chain" f %alien-global
|
||||
temp-reg temp-reg [] MOV
|
||||
temp-reg [] stack-reg MOV
|
||||
temp-reg [] cell SUB
|
||||
temp-reg 2 cells [+] ds-reg MOV
|
||||
temp-reg 3 cells [+] rs-reg MOV ;
|
||||
temp1 "stack_chain" f %alien-global
|
||||
temp1 temp1 [] MOV
|
||||
temp2 stack-reg cell neg [+] LEA
|
||||
temp1 [] temp2 MOV
|
||||
callback-allowed? [
|
||||
temp1 2 cells [+] ds-reg MOV
|
||||
temp1 3 cells [+] rs-reg MOV
|
||||
] when ;
|
||||
|
||||
M: x86 value-struct? drop t ;
|
||||
|
||||
|
|
|
|||
|
|
@ -16,7 +16,10 @@ $nl
|
|||
{ $subsection add-timing }
|
||||
{ $subsection word-timing. }
|
||||
"All of the above words are implemented using a single combinator which applies a quotation to a word definition to yield a new definition:"
|
||||
{ $subsection annotate } ;
|
||||
{ $subsection annotate }
|
||||
{ $warning
|
||||
"Certain internal words, such as words in the " { $vocab-link "math" } ", " { $vocab-link "sequences" } " and UI vocabularies, cannot be annotated, since the annotated code may end up recursively invoking the word in question. This may crash or hang Factor. It is safest to only define annotations on your own words."
|
||||
} ;
|
||||
|
||||
ABOUT: "tools.annotations"
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue