PageRenderTime 59ms CodeModel.GetById 25ms RepoModel.GetById 0ms app.codeStats 0ms

/red-system/targets/IA-32.r

http://github.com/dockimbel/Red
R | 1088 lines | 979 code | 70 blank | 39 comment | 115 complexity | 97a58f28911fdd60bcc22eff8cb0015f MD5 | raw file
  1. REBOL [
  2. Title: "Red/System IA-32 code emitter"
  3. Author: "Nenad Rakocevic"
  4. File: %IA-32.r
  5. Rights: "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
  6. License: "BSD-3 - https://github.com/dockimbel/Red/blob/master/BSD-3-License.txt"
  7. ]
  8. make target-class [
  9. target: 'IA-32
  10. little-endian?: yes
  11. struct-align-size: 4
  12. ptr-size: 4
  13. default-align: 4
  14. stack-width: 4
  15. args-offset: 8 ;-- stack frame offset to arguments (esp + ebp)
  16. branch-offset-size: 4 ;-- size of JMP offset
  17. conditions: make hash! [
  18. ;-- name ----------- signed --- unsigned --
  19. overflow? #{00} -
  20. not-overflow? #{01} -
  21. = #{04} -
  22. <> #{05} -
  23. signed? #{08} -
  24. unsigned? #{09}
  25. even? #{0A} -
  26. odd? #{0B} -
  27. < #{0C} #{02}
  28. >= #{0D} #{03}
  29. <= #{0E} #{06}
  30. > #{0F} #{07}
  31. ]
  32. add-condition: func [op [word!] data [binary!]][
  33. op: either '- = third op: find conditions op [op/2][
  34. pick op pick [2 3] signed?
  35. ]
  36. data/(length? data): (to char! last data) or (to char! first op) ;-- REBOL2's awful binary! handling
  37. data
  38. ]
  39. emit-poly: func [spec [block!] /local to-bin][ ;-- polymorphic code generation
  40. spec: reduce spec
  41. emit switch width [
  42. 1 [spec/1] ;-- 8-bit
  43. 2 [emit #{66} spec/2] ;-- 16-bit
  44. 4 [spec/2] ;-- 32-bit
  45. ;8 not yet supported
  46. ]
  47. to-bin: get select [1 to-bin8 2 to-bin16 4 to-bin32] width
  48. case/all [
  49. 2 < length? spec [emit to-bin to integer! compiler/unbox spec/3] ;-- emit displacement or immediate
  50. 3 < length? spec [emit to-bin to integer! compiler/unbox spec/4] ;-- emit displacement or immediate
  51. ]
  52. ]
  53. emit-variable-poly: func [ ;-- polymorphic variable access generation
  54. name [word! object!]
  55. g8 [binary!] g32 [binary!] ;-- opcodes for global variables
  56. l8 [binary! block!] l32 [binary! block!] ;-- opcodes for local variables
  57. ][
  58. with-width-of name [
  59. switch width [
  60. 1 [emit-variable name g8 l8] ;-- 8-bit
  61. 2 [emit #{66} emit-variable name g32 l32] ;-- 16-bit
  62. 4 [emit-variable name g32 l32] ;-- 32-bit
  63. ]
  64. ]
  65. ]
  66. emit-save-last: does [
  67. last-saved?: yes
  68. emit #{50} ;-- PUSH eax
  69. ]
  70. emit-restore-last: does [
  71. emit #{5A} ;-- POP edx
  72. ]
  73. emit-casting: func [value [object!] alt? [logic!] /local old][
  74. type: compiler/get-type value/data
  75. case [
  76. value/type/1 = 'logic! [
  77. if verbose >= 3 [print [">>>converting from" mold/flat type/1 "to logic!"]]
  78. old: width
  79. set-width/type type/1
  80. emit #{31DB} ;-- XOR ebx, ebx
  81. either alt? [
  82. emit-poly [#{80FA00} #{83FA00}] ;-- CMP rD, 0
  83. emit #{7401} ;-- JZ _exit
  84. emit #{43} ;-- INC ebx
  85. emit #{89DA} ;-- _exit: MOV edx, ebx
  86. ][
  87. emit-poly [#{3C00} #{83F800}] ;-- CMP rA, 0
  88. emit #{7401} ;-- JZ _exit
  89. emit #{43} ;-- INC ebx
  90. emit #{89D8} ;-- _exit: MOV eax, ebx
  91. ]
  92. width: old
  93. ]
  94. all [value/type/1 = 'integer! type/1 = 'byte!][
  95. if verbose >= 3 [print ">>>converting from byte! to integer! "]
  96. emit pick [#{81E2} #{25}] alt? ;-- AND edx|eax, 000000FFh
  97. emit to-bin32 255
  98. ]
  99. ]
  100. ]
  101. emit-load-literal: func [type [block! none!] value /local spec][
  102. unless type [type: compiler/get-type value]
  103. spec: emitter/store-value none value type
  104. emit #{B8} ;-- MOV eax, value
  105. emit-reloc-addr spec/2 ;-- one-based index
  106. ]
  107. emit-get-pc: does [
  108. emit #{E800000000} ;-- CALL next ; call the next instruction
  109. emit-pop ;-- get eip in eax
  110. ]
  111. emit-set-stack: func [value /frame][
  112. if verbose >= 3 [print [">>>emitting SET-STACK" mold value]]
  113. emit-load value
  114. either frame [
  115. emit #{89C5} ;-- MOV ebp, eax
  116. ][
  117. emit #{89C4} ;-- MOV esp, eax
  118. ]
  119. ]
  120. emit-get-stack: func [/frame][
  121. if verbose >= 3 [print ">>>emitting GET-STACK"]
  122. either frame [
  123. emit #{89E8} ;-- MOV eax, ebp
  124. ][
  125. emit #{89E0} ;-- MOV eax, esp
  126. ]
  127. ]
  128. emit-pop: does [
  129. if verbose >= 3 [print ">>>emitting POP"]
  130. emit #{58} ;-- POP eax
  131. ]
  132. emit-not: func [value [word! char! tag! integer! logic! path! string! object!] /local opcodes type boxed][
  133. if verbose >= 3 [print [">>>emitting NOT" mold value]]
  134. if object? value [boxed: value]
  135. value: compiler/unbox value
  136. if block? value [value: <last>]
  137. opcodes: [
  138. logic! [emit #{3401}] ;-- XOR al, 1 ; invert 0<=>1
  139. byte! [emit #{F6D0}] ;-- NOT al ; @@ missing 16-bit support
  140. integer! [emit #{F7D0}] ;-- NOT eax
  141. ]
  142. switch type?/word value [
  143. logic! [
  144. emit-load not value
  145. ]
  146. char! [
  147. emit-load value
  148. do opcodes/byte!
  149. ]
  150. integer! [
  151. emit-load value
  152. do opcodes/integer!
  153. ]
  154. word! [
  155. emit-load value
  156. if boxed [emit-casting boxed no]
  157. type: first compiler/resolve-aliased compiler/get-variable-spec value
  158. if find [pointer! c-string! struct!] type [ ;-- type casting trap
  159. type: 'logic!
  160. ]
  161. switch type opcodes
  162. ]
  163. tag! [
  164. if boxed [emit-casting boxed no]
  165. switch compiler/last-type/1 opcodes
  166. ]
  167. string! [ ;-- type casting trap
  168. emit-load value
  169. if boxed [emit-casting boxed no]
  170. do opcodes/logic!
  171. ]
  172. path! [
  173. emitter/access-path value none
  174. either boxed [
  175. emit-casting boxed no
  176. switch boxed/type/1 opcodes
  177. ][
  178. do opcodes/integer!
  179. ]
  180. ]
  181. ]
  182. ]
  183. emit-boolean-switch: does [
  184. emit #{31C0} ;-- XOR eax, eax ; eax = 0 (FALSE)
  185. emit #{EB03} ;-- JMP _exit
  186. emit #{31C0} ;-- XOR eax, eax
  187. emit #{40} ;-- INC eax ; eax = 1 (TRUE)
  188. ;-- _exit:
  189. reduce [3 7] ;-- [offset-TRUE offset-FALSE]
  190. ]
  191. emit-load: func [
  192. value [char! logic! integer! word! string! path! paren! get-word! object!]
  193. /alt
  194. ][
  195. if verbose >= 3 [print [">>>loading" mold value]]
  196. switch type?/word value [
  197. char! [
  198. emit #{B0} ;-- MOV al, value
  199. emit value
  200. ]
  201. logic! [
  202. emit #{31C0} ;-- XOR eax, eax ; eax = 0 (FALSE)
  203. if value [
  204. emit #{40} ;-- INC eax ; eax = 1 (TRUE)
  205. ]
  206. ]
  207. integer! [
  208. emit #{B8} ;-- MOV eax, value
  209. emit to-bin32 value
  210. ]
  211. word! [
  212. with-width-of value [
  213. either alt [
  214. emit-variable-poly value
  215. #{8A15} #{8B15} ;-- MOV rD, [value] ; global
  216. #{8A55} #{8B55} ;-- MOV rD, [ebp+n] ; local
  217. ][
  218. emit-variable-poly value
  219. #{A0} #{A1} ;-- MOV rA, [value] ; global
  220. #{8A45} #{8B45} ;-- MOV rA, [ebp+n] ; local
  221. ]
  222. ]
  223. ]
  224. get-word! [
  225. emit #{B8} ;-- MOV eax, &name
  226. emit-reloc-addr emitter/get-func-ref to word! value ;-- symbol address
  227. ]
  228. string! [
  229. emit-load-literal [c-string!] value
  230. ]
  231. path! [
  232. emitter/access-path value none
  233. ]
  234. paren! [
  235. emit-load-literal none value
  236. ]
  237. object! [
  238. unless any [block? value/data value/data = <last>][
  239. either alt [emit-load/alt value/data][emit-load value/data]
  240. ]
  241. ]
  242. ]
  243. ]
  244. emit-store: func [
  245. name [word!] value [char! logic! integer! word! string! paren! tag! get-word!] spec [block! none!]
  246. /local store-dword
  247. ][
  248. if verbose >= 3 [print [">>>storing" mold name mold value]]
  249. if value = <last> [value: 'last] ;-- force word! code path in switch block
  250. if logic? value [value: to integer! value] ;-- TRUE -> 1, FALSE -> 0
  251. store-dword: [
  252. emit-variable name
  253. #{C705} ;-- MOV dword [name], value ; global
  254. #{C745} ;-- MOV dword [ebp+n], value ; local
  255. ]
  256. switch type?/word value [
  257. char! [
  258. emit-variable name
  259. #{C605} ;-- MOV byte [name], value
  260. #{C645} ;-- MOV byte [ebp+n], value
  261. emit value
  262. ]
  263. integer! [
  264. do store-dword
  265. emit to-bin32 value
  266. ]
  267. word! [
  268. set-width name
  269. emit-variable-poly name
  270. #{A2} #{A3} ;-- MOV [name], rA ; global variable
  271. #{8845} #{8945} ;-- MOV [ebp+n], rA ; local variable
  272. ]
  273. get-word! [
  274. do store-dword
  275. emit-reloc-addr emitter/get-func-ref to word! value ;-- symbol address
  276. ]
  277. string! [
  278. do store-dword
  279. emit-reloc-addr spec/2
  280. ]
  281. paren! [
  282. do store-dword
  283. emit-reloc-addr spec/2
  284. ]
  285. ]
  286. ]
  287. emit-init-path: func [name [word!]][
  288. emit-variable name
  289. #{A1} ;-- MOV eax, [name] ; global
  290. #{8B45} ;-- MOV eax, [ebp+n] ; local
  291. ]
  292. emit-access-path: func [
  293. path [path! set-path!] spec [block! none!] /short /local offset type saved
  294. ][
  295. if verbose >= 3 [print [">>>accessing path:" mold path]]
  296. unless spec [
  297. spec: second compiler/resolve-type path/1
  298. emit-init-path path/1
  299. ]
  300. if short [return spec]
  301. saved: width
  302. type: first compiler/resolve-type/with path/2 spec
  303. set-width/type type ;-- adjust operations width to member value size
  304. either zero? offset: emitter/member-offset? spec path/2 [
  305. emit-poly [#{8A00} #{8B00}] ;-- MOV rA, [eax]
  306. ][
  307. emit-poly [#{8A80} #{8B80}] ;-- MOV rA, [eax+offset]
  308. emit to-bin32 offset
  309. ]
  310. width: saved
  311. ]
  312. emit-load-index: func [idx [word!]][
  313. emit-variable idx
  314. #{8B1D} ;-- MOV ebx, [idx] ; global
  315. #{8B5D} ;-- MOV ebx, [ebp+n] ; local
  316. emit #{4B} ;-- DEC ebx ; one-based index
  317. ]
  318. emit-c-string-path: func [path [path! set-path!] parent [block! none!] /local opcodes idx][
  319. either parent [
  320. emit #{89C6} ;-- MOV esi, eax ; nested access
  321. ][
  322. emit-variable path/1
  323. #{8B35} ;-- MOV esi, [value1] ; global
  324. [
  325. #{8D45} ;-- LEA eax, [ebp+n] ; local
  326. offset ;-- n
  327. #{8B30} ;-- MOV esi, [eax]
  328. ]
  329. ]
  330. opcodes: pick [[ ;-- store path opcodes --
  331. #{8816} ;-- MOV [esi], dl ; first
  332. #{8896} ;-- MOV [esi + idx], dl ; n-th
  333. #{88141E} ;-- MOV [esi + ebx], dl ; variable index
  334. ][ ;-- load path opcodes --
  335. #{8A06} ;-- MOV al, [esi] ; first
  336. #{8A86} ;-- MOV al, [esi + idx] ; n-th
  337. #{8A041E} ;-- MOV al, [esi + ebx] ; variable index
  338. ]] set-path? path
  339. either integer? idx: path/2 [
  340. either zero? idx: idx - 1 [ ;-- indexes are one-based
  341. emit opcodes/1
  342. ][
  343. emit opcodes/2
  344. emit to-bin32 idx
  345. ]
  346. ][
  347. emit-load-index idx
  348. emit opcodes/3
  349. ]
  350. ]
  351. emit-pointer-path: func [
  352. path [path! set-path!] parent [block! none!] /local opcodes idx type
  353. ][
  354. opcodes: pick [[ ;-- store path opcodes --
  355. [#{8810} #{8910}] ;-- MOV [eax], rD
  356. [#{8890} #{8990}] ;-- MOV [eax + idx * sizeof(p/value)], rD
  357. [#{881418} #{891498}] ;-- MOV [eax + ebx * sizeof(p/value)], rD
  358. ][ ;-- load path opcodes --
  359. [#{8A00} #{8B00}] ;-- MOV rA, [eax]
  360. [#{8A80} #{8B80}] ;-- MOV rA, [eax + idx * sizeof(p/value)]
  361. [#{8A0418} #{8B0498}] ;-- MOV rA, [eax + ebx * sizeof(p/value)]
  362. ]] set-path? path
  363. type: either parent [
  364. compiler/resolve-type/with path/1 parent
  365. ][
  366. emit-init-path path/1
  367. compiler/resolve-type path/1
  368. ]
  369. set-width/type type/2/1 ;-- adjust operations width to pointed value size
  370. idx: either path/2 = 'value [1][path/2]
  371. either integer? idx [
  372. either zero? idx: idx - 1 [ ;-- indexes are one-based
  373. emit-poly opcodes/1
  374. ][
  375. emit-poly opcodes/2
  376. emit to-bin32 idx * emitter/size-of? type/2/1
  377. ]
  378. ][
  379. emit-load-index idx
  380. emit-poly opcodes/3
  381. ]
  382. ]
  383. emit-load-path: func [path [path!] type [word!] parent [block! none!] /local idx][
  384. if verbose >= 3 [print [">>>loading path:" mold path]]
  385. switch type [
  386. c-string! [emit-c-string-path path parent]
  387. pointer! [emit-pointer-path path parent]
  388. struct! [emit-access-path path parent]
  389. ]
  390. ]
  391. emit-store-path: func [path [set-path!] type [word!] value parent [block! none!] /local idx offset][
  392. if verbose >= 3 [print [">>>storing path:" mold path mold value]]
  393. if parent [emit #{89C2}] ;-- MOV edx, eax ; save value/address
  394. unless value = <last> [emit-load value]
  395. emit #{92} ;-- XCHG eax, edx ; save value/restore address
  396. switch type [
  397. c-string! [emit-c-string-path path parent]
  398. pointer! [emit-pointer-path path parent]
  399. struct! [
  400. unless parent [parent: emit-access-path/short path parent]
  401. type: first compiler/resolve-type/with path/2 parent
  402. set-width/type type ;-- adjust operations width to member value size
  403. either zero? offset: emitter/member-offset? parent path/2 [
  404. emit-poly [#{8810} #{8910}] ;-- MOV [eax], rD
  405. ][
  406. emit-poly [#{8890} #{8990}] ;-- MOV [eax+offset], rD
  407. emit to-bin32 offset
  408. ]
  409. ]
  410. ]
  411. ]
  412. patch-exit-call: func [code-buf [binary!] ptr [integer!] exit-point [integer!]][
  413. change at code-buf ptr to-bin32 exit-point - ptr - branch-offset-size
  414. ]
  415. emit-exit: does [
  416. emit #{E9} ;-- JMP imm32
  417. emit-reloc-addr compose/only [- - (emitter/exits)]
  418. ]
  419. emit-branch: func [
  420. code [binary!]
  421. op [word! block! logic! none!]
  422. offset [integer! none!]
  423. /back?
  424. /local size imm8? opcode jmp
  425. ][
  426. if verbose >= 3 [print [">>>inserting branch" either op [join "cc: " mold op][""]]]
  427. size: (length? code) - any [offset 0] ;-- offset from the code's head
  428. imm8?: size <= either back? [126][127] ;-- account 2 bytes for JMP imm8
  429. opcode: either not none? op [ ;-- explicitly test for none
  430. op: case [
  431. block? op [ ;-- [cc] => keep
  432. op: op/1
  433. either logic? op [pick [= <>] op][op] ;-- [logic!] or [cc]
  434. ]
  435. logic? op [pick [= <>] op] ;-- test for TRUE/FALSE
  436. 'else [opposite? op] ;-- 'cc => invert condition
  437. ]
  438. add-condition op copy pick [#{70} #{0F80}] imm8? ;-- Jcc offset ; 8/32-bit displacement
  439. ][
  440. pick [#{EB} #{E9}] imm8? ;-- JMP offset ; 8/32-bit displacement
  441. ]
  442. if back? [size: negate (size + (length? opcode) + pick [1 4] imm8?)]
  443. jmp: rejoin [opcode either imm8? [to-bin8 size][to-bin32 size]]
  444. insert any [all [back? tail code] code] jmp
  445. length? jmp
  446. ]
  447. emit-push: func [
  448. value [char! logic! integer! word! block! string! tag! path! get-word! object!]
  449. /with cast [object!]
  450. /local spec type
  451. ][
  452. if verbose >= 3 [print [">>>pushing" mold value]]
  453. if block? value [value: <last>]
  454. switch type?/word value [
  455. tag! [ ;-- == <last>
  456. emit #{50} ;-- PUSH eax
  457. ]
  458. logic! [
  459. emit #{31C0} ;-- XOR eax, eax ; eax = 0 (FALSE)
  460. if value [
  461. emit #{40} ;-- INC eax ; eax = 1 (TRUE)
  462. ]
  463. emit #{50} ;-- PUSH eax
  464. ]
  465. char! [
  466. emit #{6A} ;-- PUSH value
  467. emit value
  468. ]
  469. integer! [
  470. either all [-128 <= value value <= 127][
  471. emit #{6A} ;-- PUSH imm8
  472. emit to-bin8 value
  473. ][
  474. emit #{68} ;-- PUSH imm32
  475. emit to-bin32 value
  476. ]
  477. ]
  478. word! [
  479. type: first compiler/get-variable-spec value
  480. emit-variable value
  481. #{FF35} ;-- PUSH [value] ; global
  482. #{FF75} ;-- PUSH [ebp+n] ; local
  483. ]
  484. get-word! [
  485. emit #{68} ;-- PUSH &value
  486. emit-reloc-addr emitter/get-func-ref to word! value ;-- value memory address
  487. ]
  488. string! [
  489. spec: emitter/store-value none value [c-string!]
  490. emit #{68} ;-- PUSH value
  491. emit-reloc-addr spec/2 ;-- one-based index
  492. ]
  493. path! [
  494. emitter/access-path value none
  495. if cast [emit-casting cast no]
  496. emit-push <last>
  497. ]
  498. object! [
  499. either path? value/data [
  500. emit-push/with value/data value
  501. ][
  502. emit-push value/data
  503. ]
  504. ]
  505. ]
  506. ]
  507. emit-sign-extension: does [
  508. emit switch width [
  509. 1 [#{6698}] ;-- CBW ; extend AL to AX
  510. 2 [#{6699}] ;-- CWD ; extend AX to DX:AX
  511. 4 [#{99}] ;-- CDQ ; extend EAX to EDX:EAX
  512. ]
  513. ]
  514. emit-bitshift-op: func [name [word!] a [word!] b [word!] args [block!] /local c value][
  515. switch b [
  516. ref [
  517. emit-variable args/2
  518. #{8A0D} ;-- MOV cl, byte [value] ; global
  519. #{8A4D} ;-- MOV cl, byte [ebp+n] ; local
  520. ]
  521. reg [emit #{88D1}] ;-- MOV cl, dl
  522. ]
  523. switch name [
  524. << [
  525. emit-poly pick [
  526. [#{C0E0} #{C1E0}] ;-- SAL|SHL rA, value
  527. [#{D2E0} #{D3E0}] ;-- SAL|SHL rA, cl
  528. ] b = 'imm
  529. ]
  530. >> [
  531. emit-poly pick [
  532. [#{C0F8} #{C1F8}] ;-- SAR rA, value
  533. [#{D2F8} #{D3F8}] ;-- SAR rA, cl
  534. ] b = 'imm
  535. ]
  536. -** [
  537. emit-poly pick [
  538. [#{C0E8} #{C1E8}] ;-- SHR rA, value
  539. [#{D2E8} #{D3E8}] ;-- SHR rA, cl
  540. ] b = 'imm
  541. ]
  542. ]
  543. if b = 'imm [
  544. c: select [1 7 2 15 4 31] width
  545. value: compiler/unbox args/2
  546. unless all [0 <= value value <= c][
  547. compiler/backtrack name
  548. compiler/throw-error rejoin [
  549. "a value in 0-" c " range is required for this shift operation"
  550. ]
  551. ]
  552. emit to-bin8 value
  553. ]
  554. ]
  555. emit-bitwise-op: func [name [word!] a [word!] b [word!] args [block!] /local code][
  556. code: select [
  557. and [
  558. #{25} ;-- AND eax, value
  559. #{21D0} ;-- AND eax, edx ; commutable op
  560. ]
  561. or [
  562. #{0D} ;-- OR eax, value
  563. #{09D0} ;-- OR eax, edx ; commutable op
  564. ]
  565. xor [
  566. #{35} ;-- XOR eax, value
  567. #{31D0} ;-- XOR eax, edx ; commutable op
  568. ]
  569. ] name
  570. switch b [
  571. imm [
  572. emit code/1 ;-- <OP> eax, value
  573. emit to-bin32 compiler/unbox args/2
  574. ]
  575. ref [
  576. emit-load/alt args/2
  577. if object? args/2 [emit-casting args/2 yes]
  578. emit code/2
  579. ]
  580. reg [emit code/2] ;-- <OP> eax, edx ; commutable op
  581. ]
  582. ]
  583. emit-comparison-op: func [name [word!] a [word!] b [word!] args [block!] /local op-poly][
  584. op-poly: [emit-poly [#{38D0} #{39D0}]] ;-- CMP rA, rD ; not commutable op
  585. switch b [
  586. imm [
  587. emit-poly [#{3C} #{3D} args/2] ;-- CMP rA, value
  588. ]
  589. ref [
  590. emit-load/alt args/2
  591. if object? args/2 [emit-casting args/2 yes]
  592. do op-poly
  593. ]
  594. reg [
  595. do op-poly
  596. ]
  597. ]
  598. ]
  599. emit-math-op: func [
  600. name [word!] a [word!] b [word!] args [block!]
  601. /local mod? scale c type arg2 op-poly
  602. ][
  603. ;-- eax = a, edx = b
  604. if find [// ///] name [ ;-- work around unaccepted '// and '///
  605. mod?: select [// mod /// rem] name ;-- convert operators to words (easier to handle)
  606. name: first [/] ;-- work around unaccepted '/
  607. ]
  608. arg2: compiler/unbox args/2
  609. if all [
  610. find [+ -] name ;-- pointer arithmetic only allowed for + & -
  611. type: compiler/resolve-expr-type args/1
  612. not compiler/any-pointer? compiler/resolve-expr-type args/2 ;-- no scaling if both operands are pointers
  613. scale: switch type/1 [
  614. pointer! [emitter/size-of? type/2/1] ;-- scale factor: size of pointed value
  615. struct! [emitter/member-offset? type/2 none] ;-- scale factor: total size of the struct
  616. ]
  617. scale > 1
  618. ][
  619. either compiler/literal? arg2 [
  620. arg2: arg2 * scale ;-- 'b is a literal, so scale it directly
  621. ][
  622. either b = 'reg [
  623. emit #{92} ;-- XCHG eax, edx ; put operands in right order
  624. ][ ;-- 'b will now be stored in reg, so save 'a
  625. emit-poly [#{88C2} #{89C2}] ;-- MOV rD, rA
  626. emit-load args/2
  627. ]
  628. emit-math-op '* 'reg 'imm reduce [arg2 scale]
  629. if name = '- [emit #{92}] ;-- XCHG eax, edx ; put operands in right order
  630. b: 'reg
  631. ]
  632. ]
  633. ;-- eax = a, edx = b
  634. switch name [
  635. + [
  636. op-poly: [
  637. emit-poly [#{00D0} #{01D0}] ;-- ADD rA, rD ; commutable op
  638. ]
  639. switch b [
  640. imm [
  641. emit-poly either arg2 = 1 [ ;-- trivial optimization
  642. [#{FEC0} #{40}] ;-- INC rA
  643. ][
  644. [#{04} #{05} arg2] ;-- ADD rA, value
  645. ]
  646. ]
  647. ref [
  648. emit-load/alt args/2
  649. do op-poly
  650. ]
  651. reg [do op-poly]
  652. ]
  653. ]
  654. - [
  655. op-poly: [
  656. emit-poly [#{28D0} #{29D0}] ;-- SUB rA, rD ; not commutable op
  657. ]
  658. switch b [
  659. imm [
  660. emit-poly either arg2 = 1 [ ;-- trivial optimization
  661. [#{FEC8} #{48}] ;-- DEC rA
  662. ][
  663. [#{2C} #{2D} arg2] ;-- SUB rA, value
  664. ]
  665. ]
  666. ref [
  667. emit-load/alt args/2
  668. do op-poly
  669. ]
  670. reg [do op-poly]
  671. ]
  672. ]
  673. * [
  674. op-poly: [
  675. emit-poly [#{F6EA} #{F7EA}] ;-- IMUL rD ; commutable op
  676. ]
  677. switch b [
  678. imm [
  679. either all [
  680. not zero? arg2
  681. c: power-of-2? arg2 ;-- trivial optimization for b=2^n
  682. ][
  683. either width = 1 [
  684. emit #{C0E0} ;-- SHL al, log2(b) ; 8-bit unsigned
  685. ][
  686. emit-poly [#{C0ED} #{C1E0}] ;-- SAL rA, log2(b) ; signed
  687. ]
  688. emit to-bin8 c
  689. ][
  690. unless width = 1 [emit #{52}] ;-- PUSH edx ; save edx from corruption for 16/32-bit ops
  691. with-width-of/alt args/2 [
  692. emit-poly [#{B2} #{BA} args/2] ;-- MOV rD, value
  693. ]
  694. emit #{89D3} ;-- MOV ebx, edx
  695. emit-poly [#{F6EB} #{F7EB}] ;-- IMUL rB ; result in ax|eax|edx:eax
  696. unless width = 1 [emit #{5A}] ;-- POP edx
  697. ]
  698. ]
  699. ref [
  700. emit #{52} ;-- PUSH edx ; save edx from corruption
  701. emit-load/alt args/2
  702. do op-poly
  703. emit #{5A} ;-- POP edx
  704. ]
  705. reg [do op-poly]
  706. ]
  707. ]
  708. / [
  709. op-poly: [
  710. either width = 1 [ ;-- 8-bit unsigned
  711. emit #{B400} ;-- MOV ah, 0 ; clean-up garbage in ah
  712. emit #{F6F3} ;-- DIV bl
  713. ][
  714. emit-sign-extension ;-- 16/32-bit signed
  715. emit-poly [#{F6FB} #{F7FB}] ;-- IDIV rB ; rA / rB
  716. ]
  717. ]
  718. switch b [
  719. imm [ ;-- SAR usage http://www.arl.wustl.edu/~lockwood/class/cs306/books/artofasm/Chapter_6/CH06-3.html#HEADING3-120
  720. emit #{52} ;-- PUSH edx ; save edx from corruption
  721. with-width-of/alt args/2 [
  722. emit-poly [#{B2} #{BA} args/2] ;-- MOV rD, value
  723. ]
  724. emit #{89D3} ;-- MOV ebx, edx
  725. do op-poly
  726. ]
  727. ref [
  728. emit #{52} ;-- PUSH edx ; save edx from corruption
  729. emit-load/alt args/2
  730. emit #{89D3} ;-- MOV ebx, edx
  731. do op-poly
  732. ]
  733. reg [
  734. emit #{89D3} ;-- MOV ebx, edx ; ebx = b
  735. do op-poly
  736. ]
  737. ]
  738. if mod? [
  739. emit-poly [#{88E0} #{89D0}] ;-- MOV rA, remainder ; remainder from ah|dx|edx
  740. if all [mod? <> 'rem width > 1][;-- modulo, not remainder
  741. ;-- Adjust modulo result to be mathematically correct:
  742. ;-- if modulo < 0 [
  743. ;-- if divisor < 0 [divisor: negate divisor]
  744. ;-- modulo: modulo + divisor
  745. ;-- ]
  746. c: to-bin8 select [1 7 2 15 4 31] width ;-- support for possible int8 type
  747. emit #{0FBAE0} ;-- BT rA, 7|15|31 ; @@ better way ?
  748. emit c
  749. emit #{730A} ;-- JNC exit ; (won't work with ax)
  750. emit #{0FBAE3} ;-- BT rB, 7|15|31 ; @@ better way ?
  751. emit c
  752. emit #{7302} ;-- JNC add ; (won't work with ax)
  753. emit-poly [#{F6DB} #{F7DB}] ;-- NEG rB
  754. emit-poly [#{00D8} #{01D8}] ;-- add: ADD rA, rB
  755. ] ;-- exit:
  756. ]
  757. if any [ ;-- in case edx was saved on stack
  758. all [b = 'imm any [mod? not c]]
  759. b = 'ref
  760. ][
  761. emit #{5A} ;-- POP edx
  762. ]
  763. ]
  764. ]
  765. ;TBD: test overflow and raise exception ? (or store overflow flag in a variable??)
  766. ; JNO? (Jump if No Overflow)
  767. ]
  768. emit-operation: func [name [word!] args [block!] /local a b c sorted? arg left right][
  769. if verbose >= 3 [print [">>>inlining op:" mold name mold args]]
  770. set-width args/1 ;-- set reg/mem access width
  771. c: 1
  772. foreach op [a b][
  773. arg: either object? args/:c [compiler/cast args/:c][args/:c]
  774. set op either arg = <last> [
  775. 'reg ;-- value in eax
  776. ][
  777. switch type?/word arg [
  778. char! ['imm] ;-- add or mov to al
  779. integer! ['imm] ;-- add or mov to eax
  780. word! ['ref] ;-- fetch value
  781. block! ['reg] ;-- value in eax (or in edx)
  782. path! ['reg] ;-- value in eax (or in edx)
  783. ]
  784. ]
  785. c: c + 1
  786. ]
  787. if verbose >= 3 [?? a ?? b] ;-- a and b hold addressing modes for operands
  788. ;-- First operand processing
  789. left: compiler/unbox args/1
  790. right: compiler/unbox args/2
  791. switch to path! reduce [a b] [
  792. imm/imm [emit-poly [#{B0} #{B8} args/1]];-- MOV rA, a
  793. imm/ref [emit-load args/1] ;-- eax = a
  794. imm/reg [ ;-- eax = b
  795. if path? right [
  796. emit-load args/2 ;-- late path loading
  797. ]
  798. emit-poly [#{88C2} #{89C2}] ;-- MOV rD, rA
  799. emit-poly [#{B0} #{B8} args/1] ;-- MOV rA, a ; eax = a, edx = b
  800. ]
  801. ref/imm [emit-load args/1]
  802. ref/ref [emit-load args/1]
  803. ref/reg [ ;-- eax = b
  804. if path? right [
  805. emit-load args/2 ;-- late path loading
  806. ]
  807. emit-poly [#{88C2} #{89C2}] ;-- MOV rD, rA
  808. emit-load args/1 ;-- eax = a, edx = b
  809. ]
  810. reg/imm [ ;-- eax = a (or edx = a if last-saved)
  811. if path? left [
  812. emit-load args/1 ;-- late path loading
  813. ]
  814. if last-saved? [emit #{92}] ;-- XCHG eax, edx ; eax = a
  815. ]
  816. reg/ref [ ;-- eax = a (or edx = a if last-saved)
  817. if path? left [
  818. emit-load args/1 ;-- late path loading
  819. ]
  820. if last-saved? [emit #{92}] ;-- XCHG eax, edx ; eax = a
  821. ]
  822. reg/reg [ ;-- eax = b, edx = a
  823. if path? left [
  824. if block? args/2 [ ;-- edx = b
  825. emit #{92} ;-- XCHG eax, edx
  826. sorted?: yes ;-- eax = a, edx = b
  827. ]
  828. emit-load args/1 ;-- late path loading
  829. ]
  830. if path? right [
  831. emit #{92} ;-- XCHG eax, edx ; eax = b, edx = a
  832. emit-load args/2
  833. ]
  834. unless sorted? [emit #{92}] ;-- XCHG eax, edx ; eax = a, edx = b
  835. ]
  836. ]
  837. last-saved?: no ;-- reset flag
  838. if object? args/1 [emit-casting args/1 no] ;-- do runtime conversion on eax if required
  839. ;-- Operator and second operand processing
  840. either all [object? args/2 find [imm reg] b][
  841. emit-casting args/2 yes ;-- do runtime conversion on edx if required
  842. ][
  843. implicit-cast right
  844. ]
  845. case [
  846. find comparison-op name [emit-comparison-op name a b args]
  847. find math-op name [emit-math-op name a b args]
  848. find bitwise-op name [emit-bitwise-op name a b args]
  849. find bitshift-op name [emit-bitshift-op name a b args]
  850. ]
  851. ]
  852. emit-cdecl-pop: func [spec [block!] args [block!] /local size][
  853. size: emitter/arguments-size? spec/4
  854. if all [
  855. spec/2 = 'syscall
  856. compiler/job/syscall = 'BSD
  857. ][
  858. size: size + stack-width ;-- account for extra space
  859. ]
  860. if issue? args/1 [ ;-- test for variadic call
  861. size: length? args/2
  862. if spec/2 = 'native [
  863. size: size + pick [3 2] args/1 = #typed ;-- account for extra arguments @@ [3 2] ??
  864. ]
  865. size: size * stack-width
  866. ]
  867. emit #{83C4} ;-- ADD esp, n ; @@ 8-bit offset only?
  868. emit to-bin8 size
  869. ]
  870. patch-call: func [code-buf rel-ptr dst-ptr][
  871. change ;-- CALL NEAR disp size
  872. at code-buf rel-ptr
  873. to-bin32 dst-ptr - rel-ptr - ptr-size
  874. ]
  875. emit-argument: func [arg func-type [word!]][
  876. either all [
  877. object? arg
  878. any [arg/type = 'logic! 'byte! = first compiler/get-type arg/data]
  879. not path? arg/data
  880. ][
  881. unless block? arg [emit-load arg] ;-- block! means last value is already in eax (func call)
  882. emit-casting arg no
  883. emit-push <last>
  884. compiler/last-type: arg/type ;-- for inline unary functions
  885. ][
  886. emit-push either block? arg [<last>][arg]
  887. ]
  888. ]
  889. emit-call-syscall: func [args [block!] fspec [block!]][
  890. switch compiler/job/syscall [
  891. BSD [ ; http://www.freebsd.org/doc/en/books/developers-handbook/book.html#X86-SYSTEM-CALLS
  892. emit #{83EC04} ;-- SUB esp, 4 ; extra entry (BSD convention)
  893. ]
  894. Linux [
  895. if fspec/1 >= 6 [
  896. emit #{89E8} ;-- MOV eax, ebp ; save frame pointer
  897. ]
  898. repeat c fspec/1 [
  899. emit pick [
  900. #{5B} ;-- POP ebx ; get 1st arg in reg
  901. #{59} ;-- POP ecx ; get 2nd arg in reg
  902. #{5A} ;-- POP edx ; get 3rd arg in reg
  903. #{5E} ;-- POP esi ; get 4th arg in reg
  904. #{5F} ;-- POP edi ; get 5th arg in reg
  905. #{5D} ;-- POP ebp ; get 6th arg in reg
  906. ] 1 + fspec/1 - c
  907. ]
  908. if fspec/1 >= 6 [
  909. emit #{50} ;-- PUSH eax ; save frame pointer on stack
  910. ]
  911. ]
  912. ]
  913. emit #{B8} ;-- MOV eax, code
  914. emit to-bin32 last fspec
  915. emit #{CD80} ;-- INT 0x80 ; syscall
  916. switch compiler/job/syscall [
  917. BSD [emit-cdecl-pop fspec args] ;-- BSD syscall cconv (~ cdecl)
  918. Linux [
  919. if fspec/1 >= 6 [emit #{5D}] ;-- POP ebp ; restore frame pointer
  920. ]
  921. ]
  922. ]
  923. emit-call-import: func [args [block!] fspec [block!] spec [block!]][
  924. either compiler/job/OS = 'MacOSX [
  925. emit #{B8} ;-- MOV eax, addr
  926. emit-reloc-addr spec
  927. emit #{FFD0} ;-- CALL eax ; direct call
  928. ][
  929. emit #{FF15} ;-- CALL FAR [addr] ; indirect call
  930. emit-reloc-addr spec
  931. ]
  932. if fspec/3 = 'cdecl [ ;-- add calling cleanup when required
  933. emit-cdecl-pop fspec args
  934. ]
  935. ]
  936. emit-call-native: func [args [block!] fspec [block!] spec [block!] /local total][
  937. if issue? args/1 [ ;-- variadic call
  938. emit-push 4 * length? args/2 ;-- push arguments total size in bytes
  939. ;-- (required to clear stack on stdcall return)
  940. emit #{8D742404} ;-- LEA esi, [esp+4] ; skip last pushed value
  941. emit #{56} ;-- PUSH esi ; push arguments list pointer
  942. total: length? args/2
  943. if args/1 = #typed [total: total / 2]
  944. emit-push total ;-- push arguments count
  945. ]
  946. emit #{E8} ;-- CALL NEAR disp
  947. emit-reloc-addr spec ;-- 32-bit relative displacement place-holder
  948. if fspec/3 = 'cdecl [ ;-- in case of non-default calling convention
  949. emit-cdecl-pop fspec args
  950. ]
  951. ]
  952. emit-stack-align-prolog: func [args-nb [integer!] /local offset][
  953. if compiler/job/stack-align-16? [
  954. emit #{89E7} ;-- MOV edi, esp
  955. emit #{83E4F0} ;-- AND esp, -16
  956. offset: 1 + args-nb ;-- account for saved edi
  957. unless zero? offset: offset // 4 [
  958. emit #{83EC} ;-- SUB esp, offset ; ensure call will be 16-bytes aligned
  959. emit to-bin8 (4 - offset) * 4
  960. ]
  961. emit #{57} ;-- PUSH edi
  962. ]
  963. ]
  964. emit-stack-align-epilog: func [args-nb [integer!]][
  965. if compiler/job/stack-align-16? [
  966. emit #{5C} ;-- POP esp
  967. ]
  968. ]
  969. emit-prolog: func [name [word!] locals [block!] locals-size [integer!] /local fspec][
  970. if verbose >= 3 [print [">>>building:" uppercase mold to-word name "prolog"]]
  971. emit #{55} ;-- PUSH ebp
  972. emit #{89E5} ;-- MOV ebp, esp
  973. unless zero? locals-size [
  974. emit #{83EC} ;-- SUB esp, locals-size
  975. emit to-char round/to/ceiling locals-size 4 ;-- limits total local variables size to 255 bytes
  976. ]
  977. fspec: select compiler/functions name
  978. if all [block? fspec/4/1 fspec/5 = 'callback][
  979. emit #{53} ;-- PUSH ebx
  980. emit #{56} ;-- PUSH esi
  981. emit #{57} ;-- PUSH edi
  982. ]
  983. ]
  984. emit-epilog: func [
  985. name [word!] locals [block!] args-size [integer!] locals-size [integer!]
  986. /local fspec
  987. ][
  988. if verbose >= 3 [print [">>>building:" uppercase mold to-word name "epilog"]]
  989. fspec: select compiler/functions name
  990. if all [block? fspec/4/1 fspec/5 = 'callback][
  991. emit #{5F} ;-- POP edi
  992. emit #{5E} ;-- POP esi
  993. emit #{5B} ;-- POP ebx
  994. ]
  995. emit #{C9} ;-- LEAVE
  996. either any [
  997. zero? args-size
  998. fspec/3 = 'cdecl
  999. ][
  1000. ;; cdecl: Leave original arguments on stack, popped by caller.
  1001. emit #{C3} ;-- RET
  1002. ][
  1003. ;; stdcall/reds: Consume original arguments from stack.
  1004. either compiler/check-variable-arity? locals [
  1005. emit #{5E} ;-- POP esi ; retrieve the return address
  1006. emit #{5B} ;-- POP ebx ; skip arguments count
  1007. emit #{5B} ;-- POP ebx ; skip arguments pointer
  1008. emit #{5B} ;-- POP ebx ; get stack offset
  1009. emit #{01DC} ;-- ADD esp, ebx ; skip arguments list (clears stack)
  1010. emit #{56} ;-- PUSH esi ; push return address
  1011. emit #{C3} ;-- RET
  1012. ][
  1013. emit #{C2} ;-- RET args-size
  1014. emit to-bin16 round/to/ceiling args-size 4
  1015. ]
  1016. ]
  1017. ]
  1018. ]