extra/cpu/arm/assembler/assembler.factor

   1 ! Copyright (C) 2007, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays combinators kernel make math math.bitwise
   4 namespaces sequences words words.symbol parser ;
   5 IN: cpu.arm.assembler
   6
   7 ! Registers
   8 <<
   9
  10 SYMBOL: registers
  11
  12 V{ } registers set-global
  13
  14 SYNTAX: 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
  23 REGISTER: R0
  24 REGISTER: R1
  25 REGISTER: R2
  26 REGISTER: R3
  27 REGISTER: R4
  28 REGISTER: R5
  29 REGISTER: R6
  30 REGISTER: R7
  31 REGISTER: R8
  32 REGISTER: R9
  33 REGISTER: R10
  34 REGISTER: R11
  35 REGISTER: R12
  36 REGISTER: R13
  37 REGISTER: R14
  38 REGISTER: R15
  39
  40 ALIAS: SL R10 ALIAS: FP R11 ALIAS: IP R12
  41 ALIAS: SP R13 ALIAS: LR R14 ALIAS: PC R15
  42
  43 <PRIVATE
  44
  45 PREDICATE: register < word register >boolean ;
  46
  47 GENERIC: register ( register -- n )
  48 M: word register "register" word-prop ;
  49 M: f register drop 0 ;
  50
  51 PRIVATE>
  52
  53 ! Condition codes
  54 SYMBOL: 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
  87 GENERIC# (B) 1 ( target l -- )
  88
  89 M: integer (B) { 24 { 1 25 } { 0 26 } { 1 27 } 0 } insn ;
  90
  91 PRIVATE>
  92
  93 : B ( target -- ) 0 (B) ;
  94 : BL ( target -- ) 1 (B) ;
  95
  96 ! Data processing instructions
  97 <PRIVATE
  98
  99 SYMBOL: updates-cond-code
 100
 101 PRIVATE>
 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
 112 GENERIC# shift-imm/reg 2 ( shift-imm/Rs Rm shift -- n )
 113
 114 M: integer shift-imm/reg ( shift-imm Rm shift -- n )
 115     { { 0 4 } 5 { register 0 } 7 } bitfield ;
 116
 117 M: 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
 126 PRIVATE>
 127
 128 TUPLE: IMM immed rotate ;
 129 C: <IMM> IMM
 130
 131 TUPLE: shifter Rm by shift ;
 132 C: <shifter> shifter
 133
 134 <PRIVATE
 135
 136 GENERIC: shifter-op ( shifter-op -- n )
 137
 138 M: IMM shifter-op
 139     [ immed>> ] [ rotate>> ] bi { { 1 25 } 8 0 } bitfield ;
 140
 141 M: shifter shifter-op
 142     [ by>> ] [ Rm>> ] [ shift>> ] tri shift-imm/reg ;
 143
 144 PRIVATE>
 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
 152 M: register shifter-op 0 <LSL> shifter-op ;
 153 M: 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
 165 PRIVATE>
 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
 186 PRIVATE>
 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
 220 PRIVATE>
 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
 248 GENERIC: addressing-mode-2 ( addressing-mode -- n )
 249
 250 TUPLE: addressing base p u w ;
 251 C: <addressing> addressing
 252
 253 M: addressing addressing-mode-2
 254     { [ p>> ] [ u>> ] [ w>> ] [ base>> addressing-mode-2 ] } cleave
 255     { 0 21 23 24 } bitfield ;
 256
 257 M: integer addressing-mode-2 ;
 258
 259 M: 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
 271 PRIVATE>
 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.
 292 SYMBOL: have-BX?
 293 SYMBOL: have-BLX?
 294
 295 <PRIVATE
 296
 297 GENERIC# (BX) 1 ( Rm l -- )
 298
 299 M: 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
 311 PRIVATE>
 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
 320 GENERIC: addressing-mode-3 ( addressing-mode -- n )
 321
 322 : b>n/n ( b -- n n ) [ -4 shift ] [ 0xf bitand ] bi ;
 323
 324 M: addressing addressing-mode-3
 325     { [ p>> ] [ u>> ] [ w>> ] [ base>> addressing-mode-3 ] } cleave
 326     { 0 21 23 24 } bitfield ;
 327
 328 M: 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
 338 M: 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
 356 PRIVATE>
 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