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