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

compiler.cfg: bug fixes in GC check insertion and fixnum intrinsics

db4
Slava Pestov 2009-07-02 00:51:06 -05:00
parent e6b1c21590
commit af875ba836
3 changed files with 18 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/compiler/cfg/instructions/instructions.factor
View File

@ -240,7 +240,7 @@ INSN: _compare-imm-branch label { src1 vreg } { src2 integer } cc ;
INSN: _compare-float-branch < _conditional-branch ; INSN: _compare-float-branch < _conditional-branch ;
TUPLE: spill-slot n ; C: <spill-slot> spill-slot TUPLE: spill-slot { n integer } ; C: <spill-slot> spill-slot
INSN: _gc { temp1 vreg } { temp2 vreg } gc-roots gc-root-count gc-root-size ; INSN: _gc { temp1 vreg } { temp2 vreg } gc-roots gc-root-count gc-root-size ;

43
basis/compiler/cfg/intrinsics/fixnum/fixnum.factor
View File

@ -39,38 +39,25 @@ IN: compiler.cfg.intrinsics.fixnum
:: emit-commutative-fixnum-op ( node insn imm-insn -- ) :: emit-commutative-fixnum-op ( node insn imm-insn -- )
[let | infos [ node node-input-infos ] | [let | infos [ node node-input-infos ] |
infos first value-info-small-tagged? {
[ infos imm-insn emit-fixnum-imm-op1 ] { [ infos first value-info-small-tagged? ] [ infos imm-insn emit-fixnum-imm-op1 ] }
[ { [ infos second value-info-small-tagged? ] [ infos imm-insn emit-fixnum-imm-op2 ] }
infos second value-info-small-tagged? [ [ insn (emit-fixnum-op) ]
infos imm-insn emit-fixnum-imm-op2 } cond
] [
insn (emit-fixnum-op)
] if
] if
ds-push ds-push
] ; inline ] ; inline
: (emit-fixnum-shift-fast) ( obj node -- obj )
literal>> dup sgn {
{ -1 [ neg tag-bits get + ^^sar-imm ^^tag-fixnum ] }
{ 0 [ drop ] }
{ 1 [ ^^shl-imm ] }
} case ;
: emit-fixnum-shift-fast ( node -- ) : emit-fixnum-shift-fast ( node -- )
dup node-input-infos dup first value-info-small-fixnum? [ dup node-input-infos dup second value-info-small-fixnum? [
nip nip
[ ds-pop ds-drop ] dip first (emit-fixnum-shift-fast) ds-push [ ds-drop ds-pop ] dip
] [ second literal>> dup sgn {
drop { -1 [ neg tag-bits get + ^^sar-imm ^^tag-fixnum ] }
dup node-input-infos dup second value-info-small-fixnum? [ { 0 [ drop ] }
nip { 1 [ ^^shl-imm ] }
[ ds-drop ds-pop ] dip second (emit-fixnum-shift-fast) ds-push } case
] [ ds-push
drop emit-primitive ] [ drop emit-primitive ] if ;
] if
] if ;
: emit-fixnum-bitnot ( -- ) : emit-fixnum-bitnot ( -- )
ds-pop ^^not tag-mask get ^^xor-imm ds-push ; ds-pop ^^not tag-mask get ^^xor-imm ds-push ;
@ -89,7 +76,7 @@ IN: compiler.cfg.intrinsics.fixnum
: emit-fixnum*fast ( node -- ) : emit-fixnum*fast ( node -- )
node-input-infos node-input-infos
dup first value-info-small-fixnum? dup first value-info-small-fixnum? drop f
[ [
(emit-fixnum*fast-imm1) (emit-fixnum*fast-imm1)
] [ ] [

4
basis/compiler/cfg/linear-scan/assignment/assignment.factor
View File

@ -136,8 +136,8 @@ M: vreg-insn assign-registers-in-insn
register-mapping ; register-mapping ;
: compute-live-spill-slots ( -- spill-slots ) : compute-live-spill-slots ( -- spill-slots )
spill-slots get values [ values ] map concat spill-slots get values
[ [ vreg>> ] [ reload-from>> ] bi ] { } map>assoc ; [ [ vreg>> swap ] { } assoc-map-as ] map concat ;
M: ##gc assign-registers-in-insn M: ##gc assign-registers-in-insn
dup call-next-method dup call-next-method