Created
April 6, 2016 04:34
-
-
Save dockimbel/d8fcdbf16a44b8e04085a3fe57197527 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
REBOL [ | |
Title: "Red/System AVR8 code emitter" | |
Author: "Nenad Rakocevic" | |
File: %AVR8.r | |
Rights: "Copyright (C) 2011 Nenad Rakocevic. All rights reserved." | |
License: "BSD-3 - https://github.com/dockimbel/Red/blob/master/BSD-3-License.txt" | |
] | |
make target-class [ | |
target: 'AVR-8 | |
little-endian?: yes | |
struct-align-size: 2 | |
ptr-size: 2 | |
default-align: 2 | |
stack-width: 1 | |
branch-offset-size: 4 ;-- size of JMP offset | |
types: emitter/datatypes | |
types/logic!: 1 | |
types/pointer!: | |
types/c-string!: | |
types/struct!: | |
types/function!: 2 | |
append types [int16! 2 signed] | |
c-reg: 25 ;-- top reg for C functions calling convention | |
void-ptr: #{0000} | |
C-call?: no | |
base: [ | |
;code #{03EB} ;-- code base address (Flash memory) | |
data #{0127} ;-- data base address (SRAM) + offset over runtime data | |
] | |
;-- avrdude -Cavrdude/avrdude.conf -v -v -pm328p -cstk500v1 -P\\.\COM4 -b115200 -D -Uflash:w:avr-8-test.hex:i -F | |
;-- avr-objdump -D --architecture=avr:5 build.hex | |
;-- TBD: SP (stack) must be initialize in the Reset routine (see p.9) | |
;-- data and stack are in SRAM | |
;-- SRAM: | |
;-- 00h - 19h : registers | |
;-- 1Ah - 1Bh : X register | |
;-- 1Ch - 1Dh : Y register | |
;-- 1Eh - 1Fh : Z register | |
;-- 20h - 5Fh : I/O space | |
;-- 60h - FFh : extended I/O space (ST/STS/STD and LD/LDS/LDD only) | |
;-- Flash: (program): 0000h - 3FFFh (boot flash section at end) | |
;-- Z register can be used to read constants stored in Program Memory | |
;-- accumulator: r16 | |
intermix: func [opcode [binary!] value [char! integer!]][ | |
if char? value [value: to integer! value] | |
opcode: copy opcode | |
opcode/1: to char! opcode/1 or (value and 15) ;-- inject low nibble | |
opcode/2: to char! opcode/2 or shift value 4 ;-- inject high nibble | |
opcode | |
] | |
emit-address: func [addr [integer!]][ | |
emit to-bin16 shift addr 1 | |
] | |
emit-variable-address: func [name [word!]][ | |
emit-address emitter/symbols/:name/2 | |
] | |
emit-load-reg: func [reg [integer!] value size [integer!] /local byte][ | |
repeat c size [ | |
byte: (shift value (size - c) * 8) // 256 | |
emit to char! (shift/left reg - 16 4) or (byte and 15) | |
emit #"^(E0)" or shift byte 4 | |
reg: reg - 1 | |
] | |
reg | |
] | |
emit-load-reg-Z+: func [reg [integer!] size [integer!]][ | |
repeat c width [ | |
emit #"^(01)" or shift/left (reg and 15) 4 | |
emit #"^(90)" or shift reg 4 | |
reg: reg - 1 | |
] | |
reg | |
] | |
emit-mixed: func [value [char! integer!]][ | |
either C-call? [ | |
if any [even? c-reg width = 1][ | |
;emit to char! shift/left c-reg - 16 4 ; load c-reg with 0 | |
;emit #"^(E0)" | |
c-reg: c-reg - 1 | |
] | |
c-reg: emit-load-reg c-reg value width | |
][ | |
emit-load-reg 25 value width | |
] | |
] | |
emit-mixed-Z+: does [ | |
either C-call? [ | |
if any [even? c-reg width = 1][c-reg: c-reg - 1] | |
c-reg: emit-load-reg-Z+ c-reg width | |
][ | |
emit-load-reg-Z+ 25 width | |
] | |
] | |
emit-mixed-address: func [name [word!] low [binary!] high [binary!] /local addr][ | |
addr: emitter/symbols/:name/2 + to integer! base/data | |
emit intermix low addr and 255 | |
emit intermix high shift addr 8 | |
] | |
emit-variable: func [ | |
name [word! object!] gcode [binary!] lcode [binary! block!] | |
/local offset value | |
][ | |
if object? name [name: compiler/unbox name] | |
either offset: select emitter/stack name [ | |
if any [ ;-- local variable case | |
offset < -128 | |
offset > 127 | |
][ | |
compiler/throw-error "#code generation error: overflow in emit-variable" | |
] | |
offset: skip debase/base to-hex offset 16 3 ; @@ just to-char ?? | |
either block? lcode [ | |
emit reduce bind lcode 'offset | |
][ | |
emit #{FE01} ;-- MOVW Z,Y | |
value: shift offset and 32 5 | |
value: value or shift offset and 24 2 | |
emit lcode/1 or value | |
emit lcode/2 or (offset and 6) | |
] | |
][ ;-- global variable case | |
emit-mixed-address name | |
#{E0E0} ;-- LDI r30, [LOW(value)] | |
#{F0E0} ;-- LDI r31, [HIGH(value)] | |
emit gcode | |
] | |
] | |
;--- Public API --- | |
emit-save-last: does [ | |
emit #{89C2} ;-- MOV edx, eax | |
] | |
emit-casting: func [value [object!] alt? [logic!] /local old][ | |
type: compiler/get-type value/data | |
case [ | |
value/type/1 = 'logic! [ | |
if verbose >= 3 [print [">>>converting from" mold/flat type/1 "to logic!"]] | |
old: width | |
set-width/type type/1 | |
emit #{31DB} ;-- XOR ebx, ebx | |
either alt? [ | |
emit-poly [#{80FA00} #{83FA00}] ;-- CMP rD, 0 | |
emit #{7401} ;-- JZ _exit | |
emit #{43} ;-- INC ebx | |
emit #{89DA} ;-- _exit: MOV edx, ebx | |
][ | |
emit-poly [#{3C00} #{83F800}] ;-- CMP rA, 0 | |
emit #{7401} ;-- JZ _exit | |
emit #{43} ;-- INC ebx | |
emit #{89D8} ;-- _exit: MOV eax, ebx | |
] | |
width: old | |
] | |
all [value/type/1 = 'integer! type/1 = 'byte!][ | |
if verbose >= 3 [print ">>>converting from byte! to integer! "] | |
emit pick [#{81E2} #{25}] alt? ;-- AND edx|eax, 000000FFh | |
emit to-bin32 255 | |
] | |
] | |
] | |
emit-load-literal: func [type [block! none!] value /local spec][ | |
unless type [type: compiler/get-type value] | |
spec: emitter/store-value none value type | |
emit #{B8} ;-- MOV eax, value | |
emit-reloc-addr spec/2 ;-- one-based index | |
] | |
emit-set-stack: func [value /frame][ | |
if verbose >= 3 [print [">>>emitting SET-STACK" mold value]] | |
emit-load value | |
either frame [ | |
emit #{89C5} ;-- MOV ebp, eax | |
][ | |
emit #{89C4} ;-- MOV esp, eax | |
] | |
] | |
emit-get-stack: func [/frame][ | |
if verbose >= 3 [print ">>>emitting GET-STACK"] | |
either frame [ | |
emit #{89E8} ;-- MOV eax, ebp | |
][ | |
emit #{89E0} ;-- MOV eax, esp | |
] | |
] | |
emit-pop: does [ | |
if verbose >= 3 [print ">>>emitting POP"] | |
emit #{58} ;-- POP eax | |
] | |
emit-not: func [value [word! char! tag! integer! logic! path! string! object!] /local opcodes type boxed][ | |
if verbose >= 3 [print [">>>emitting NOT" mold value]] | |
if object? value [boxed: value] | |
value: compiler/unbox value | |
if block? value [value: <last>] | |
opcodes: [ | |
logic! [emit #{3401}] ;-- XOR al, 1 ; invert 0<=>1 | |
byte! [emit #{F6D0}] ;-- NOT al ; @@ missing 16-bit support | |
integer! [emit #{F7D0}] ;-- NOT eax | |
] | |
switch type?/word value [ | |
logic! [ | |
emit-load not value | |
] | |
char! [ | |
emit-load value | |
do opcodes/byte! | |
] | |
integer! [ | |
emit-load value | |
do opcodes/integer! | |
] | |
word! [ | |
emit-load value | |
if boxed [emit-casting boxed no] | |
type: first compiler/get-variable-spec value | |
if find [pointer! c-string! struct!] type [ ;-- type casting trap | |
type: 'logic! | |
] | |
switch type opcodes | |
] | |
tag! [ | |
if boxed [emit-casting boxed no] | |
switch compiler/last-type/1 opcodes | |
] | |
string! [ ;-- type casting trap | |
emit-load value | |
if boxed [emit-casting boxed no] | |
do opcodes/logic! | |
] | |
path! [ | |
emitter/access-path value none | |
either boxed [ | |
emit-casting boxed no | |
switch boxed/type/1 opcodes | |
][ | |
do opcodes/integer! | |
] | |
] | |
] | |
] | |
emit-boolean-switch: does [ | |
emit #{31C0} ;-- XOR eax, eax ; eax = 0 (FALSE) | |
emit #{EB03} ;-- JMP _exit | |
emit #{31C0} ;-- XOR eax, eax | |
emit #{40} ;-- INC eax ; eax = 1 (TRUE) | |
;-- _exit: | |
reduce [3 7] ;-- [offset-TRUE offset-FALSE] | |
] | |
emit-load-word: func [name [word!]][ | |
type: compiler/resolve-type name | |
switch emitter/size-of? type [ | |
1 [ | |
emit either C-call? [ | |
#{1891} ;-- LDS r24, [value] ; global | |
][ | |
#{1991} ;-- LDS r25, [value] ; global | |
] | |
emit-variable-address name | |
] | |
2 [ | |
] | |
4 [ | |
emit-mixed-address name | |
#{E0E0} ;-- LDI r30, [LOW(value)] | |
#{F0E0} ;-- LDI r31, [HIGH(value)] | |
emit-mixed-Z+ | |
;emit #{6191} ;-- LD r25, Z+ | |
;emit #{7191} ;-- LD r24, Z+ | |
;emit #{8191} ;-- LD r23, Z+ | |
;emit #{9191} ;-- LD r22, Z+ | |
] | |
] | |
] | |
emit-load: func [ | |
value [char! logic! integer! word! string! struct! path! paren! get-word! object!] | |
/alt | |
][ | |
if verbose >= 3 [print [">>>loading" mold value]] | |
switch type?/word value [ | |
char! [ | |
emit-mixed value ;-- LDI r25, value | |
] | |
logic! [ | |
emit #{9924} ;-- CLR r25 ; r25 = 0 (FALSE) | |
if value [emit #{9394}] ;-- INC r25 ; r25 = 1 (TRUE) | |
] | |
integer! [ | |
emit-mixed value ;-- LDI r25:r22, value | |
] | |
word! [ | |
with-width-of value [ | |
emit-load-word value | |
] | |
] | |
get-word! [ | |
;emit #{B8} ;-- MOV eax, &name | |
;emit-reloc-addr emitter/get-func-ref to word! value ;-- symbol address | |
] | |
string! [ | |
emit-load-literal [c-string!] value | |
] | |
path! [ | |
emitter/access-path value none | |
] | |
paren! [ | |
emit-load-literal none value | |
] | |
object! [ | |
unless any [block? value/data value/data = <last>][ | |
either alt [emit-load/alt value/data][emit-load value/data] | |
] | |
] | |
] | |
] | |
emit-store: func [ | |
name [word!] value [char! logic! integer! word! string! paren! tag! get-word!] spec [block! none!] | |
/local store-dword | |
][ | |
if verbose >= 3 [print [">>>storing" mold name mold value]] | |
if value = <last> [value: 'last] | |
if logic? value [value: to char! value] ;-- TRUE -> 1, FALSE -> 0 | |
switch type?/word value [ | |
char! [ | |
emit-load value ;-- LDI r25, value | |
emit-variable name ; STS [name], r25 | |
#{F083} ;-- STS Z, r25 ; global | |
#{9883} ;-- STD Y+n, r25 ; local | |
] | |
integer! [ | |
width: 4 | |
emit-variable-wide name ; STS [name], r25 | |
#{F083} ;-- STS Z, r25:r22 ; global | |
#{9883} ;-- STD Y+n, r25:r22 ; local | |
] | |
word! [ | |
set-width name | |
if value <> 'last [ | |
emit-load value | |
] | |
do store-byte | |
] | |
get-word! [ | |
do store-byte | |
emit-reloc-addr emitter/get-func-ref to word! value ;-- symbol address | |
] | |
string! [ | |
do store-byte | |
emit-reloc-addr spec/2 | |
] | |
paren! [ | |
do store-byte | |
emit-reloc-addr spec/2 | |
] | |
] | |
] | |
emit-init-path: func [name [word!]][ | |
emit-variable name | |
#{A1} ;-- MOV eax, [name] ; global | |
#{8B45} ;-- MOV eax, [ebp+n] ; local | |
] | |
emit-access-path: func [ | |
path [path! set-path!] spec [block! none!] /short /local offset type saved | |
][ | |
if verbose >= 3 [print [">>>accessing path:" mold path]] | |
unless spec [ | |
spec: second compiler/resolve-type path/1 | |
emit-init-path path/1 | |
] | |
if short [return spec] | |
saved: width | |
type: first compiler/resolve-type/with path/2 spec | |
set-width/type type ;-- adjust operations width to member value size | |
either zero? offset: emitter/member-offset? spec path/2 [ | |
emit-poly [#{8A00} #{8B00}] ;-- MOV rA, [eax] | |
][ | |
emit-poly [#{8A80} #{8B80}] ;-- MOV rA, [eax+offset] | |
emit to-bin32 offset | |
] | |
width: saved | |
] | |
emit-load-index: func [idx [word!]][ | |
emit-variable idx | |
#{8B1D} ;-- MOV ebx, [idx] ; global | |
#{8B5D} ;-- MOV ebx, [ebp+n] ; local | |
emit #{4B} ;-- DEC ebx ; one-based index | |
] | |
emit-c-string-path: func [path [path! set-path!] parent [block! none!] /local opcodes idx][ | |
either parent [ | |
emit #{89C6} ;-- MOV esi, eax ; nested access | |
][ | |
emit-variable path/1 | |
#{8B35} ;-- MOV esi, [value1] ; global | |
[ | |
#{8D45} ;-- LEA eax, [ebp+n] ; local | |
offset ;-- n | |
#{8B30} ;-- MOV esi, [eax] | |
] | |
] | |
opcodes: pick [[ ;-- store path opcodes -- | |
#{8816} ;-- MOV [esi], dl ; first | |
#{8896} ;-- MOV [esi + idx], dl ; n-th | |
#{88141E} ;-- MOV [esi + ebx], dl ; variable index | |
][ ;-- load path opcodes -- | |
#{8A06} ;-- MOV al, [esi] ; first | |
#{8A86} ;-- MOV al, [esi + idx] ; n-th | |
#{8A041E} ;-- MOV al, [esi + ebx] ; variable index | |
]] set-path? path | |
either integer? idx: path/2 [ | |
either zero? idx: idx - 1 [ ;-- indexes are one-based | |
emit opcodes/1 | |
][ | |
emit opcodes/2 | |
emit to-bin32 idx | |
] | |
][ | |
emit-load-index idx | |
emit opcodes/3 | |
] | |
] | |
emit-pointer-path: func [ | |
path [path! set-path!] parent [block! none!] /local opcodes idx type | |
][ | |
opcodes: pick [[ ;-- store path opcodes -- | |
[#{8810} #{8910}] ;-- MOV [eax], rD | |
[#{8890} #{8990}] ;-- MOV [eax + idx * sizeof(p/value)], rD | |
[#{881418} #{891498}] ;-- MOV [eax + ebx * sizeof(p/value)], rD | |
][ ;-- load path opcodes -- | |
[#{8A00} #{8B00}] ;-- MOV rA, [eax] | |
[#{8A80} #{8B80}] ;-- MOV rA, [eax + idx * sizeof(p/value)] | |
[#{8A0418} #{8B0498}] ;-- MOV rA, [eax + ebx * sizeof(p/value)] | |
]] set-path? path | |
type: either parent [ | |
compiler/resolve-type/with path/1 parent | |
][ | |
emit-init-path path/1 | |
type: compiler/resolve-type path/1 | |
] | |
set-width/type type/2/1 ;-- adjust operations width to pointed value size | |
idx: either path/2 = 'value [1][path/2] | |
either integer? idx [ | |
either zero? idx: idx - 1 [ ;-- indexes are one-based | |
emit-poly opcodes/1 | |
][ | |
emit-poly opcodes/2 | |
emit to-bin32 idx * emitter/size-of? type/2/1 | |
] | |
][ | |
emit-load-index idx | |
emit-poly opcodes/3 | |
] | |
] | |
emit-load-path: func [path [path!] type [word!] parent [block! none!] /local idx][ | |
if verbose >= 3 [print [">>>loading path:" mold path]] | |
switch type [ | |
c-string! [emit-c-string-path path parent] | |
pointer! [emit-pointer-path path parent] | |
struct! [emit-access-path path parent] | |
] | |
] | |
emit-store-path: func [path [set-path!] type [word!] value parent [block! none!] /local idx offset][ | |
if verbose >= 3 [print [">>>storing path:" mold path mold value]] | |
if parent [emit #{89C2}] ;-- MOV edx, eax ; save value/address | |
unless value = <last> [emit-load value] | |
emit #{92} ;-- XCHG eax, edx ; save value/restore address | |
switch type [ | |
c-string! [emit-c-string-path path parent] | |
pointer! [emit-pointer-path path parent] | |
struct! [ | |
unless parent [parent: emit-access-path/short path parent] | |
type: first compiler/resolve-type/with path/2 parent | |
set-width/type type ;-- adjust operations width to member value size | |
either zero? offset: emitter/member-offset? parent path/2 [ | |
emit-poly [#{8810} #{8910}] ;-- MOV [eax], rD | |
][ | |
emit-poly [#{8890} #{8990}] ;-- MOV [eax+offset], rD | |
emit to-bin32 offset | |
] | |
] | |
] | |
] | |
emit-exit: does [ | |
emit #{E9} ;-- JMP imm32 | |
emit-reloc-addr compose/only [- - (emitter/exits)] | |
] | |
emit-branch: func [ | |
code [binary!] | |
op [word! block! logic! none!] | |
offset [integer! none!] | |
/back | |
/local size imm8? opcode jmp | |
][ | |
if verbose >= 3 [print [">>>inserting branch" either op [join "cc: " mold op][""]]] | |
size: (length? code) - any [offset 0] ;-- offset from the code's head | |
imm8?: size <= either back [126][127] ;-- account 2 bytes for JMP imm8 | |
opcode: either not none? op [ ;-- explicitly test for none | |
op: case [ | |
block? op [ ;-- [cc] => keep | |
op: op/1 | |
either logic? op [pick [= <>] op][op] ;-- [logic!] or [cc] | |
] | |
logic? op [pick [= <>] op] ;-- test for TRUE/FALSE | |
'else [opposite? op] ;-- 'cc => invert condition | |
] | |
add-condition op copy pick [#{70} #{0F80}] imm8? ;-- Jcc offset ; 8/32-bit displacement | |
][ | |
pick [#{EB} #{E9}] imm8? ;-- JMP offset ; 8/32-bit displacement | |
] | |
if back [size: negate (size + (length? opcode) + pick [1 4] imm8?)] | |
jmp: rejoin [opcode either imm8? [to-bin8 size][to-bin32 size]] | |
insert any [all [back tail code] code] jmp | |
length? jmp | |
] | |
emit-push: func [ | |
value [char! logic! integer! word! block! string! tag! path! get-word! object!] | |
/with cast [object!] | |
/local spec type | |
][ | |
if verbose >= 3 [print [">>>pushing" mold value]] | |
if block? value [value: <last>] | |
switch type?/word value [ | |
tag! [ ;-- == <last> | |
emit #{50} ;-- PUSH eax | |
] | |
logic! [ | |
emit #{31C0} ;-- XOR eax, eax ; eax = 0 (FALSE) | |
if value [ | |
emit #{40} ;-- INC eax ; eax = 1 (TRUE) | |
] | |
emit #{50} ;-- PUSH eax | |
] | |
char! [ | |
emit #{6A} ;-- PUSH value | |
emit value | |
] | |
integer! [ | |
either all [-128 <= value value <= 127][ | |
emit #{6A} ;-- PUSH imm8 | |
emit to-bin8 value | |
][ | |
emit #{68} ;-- PUSH imm32 | |
emit to-bin32 value | |
] | |
] | |
word! [ | |
type: first compiler/get-variable-spec value | |
either find [c-string! struct! pointer!] type [ | |
emit-variable value | |
#{FF35} ;-- PUSH [value] ; global | |
#{FF75} ;-- PUSH [ebp+n] ; local | |
][ | |
emit-variable value | |
#{FF35} ;-- PUSH dword [value] ; global | |
[ | |
#{8D45} ;-- LEA eax, [ebp+n] ; local | |
offset ;-- n | |
#{FF30} ;-- PUSH dword [eax] | |
] | |
] | |
] | |
get-word! [ | |
emit #{68} ;-- PUSH &value | |
emit-reloc-addr emitter/get-func-ref to word! value ;-- value memory address | |
] | |
string! [ | |
spec: emitter/store-value none value [c-string!] | |
emit #{68} ;-- PUSH value | |
emit-reloc-addr spec/2 ;-- one-based index | |
] | |
path! [ | |
emitter/access-path value none | |
if cast [emit-casting cast no] | |
emit-push <last> | |
] | |
object! [ | |
either path? value/data [ | |
emit-push/with value/data value | |
][ | |
emit-push value/data | |
] | |
emit-push <last> | |
] | |
] | |
] | |
emit-sign-extension: does [ | |
emit switch width [ | |
1 [#{6698}] ;-- CBW ; extend AL to AX | |
2 [#{6699}] ;-- CWD ; extend AX to DX:AX | |
4 [#{99}] ;-- CDQ ; extend EAX to EDX:EAX | |
] | |
] | |
emit-bitshift-op: func [name [word!] a [word!] b [word!] args [block!] /local c value][ | |
switch b [ | |
ref [ | |
emit-variable args/2 | |
#{8A0D} ;-- MOV cl, byte [value] ; global | |
#{8A4D} ;-- MOV cl, byte [ebp+n] ; local | |
] | |
reg [emit #{88D1}] ;-- MOV cl, dl | |
] | |
switch name [ | |
<< [ | |
emit-poly pick [ | |
[#{C0E0} #{C1E0}] ;-- SAL|SHL rA, value | |
[#{D2E0} #{D3E0}] ;-- SAL|SHL rA, cl | |
] b = 'imm | |
] | |
>> [ | |
emit-poly pick [ | |
[#{C0F8} #{C1F8}] ;-- SAR rA, value | |
[#{D2F8} #{D3F8}] ;-- SAR rA, cl | |
] b = 'imm | |
] | |
-** [ | |
emit-poly pick [ | |
[#{C0E8} #{C1E8}] ;-- SHR rA, value | |
[#{D2E8} #{D3E8}] ;-- SHR rA, cl | |
] b = 'imm | |
] | |
] | |
if b = 'imm [ | |
c: select [1 7 2 15 4 31] width | |
value: compiler/unbox args/2 | |
unless all [0 <= value value <= c][ | |
compiler/backtrack name | |
compiler/throw-error rejoin [ | |
"a value in 0-" c " range is required for this shift operation" | |
] | |
] | |
emit to-bin8 value | |
] | |
] | |
emit-bitwise-op: func [name [word!] a [word!] b [word!] args [block!] /local code][ | |
code: select [ | |
and [ | |
#{25} ;-- AND eax, value | |
#{21D0} ;-- AND eax, edx ; commutable op | |
] | |
or [ | |
#{0D} ;-- OR eax, value | |
#{09D0} ;-- OR eax, edx ; commutable op | |
] | |
xor [ | |
#{35} ;-- XOR eax, value | |
#{31D0} ;-- XOR eax, edx ; commutable op | |
] | |
] name | |
switch b [ | |
imm [ | |
emit code/1 ;-- <OP> eax, value | |
emit to-bin32 compiler/unbox args/2 | |
] | |
ref [ | |
emit-load/alt args/2 | |
if object? args/2 [emit-casting args/2 yes] | |
emit code/2 | |
] | |
reg [emit code/2] ;-- <OP> eax, edx ; commutable op | |
] | |
] | |
emit-comparison-op: func [name [word!] a [word!] b [word!] args [block!] /local op-poly][ | |
op-poly: [emit-poly [#{38D0} #{39D0}]] ;-- CMP rA, rD ; not commutable op | |
switch b [ | |
imm [ | |
emit-poly [#{3C} #{3D} args/2] ;-- CMP rA, value | |
] | |
ref [ | |
emit-load/alt args/2 | |
if object? args/2 [emit-casting args/2 yes] | |
do op-poly | |
] | |
reg [ | |
do op-poly | |
] | |
] | |
] | |
emit-math-op: func [ | |
name [word!] a [word!] b [word!] args [block!] | |
/local mod? scale c type arg2 op-poly | |
][ | |
;-- eax = a, edx = b | |
if find [// ///] name [ ;-- work around unaccepted '// and '/// | |
mod?: select [// mod /// rem] name ;-- convert operators to words (easier to handle) | |
name: first [/] ;-- work around unaccepted '/ | |
] | |
arg2: compiler/unbox args/2 | |
if all [ | |
find [+ -] name ;-- pointer arithmetic only allowed for + & - | |
type: compiler/resolve-expr-type args/1 | |
not compiler/any-pointer? compiler/resolve-expr-type args/2 ;-- no scaling if both operands are pointers | |
scale: switch type/1 [ | |
pointer! [emitter/size-of? type/2/1] ;-- scale factor: size of pointed value | |
struct! [emitter/member-offset? type/2 none] ;-- scale factor: total size of the struct | |
] | |
scale > 1 | |
][ | |
either compiler/literal? arg2 [ | |
arg2: arg2 * scale ;-- 'b is a literal, so scale it directly | |
][ | |
either b = 'reg [ | |
emit #{92} ;-- XCHG eax, edx ; put operands in right order | |
][ ;-- 'b will now be stored in reg, so save 'a | |
emit-poly [#{88C2} #{89C2}] ;-- MOV rD, rA | |
emit-load args/2 | |
] | |
emit-math-op '* 'reg 'imm reduce [arg2 scale] | |
if name = '- [emit #{92}] ;-- XCHG eax, edx ; put operands in right order | |
b: 'reg | |
] | |
] | |
;-- eax = a, edx = b | |
switch name [ | |
+ [ | |
op-poly: [ | |
emit-poly [#{00D0} #{01D0}] ;-- ADD rA, rD ; commutable op | |
] | |
switch b [ | |
imm [ | |
emit-poly either arg2 = 1 [ ;-- trivial optimization | |
[#{FEC0} #{40}] ;-- INC rA | |
][ | |
[#{04} #{05} arg2] ;-- ADD rA, value | |
] | |
] | |
ref [ | |
emit-load/alt args/2 | |
do op-poly | |
] | |
reg [do op-poly] | |
] | |
] | |
- [ | |
op-poly: [ | |
emit-poly [#{28D0} #{29D0}] ;-- SUB rA, rD ; not commutable op | |
] | |
switch b [ | |
imm [ | |
emit-poly either arg2 = 1 [ ;-- trivial optimization | |
[#{FEC8} #{48}] ;-- DEC rA | |
][ | |
[#{2C} #{2D} arg2] ;-- SUB rA, value | |
] | |
] | |
ref [ | |
emit-load/alt args/2 | |
do op-poly | |
] | |
reg [do op-poly] | |
] | |
] | |
* [ | |
op-poly: [ | |
emit-poly [#{F6EA} #{F7EA}] ;-- IMUL rD ; commutable op | |
] | |
switch b [ | |
imm [ | |
either all [ | |
not zero? arg2 | |
c: power-of-2? arg2 ;-- trivial optimization for b=2^n | |
][ | |
either width = 1 [ | |
emit #{C0E0} ;-- SHL al, log2(b) ; 8-bit unsigned | |
][ | |
emit-poly [#{C0ED} #{C1E0}] ;-- SAL rA, log2(b) ; signed | |
] | |
emit to-bin8 c | |
][ | |
unless width = 1 [emit #{52}] ;-- PUSH edx ; save edx from corruption for 16/32-bit ops | |
with-width-of/alt args/2 [ | |
emit-poly [#{B2} #{BA} args/2] ;-- MOV rD, value | |
] | |
emit #{89D3} ;-- MOV ebx, edx | |
emit-poly [#{F6EB} #{F7EB}] ;-- IMUL rB ; result in ax|eax|edx:eax | |
unless width = 1 [emit #{5A}] ;-- POP edx | |
] | |
] | |
ref [ | |
emit #{52} ;-- PUSH edx ; save edx from corruption | |
emit-load/alt args/2 | |
do op-poly | |
emit #{5A} ;-- POP edx | |
] | |
reg [do op-poly] | |
] | |
] | |
/ [ | |
op-poly: [ | |
either width = 1 [ ;-- 8-bit unsigned | |
emit #{B400} ;-- MOV ah, 0 ; clean-up garbage in ah | |
emit #{F6F3} ;-- DIV bl | |
][ | |
emit-sign-extension ;-- 16/32-bit signed | |
emit-poly [#{F6FB} #{F7FB}] ;-- IDIV rB ; rA / rB | |
] | |
] | |
switch b [ | |
imm [ ;-- SAR usage http://www.arl.wustl.edu/~lockwood/class/cs306/books/artofasm/Chapter_6/CH06-3.html#HEADING3-120 | |
emit #{52} ;-- PUSH edx ; save edx from corruption | |
with-width-of/alt args/2 [ | |
emit-poly [#{B2} #{BA} args/2] ;-- MOV rD, value | |
] | |
emit #{89D3} ;-- MOV ebx, edx | |
do op-poly | |
] | |
ref [ | |
emit #{52} ;-- PUSH edx ; save edx from corruption | |
emit-load/alt args/2 | |
emit #{89D3} ;-- MOV ebx, edx | |
do op-poly | |
] | |
reg [ | |
emit #{89D3} ;-- MOV ebx, edx ; ebx = b | |
do op-poly | |
] | |
] | |
if mod? [ | |
emit-poly [#{88E0} #{89D0}] ;-- MOV rA, remainder ; remainder from ah|dx|edx | |
if all [mod? <> 'rem width > 1][;-- modulo, not remainder | |
;-- Adjust modulo result to be mathematically correct: | |
;-- if modulo < 0 [ | |
;-- if divider < 0 [divider: negate divider] | |
;-- modulo: modulo + divider | |
;-- ] | |
c: to-bin8 select [1 7 2 15 4 31] width ;-- support for possible int8 type | |
emit #{0FBAE0} ;-- BT rA, 7|15|31 ; @@ better way ? | |
emit c | |
emit #{730A} ;-- JNC exit ; (won't work with ax) | |
emit #{0FBAE3} ;-- BT rB, 7|15|31 ; @@ better way ? | |
emit c | |
emit #{7302} ;-- JNC add ; (won't work with ax) | |
emit-poly [#{F6DB} #{F7DB}] ;-- NEG rB | |
emit-poly [#{00D8} #{01D8}] ;-- add: ADD rA, rB | |
] ;-- exit: | |
] | |
if any [ ;-- in case edx was saved on stack | |
all [b = 'imm any [mod? not c]] | |
b = 'ref | |
][ | |
emit #{5A} ;-- POP edx | |
] | |
] | |
] | |
;TBD: test overflow and raise exception ? (or store overflow flag in a variable??) | |
; JNO? (Jump if No Overflow) | |
] | |
emit-operation: func [name [word!] args [block!] /local a b c sorted? arg left right][ | |
if verbose >= 3 [print [">>>inlining op:" mold name mold args]] | |
set-width args/1 ;-- set reg/mem access width | |
c: 1 | |
foreach op [a b][ | |
arg: either object? args/:c [compiler/cast args/:c][args/:c] | |
set op either arg = <last> [ | |
'reg ;-- value in eax | |
][ | |
switch type?/word arg [ | |
char! ['imm] ;-- add or mov to al | |
integer! ['imm] ;-- add or mov to eax | |
word! ['ref] ;-- fetch value | |
block! ['reg] ;-- value in eax (or in edx) | |
path! ['reg] ;-- value in eax (or in edx) | |
] | |
] | |
c: c + 1 | |
] | |
if verbose >= 3 [?? a ?? b] ;-- a and b hold addressing modes for operands | |
;-- First operand processing | |
left: compiler/unbox args/1 | |
right: compiler/unbox args/2 | |
switch to path! reduce [a b] [ | |
imm/imm [emit-poly [#{B0} #{B8} args/1]];-- MOV rA, a | |
imm/ref [emit-load args/1] ;-- eax = a | |
imm/reg [ ;-- eax = b | |
if path? right [ | |
emit-load args/2 ;-- late path loading | |
] | |
emit-poly [#{88C2} #{89C2}] ;-- MOV rD, rA | |
emit-poly [#{B0} #{B8} args/1] ;-- MOV rA, a ; eax = a, edx = b | |
] | |
ref/imm [emit-load args/1] | |
ref/ref [emit-load args/1] | |
ref/reg [ ;-- eax = b | |
if path? right [ | |
emit-load args/2 ;-- late path loading | |
] | |
emit-poly [#{88C2} #{89C2}] ;-- MOV rD, rA | |
emit-load args/1 ;-- eax = a, edx = b | |
] | |
reg/imm [ ;-- eax = a (or edx = a if last-saved) | |
if path? left [ | |
emit-load args/1 ;-- late path loading | |
] | |
if last-saved? [emit #{92}] ;-- XCHG eax, edx ; eax = a | |
] | |
reg/ref [ ;-- eax = a (or edx = a if last-saved) | |
if path? left [ | |
emit-load args/1 ;-- late path loading | |
] | |
if last-saved? [emit #{92}] ;-- XCHG eax, edx ; eax = a | |
] | |
reg/reg [ ;-- eax = b, edx = a | |
if path? left [ | |
if block? args/2 [ ;-- edx = b | |
emit #{92} ;-- XCHG eax, edx | |
sorted?: yes ;-- eax = a, edx = b | |
] | |
emit-load args/1 ;-- late path loading | |
] | |
if path? right [ | |
emit #{92} ;-- XCHG eax, edx ; eax = b, edx = a | |
emit-load args/2 | |
] | |
unless sorted? [emit #{92}] ;-- XCHG eax, edx ; eax = a, edx = b | |
] | |
] | |
last-saved?: no ;-- reset flag | |
if object? args/1 [emit-casting args/1 no] ;-- do runtime conversion on eax if required | |
;-- Operator and second operand processing | |
either all [object? args/2 find [imm reg] b][ | |
emit-casting args/2 yes ;-- do runtime conversion on edx if required | |
][ | |
implicit-cast right | |
] | |
case [ | |
find comparison-op name [emit-comparison-op name a b args] | |
find math-op name [emit-math-op name a b args] | |
find bitwise-op name [emit-bitwise-op name a b args] | |
find bitshift-op name [emit-bitshift-op name a b args] | |
] | |
] | |
emit-cdecl-pop: func [spec [block!] args [block!] /local size][ | |
size: emitter/arguments-size? spec/4 | |
if all [ | |
spec/2 = 'syscall | |
compiler/job/syscall = 'BSD | |
][ | |
size: size + stack-width ;-- account for extra space | |
] | |
if issue? args/1 [ ;-- test for variadic call | |
size: length? args/2 | |
if spec/2 = 'native [ | |
size: size + pick [3 2] args/1 = #typed ;-- account for extra arguments | |
] | |
size: size * stack-width | |
] | |
emit #{83C4} ;-- ADD esp, n | |
emit to-bin8 size | |
] | |
emit-argument: func [arg func-type [word!]][ | |
either all [ | |
object? arg | |
any [arg/type = 'logic! 'byte! = first compiler/get-type arg/data] | |
not path? arg/data | |
][ | |
unless block? arg [emit-load arg] ;-- block! means last value is already in eax (func call) | |
emit-casting arg no | |
emit-push <last> | |
compiler/last-type: arg/type ;-- for inline unary functions | |
][ | |
set-width arg | |
] | |
switch func-type [ | |
syscall [ | |
C-call?: yes | |
emit-load arg | |
] | |
] | |
] | |
emit-call: func [name [word!] args [block!] sub? [logic!] /local spec fspec type res total][ | |
if verbose >= 3 [print [">>>calling:" mold name mold args]] | |
fspec: select compiler/functions name | |
type: first spec: any [ | |
select emitter/symbols name ;@@ | |
next fspec | |
] | |
switch type [ ;-- call or inline the function | |
syscall [ | |
emit #{0E94} ;-- CALL address | |
emit-address last fspec ;-- syscall address | |
;emit-cdecl-pop fspec ;-- AVR-libc uses cdecl | |
c-reg: 25 ;-- reset register counter (C cconv) | |
C-call?: no ;-- clear C cconv flag | |
] | |
import [ | |
compiler/throw-error "not supported for AVR-8" | |
] | |
native [ | |
emit #{E8} ;-- CALL NEAR disp | |
emit-reloc-addr spec ;-- 32-bit relative displacement place-holder | |
if find [cdecl gcc45] fspec/3 [ ;-- in case of not default calling convention | |
emit-cdecl-pop fspec | |
] | |
] | |
inline [ | |
if block? args/1 [args/1: <last>] ;-- works only for unary functions | |
do select [ | |
not [emit-not args/1] | |
push [emit-push args/1] | |
pop [emit-pop] | |
] name | |
if name = 'not [res: compiler/get-type args/1] | |
] | |
op [ | |
emit-operation name args | |
if sub? [emitter/logic-to-integer name] | |
unless find comparison-op name [ ;-- comparison always return a logic! | |
res: any [ | |
;all [object? args/1 args/1/type] | |
all [not sub? block? args/1 compiler/last-type] | |
compiler/get-type args/1 ;-- other ops return type of the first argument | |
] | |
] | |
] | |
] | |
res | |
] | |
emit-stack-align-prolog: func [args [block!] /local offset][ | |
if compiler/job/stack-align-16? [ | |
emit #{89E7} ;-- MOV edi, esp | |
emit #{83E4F0} ;-- AND esp, -16 | |
offset: 1 + length? args ;-- account for saved edi | |
unless zero? offset: offset // 4 [ | |
emit #{83EC} ;-- SUB esp, offset ; ensure call will be 16-bytes aligned | |
emit to-bin8 (4 - offset) * 4 | |
] | |
emit #{57} ;-- PUSH edi | |
] | |
] | |
emit-stack-align-epilog: func [args [block!]][ | |
if compiler/job/stack-align-16? [ | |
emit #{5C} ;-- POP esp | |
] | |
] | |
emit-prolog: func [name [word!] locals [block!] locals-size [integer!] /local fspec][ | |
if verbose >= 3 [print [">>>building:" uppercase mold to-word name "prolog"]] | |
emit #{55} ;-- PUSH ebp | |
emit #{89E5} ;-- MOV ebp, esp | |
unless zero? locals-size [ | |
emit #{83EC} ;-- SUB esp, locals-size | |
emit to-char round/to/ceiling locals-size 4 ;-- limits total local variables size to 255 bytes | |
] | |
fspec: select compiler/functions name | |
if all [block? fspec/4/1 find fspec/4/1 'callback] [ | |
emit #{53} ;-- PUSH ebx | |
emit #{56} ;-- PUSH esi | |
emit #{57} ;-- PUSH edi | |
] | |
] | |
emit-epilog: func [name [word!] locals [block!] args-size [integer!] /local fspec][ | |
if verbose >= 3 [print [">>>building:" uppercase mold to-word name "epilog"]] | |
] | |
] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment