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

http://github.com/abeaumont/factor · Factor · 367 lines · 255 code · 90 blank · 22 comment · 8 complexity · 64bb51aabe36a481b125fbdc5fda3a84 MD5 · raw file

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