unmaintained/arm/assembler/assembler.factor

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