diff options
| -rw-r--r-- | amd64.e | 66 | ||||
| -rw-r--r-- | transform.e | 47 |
2 files changed, 69 insertions, 44 deletions
diff --git a/amd64.e b/amd64.e index 1449bfd..c6dabb4 100644 --- a/amd64.e +++ b/amd64.e @@ -263,6 +263,7 @@ s" :cc-greater" keyword ~ ~ (scale factor -- 2-bit encoded value) : scalefield + ~ : provide-decimal dup 1 = { drop 0 exit } if dup 2 = { drop 1 exit } if dup 4 = { drop 2 exit } if @@ -286,6 +287,7 @@ s" :cc-greater" keyword ~ ~ (condition -- 4-bit encoded value) : condition-code + ~ : provide-keyword dup :cc-overflow = { drop 0 exit } if dup :cc-no-overflow = { drop 1 exit } if dup :cc-below = { drop 2 exit } if @@ -511,8 +513,10 @@ s" :cc-greater" keyword ~ If the R/M register was rsp, we need an SIB byte; otherwise, skip it. 3roll { 0 4 :rsp reg64 sib } if ~ The displacement byte. + swap ~ : 1 adjust-length - swap pack8 ; + ~ : provide-hex8 + pack8 ; ~ (output point, reg/op field value, reg/mem field register, ~ displacement value -- output point) @@ -526,8 +530,10 @@ s" :cc-greater" keyword ~ If the R/M register was rsp, we need an SIB byte; otherwise, skip it. 3roll { 0 4 :rsp reg64 sib } if ~ The displacement value. + swap ~ : 4 adjust-length - swap pack32 ; + ~ : provide-hex32 + pack32 ; ~ (output point, reg/op field value, ~ scale factor, index register, base field register @@ -550,8 +556,10 @@ s" :cc-greater" keyword ~ Reg/mem value 4 means to use an SIB byte (at least, with this mode). 6 roll 1 7 roll 4 modrm 5 unroll 5 unroll reg64 3unroll reg64 3unroll scalefield 3unroll sib + swap ~ : 1 adjust-length - swap pack8 ; + ~ : provide-hex8 + pack8 ; ~ Easy instructions @@ -604,14 +612,14 @@ s" :cc-greater" keyword ~ (output point, source register, source displacement value, target register ~ -- output point) : lea-reg64-disp8-reg64 - ~ : 1 lea-reg64-disp8-reg64 + ~ : 1 # # # lea-reg64-disp8-reg64 4 roll rex-w 0x8D pack8 4 unroll reg64 3unroll addressing-disp8-reg64 ; ~ (output point, source register, source displacement value, target register ~ -- output point) : lea-reg64-disp32-reg64 - ~ : 1 lea-reg64-disp32-reg64 + ~ : 1 # # # lea-reg64-disp32-reg64 4 roll rex-w 0x8D pack8 4 unroll reg64 3unroll addressing-disp32-reg64 ; @@ -619,7 +627,7 @@ s" :cc-greater" keyword ~ source base register, source index register, source index scale factor, ~ target register -- output point) : lea-reg64-indexed-reg64 - ~ : 1 lea-reg64-indexed-reg64 + ~ : 1 # # # lea-reg64-indexed-reg64 5 roll rex-w 0x8D pack8 5 unroll reg64 4 unroll 3unroll swap addressing-indexed-reg64 ; @@ -628,7 +636,7 @@ s" :cc-greater" keyword ~ source displacement value, ~ target register -- output point) : lea-reg64-disp8-indexed-reg64 - ~ : 1 lea-reg64-disp8-indexed-reg64 + ~ : 1 # # # # lea-reg64-disp8-indexed-reg64 6 roll rex-w 0x8D pack8 6 unroll reg64 5 unroll 3 roll 4 roll 3 roll addressing-disp8-indexed-reg64 ; @@ -681,7 +689,7 @@ s" :cc-greater" keyword ~ (output point, source register, target register, target displacement value ~ -- output point) : mov-disp8-reg64-reg64 - ~ : 1 # # mov-disp8-reg64-reg64 + ~ : 1 # # # mov-disp8-reg64-reg64 4 roll rex-w 0x89 pack8 4 unroll 3roll reg64 3unroll addressing-disp8-reg64 ; @@ -694,11 +702,11 @@ s" :cc-greater" keyword ~ (output point, source register, source displacement value, target register ~ -- output point) : mov-reg64-disp8-reg64 - ~ : 1 # # mov-reg64-disp8-reg64 + ~ : 1 # # # mov-reg64-disp8-reg64 4 roll rex-w 0x8B pack8 4 unroll reg64 3unroll addressing-disp8-reg64 ; : mov-reg64-disp32-reg64 - ~ : 1 mov-reg64-disp32-reg64 + ~ : 1 # # # mov-reg64-disp32-reg64 4 roll rex-w 0x89 pack8 4 unroll 3roll reg64 swap 3roll addressing-disp32-reg64 ; @@ -706,7 +714,7 @@ s" :cc-greater" keyword ~ source base register, source index register, source index scale factor, ~ target register -- output point) : mov-reg64-indexed-reg64 - ~ : 1 mov-reg64-indexed-reg64 + ~ : 1 # # # mov-reg64-indexed-reg64 5 roll rex-w 0x8B pack8 5 unroll reg64 4 unroll 3unroll swap addressing-indexed-reg64 ; @@ -714,86 +722,88 @@ s" :cc-greater" keyword ~ target base register, target index register, target index scale factor ~ -- output point) : mov-indexed-reg64-reg64 - ~ : 1 mov-indexed-reg64-reg64 + ~ : 1 # # # mov-indexed-reg64-reg64 5 roll rex-w 0x89 pack8 5 unroll 4 roll reg64 4 unroll 3unroll swap addressing-indexed-reg64 ; ~ (output point, source register, target register -- output point) : mov-indirect-reg64-reg32 - ~ : 1 mov-indirect-reg64-reg32 + ~ : 1 # # mov-indirect-reg64-reg32 3roll 0x89 pack8 3unroll swap reg32 swap addressing-indirect-reg64 ; ~ (output point, source register, target register, target displacement value ~ -- output point) : mov-disp8-reg64-reg32 - ~ : 1 mov-disp8-reg64-reg32 + ~ : 1 # # # mov-disp8-reg64-reg32 4 roll 0x89 pack8 4 unroll 3roll reg32 3unroll addressing-disp8-reg64 ; ~ (output point, source register, target register -- output point) : mov-reg32-indirect-reg64 - ~ : 1 mov-reg32-indirect-reg64 + ~ : 1 # # mov-reg32-indirect-reg64 3roll 0x8B pack8 3unroll reg32 swap addressing-indirect-reg64 ; ~ (output point, source register, source displacement value, target register ~ -- output point) : mov-reg32-disp8-reg64 - ~ : 1 mov-reg32-disp8-reg64 + ~ : 1 # # # mov-reg32-disp8-reg64 4 roll 0x8B pack8 4 unroll reg32 3unroll addressing-disp8-reg64 ; ~ (output point, source register, target register -- output point) : mov-indirect-reg64-reg16 - ~ : 2 mov-indirect-reg64-reg16 + ~ : 2 # # mov-indirect-reg64-reg16 3roll 0x66 pack8 0x89 pack8 3unroll swap reg16 swap addressing-indirect-reg64 ; ~ (output point, source register, target register, target displacement value ~ -- output point) : mov-disp8-reg64-reg16 - ~ : 2 mov-disp8-reg64-reg16 + ~ : 2 # # # mov-disp8-reg64-reg16 4 roll 0x66 pack8 0x89 pack8 4 unroll 3roll reg16 3unroll addressing-disp8-reg64 ; ~ (output point, source register, target register -- output point) : mov-reg16-indirect-reg64 - ~ : 2 mov-reg16-indirect-reg64 + ~ : 2 # # mov-reg16-indirect-reg64 3roll 0x66 pack8 0x8B pack8 3unroll reg16 swap addressing-indirect-reg64 ; ~ (output point, source register, target displacement value, target register ~ -- output point) : mov-reg16-disp8-reg64 - ~ : 2 mov-reg16-disp8-reg64 + ~ : 2 # # # mov-reg16-disp8-reg64 4 roll 0x66 pack8 0x8B pack8 4 unroll reg16 3unroll addressing-disp8-reg64 ; ~ (output point, source register, target register -- output point) : mov-indirect-reg64-reg8 - ~ : 1 mov-indirect-reg64-reg8 + ~ : 1 # # mov-indirect-reg64-reg8 3roll 0x88 pack8 3unroll swap reg8 swap addressing-indirect-reg64 ; ~ (output point, source register, target register, target displacement value ~ -- output point) : mov-disp8-reg64-reg8 - ~ : 1 mov-disp8-reg64-reg8 + ~ : 1 # # # mov-disp8-reg64-reg8 4 roll 0x88 pack8 4 unroll 3roll reg8 3unroll addressing-disp8-reg64 ; ~ (output point, source register, target register -- output point) : mov-reg8-indirect-reg64 - ~ : 1 mov-reg8-indirect-reg64 + ~ : 1 # # mov-reg8-indirect-reg64 3roll 0x8A pack8 3unroll reg8 swap addressing-indirect-reg64 ; +~ TODO this word is probably broken? It appears to try packing something +~ that doesn't exist, and it's never called. ~ (output point, source register, source displacement value, target register ~ -- output point) : mov-reg8-disp8-reg64 - ~ : 2 # mov-reg8-disp8-reg64 + ~ : 2 # # # mov-reg8-disp8-reg64 4 roll ~ : provide-hex8 pack8 0x8A pack8 4 unroll @@ -801,7 +811,7 @@ s" :cc-greater" keyword ~ (output point, source register, target register -- output point) : mov-reg8-reg8 - ~ : 1 mov-reg8-reg8 + ~ : 1 # # mov-reg8-reg8 3roll 0x88 pack8 3unroll swap reg8 swap addressing-reg8 ; @@ -1225,14 +1235,14 @@ s" :cc-greater" keyword ~ (output point, condition code, target register -- output point) : set-reg8-cc - ~ : 1 # set-reg8-cc + ~ : 1 # # set-reg8-cc 3roll 0x0F pack8 3roll condition-code 0x90 opcodecc swap reg8 3 0 3roll modrm ; ~ (output point, address offset value, condition code -- output point) : jmp-cc-rel-imm8 - ~ : 1 # jmp-cc-rel-imm8 + ~ : 1 # # jmp-cc-rel-imm8 3roll swap condition-code 0x70 opcodecc swap ~ : provide-hex8 @@ -1240,7 +1250,7 @@ s" :cc-greater" keyword ~ (output point, address offset value, condition code -- output point) : jmp-cc-rel-imm32 - ~ : 5 # jmp-cc-rel-imm32 + ~ : 5 # # jmp-cc-rel-imm32 3unroll 0x0F pack8 swap condition-code 0x70 opcodecc swap diff --git a/transform.e b/transform.e index 54fd9e6..2227f2a 100644 --- a/transform.e +++ b/transform.e @@ -2778,6 +2778,7 @@ allocate-transformation-state s" transformation-state" variable ~ ~ : 1 suppress ~ ~ ~ : Do a thing with # and # ? +~ ~ : provide-decimal ~ ~ : provide-hex8 ~ ~ : provide-hex16 ~ ~ : provide-hex32 @@ -2901,9 +2902,10 @@ allocate-transformation-state s" transformation-state" variable ~ with the "adjust-line" command. When this command executes, it doesn't ~ create a new metadata entry. Rather, it scans backwards from the end of the ~ entry array, to find the most recently-created entry which is a line or -~ suffix comment. Then it adjusts the length of that entry, in-place! The -~ parameter of adjust-line may be positive or negative, and either way it's -~ added to the pre-existing length of the entry it modifies. +~ suffix comment. It skips over entries of other types. Then it adjusts the +~ length of that entry, in-place! The parameter of adjust-line may be positive +~ or negative, and either way it's added to the pre-existing length of the +~ entry it modifies. ~ ~ If that doesn't sound confusing, you may not have fully appreciated that ~ adjust-line commands don't have to come in the same word as the command that @@ -3098,13 +3100,13 @@ allocate-transformation-state s" transformation-state" variable ~ still just recording the fact that the word did or didn't run. ~ ~ The provide-* commands are deeper than that. They peek at the top item on -~ the stack OF THE COMPILER, the code being transformed. The -hex* variants -~ create a corresponding provide-substring-hex* metadata entry and copy the -~ numeric value into it. The -keyword variant expects to find a keyword (a -~ word which, when executed, pushes its own execution token onto the stack); -~ the command extracts the name of the keyword from the dictionary entry -~ header, and saves a pointer to the name in a provide-substring-string -~ metadata entry. +~ the stack OF THE COMPILER, the code being transformed. The -decimal and +~ -hex* variants create a corresponding -entry-type-provide-substring- +~ metadata entry of the matching type, and copy the numeric value into it. The +~ -keyword variant expects to find a keyword (a word which, when executed, +~ pushes its own execution token onto the stack); the command extracts the +~ name of the keyword from the dictionary entry header, and saves a pointer to +~ the name in a provide-substring-string metadata entry. ~ ~ Admit it, you thought writing out "metadata entry" so many times instead ~ of just "entry" was silly because there was no other kind of entry in @@ -3173,11 +3175,12 @@ allocate-transformation-state s" transformation-state" variable : hex-output-metadata-entry-type-string-literal 5 ; : hex-output-metadata-entry-type-raw-string-literal 6 ; : hex-output-metadata-entry-type-alignment 7 ; -: hex-output-metadata-entry-type-provide-substring-hex8 8 ; -: hex-output-metadata-entry-type-provide-substring-hex16 9 ; -: hex-output-metadata-entry-type-provide-substring-hex32 10 ; -: hex-output-metadata-entry-type-provide-substring-hex64 11 ; -: hex-output-metadata-entry-type-provide-substring-string 12 ; +: hex-output-metadata-entry-type-provide-substring-decimal 8 ; +: hex-output-metadata-entry-type-provide-substring-hex8 9 ; +: hex-output-metadata-entry-type-provide-substring-hex16 10 ; +: hex-output-metadata-entry-type-provide-substring-hex32 11 ; +: hex-output-metadata-entry-type-provide-substring-hex64 12 ; +: hex-output-metadata-entry-type-provide-substring-string 13 ; ~ Initialize the contents of the output metadata to all zeroes. This is ~ called from hex-transform at its top level, at the very start, to make sure @@ -3217,7 +3220,8 @@ allocate-transformation-state s" transformation-state" variable : is-provide-substring-entry hex-output-metadata-entry-type @ - dup hex-output-metadata-entry-type-provide-substring-hex8 = swap + dup hex-output-metadata-entry-type-provide-substring-decimal = swap + dup hex-output-metadata-entry-type-provide-substring-hex8 = 3roll || swap dup hex-output-metadata-entry-type-provide-substring-hex16 = 3roll || swap dup hex-output-metadata-entry-type-provide-substring-hex32 = 3roll || swap dup hex-output-metadata-entry-type-provide-substring-hex64 = 3roll || swap @@ -3700,6 +3704,11 @@ allocate-transformation-state s" transformation-state" variable pop-substring-entry-stack dup hex-output-metadata-entry-type @ + hex-output-metadata-entry-type-provide-substring-decimal = { + dup hex-output-metadata-entry-string @ . + } if + + dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-provide-substring-hex8 = { ." 0x" dup hex-output-metadata-entry-string @ .hex8 @@ -4693,6 +4702,12 @@ allocate-transformation-state s" transformation-state" variable ~ Notice with all of these that we intentionally read one stack level deeper ~ than anything of ours, which will be a value provided by the code the ~ magic comment is embedded in. + dup s" provide-decimal" stringcmp 0 = { + ~ Create a new "provide substring decimal" entry. + drop 2 pick hex-output-metadata-entry-type-provide-substring-decimal swap + add-hex-output-metadata-entry + exit + } if dup s" provide-hex8" stringcmp 0 = { ~ Create a new "provide substring hex8" entry. drop 2 pick hex-output-metadata-entry-type-provide-substring-hex8 swap |