diff options
Diffstat (limited to 'transform.e')
| -rw-r--r-- | transform.e | 132 |
1 files changed, 123 insertions, 9 deletions
diff --git a/transform.e b/transform.e index ddf3208..61cc4e0 100644 --- a/transform.e +++ b/transform.e @@ -286,14 +286,16 @@ : transformation-state-user-stack-depth 3 8 * + ; : transformation-state-label-scratch 4 8 * + ; : transformation-state-delimiter 5 8 * + ; +: transformation-state-output-metadata 6 8 * + ; : allocate-transformation-state - 6 8 * allocate + 7 8 * allocate dup transformation-state-saved-here 0 swap ! dup transformation-state-saved-latest 0 swap ! dup transformation-state-output-buffer-start 0 swap ! dup transformation-state-user-stack-depth 0 swap ! dup transformation-state-label-scratch 0 swap ! - dup transformation-state-delimiter 0 swap ! ; + dup transformation-state-delimiter 0 swap ! + dup transformation-state-output-metadata 0 swap ! ; allocate-transformation-state s" transformation-state" variable @@ -2706,6 +2708,25 @@ allocate-transformation-state s" transformation-state" variable ~ (length to write, base address --) : hex-sys-write-replacement { over } { + ~ The output metadata is an array of structs in the format: referenced + ~ data pointer; referenced data length; string pointer. It ends with a + ~ value of 0 where the referenced data pointer would be. + transformation-state transformation-state-output-metadata @ + ~ (length remaining, current output address, metadata scan pointer) + { dup @ dup { dup 2 pick >= drop } if + ~ dup { dup 2 pick >= } if + } { + dup @ + 2 pick = { + ~ We found a matching metadata entry. + ~ (length remaining, current output address, metadata scan pointer) + + dup 2 8 * + @ ." ~ " emitstring newline + } if + 3 8 * + + } while + drop + dup 8@ .hex8 space 1+ swap 1- swap } while ; @@ -2909,6 +2930,84 @@ allocate-transformation-state s" transformation-state" variable : hex-latest-alternate latest ; : hex-here-alternate here ; +~ The code we're compiling may try to exit when it's done. We want to return +~ to our caller instead; we turn that into an nop. This isn't quite correct, +~ but it will work as long as the inner code doesn't try to do anything else +~ after. +: hex-bye-alternate ; + +~ Okay, now here's an interesting one. We need to provide additional +~ behavior for "allocate", but only when it is called directly from the body +~ of label-loop. That condition of being in the body is only testable +~ immediately, though "allocate" is not an immediate word and the effect of it +~ needs to happen later. This is crucial functionality that we can't work +~ without. So, we use a replacement and an alternate that work in tandem. +~ +~ First, we define the replacement... +~ +~ (size -- pointer) +: hex-allocate-replacement + allocate + + transformation-state transformation-state-output-metadata @ + ~ (result pointer, metadata output point) + + over pack64 + 0 pack64 + s" This is a commented hexadecimal representation of a compiled program," + pack64 + + over pack64 + 0 pack64 + s" the output of Evocation's hex transform. The comments are intended to" + pack64 + + over pack64 + 0 pack64 + s" allow a human reader to audit it. The difference between a source and a " + pack64 + + over pack64 + 0 pack64 + s" binary is comments! Enjoy. :)" + pack64 + + over pack64 + 0 pack64 + s" " pack64 + + 0 pack64 + drop ; + +~ ... then, we define the alternate. +~ +~ The alternate is flagged as immediate, which means hex-transform-one will +~ treat it as always having the highest priority. It checks what mode we're +~ in; if we're immediate, it runs the inner "allocate" if it exists or the +~ outer one if not. If we're compiling, it checks if we're in the body of +~ label-loop and compiles an execution token for the replacement if so, or the +~ inner "allocate" if not. +~ +~ If that was confusing: The point is, by having the immediate effect be +~ compilation, we get to have it both ways. +: hex-allocate-alternate + interpreter-flags @ 0x01 & { + ~ Compile mode. + latest @ entry-to-name dup s" label-loop" stringcmp 0 = { + ~ In label-loop. + drop + ' hex-allocate-replacement entry-to-execution-token , + } { + ~ Not in label-loop. + drop + s" allocate" find entry-to-execution-token , + } if-else + } { + ~ Immediate mode. + s" allocate" find + dup { entry-to-execution-token execute } { drop allocate } if-else + } if-else ; make-immediate + ~ This implements the hex transform for a single word. It is directly ~ analogous to "interpret", and reading interpret.e may help in understanding ~ it, though it's meant to still make sense on its own. @@ -2981,6 +3080,9 @@ allocate-transformation-state s" transformation-state" variable dup s" r0" stringcmp 0 = { swap drop ' hex-r0-alternate swap } if dup s" latest" stringcmp 0 = { swap drop ' hex-latest-alternate swap } if dup s" here" stringcmp 0 = { swap drop ' hex-here-alternate swap } if + dup s" bye" stringcmp 0 = { swap drop ' hex-bye-alternate swap } if + dup s" allocate" stringcmp 0 = { + swap drop ' hex-allocate-alternate swap } if ~ (name as stack string, 0 or alternate entry pointer, name pointer) find @@ -3124,11 +3226,14 @@ allocate-transformation-state s" transformation-state" variable ~ an input string. It is directly analogous to "quit", in interpret.e, but is ~ more complex. ~ -~ (output buffer start, output point, input string pointer, delimiter pointer +~ (comment buffer start, output buffer start, output point, +~ input string pointer, delimiter pointer ~ -- output buffer start, output point) : hex-transform main-input-buffer dup push-input-buffer 3roll attach-string-to-input-buffer + ~ (comment buffer start, output buffer start, output point, + ~ delimiter pointer) ~ Save the old values of "here" and "latest", and set the initial values ~ of the internal ones. These values need to persist across iterations, @@ -3136,17 +3241,26 @@ allocate-transformation-state s" transformation-state" variable ~ updates having taken effect. So we do the swap just once, here outside the ~ loop, and set it back when the loop ends. ~ - ~ We also take this opportunity to initialize the output-buffer-start and - ~ user-stack-depth fields of transformation-state. + ~ We also take this opportunity to initialize the other fields of + ~ transformation-state. While it might be nice to do these in some sort of + ~ logical order, it gets unreadable quickly, so we initialize them in the + ~ most convenient order given how we received our parameters. here @ transformation-state transformation-state-saved-here ! latest @ transformation-state transformation-state-saved-latest ! - 2 pick transformation-state transformation-state-output-buffer-start ! - 0 transformation-state transformation-state-user-stack-depth ! - swap here ! - 0 latest ! transformation-state transformation-state-delimiter ! + here ! + 0 latest ! + transformation-state transformation-state-output-buffer-start ! + 0 transformation-state transformation-state-user-stack-depth ! + transformation-state transformation-state-output-metadata ! ~ Now the stack has nothing of ours on it, so client code can do its thing. + ~ Initialize the contents of the output metadata. See + ~ hex-sys-write-replacement for more notes on its format. + transformation-state transformation-state-output-metadata @ + 0 pack64 + drop + ~ It's important that the stack has nothing of ours on it that persists ~ across iterations, so that client code can add and remove stuff there as ~ it sees fit. |