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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-06-30 23:07:36 -05:00
parent f894baf60e 8b728e0a8a
commit a3b21292b6
3 changed files with 70 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/compiler/cfg/builder/builder-tests.factor
View File

@ -18,10 +18,14 @@ kernel.private math ;
[ 3 fixnum+fast ]
[ fixnum*fast ]
[ 3 fixnum*fast ]
[ 3 swap fixnum*fast ]
[ fixnum-shift-fast ]
[ 10 fixnum-shift-fast ]
[ -10 fixnum-shift-fast ]
[ 0 fixnum-shift-fast ]
[ 10 swap fixnum-shift-fast ]
[ -10 swap fixnum-shift-fast ]
[ 0 swap fixnum-shift-fast ]
[ fixnum-bitnot ]
[ eq? ]
[ "hi" eq? ]

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

@ -51,18 +51,27 @@ IN: compiler.cfg.intrinsics.fixnum
ds-push
] ; inline
: emit-fixnum-shift-fast ( node -- )
dup node-input-infos dup second value-info-small-fixnum? [
nip
[ 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-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? [
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 ;
: emit-fixnum-bitnot ( -- )
ds-pop ^^not tag-mask get ^^xor-imm ds-push ;
@ -72,14 +81,21 @@ IN: compiler.cfg.intrinsics.fixnum
: (emit-fixnum*fast) ( -- dst )
2inputs ^^untag-fixnum ^^mul ;
: (emit-fixnum*fast-imm) ( infos -- dst )
ds-drop
[ ds-pop ] [ second literal>> ] bi* ^^mul-imm ;
: (emit-fixnum*fast-imm1) ( infos -- dst )
[ ds-pop ds-drop ] [ first literal>> ] bi* ^^mul-imm ;
: (emit-fixnum*fast-imm2) ( infos -- dst )
[ ds-drop ds-pop ] [ second literal>> ] bi* ^^mul-imm ;
: emit-fixnum*fast ( node -- )
node-input-infos
dup second value-info-small-fixnum?
[ (emit-fixnum*fast-imm) ] [ drop (emit-fixnum*fast) ] if
dup first value-info-small-fixnum?
[
(emit-fixnum*fast-imm1)
] [
dup second value-info-small-fixnum?
[ (emit-fixnum*fast-imm2) ] [ drop (emit-fixnum*fast) ] if
] if
ds-push ;
: (emit-fixnum-comparison) ( cc -- quot1 quot2 )

49
basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
View File

@ -1,12 +1,11 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences layouts accessors combinators namespaces
math fry
compiler.cfg.hats
compiler.cfg.instructions
USING: accessors combinators combinators.short-circuit
compiler.cfg.hats compiler.cfg.instructions
compiler.cfg.value-numbering.expressions
compiler.cfg.value-numbering.graph
compiler.cfg.value-numbering.simplify
compiler.cfg.value-numbering.expressions ;
compiler.cfg.value-numbering.simplify fry kernel layouts math
namespaces sequences ;
IN: compiler.cfg.value-numbering.rewrite
GENERIC: rewrite ( insn -- insn' )
@ -19,8 +18,10 @@ M: ##mul-imm rewrite
: ##branch-t? ( insn -- ? )
dup ##compare-imm-branch? [
[ cc>> cc/= eq? ]
[ src2>> \ f tag-number eq? ] bi and
{
[ cc>> cc/= eq? ]
[ src2>> \ f tag-number eq? ]
} 1&&
] [ drop f ] if ; inline
: rewrite-boolean-comparison? ( insn -- ? )
@ -47,9 +48,10 @@ M: ##mul-imm rewrite
: rewrite-tagged-comparison? ( insn -- ? )
#! Are we comparing two tagged fixnums? Then untag them.
[ src1>> vreg>expr tag-fixnum-expr? ]
[ src2>> tag-mask get bitand 0 = ]
bi and ; inline
{
[ src1>> vreg>expr tag-fixnum-expr? ]
[ src2>> tag-mask get bitand 0 = ]
} 1&& ; inline
: (rewrite-tagged-comparison) ( insn -- src1 src2 cc )
[ src1>> vreg>expr in1>> vn>vreg ]
@ -89,10 +91,11 @@ M: ##compare rewrite
] when ;
: rewrite-redundant-comparison? ( insn -- ? )
[ src1>> vreg>expr compare-expr? ]
[ src2>> \ f tag-number = ]
[ cc>> { cc= cc/= } memq? ]
tri and and ; inline
{
[ src1>> vreg>expr compare-expr? ]
[ src2>> \ f tag-number = ]
[ cc>> { cc= cc/= } memq? ]
} 1&& ; inline
: rewrite-redundant-comparison ( insn -- insn' )
[ cc>> ] [ dst>> ] [ src1>> vreg>expr dup op>> ] tri {
@ -114,4 +117,20 @@ M: ##compare-imm rewrite
] when
] when ;
: combine-add-imm? ( insn -- ? )
{
[ src1>> vreg>expr op>> \ ##add-imm = ]
[ src2>> number? ]
} 1&& ;
: combine-add-imm ( dst src n -- insn )
[ vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ] dip
+ \ ##add-imm new-insn ;
M: ##add-imm rewrite
dup combine-add-imm? [
[ dst>> ] [ src1>> ] [ src2>> ] tri combine-add-imm
dup number-values
] when ;
M: insn rewrite ;