def: dst/int-rep
use: src/int-rep ;
-! Bignum/integer conversion
-PURE-INSN: ##integer>bignum
-def: dst/int-rep
-use: src/int-rep
-temp: temp/int-rep ;
-
-PURE-INSN: ##bignum>integer
-def: dst/int-rep
-use: src/int-rep
-temp: temp/int-rep ;
-
! Float arithmetic
PURE-INSN: ##unbox-float
def: dst/double-rep
##box-float
##box-vector
##box-alien
-##box-displaced-alien
-##integer>bignum ;
+##box-displaced-alien ;
! For alias analysis
UNION: ##read ##slot ##slot-imm ;
! Instructions that have complex expansions and require that the
! output registers are not equal to any of the input registers
UNION: def-is-use-insn
-##integer>bignum
-##bignum>integer
##box-alien
##box-displaced-alien
##string-nth
: emit-fixnum-comparison ( cc -- )
'[ _ ^^compare ] emit-fixnum-op ;
-: emit-bignum>fixnum ( -- )
- ds-pop ^^bignum>integer ^^tag-fixnum ds-push ;
-
-: emit-fixnum>bignum ( -- )
- ds-pop ^^untag-fixnum ^^integer>bignum ds-push ;
-
: emit-no-overflow-case ( dst -- final-bb )
[ ds-drop ds-drop ds-push ] with-branch ;
CODEGEN: ##not %not
CODEGEN: ##log2 %log2
CODEGEN: ##copy %copy
-CODEGEN: ##integer>bignum %integer>bignum
-CODEGEN: ##bignum>integer %bignum>integer
CODEGEN: ##unbox-float %unbox-float
CODEGEN: ##box-float %box-float
CODEGEN: ##add-float %add-float
dup recompile-callers?
[ compiled-usage keys [ queue-compile ] each ] [ drop ] if ;
+: compiler-message ( string -- )
+ "trace-compilation" get [ global [ print flush ] bind ] [ drop ] if ;
+
: start ( word -- )
- "trace-compilation" get [ dup name>> print flush ] when
+ dup name>> compiler-message
H{ } clone dependencies set
H{ } clone generic-dependencies set
clear-compiler-error ;
compile-queue get compile-loop
compiled get >alist
] with-scope
- "trace-compilation" get [ "--- compile done" print flush ] when ;
+ "--- compile done" compiler-message ;
: with-optimizer ( quot -- )
[ optimizing-compiler compiler-impl ] dip with-variable ; inline
T{ ##add-imm f 0 0 -8 }
} compile-test-bb
] unit-test
-
-! These are def-is-use-insns
-USE: multiline
-
-/*
-
-[ 100 ] [
- V{
- T{ ##load-immediate f 0 100 }
- T{ ##integer>bignum f 0 0 1 }
- } compile-test-bb
-] unit-test
-
-[ 1 ] [
- V{
- T{ ##load-reference f 0 ALIEN: 8 }
- T{ ##unbox-any-c-ptr f 0 0 1 }
- } compile-test-bb
-] unit-test
-
-*/
HOOK: %fixnum-sub cpu ( label dst src1 src2 -- )
HOOK: %fixnum-mul cpu ( label dst src1 src2 -- )
-HOOK: %integer>bignum cpu ( dst src temp -- )
-HOOK: %bignum>integer cpu ( dst src temp -- )
-
HOOK: %unbox-float cpu ( dst src -- )
HOOK: %box-float cpu ( dst src temp -- )
M: ppc %fixnum-mul ( label dst src1 src2 -- )
[ MULLWO. ] overflow-template ;
-: bignum@ ( n -- offset ) cells bignum tag-number - ; inline
-
-M:: ppc %integer>bignum ( dst src temp -- )
- [
- "end" define-label
- dst 0 >bignum %load-reference
- ! Is it zero? Then just go to the end and return this zero
- 0 src 0 CMPI
- "end" get BEQ
- ! Allocate a bignum
- dst 4 cells bignum temp %allot
- ! Write length
- 2 tag-fixnum temp LI
- temp dst 1 bignum@ STW
- ! Compute sign
- temp src MR
- temp temp cell-bits 1 - SRAWI
- temp temp 1 ANDI
- ! Store sign
- temp dst 2 bignum@ STW
- ! Make negative value positive
- temp temp temp ADD
- temp temp NEG
- temp temp 1 ADDI
- temp src temp MULLW
- ! Store the bignum
- temp dst 3 bignum@ STW
- "end" resolve-label
- ] with-scope ;
-
-M:: ppc %bignum>integer ( dst src temp -- )
- [
- "end" define-label
- temp src 1 bignum@ LWZ
- ! if the length is 1, its just the sign and nothing else,
- ! so output 0
- 0 dst LI
- 0 temp 1 tag-fixnum CMPI
- "end" get BEQ
- ! load the value
- dst src 3 bignum@ LWZ
- ! load the sign
- temp src 2 bignum@ LWZ
- ! branchless arithmetic: we want to turn 0 into 1,
- ! and 1 into -1
- temp temp temp ADD
- temp temp 1 SUBI
- temp temp NEG
- ! multiply value by sign
- dst dst temp MULLW
- "end" resolve-label
- ] with-scope ;
-
M: ppc %add-float FADD ;
M: ppc %sub-float FSUB ;
M: ppc %mul-float FMUL ;
M: x86 %fixnum-mul ( label dst src1 src2 -- )
int-rep two-operand swap IMUL2 JO ;
-: bignum@ ( reg n -- op )
- cells bignum tag-number - [+] ; inline
-
-M:: x86 %integer>bignum ( dst src temp -- )
- #! on entry, inreg is a signed 32-bit quantity
- #! exits with tagged ptr to bignum in outreg
- #! 1 cell header, 1 cell length, 1 cell sign, + digits
- #! length is the # of digits + sign
- [
- "end" define-label
- ! Load cached zero value
- dst 0 >bignum %load-reference
- src 0 CMP
- ! Is it zero? Then just go to the end and return this zero
- "end" get JE
- ! Allocate a bignum
- dst 4 cells bignum temp %allot
- ! Write length
- dst 1 bignum@ 2 tag-fixnum MOV
- ! Store value
- dst 3 bignum@ src MOV
- ! Compute sign
- temp src MOV
- temp cell-bits 1 - SAR
- temp 1 AND
- ! Store sign
- dst 2 bignum@ temp MOV
- ! Make negative value positive
- temp temp ADD
- temp NEG
- temp 1 ADD
- src temp IMUL2
- ! Store the bignum
- dst 3 bignum@ temp MOV
- "end" resolve-label
- ] with-scope ;
-
-M:: x86 %bignum>integer ( dst src temp -- )
- [
- "end" define-label
- ! load length
- temp src 1 bignum@ MOV
- ! if the length is 1, its just the sign and nothing else,
- ! so output 0
- dst 0 MOV
- temp 1 tag-fixnum CMP
- "end" get JE
- ! load the value
- dst src 3 bignum@ MOV
- ! load the sign
- temp src 2 bignum@ MOV
- ! convert it into -1 or 1
- temp temp ADD
- temp NEG
- temp 1 ADD
- ! make dst signed
- temp dst IMUL2
- "end" resolve-label
- ] with-scope ;
-
M: x86 %add-float double-rep two-operand ADDSD ;
M: x86 %sub-float double-rep two-operand SUBSD ;
M: x86 %mul-float double-rep two-operand MULSD ;
projects / factor.git / commitdiff