From 8a8f0c925c80907199c56a7aab60fea75ff18a59 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sat, 6 Dec 2008 15:31:17 -0600 Subject: [PATCH] Use BSR instruction to implement fixnum-log2 intrinsic --- basis/compiler/cfg/hats/hats.factor | 1 + basis/compiler/cfg/instructions/instructions.factor | 1 + basis/compiler/cfg/intrinsics/fixnum/fixnum.factor | 3 +++ basis/compiler/cfg/intrinsics/intrinsics.factor | 5 +++++ basis/compiler/codegen/codegen.factor | 1 + basis/cpu/architecture/architecture.factor | 1 + basis/cpu/x86/assembler/assembler.factor | 2 ++ basis/cpu/x86/x86.factor | 7 +++++-- core/math/integers/integers.factor | 10 ++++++---- core/math/math.factor | 11 +++-------- 10 files changed, 28 insertions(+), 14 deletions(-) diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor index ca793de1b7..c0d5bf79a6 100644 --- a/basis/compiler/cfg/hats/hats.factor +++ b/basis/compiler/cfg/hats/hats.factor @@ -39,6 +39,7 @@ IN: compiler.cfg.hats : ^^shr-imm ( src1 src2 -- dst ) ^^i2 ##shr-imm ; inline : ^^sar-imm ( src1 src2 -- dst ) ^^i2 ##sar-imm ; inline : ^^not ( src -- dst ) ^^i1 ##not ; inline +: ^^log2 ( src -- dst ) ^^i1 ##log2 ; inline : ^^bignum>integer ( src -- dst ) ^^i1 i ##bignum>integer ; inline : ^^integer>bignum ( src -- dst ) ^^i1 i ##integer>bignum ; inline : ^^add-float ( src1 src2 -- dst ) ^^d2 ##add-float ; inline diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index b34e5f8232..5619a70740 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -92,6 +92,7 @@ INSN: ##shl-imm < ##binary-imm ; INSN: ##shr-imm < ##binary-imm ; INSN: ##sar-imm < ##binary-imm ; INSN: ##not < ##unary ; +INSN: ##log2 < ##unary ; ! Overflowing arithmetic TUPLE: ##fixnum-overflow < insn src1 src2 ; diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor index 69cd5e5669..3ad716d847 100644 --- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor +++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor @@ -53,6 +53,9 @@ IN: compiler.cfg.intrinsics.fixnum : emit-fixnum-bitnot ( -- ) ds-pop ^^not tag-mask get ^^xor-imm ds-push ; +: emit-fixnum-log2 ( -- ) + ds-pop ^^log2 tag-bits get ^^sub-imm ^^tag-fixnum ds-push ; + : (emit-fixnum*fast) ( -- dst ) 2inputs ^^untag-fixnum ^^mul ; diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index 41f4bf47a5..6656cd11f7 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -19,6 +19,7 @@ QUALIFIED: slots.private QUALIFIED: strings.private QUALIFIED: classes.tuple.private QUALIFIED: math.private +QUALIFIED: math.integers.private QUALIFIED: alien.accessors IN: compiler.cfg.intrinsics @@ -93,6 +94,9 @@ IN: compiler.cfg.intrinsics alien.accessors:set-alien-double } [ t "intrinsic" set-word-prop ] each ; +: enable-fixnum-log2 ( -- ) + \ math.integers.private:fixnum-log2 t "intrinsic" set-word-prop ; + : emit-intrinsic ( node word -- node/f ) { { \ kernel.private:tag [ drop emit-tag iterate-next ] } @@ -108,6 +112,7 @@ IN: compiler.cfg.intrinsics { \ math.private:fixnum-bitxor [ [ ^^xor ] [ ^^xor-imm ] emit-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 ] } { \ math.private:fixnum*fast [ emit-fixnum*fast iterate-next ] } { \ math.private:fixnum< [ cc< emit-fixnum-comparison iterate-next ] } { \ math.private:fixnum<= [ cc<= emit-fixnum-comparison iterate-next ] } diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index fe3da93130..9f134c02d7 100644 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -163,6 +163,7 @@ M: ##shl-imm generate-insn dst/src1/src2 %shl-imm ; M: ##shr-imm generate-insn dst/src1/src2 %shr-imm ; M: ##sar-imm generate-insn dst/src1/src2 %sar-imm ; M: ##not generate-insn dst/src %not ; +M: ##log2 generate-insn dst/src %log2 ; : src1/src2 ( insn -- src1 src2 ) [ src1>> register ] [ src2>> register ] bi ; inline diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 836385574d..c609b9e98d 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -77,6 +77,7 @@ HOOK: %shl-imm cpu ( dst src1 src2 -- ) HOOK: %shr-imm cpu ( dst src1 src2 -- ) HOOK: %sar-imm cpu ( dst src1 src2 -- ) HOOK: %not cpu ( dst src -- ) +HOOK: %log2 cpu ( dst src -- ) HOOK: %fixnum-add cpu ( src1 src2 -- ) HOOK: %fixnum-add-tail cpu ( src1 src2 -- ) diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor index 27c00cb3c0..2bea887295 100644 --- a/basis/cpu/x86/assembler/assembler.factor +++ b/basis/cpu/x86/assembler/assembler.factor @@ -384,6 +384,8 @@ M: operand CMP OCT: 070 2-operand ; : XCHG ( dst src -- ) OCT: 207 2-operand ; +: BSR ( dst src -- ) swap { HEX: 0f HEX: bd } (2-operand) ; + : NOT ( dst -- ) { BIN: 010 t HEX: f7 } 1-operand ; : NEG ( dst -- ) { BIN: 011 t HEX: f7 } 1-operand ; : MUL ( dst -- ) { BIN: 100 t HEX: f7 } 1-operand ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index c477e98aa7..44300a75f9 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -5,10 +5,12 @@ cpu.x86.assembler cpu.x86.assembler.private cpu.architecture kernel kernel.private math memory namespaces make sequences words system layouts combinators math.order fry locals compiler.constants compiler.cfg.registers -compiler.cfg.instructions compiler.codegen -compiler.codegen.fixup ; +compiler.cfg.instructions compiler.cfg.intrinsics +compiler.codegen compiler.codegen.fixup ; IN: cpu.x86 +<< enable-fixnum-log2 >> + M: x86 two-operand? t ; HOOK: temp-reg-1 cpu ( -- reg ) @@ -92,6 +94,7 @@ M: x86 %shl-imm nip SHL ; M: x86 %shr-imm nip SHR ; M: x86 %sar-imm nip SAR ; M: x86 %not drop NOT ; +M: x86 %log2 BSR ; : ?MOV ( dst src -- ) 2dup = [ 2drop ] [ MOV ] if ; inline diff --git a/core/math/integers/integers.factor b/core/math/integers/integers.factor index fcb1b65d80..910d394c55 100644 --- a/core/math/integers/integers.factor +++ b/core/math/integers/integers.factor @@ -40,11 +40,13 @@ M: fixnum bitnot fixnum-bitnot ; M: fixnum bit? neg shift 1 bitand 0 > ; -: (fixnum-log2) ( accum n -- accum ) - dup 1 number= [ drop ] [ [ 1+ ] [ 2/ ] bi* (fixnum-log2) ] if ; - inline recursive +: fixnum-log2 ( x -- n ) + 0 swap [ dup 1 number= not ] [ [ 1+ ] [ 2/ ] bi* ] [ ] while drop ; -M: fixnum (log2) 0 swap (fixnum-log2) ; +M: fixnum (log2) fixnum-log2 ; + +M: integer next-power-of-2 + dup 2 <= [ drop 2 ] [ 1- log2 1+ 2^ ] if ; M: bignum >fixnum bignum>fixnum ; M: bignum >bignum ; diff --git a/core/math/math.factor b/core/math/math.factor index 5c53d99cff..8b064725d3 100644 --- a/core/math/math.factor +++ b/core/math/math.factor @@ -53,7 +53,7 @@ PRIVATE> "log2 expects positive inputs" throw ] [ (log2) - ] if ; foldable + ] if ; inline : zero? ( x -- ? ) 0 number= ; inline : 1+ ( x -- y ) 1 + ; inline @@ -103,14 +103,9 @@ M: float fp-infinity? ( float -- ? ) drop f ] if ; -: (next-power-of-2) ( i n -- n ) - 2dup >= [ - drop - ] [ - [ 1 shift ] dip (next-power-of-2) - ] if ; +GENERIC: next-power-of-2 ( m -- n ) foldable -: next-power-of-2 ( m -- n ) 2 swap (next-power-of-2) ; foldable +M: real next-power-of-2 1+ >integer next-power-of-2 ; : power-of-2? ( n -- ? ) dup 0 <= [ drop f ] [ dup 1- bitand zero? ] if ; foldable