/extra/cpu/arm/assembler/assembler.factor

  1! Copyright (C) 2007, 2009 Slava Pestov.
  2! See http://factorcode.org/license.txt for BSD license.
  3USING: accessors arrays combinators kernel make math math.bitwise
  4namespaces sequences words words.symbol parser ;
  5IN: cpu.arm.assembler
  6
  7! Registers
  8<<
  9
 10SYMBOL: registers
 11
 12V{ } registers set-global
 13
 14SYNTAX: REGISTER:
 15    scan-new-word
 16    [ define-symbol ]
 17    [ registers get length "register" set-word-prop ]
 18    [ registers get push ]
 19    tri ;
 20
 21>>
 22
 23REGISTER: R0
 24REGISTER: R1
 25REGISTER: R2
 26REGISTER: R3
 27REGISTER: R4
 28REGISTER: R5
 29REGISTER: R6
 30REGISTER: R7
 31REGISTER: R8
 32REGISTER: R9
 33REGISTER: R10
 34REGISTER: R11
 35REGISTER: R12
 36REGISTER: R13
 37REGISTER: R14
 38REGISTER: R15
 39
 40ALIAS: SL R10 ALIAS: FP R11 ALIAS: IP R12
 41ALIAS: SP R13 ALIAS: LR R14 ALIAS: PC R15
 42
 43<PRIVATE
 44
 45PREDICATE: register < word register >boolean ;
 46
 47GENERIC: register ( register -- n )
 48M: word register "register" word-prop ;
 49M: f register drop 0 ;
 50
 51PRIVATE>
 52
 53! Condition codes
 54SYMBOL: cond-code
 55
 56: >CC ( n -- )
 57    cond-code set ;
 58
 59: CC> ( -- n )
 60    #! Default value is 0b1110 AL (= always)
 61    cond-code [ f ] change 0b1110 or ;
 62
 63: EQ ( -- ) 0b0000 >CC ;
 64: NE ( -- ) 0b0001 >CC ;
 65: CS ( -- ) 0b0010 >CC ;
 66: CC ( -- ) 0b0011 >CC ;
 67: LO ( -- ) 0b0100 >CC ;
 68: PL ( -- ) 0b0101 >CC ;
 69: VS ( -- ) 0b0110 >CC ;
 70: VC ( -- ) 0b0111 >CC ;
 71: HI ( -- ) 0b1000 >CC ;
 72: LS ( -- ) 0b1001 >CC ;
 73: GE ( -- ) 0b1010 >CC ;
 74: LT ( -- ) 0b1011 >CC ;
 75: GT ( -- ) 0b1100 >CC ;
 76: LE ( -- ) 0b1101 >CC ;
 77: AL ( -- ) 0b1110 >CC ;
 78: NV ( -- ) 0b1111 >CC ;
 79
 80<PRIVATE
 81
 82: (insn) ( n -- ) CC> 28 shift bitor , ;
 83
 84: insn ( bitspec -- ) bitfield (insn) ; inline
 85
 86! Branching instructions
 87GENERIC# (B) 1 ( target l -- )
 88
 89M: integer (B) { 24 { 1 25 } { 0 26 } { 1 27 } 0 } insn ;
 90
 91PRIVATE>
 92
 93: B ( target -- ) 0 (B) ;
 94: BL ( target -- ) 1 (B) ;
 95
 96! Data processing instructions
 97<PRIVATE
 98
 99SYMBOL: updates-cond-code
