diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor index cb5f2e926d..a93fa5d902 100644 --- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor +++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor @@ -18,13 +18,14 @@ IN: compiler.cfg.intrinsics.fixnum 0 cc= ^^compare-imm ds-push ; -: (emit-fixnum-imm-op) ( infos insn -- dst ) - ds-drop - [ ds-pop ] - [ second literal>> [ tag-fixnum ] [ \ f tag-number ] if* ] - [ ] - tri* - call ; inline +: tag-literal ( n -- tagged ) + literal>> [ tag-fixnum ] [ \ f tag-number ] if* ; + +: emit-fixnum-imm-op1 ( infos insn -- dst ) + [ ds-pop ds-drop ] [ first tag-literal ] [ ] tri* call ; inline + +: emit-fixnum-imm-op2 ( infos insn -- dst ) + [ ds-drop ds-pop ] [ second tag-literal ] [ ] tri* call ; inline : (emit-fixnum-op) ( insn -- dst ) [ 2inputs ] dip call ; inline @@ -32,9 +33,22 @@ IN: compiler.cfg.intrinsics.fixnum :: emit-fixnum-op ( node insn imm-insn -- ) [let | infos [ node node-input-infos ] | infos second value-info-small-tagged? - [ infos imm-insn (emit-fixnum-imm-op) ] - [ insn (emit-fixnum-op) ] - if + [ infos imm-insn emit-fixnum-imm-op2 ] + [ insn (emit-fixnum-op) ] if + ds-push + ] ; inline + +:: 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 ds-push ] ; inline @@ -69,9 +83,14 @@ IN: compiler.cfg.intrinsics.fixnum [ (emit-fixnum*fast-imm) ] [ drop (emit-fixnum*fast) ] if ds-push ; +: (emit-fixnum-comparison) ( cc -- quot1 quot2 ) + [ ^^compare ] [ ^^compare-imm ] bi-curry ; inline + +: emit-eq ( node cc -- ) + (emit-fixnum-comparison) emit-commutative-fixnum-op ; + : emit-fixnum-comparison ( node cc -- ) - [ ^^compare ] [ ^^compare-imm ] bi-curry - emit-fixnum-op ; + (emit-fixnum-comparison) emit-fixnum-op ; : emit-bignum>fixnum ( -- ) ds-pop ^^bignum>integer ^^tag-fixnum ds-push ; diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index ec819f9440..15c9c0cef3 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -103,11 +103,11 @@ IN: compiler.cfg.intrinsics { \ math.private:fixnum+ [ drop [ ##fixnum-add ] [ ##fixnum-add-tail ] emit-fixnum-overflow-op ] } { \ math.private:fixnum- [ drop [ ##fixnum-sub ] [ ##fixnum-sub-tail ] emit-fixnum-overflow-op ] } { \ math.private:fixnum* [ drop [ i i ##fixnum-mul ] [ i i ##fixnum-mul-tail ] emit-fixnum-overflow-op ] } - { \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-fixnum-op iterate-next ] } + { \ math.private:fixnum+fast [ [ ^^add ] [ ^^add-imm ] emit-commutative-fixnum-op iterate-next ] } { \ math.private:fixnum-fast [ [ ^^sub ] [ ^^sub-imm ] emit-fixnum-op iterate-next ] } - { \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-fixnum-op iterate-next ] } - { \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-fixnum-op iterate-next ] } - { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-fixnum-op iterate-next ] } + { \ math.private:fixnum-bitand [ [ ^^and ] [ ^^and-imm ] emit-commutative-fixnum-op iterate-next ] } + { \ math.private:fixnum-bitor [ [ ^^or ] [ ^^or-imm ] emit-commutative-fixnum-op iterate-next ] } + { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-commutative-fixnum-op iterate-next ] } { \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast iterate-next ] } { \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot iterate-next ] } { \ math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 iterate-next ] } @@ -116,7 +116,7 @@ IN: compiler.cfg.intrinsics { \ math.private:fixnum<= [ cc<= emit-fixnum-comparison iterate-next ] } { \ math.private:fixnum>= [ cc>= emit-fixnum-comparison iterate-next ] } { \ math.private:fixnum> [ cc> emit-fixnum-comparison iterate-next ] } - { \ kernel:eq? [ cc= emit-fixnum-comparison iterate-next ] } + { \ kernel:eq? [ cc= emit-eq iterate-next ] } { \ math.private:bignum>fixnum [ drop emit-bignum>fixnum iterate-next ] } { \ math.private:fixnum>bignum [ drop emit-fixnum>bignum iterate-next ] } { \ math.private:float+ [ drop [ ^^add-float ] emit-float-op iterate-next ] }