and ;
: emit-trivial-if ( -- )
- ds-pop f cc/= ^^compare-imm ds-push ;
+ [ f cc/= ^^compare-imm ] unary-op ;
: trivial-not-if? ( #if -- ? )
children>> first2
and ;
: emit-trivial-not-if ( -- )
- ds-pop f cc= ^^compare-imm ds-push ;
+ [ f cc= ^^compare-imm ] unary-op ;
: emit-actual-if ( #if -- )
! Inputs to the final instruction need to be copied because of
[ ##dispatch? ]
[ ##compare-branch? ]
[ ##compare-imm-branch? ]
+ [ ##compare-integer-branch? ]
+ [ ##compare-integer-imm-branch? ]
[ ##compare-float-ordered-branch? ]
[ ##compare-float-unordered-branch? ]
[ ##fixnum-add? ]
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays byte-arrays combinators.short-circuit
-kernel layouts math namespaces sequences combinators splitting
-parser effects words cpu.architecture compiler.cfg.registers
+USING: accessors alien arrays byte-arrays classes.algebra
+combinators.short-circuit kernel layouts math namespaces
+sequences combinators splitting parser effects words
+cpu.architecture compiler.constants compiler.cfg.registers
compiler.cfg.instructions compiler.cfg.instructions.syntax ;
IN: compiler.cfg.hats
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs accessors arrays kernel sequences namespaces words
-math math.order layouts classes.algebra classes.union
-compiler.units alien byte-arrays compiler.constants combinators
-compiler.cfg.registers compiler.cfg.instructions.syntax ;
+math math.order layouts classes.union compiler.units alien
+byte-arrays combinators compiler.cfg.registers
+compiler.cfg.instructions.syntax ;
IN: compiler.cfg.instructions
<<
! Constants
INSN: ##load-integer
def: dst/int-rep
-constant: val ;
+constant: val/int-rep ;
INSN: ##load-reference
def: dst/tagged-rep
-constant: obj ;
+constant: obj/tagged-rep ;
! These two are inserted by representation selection
INSN: ##load-tagged
def: dst/tagged-rep
-constant: val ;
+constant: val/tagged-rep ;
INSN: ##load-double
def: dst/double-rep
-constant: val ;
+constant: val/double-rep ;
! Stack operations
INSN: ##peek
PURE-INSN: ##add-imm
def: dst/int-rep
use: src1/int-rep
-constant: src2 ;
+constant: src2/int-rep ;
PURE-INSN: ##sub
def: dst/int-rep
PURE-INSN: ##sub-imm
def: dst/int-rep
use: src1/int-rep
-constant: src2 ;
+constant: src2/int-rep ;
PURE-INSN: ##mul
def: dst/int-rep
PURE-INSN: ##mul-imm
def: dst/int-rep
use: src1/int-rep
-constant: src2 ;
+constant: src2/int-rep ;
PURE-INSN: ##and
def: dst/int-rep
PURE-INSN: ##and-imm
def: dst/int-rep
use: src1/int-rep
-constant: src2 ;
+constant: src2/int-rep ;
PURE-INSN: ##or
def: dst/int-rep
PURE-INSN: ##or-imm
def: dst/int-rep
use: src1/int-rep
-constant: src2 ;
+constant: src2/int-rep ;
PURE-INSN: ##xor
def: dst/int-rep
PURE-INSN: ##xor-imm
def: dst/int-rep
use: src1/int-rep
-constant: src2 ;
+constant: src2/int-rep ;
PURE-INSN: ##shl
def: dst/int-rep
PURE-INSN: ##shl-imm
def: dst/int-rep
use: src1/int-rep
-constant: src2 ;
+constant: src2/int-rep ;
PURE-INSN: ##shr
def: dst/int-rep
PURE-INSN: ##shr-imm
def: dst/int-rep
use: src1/int-rep
-constant: src2 ;
+constant: src2/int-rep ;
PURE-INSN: ##sar
def: dst/int-rep
PURE-INSN: ##sar-imm
def: dst/int-rep
use: src1/int-rep
-constant: src2 ;
+constant: src2/int-rep ;
PURE-INSN: ##min
def: dst/int-rep
def: dst
literal: inputs ;
-! Conditionals
+! Tagged conditionals
INSN: ##compare-branch
use: src1/tagged-rep src2/tagged-rep
literal: cc ;
INSN: ##compare-imm-branch
use: src1/tagged-rep
-constant: src2
+constant: src2/tagged-rep
literal: cc ;
PURE-INSN: ##compare
PURE-INSN: ##compare-imm
def: dst/tagged-rep
use: src1/tagged-rep
-constant: src2
+constant: src2/tagged-rep
+literal: cc
+temp: temp/int-rep ;
+
+! Integer conditionals
+INSN: ##compare-integer-branch
+use: src1/int-rep src2/int-rep
+literal: cc ;
+
+INSN: ##compare-integer-imm-branch
+use: src1/int-rep
+constant: src2/int-rep
+literal: cc ;
+
+PURE-INSN: ##compare-integer
+def: dst/tagged-rep
+use: src1/int-rep src2/int-rep
literal: cc
temp: temp/int-rep ;
+PURE-INSN: ##compare-integer-imm
+def: dst/tagged-rep
+use: src1/int-rep
+constant: src2/int-rep
+literal: cc
+temp: temp/int-rep ;
+
+! Float conditionals
INSN: ##compare-float-ordered-branch
use: src1/double-rep src2/double-rep
literal: cc ;
INSN: _loop-entry ;
INSN: _dispatch
-use: src/int-rep
+use: src
temp: temp ;
INSN: _dispatch-label
INSN: _compare-branch
literal: label
-use: src1/tagged-rep src2/tagged-rep
+use: src1 src2
literal: cc ;
INSN: _compare-imm-branch
literal: label
-use: src1/tagged-rep
+use: src1
constant: src2
literal: cc ;
INSN: _compare-float-unordered-branch
literal: label
-use: src1/tagged-rep src2/tagged-rep
+use: src1 src2
literal: cc ;
INSN: _compare-float-ordered-branch
literal: label
-use: src1/tagged-rep src2/tagged-rep
+use: src1 src2
literal: cc ;
! Overflowing arithmetic
INSN: _fixnum-add
literal: label
-def: dst/tagged-rep
-use: src1/tagged-rep src2/tagged-rep ;
+def: dst
+use: src1 src2 ;
INSN: _fixnum-sub
literal: label
-def: dst/tagged-rep
-use: src1/tagged-rep src2/tagged-rep ;
+def: dst
+use: src1 src2 ;
INSN: _fixnum-mul
literal: label
-def: dst/tagged-rep
-use: src1/tagged-rep src2/int-rep ;
+def: dst
+use: src1 src2 ;
TUPLE: spill-slot { n integer } ;
C: <spill-slot> spill-slot
-! These instructions operate on machine registers and not
-! virtual registers
INSN: _spill
use: src
literal: rep dst ;
INSN: _spill-area-size
literal: n ;
+! For GC check insertion
UNION: ##allocation
##allot
##box-alien
: emit-<displaced-alien> ( node -- )
dup emit-<displaced-alien>? [
- [ 2inputs ] dip
- node-input-infos second class>>
- ^^box-displaced-alien ds-push
+ '[
+ _ node-input-infos second class>>
+ ^^box-displaced-alien
+ ] binary-op
] [ emit-primitive ] if ;
:: inline-alien ( node quot test -- )
: prepare-alien-setter ( infos -- ptr-vreg offset )
second prepare-alien-accessor ;
-: inline-alien-setter ( node quot -- )
+: inline-alien-integer-setter ( node quot -- )
'[ prepare-alien-setter ds-pop @ ]
[ fixnum inline-alien-setter? ]
inline-alien ; inline
+: inline-alien-float-setter ( node quot -- )
+ '[ prepare-alien-setter ds-pop @ ]
+ [ float inline-alien-setter? ]
+ inline-alien ; inline
+
: inline-alien-cell-setter ( node quot -- )
'[ [ prepare-alien-setter ds-pop ] [ first class>> ] bi ^^unbox-c-ptr @ ]
[ pinned-c-ptr inline-alien-setter? ]
{ 2 [ ##set-alien-integer-2 ] }
{ 4 [ ##set-alien-integer-4 ] }
} case
- ] inline-alien-setter ;
+ ] inline-alien-integer-setter ;
: emit-alien-cell-getter ( node -- )
[ ^^alien-cell ^^box-alien ] inline-alien-getter ;
{ float-rep [ ##set-alien-float ] }
{ double-rep [ ##set-alien-double ] }
} case
- ] inline-alien-setter ;
+ ] inline-alien-float-setter ;
IN: compiler.cfg.intrinsics.fixnum
: emit-both-fixnums? ( -- )
- 2inputs
- ^^or
- tag-mask get ^^and-imm
- 0 cc= ^^compare-imm
- ds-push ;
-
-: binary-fixnum-op ( quot -- )
- [ 2inputs ] dip call ds-push ; inline
-
-: unary-fixnum-op ( quot -- )
- [ ds-pop ] dip call ds-push ; inline
+ [
+ [ ^^tagged>integer ] bi@
+ ^^or tag-mask get ^^and-imm
+ 0 cc= ^^compare-integer-imm
+ ] binary-op ;
: emit-fixnum-left-shift ( -- )
- [ ^^shl ] binary-fixnum-op ;
+ [ ^^shl ] binary-op ;
: emit-fixnum-right-shift ( -- )
- [ ^^sar ] binary-fixnum-op ;
+ [
+ [ tag-bits get ^^shl-imm ] dip
+ ^^neg ^^sar
+ tag-bits get ^^sar-imm
+ ] binary-op ;
: emit-fixnum-shift-general ( -- )
- ds-peek 0 cc> ##compare-imm-branch
+ ds-peek 0 cc> ##compare-integer-imm-branch
[ emit-fixnum-left-shift ] with-branch
[ emit-fixnum-right-shift ] with-branch
2array emit-conditional ;
} cond ;
: emit-fixnum-comparison ( cc -- )
- '[ _ ^^compare ] binary-fixnum-op ;
+ '[ _ ^^compare-integer ] binary-op ;
: emit-no-overflow-case ( dst -- final-bb )
[ ds-drop ds-drop ds-push ] with-branch ;
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel compiler.cfg.stacks compiler.cfg.hats
+USING: fry kernel compiler.cfg.stacks compiler.cfg.hats
compiler.cfg.instructions compiler.cfg.utilities ;
IN: compiler.cfg.intrinsics.float
-: emit-float-op ( insn -- )
- [ 2inputs ] dip call ds-push ; inline
-
: emit-float-ordered-comparison ( cc -- )
- [ 2inputs ] dip ^^compare-float-ordered ds-push ; inline
+ '[ _ ^^compare-float-ordered ] binary-op ; inline
: emit-float-unordered-comparison ( cc -- )
- [ 2inputs ] dip ^^compare-float-unordered ds-push ; inline
-
-: emit-float>fixnum ( -- )
- ds-pop ^^float>integer ds-push ;
-
-: emit-fixnum>float ( -- )
- ds-pop ^^integer>float ds-push ;
-
-: emit-fsqrt ( -- )
- ds-pop ^^sqrt ds-push ;
+ '[ _ ^^compare-float-unordered ] binary-op ; inline
: emit-unary-float-function ( func -- )
- [ ds-pop ] dip ^^unary-float-function ds-push ;
+ '[ _ ^^unary-float-function ] unary-op ;
: emit-binary-float-function ( func -- )
- [ 2inputs ] dip ^^binary-float-function ds-push ;
+ '[ _ ^^binary-float-function ] binary-op ;
! See http://factorcode.org/license.txt for BSD license.
USING: words sequences kernel combinators cpu.architecture assocs
compiler.cfg.hats
+compiler.cfg.stacks
compiler.cfg.instructions
compiler.cfg.intrinsics.alien
compiler.cfg.intrinsics.allot
{ math.private:fixnum+ [ drop emit-fixnum+ ] }
{ math.private:fixnum- [ drop emit-fixnum- ] }
{ math.private:fixnum* [ drop emit-fixnum* ] }
- { math.private:fixnum+fast [ drop [ ^^add ] binary-fixnum-op ] }
- { math.private:fixnum-fast [ drop [ ^^sub ] binary-fixnum-op ] }
- { math.private:fixnum*fast [ drop [ ^^mul ] binary-fixnum-op ] }
- { math.private:fixnum-bitand [ drop [ ^^and ] binary-fixnum-op ] }
- { math.private:fixnum-bitor [ drop [ ^^or ] binary-fixnum-op ] }
- { math.private:fixnum-bitxor [ drop [ ^^xor ] binary-fixnum-op ] }
+ { math.private:fixnum+fast [ drop [ ^^add ] binary-op ] }
+ { math.private:fixnum-fast [ drop [ ^^sub ] binary-op ] }
+ { math.private:fixnum*fast [ drop [ ^^mul ] binary-op ] }
+ { math.private:fixnum-bitand [ drop [ ^^and ] binary-op ] }
+ { math.private:fixnum-bitor [ drop [ ^^or ] binary-op ] }
+ { math.private:fixnum-bitxor [ drop [ ^^xor ] binary-op ] }
{ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] }
- { math.private:fixnum-bitnot [ drop [ ^^not ] unary-fixnum-op ] }
+ { math.private:fixnum-bitnot [ drop [ ^^not ] unary-op ] }
{ math.private:fixnum< [ drop cc< emit-fixnum-comparison ] }
{ math.private:fixnum<= [ drop cc<= emit-fixnum-comparison ] }
{ math.private:fixnum>= [ drop cc>= emit-fixnum-comparison ] }
{ math.private:fixnum> [ drop cc> emit-fixnum-comparison ] }
- { kernel:eq? [ drop cc= emit-fixnum-comparison ] }
+ { kernel:eq? [ emit-eq ] }
{ slots.private:slot [ emit-slot ] }
{ slots.private:set-slot [ emit-set-slot ] }
{ strings.private:string-nth [ drop emit-string-nth ] }
: enable-float-intrinsics ( -- )
{
- { math.private:float+ [ drop [ ^^add-float ] emit-float-op ] }
- { math.private:float- [ drop [ ^^sub-float ] emit-float-op ] }
- { math.private:float* [ drop [ ^^mul-float ] emit-float-op ] }
- { math.private:float/f [ drop [ ^^div-float ] emit-float-op ] }
+ { math.private:float+ [ drop [ ^^add-float ] binary-op ] }
+ { math.private:float- [ drop [ ^^sub-float ] binary-op ] }
+ { math.private:float* [ drop [ ^^mul-float ] binary-op ] }
+ { math.private:float/f [ drop [ ^^div-float ] binary-op ] }
{ math.private:float< [ drop cc< emit-float-ordered-comparison ] }
{ math.private:float<= [ drop cc<= emit-float-ordered-comparison ] }
{ math.private:float>= [ drop cc>= emit-float-ordered-comparison ] }
{ math.private:float-u>= [ drop cc>= emit-float-unordered-comparison ] }
{ math.private:float-u> [ drop cc> emit-float-unordered-comparison ] }
{ math.private:float= [ drop cc= emit-float-unordered-comparison ] }
- { math.private:float>fixnum [ drop emit-float>fixnum ] }
- { math.private:fixnum>float [ drop emit-fixnum>float ] }
+ { math.private:float>fixnum [ drop [ ^^float>integer ] unary-op ] }
+ { math.private:fixnum>float [ drop [ ^^integer>float ] unary-op ] }
{ math.floats.private:float-unordered? [ drop cc/<>= emit-float-unordered-comparison ] }
{ alien.accessors:alien-float [ float-rep emit-alien-float-getter ] }
{ alien.accessors:set-alien-float [ float-rep emit-alien-float-setter ] }
: enable-fsqrt ( -- )
{
- { math.libm:fsqrt [ drop emit-fsqrt ] }
+ { math.libm:fsqrt [ drop [ ^^sqrt ] unary-op ] }
} enable-intrinsics ;
: enable-float-min/max ( -- )
{
- { math.floats.private:float-min [ drop [ ^^min-float ] emit-float-op ] }
- { math.floats.private:float-max [ drop [ ^^max-float ] emit-float-op ] }
+ { math.floats.private:float-min [ drop [ ^^min-float ] binary-op ] }
+ { math.floats.private:float-max [ drop [ ^^max-float ] binary-op ] }
} enable-intrinsics ;
: enable-float-functions ( -- )
: enable-min/max ( -- )
{
- { math.integers.private:fixnum-min [ drop [ ^^min ] binary-fixnum-op ] }
- { math.integers.private:fixnum-max [ drop [ ^^max ] binary-fixnum-op ] }
+ { math.integers.private:fixnum-min [ drop [ ^^min ] binary-op ] }
+ { math.integers.private:fixnum-max [ drop [ ^^max ] binary-op ] }
} enable-intrinsics ;
: enable-log2 ( -- )
{
- { math.integers.private:fixnum-log2 [ drop [ ^^log2 ] unary-fixnum-op ] }
+ { math.integers.private:fixnum-log2 [ drop [ ^^log2 ] unary-op ] }
} enable-intrinsics ;
: emit-intrinsic ( node word -- )
! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces layouts sequences kernel math accessors
-compiler.tree.propagation.info compiler.cfg.stacks
-compiler.cfg.hats compiler.cfg.instructions
+USING: accessors classes.algebra layouts kernel math namespaces
+sequences
+compiler.tree.propagation.info
+compiler.cfg.stacks
+compiler.cfg.hats
+compiler.cfg.comparisons
+compiler.cfg.instructions
compiler.cfg.builder.blocks
compiler.cfg.utilities ;
FROM: vm => context-field-offset vm-field-offset ;
IN: compiler.cfg.intrinsics.misc
: emit-tag ( -- )
- ds-pop ^^tagged>integer tag-mask get ^^and-imm ds-push ;
+ [ ^^tagged>integer tag-mask get ^^and-imm ] unary-op ;
+
+: emit-eq ( node -- )
+ node-input-infos first2 [ class>> fixnum class<= ] both?
+ [ [ cc= ^^compare-integer ] binary-op ] [ [ cc= ^^compare ] binary-op ] if ;
: special-object-offset ( n -- offset )
cells "special-objects" vm-field-offset + ;
] [ emit-primitive ] ?if ;
: emit-identity-hashcode ( -- )
- ds-pop ^^tagged>integer
- tag-mask get bitnot ^^load-integer ^^and
- 0 ^^alien-cell
- hashcode-shift ^^shr-imm
- ds-push ;
+ [
+ ^^tagged>integer
+ tag-mask get bitnot ^^load-integer ^^and
+ 0 ^^alien-cell
+ hashcode-shift ^^shr-imm
+ ] unary-op ;
M: ##compare-imm-branch linearize-insn
binary-conditional _compare-imm-branch emit-branch ;
+M: ##compare-integer-branch linearize-insn
+ binary-conditional _compare-branch emit-branch ;
+
+M: ##compare-integer-imm-branch linearize-insn
+ binary-conditional _compare-imm-branch emit-branch ;
+
M: ##compare-float-ordered-branch linearize-insn
binary-conditional _compare-float-ordered-branch emit-branch ;
M: insn prepare-insn
[ defs-vreg ] [ uses-vregs ] bi
2dup empty? not and [
- first
+ first
2dup [ rep-of ] bi@ eq?
[ try-to-coalesce ] [ 2drop ] if
] [ 2drop ] if ;
: 3inputs ( -- vreg1 vreg2 vreg3 )
(3inputs) -3 inc-d ;
+: binary-op ( quot -- )
+ [ 2inputs ] dip call ds-push ; inline
+
+: unary-op ( quot -- )
+ [ ds-pop ] dip call ds-push ; inline
+
! adjust-d/adjust-r: these are called when other instructions which
! internally adjust the stack height are emitted, such as ##call and
! ##alien-invoke
: adjust-d ( n -- ) current-height get [ + ] change-d drop ;
: adjust-r ( n -- ) current-height get [ + ] change-r drop ;
-
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors sequences math combinators combinators.short-circuit
-classes vectors compiler.cfg compiler.cfg.instructions compiler.cfg.rpo
+USING: kernel accessors sequences math combinators
+combinators.short-circuit vectors compiler.cfg
+compiler.cfg.instructions compiler.cfg.rpo
compiler.cfg.utilities ;
IN: compiler.cfg.useless-conditionals
: delete-conditional? ( bb -- ? )
{
[
- instructions>> last class {
- ##compare-branch
- ##compare-imm-branch
- ##compare-float-ordered-branch
- ##compare-float-unordered-branch
- } member-eq?
+ instructions>> last {
+ [ ##compare-branch? ]
+ [ ##compare-imm-branch? ]
+ [ ##compare-integer-branch? ]
+ [ ##compare-integer-imm-branch? ]
+ [ ##compare-float-ordered-branch? ]
+ [ ##compare-float-unordered-branch? ]
+ } 1||
]
[ successors>> first2 [ skip-empty-blocks ] bi@ eq? ]
} 1&& ;
compiler.cfg.value-numbering.rewrite ;
IN: compiler.cfg.value-numbering.comparisons
-: ##branch-t? ( insn -- ? )
- dup ##compare-imm-branch? [
- { [ cc>> cc/= eq? ] [ src2>> not ] } 1&&
- ] [ drop f ] if ; inline
+! Optimizations performed here:
+!
+! 1) Eliminating intermediate boolean values when the result of
+! a comparison is used by a compare-branch
+! 2) Folding comparisons where both inputs are literal
+! 3) Folding comparisons where both inputs are congruent
+! 4) Converting compare instructions into compare-imm instructions
-: scalar-compare-expr? ( insn -- ? )
- {
- [ compare-expr? ]
- [ compare-imm-expr? ]
- [ compare-float-unordered-expr? ]
- [ compare-float-ordered-expr? ]
- } 1|| ;
+: fold-compare-imm? ( insn -- ? )
+ src1>> vreg>expr literal-expr? ;
-: general-compare-expr? ( insn -- ? )
+: evaluate-compare-imm ( insn -- ? )
+ [ src1>> vreg>comparand ] [ src2>> ] [ cc>> ] tri
{
- [ scalar-compare-expr? ]
- [ test-vector-expr? ]
- } 1|| ;
+ { cc= [ eq? ] }
+ { cc/= [ eq? not ] }
+ } case ;
+
+: fold-compare-integer-imm? ( insn -- ? )
+ src1>> vreg>expr integer-expr? ;
+
+: evaluate-compare-integer-imm ( insn -- ? )
+ [ src1>> vreg>integer ] [ src2>> ] [ cc>> ] tri
+ [ <=> ] dip evaluate-cc ;
-: rewrite-boolean-comparison? ( insn -- ? )
- dup ##branch-t? [
- src1>> vreg>expr general-compare-expr?
- ] [ drop f ] if ; inline
-
: >compare-expr< ( expr -- in1 in2 cc )
[ src1>> vn>vreg ] [ src2>> vn>vreg ] [ cc>> ] tri ; inline
: >compare-imm-expr< ( expr -- in1 in2 cc )
+ [ src1>> vn>vreg ] [ src2>> vn>comparand ] [ cc>> ] tri ; inline
+
+: >compare-integer-expr< ( expr -- in1 in2 cc )
+ [ src1>> vn>vreg ] [ src2>> vn>vreg ] [ cc>> ] tri ; inline
+
+: >compare-integer-imm-expr< ( expr -- in1 in2 cc )
[ src1>> vn>vreg ] [ src2>> vn>integer ] [ cc>> ] tri ; inline
: >test-vector-expr< ( expr -- src1 temp rep vcc )
[ vcc>> ]
} cleave ; inline
+: scalar-compare-expr? ( insn -- ? )
+ {
+ [ compare-expr? ]
+ [ compare-imm-expr? ]
+ [ compare-integer-expr? ]
+ [ compare-integer-imm-expr? ]
+ [ compare-float-unordered-expr? ]
+ [ compare-float-ordered-expr? ]
+ } 1|| ;
+
+: general-compare-expr? ( insn -- ? )
+ {
+ [ scalar-compare-expr? ]
+ [ test-vector-expr? ]
+ } 1|| ;
+
+: rewrite-boolean-comparison? ( insn -- ? )
+ {
+ [ src1>> vreg>expr general-compare-expr? ]
+ [ src2>> not ]
+ [ cc>> cc/= eq? ]
+ } 1&& ; inline
+
: rewrite-boolean-comparison ( expr -- insn )
src1>> vreg>expr {
{ [ dup compare-expr? ] [ >compare-expr< \ ##compare-branch new-insn ] }
{ [ dup compare-imm-expr? ] [ >compare-imm-expr< \ ##compare-imm-branch new-insn ] }
+ { [ dup compare-integer-expr? ] [ >compare-integer-expr< \ ##compare-integer-branch new-insn ] }
+ { [ dup compare-integer-imm-expr? ] [ >compare-integer-imm-expr< \ ##compare-integer-imm-branch new-insn ] }
{ [ dup compare-float-unordered-expr? ] [ >compare-expr< \ ##compare-float-unordered-branch new-insn ] }
{ [ dup compare-float-ordered-expr? ] [ >compare-expr< \ ##compare-float-ordered-branch new-insn ] }
{ [ dup test-vector-expr? ] [ >test-vector-expr< \ ##test-vector-branch new-insn ] }
} cond ;
-: rewrite-redundant-comparison? ( insn -- ? )
- {
- [ src1>> vreg>expr scalar-compare-expr? ]
- [ src2>> not ]
- [ cc>> { cc= cc/= } member? ]
- } 1&& ; inline
-
-: rewrite-redundant-comparison ( insn -- insn' )
- [ cc>> ] [ dst>> ] [ src1>> vreg>expr ] tri {
- { [ dup compare-expr? ] [ >compare-expr< next-vreg \ ##compare new-insn ] }
- { [ dup compare-imm-expr? ] [ >compare-imm-expr< next-vreg \ ##compare-imm new-insn ] }
- { [ dup compare-float-unordered-expr? ] [ >compare-expr< next-vreg \ ##compare-float-unordered new-insn ] }
- { [ dup compare-float-ordered-expr? ] [ >compare-expr< next-vreg \ ##compare-float-ordered new-insn ] }
- } cond
- swap cc= eq? [ [ negate-cc ] change-cc ] when ;
-
-: evaluate-compare-imm ( insn -- ? )
- [ src1>> vreg>comparand ] [ src2>> ] [ cc>> ] tri
- 2over [ integer? ] both? [ [ <=> ] dip evaluate-cc ] [
- {
- { cc= [ eq? ] }
- { cc/= [ eq? not ] }
- } case
- ] if ;
-
-: fold-compare-imm? ( insn -- ? )
- src1>> vreg>expr literal-expr? ;
-
: fold-branch ( ? -- insn )
0 1 ?
basic-block get [ nth 1vector ] change-successors drop
[ drop f ]
} cond ;
+: fold-compare-integer-imm-branch ( insn -- insn/f )
+ evaluate-compare-integer-imm fold-branch ;
+
+M: ##compare-integer-imm-branch rewrite
+ {
+ { [ dup fold-compare-integer-imm? ] [ fold-compare-integer-imm-branch ] }
+ [ drop f ]
+ } cond ;
+
: swap-compare ( src1 src2 cc swap? -- src1 src2 cc )
[ [ swap ] dip swap-cc ] when ; inline
+: (>compare-imm-branch) ( insn swap? -- src1 src2 cc )
+ [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] dip swap-compare ; inline
+
: >compare-imm-branch ( insn swap? -- insn' )
- [
- [ src1>> ]
- [ src2>> ]
- [ cc>> ]
- tri
- ] dip
- swap-compare
+ (>compare-imm-branch)
[ vreg>comparand ] dip
\ ##compare-imm-branch new-insn ; inline
+: >compare-integer-imm-branch ( insn swap? -- insn' )
+ (>compare-imm-branch)
+ [ vreg>integer ] dip
+ \ ##compare-integer-imm-branch new-insn ; inline
+
: self-compare? ( insn -- ? )
[ src1>> ] [ src2>> ] bi [ vreg>vn ] bi@ = ; inline
[ drop f ]
} cond ;
+M: ##compare-integer-branch rewrite
+ {
+ { [ dup src1>> vreg-immediate-arithmetic? ] [ t >compare-integer-imm-branch ] }
+ { [ dup src2>> vreg-immediate-arithmetic? ] [ f >compare-integer-imm-branch ] }
+ { [ dup self-compare? ] [ rewrite-self-compare-branch ] }
+ [ drop f ]
+ } cond ;
+
+: (>compare-imm) ( insn swap? -- dst src1 src2 cc )
+ [ { [ dst>> ] [ src1>> ] [ src2>> ] [ cc>> ] } cleave ] dip
+ swap-compare ; inline
+
: >compare-imm ( insn swap? -- insn' )
- [
- {
- [ dst>> ]
- [ src1>> ]
- [ src2>> ]
- [ cc>> ]
- } cleave
- ] dip
- swap-compare
+ (>compare-imm)
[ vreg>comparand ] dip
next-vreg \ ##compare-imm new-insn ; inline
+: >compare-integer-imm ( insn swap? -- insn' )
+ (>compare-imm)
+ [ vreg>integer ] dip
+ next-vreg \ ##compare-integer-imm new-insn ; inline
+
: >boolean-insn ( insn ? -- insn' )
[ dst>> ] dip \ ##load-reference new-insn ;
[ drop f ]
} cond ;
+M: ##compare-integer rewrite
+ {
+ { [ dup src1>> vreg-immediate-arithmetic? ] [ t >compare-integer-imm ] }
+ { [ dup src2>> vreg-immediate-arithmetic? ] [ f >compare-integer-imm ] }
+ { [ dup self-compare? ] [ rewrite-self-compare ] }
+ [ drop f ]
+ } cond ;
+
+: rewrite-redundant-comparison? ( insn -- ? )
+ {
+ [ src1>> vreg>expr scalar-compare-expr? ]
+ [ src2>> not ]
+ [ cc>> { cc= cc/= } member? ]
+ } 1&& ; inline
+
+: rewrite-redundant-comparison ( insn -- insn' )
+ [ cc>> ] [ dst>> ] [ src1>> vreg>expr ] tri {
+ { [ dup compare-expr? ] [ >compare-expr< next-vreg \ ##compare new-insn ] }
+ { [ dup compare-imm-expr? ] [ >compare-imm-expr< next-vreg \ ##compare-imm new-insn ] }
+ { [ dup compare-integer-expr? ] [ >compare-integer-expr< next-vreg \ ##compare-integer new-insn ] }
+ { [ dup compare-integer-imm-expr? ] [ >compare-integer-imm-expr< next-vreg \ ##compare-integer-imm new-insn ] }
+ { [ dup compare-float-unordered-expr? ] [ >compare-expr< next-vreg \ ##compare-float-unordered new-insn ] }
+ { [ dup compare-float-ordered-expr? ] [ >compare-expr< next-vreg \ ##compare-float-ordered new-insn ] }
+ } cond
+ swap cc= eq? [ [ negate-cc ] change-cc ] when ;
+
: fold-compare-imm ( insn -- insn' )
dup evaluate-compare-imm >boolean-insn ;
{ [ dup fold-compare-imm? ] [ fold-compare-imm ] }
[ drop f ]
} cond ;
+
+: fold-compare-integer-imm ( insn -- insn' )
+ dup evaluate-compare-integer-imm >boolean-insn ;
+
+M: ##compare-integer-imm rewrite
+ {
+ { [ dup fold-compare-integer-imm? ] [ fold-compare-integer-imm ] }
+ [ drop f ]
+ } cond ;
! See http://factorcode.org/license.txt for BSD license.
USING: accessors classes classes.algebra classes.parser
classes.tuple combinators combinators.short-circuit fry
-generic.parser kernel layouts locals math namespaces quotations
+generic.parser kernel layouts math namespaces quotations
sequences slots splitting words
cpu.architecture
compiler.cfg.instructions
: vreg-immediate-arithmetic? ( vreg -- ? )
vreg>expr {
[ integer-expr? ]
- [ expr>integer tag-fixnum immediate-arithmetic? ]
+ [ expr>integer immediate-arithmetic? ]
} 1&& ;
: vreg-immediate-bitwise? ( vreg -- ? )
vreg>expr {
[ integer-expr? ]
- [ expr>integer tag-fixnum immediate-bitwise? ]
+ [ expr>integer immediate-bitwise? ]
} 1&& ;
GENERIC: expr>comparand ( expr -- n )
-M: integer-expr expr>comparand value>> ;
+M: integer-expr expr>comparand value>> tag-fixnum ;
M: reference-expr expr>comparand value>> ;
: define-expr-class ( expr slot-specs -- )
[ expr ] dip [ name>> ] map define-tuple-class ;
-: constant>vn ( obj -- vn )
- dup integer? [ <integer-expr> ] [ <reference-expr> ] if
- expr>vn ;
+: constant-quot ( rep -- quot )
+ {
+ { int-rep [ [ <integer-expr> ] ] }
+ { tagged-rep [ [ <reference-expr> ] ] }
+ } case [ expr>vn ] append ;
: >expr-quot ( expr slot-specs -- quot )
[
[ name>> reader-word 1quotation ]
[
- type>> {
- { use [ [ vreg>vn ] ] }
- { literal [ [ ] ] }
- { constant [ [ constant>vn ] ] }
+ [ rep>> ] [ type>> ] bi {
+ { use [ drop [ vreg>vn ] ] }
+ { literal [ drop [ ] ] }
+ { constant [ constant-quot ] }
} case
] bi append
] map cleave>quot swap suffix \ boa suffix ;
dup {
[ ##compare? ]
[ ##compare-imm? ]
+ [ ##compare-integer? ]
+ [ ##compare-integer-imm? ]
[ ##compare-float-unordered? ]
[ ##compare-float-ordered? ]
[ ##test-vector? ]
! Double compare elimination
[
{
- T{ ##load-reference f 1 "hi" }
- T{ ##peek f 2 D 0 }
- T{ ##compare f 4 2 1 cc> }
+ T{ ##peek f 1 D 1 }
+ T{ ##peek f 2 D 2 }
+ T{ ##compare f 4 2 1 cc= }
T{ ##copy f 6 4 any-rep }
T{ ##replace f 6 D 0 }
}
] [
{
- T{ ##load-reference f 1 "hi" }
- T{ ##peek f 2 D 0 }
- T{ ##compare f 4 2 1 cc> }
+ T{ ##peek f 1 D 1 }
+ T{ ##peek f 2 D 2 }
+ T{ ##compare f 4 2 1 cc= }
T{ ##compare-imm f 6 4 f cc/= }
T{ ##replace f 6 D 0 }
} value-numbering-step trim-temps
[
{
- T{ ##load-reference f 1 "hi" }
- T{ ##peek f 2 D 0 }
- T{ ##compare f 4 2 1 cc<= }
- T{ ##compare f 6 2 1 cc/<= }
+ T{ ##peek f 1 D 1 }
+ T{ ##compare-imm f 2 1 16 cc= }
+ T{ ##copy f 3 2 any-rep }
+ T{ ##replace f 3 D 0 }
+ }
+] [
+ {
+ T{ ##peek f 1 D 1 }
+ T{ ##compare-imm f 2 1 16 cc= }
+ T{ ##compare-imm f 3 2 f cc/= }
+ T{ ##replace f 3 D 0 }
+ } value-numbering-step trim-temps
+] unit-test
+
+[
+ {
+ T{ ##peek f 1 D 1 }
+ T{ ##peek f 2 D 2 }
+ T{ ##compare-integer f 4 2 1 cc> }
+ T{ ##copy f 6 4 any-rep }
T{ ##replace f 6 D 0 }
}
] [
{
- T{ ##load-reference f 1 "hi" }
- T{ ##peek f 2 D 0 }
- T{ ##compare f 4 2 1 cc<= }
+ T{ ##peek f 1 D 1 }
+ T{ ##peek f 2 D 2 }
+ T{ ##compare-integer f 4 2 1 cc> }
+ T{ ##compare-imm f 6 4 f cc/= }
+ T{ ##replace f 6 D 0 }
+ } value-numbering-step trim-temps
+] unit-test
+
+[
+ {
+ T{ ##peek f 1 D 1 }
+ T{ ##peek f 2 D 2 }
+ T{ ##compare-integer f 4 2 1 cc<= }
+ T{ ##compare-integer f 6 2 1 cc/<= }
+ T{ ##replace f 6 D 0 }
+ }
+] [
+ {
+ T{ ##peek f 1 D 1 }
+ T{ ##peek f 2 D 2 }
+ T{ ##compare-integer f 4 2 1 cc<= }
T{ ##compare-imm f 6 4 f cc= }
T{ ##replace f 6 D 0 }
} value-numbering-step trim-temps
] unit-test
+[
+ {
+ T{ ##peek f 1 D 1 }
+ T{ ##compare-integer-imm f 2 1 100 cc<= }
+ T{ ##compare-integer-imm f 3 1 100 cc/<= }
+ T{ ##replace f 3 D 0 }
+ }
+] [
+ {
+ T{ ##peek f 1 D 1 }
+ T{ ##compare-integer-imm f 2 1 100 cc<= }
+ T{ ##compare-imm f 3 2 f cc= }
+ T{ ##replace f 3 D 0 }
+ } value-numbering-step trim-temps
+] unit-test
+
[
{
T{ ##peek f 8 D 0 }
{
T{ ##peek f 29 D -1 }
T{ ##peek f 30 D -2 }
- T{ ##compare f 33 29 30 cc<= }
- T{ ##compare-branch f 29 30 cc<= }
+ T{ ##compare f 33 29 30 cc= }
+ T{ ##compare-branch f 29 30 cc= }
}
] [
{
T{ ##peek f 29 D -1 }
T{ ##peek f 30 D -2 }
- T{ ##compare f 33 29 30 cc<= }
+ T{ ##compare f 33 29 30 cc= }
+ T{ ##compare-imm-branch f 33 f cc/= }
+ } value-numbering-step trim-temps
+] unit-test
+
+[
+ {
+ T{ ##peek f 29 D -1 }
+ T{ ##peek f 30 D -2 }
+ T{ ##compare-integer f 33 29 30 cc<= }
+ T{ ##compare-integer-branch f 29 30 cc<= }
+ }
+] [
+ {
+ T{ ##peek f 29 D -1 }
+ T{ ##peek f 30 D -2 }
+ T{ ##compare-integer f 33 29 30 cc<= }
T{ ##compare-imm-branch f 33 f cc/= }
} value-numbering-step trim-temps
] unit-test
} value-numbering-step trim-temps
] unit-test
+cpu x86.32? [
+ [
+ {
+ T{ ##peek f 1 D 0 }
+ T{ ##compare-imm f 2 1 + cc= }
+ T{ ##compare-imm-branch f 1 + cc= }
+ }
+ ] [
+ {
+ T{ ##peek f 1 D 0 }
+ T{ ##compare-imm f 2 1 + cc= }
+ T{ ##compare-imm-branch f 2 f cc/= }
+ } value-numbering-step trim-temps
+ ] unit-test
+] when
+
! Immediate operand fusion
[
{
{
T{ ##peek f 0 D 0 }
T{ ##load-integer f 1 100 }
- T{ ##compare-imm f 2 0 100 cc<= }
+ T{ ##compare-imm f 2 0 $[ 100 tag-fixnum ] cc= }
+ }
+] [
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-integer f 1 100 }
+ T{ ##compare f 2 0 1 cc= }
+ } value-numbering-step trim-temps
+] unit-test
+
+[
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-integer f 1 100 }
+ T{ ##compare-integer-imm f 2 0 100 cc<= }
}
] [
{
T{ ##peek f 0 D 0 }
T{ ##load-integer f 1 100 }
- T{ ##compare f 2 0 1 cc<= }
+ T{ ##compare-integer f 2 0 1 cc<= }
} value-numbering-step trim-temps
] unit-test
{
T{ ##peek f 0 D 0 }
T{ ##load-integer f 1 100 }
- T{ ##compare-imm f 2 0 100 cc>= }
+ T{ ##compare-integer-imm f 2 0 100 cc>= }
}
] [
{
T{ ##peek f 0 D 0 }
T{ ##load-integer f 1 100 }
- T{ ##compare f 2 1 0 cc<= }
+ T{ ##compare-integer f 2 1 0 cc<= }
} value-numbering-step trim-temps
] unit-test
{
T{ ##peek f 0 D 0 }
T{ ##load-integer f 1 100 }
- T{ ##compare-imm-branch f 0 100 cc<= }
+ T{ ##compare-integer-imm-branch f 0 100 cc<= }
}
] [
{
T{ ##peek f 0 D 0 }
T{ ##load-integer f 1 100 }
- T{ ##compare-branch f 0 1 cc<= }
+ T{ ##compare-integer-branch f 0 1 cc<= }
} value-numbering-step
] unit-test
{
T{ ##peek f 0 D 0 }
T{ ##load-integer f 1 100 }
- T{ ##compare-imm-branch f 0 100 cc>= }
+ T{ ##compare-integer-imm-branch f 0 100 cc>= }
}
] [
{
T{ ##peek f 0 D 0 }
T{ ##load-integer f 1 100 }
- T{ ##compare-branch f 1 0 cc<= }
+ T{ ##compare-integer-branch f 1 0 cc<= }
} value-numbering-step trim-temps
] unit-test
{
T{ ##load-integer f 1 100 }
T{ ##load-integer f 2 200 }
- T{ ##compare f 3 1 2 cc<= }
+ T{ ##compare-integer f 3 1 2 cc<= }
} value-numbering-step trim-temps
] unit-test
{
T{ ##load-integer f 1 100 }
T{ ##load-integer f 2 200 }
- T{ ##compare f 3 1 2 cc= }
+ T{ ##compare-integer f 3 1 2 cc= }
} value-numbering-step trim-temps
] unit-test
] [
{
T{ ##load-integer f 1 100 }
- T{ ##compare-imm f 2 1 f cc= }
- } value-numbering-step trim-temps
-] unit-test
-
-[
- {
- T{ ##load-reference f 1 f }
- T{ ##load-reference f 2 t }
- }
-] [
- {
- T{ ##load-reference f 1 f }
- T{ ##compare-imm f 2 1 f cc= }
+ T{ ##compare-integer-imm f 2 1 123 cc= }
} value-numbering-step trim-temps
] unit-test
{
T{ ##load-integer f 1 10 }
T{ ##load-integer f 2 20 }
- T{ ##compare f 3 1 2 cc= }
+ T{ ##compare-integer f 3 1 2 cc= }
} value-numbering-step
] unit-test
{
T{ ##load-integer f 1 1 }
T{ ##load-integer f 2 2 }
- T{ ##compare f 3 1 2 cc/= }
+ T{ ##compare-integer f 3 1 2 cc/= }
} value-numbering-step
] unit-test
{
T{ ##load-integer f 1 1 }
T{ ##load-integer f 2 2 }
- T{ ##compare f 3 1 2 cc< }
+ T{ ##compare-integer f 3 1 2 cc< }
} value-numbering-step
] unit-test
{
T{ ##load-integer f 1 10 }
T{ ##load-integer f 2 20 }
- T{ ##compare f 3 2 1 cc< }
+ T{ ##compare-integer f 3 2 1 cc< }
} value-numbering-step
] unit-test
] [
{
T{ ##peek f 0 D 0 }
- T{ ##compare f 1 0 0 cc< }
+ T{ ##compare-integer f 1 0 0 cc< }
} value-numbering-step
] unit-test
] [
{
T{ ##peek f 0 D 0 }
- T{ ##compare f 1 0 0 cc<= }
+ T{ ##compare-integer f 1 0 0 cc<= }
} value-numbering-step
] unit-test
] [
{
T{ ##peek f 0 D 0 }
- T{ ##compare f 1 0 0 cc> }
+ T{ ##compare-integer f 1 0 0 cc> }
} value-numbering-step
] unit-test
] [
{
T{ ##peek f 0 D 0 }
- T{ ##compare f 1 0 0 cc>= }
+ T{ ##compare-integer f 1 0 0 cc>= }
} value-numbering-step
] unit-test
] [
{
T{ ##peek f 0 D 0 }
- T{ ##compare f 1 0 0 cc/= }
+ T{ ##compare-integer f 1 0 0 cc/= }
+ } value-numbering-step
+] unit-test
+
+[
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-reference f 1 t }
+ }
+] [
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##compare-integer f 1 0 0 cc= }
+ } value-numbering-step
+] unit-test
+
+[
+ {
+ T{ ##load-integer f 1 10 }
+ T{ ##load-reference f 2 f }
+ }
+] [
+ {
+ T{ ##load-integer f 1 10 }
+ T{ ##compare-imm f 2 1 10 cc= }
} value-numbering-step
] unit-test
+[
+ {
+ T{ ##load-integer f 1 10 }
+ T{ ##load-reference f 2 t }
+ }
+] [
+ {
+ T{ ##load-integer f 1 10 }
+ T{ ##compare-imm f 2 1 $[ 10 tag-fixnum ] cc= }
+ } value-numbering-step
+] unit-test
+
+[
+ {
+ T{ ##load-integer f 1 10 }
+ T{ ##load-reference f 2 t }
+ }
+] [
+ {
+ T{ ##load-integer f 1 10 }
+ T{ ##compare-imm f 2 1 10 cc/= }
+ } value-numbering-step
+] unit-test
+
+[
+ {
+ T{ ##load-integer f 1 10 }
+ T{ ##load-reference f 2 f }
+ }
+] [
+ {
+ T{ ##load-integer f 1 10 }
+ T{ ##compare-imm f 2 1 $[ 10 tag-fixnum ] cc/= }
+ } value-numbering-step
+] unit-test
+
+cpu x86.32? [
+ [
+ {
+ T{ ##load-reference f 1 + }
+ T{ ##load-reference f 2 f }
+ }
+ ] [
+ {
+ T{ ##load-reference f 1 + }
+ T{ ##compare-imm f 2 1 + cc/= }
+ } value-numbering-step
+ ] unit-test
+
+ [
+ {
+ T{ ##load-reference f 1 + }
+ T{ ##load-reference f 2 t }
+ }
+ ] [
+ {
+ T{ ##load-reference f 1 + }
+ T{ ##compare-imm f 2 1 * cc/= }
+ } value-numbering-step
+ ] unit-test
+
+ [
+ {
+ T{ ##load-reference f 1 + }
+ T{ ##load-reference f 2 t }
+ }
+ ] [
+ {
+ T{ ##load-reference f 1 + }
+ T{ ##compare-imm f 2 1 + cc= }
+ } value-numbering-step
+ ] unit-test
+
+ [
+ {
+ T{ ##load-reference f 1 + }
+ T{ ##load-reference f 2 f }
+ }
+ ] [
+ {
+ T{ ##load-reference f 1 + }
+ T{ ##compare-imm f 2 1 * cc= }
+ } value-numbering-step
+ ] unit-test
+] when
+
[
{
T{ ##peek f 0 D 0 }
} value-numbering-step
] unit-test
+[
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-reference f 1 f }
+ }
+] [
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##compare f 1 0 0 cc/= }
+ } value-numbering-step
+] unit-test
+
! Reassociation
[
{
{
T{ ##load-integer f 1 1 }
T{ ##load-integer f 2 2 }
- T{ ##compare-branch f 1 2 cc< }
+ T{ ##compare-integer-branch f 1 2 cc< }
} test-branch-folding
] unit-test
{
T{ ##load-integer f 1 1 }
T{ ##load-integer f 2 2 }
- T{ ##compare-branch f 2 1 cc< }
+ T{ ##compare-integer-branch f 2 1 cc< }
} test-branch-folding
] unit-test
] [
{
T{ ##peek f 0 D 0 }
- T{ ##compare-branch f 0 0 cc< }
+ T{ ##compare-integer-branch f 0 0 cc< }
} test-branch-folding
] unit-test
] [
{
T{ ##peek f 0 D 0 }
- T{ ##compare-branch f 0 0 cc<= }
+ T{ ##compare-integer-branch f 0 0 cc<= }
} test-branch-folding
] unit-test
] [
{
T{ ##peek f 0 D 0 }
- T{ ##compare-branch f 0 0 cc> }
+ T{ ##compare-integer-branch f 0 0 cc> }
} test-branch-folding
] unit-test
] [
{
T{ ##peek f 0 D 0 }
- T{ ##compare-branch f 0 0 cc>= }
+ T{ ##compare-integer-branch f 0 0 cc>= }
} test-branch-folding
] unit-test
] [
{
T{ ##peek f 0 D 0 }
- T{ ##compare-branch f 0 0 cc= }
+ T{ ##compare-integer-branch f 0 0 cc= }
} test-branch-folding
] unit-test
] [
{
T{ ##peek f 0 D 0 }
- T{ ##compare-branch f 0 0 cc/= }
+ T{ ##compare-integer-branch f 0 0 cc/= }
} test-branch-folding
] unit-test
V{
T{ ##peek f 0 D 0 }
- T{ ##compare-branch f 0 0 cc< }
+ T{ ##compare-integer-branch f 0 0 cc< }
} 1 test-bb
V{
V{
T{ ##peek f 1 D 1 }
- T{ ##compare-branch f 1 1 cc< }
+ T{ ##compare-integer-branch f 1 1 cc< }
} 1 test-bb
V{
] unit-test
[ f ] [ 1 get instructions>> [ ##peek? ] any? ] unit-test
-
CODEGEN: ##neg %neg
CODEGEN: ##log2 %log2
CODEGEN: ##copy %copy
-CODEGEN: ##tagged>integer %copy
+CODEGEN: ##tagged>integer %tagged>integer
CODEGEN: ##add-float %add-float
CODEGEN: ##sub-float %sub-float
CODEGEN: ##mul-float %mul-float
CODEGEN: ##write-barrier-imm %write-barrier-imm
CODEGEN: ##compare %compare
CODEGEN: ##compare-imm %compare-imm
+CODEGEN: ##compare-integer %compare
+CODEGEN: ##compare-integer-imm %compare-imm
CODEGEN: ##compare-float-ordered %compare-float-ordered
CODEGEN: ##compare-float-unordered %compare-float-unordered
CODEGEN: ##save-context %save-context
HOOK: %copy cpu ( dst src rep -- )
+: %tagged>integer ( dst src -- ) int-rep %copy ;
+
HOOK: %fixnum-add cpu ( label dst src1 src2 -- )
HOOK: %fixnum-sub cpu ( label dst src1 src2 -- )
HOOK: %fixnum-mul cpu ( label dst src1 src2 -- )