1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: compiler.generator.fixup kernel namespaces make sequences
4 words math math.bitwise io.binary parser lexer ;
5 IN: cpu.ppc.assembler.backend
7 : insn ( operand opcode -- ) { 26 0 } bitfield , ;
9 : a-insn ( d a b c xo rc opcode -- )
10 [ { 0 1 6 11 16 21 } bitfield ] dip insn ;
12 : b-insn ( bo bi bd aa lk opcode -- )
13 [ { 0 1 2 16 21 } bitfield ] dip insn ;
15 : s>u16 ( s -- u ) HEX: ffff bitand ;
17 : d-insn ( d a simm opcode -- )
18 [ s>u16 { 0 16 21 } bitfield ] dip insn ;
20 : define-d-insn ( word opcode -- )
21 [ d-insn ] curry (( d a simm -- )) define-declared ;
23 : D: CREATE scan-word define-d-insn ; parsing
25 : sd-insn ( d a simm opcode -- )
26 [ s>u16 { 0 21 16 } bitfield ] dip insn ;
28 : define-sd-insn ( word opcode -- )
29 [ sd-insn ] curry (( d a simm -- )) define-declared ;
31 : SD: CREATE scan-word define-sd-insn ; parsing
33 : i-insn ( li aa lk opcode -- )
34 [ { 0 1 0 } bitfield ] dip insn ;
36 : x-insn ( a s b rc xo opcode -- )
37 [ { 1 0 11 21 16 } bitfield ] dip insn ;
39 : (X) ( -- word quot )
40 CREATE scan-word scan-word scan-word [ x-insn ] 3curry ;
42 : X: (X) (( a s b -- )) define-declared ; parsing
44 : (1) ( quot -- quot' ) [ 0 ] prepose ;
46 : X1: (X) (1) (( a s -- )) define-declared ; parsing
48 : xfx-insn ( d spr xo opcode -- )
49 [ { 1 11 21 } bitfield ] dip insn ;
51 : CREATE-MF ( -- word ) scan "MF" prepend create-in ;
54 CREATE-MF scan-word 5 shift [ 339 31 xfx-insn ] curry
55 (( d -- )) define-declared ; parsing
57 : CREATE-MT ( -- word ) scan "MT" prepend create-in ;
60 CREATE-MT scan-word 5 shift [ 467 31 xfx-insn ] curry
61 (( d -- )) define-declared ; parsing
63 : xo-insn ( d a b oe rc xo opcode -- )
64 [ { 1 0 10 11 16 21 } bitfield ] dip insn ;
66 : (XO) ( -- word quot )
67 CREATE scan-word scan-word scan-word scan-word
68 [ xo-insn ] 2curry 2curry ;
70 : XO: (XO) (( a s b -- )) define-declared ; parsing
72 : XO1: (XO) (1) (( a s -- )) define-declared ; parsing
74 GENERIC# (B) 2 ( dest aa lk -- )
75 M: integer (B) 18 i-insn ;
76 M: word (B) 0 -rot (B) rc-relative-ppc-3 rel-word ;
77 M: label (B) 0 -rot (B) rc-relative-ppc-3 label-fixup ;
79 GENERIC: BC ( a b c -- )
80 M: integer BC 0 0 16 b-insn ;
81 M: word BC >r 0 BC r> rc-relative-ppc-2 rel-word ;
82 M: label BC >r 0 BC r> rc-relative-ppc-2 label-fixup ;
84 : CREATE-B ( -- word ) scan "B" prepend create-in ;
87 CREATE-B scan-word scan-word
88 [ rot BC ] 2curry (( c -- )) define-declared ; parsing
91 CREATE-B scan-word scan-word scan-word scan-word scan-word
92 [ b-insn ] curry curry curry curry curry
93 (( bo -- )) define-declared ; parsing