100
101PRIVATE>
102
103: S ( -- ) updates-cond-code on ;
104
105: S> ( -- ? ) updates-cond-code [ f ] change ;
106
107<PRIVATE
108
109: sinsn ( bitspec -- )
110    bitfield S> [ 20 2^ bitor ] when (insn) ; inline
111
112GENERIC# shift-imm/reg 2 ( shift-imm/Rs Rm shift -- n )
113
114M: integer shift-imm/reg ( shift-imm Rm shift -- n )
115    { { 0 4 } 5 { register 0 } 7 } bitfield ;
116
117M: register shift-imm/reg ( Rs Rm shift -- n )
118    {
119        { 1 4 }
120        { 0 7 }
121        5
122        { register 8 }
123        { register 0 }
124    } bitfield ;
125
126PRIVATE>
127
128TUPLE: IMM immed rotate ;
129C: <IMM> IMM
130
131TUPLE: shifter Rm by shift ;
132C: <shifter> shifter
133
134<PRIVATE
135
136GENERIC: shifter-op ( shifter-op -- n )
137
138M: IMM shifter-op
139    [ immed>> ] [ rotate>> ] bi { { 1 25 } 8 0 } bitfield ;
140
141M: shifter shifter-op
142    [ by>> ] [ Rm>> ] [ shift>> ] tri shift-imm/reg ;
143
144PRIVATE>
145
146: <LSL> ( Rm shift-imm/Rs -- shifter-op ) 0b00 <shifter> ;
147: <LSR> ( Rm shift-imm/Rs -- shifter-op ) 0b01 <shifter> ;
148: <ASR> ( Rm shift-imm/Rs -- shifter-op ) 0b10 <shifter> ;
149: <ROR> ( Rm shift-imm/Rs -- shifter-op ) 0b11 <shifter> ;
150: <RRX> ( Rm -- shifter-op ) 0 <ROR> ;
151
152M: register shifter-op 0 <LSL> shifter-op ;
153M: integer shifter-op 0 <IMM> shifter-op ;
154
155<PRIVATE
156
157: addr1 ( Rd Rn shifter-op opcode -- )
158    {
159        21 ! opcode
160        { shifter-op 0 }
161        { register 16 } ! Rn
162        { register 12 } ! Rd
163    } sinsn ;
164
165PRIVATE>
166
167: AND ( Rd Rn shifter-op -- ) 0b0000 addr1 ;
168: EOR ( Rd Rn shifter-op -- ) 0b0001 addr1 ;
169: SUB ( Rd Rn shifter-op -- ) 0b0010 addr1 ;
170: RSB ( Rd Rn shifter-op -- ) 0b0011 addr1 ;
171: ADD ( Rd Rn shifter-op -- ) 0b0100 addr1 ;
172: ADC ( Rd Rn shifter-op -- ) 0b0101 addr1 ;
173: SBC ( Rd Rn shifter-op -- ) 0b0110 addr1 ;
174: RSC ( Rd Rn shifter-op -- ) 0b0111 addr1 ;
175: ORR ( Rd Rn shifter-op -- ) 0b1100 addr1 ;
176: BIC ( Rd Rn shifter-op -- ) 0b1110 addr1 ;
177
178: MOV ( Rd shifter-op -- ) [ f ] dip 0b1101 addr1 ;
179: MVN ( Rd shifter-op -- ) [ f ] dip 0b1111 addr1 ;
180
181! These always update the condition code flags
182<PRIVATE
183
184: (CMP) ( Rn shifter-op opcode -- ) [ f ] 3dip S addr1 ;
185
186PRIVATE>
187
188: TST ( Rn shifter-op -- ) 0b1000 (CMP) ;
189: TEQ ( Rn shifter-op -- ) 0b1001 (CMP) ;
190: CMP ( Rn shifter-op -- ) 0b1010 (CMP) ;
191: CMN ( Rn shifter-op -- ) 0b1011 (CMP) ;
192
193! Multiply instructions
194<PRIVATE
195
196: (MLA) ( Rd Rm Rs Rn a -- )
197    {
198        21
199        { register 12 }
200        { register 8 }
201        { register 0 }
202        { register 16 }
203        { 1 7 }
204        { 1 4 }
205    } sinsn ;
206
207: (S/UMLAL)  ( RdLo RdHi Rm Rs s a -- )
208    {
209        { 1 23 }
210        22
211        21
212        { register 8 }
213        { register 0 }
214        { register 16 }
215        { register 12 }
216        { 1 7 }
217        { 1 4 }
218    } sinsn ;
219
220PRIVATE>
221
222: MUL ( Rd Rm Rs -- ) f 0 (MLA) ;
223: MLA ( Rd Rm Rs Rn -- ) 1 (MLA) ;
224
225: SMLAL ( RdLo RdHi Rm Rs -- ) 1 1 (S/UMLAL) ;
226: SMULL ( RdLo RdHi Rm Rs -- ) 1 0 (S/UMLAL) ;
227: UMLAL ( RdLo RdHi Rm Rs -- ) 0 1 (S/UMLAL) ;
228: UMULL ( RdLo RdHi Rm Rs -- ) 0 0 (S/UMLAL) ;
229
230! Miscellaneous arithmetic instructions
231: CLZ ( Rd Rm -- )
232    {
233        { 1 24 }
234        { 1 22 }
235        { 1 21 }
236        { 0b111 16 }
237        { 0b1111 8 }
238        { 1 4 }
239        { register 0 }
240        { register 12 }
241    } sinsn ;
242
243! Status register acess instructions
244
245! Load and store instructions
246<PRIVATE
247
248GENERIC: addressing-mode-2 ( addressing-mode -- n )
249
250TUPLE: addressing base p u w ;
251C: <addressing> addressing
252
253M: addressing addressing-mode-2
254    { [ p>> ] [ u>> ] [ w>> ] [ base>> addressing-mode-2 ] } cleave
255    { 0 21 23 24 } bitfield ;
256
257M: integer addressing-mode-2 ;
258
259M: object addressing-mode-2 shifter-op { { 1 25 } 0 } bitfield ;
260
261: addr2 ( Rd Rn addressing-mode b l -- )
262    {
263        { 1 26 }
264        20
265        22
266        { addressing-mode-2 0 }
267        { register 16 }
268        { register 12 }
269    } insn ;
270
271PRIVATE>
272
273! Offset
274: <+> ( base -- addressing ) 1 1 0 <addressing> ;
275: <-> ( base -- addressing ) 1 0 0 <addressing> ;
276
277! Pre-indexed
278: <!+> ( base -- addressing ) 1 1 1 <addressing> ;
279: <!-> ( base -- addressing ) 1 0 1 <addressing> ;
280
281! Post-indexed
282: <+!> ( base -- addressing ) 0 1 0 <addressing> ;
283: <-!> ( base -- addressing ) 0 0 0 <addressing> ;
284
285: LDR  ( Rd Rn addressing-mode -- ) 0 1 addr2 ;
286: LDRB ( Rd Rn addressing-mode -- ) 1 1 addr2 ;
287: STR  ( Rd Rn addressing-mode -- ) 0 0 addr2 ;
288: STRB ( Rd Rn addressing-mode -- ) 1 0 addr2 ;
289
290! We might have to simulate these instructions since older ARM
291! chips don't have them.
292SYMBOL: have-BX?
293SYMBOL: have-BLX?
294
295<PRIVATE
296
297GENERIC# (BX) 1 ( Rm l -- )
298
299M: register (BX) ( Rm l -- )
300    {
301        { 1 24 }
302        { 1 21 }
303        { 0b1111 16 }
304        { 0b1111 12 }
305        { 0b1111 8 }
306        5
307        { 1 4 }
308        { register 0 }
309    } insn ;
310
311PRIVATE>
312
313: BX ( Rm -- ) have-BX? get [ 0 (BX) ] [ [ PC ] dip MOV ] if ;
314
315: BLX ( Rm -- ) have-BLX? get [ 1 (BX) ] [ LR PC MOV BX ] if ;
316
317! More load and store instructions
318<PRIVATE
319
320GENERIC: addressing-mode-3 ( addressing-mode -- n )
321
322: b>n/n ( b -- n n ) [ -4 shift ] [ 0xf bitand ] bi ;
323
324M: addressing addressing-mode-3
325    { [ p>> ] [ u>> ] [ w>> ] [ base>> addressing-mode-3 ] } cleave
326    { 0 21 23 24 } bitfield ;
327
328M: integer addressing-mode-3
329    b>n/n {
330        ! { 1 24 }
331        { 1 22 }
332        { 1 7 }
333        { 1 4 }
334        0
335        8
336    } bitfield ;
337
338M: object addressing-mode-3
339    shifter-op {
340        ! { 1 24 }
341        { 1 7 }
342        { 1 4 }
343        0
344    } bitfield ;
345
346: addr3 ( Rn Rd addressing-mode h l s -- )
347    {
348        6
349        20
350        5
351        { addressing-mode-3 0 }
352        { register 16 }
353        { register 12 }
354    } insn ;
355
356PRIVATE>
357
358: LDRH  ( Rn Rd addressing-mode -- ) 1 1 0 addr3 ;
359: LDRSB ( Rn Rd addressing-mode -- ) 0 1 1 addr3 ;
360: LDRSH ( Rn Rd addressing-mode -- ) 1 1 1 addr3 ;
361: STRH  ( Rn Rd addressing-mode -- ) 1 0 0 addr3 ;
362
363! Load and store multiple instructions
364
365! Semaphore instructions
366
367! Exception-generating instructions