\r
cpu "ppc" = [\r
"/library/compiler/ppc/assembler.factor"\r
- "/library/compiler/ppc/stack.factor"\r
"/library/compiler/ppc/generator.factor"\r
+ "/library/compiler/ppc/stack.factor"\r
"/library/compiler/ppc/alien.factor"\r
] pull-in\r
\r
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: assembler
-USING: alien compiler inference kernel kernel-internals lists
-math memory namespaces words ;
+USING: alien compiler compiler-backend inference kernel
+kernel-internals lists math memory namespaces words ;
-\ alien-invoke [
- uncons load-library 2dup 1 rel-dlsym dlsym compile-call-far
-] "generator" set-word-prop
+M: %alien-invoke generate-node ( vop -- )
+ uncons load-library 2dup 1 rel-dlsym dlsym compile-call-far ;
: stack-size 8 + 16 align ;
: stack@ 3 + cell * ;
-#parameters [
- dup 0 = [ drop ] [ stack-size 1 1 rot SUBI ] ifte
-] "generator" set-word-prop
+M: %parameters generate-node ( vop -- )
+ dup 0 = [ drop ] [ stack-size 1 1 rot SUBI ] ifte ;
-#unbox [
+M: %unbox generate-node ( vop -- )
uncons f 2dup 1 rel-dlsym dlsym compile-call-far
- 3 1 rot stack@ STW
-] "generator" set-word-prop
+ 3 1 rot stack@ STW ;
-#parameter [
- dup 3 + 1 rot stack@ LWZ
-] "generator" set-word-prop
+M: %parameter generate-node ( vop -- )
+ dup 3 + 1 rot stack@ LWZ ;
-#box [
- f 2dup 1 rel-dlsym dlsym compile-call-far
-] "generator" set-word-prop
+M: %box generate-node ( vop -- )
+ f 2dup 1 rel-dlsym dlsym compile-call-far ;
-#cleanup [
- dup 0 = [ drop ] [ stack-size 1 1 rot ADDI ] ifte
-] "generator" set-word-prop
+M: %cleanup generate-node ( vop -- )
+ dup 0 = [ drop ] [ stack-size 1 1 rot ADDI ] ifte ;
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
IN: assembler
-USING: errors kernel math memory words ;
+USING: compiler errors kernel math memory words ;
! See the Motorola or IBM documentation for details. The opcode
! names are standard, and the operand order is the same as in
: SUBI neg ADDI ;
: ORI d-form 24 insn ;
: SRAWI 824 0 x-form 31 insn ;
-: BL 0 1 i-form 18 insn ;
-: B 0 0 i-form 18 insn ;
-: BC 0 0 b-form 16 insn ;
+
+GENERIC: BL
+M: integer BL 0 1 i-form 18 insn ;
+M: word BL 0 BL relative-24 ;
+
+GENERIC: B
+M: integer B 0 0 i-form 18 insn ;
+M: word B 0 B relative-24 ;
+
+GENERIC: BC
+M: integer BC 0 0 b-form 16 insn ;
+M: word BC >r 0 BC r> relative-14 ;
+
: BEQ 12 2 rot BC ;
: BNE 4 2 rot BC ;
: BCLR 0 8 0 0 b-form 19 insn ;
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
-IN: assembler
-USING: compiler inference kernel kernel-internals lists math
-words ;
+IN: compiler-backend
+USING: assembler compiler inference kernel kernel-internals
+lists math memory words ;
+
+! PowerPC register assignments
+! r14 data stack
+! r15 call stack
+! r16 callframe
+! r17 executing
+! r18-r30 vregs
+
+GENERIC: v>operand
+M: integer v>operand tag-bits shift ;
+M: vreg v>operand vreg-n 18 + ;
! At the start of each word that calls a subroutine, we store
! the link register in r0, then push r0 on the C stack.
-#prologue [
+M: %prologue generate-node ( vop -- )
drop
1 1 -16 STWU
0 MFLR
- 0 1 20 STW
-] "generator" set-word-prop
+ 0 1 20 STW ;
! At the end of each word that calls a subroutine, we store
! the previous link register value in r0 by popping it off the
1 1 16 ADDI
0 MTLR ;
-\ slot [
- PEEK-DS
- 2unlist type-tag >r cell * r> - >r 18 18 r> LWZ
- REPL-DS
-] "generator" set-word-prop
-
-#return-to [
- 0 18 LOAD32 absolute-16/16
- 1 1 -16 STWU
- 18 1 20 STW
-] "generator" set-word-prop
-
-#return [ drop compile-epilogue BLR ] "generator" set-word-prop
-
! Far calls are made to addresses already known when the
! IR node is being generated. No forward reference far
! calls are possible.
dup primitive? [
dup 1 rel-primitive word-xt compile-call-far
] [
- 0 BL relative-24
+ BL
] ifte ;
-#call-label [
- ! Hack: length of instruction sequence that follows
+: compile-call-label ( word -- )
+ #! Hack: length of instruction sequence that follows
0 1 rel-address compiled-offset 20 + 18 LOAD32
1 1 -16 STWU
18 1 20 STW
- 0 B relative-24
-] "generator" set-word-prop
+ B ;
+
+M: %call-label generate-node ( vop -- )
+ vop-label compile-call-label ;
+
+M: %call generate-node ( vop -- )
+ vop-label dup postpone-word compile-call-label ;
: compile-jump-far ( word -- )
19 LOAD32
dup primitive? [
dup 1 rel-primitive word-xt compile-jump-far
] [
- 0 B relative-24
+ B
] ifte ;
-#jump [
- dup postpone-word compile-epilogue compile-jump-label
-] "generator" set-word-prop
+M: %jump generate-node ( vop -- )
+ vop-label dup postpone-word compile-epilogue
+ compile-jump-label ;
+
+M: %jump-label generate-node ( vop -- )
+ vop-label compile-jump-label ;
-: compile-jump-t ( label -- )
- POP-DS
- 0 18 3 CMPI
- 0 BNE relative-14 ;
+: conditional ( vop -- label )
+ dup vop-in-1 v>operand 0 swap f address CMPI vop-label ;
-: compile-jump-f ( label -- )
- POP-DS
- 0 18 3 CMPI
- 0 BEQ relative-14 ;
+M: %jump-f generate-node ( vop -- )
+ conditional BEQ ;
-\ dispatch [
+M: %jump-t generate-node ( vop -- )
+ conditional BNE ;
+
+M: %return-to generate-node ( vop -- )
+ vop-label 0 18 LOAD32 absolute-16/16
+ 1 1 -16 STWU
+ 18 1 20 STW ;
+
+M: %return generate-node ( vop -- )
+ drop compile-epilogue BLR ;
+
+M: %dispatch generate-node ( vop -- )
! Compile a piece of code that jumps to an offset in a
! jump table indexed by the fixnum at the top of the stack.
! The jump table must immediately follow this macro.
drop
- POP-DS
+ ! POP-DS
18 18 1 SRAWI
! The value 24 is a magic number. It is the length of the
! instruction sequence that follows to be generated.
18 18 19 ADD
18 18 0 LWZ
18 MTLR
- BLR
-] "generator" set-word-prop
+ BLR ;
+
+! \ slot [
+! PEEK-DS
+! 2unlist type-tag >r cell * r> - >r 18 18 r> LWZ
+! REPL-DS
+! ] "generator" set-word-prop
! Copyright (C) 2005 Slava Pestov.
! See http://factor.sf.net/license.txt for BSD license.
-IN: assembler
-USING: compiler errors kernel math memory words ;
-
-! Pushing and popping the data stack.
-: PEEK-DS 18 14 0 LWZ ;
-: POP-DS PEEK-DS 14 14 4 SUBI ;
-: PUSH-DS 18 14 4 STWU ;
-: REPL-DS 18 14 0 STW ;
-
-! Pushing and popping the return stack.
-: PEEK-CS 18 15 0 LWZ ;
-: POP-CS PEEK-CS 15 15 4 SUBI ;
-: PUSH-CS 18 15 4 STWU ;
-
-: indirect-literal ( obj -- )
- intern-literal 19 LOAD
- 18 19 0 LWZ ;
-
-#push-immediate [
- address 18 LOAD PUSH-DS
-] "generator" set-word-prop
-
-#push-indirect [
- indirect-literal PUSH-DS
-] "generator" set-word-prop
-
-#replace-immediate [
- address 18 LOAD REPL-DS
-] "generator" set-word-prop
-
-#replace-indirect [
- indirect-literal REPL-DS
-] "generator" set-word-prop
-
-\ drop [ drop 14 14 4 SUBI ] "generator" set-word-prop
-\ dup [ drop PEEK-DS PUSH-DS ] "generator" set-word-prop
-\ over [ drop 18 14 -4 LWZ PUSH-DS ] "generator" set-word-prop
-\ pick [ drop 18 14 -8 LWZ PUSH-DS ] "generator" set-word-prop
-
-\ swap [
- drop
- 18 14 -4 LWZ
- 19 14 0 LWZ
- 19 14 -4 STW
- 18 14 0 STW
-] "generator" set-word-prop
-
-\ >r [ drop POP-DS PUSH-CS ] "generator" set-word-prop
-\ r> [ drop POP-CS PUSH-DS ] "generator" set-word-prop
+IN: compiler-backend
+USING: assembler compiler errors kernel math memory words ;
+
+: ds-op cell * neg 14 swap ;
+: cs-op cell * neg 15 swap ;
+
+M: %immediate generate-node ( vop -- )
+ dup vop-in-1 address swap vop-out-1 v>operand LOAD32 ;
+
+M: %indirect generate-node ( vop -- )
+ dup vop-out-1 v>operand swap vop-in-1 intern-literal
+ over LOAD dup 0 LWZ ;
+
+M: %peek-d generate-node ( vop -- )
+ dup vop-out-1 v>operand swap vop-in-1 ds-op LWZ ;
+
+M: %replace-d generate-node ( vop -- )
+ dup vop-in-2 v>operand swap vop-in-1 ds-op STW ;
+
+M: %inc-d generate-node ( vop -- )
+ 14 14 rot vop-in-1 cell * ADDI ;
+
+M: %inc-r generate-node ( vop -- )
+ 15 15 rot vop-in-1 cell * ADDI ;
+
+M: %dec-r generate-node ( vop -- )
+ 15 15 rot vop-in-1 cell * SUBI ;
+
+M: %peek-r generate-node ( vop -- )
+ dup vop-out-1 v>operand swap vop-in-1 cs-op LWZ ;
+
+M: %replace-r generate-node ( vop -- )
+ dup vop-in-2 v>operand swap vop-in-2 cs-op STW ;
! give it a fixnum tag.
vop-out-1 v>operand tag-bits SHL ;
-: conditional ( dest cond -- )
+: load-boolean ( dest cond -- )
#! Compile this after a conditional jump to store f or t
#! in dest depending on the jump being taken or not.
<label> "true" set
dup vop-out-1 v>operand dup rot vop-in-1 v>operand CMP ;
M: %fixnum< generate-node ( vop -- )
- fixnum-compare \ JL conditional ;
+ fixnum-compare \ JL load-boolean ;
M: %fixnum<= generate-node ( vop -- )
- fixnum-compare \ JLE conditional ;
+ fixnum-compare \ JLE load-boolean ;
M: %fixnum> generate-node ( vop -- )
- fixnum-compare \ JG conditional ;
+ fixnum-compare \ JG load-boolean ;
M: %fixnum>= generate-node ( vop -- )
- fixnum-compare \ JGE conditional ;
+ fixnum-compare \ JGE load-boolean ;
M: %eq? generate-node ( vop -- )
- fixnum-compare \ JE conditional ;
+ fixnum-compare \ JE load-boolean ;
: fixnum-branch ( vop -- label )
dup vop-in-2 v>operand over vop-in-1 v>operand CMP
M: %call generate-node ( vop -- )
vop-label dup postpone-word CALL ;
-M: %jump-label generate-node ( vop -- )
- vop-label JMP ;
-
M: %call-label generate-node ( vop -- )
vop-label CALL ;
M: %jump generate-node ( vop -- )
vop-label dup postpone-word JMP ;
+M: %jump-label generate-node ( vop -- )
+ vop-label JMP ;
+
+: conditional ( vop -- label )
+ dup vop-in-1 v>operand f address CMP vop-label ;
+
M: %jump-f generate-node ( vop -- )
- dup vop-in-1 v>operand f address CMP vop-label JE ;
+ conditional JE ;
M: %jump-t generate-node ( vop -- )
- dup vop-in-1 v>operand f address CMP vop-label JNE ;
+ conditional JNE ;
M: %return-to generate-node ( vop -- )
0 PUSH vop-label absolute ;
projects / factor.git / commitdiff