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

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 -- )
[let | infos [ node node-input-infos ] |
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
] [
insn (emit-fixnum-op)
] if
] if
{
{ [ 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 ] }
[ insn (emit-fixnum-op) ]
} cond
ds-push
] ; 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 -- )
dup node-input-infos dup first value-info-small-fixnum? [
dup node-input-infos dup second value-info-small-fixnum? [
nip
[ ds-pop ds-drop ] dip first (emit-fixnum-shift-fast) ds-push
] [
drop
dup node-input-infos dup second value-info-small-fixnum? [
nip
[ ds-drop ds-pop ] dip second (emit-fixnum-shift-fast) ds-push
] [
drop emit-primitive
] if
] if ;
[ ds-drop ds-pop ] dip
second literal>> dup sgn {
{ -1 [ neg tag-bits get + ^^sar-imm ^^tag-fixnum ] }
{ 0 [ drop ] }
{ 1 [ ^^shl-imm ] }
} case
ds-push
] [ drop emit-primitive ] if ;
: emit-fixnum-bitnot ( -- )
ds-pop ^^not tag-mask get ^^xor-imm ds-push ;
@ -89,7 +76,7 @@ IN: compiler.cfg.intrinsics.fixnum
: emit-fixnum*fast ( node -- )
node-input-infos
dup first value-info-small-fixnum?
dup first value-info-small-fixnum? drop f
[
(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 ;
: compute-live-spill-slots ( -- spill-slots )
spill-slots get values [ values ] map concat
[ [ vreg>> ] [ reload-from>> ] bi ] { } map>assoc ;
spill-slots get values
[ [ vreg>> swap ] { } assoc-map-as ] map concat ;
M: ##gc assign-registers-in-insn
dup call-next-method