~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~ ~~ Code transformation facility ~~ ~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~ ~ The process of producing an executable binary out of Evocation involves ~ various bootstrapping phases during which code operates under different ~ constraints, and must be written with different styles. In some cases, ~ substantially the same code must be output multiple times in slightly ~ different ways, and it would be both arduous and verbose to write each of ~ these directly. ~ ~ To solve this problem, this file implements a concept of code ~ transformation. There are two transforms, the label transform and the ~ log-load transform, each of which takes a string containing Evocation source ~ code and produces compiled code that has been modified to operate in a ~ specific way. The transforms rely on the label facility provided by ~ labels.e, and expect to run from within label-loop. ~ ~ The label transform produces code that uses one label per word it defines, ~ to statically reference everything. Thus, when output to an executable ~ binary, this code will function without external dependencies. The tradeoff ~ is that it has no way to reference data that exists only at runtime. ~ ~ The log-load transform relies on labels, but doesn't add any of its own. ~ It produces a compiled routine which, when run, dynamically looks up all the ~ references in the log, and appends the original code to the log. This adds ~ work that must be done when the runtime starts up, but the benefit is that ~ it can reference data that doesn't exist at compile-time. Most crucially, ~ it can reference the "here" and "latest" pointers in the log, which are ~ required for all the usual word-definition stuff to work, and whose ~ addresses are not known until runtime. ~ ~ The log-load transform may also be useful for experimental tasks such as ~ creating additional, independent logs, or injecting Evocation into another ~ process's address space. ~ ~ Please notice that both these transforms, in different ways, navigate the ~ same underlying design tension: The Forth compilation model hardcodes ~ references at the time compilation happens, and Evocation makes the choice ~ to not decide the address of the log until runtime. Thus the label transform ~ can't be sufficient on its own. Other Forths avoid this problem by ~ hardcoding an address for the log, or by using OS-provided load-time ~ symbol relocation. Evocation, however, does it on hard mode, mostly for fun. ~ ~ Because it was clear from early on that the label transform couldn't stand ~ alone, and that another one would be necessary, we've refrained from adding ~ too many features to it. Since we have multiple transforms, they should each ~ be kept simple and well-defined, so that they can be composed in creative ~ new ways down the line. When adding additional behavior, always give thought ~ to whether it belongs in an existing transform or a new one. ~ ~ ~ About the label transform ~ ~~~~~~~~~~~~~~~~~~~~~~~~~ ~ ~ The label transform operates on code that compiles itself, and ensures ~ that the result of the compilation is suitable to be included in an ~ executable binary as words that are statically referenced by their ~ addresses. To achieve this, it causes each newly-defined word to have a ~ corresponding label whose value is the offset of its codeword, and it causes ~ all compiled invocations of other words to be resolved by using these labels. ~ The label transform is suitable for code that must be directly invoked by ~ the warm-start routine provided by execution.e. ~ ~ The most fundamental technique the label transform performs is to separate ~ words that run in compile mode from words that run immediately. There is no ~ distinction made between words running in immediate mode, and words declared ~ as immediate. Immediate words are looked up and executed based on their ~ "real", currently-executing definitions. Compiled words, including ~ literals, are looked up via the label facility. ~ ~ Since the label facility is able to resolve forward references, there is ~ no hard requirement that everything in the file be topologically sorted. ~ However, the transform will refuse to create forward references to compiled ~ words. If you want them, you can create them by hand by calling use-label ~ yourself. This restriction is in place because allowing forward references ~ would be a significant difference from un-transformed code that could easily ~ become confusing, and because it simplifies the implementation a bit. ~ ~ Compilation words do make extensive reference to the global variables ~ "here" and "latest". In particular, flow-control words such as if-else ~ expect the log to have recent compilation outputs on it, and to be able to ~ mutate them in-place. In order to make this work, we provide temporary ~ values of these two variables which point to the location of the output ~ buffer. This allows pointer resolution to work correctly without additional ~ effort, but notice that the buffer's address will differ from the address ~ the resulting program loads itself at. There's no simple way to avoid this ~ concern, since the variables must point to one of those addresses or the ~ other, not both. ~ ~ We resolve the issue by running our own, alternate versions of most of the ~ critical word-defining words, including for example "create", ":", and ";". ~ These alternates run instead of the normal versions of these words, and use ~ the label facility to compute the addresses that will be needed at runtime. ~ The code being compiled is responsible for not doing anything else that ~ would rely on "here" and "latest" matching their runtime addresses, though ~ it is otherwise allowed to modify and rely on them in all the usual ways. ~ The alternate versions are defined in this file as their own words, ~ "label-create-alternate" and so on. ~ ~ Note that these alternates are applied via a purely lexical ~ transformation: when a word would be looked up in the dictionary to ~ interpret, first check if it's one of these. That means the transformation ~ won't apply to indirect callers of these words, nor to tick-quotes of them. ~ The code being compiled is responsible for not doing either of those things. ~ ~ Notably, the transformation uses the same "interpreter-flags" variable as ~ the rest of Evocation. There's no need to keep it separate like there is ~ with the other variables. This makes it easy to change modes. ~ ~ The label transformation and its alternates rely on various labels, all of ~ which must be defined elsewhere, lest the label loop fail to converge: ~ "lit", "origin", "docol", "exit", ":", ";", and ";asm". ~ ~ All of these limitations result in the compiled code being, in effect, ~ written in a dialect which is like Evocation, but more restricted. This is ~ acceptable, because the label transform is intended for compiling code that ~ is an early part of Evocation itself, and the necessary code has all been ~ written to follow these restrictions. ~ ~ ~ About the log-load transform ~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~ ~ The log-load transform also operates on code that compiles itself; it ~ produces a compiled routine which, when run, appends the original code to ~ the log. As the routine is run, each reference to another word is resolved ~ by looking up the name of the target word in the log. Furthermore, these ~ lookups are done using log-load-find, defined in log-load.e, which accepts ~ a pointer to the log's base address as a parameter. See that file for more ~ explanation of what the log is and why it's important. Thus, unlike normal ~ accesses to the log, this routine doesn't rely on already having the log's ~ base address hardcoded into it at the time of its own compilation. The ~ log-load transform is suitable for implementing the core responsibilities of ~ the warm-start routine provided by execution.e, relying on only a few ~ specific words that it statically references via labels. ~ ~ Much like the label transform, the log-load transform provides alternate ~ versions of certain immediate words used in word definition. Also like the ~ label transform, it provides its own copies of "here" and "latest". ~ ~ The log-load transform provides alternates for a significantly broader set ~ of words than the label transform, including all the flow-control words such ~ as if-else. It runs its own alternates immediately, but unlike the label ~ transform, immediate execution for the log-load transform is not actually ~ immediate; it is compiled into words which will have those immediate effects ~ at the time the generated routine is run. The generated routine can itself ~ be thought of as a compilation process, producing its output on the log, so ~ doing things later for us still means doing them immediately during the ~ routine. ~ ~ The log-load transform does impose a no-forward-references requirement, ~ though it is applied at the time the routine is run, rather than at the time ~ of the transformation. ~ ~ The log-load transformation and its alternates rely on the following ~ labels, all of which must be defined elsewhere: TODO ~ ~ ~ About the hex transform ~ ~~~~~~~~~~~~~~~~~~~~~~~ ~ ~ The hex transform's role is a bit different. Whereas the label and ~ log-load transforms are used as part of generating an executable binary, the ~ hex transform produces a commented hex dump that, when later processed by ~ the "hex" tool, produces that same binary. It achieves this by modifying ~ various words which are core parts of Evocation to keep track of appropriate ~ comments and other metadata, and modifying the output facility to output a ~ hex dump with any attached comments, rather than raw bytes. ~ ~ By its nature, the hex transform needs to be able to cope with other ~ transforms running inside itself; that is, the transformation facility needs ~ to be reentrant. The other transforms don't have to cope with that, since ~ the code they run is mostly just about creating word definitions, but the ~ code given to the hex transform will normally include a call to label-loop, ~ all the memory manipulation that happens as part of binary generation, and ~ various output words. ~ ~ While the label and log-load transforms allow Evocation to be a ~ self-hosting compiler, the hex transform attains the even higher bar of ~ making Evocation a "self-bootstrapping" compiler, able to create a running ~ copy of itself without having any sort of pre-existing compiler at all, only ~ a hex converter or similar small tool. The idea is that the hex converter is ~ small and simple enough that it's easy to perform a BINARY audit on, and ~ that there need be no other binary artifacts in the chain of trust. ~ ~ This is not a new concept, but as far as Irenes are aware this name for it ~ is a new coinage. The approach of using a hex-to-binary conversion tool as ~ the initial bootstrapping stage is due to MesCC, which is quite inspiring in ~ that regard. ~ ~ The key insight is that, some sense, the difference between source code ~ and binary is the ability to have comments. ~ ~ The hex transform keeps some large, complex state as it runs, unlike the ~ label and log-load transforms, which only require very simple state. This ~ state is called the "output metadata". Entries in the output metadata are ~ created and modified as the code under transform runs, by "magic comments" ~ embedded within it. There is a complex command language for these comments, ~ which must be understood to write code designed to make good use of the hex ~ transform. Fortunately, that's really just assembly-language ~ implementations. ~ ~ It's quite an intense topic, and many readers may wish only to know that ~ the hex transform exists, not how it's structured. So, details on the output ~ metadata and the magic comments are described below, under "hex transform ~ implementation", rather than here. ~ ~ The hex transform DOES NOT WORK yet. It's still in development. ~ TODO update this note when it does work ~ Buffer- and address-management helpers ~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~ ~ The facilities in this section are used as helper code in the ~ implementations of both transforms. ~ TODO all this buffer stuff should be in its own file ~ (delimiter pointer, buffer size -- buffer address) : read-to-buffer dup allocate dup dup ~ (buffer size, buffer address, word start, output point) { key ~ Exit if it's a zero byte. dup not { ~ Make sure to pack the zero to serve as a null terminator. pack8 drop drop swap drop swap drop exit } if ~ If it's a space character, we need to check if we just consumed the ~ magic word, and do some handling to reset the word tracking. dup is-space { ~ (buffer size, buffer address, word start, output point, key) ~ Tuck the key out of the way until we've done some stuff. 3unroll ~ Add a null terminator so we can use stringcmp dup 0 swap 8! ~ Check for the magic word. over 6 pick stringcmp 0 = { ~ It's magic, so exit. ~ Make sure to pack a zero to serve as a null terminator. 0 pack8 drop drop drop swap drop swap drop exit } { ~ It's not magic, so reset the word start. Of course whitespace is ~ not a word but this will help us keep track of things. 3roll pack8 swap drop dup } if-else } { ~ (buffer size, buffer address, word start, output point, key) ~ Tuck the key out of the way again. 3unroll ~ Check if the word just started and the previous character is space. 2dup = dup { drop dup @ is-space } if { ~ If so, this is the actual first character of the word. drop swap pack8 dup } { ~ If not, leave the word start alone. 3roll pack8 } if-else } if-else } forever ; ~ In logical terms, this modifies an input buffer metadata structure ~ in-place to push a new, zeroed one into the start of the linked list formed ~ through the next-source field. ~ ~ In physical terms, it works by allocating a new structure, copying the ~ fields of the existing one into it, and zeroing the existing one. That's ~ necessary because otherwise we'd need a mutable handle (a pointer to a ~ pointer) to update the start of the list, and there's no way to do that with ~ the main-input-buffer variable working the way it presently does. ~ ~ (input buffer metadata pointer --) : push-input-buffer allocate-input-buffer-metadata ~ (original metadata pointer, new metadata pointer) 2dup 6 8 * memcopy ~ (original metadata pointer, new metadata pointer) swap dup zero-input-buffer-metadata input-buffer-next-source ! ; ~ This does the inverse of push-input-buffer. In the event that the ~ next-source field is null, it zeroes the buffer. ~ ~ Note, however, that it doesn't deallocate the memory, because that's not ~ how memory allocation on the log works. If necessary, it can be deallocated ~ with "forget", though as usual that requires careful planning. ~ ~ (input buffer metadata pointer --) : pop-input-buffer dup input-buffer-next-source @ ~ (original metadata pointer, next source metadata pointer) dup { swap 6 8 * memcopy } { drop zero-input-buffer-metadata } if-else ; ~ We have a bunch of accessors for the transformation state structure, which ~ are all functions from pointers to pointers. We also define a global ~ variable which points to the transformation state. : transformation-state-saved-here ; : transformation-state-saved-latest 8 + ; : transformation-state-output-buffer-start 2 8 * + ; : 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 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-output-metadata 0 swap ! ; allocate-transformation-state s" transformation-state" variable ~ When calling the label facility during a transformation, it's necessary ~ to use the real, non-wrapped "here" and "latest". : swap-transform-variables here @ transformation-state transformation-state-saved-here @ here ! transformation-state transformation-state-saved-here ! latest @ transformation-state transformation-state-saved-latest @ latest ! transformation-state transformation-state-saved-latest ! ; ~ We deal with a few address spaces. There's the "host" address space, the ~ space this process performing the compilation is using for itself. There's ~ the "target" address space, the address space that will exist later, when ~ the program we've compiled is running. ~ ~ Then there's "offsets", which are relative to the start of the output ~ buffer. For clarity's sake, we always refer to these as offsets, rather than ~ as addresses. ~ ~ When we define labels for compiled words, we set their values to be ~ offsets pointing to the generated codeword. This is done by ~ label-create-alternate. We then need to convert them either to the host or ~ the target address space, depending on how we're using them. ~ ~ There's no approach here that isn't confusing, but the hope is that by ~ using offsets, so that we always have to convert them regardless of what ~ we're doing with them, we won't miss a spot where conversion needs to ~ happen. ~ ~ (output offset -- target address) : offset-to-target-address-space ~ Don't transform null pointers. dup { swap-transform-variables L@' origin swap-transform-variables + } if ; ~ (target address -- output offset) : target-address-space-to-offset ~ Don't transform null pointers. dup { swap-transform-variables L@' origin swap-transform-variables - } if ; ~ (output offset -- host address) : offset-to-host-address-space ~ Don't transform null pointers dup { transformation-state transformation-state-output-buffer-start @ + } if ; ~ (host address --output offset) : host-address-space-to-offset ~ Don't transform null pointers dup { transformation-state transformation-state-output-buffer-start @ - } if ; ~ (host address inside the output buffer -- target address) : host-address-space-to-target host-address-space-to-offset offset-to-target-address-space ; ~ (target address -- host address) : target-address-space-to-host target-address-space-to-offset offset-to-host-address-space ; : describe-transformation ." active here " here @ .hex64 space ." latest " latest @ .hex64 newline ." saved here " transformation-state transformation-state-saved-here @ .hex64 space ." latest " transformation-state transformation-state-saved-latest @ .hex64 newline ." output start " transformation-state transformation-state-output-buffer-start @ .hex64 newline ." user stack depth " transformation-state transformation-state-user-stack-depth @ .hex64 newline ; ~ User stack depth tracking helper ~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~ ~ The transformation facility offers a feature which specific transforms can ~ use, or not, as they prefer, called user stack depth tracking. The log-load ~ transform uses it; the label transform does not. The most difficult part of ~ the tracking is the heler word below; it also relies on the user-stack-depth ~ field of the transformation-state variable. ~ ~ What does user stack depth mean? Well, for every transform there's some ~ notion of running a word "immediately"; for the log-load transform, it means ~ that the word runs at the time the generated log-load routine executes. Each ~ time a word runs, it interacts with the value stack in some way. Some words ~ are neutral; others result in a net increase or decrease in its depth, which ~ we call the delta. The running total of these deltas is what we call the ~ user stack depth. By "user" we mean that these are values which were created ~ by and for the code being transformed, which the code doing the transforming ~ must be careful not to interfere with. ~ ~ Why do we need to do this? Recall that the log-load routine is given the ~ log address as the only value on the stack when it begins, and any time it ~ does something that requires looking at the log, it needs to be able to find ~ that address. The log-load routine runs as part of the warm-start routine ~ (see execution.e), whose overall job is to get Evocation into a state where ~ it can freely work with dynamically-allocated data on the log whose address ~ isn't known at compile time. Therefore, necessarily, the log-load routine ~ itself cannot assume access to any scratch space; the value stack is the ~ only place it can store anything it needs, most crucially including the log ~ address. ~ ~ Fortunately, it is possible for the transform's own generated code to ~ cooperate with the transformed code so that they can both share the stack, ~ as long as the log transform knows what the transformed code is doing with ~ it. Unfortunately, there's no general way to know that. We achieve it by ~ hard-coding a delta value for every single possible word, and looking up ~ that delta at transform-time, based on the word's name. Yes, that is quite a ~ thing to have to do, but it does mean we don't have to think about this ~ while writing the code we're transforming. ~ ~ It's worth noticing that the delta only applies to things that happen ~ immediately. It does not apply to compiled words because they run later, and ~ it does not apply to alternates because they run too soon. Feel free to ~ contemplate how confusing it is that transformation-time is sooner than ~ "immediate". ~ ~ (name pointer -- delta value) : transform-get-stack-delta ~ From core.e. dup s" docol" stringcmp 0 = { drop 1 exit } if dup s" exit" stringcmp 0 = { drop 0 exit } if dup s" swap" stringcmp 0 = { drop 0 exit } if dup s" drop" stringcmp 0 = { drop -1 exit } if dup s" 2drop" stringcmp 0 = { drop -2 exit } if ~ The following are deliberate omissions: roll, unroll. dup s" 3roll" stringcmp 0 = { drop 0 exit } if dup s" 3unroll" stringcmp 0 = { drop 0 exit } if dup s" dup" stringcmp 0 = { drop 1 exit } if dup s" 2dup" stringcmp 0 = { drop 2 exit } if dup s" +" stringcmp 0 = { drop -1 exit } if dup s" -" stringcmp 0 = { drop -1 exit } if dup s" *" stringcmp 0 = { drop -1 exit } if dup s" /%" stringcmp 0 = { drop 0 exit } if dup s" 1+" stringcmp 0 = { drop 0 exit } if dup s" 1-" stringcmp 0 = { drop 0 exit } if dup s" =" stringcmp 0 = { drop -1 exit } if dup s" !=" stringcmp 0 = { drop -1 exit } if dup s" >" stringcmp 0 = { drop -1 exit } if dup s" <" stringcmp 0 = { drop -1 exit } if dup s" >=" stringcmp 0 = { drop -1 exit } if dup s" <=" stringcmp 0 = { drop -1 exit } if dup s" >unsigned" stringcmp 0 = { drop -1 exit } if dup s" =unsigned" stringcmp 0 = { drop -1 exit } if dup s" <=unsigned" stringcmp 0 = { drop -1 exit } if dup s" &" stringcmp 0 = { drop -1 exit } if dup s" |" stringcmp 0 = { drop -1 exit } if dup s" xor" stringcmp 0 = { drop -1 exit } if dup s" invert" stringcmp 0 = { drop 0 exit } if dup s" lit" stringcmp 0 = { drop 1 exit } if dup s" litstring" stringcmp 0 = { drop 1 exit } if dup s" !" stringcmp 0 = { drop -2 exit } if dup s" @" stringcmp 0 = { drop 0 exit } if dup s" +!" stringcmp 0 = { drop -2 exit } if dup s" -!" stringcmp 0 = { drop -2 exit } if dup s" 8!" stringcmp 0 = { drop -2 exit } if dup s" 8@" stringcmp 0 = { drop 0 exit } if dup s" 16!" stringcmp 0 = { drop -2 exit } if dup s" 16@" stringcmp 0 = { drop 0 exit } if dup s" 32!" stringcmp 0 = { drop -2 exit } if dup s" 32@" stringcmp 0 = { drop 0 exit } if dup s" control!" stringcmp 0 = { drop -1 exit } if dup s" control@" stringcmp 0 = { drop 1 exit } if dup s" value!" stringcmp 0 = { drop -1 exit } if dup s" value@" stringcmp 0 = { drop 1 exit } if dup s" memcopy" stringcmp 0 = { drop -3 exit } if dup s" memmove" stringcmp 0 = { drop -3 exit } if dup s" stringlen" stringcmp 0 = { drop 0 exit } if dup s" reverse-stringlen" stringcmp 0 = { drop 0 exit } if dup s" reverse-padding-len" stringcmp 0 = { drop 0 exit } if dup s" stringcmp" stringcmp 0 = { drop -1 exit } if dup s" branch" stringcmp 0 = { drop 0 exit } if dup s" 0branch" stringcmp 0 = { drop 0 exit } if ~ This is kind of a big assumption. dup s" execute" stringcmp 0 = { drop -1 exit } if dup s" entry-to-execution-token" stringcmp 0 = { drop 0 exit } if dup s" execution-token-to-entry" stringcmp 0 = { drop 0 exit } if dup s" entry-flags@" stringcmp 0 = { drop 0 exit } if dup s" entry-flags!" stringcmp 0 = { drop -2 exit } if dup s" entry-to-name" stringcmp 0 = { drop 0 exit } if dup s" pack64" stringcmp 0 = { drop -1 exit } if dup s" pack32" stringcmp 0 = { drop -1 exit } if dup s" pack16" stringcmp 0 = { drop -1 exit } if dup s" pack8" stringcmp 0 = { drop -1 exit } if dup s" packstring" stringcmp 0 = { drop -1 exit } if dup s" packalign" stringcmp 0 = { drop -1 exit } if dup s" unpack64" stringcmp 0 = { drop 1 exit } if dup s" unpack32" stringcmp 0 = { drop 1 exit } if dup s" unpack16" stringcmp 0 = { drop 1 exit } if dup s" unpack8" stringcmp 0 = { drop 1 exit } if dup s" align-size" stringcmp 0 = { drop -1 exit } if dup s" unpackalign" stringcmp 0 = { drop -1 exit } if dup s" crash" stringcmp 0 = { drop 0 exit } if dup s" max" stringcmp 0 = { drop -1 exit } if dup s" min" stringcmp 0 = { drop -1 exit } if dup s" over" stringcmp 0 = { drop 1 exit } if dup s" pick" stringcmp 0 = { drop 0 exit } if ~ The following are deliberate omissions: ndrop, ndup. dup s" 3drop" stringcmp 0 = { drop -3 exit } if dup s" 3dup" stringcmp 0 = { drop 3 exit } if dup s" &&" stringcmp 0 = { drop -1 exit } if dup s" ||" stringcmp 0 = { drop -1 exit } if dup s" not" stringcmp 0 = { drop 0 exit } if dup s" negate" stringcmp 0 = { drop 0 exit } if dup s" align-floor" stringcmp 0 = { drop -1 exit } if ~ From linux.e. dup s" sys-exit" stringcmp 0 = { drop -1 exit } if dup s" sys-write" stringcmp 0 = { drop -2 exit } if dup s" sys-read" stringcmp 0 = { drop -1 exit } if ~ From output.e. dup s" emitstring" stringcmp 0 = { drop -1 exit } if dup s" space" stringcmp 0 = { drop 0 exit } if dup s" newline" stringcmp 0 = { drop 0 exit } if dup s" pow" stringcmp 0 = { drop 2 exit } if dup s" logfloor" stringcmp 0 = { drop 2 exit } if dup s" logceil" stringcmp 0 = { drop 2 exit } if dup s" .base-unsigned" stringcmp 0 = { drop -3 exit } if dup s" .base" stringcmp 0 = { drop -2 exit } if dup s" ." stringcmp 0 = { drop -1 exit } if dup s" .hex" stringcmp 0 = { drop -1 exit } if dup s" .hex8" stringcmp 0 = { drop -1 exit } if dup s" .hex16" stringcmp 0 = { drop -1 exit } if dup s" .hex32" stringcmp 0 = { drop -1 exit } if dup s" .hex64" stringcmp 0 = { drop -1 exit } if dup s" .hexn" stringcmp 0 = { drop -2 exit } if ~ From amd64.e. dup s" :rax" stringcmp 0 = { drop 1 exit } if dup s" :rcx" stringcmp 0 = { drop 1 exit } if dup s" :rdx" stringcmp 0 = { drop 1 exit } if dup s" :rbx" stringcmp 0 = { drop 1 exit } if dup s" :rsp" stringcmp 0 = { drop 1 exit } if dup s" :rbp" stringcmp 0 = { drop 1 exit } if dup s" :rsi" stringcmp 0 = { drop 1 exit } if dup s" :rdi" stringcmp 0 = { drop 1 exit } if dup s" :r8" stringcmp 0 = { drop 1 exit } if dup s" :r9" stringcmp 0 = { drop 1 exit } if dup s" :r10" stringcmp 0 = { drop 1 exit } if dup s" :r11" stringcmp 0 = { drop 1 exit } if dup s" :r12" stringcmp 0 = { drop 1 exit } if dup s" :r13" stringcmp 0 = { drop 1 exit } if dup s" :r14" stringcmp 0 = { drop 1 exit } if dup s" :r15" stringcmp 0 = { drop 1 exit } if dup s" :eax" stringcmp 0 = { drop 1 exit } if dup s" :ecx" stringcmp 0 = { drop 1 exit } if dup s" :edx" stringcmp 0 = { drop 1 exit } if dup s" :ebx" stringcmp 0 = { drop 1 exit } if dup s" :esp" stringcmp 0 = { drop 1 exit } if dup s" :ebp" stringcmp 0 = { drop 1 exit } if dup s" :esi" stringcmp 0 = { drop 1 exit } if dup s" :edi" stringcmp 0 = { drop 1 exit } if dup s" :ax" stringcmp 0 = { drop 1 exit } if dup s" :cx" stringcmp 0 = { drop 1 exit } if dup s" :dx" stringcmp 0 = { drop 1 exit } if dup s" :bx" stringcmp 0 = { drop 1 exit } if dup s" :sp" stringcmp 0 = { drop 1 exit } if dup s" :bp" stringcmp 0 = { drop 1 exit } if dup s" :si" stringcmp 0 = { drop 1 exit } if dup s" :di" stringcmp 0 = { drop 1 exit } if dup s" :al" stringcmp 0 = { drop 1 exit } if dup s" :cl" stringcmp 0 = { drop 1 exit } if dup s" :dl" stringcmp 0 = { drop 1 exit } if dup s" :bl" stringcmp 0 = { drop 1 exit } if dup s" :ah" stringcmp 0 = { drop 1 exit } if dup s" :ch" stringcmp 0 = { drop 1 exit } if dup s" :dh" stringcmp 0 = { drop 1 exit } if dup s" :bh" stringcmp 0 = { drop 1 exit } if dup s" :cc-overflow" stringcmp 0 = { drop 1 exit } if dup s" :cc-no-overflow" stringcmp 0 = { drop 1 exit } if dup s" :cc-below" stringcmp 0 = { drop 1 exit } if dup s" :cc-above-equal" stringcmp 0 = { drop 1 exit } if dup s" :cc-equal" stringcmp 0 = { drop 1 exit } if dup s" :cc-not-equal" stringcmp 0 = { drop 1 exit } if dup s" :cc-below-equal" stringcmp 0 = { drop 1 exit } if dup s" :cc-above" stringcmp 0 = { drop 1 exit } if dup s" :cc-sign" stringcmp 0 = { drop 1 exit } if dup s" :cc-not-sign" stringcmp 0 = { drop 1 exit } if dup s" :cc-even" stringcmp 0 = { drop 1 exit } if dup s" :cc-odd" stringcmp 0 = { drop 1 exit } if dup s" :cc-less" stringcmp 0 = { drop 1 exit } if dup s" :cc-greater-equal" stringcmp 0 = { drop 1 exit } if dup s" :cc-less-equal" stringcmp 0 = { drop 1 exit } if dup s" :cc-greater" stringcmp 0 = { drop 1 exit } if dup s" reg64" stringcmp 0 = { drop 0 exit } if dup s" extrareg64" stringcmp 0 = { drop 0 exit } if dup s" reg32" stringcmp 0 = { drop 0 exit } if dup s" reg16" stringcmp 0 = { drop 0 exit } if dup s" reg8" stringcmp 0 = { drop 0 exit } if dup s" scalefield" stringcmp 0 = { drop 0 exit } if dup s" condition-code" stringcmp 0 = { drop 0 exit } if dup s" rex-0" stringcmp 0 = { drop 0 exit } if dup s" rex-w" stringcmp 0 = { drop 0 exit } if dup s" rex-r" stringcmp 0 = { drop 0 exit } if dup s" rex-x" stringcmp 0 = { drop 0 exit } if dup s" rex-b" stringcmp 0 = { drop 0 exit } if dup s" rex-wr" stringcmp 0 = { drop 0 exit } if dup s" rex-wx" stringcmp 0 = { drop 0 exit } if dup s" rex-wb" stringcmp 0 = { drop 0 exit } if dup s" rex-rx" stringcmp 0 = { drop 0 exit } if dup s" rex-rb" stringcmp 0 = { drop 0 exit } if dup s" rex-xb" stringcmp 0 = { drop 0 exit } if dup s" rex-wrx" stringcmp 0 = { drop 0 exit } if dup s" rex-wrb" stringcmp 0 = { drop 0 exit } if dup s" rex-wxb" stringcmp 0 = { drop 0 exit } if dup s" rex-rxb" stringcmp 0 = { drop 0 exit } if dup s" rex-wrxb" stringcmp 0 = { drop 0 exit } if dup s" opcodereg" stringcmp 0 = { drop -2 exit } if dup s" opcodecc" stringcmp 0 = { drop -2 exit } if dup s" modrm" stringcmp 0 = { drop -3 exit } if dup s" sib" stringcmp 0 = { drop -3 exit } if dup s" addressing-reg64" stringcmp 0 = { drop -2 exit } if dup s" addressing-reg8" stringcmp 0 = { drop -2 exit } if dup s" addressing-indirect-reg64" stringcmp 0 = { drop -2 exit } if dup s" addressing-disp8-reg64" stringcmp 0 = { drop -3 exit } if dup s" addressing-disp32-reg64" stringcmp 0 = { drop -3 exit } if dup s" addressing-indexed-reg64" stringcmp 0 = { drop -4 exit } if dup s" addressing-disp8-indexed-reg64" stringcmp 0 = { drop -5 exit } if dup s" cld" stringcmp 0 = { drop 0 exit } if dup s" std" stringcmp 0 = { drop 0 exit } if dup s" syscall" stringcmp 0 = { drop 0 exit } if dup s" hlt" stringcmp 0 = { drop 0 exit } if dup s" push-reg64" stringcmp 0 = { drop -1 exit } if dup s" push-extrareg64" stringcmp 0 = { drop -1 exit } if dup s" pop-reg64" stringcmp 0 = { drop -1 exit } if dup s" pop-extrareg64" stringcmp 0 = { drop -1 exit } if dup s" push-imm32-extended64" stringcmp 0 = { drop -1 exit } if dup s" lea-reg64-disp8-reg64" stringcmp 0 = { drop -3 exit } if dup s" lea-reg64-disp32-reg64" stringcmp 0 = { drop -3 exit } if dup s" lea-reg64-indexed-reg64" stringcmp 0 = { drop -4 exit } if dup s" lea-reg64-disp8-indexed-reg64" stringcmp 0 = { drop -5 exit } if dup s" mov-reg64-imm32" stringcmp 0 = { drop -2 exit } if dup s" mov-reg64-imm64" stringcmp 0 = { drop -2 exit } if dup s" mov-extrareg64-imm64" stringcmp 0 = { drop -2 exit } if dup s" mov-reg64-reg64" stringcmp 0 = { drop -2 exit } if dup s" mov-indirect-reg64-reg64" stringcmp 0 = { drop -2 exit } if dup s" mov-disp8-reg64-reg64" stringcmp 0 = { drop -3 exit } if dup s" mov-reg64-indirect-reg64" stringcmp 0 = { drop -2 exit } if dup s" mov-reg64-disp8-reg64" stringcmp 0 = { drop -3 exit } if dup s" mov-reg64-disp32-reg64" stringcmp 0 = { drop -3 exit } if dup s" mov-reg64-indexed-reg64" stringcmp 0 = { drop -4 exit } if dup s" mov-indexed-reg64-reg64" stringcmp 0 = { drop -4 exit } if dup s" mov-indirect-reg64-reg32" stringcmp 0 = { drop -2 exit } if dup s" mov-disp8-reg64-reg32" stringcmp 0 = { drop -3 exit } if dup s" mov-reg32-indirect-reg64" stringcmp 0 = { drop -2 exit } if dup s" mov-reg32-disp8-reg64" stringcmp 0 = { drop -3 exit } if dup s" mov-indirect-reg64-reg16" stringcmp 0 = { drop -2 exit } if dup s" mov-disp8-reg64-reg16" stringcmp 0 = { drop -3 exit } if dup s" mov-reg16-indirect-reg64" stringcmp 0 = { drop -2 exit } if dup s" mov-reg16-disp8-reg64" stringcmp 0 = { drop -3 exit } if dup s" mov-indirect-reg64-reg8" stringcmp 0 = { drop -2 exit } if dup s" mov-disp8-reg64-reg8" stringcmp 0 = { drop -3 exit } if dup s" mov-reg8-indirect-reg64" stringcmp 0 = { drop -2 exit } if dup s" mov-reg8-disp8-reg64" stringcmp 0 = { drop -3 exit } if dup s" mov-reg8-reg8" stringcmp 0 = { drop -2 exit } if dup s" movs8" stringcmp 0 = { drop 0 exit } if dup s" movs16" stringcmp 0 = { drop 0 exit } if dup s" movs32" stringcmp 0 = { drop 0 exit } if dup s" movs64" stringcmp 0 = { drop 0 exit } if dup s" rep-movs8" stringcmp 0 = { drop 0 exit } if dup s" rep-movs16" stringcmp 0 = { drop 0 exit } if dup s" rep-movs32" stringcmp 0 = { drop 0 exit } if dup s" rep-movs64" stringcmp 0 = { drop 0 exit } if dup s" lods8" stringcmp 0 = { drop 0 exit } if dup s" lods16" stringcmp 0 = { drop 0 exit } if dup s" lods32" stringcmp 0 = { drop 0 exit } if dup s" lods64" stringcmp 0 = { drop 0 exit } if dup s" rep-lods8" stringcmp 0 = { drop 0 exit } if dup s" rep-lods16" stringcmp 0 = { drop 0 exit } if dup s" rep-lods32" stringcmp 0 = { drop 0 exit } if dup s" rep-lods64" stringcmp 0 = { drop 0 exit } if dup s" stos8" stringcmp 0 = { drop 0 exit } if dup s" stos16" stringcmp 0 = { drop 0 exit } if dup s" stos32" stringcmp 0 = { drop 0 exit } if dup s" stos64" stringcmp 0 = { drop 0 exit } if dup s" rep-stos8" stringcmp 0 = { drop 0 exit } if dup s" rep-stos16" stringcmp 0 = { drop 0 exit } if dup s" rep-stos32" stringcmp 0 = { drop 0 exit } if dup s" rep-stos64" stringcmp 0 = { drop 0 exit } if dup s" cmps8" stringcmp 0 = { drop 0 exit } if dup s" cmps16" stringcmp 0 = { drop 0 exit } if dup s" cmps32" stringcmp 0 = { drop 0 exit } if dup s" cmps64" stringcmp 0 = { drop 0 exit } if dup s" repz-cmps8" stringcmp 0 = { drop 0 exit } if dup s" repz-cmps16" stringcmp 0 = { drop 0 exit } if dup s" repz-cmps32" stringcmp 0 = { drop 0 exit } if dup s" repz-cmps64" stringcmp 0 = { drop 0 exit } if dup s" repnz-cmps8" stringcmp 0 = { drop 0 exit } if dup s" repnz-cmps16" stringcmp 0 = { drop 0 exit } if dup s" repnz-cmps32" stringcmp 0 = { drop 0 exit } if dup s" repnz-cmps64" stringcmp 0 = { drop 0 exit } if dup s" scas8" stringcmp 0 = { drop 0 exit } if dup s" scas16" stringcmp 0 = { drop 0 exit } if dup s" scas32" stringcmp 0 = { drop 0 exit } if dup s" scas64" stringcmp 0 = { drop 0 exit } if dup s" repz-scas8" stringcmp 0 = { drop 0 exit } if dup s" repz-scas16" stringcmp 0 = { drop 0 exit } if dup s" repz-scas32" stringcmp 0 = { drop 0 exit } if dup s" repz-scas64" stringcmp 0 = { drop 0 exit } if dup s" repnz-scas8" stringcmp 0 = { drop 0 exit } if dup s" repnz-scas16" stringcmp 0 = { drop 0 exit } if dup s" repnz-scas32" stringcmp 0 = { drop 0 exit } if dup s" repnz-scas64" stringcmp 0 = { drop 0 exit } if dup s" add-reg64-reg64" stringcmp 0 = { drop -2 exit } if dup s" add-indirect-reg64-reg64" stringcmp 0 = { drop -2 exit } if dup s" add-reg64-indirect-reg64" stringcmp 0 = { drop -2 exit } if dup s" add-reg64-imm8" stringcmp 0 = { drop -2 exit } if dup s" sub-reg64-reg64" stringcmp 0 = { drop -2 exit } if dup s" sub-indirect-reg64-reg64" stringcmp 0 = { drop -2 exit } if dup s" sub-reg64-imm8" stringcmp 0 = { drop -2 exit } if dup s" sbb-reg64-imm8" stringcmp 0 = { drop -2 exit } if dup s" mul-reg64" stringcmp 0 = { drop -1 exit } if dup s" divmod-reg64" stringcmp 0 = { drop -1 exit } if dup s" idivmod-reg64" stringcmp 0 = { drop -1 exit } if dup s" inc-reg64" stringcmp 0 = { drop -1 exit } if dup s" dec-reg64" stringcmp 0 = { drop -1 exit } if dup s" and-reg64-reg64" stringcmp 0 = { drop -2 exit } if dup s" and-reg64-imm8" stringcmp 0 = { drop -2 exit } if dup s" or-reg64-reg64" stringcmp 0 = { drop -2 exit } if dup s" or-reg64-imm8" stringcmp 0 = { drop -2 exit } if dup s" xor-reg64-reg64" stringcmp 0 = { drop -2 exit } if dup s" not-reg64" stringcmp 0 = { drop -1 exit } if dup s" cmp-reg64-reg64" stringcmp 0 = { drop -2 exit } if dup s" test-reg64-reg64" stringcmp 0 = { drop -2 exit } if dup s" set-reg8-cc" stringcmp 0 = { drop -2 exit } if dup s" jmp-cc-rel-imm8" stringcmp 0 = { drop -2 exit } if dup s" jmp-cc-rel-imm32" stringcmp 0 = { drop -2 exit } if dup s" jmp-abs-indirect-reg64" stringcmp 0 = { drop -1 exit } if dup s" jmp-rel-imm8" stringcmp 0 = { drop -1 exit } if dup s" jmp-rel-imm32" stringcmp 0 = { drop -1 exit } if ~ From execution-support.e. dup s" pack-next" stringcmp 0 = { drop 0 exit } if dup s" pack-beforenext" stringcmp 0 = { drop -1 exit } if dup s" pack-pushcontrol" stringcmp 0 = { drop -1 exit } if dup s" pack-popcontrol" stringcmp 0 = { drop -1 exit } if ~ From dynamic.e. dup s" stack" stringcmp 0 = { drop 0 exit } if dup s" stackhex" stringcmp 0 = { drop 0 exit } if dup s" is-in-log" stringcmp 0 = { drop 0 exit } if dup s" oldest-entry" stringcmp 0 = { drop 1 exit } if dup s" next-newer-entry" stringcmp 0 = { drop 0 exit } if dup s" guess-entry-end" stringcmp 0 = { drop 0 exit } if dup s" containing-entry" stringcmp 0 = { drop 0 exit } if dup s" is-assembly-word" stringcmp 0 = { drop 0 exit } if dup s" is-docol-itself" stringcmp 0 = { drop 0 exit } if dup s" is-docol-codeword" stringcmp 0 = { drop 0 exit } if dup s" is-docol-interpreted-word" stringcmp 0 = { drop 0 exit } if dup s" is-codeword-pointer" stringcmp 0 = { drop 0 exit } if dup s" indent" stringcmp 0 = { drop -1 exit } if dup s" word-heading" stringcmp 0 = { drop -1 exit } if dup s" list-dictionary" stringcmp 0 = { drop 0 exit } if dup s" hexdump-row" stringcmp 0 = { drop -3 exit } if dup s" hexdump-between" stringcmp 0 = { drop -2 exit } if dup s" hexdump-from" stringcmp 0 = { drop -2 exit } if dup s" hexdump" stringcmp 0 = { drop -1 exit } if dup s" describe-hex" stringcmp 0 = { drop -1 exit } if dup s" describe-docol" stringcmp 0 = { drop -1 exit } if dup s" describe" stringcmp 0 = { drop -1 exit } if dup s" describe-all" stringcmp 0 = { drop 0 exit } if dup s" describe-compilation" stringcmp 0 = { drop 0 exit } if dup s" symbolize-pointer" stringcmp 0 = { drop -1 exit } if dup s" list-callers" stringcmp 0 = { drop 0 exit } if dup s" forget" stringcmp 0 = { drop -1 exit } if dup s" ," stringcmp 0 = { drop -1 exit } if dup s" make-immediate" stringcmp 0 = { drop 0 exit } if dup s" make-hidden" stringcmp 0 = { drop 0 exit } if dup s" make-visible" stringcmp 0 = { drop 0 exit } if dup s" recurse" stringcmp 0 = { drop 0 exit } if dup s" recurse" stringcmp 0 = { drop 0 exit } if dup s" find" stringcmp 0 = { drop 0 exit } if dup s" allocate" stringcmp 0 = { drop 0 exit } if dup s" create" stringcmp 0 = { drop -1 exit } if dup s" self-codeword" stringcmp 0 = { drop 0 exit } if dup s" variable" stringcmp 0 = { drop -2 exit } if dup s" keyword" stringcmp 0 = { drop -1 exit } if dup s" literal" stringcmp 0 = { drop -1 exit } if ~ From input.e. dup s" buffer-physical-start" stringcmp 0 = { drop 0 exit } if dup s" buffer-physical-length" stringcmp 0 = { drop 0 exit } if dup s" buffer-logical-start" stringcmp 0 = { drop 0 exit } if dup s" buffer-logical-length" stringcmp 0 = { drop 0 exit } if dup s" input-buffer-refill" stringcmp 0 = { drop 0 exit } if dup s" input-buffer-next-source" stringcmp 0 = { drop 0 exit } if dup s" clear-buffer" stringcmp 0 = { drop -1 exit } if dup s" zero-input-buffer-metadata" stringcmp 0 = { drop -1 exit } if dup s" allocate-input-buffer-metadata" stringcmp 0 = { drop 1 exit } if dup s" allocate-input-buffer" stringcmp 0 = { drop 0 exit } if dup s" attach-string-to-input-buffer" stringcmp 0 = { drop -2 exit } if dup s" consume-from" stringcmp 0 = { drop -1 exit } if dup s" peek-from" stringcmp 0 = { drop 0 exit } if dup s" key-from" stringcmp 0 = { drop 0 exit } if dup s" normalize-buffer" stringcmp 0 = { drop -1 exit } if dup s" compute-next-buffer-free-block" stringcmp 0 = { drop 1 exit } if dup s" refill-input-buffer-from-stdin" stringcmp 0 = { drop -1 exit } if dup s" main-input-buffer" stringcmp 0 = { drop 1 exit } if dup s" consume" stringcmp 0 = { drop 0 exit } if dup s" peek" stringcmp 0 = { drop 1 exit } if dup s" key" stringcmp 0 = { drop 1 exit } if ~ From interpret.e. dup s" unroll-past-string" stringcmp 0 = { drop 0 exit } if dup s" swap-past-string" stringcmp 0 = { drop 0 exit } if ~ The following are deliberate omissions: dropstring, ~ dropstring-with-result, accumulate-string. dup s" is-space" stringcmp 0 = { drop 0 exit } if dup s" is-alphanumeric" stringcmp 0 = { drop 0 exit } if ~ The following is a deliberate omission: word. dup s" generalized-digit-value" stringcmp 0 = { drop 0 exit } if ~ The following are deliberate omissions: decode-generalized-digit, ~ read-base-unsigned, read-integer-unsigned, read-integer, read-decimal. dup s" interpreter-flags" stringcmp 0 = { drop 1 exit } if dup s" [" stringcmp 0 = { drop 0 exit } if dup s" ]" stringcmp 0 = { drop 0 exit } if dup s" :" stringcmp 0 = { drop 0 exit } if dup s" ;" stringcmp 0 = { drop 0 exit } if dup s" ;asm" stringcmp 0 = { drop 0 exit } if dup s" '" stringcmp 0 = { drop 1 exit } if dup s" relink-main-input-buffer-to-stdin" stringcmp 0 = { drop 0 exit } if ~ The following is a deliberate omission: interpret. dup s" quit" stringcmp 0 = { drop 0 exit } if ~ From linux-dynamic.e. dup s" allocate-timespec" stringcmp 0 = { drop 1 exit } if dup s" timespec-seconds" stringcmp 0 = { drop 0 exit } if dup s" timespec-nanoseconds" stringcmp 0 = { drop 0 exit } if dup s" nanosleep" stringcmp 0 = { drop 0 exit } if dup s" sys-sigaction" stringcmp 0 = { drop -2 exit } if dup s" sys-sigaltstack" stringcmp 0 = { drop -1 exit } if dup s" allocate-sigaction" stringcmp 0 = { drop 1 exit } if dup s" sigaction-action" stringcmp 0 = { drop 0 exit } if dup s" sigaction-flags" stringcmp 0 = { drop 0 exit } if dup s" sigaction-restorer" stringcmp 0 = { drop 0 exit } if dup s" sigaction-mask" stringcmp 0 = { drop 0 exit } if dup s" allocate-sigaltstack" stringcmp 0 = { drop 1 exit } if dup s" sigaltstack-pointer" stringcmp 0 = { drop 0 exit } if dup s" sigaltstack-flags" stringcmp 0 = { drop 0 exit } if dup s" sigaltstack-size" stringcmp 0 = { drop 0 exit } if dup s" prepare-signal-stack" stringcmp 0 = { drop 0 exit } if ~ The following is a deliberate omission: signal-return-trampoline. dup s" wrap-signal-handler" stringcmp 0 = { drop 0 exit } if dup s" bind-signal" stringcmp 0 = { drop -2 exit } if ~ The following is a deliberate omission: handle-crash. dup s" install-crash-handler" stringcmp 0 = { drop 0 exit } if ~ Created by warm-start in execution.e. dup s" log" stringcmp 0 = { drop 1 exit } if dup s" s0" stringcmp 0 = { drop 1 exit } if dup s" r0" stringcmp 0 = { drop 1 exit } if dup s" latest" stringcmp 0 = { drop 1 exit } if dup s" here" stringcmp 0 = { drop 1 exit } if ~ Word not provided statically, but used during the log-load routine anyway. dup s" L@'" stringcmp 0 = { drop 1 exit } if dup s" L!'" stringcmp 0 = { drop -1 exit } if dup s" labels" stringcmp 0 = { drop 1 exit } if dup s" allocate-transformation-state" stringcmp 0 = { drop 1 exit } if ~ If we get here, that's a problem. Emit an error message to make sure ~ it's easy to diagnose. We also return a comically large negative value, ~ to make sure things fail as quickly as possible afterwards. ." No known stack delta: " emitstring newline -256 ; ~ (delta --) : transform-apply-stack-delta transformation-state transformation-state-user-stack-depth @ + transformation-state transformation-state-user-stack-depth ! ; ~ Label transform implementation ~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~ ~ The following code is all part of implementing the label transform. For ~ conceptual overview, see the top of this file. ~ This is the alternate version of "create" for use with the label ~ transform. Its code is the same as the regular "create" except as noted ~ below. It is likely to be extremely useful to read and understand "create" ~ in dynamic.e before attempting to understand label-create-alternate. : label-create-alternate ~ : blank-line ~ : blank-line ~ : provide-string-copy ~ : # is defined here via the label transform; this is its entry header. ~ : indent dup stringlen 1 + dup 3unroll here @ 10 + swap memmove here @ ~ This value of "latest" is going into the generated output, so we need ~ to map it to the target address space. It's stored in the host address ~ space to make immediate words work as expected, so the appropriate ~ conversion is host-address-space-to-target. latest @ host-address-space-to-target pack64 0 pack8 0 pack8 + 8 packalign here @ latest ! ~ Now we're immediately after the word header, which is where the codeword ~ will be. This is the value the label should taken on, so we set it. dup host-address-space-to-offset here @ 10 + swap-transform-variables intern-label set-label swap-transform-variables here ! ; ~ This is the alternate version of ":" for use with the label transform. Its ~ code is the same as the regular "create" except as noted below. It is likely ~ to be extremely useful to read and understand ":" in dynamic.e before ~ attempting to understand label-colon-alternate. : label-colon-alternate ~ This calls label-create-alternate instead of "create". word value@ label-create-alternate dropstring ~ This looks up "docol" by label. swap-transform-variables L@' docol-codeword-value L@' origin swap-transform-variables + , latest @ dup entry-flags@ 0x80 | swap entry-flags! ] ; ~ So, the way docol's user-facing entry is set up in core.e, it really wants ~ to reference "here" to create its codeword, but "here" is in the host ~ address space. We solve this by having it call the word "self-codeword" and ~ then patching around the address space issue with alternates. ~ ~ If we didn't have this fix, everything would appear to work fine but the ~ statically generated user-facing docol from the label transform would have ~ a wrong codeword, varying based on the host's memory usage. It's never ~ actually called by evoke itself (it would crash horribly), though it may ~ be from programs that use the facilities differently. It's a binary ~ reproducibility issue - our only known one, in fact - so it's worth fixing. : label-self-codeword-alternate here @ dup 8 + host-address-space-to-target pack64 here ! ; make-immediate ~ This is the alternate version of ";" for use with the label transform. Its ~ code is the same as the regular "create" except as noted below. It is likely ~ to be extremely useful to read and understand ";" in dynamic.e before ~ attempting to understand label-semicolon-alternate. : label-semicolon-alternate ~ This looks up "exit" by label. swap-transform-variables L@' exit swap-transform-variables offset-to-target-address-space , ~ : deindent latest @ dup entry-flags@ 0x80 invert & swap entry-flags! ~ Since [ is an immediate word, we have to go to extra trouble to compile ~ it as part of ;. [ ' [ entry-to-execution-token , ] ; make-immediate ~ This is the alternate version of ";asm" for use with the label transform. ~ Its code is the same as the regular "create" except as noted below. It is ~ likely to be extremely useful to read and understand ";asm" in dynamic.e ~ before attempting to understand label-semicolon-assembly-alternate. : label-semicolon-assembly-alternate here @ pack-next 8 packalign here ! ~ : deindent latest @ dup dup entry-flags@ 0x80 invert & swap entry-flags! entry-to-execution-token ~ The codeword needs to be transformed to the target address space. dup 8 + host-address-space-to-target swap ! ~ Since [ is an immediate word, we have to go to extra trouble to compile ~ it as part of ;asm. [ ' [ entry-to-execution-token , ] ; make-immediate ~ TODO there should really be an actual word that this alternate is replacing ~ ~ If it existed, that word would be (string pointer --). : label-keyword-alternate label-create-alternate here @ dup ~ (self execution token, output point) dup 8 + host-address-space-to-target pack64 swap host-address-space-to-target :rax mov-reg64-imm64 ~ (output point) :rax push-reg64 pack-next 8 packalign here ! ~ : deindent ; make-immediate ~ It's convenient to be able to work with strings in label-transformed ~ code. If we don't provide an alternate for it, we get codeword pointers in ~ the host address space, which therefore don't work. : label-string-alternate ~ Something subtle here: s" is state-dependent. That is, it does different ~ things depending on the interpreter flags. We would really rather know ~ which version we're getting, and also it would be best if it didn't ~ scribble on the output buffer. Fortunately we can achieve both of these, ~ by coercing things into a known state while calling it. ~ ~ We could choose either version of s", but the interpreted one is more ~ convenient because it doesn't mess with a spurious litstring invocation, ~ just scribbled into scratch space after "here". Of course, that raises the ~ additional concern that we have the wrong "here", but we can just swap ~ that around, too. ~ ~ This is all worth it to avoid reimplementing s". If we had two ~ implementations, they'd have to be kept in sync, and it's an important ~ user-facing word with semantics that are likely to improve over time. interpreter-flags @ ' s" entry-to-execution-token swap-transform-variables ~ Since [ is an immediate word, we have to go to extra trouble to compile ~ it as part of the alternate. [ ' [ entry-to-execution-token , ] execute swap-transform-variables swap interpreter-flags ! ~ Whew. What a mouthful. ~ ~ Having done this, we have the string pointer on the stack at transform ~ time, which with the label transform is the same as immediate time. If ~ we're in immediate mode, therefore, we've left the string on the stack and ~ that's all we wanted. If we're in compile mode, it's our job to output a ~ litstring invocation. interpreter-flags @ 0x01 & { swap-transform-variables L@' litstring swap-transform-variables offset-to-target-address-space , ~ litstring here @ swap packstring 8 packalign here ! } if ; make-immediate : label-dot-string-alternate ' label-string-alternate entry-to-execution-token execute interpreter-flags @ 0x01 & { swap-transform-variables L@' emitstring swap-transform-variables offset-to-target-address-space , ~ emitstring } { emitstring } if-else ; make-immediate ~ Because docol requires it, we provide a special mini-version of the label ~ system. We only do L@' and L!', because that's all we need. These are real ~ labels; there can be arbitrarily many of them, and they can have forward ~ references. ~ ~ The value that's accepted is in the host address space; the label is set ~ to an offset; and the value that's returned is in the target address space. ~ ~ (-- value) : label-L@'-alternate word value@ swap-transform-variables intern-label use-label swap-transform-variables dropstring-with-result offset-to-target-address-space ; make-immediate ~ (value --) : label-L!'-alternate host-address-space-to-offset word value@ swap-transform-variables intern-label swap-transform-variables dropstring-with-result swap-transform-variables set-label swap-transform-variables ; make-immediate ~ We implement alternates of all the high-level flow-control words for the ~ label transform: if, unless, if-else, forever, and while. We leave { and } ~ as their usual implementations. The values { and } leave on the stack will ~ be in the host address space, which is convenient anyway. Those values don't ~ make their way into the output, since everything is relative, and the ~ relative offsets are correct regardless. What we do need to change, though, ~ is the addresses of branch and 0branch. We need to resolve these via label. ~ ~ (start pointer, length --) : label-if-alternate 2dup swap dup 5 8 * + 3roll ~ (start pointer, length, adjusted start pointer, start pointer, length) memmove ~ (start pointer, length) swap here @ swap here ! swap ~ (old here, length) swap-transform-variables L@' 0branch L@' != L@' lit swap-transform-variables offset-to-target-address-space , 0 , ~ lit offset-to-target-address-space , ~ != ~ The branch length needs to be one word longer than the block length, ~ because the length field itself is part of the scope of the branch. offset-to-target-address-space , dup 8 + , ~ 0branch ~ (old here, length) drop 5 8 * + here ! ; make-immediate ~ (start pointer, length) : label-unless-alternate 2dup swap dup 5 8 * + 3roll ~ (start pointer, length, adjusted start pointer, start pointer, length) memmove ~ (start pointer, length) swap here @ swap here ! swap ~ (old here, length) swap-transform-variables L@' 0branch L@' = L@' lit swap-transform-variables offset-to-target-address-space , 0 , ~ lit offset-to-target-address-space , ~ = ~ The branch length needs to be one word longer than the block length, ~ because the length field itself is part of the scope of the branch. offset-to-target-address-space , dup 8 + , ~ 0branch ~ (old here, length) drop 5 8 * + here ! ; make-immediate ~ (true start, true length, false start, false length) : label-if-else-alternate ~ First we slide the false-block forward, then the true-block. We slide ~ them both directly into their final positions, leaving space at the start ~ for a test and branch, and space in between for an unconditional branch. ~ Those spaces will take five words, and two words, respectively. So the ~ false-block gets moved by seven words, and the true-block gets moved by ~ five words. 2dup swap dup 7 8 * + 3roll memmove 3 pick dup 5 8 * + 4 pick memmove ~ (true start, true length, false start, false length) ~ Now we write out the initial test-and-branch. 4 roll dup 5 unroll here @ 6 unroll here ! ~ (old here, true start, true length, false start, false length) swap-transform-variables L@' 0branch L@' != L@' lit swap-transform-variables offset-to-target-address-space , 0 , ~ lit offset-to-target-address-space , ~ != ~ Branch past the length field, the true-block, and the unconditional ~ branch in the middle. offset-to-target-address-space , ~ 0branch 3roll dup 4 unroll 3 8 * + , ~ Next, write out the unconditional branch in the middle. swap dup 3unroll 5 8 * + here ! swap-transform-variables L@' branch swap-transform-variables offset-to-target-address-space , ~ branch ~ Branch past the length field and the false-block. dup 8 + , ~ Set "here" to point to the true end. drop drop drop drop 7 8 * + here ! ; make-immediate ~ (start, length --) : label-forever-alternate swap-transform-variables L@' branch swap-transform-variables offset-to-target-address-space , ~ branch 8 + -1 * , drop ; make-immediate ~ (test start, test length, body start, body length --) : label-while-alternate ~ The conditional branch needs five words. 2dup swap dup 5 8 * + 3roll memmove here @ 5 unroll swap dup 3unroll here ! ~ (old here, test start, test length, body start, body length) swap-transform-variables L@' 0branch L@' != L@' lit swap-transform-variables offset-to-target-address-space , 0 , ~ lit offset-to-target-address-space , ~ != ~ Branch past the length field, the body, and the unconditional branch. offset-to-target-address-space , ~ 0branch dup 3 8 * + , ~ Set "here" to the new end. 5 8 * 6 roll + here ! ~ (test start, test length, body start, body length) ~ Unconditionally branch backwards past the branch word, the body, the ~ conditional branch, and the test. swap-transform-variables L@' branch swap-transform-variables offset-to-target-address-space , 6 8 * + swap drop + swap drop -1 * , ; make-immediate ~ This implements the label transform for a single word. It is directly ~ analogous to "interpret", and reading dynamic.e may help in understanding ~ it, though it's meant to still make sense on its own. ~ ~ It expects to be called from "label-transform", below, which loops. ~ ~ (-- done) : label-transform-one word ~ If no word was returned, exit. dup 0 = { drop 0 exit } if ~ The string is on the top of the stack, so to get a pointer to it we get ~ the stack address. ~ (string) value@ ~ If it's the magic word, end the transformation. dup transformation-state transformation-state-delimiter @ stringcmp 0 = { drop dropstring 1 exit } if ~ Check whether it's one of the words we have alternates for, and look up ~ the alternate if so. dup 0 swap ~ (name as stack string, name pointer, placeholder, name pointer) dup s" create" stringcmp 0 = { swap drop ' label-create-alternate swap } if dup s" :" stringcmp 0 = { swap drop ' label-colon-alternate swap } if dup s" self-codeword" stringcmp 0 = { swap drop ' label-self-codeword-alternate swap } if dup s" ;" stringcmp 0 = { swap drop ' label-semicolon-alternate swap } if dup s" ;asm" stringcmp 0 = { swap drop ' label-semicolon-assembly-alternate swap } if ~ It is nontrivial to construct a string with a double-quote in it. dup ' s" entry-to-name stringcmp 0 = { swap drop ' label-string-alternate swap } if dup ' ." entry-to-name stringcmp 0 = { swap drop ' label-dot-string-alternate swap } if dup s" L@'" stringcmp 0 = { swap drop ' label-L@'-alternate swap } if dup s" L!'" stringcmp 0 = { swap drop ' label-L!'-alternate swap } if dup s" keyword" stringcmp 0 = { swap drop ' label-keyword-alternate swap } if dup s" if" stringcmp 0 = { swap drop ' label-if-alternate swap } if dup s" unless" stringcmp 0 = { swap drop ' label-unless-alternate swap } if dup s" if-else" stringcmp 0 = { swap drop ' label-if-else-alternate swap } if dup s" forever" stringcmp 0 = { swap drop ' label-forever-alternate swap } if dup s" while" stringcmp 0 = { swap drop ' label-while-alternate swap } if drop swap ~ (name as stack string, 0 or alternate entry pointer, name pointer) ~ If an alternate was found, the alternate will be used in immediate mode. ~ If not, we look up the word in the regular, non-transformed dictionary ~ and use that for immediate mode. over { dup transformation-state transformation-state-saved-latest @ swap find-in 3roll drop swap } unless ~ (name as stack string, immediate entry pointer, name pointer) ~ In regular "interpret", we would check whether we found the word before ~ checking the mode. However, we have three different places words could ~ come from, so that's not a simple notion. So, we check the mode first. interpreter-flags @ 0x01 & { ~ If we're in compile mode, there's still a chance it's an immediate ~ word. First check whether we have an immediate entry, then if so, check ~ that entry's flags. Notice that this means the generated code can't ~ override an immediate word with a non-immediate word of the same name. over dup { entry-flags@ 0x01 & not } { not } if-else { ~ Either there was no immediate entry, or the immediate entry wasn't ~ flagged as an immediate word. So we check whether this could be a ~ compilation. ~ ~ To do this, we need to look the word up in the output buffer. We ~ can't easily traverse the next-entry pointers in the output buffer's ~ dictionary, so we check the label. Since we don't know the word's name ~ statically, this is a rare scenario where we can't use the abbreviated ~ label syntax, but that's easy enough. ~ ~ Even though we've ruled out the possibility that the word is only ~ ever used immediately, it is still possible that there's some reason ~ the word doesn't exist. In particular, it could be an integer literal. ~ If we were to call use-label first, that would count as a requirement ~ that the label must eventually be set. We don't want to require that ~ quite yet, so we call find-label. ~ ~ This check is the means by which forward references are disallowed: ~ On the very first pass, a forward-referenced label won't exist yet, so ~ transform will give a "no such word" error, which in an ideal world ~ would prevent there from being a subsequent pass, but at the very ~ least it will ensure the output isn't a valid ELF. dup swap-transform-variables find-label swap-transform-variables { ~ It exists, so we declare our use of it (that's also the only way to ~ get a value for it). swap-transform-variables intern-label use-label swap-transform-variables ~ Labels point to codewords (because that's what ~ label-create-alternate does), which is already what we want to ~ output. ~ ~ An important caveat: Though it would require something weird to be ~ happening, such as a forced forward reference, the label may be ~ zero! We need to allow for that possibility by not examining the ~ contents of a nonexistent entry. ~ ~ Fortunately we don't have to look at it, just append it to the log ~ and clean up. offset-to-target-address-space , drop dropstring 0 exit } if ~ If we got here, we're in compile mode, no label was found, and even ~ if there was a candidate for an immediate word it wasn't flagged as ~ immediate. There are two possibilities: It's genuinely missing, or it's ~ an integer literal. We decline to run the candidate immediate entry, ~ even if it exists, because that's not the correct semantics. ~ ~ If the word is genuinely missing, we want to make sure we make it ~ all the way to the not-found error-handling code at the end, because ~ that will be way easier to debug than doing the wrong thing will. Way, ~ way easier. Far less staring at numbers. ~ ~ Anyway, we no longer need the immediate entry pointer, so we drop ~ it. drop drop } { ~ If we get here, we're in compile mode, but there was a candidate ~ entry for an immediate word, and it was indeed flagged as immediate. ~ So, we run it and exit. drop dropstring-with-result entry-to-execution-token execute 0 exit } if-else ~ This is the end of the compile-mode branch. As you can see by tracing ~ through all the above cases, if we got here, the two possibilities are ~ that the word is genuinely missing, or it's an integer literal. ~ ~ Please notice that these are the same two possibilities remaining at ~ the end of the immediate-mode branch, below. } { ~ If we got here, we're in interpret mode. There are three ~ possibilities: there's an immediate word which we should run; it's an ~ integer literal; or the word is genuinely missing. ~ ~ If the immediate entry pointer is non-zero, run it and exit. over { drop dropstring-with-result entry-to-execution-token execute 0 exit } if ~ There was no immediate word, so either it's an integer literal or ~ the word is genuinely missing. Please notice that these are the same two ~ possibilities remaining at the end of the compile-mode branch, above. ~ ~ We no longer need the immediate-mode pointer, so drop it. drop drop } if-else ~ (name as stack string) ~ If we got here, one of two things is true: the word is an integer ~ literal, or it's genuinely missing. We know this because both the mode ~ cases above end with these as the only two remaining possibilities. So ~ ~ Check whether it's an integer literal. As before, we get the stack ~ address and use it as a string pointer. value@ read-integer 0 = { ~ It's a number. interpreter-flags @ 0x01 & { ~ We're in compile mode; append first "lit", then the number, to the ~ log. The version of "lit" we use is found by label, so it'll be the ~ one that exists when this code is ultimately run. dropstring-with-result ~ We look up "lit" as a label. swap-transform-variables L@' lit swap-transform-variables offset-to-target-address-space , , 0 exit } if ~ We're in interpret mode; push the number to the stack. Or at least, that's ~ what the code we're interpreting will see. Really it's already on the ~ stack, just clean everything else up and leave it there. dropstring-with-result 0 exit } if ~ If it's neither in the dictionary nor a number, just print an error. ~ ~ It's really important, when maintaining this code, to make sure that all ~ the possible ways the word can fail to exist, end up here. Doing anything ~ else is going to result in many hours of trying to untangle the ~ consequences of incorrect behavior, after-the-fact. s" No such word: " emitstring value@ emitstring newline dropstring 0 ; ~ This implements the label transform for all words in a region given as an ~ input string. It is directly analogous to "quit", in interpet.e, but is far ~ more complex. ~ ~ (output buffer start, output point, input string pointer, delimiter pointer ~ -- output buffer start, output point) : label-transform ~ : blank-line ~ : blank-line ~ : ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ : ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ : ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ : ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~ : blank-line ~ : This is the start of a long block of code which has been processed by ~ : the label transform, meaning it consists of ready-to-run Forth word ~ : definitions that reference each other by address, suitable for direct ~ : execution as soon as the cold-start routine has set up the basic ~ : registers, flags, and memory areas that form Evocation's internal ABI. ~ : ~ : Each word definition consists of a dictionary entry header, a ~ : codeword, and a word body. For words implemented as Forth code, the ~ : codeword points to the "docol" routine, and the word body is an array of ~ : pointers to the codewords of other words, occasionally interspersed with ~ : literal values. For words implemented as machine code, the codeword ~ : points to the start of the body, and the body is the machine code. ~ : ~ : All the word entry headers in this code link to each other, from last ~ : backwards to first, forming an Evocation dictionary. ~ : ~ : The warm-start routine relies on words defined by the label transform, ~ : as does the log-load routine. ~ : blank-line ~ : blank-line main-input-buffer dup push-input-buffer 3roll attach-string-to-input-buffer ~ Save the old values of "here" and "latest", and set the initial values ~ of the internal ones. These values need to persist across iterations, ~ since client code will make its own updates to them and then rely on those ~ updates having taken effect. So we do the swap just once, here outside the ~ loop, and set it back when the loop ends. here @ transformation-state transformation-state-saved-here ! latest @ transformation-state transformation-state-saved-latest ! 2 pick transformation-state transformation-state-output-buffer-start ! swap here ! 0 latest ! transformation-state transformation-state-delimiter ! ~ Now the stack has nothing of ours on it, so client code can do its thing. ~ 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. { label-transform-one ~ (done) ~ When the loop is done, get the real values of "here" and "latest" ~ back. The internal "here" is also the output point, and will become our ~ return value. The internal "latest" is discarded. { here @ transformation-state transformation-state-saved-here @ here ! transformation-state transformation-state-saved-latest @ latest ! ~ (output point) ~ Though we don't actually use transformation-state outside of this ~ invocation, for tidiness we zero it out. 0 transformation-state transformation-state-saved-here ! 0 transformation-state transformation-state-saved-latest ! 0 transformation-state transformation-state-output-buffer-start ! ~ Also put the input source back how it was. main-input-buffer pop-input-buffer exit } if } forever ; ~ Log-load transform implementation ~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~ ~ The following code is all part of implementing the log-load transform. ~ For conceptual overview, see the top of this file. ~ This outputs code that performs a roll of a given size, for use by the ~ words that rely on the tracked user stack depth. ~ ~ (amount to roll by --) : log-load-roll ~ A roll of size 1 is an nop, and a roll of size 0 crashes. dup 2 > { drop exit } if ~ A roll of size 2 is equivalent to a swap, and we compile it as one for ~ clarity when reading the hexdump. ~ ~ Yes, clarity when reading the hexdump. dup 2 = { drop swap-transform-variables L@' swap swap-transform-variables offset-to-target-address-space , ~ swap exit } if swap-transform-variables L@' roll L@' lit swap-transform-variables offset-to-target-address-space , ~ lit swap , offset-to-target-address-space , ~ roll ; ~ This outputs code that perfoms an unroll of a given size, for use by the ~ words that rely on the tracked user stack depth. ~ (amount to unroll by --) : log-load-unroll ~ An unroll of size 1 is an nop, and an unroll of size 0 crashes. dup 2 > { drop exit } if ~ Yes, clarity when reading the hexdump! What's so weird about that? :) dup 2 = { drop swap-transform-variables L@' swap swap-transform-variables offset-to-target-address-space , ~ swap exit } if swap-transform-variables L@' unroll L@' lit swap-transform-variables offset-to-target-address-space , ~ lit swap , offset-to-target-address-space , ~ unroll ; ~ This checks the tracked user stack depth and outputs an appropriate roll ~ to put the log address on top, as preparation for calling something that ~ relies on it. : log-load-roll-log-address transformation-state transformation-state-user-stack-depth @ ~ The amount we're rolling includes the log address, which is not a user ~ value, so we add 1. 1 + log-load-roll ; ~ This checks the tracked user stack depth and outputs an appropriate unroll ~ to put the log address back at the bottom, as cleanup after calling ~ something that relies on it. : log-load-unroll-log-address transformation-state transformation-state-user-stack-depth @ ~ The amount we're rolling includes the log address, which is not a user ~ value, so we add 1. 1 + log-load-unroll ; ~ This checks the tracked user stack depth and outputs an appropriate roll ~ to put the saved label value on top, as preparation for calling something ~ that consumes it. : log-load-roll-saved-label transformation-state transformation-state-user-stack-depth @ ~ The amount we're rolling includes both the log address and the label ~ value, neither of which are user values, so we add 2. 2 + log-load-roll ; ~ This checks the tracked user stack depth and outputs an appropriate unroll ~ to put a saved label value on the bottom, as a way of safely storing it away ~ when it's newly generated. : log-load-unroll-saved-label transformation-state transformation-state-user-stack-depth @ ~ The amount we're rolling includes both the log address and the label ~ value, neither of which are user values, so we add 2. 2 + log-load-unroll ; ~ (name pointer --) : log-load-compile-dynamic-word log-load-roll-log-address swap-transform-variables ~ Looking these up in reverse order saves us some stack juggling. Does it ~ help readability, or hurt it? Who can say... L@' log-load-comma L@' log-load-find-execution-token L@' litstring swap-transform-variables ~ (name pointer, log-load-comma, log-load-find-execution-token, litstring) ~ The overall stack delta of this sequence is 0. offset-to-target-address-space , ~ litstring 3roll here @ swap packstring 8 packalign here ! offset-to-target-address-space , ~ log-load-find-execution-token offset-to-target-address-space , ~ log-load-comma log-load-unroll-log-address ; ~ When we want the log-load routine to run a word that wasn't statically ~ compiled-in to the target executable, we output code that looks up the word ~ by name on the log, then calls it. ~ ~ We update the user stack depth as we go, to account for our internal ~ needs. The last thing our generated code does is execute the word we were ~ asked to, and we have no way of knowing what its stack delta will be, so ~ that final delta is our caller's responsibility. The caller should only ~ consider the delta of the word it requested itself; we handle everything ~ pertaining to retrieving, and then consuming, its execution token. ~ ~ (name pointer --) : log-load-execute-dynamic-word log-load-roll-log-address swap-transform-variables ~ This is reverse order again. L@' swap L@' log-load-find-execution-token L@' litstring swap-transform-variables ~ (name pointer, swap, log-load-find-execution-token, litstring) offset-to-target-address-space , ~ litstring 3roll here @ swap packstring 8 packalign here ! offset-to-target-address-space , ~ log-load-find-execution-token offset-to-target-address-space , ~ swap ~ Now the execution token is on the stack, immediately below the log ~ address, so we apply a delta for it. 1 transform-apply-stack-delta log-load-unroll-log-address swap-transform-variables L@' execute swap-transform-variables offset-to-target-address-space , ~ execute ~ Invoking execute consumes the execution token, which is a delta of -1. ~ Any additional delta is our caller's responsibility, per above. -1 transform-apply-stack-delta ; ~ We generate code that looks up "docol" by name, runs it to get the ~ codeword pointer, then finally appends it to the entry. ~ ~ This one's unusual in that it first executes the word, then compiles the ~ result. To avoid rolling and unrolling repeatedly, we implement it as a ~ special case. For clarity's sake we put the code here, with the other ~ dynamic word stuff. ~ : log-load-compile-docol log-load-roll-log-address swap-transform-variables ~ As usual, we do these in reverse. L@' log-load-comma L@' execute L@' log-load-find-execution-token L@' litstring swap-transform-variables ~ The overall stack delta of this sequence is 0. offset-to-target-address-space , ~ litstring here @ s" docol" packstring 8 packalign here ! offset-to-target-address-space , ~ log-load-find-execution-token offset-to-target-address-space , ~ execute offset-to-target-address-space , ~ log-load-comma log-load-unroll-log-address ; ~ There's one more compilation case, where we wish to compile an integer ~ literal. Again, for clarity, we do it here. ~ ~ (integer value --) : log-load-compile-literal log-load-roll-log-address swap-transform-variables ~ As usual, we do these in reverse. L@' log-load-comma L@' lit L@' log-load-comma L@' log-load-find-execution-token L@' litstring swap-transform-variables ~ The overall stack delta of this sequence is 0. offset-to-target-address-space , ~ litstring here @ s" lit" packstring 8 packalign here ! offset-to-target-address-space , ~ log-load-find-execution-token offset-to-target-address-space , ~ log-load-comma offset-to-target-address-space , ~ lit swap , ~ the value offset-to-target-address-space , ~ log-load-comma log-load-unroll-log-address ; ~ This is the alternate version of "create" for use with the log-load ~ transform. This one is quite unlike the regular "create"; rather than ~ creating an entry on the log directly, its job is to output words which, ~ when they're later executed, will do create's job. ~ ~ In practice that means outputting a codeword pointer to run a ~ statically-compiled word that does the work. The implementation of ~ log-load-create is in log-load.e. ~ ~ It's worth keeping in mind that this alternate only gets called for ~ manual invocations of "create". It isn't called from the colon alternate. : log-load-create-alternate ~ In immediate mode, we have special behavior because this is fundamental ~ to bootstrapping the log. In compile mode, we compile a dynamic call, ~ which is the same thing that would happen if we didn't have an alternate ~ at all. interpreter-flags @ 0x01 & { s" create" log-load-compile-dynamic-word } { log-load-roll-log-address swap-transform-variables L@' log-load-create L@' swap swap-transform-variables ~ The overall stack delta of this sequence is 0. offset-to-target-address-space , ~ swap offset-to-target-address-space , ~ log-load-create ~ We've consumed a string pointer from the stack, so that's a delta of -1. -1 transform-apply-stack-delta log-load-unroll-log-address } if-else ; ~ This is the alternate version of ":" for use with the log-load transform. ~ Its code is the same as the regular ":" except as noted below. It is likely ~ to be extremely useful to read and understand ":" in dynamic.e before ~ attempting to understand "log-load-colon-alternate". : log-load-colon-alternate word value@ ~ Calling log-load-create-alternate would result in some redundant rolling ~ and unrolling, so we do it together like this instead. log-load-roll-log-address swap-transform-variables L@' log-load-create L@' litstring swap-transform-variables ~ The overall stack delta of this sequence is 0. offset-to-target-address-space , ~ litstring swap here @ swap packstring 8 packalign here ! offset-to-target-address-space , ~ log-load-create log-load-unroll-log-address dropstring ~ We generate code that looks up "docol" by name, runs it to get the ~ codeword pointer, then finally appends it to the entry. log-load-compile-docol ~ This is where we would mark the entry hidden, but we don't do that. It ~ won't shadow anything and it won't be called until the entire log-load ~ routine has finished. ~ Switching between immediate and compile mode is one of the very few ~ things that happens NOW, while the log-load transform is actually running. ] ; ~ See notes on label-self-codeword-alternate for what problem this is ~ solving. ~ ~ Since self-codeword's real definition is in dynamic.e, which absolutely ~ cannot be loaded yet at the time we output docol at the very beginning of ~ core.e, we need to provide an alternate for the log-load transform as well, ~ even though only the label transform has the reproducibility issue. : log-load-self-codeword-alternate ~ It's important to remember, this is not an immediate word! It needs to ~ produce correct compiled output, when invoked in compile mode. Since it's ~ also a regular word that exists, correct output is a reference to the ~ non-alternate version. interpreter-flags @ 0x01 & { s" self-codeword" log-load-compile-dynamic-word } { log-load-roll-log-address swap-transform-variables L@' log-load-self-codeword swap-transform-variables offset-to-target-address-space , ~ log-load-self-codeword log-load-unroll-log-address } if-else ; make-immediate ~ This is the alternate version of ";" for use with the log-load transform. ~ Its code is the same as the regular ";" except as noted below. It is ~ likely to be extremely useful to read and understand ";" in dynamic.e ~ before attempting to understand "log-load-semicolon-alternate". : log-load-semicolon-alternate ~ We generate code that looks up "exit" by name and appends it to the ~ entry. log-load-roll-log-address swap-transform-variables ~ As usual, we do these in reverse. L@' log-load-comma L@' log-load-find-execution-token L@' litstring swap-transform-variables ~ The overall stack delta of this sequence is 0. offset-to-target-address-space , ~ litstring here @ s" exit" packstring 8 packalign here ! offset-to-target-address-space , ~ log-load-find-execution-token offset-to-target-address-space , ~ log-load-comma log-load-unroll-log-address ~ This is where we would unhide the entry, but again, we don't do that. ~ Since [ is an immediate word, we have to go to extra trouble to compile ~ it as part of ;. [ ' [ entry-to-execution-token , ] ; make-immediate ~ This is the alternate version of ";asm" for use with the log-load ~ transform. Its code is the same as the regular "create" except as noted ~ below. It is likely to be extremely useful to read and understand ";asm" in ~ dynamic.e before attempting to understand "log-load;asm". : log-load-semicolon-assembly-alternate ~ We generate code that statically invokes log-load-semicolon-assembly, ~ which does all the actual work. There's quite a few steps, so it makes ~ sense to have a word that bundles them up. log-load-roll-log-address swap-transform-variables ~ As usual, we do these in reverse. L@' log-load-semicolon-assembly swap-transform-variables ~ The stack delta of this call is 0. offset-to-target-address-space , ~ log-load-semicolon-assembly log-load-unroll-log-address ~ This is where we would unhide the entry, but again, we don't do that. ~ Since [ is an immediate word, we have to go to extra trouble to compile ~ it as part of ;. [ ' [ entry-to-execution-token , ] ; make-immediate ~ This just does the same thing [ always does, but having it as an alternate ~ means it happens at transformation time, which is sooner than "immediate" ~ time. The log load transform is weird like that, it has three different ~ times things can happen, rather than the usual two. : log-load-left-square-brace-alternate ~ Since [ is an immediate word, we have to go to extra trouble to compile ~ it as part of the alternate. [ ' [ entry-to-execution-token , ] ; make-immediate ~ We need this one, too. It's not even an immediate word normally! : log-load-right-square-brace-alternate ] ; make-immediate : log-load-comma-alternate ~ In immediate mode, we have special behavior because of the "here" magic. ~ In compile mode, we compile a dynamic call, which is the same thing that ~ would happen if we didn't have an alternate at all. interpreter-flags @ 0x01 & { s" ," log-load-compile-dynamic-word } { log-load-roll-log-address swap-transform-variables L@' log-load-comma L@' swap swap-transform-variables offset-to-target-address-space , ~ swap offset-to-target-address-space , ~ log-load-comma ~ We consumed the value, so we apply a delta. -1 transform-apply-stack-delta log-load-unroll-log-address } if-else ; make-immediate : log-load-variable-alternate ~ In immediate mode, we have special behavior because of the "here" magic. ~ In compile mode, we compile a dynamic call, which is the same thing that ~ would happen if we didn't have an alternate at all. interpreter-flags @ 0x01 & { s" variable" log-load-compile-dynamic-word } { ~ Calling log-load-create-alternate would result in some redundant rolling ~ and unrolling, so we do it together like this instead. log-load-roll-log-address swap-transform-variables L@' log-load-variable L@' 3unroll swap-transform-variables offset-to-target-address-space , ~ 3unroll offset-to-target-address-space , ~ log-load-variable ~ We consumed the string and address, so we apply a delta. -2 transform-apply-stack-delta log-load-unroll-log-address } if-else ; make-immediate : log-load-keyword-alternate ~ In immediate mode, we have special behavior because of the "here" magic. ~ In compile mode, we compile a dynamic call, which is the same thing that ~ would happen if we didn't have an alternate at all. interpreter-flags @ 0x01 & { s" keyword" log-load-compile-dynamic-word } { ~ Calling log-load-create-alternate would result in some redundant rolling ~ and unrolling, so we do it together like this instead. log-load-roll-log-address swap-transform-variables L@' log-load-keyword L@' swap swap-transform-variables offset-to-target-address-space , ~ swap offset-to-target-address-space , ~ log-load-keyword ~ We consumed the string, so we apply a delta. -1 transform-apply-stack-delta log-load-unroll-log-address } if-else ; make-immediate ~ Yeah comments have to go. : log-load-tilde-alternate ' ~ entry-to-execution-token execute ; make-immediate ~ Strings are important and must happen now, now, now. : log-load-string-alternate ~ Wrapping s" is surprisingly difficult; see label-string-alternate ~ for detailed notes on how that works. Once we've finished the ~ transform-time part, our implementations will diverge, but this first bit ~ is the same. interpreter-flags @ ' s" entry-to-execution-token swap-transform-variables ~ Since [ is an immediate word, we have to go to extra trouble to compile ~ it as part of the alternate. [ ' [ entry-to-execution-token , ] execute swap-transform-variables swap interpreter-flags ! ~ Nope, doing it twice didn't make that any less of a mouthful. ~ ~ Having done this, we have the string pointer on the stack at transform ~ time (not, mind you, at log-load time, as yet). Now it is our job to ~ either compile it, or invoke it "immediately". Recall that the log-load ~ transform's "immediate" time, which we also call log-load time, is ~ analogous to the label transform's "compile" time. The log-load ~ transform's "compile" time is an additional layer of indirection. ~ ~ No matter which mode we're in, the first thing we want to do is get the ~ string onto the value stack at log-load time. So we compile code to do ~ that, first. We do that using the static "litstring", which we find by ~ label. ~ ~ If this is all too twisty, it might be helpful to go re-read the ~ definition of log-load-compile-literal, which does a simpler version of ~ this same task (because integers are easier than strings). swap-transform-variables L@' litstring swap-transform-variables offset-to-target-address-space , ~ litstring here @ swap packstring 8 packalign here ! ~ Now the string pointer is on the stack at log-load time, so we apply a ~ delta for it. 1 transform-apply-stack-delta ~ If we're in immediate mode, we're done! Yay! Putting the string on the ~ stack at log-load time is what we wanted. If not... interpreter-flags @ 0x01 & { ~ We're in compile mode, so we need to look up the ultimate, dynamic, ~ log-based, super-atomic space rocket copy of "litstring" and use that. ~ We could call log-load-compile-dynamic-word here, but, as usual, it ~ would produce some excessive rolling and unrolling, so we do its job ~ ourselves instead. log-load-roll-log-address swap-transform-variables ~ As usual, we do these in reverse. L@' log-load-comma-string L@' swap L@' log-load-comma L@' log-load-find-execution-token L@' litstring swap-transform-variables ~ The overall stack delta of this sequence is 0. offset-to-target-address-space , ~ litstring here @ s" litstring" packstring 8 packalign here ! offset-to-target-address-space , ~ log-load-find-execution-token offset-to-target-address-space , ~ log-load-comma offset-to-target-address-space , ~ swap offset-to-target-address-space , ~ log-load-comma-string ~ We consumed the string pointer at log-load time, so we apply a delta ~ for it. ~ ~ Notice by the way how the nearby calls to log-load-unroll-log-address ~ rely on this being split into two deltas like this, even though they ~ net out to zero; we aren't doing it just for kicks. -1 transform-apply-stack-delta log-load-unroll-log-address } if ; make-immediate : log-load-dot-string-alternate ' log-load-string-alternate entry-to-execution-token execute interpreter-flags @ 0x01 & { ~ Hey look, it's the one time we're doing something simple enough that ~ we can actually benefit from log-load-compile-dynamic-word as something ~ more than an example to start from. :) s" emitstring" log-load-compile-dynamic-word } { swap-transform-variables L@' emitstring swap-transform-variables offset-to-target-address-space , ~ emitstring } if-else ; make-immediate ~ No matter what mode we're in, we read a name at transform time. Then we ~ look up the name at either log-load time or runtime, depending. : log-load-tick-alternate ~ Read the name. word value@ ~ Get the name onto the stack at log-load time. swap-transform-variables L@' litstring swap-transform-variables offset-to-target-address-space , ~ litstring here @ swap packstring 8 packalign here ! ~ Apply a delta for the string pointer. 1 transform-apply-stack-delta dropstring ~ Now break out the remaining behavior based on mode. interpreter-flags @ 0x01 & { log-load-roll-log-address swap-transform-variables L@' log-load-comma L@' log-load-find-execution-token L@' litstring L@' log-load-comma-string L@' swap L@' log-load-comma L@' log-load-find-execution-token L@' litstring swap-transform-variables ~ The overall stack delta of this sequence is 0. offset-to-target-address-space , ~ litstring here @ s" litstring" packstring 8 packalign here ! offset-to-target-address-space , ~ log-load-find-execution-token offset-to-target-address-space , ~ log-load-comma offset-to-target-address-space , ~ swap offset-to-target-address-space , ~ log-load-comma-string offset-to-target-address-space , ~ litstring here @ s" find" packstring 8 packalign here ! offset-to-target-address-space , ~ log-load-find-execution-token offset-to-target-address-space , ~ log-load-comma ~ We consumed the string pointer at log-load time, so we apply a delta ~ for it. As in log-load-string-alternate, this needs to be split into ~ two parts like this. -1 transform-apply-stack-delta log-load-unroll-log-address } { log-load-roll-log-address swap-transform-variables L@' log-load-find swap-transform-variables offset-to-target-address-space , ~ log-load-comma ~ We leave an execution token on the log-load-time stack, so no delta ~ needed. log-load-unroll-log-address } if-else ; make-immediate ~ Because docol requires it, we provide a special mini-version of the label ~ system. We only do L@' and L!', because that's all we need. Unlike the ~ version of this feature for the label transform, for the log-load transform, ~ we heavily restrict the use-case. ~ ~ The implementation strategy is that we ignore the label name, and store ~ the value on the stack when the generated log-load routine runs. So, each ~ instance of L@' must be closely followed by a matching instance of L!'. Each ~ label can only ever be used exactly once, and it must be a backward ~ reference. Furthermore, the stack is used in a very specific way, which the ~ transformed code must be compatible with. The easiest way to explain it is ~ by showing the interface of these words from the transformed code's ~ perspective: ~ ~ L!' is (preserved values, ..., ..., value of label ~ -- value of label, preserved values, ..., ...) ~ L@' is (value of label, preserved values, ..., ...) ~ -- preserved values, ..., ..., value of label) ~ ~ The preserved values are simply more items on the stack, which the ~ alternates take pains not to interfere with. The alternates output a roll or ~ unroll of an appropriate size. Hopefully, in reading this, you have the ~ question: How can the alternates possibly know what size is appropriate? ~ The answer is that the log-load transform carefully tracks how many items ~ the transformed code is expected to have on the stack, based on its ~ hardcoded understanding of each word that's expected to be relevant, looked ~ up by the word's name. The number of items is stored in the user-stack-depth ~ field of transformation-state. ~ ~ There is no adjustment done on the saved value, since it's created in the ~ target address space and then also used in the target address space. It ~ wouldn't actually be necessary to use this at all, since checking "here" ~ would be sufficient, but then the code would have to do something different ~ depending on which transform it's running under, and there'd have to be a ~ mechanism for that. ~ ~ This is sufficient to implement docol, and that's probably the only thing ~ it should be used for. : log-load-L@'-alternate word dropstring log-load-roll-saved-label ~ We now begin thinking of the label value as user data, so we need to ~ notate that appropriately. 1 transform-apply-stack-delta ; make-immediate : log-load-L!'-alternate word dropstring ~ We cease to think of the label value as user data, so we need to notate ~ that appropriately. -1 transform-apply-stack-delta log-load-unroll-saved-label ; make-immediate ~ Not to be outdone by the label transform, the log-load transform also ~ offers alternates of all the high-level flow-control words: if, unless, ~ if-else, forever, and while. Unlike the label transform, we also need to ~ implement alternates of { and }, because their values need to be on the ~ stack at log-load "immediate" time, not at transform time. ~ ~ Anyway, most of the implementation is deferred to pre-packaged words in ~ log-load.e. : log-load-left-curly-brace-alternate log-load-roll-log-address swap-transform-variables L@' log-load-left-curly-brace swap-transform-variables offset-to-target-address-space , ~ log-load-left-curly-brace ~ It pushes a start pointer onto the stack. 1 transform-apply-stack-delta log-load-unroll-log-address ; make-immediate : log-load-right-curly-brace-alternate log-load-roll-log-address swap-transform-variables L@' log-load-right-curly-brace swap-transform-variables offset-to-target-address-space , ~ log-load-right-curly-brace ~ It pushes a length value onto the stack. 1 transform-apply-stack-delta log-load-unroll-log-address ; make-immediate ~ (start pointer, length --) : log-load-if-alternate log-load-roll-log-address swap-transform-variables L@' log-load-if swap-transform-variables offset-to-target-address-space , ~ log-load-if ~ It pops the start and length. -2 transform-apply-stack-delta log-load-unroll-log-address ; make-immediate ~ (start pointer, length) : log-load-unless-alternate log-load-roll-log-address swap-transform-variables L@' log-load-unless swap-transform-variables offset-to-target-address-space , ~ log-load-unless ~ It pops the start and length. -2 transform-apply-stack-delta log-load-unroll-log-address ; make-immediate ~ (true start, true length, false start, false length) : log-load-if-else-alternate log-load-roll-log-address swap-transform-variables L@' log-load-if-else swap-transform-variables offset-to-target-address-space , ~ log-load-if-else ~ It pops two pairs of start and length. -4 transform-apply-stack-delta log-load-unroll-log-address ; make-immediate ~ (start, length --) : log-load-forever-alternate log-load-roll-log-address swap-transform-variables L@' log-load-forever swap-transform-variables offset-to-target-address-space , ~ log-load-forever ~ It pops the start and length. -2 transform-apply-stack-delta log-load-unroll-log-address ; make-immediate ~ (test start, test length, body start, body length --) : log-load-while-alternate log-load-roll-log-address swap-transform-variables L@' log-load-while swap-transform-variables offset-to-target-address-space , ~ log-load-while ~ It pops two pairs of start and length. -4 transform-apply-stack-delta log-load-unroll-log-address ; make-immediate ~ This implements the log-load 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. ~ ~ It expects to be called from "log-load-transform", below, which loops. ~ ~ (-- done) : log-load-transform-one word ~ If no word was returned, exit. dup 0 = { drop 0 exit } if ~ The string is on the top of the stack, so to get a pointer to it we get ~ the stack address. ~ (string) value@ ~ If it's the magic word, end the transformation. dup transformation-state transformation-state-delimiter @ stringcmp 0 = { drop dropstring 1 exit } if ~ Check whether it's one of the words we have alternates for, and look up ~ the alternate if so. 0 swap ~ (name as stack string, placeholder, name pointer) dup s" create" stringcmp 0 = { swap drop ' log-load-create-alternate swap } if dup s" :" stringcmp 0 = { swap drop ' log-load-colon-alternate swap } if dup s" self-codeword" stringcmp 0 = { swap drop ' log-load-self-codeword-alternate swap } if dup s" ;" stringcmp 0 = { swap drop ' log-load-semicolon-alternate swap } if dup s" ;asm" stringcmp 0 = { swap drop ' log-load-semicolon-assembly-alternate swap } if dup s" [" stringcmp 0 = { swap drop ' log-load-left-square-brace-alternate swap } if dup s" ]" stringcmp 0 = { swap drop ' log-load-right-square-brace-alternate swap } if dup s" ," stringcmp 0 = { swap drop ' log-load-comma-alternate swap } if dup s" variable" stringcmp 0 = { swap drop ' log-load-variable-alternate swap } if dup s" keyword" stringcmp 0 = { swap drop ' log-load-keyword-alternate swap } if dup s" ~" stringcmp 0 = { swap drop ' log-load-tilde-alternate swap } if ~ It is nontrivial to construct a string with a double-quote in it. dup ' s" entry-to-name stringcmp 0 = { swap drop ' log-load-string-alternate swap } if dup ' ." entry-to-name stringcmp 0 = { swap drop ' log-load-dot-string-alternate swap } if dup ' ' entry-to-name stringcmp 0 = { swap drop ' log-load-tick-alternate swap } if dup s" L@'" stringcmp 0 = { swap drop ' log-load-L@'-alternate swap } if dup s" L!'" stringcmp 0 = { swap drop ' log-load-L!'-alternate swap } if dup s" {" stringcmp 0 = { swap drop ' log-load-left-curly-brace-alternate swap } if dup s" }" stringcmp 0 = { swap drop ' log-load-right-curly-brace-alternate swap } if dup s" if" stringcmp 0 = { swap drop ' log-load-if-alternate swap } if dup s" unless" stringcmp 0 = { swap drop ' log-load-unless-alternate swap } if dup s" if-else" stringcmp 0 = { swap drop ' log-load-if-else-alternate swap } if dup s" forever" stringcmp 0 = { swap drop ' log-load-forever-alternate swap } if dup s" while" stringcmp 0 = { swap drop ' log-load-while-alternate swap } if ~ (name as stack string, 0 or alternate entry pointer, name pointer) ~ If we have an alternate, we want to run that now, regardless of what ~ mode we're in. They're all flagged as immediate, but we don't even bother ~ checking, because it doesn't fully describe their behavior anyway. With ~ this transform there's three potential times at which we might execute ~ things, not two. The alternates are more immediate than immediate; they ~ run NOW, during the transformation. over { drop dropstring-with-result entry-to-execution-token execute 0 exit } if drop drop ~ (name as stack string) ~ Now we might have a compiled word, an immediate word, or an integer ~ literal. Recall that the word won't actually be looked up until the ~ routine we're producing is run - that's the whole point - so there's no ~ check we can perform now that will tell us whether the word we have exists ~ in the eventual log. Instead, we invert the usual fallback order and ~ check whether the word could be an integer literal. If it is, we'll ~ handle that; if not, we'll assume it'll eventually exist. ~ ~ This means that code that's run with the log-load transform can't ~ shadow an integer literal with a word definition. Oh, so limiting. value@ read-integer 0 = { ~ It's a number. ~ ~ (name as stack string, integer value) dropstring-with-result ~ (integer value) interpreter-flags @ 0x01 & { ~ We're in compile mode, so we want to generate code which will compile ~ the number. log-load-compile-literal 0 exit } if ~ We're in interpret mode, so we want to generate code which will push ~ the number to the stack. ~ ~ This is an immediate effect, so once we've done it, we update the user ~ stack depth. An integer literal is a stack-depth delta of 1. swap-transform-variables L@' lit swap-transform-variables offset-to-target-address-space , , 1 transform-apply-stack-delta 0 exit } if ~ (name as stack string) ~ We know it's a regular word, and we're assuming it will exist at ~ runtime. We of course have no way to check what flags it will have, which ~ means immediate words don't work with this transform. We still treat it ~ differently based on whether we're in compile mode. interpreter-flags @ 0x01 & { ~ We're in compile mode. We compile code that compiles the word. ~ ~ Since that's not an immediate effect, we don't need to update the ~ user stack depth. Instead, this is a key spot where we rely on that ~ knowledge, to roll and unroll the log address. value@ log-load-compile-dynamic-word dropstring 0 exit } if ~ (name as stack string) ~ At this point we know we're in immediate mode and have a regular word. ~ While we still have the name pointer handy, we check what delta this word ~ will cause for the user stack depth, when run. See ~ transform-get-stack-delta for more explanation of this. We keep track of ~ the proposed delta until we actually process the word, down below. value@ dup transform-get-stack-delta swap ~ (name as stack string, proposed stack depth delta, name pointer) ~ We're in immediate mode. We compile code that runs the word immediately. ~ We check whether there's a label for the word; if there is, we'll output ~ that. Otherwise we'll output code that looks it up in the log and runs it. ~ ~ Just like in label-transform, we use find-label to check whether a label ~ exists without declaring a dependency on it, then if it does, we do ~ use-label to ask for its value. ~ ~ There's one additional wrinkle to remember here: We're running inside ~ the label loop, and warm-start appears before all the normal words in the ~ executable. So all the labels we'll be checking are forwared references, ~ and on the very first pass they definitely won't be defined. That's fine ~ though, they will exist on all subsequent passes, so things will ~ definitely still converge. ~ ~ The first pass will never accidentally think it succeeded, because even ~ the reference to L' cold-start from the ELF header is a forward reference ~ and won't exist on the first pass. dup swap-transform-variables find-label swap-transform-variables { ~ Again just like in label-transform, we declare our use of the label ~ and get a value for it. swap-transform-variables intern-label use-label swap-transform-variables ~ (name as stack string, proposed stack depth delta, label value) ~ Like in label-transform, this is a codeword pointer, so we just output ~ it directly. Also as before, because we don't have to examine it, we ~ don't have to do anything special in the case where it's zero due to the ~ way the label loop works. ~ ~ This is an immediate effect, so once we've done that, we update the ~ user stack depth. offset-to-target-address-space , transform-apply-stack-delta dropstring 0 exit } if ~ (name as stack string, proposed stack depth delta, name pointer) ~ There's no label for the word; that means it wasn't statically ~ compiled-in to the target executable. So we output code that looks up the ~ word by name on the log, then calls it. ~ ~ This is also an immediate effect, despite being distinct from the above ~ case, so once we've done that, we update the user stack depth. ~ ~ There's no such thing as not finding the word, with this transform. So ~ once we're done, we just exit. log-load-execute-dynamic-word transform-apply-stack-delta dropstring 0 ; ~ This implements the log-load transform for all words in a region given as ~ an input string. It is directly analogous to "quit", in interpret.e, but is ~ far more complex. ~ ~ (output buffer start, output point, input string pointer, delimiter pointer ~ -- output buffer start, output point) : log-load-transform ~ : This is the start of the log-load routine, which is a long block of ~ : code that has been processed by the log-load transform. It is part of ~ : the warm-start routine, which does other things before and after it. ~ : For clarity's sake, to avoid weird nesting, the section header above ~ : calls this the warm-start section of the executable, but in a sense it ~ : might be more accurate to call it the log-load section. ~ : ~ : The routine is interpreted Forth code, just as the warm-start routine ~ : as a whole is; see above. ~ : ~ : The job of the log-load routine is to create runnable code in the ~ : dynamic log, at runtime. The normal way to create a Forth executable ~ : is to use label-transformed code to implement a minimal set of ~ : functionality needed for the log-load routine to run, then invoke the ~ : log-load routine to copy a more complete set of functionality into ~ : memory. main-input-buffer dup push-input-buffer 3roll attach-string-to-input-buffer ~ Save the old values of "here" and "latest", and set the initial values ~ of the internal ones. These values need to persist across iterations, ~ since client code will make its own updates to them and then rely on those ~ 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. 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 ! ~ Now the stack has nothing of ours on it, so client code can do its thing. ~ 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. { log-load-transform-one ~ (done) ~ When the loop is done, get the real values of "here" and "latest" ~ back. The internal "here" is also the output point, and will become our ~ return value. The internal "latest" is discarded. { here @ transformation-state transformation-state-saved-here @ here ! transformation-state transformation-state-saved-latest @ latest ! ~ (output point) ~ Though we don't actually use transformation-state outside of this ~ invocation, for tidiness we zero it out. 0 transformation-state transformation-state-saved-here ! 0 transformation-state transformation-state-saved-latest ! 0 transformation-state transformation-state-output-buffer-start ! 0 transformation-state transformation-state-user-stack-depth ! ~ Also put the input source back how it was. main-input-buffer pop-input-buffer exit } if } forever ; ~ Hex transform implementation ~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~ ~ The following code is all part of implementing the hex transform. For ~ conceptual overview, see the top of this file. ~ ~ The hex transform operates under some very complex memory-management ~ assumptions, even compared to the other transforms, so it's worth going over ~ all that and studying how it comes together, even though much of it is ~ material that has been explained elsewhere. This explanation is here with ~ the implementation details rather than at the top of the file, because it's ~ only necessary to understanding how to modify the transform, not how to use ~ it. ~ ~ This is the bit of the hex transform where all the memory-management ~ assumptions are in play at once, so, a quick refresher. The transform ~ itself is running in the outer context; hex-trace and its siblings are ~ part of Evocation's main log and dictionary. This is also true for the ~ label and log-load transforms. Evocation has two global variables, ~ "here" and "latest", which are the root of all references to the log and ~ dictionary, respectively. Remember, the log is the structure used for ~ memory allocation, and the dictionary, which forms the majority of the ~ log, is the structure used for looking up words by name. ~ ~ Every transform, in its various ways, is changing what it means to ~ "execute" and "compile" code; therefore, when the transforms are invoked, ~ they are passed an "output buffer" which is used as the destination for ~ any compilation that occurs, and any scratch space that is needed. When ~ more than one transform is running at once (such as when the hex transform ~ operates on code that is itself running the label transform), each ~ transform has its own separate output buffer. ~ ~ Furthermore, the transformation facility helps each transform to swap out ~ the values of "here" and "latest", and restore them later, so that the code ~ being transformed will see the output buffer as if it is the "real" log, and ~ will see the separate dictionary stored within the output buffer as if it is ~ the "real" dictionary. ~ ~ All this stuff about the output buffer applies to every transform. The ~ hex transform takes it one step further, and as such there are two ~ additional memory regions that are important to understanding it. The first ~ is the label-loop buffer, which is allocated out of the inner log, and used ~ to hold draft versions of the binary output that the inner compilation ~ process would eventually emit to the standard output stream, if it were ~ being allowed to emit output in the normal way. The second is the output ~ metadata buffer, which is allocated out of the outer log, and used to hold ~ metadata such as comments and formatting pertaining to code structure, which ~ will need to be referenced when actually outputting the final hex dump. ~ ~ So, the label-loop buffer can be thought of as scratch space for the ~ compiled binary output from the code being transformed, and the output ~ metadata buffer can be thought of as the scratch space for the formatted hex ~ dump that will be made out of that output. It's important not to confuse ~ either of them with the output buffer, which is the scratch space used as ~ part of the compilation process. ~ ~ Confusingly, the output buffer and the label-loop buffer both contain ~ logs and dictionaries, at least potentially, if the code being compiled is ~ Forth code. It is also possible to use the hex transform on assembly code, ~ in which case the label-loop buffer won't have a log in it but the output ~ buffer still will. In practice, the hex transform frequently winds up ~ needing to be careful about the log and dictionary in the output buffer, but ~ rarely does anything that directly touches the log and dictionary in the ~ label-loop buffer, so you can usually ignore the latter when reading this ~ code. ~ ~ Allocating the output buffer and output metadata buffer is the ~ responsibility of the caller of hex-transform. Allocating the label-loop ~ buffer is the responsibility of label-loop, which is called by the code ~ being transformed, but the hex transform intervenes in that allocation to ~ save information about it. ~ ~ The output buffer is referenced during the transform via the ~ transformation-state-output-buffer-start field of the global ~ "transformation-state" variable, and the output metadata buffer is ~ referenced via the transformation-state-output-metadata field of that same ~ variable. The label-loop buffer is referenced from the ~ hex-output-metadata-label-loop-buffer-start and -length fields of the ~ output metadata's top-level header, and the code being transformed passes ~ around its own reference to that same buffer. ~ ~ Finally, recall that, when Evocation itself is the thing being ~ transformed, the code under transformation includes its own copy of the ~ transformation facility, along with all the rest of Evocation. When the code ~ under transformation invokes the label and log-load transforms, it will do ~ so using the copies of those transforms which have been transformed by the ~ hex transform. The same goes for most Evocation internals invoked by the ~ compilation process, except for whatever specific exceptions the hex ~ transform creates. Do not confuse the inner copies of anything with the ~ outer copies. Also try not to worry too much about the inner-inner copies, ~ let the inner transforms deal with them. ~ ~ Got all that background fresh in your mind? Okay, time to get concrete! ~ The output metadata is a header structure followed by an array of entry ~ structures, as follows: ~ ~ (header start) ~ 0x00 - 0x07 Label-loop buffer start ~ 0x08 - 0x0f Label-loop buffer length ~ (entry start) ~ ... + 0x00 - ... + 0x07 Data pointer ~ ... + 0x08 - ... + 0x0f Referenced data length ~ ... + 0x10 - ... + 0x17 String pointer ~ (entry fields repeat at successive offsets, until...) ~ ... + 0x00 - ... + 0x07 (end) Zero, used as a delimiter ~ ~ ~ Magic comment syntax ~ ~~~~~~~~~~~~~~~~~~~~ ~ ~ How, the sufficiently determined reader may ask, does all this output ~ metadata get created? Surely, the reader may rightly think, creating ~ metadata entries which fully describe a compilation process must entail ~ gathering and synthesizing information from disparate stages of that ~ process, which seems quite involved. ~ ~ That is correct: It is quite involved. It would be nice if there were a ~ simple trick, but this appears to be essential complexity. Several ~ approaches were considered. In principle it would be possible to have a ~ specific trap defined here in this file for every word that generates ~ nontrivial output, and keep knowledge of what information to gather from ~ those words in the trap definitions. However, that would bind the important ~ semantics quite closely to the already-overwhelming topic of the ~ transformation data structures, and make it all but impossible to port ~ Evocation to a new architecture. The knowledge we wish to capture is really ~ knowledge about an instruction set architecture, not about data structures. ~ ~ Instead, following the principle that different kinds of knowledge on the ~ same topic should live close together, we've defined a magic-comment syntax ~ which allows the assembly-language words in amd64.e to describe their own ~ metadata, and is versatile enough to do the same for future architectures. ~ ~ When the compiler operates normally, without the hex transform, these ~ magic comments are simply regular comments, and are discarded as the ~ interpreter finds them. When the compiler runs under the hex transform, they ~ are instead recognized as commands to be processed by the hex transform. ~ Magic comments can only appear in the body of a word being compiled, not at ~ the top level. The hex transform intervenes in the compilation process to ~ insert calls to its own internal words, which are executed, not when the ~ comment is read, but later, when the word it was compiled into is called. ~ When the word in question is itself part of the compiler, the magic comments ~ will be able to see and work with all the state that exists as it runs, and ~ gather it as they wish. ~ ~ There are several kinds of magic comment. All of them begin with the ~ characters : and space as the first two characters of the comment body (and ~ don't forget that there's a space after ~, as well). The syntax on the rest ~ of the line determines what type of command it is. ~ ~ Here are some examples: ~ ~ ~ : Intriguing commentary goes here. ~ ~ : 5 This comment describes the next five bytes of output. ~ 777 pack32 ~ : -4 This comment describes the previous four bytes. ~ ~ ~ : indent ~ ~ : deindent ~ ~ : fresh-line ~ ~ : blank-line ~ ~ ~ : 1 adjust-length ~ ~ : 1 suppress ~ ~ ~ : Do a thing with # and # ? ~ ~ : Do a different #swap # thing to # now. ~ ~ : provide-decimal ~ ~ : provide-hex ~ ~ : provide-hex8 ~ ~ : provide-hex16 ~ ~ : provide-hex32 ~ ~ : provide-hex64 ~ ~ : provide-string ~ ~ : provide-string-copy ~ ~ : provide-keyword ~ ~ : drop-subitem ~ ~ : swap-subitems ~ ~ : 3 roll-subitems ~ ~ By the way, the reason it's possible to write these examples is that ~ they're all embedded within an outer comment, the text you're reading, so ~ they don't look like real magic comments to the hex transform. Hopefully ~ that's not too confusing; there isn't really another way. ~ ~ So. You'll have noticed that some magic comments seem to be descriptive ~ text, and others seem to be commands. Every magic comment, in one way or ~ another, creates or manipulates the metadata entries, which are stored in ~ an array inside the output metadata as global mutable state. There are ~ several phases of processing, and if you've gotten this far, you likely need ~ to understand what they are and what order they happen in. ~ ~ The simplest kind of comment is the "line comment", the first example ~ above. Any comment that doesn't match some more-specific syntax is treated ~ as a line comment. It has not escaped Irenes' notice that this means your ~ syntax errors will seem to half-work; sorry about that. When a line comment ~ is executed, it creates a metadata entry at the end of the array of entries, ~ of -entry-type-line-comment, attached to the latest output point. ~ ~ This is the general pattern: Any magic comment that creates a metadata ~ entry will always create it at the end of the entry array, and will always ~ attach it to the latest output point as of the time the comment executes. ~ Notice that, although the entry array will eventually be sorted by the ~ addresses entries are attached to, at the time entries are created they're ~ simply appended. This is rarely an important distinction, but when it is, it ~ is. ~ ~ What is the latest output point? Well, the hex transform has trapped all ~ the words from core that compilation processes use to directly append bytes ~ to the label-loop buffer, including pack8, packstring, and the variants ~ thereof. The traps are able to tell when the destination is in the ~ label-loop buffer, and they ignore any writes that aren't. The traps keep ~ track of the next address AFTER whatever was just written, and store that ~ in the output metadata header so magic comments can make use of it. ~ ~ It's necessary to take this sneaky approach, because the compiler is free ~ to write things in any order it wants; the label loop goes back to the start ~ every so often, and the high-level flow-control words even slide things ~ around after the fact. The compiler is also free to pass around addresses ~ however it wants within itself, and without restricting that, there's no way ~ for the hex transform to know which value represents the place stuff MIGHT ~ be written to. ~ ~ The semantics of the latest output point are simple enough that they're ~ easy to keep in mind while writing magic comments. In practice, the output ~ point is almost never the cause of confusion about the behavior of magic ~ comments, but it's important to know about since it's the input the whole ~ thing starts with. ~ ~ Now, one thing to keep in mind is that every metadata entry has both an ~ address in the label-loop buffer that it attaches to, and a length field. ~ Line comments insert themselves in between lines of output in the hex dump, ~ and don't otherwise affect the surrounding formatting, so they don't need to ~ make use of the length and it's always set to zero. ~ ~ Now the second example above, which starts with the number 5 before its ~ descriptive text. When the first space-separated word of a magic comment's ~ body is a valid integer literal, this is taken as a parameter; different ~ types of magic comment use that parameter in different ways. The parameter ~ can be positive or negative, and can be written in any base Evocation ~ normally supports. ~ ~ When a parameter is given (even if it's zero), and the comment doesn't ~ match some other more-specific syntax, it's treated as a "suffix comment". ~ Much like a line comment, when a suffix comment is executed, it creates a ~ metadata entry at the end, of -entry-type-suffix-comment, attached to the ~ latest output point. The command uses the parameter as the initial value of ~ the entry's length field, but it's worth being aware that other commands may ~ change it later. ~ ~ It's called a suffix comment because, when all the passes described below ~ have run and the formatting happens, it will appear at the end of a line of ~ text, after the byte values it's attached to. Things like assembly-language ~ instructions should almost always be suffix comments, because this makes it ~ easy for a human reader to see which bytes of machine code go with them. ~ ~ There's also an implicit way to create a suffix comment, which is to have ~ non-blank words of any kind on the line prior to the magic comment. In this ~ case, the default is to be a suffix comment rather than a line comment. ~ Suffix comments created this way will have zero length. ~ ~ Before we move on from magic comments that produce descriptive text, also ~ look at the third example above. This is another suffix comment, but it's ~ got a negative number as its parameter. It's got a bit of code on the line ~ before it, to illustrate the typical way these negative parameters are used. ~ Just as a suffix comment with a positive length describes a span of bytes ~ with its start anchored at the address the comment is attached to, so when ~ the length is negative, the span of bytes has its END anchored at the ~ address. ~ ~ You can see examples of how this syntax is useful in elf.e, where it ~ describes fields of various header structures. When it fits the situation, ~ this notation is concise and easy to visually skim both in the actual source ~ code, and in the generated hex dump. ~ ~ Now let's look at some magic comments that do more interesting things. ~ The two commands "indent" and "deindent" both create an entry of ~ -entry-type-indent. Neither takes a parameter as part of the comment syntax, ~ but the entry structure has an internal value which is set to 2 for "indent" ~ and -2 for "deindent". When output is eventually formatted, these entries ~ will be used to adjust the amount of space at the beginning of each line, ~ which can be very useful to visually group code together. The formatting ~ process has some mutable state of its own, which doesn't exist until this ~ very late stage (long after magic comments execute); among other things, ~ there's a notion of current indentation level, which is preserved until ~ these entries adjust it. ~ ~ The commands "fresh-line" and "blank-line" create entries of ~ -entry-type-fresh-line and -entry-type-blank-line, respectively. Just as the ~ output formatting knows how deeply indented it is, it also knows whether ~ it's at the start of a line. A fresh-line entry will insert a line break, ~ but only if we're somewhere deep in a line; if we're already at the start, ~ it does nothing. A blank-line entry will do the same thing as fresh-line, ~ then it will add another line break, so that the result is to output a fully ~ blank line in the hex dump. This can be useful to break things up visually. ~ ~ Thus far, though we've taken pains to allude to the fact that there are ~ many stages of processing of metadata entries after they're created, we ~ haven't introduced any interesting features that rely on that. That changes ~ 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. 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 ~ created the entry they're modifying. For example, in amd64.e, rex-w is a ~ common helper word called as part of many assembly instructions. It always ~ outputs a single byte. Commentary in that file describes an accounting ~ convention whereby keeping track of this byte is rex-w's job, so rex-w also ~ has a magic comment with an adjust-length command. Whatever word calls rex-w ~ will have already created a suffix comment giving the name of the ~ instruction it's implementing, by the time this is called, and rex-w's ~ call to adjust-length will find that comment's entry and modify it. ~ ~ The use of this may not seem like much for a word like rex-w, which always ~ outputs the same number of bytes, but now look at the definition of ~ addressing-indirect-reg64. This is a common addressing mode shared by many ~ instructions, and called as a helper from various instruction words. Notice ~ how it has to generate a different encoding when it's given the register ~ :rsp, which has an extra SIB byte that's not needed for any other register. ~ There's no magic comments in addressing-indirect-reg64 itself, but the word ~ "sib" is another helper which does an appropriate adjust-length, if and only ~ if sib is actually called. ~ ~ You can see how it might become quite confusing trying to decide which ~ word should take responsibility for a particular byte, when there are ~ multiple layers of abstraction like this. It's especially confusing because ~ this is an extra form of side-effect which acts on global mutable state, and ~ is out-of-band compared to the normal Forth value stack. When you're ~ implementing an instruction set architecture, you should strongly consider ~ defining an accounting convention which makes that clear and unambiguous. ~ Feel free to consult the convention described at the top of amd64.e for ~ inspiration. ~ ~ We will revisit the topic of adjust-length later, when we describe the ~ comment template feature, but for now we'll leave it there. ~ ~ Direct your attention to the "suppress" command. Sometimes, you intend to ~ call a helper word which is going to create its own entries, but you know ~ that those entries don't suit your purpose, and you want to ignore them. ~ For example, you may be calling a word which outputs a binary string and ~ creates entries describing the string, but you're doing something more ~ specific and would prefer to create entries that describe your special case, ~ instead. ~ ~ When you need this, you can call "suppress" with an integer parameter. If ~ the parameter is 1, the next time a metadata entry would have been created, ~ it won't; then things go back to normal. If you want to suppress more than ~ one entry in a row, you can pass it a larger number. If you change your ~ mind, you can pass it a negative number. At the time magic comments are ~ executing, there's a running count of how many entries should be suppressed, ~ which is decremented any time it's greater than zero and an entry would be ~ created, and adjusted every time a call to "suppress" is executed. ~ ~ Take a quick look at the remaining examples. These are part of the comment ~ template feature. We'll need to describe the other phases of processing ~ before we can talk about how they work, but notice that one of them has the ~ space-separated word # inside it, while the others are commands whose names ~ start with provide-. Any line or suffix comment can have # in it, which will ~ consume a subitem from somewhere else, replacing the # like it's a template. ~ The various provide- commands are the origins of those subitems. Which # ~ goes with which provide- command? Thereby hangs a tale. ~ ~ So. Let's pretend for the moment that we've finished talking about things ~ that happen when magic comments execute. We haven't, quite, but to finish it ~ out you'll need the full picture in your head. ~ ~ All this time, the hex transform has been executing the compiler, which ~ is running its guts inside a utility called the label loop (see labels.e). ~ The compiler guts have been calling their own various internal words and ~ accumulating their binary output in the label-loop buffer. While this is ~ happening, the hex transform's various traps have been tracking the latest ~ output point, executing magic comments, and doing other vital but simpler ~ tasks. ~ ~ Eventually the label-loop will reach the end of its iteration, and then it ~ will either conclude that all the labels in the program have been resolved ~ successfully, or it will notice that some of them were given addresses that ~ don't work. If the labels aren't all resolved, the label loop will start ~ over from the beginning, running all the same compiler guts again. The hex ~ transform will notice that this happened, clear out all the metadata ~ entries, and restart its own activities as well. ~ ~ When the label loop finally declares success, and exits, the compiler will ~ want to actually produce its binary output. The hex transform has trapped ~ this, too! Now there's a postprocessing phase which cleans up all the ~ metadata entries, and then finally there's a formatting phase where the ~ entries are "run", as if they're a program, and the final hex dump with all ~ its comments is output. ~ ~ As a side note, the hex transform doesn't stop the compiler short; it lets ~ the compiler decide which bytes will be output and in what order. In ~ practice, Evocation and the various supplemental programs around it only ~ ever write their output in a single giant chunk, but the formatting phase ~ actually runs every single time the compiler calls sys-write, and it only ~ handles the portion of the label-loop buffer which the compiler passed to ~ sys-write. ~ ~ The postprocessing phase is idempotent - doing it twice is the same as ~ doing it once - so it's simply called every time sys-write is, before the ~ formatting phase starts. Postprocessing considers every metadata entry, ~ every time it runs, even when sys-write is called on something less than ~ the whole buffer. ~ ~ If you add postprocessing features, make sure to keep them idempotent. ~ While it's possible to imagine reasons one might want to have back-and-forth ~ interplay between successive formatting and postprocessing phases, Evocation ~ goes to some trouble to make sure there is none. In Irenes' opinion, this ~ is already quite enough complexity and is nearing the limit of what humans ~ will find worthwhile. If you break idempotence, you are hereby warned that ~ you are at risk of falling into the abyss[1]. ~ ~ Postprocessing re-organizes entries, without changing their meaning, but ~ in a way that will make them easier to format. There are two things it ~ does, and they happen simultaneously: The whole array is bubble-sorted; ~ and some suffix comment entries are split apart. ~ ~ The bubble sort resolves ordering first by the address each entry is ~ attached to, low-to-high. As a tiebreaker when two entries have the same ~ address, a comment entry is sorted after a stack-manipulation entry. The ~ tiebreaker rule means that stack-manipulation commands can come after the ~ last byte that's within the comment's span; otherwise they would always have ~ to be before it. If neither criterion applies, the entries will stay in ~ whatever order they were in to begin with; that is, it's a stable sort. ~ ~ The comment splitting applies only to suffix comments, and only when their ~ length is not zero. They become a fresh-line entry at the start of the span ~ the comment originally attached to, and a zero-length suffix comment entry ~ at the end of the span. ~ ~ Please notice that adjust-length commands happen when magic comments are ~ executed, which was long, long ago by now. By the time the postprocessing ~ happens, every entry's length has been as adjusted as it's ever going to be. ~ This is important, because the order of entries is going to matter during ~ the formatting phase. ~ ~ Notice also that the splitting of suffix comment entries changes what ~ address the comment is attached to (unless it's a negative length, which is ~ already at the end of its span). Any entries that were attached to output ~ points somewhere inside the span will now definitely be before the suffix ~ comment's entry in the entry array, whereas up till now they were likely ~ somewhere after it, depending on the exact order everything was created in. ~ ~ The postprocessing phase is conceptually simple - unlike the magic-comment ~ execution phase before it, and unlike the formatting phase after it, there ~ isn't any mutable state inside the phase that would make it matter what ~ order things happen in. Enjoy this, because ordering is about to become ~ super confusing. ~ ~ Now let's consider the formatting phase. We've already mentioned that ~ there is some global state which is tracked throughout the phase, such as ~ the current indentation level and whether the output is at the start of a ~ line. The formatting phase is given an overall block of bytes in the ~ label-loop buffer, which it iterates through in order from beginning to end. ~ Any time the formatting phase reaches an address which has metadata entries ~ attached to it, all the entries at that address are executed, in the order ~ they exist in the entry array. ~ ~ Yes, that's right, executing an entry is different from executing the ~ magic comment that created the entry. That's important. ~ ~ The line-comment and suffix-comment entries do the obvious things: They ~ print out the appropriate comment text. Suffix comments are also all ~ horizontally aligned with each other, to make them easier to visually skim. ~ The two kinds of comment entries also do a less-obvious thing, which is fill ~ in any # template items that are part of the comment text, in order from ~ left to right. ~ ~ Where do those items come from? Well, there's a separate stack, the ~ subitem entry stack, which is kept in the hex output metadata header. The ~ subitem entry stack has an extremely small, fixed maximum depth. The maximum ~ depth is deliberately small, so that any leaks onto it will be detected ~ somewhere close to their root causes, for ease of diagnosis. Unusually for ~ Evocation, if you underflow or overflow it, you'll get a friendly error ~ message rather than a segfault - how nice! Of course, the error message will ~ appear in the middle of your regular output and corrupt it, but you can't ~ have everything... ~ ~ Each time a comment template is being filled and encounters a # ~ placeholder, an item is popped off the subitem entry stack and formatted ~ according to what type of entry it is. It's called an "entry stack" for a ~ reason: it's a stack of pointers to metadata entries, whose backing store ~ is in this very same entry array that we're executing. So, all the various ~ internal fields of an entry are available to provide rich behavior which ~ allows different kinds of values to be formatted in different ways. ~ ~ For those used to languages with automatic memory management, keep in mind ~ that there's no language-provided guarantee that the thing a pointer points ~ to still exists, and hasn't been replaced with some other ~ misleadingly-similar thing. The separation of all this stuff into phases ~ provides that guarantee, because there's nothing in the formatting phase ~ that destroys or moves metadata entries in the array, but if that separation ~ were to break down, astonishingly complex wrong behavior would be entirely ~ likely. If you're reading all this, it's probably to touch that code, so ~ please keep those consequences in mind. ~ ~ How do entry pointers get pushed onto the subitem entry stack, and where ~ do the values inside them come from? Okay, now this is the payoff, the part ~ where you need to understand all these phases at once. Cast your mind all ~ the way back to the magic-comment execution, and take another look at the ~ provide-* examples above. Recall that magic comment commands execute when ~ the word they're contained in is running. For the other comment commands, ~ this is mostly a curiosity; we talked about adjust-length, above, but that's ~ 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 -decimal and ~ -hex* variants create a corresponding -entry-type-push-subitem- metadata ~ entry of the matching type, and copy the numeric value into it. ~ ~ The -string variant expects to find a pointer to a null-terminated string; ~ -string-copy does too, but copies the contents of it to a safe place ~ immediately, on the assumption they'll be overwritten. 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. All three of these save pointer to ~ their respective strings in a push-subitem-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 ~ consideration, right up until you got to "dictionary entry". If so, hey ~ look, neat, right? ;) ~ ~ Anyway, notice that when the various provide-* commands execute, all ~ they're doing is capturing values and creating metadata entries. Like all ~ metadata entries, these are attached to the latest output point as of the ~ time the magic comment executes. In particular, the subitem entry stack ~ isn't touched until all the way at the end, in the formatting phase. It's ~ only when the formatting reaches the address the entry is attached to that ~ the entry is executed, which has the effect of pushing a pointer to the ~ entry onto the subitem entry stack. ~ ~ It's been said already, but just to bring it all full circle, the life ~ cycle of a push-* entry ends later in the formatting phase, when a comment ~ entry pops it off the subitem entry stack and pretty-prints the value it ~ holds. ~ ~ With all this context, it likely doesn't need much explanation, but the ~ drop-subitem command will create an -entry-type-drop-subitem entry. When ~ this entry is executed, it will discard an item from the subitem entry ~ stack. Similarly, swap-subitems creates an -entry-type-swap-subitems, which ~ swaps the top two items, and roll-subitems creates an ~ -entry-type-roll-subitems, which rolls them, or unrolls them with a negative ~ parameter. ~ In general, the order in which provide-* commands execute will most likely ~ match the order in which the corresponding bytes are output. This may not ~ always match the order in which the comment template wants to pretty-print ~ them. Therefore, you will want to use these commands to get the subitem ~ stack in the proper order. ~ ~ In using these commands that manipulate the subitem stack, it's important ~ to remember that, when formatting happens, the left-to-right output of ~ subitems in the final output comment is top-to-bottom on the subitem stack, ~ because they're popped in order. This is the opposite of the usual visual ~ representation of stacks, and can easily be confusing. ~ ~ It's probably clear from the extreme emphasis this documentation has taken ~ on describing the order things happen in, but it is quite common to define ~ a suffix comment at the start of an assembly-instruction word; adjust its ~ length as other words are called; accumulate push-* entries; then rely ~ on the address sorting to make sure the push-* entries are executed ~ before the suffix comment entry, even though the suffix-comment command ~ executed before the others, and even though the adjust-length commands may ~ have come before or after the provide-* commands that go with the same ~ suffix comment. ~ ~ This is the kind of forwards-and-backwards thinking which humans are ~ surprisingly good at when reading and writing software, but which it's ~ quite difficult to formalize in a way that lets a computer share that ~ understanding. If you've read this far, Irenes would absolutely adore ~ hearing about how you found the explanation and whether you did anything ~ with it; don't be shy! ~ ~ [1] https://katalepsis.net/ ~ We have a bunch of accessors and traversers for the output metadata, which ~ are all functions from pointers to pointers. Don't confuse these with the ~ accessors for the transformation state, defined far, far above. : hex-output-metadata-label-loop-buffer-start ; : hex-output-metadata-label-loop-buffer-length 8 + ; : hex-output-metadata-latest-output-point 2 8 * + ; : hex-output-metadata-has-non-space-this-input-line 3 8 * + ; : hex-output-metadata-suppression-count 4 8 * + ; : hex-output-metadata-is-fresh-line 5 8 * + ; : hex-output-metadata-indentation-depth 6 8 * + ; : hex-output-metadata-current-column 7 8 * + ; : hex-output-metadata-subitem-entry-stack-depth 8 8 * + ; : hex-output-metadata-subitem-entry-stack-zero 9 8 * + ; : hex-output-metadata-subitem-entry-stack-capacity 8 ; : hex-output-metadata-first-entry 9 hex-output-metadata-subitem-entry-stack-capacity + 8 * + ; : hex-output-metadata-entry-data-start ; : hex-output-metadata-entry-data-length 8 + ; : hex-output-metadata-entry-type 2 8 * + ; : hex-output-metadata-entry-content 3 8 * + ; : hex-output-metadata-next-entry 4 8 * + ; : hex-output-metadata-previous-entry 4 8 * - ; : hex-output-metadata-entry-type-line-comment 0 ; : hex-output-metadata-entry-type-suffix-comment 1 ; : hex-output-metadata-entry-type-fresh-line 2 ; : hex-output-metadata-entry-type-blank-line 3 ; : hex-output-metadata-entry-type-indent 4 ; : hex-output-metadata-entry-type-string-literal 5 ; : hex-output-metadata-entry-type-raw-string-literal 6 ; : hex-output-metadata-entry-type-push-subitem-decimal 7 ; : hex-output-metadata-entry-type-push-subitem-hex 8 ; : hex-output-metadata-entry-type-push-subitem-hex8 9 ; : hex-output-metadata-entry-type-push-subitem-hex16 10 ; : hex-output-metadata-entry-type-push-subitem-hex32 11 ; : hex-output-metadata-entry-type-push-subitem-hex64 12 ; : hex-output-metadata-entry-type-push-subitem-string 13 ; : hex-output-metadata-entry-type-drop-subitem 14 ; : hex-output-metadata-entry-type-swap-subitems 15 ; : hex-output-metadata-entry-type-roll-subitems 16 ; ~ 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 ~ everything is structurally valid. We can't store real values at that point, ~ because they don't exist yet. The actual label-loop buffer, per its name, ~ won't be allocated until label-loop is called, so we can't possibly know its ~ address till then. : zero-hex-output-metadata transformation-state transformation-state-output-metadata @ dup hex-output-metadata-label-loop-buffer-start 0 swap ! dup hex-output-metadata-label-loop-buffer-length 0 swap ! dup hex-output-metadata-latest-output-point 0 swap ! dup hex-output-metadata-has-non-space-this-input-line 0 swap ! dup hex-output-metadata-suppression-count 0 swap ! dup hex-output-metadata-is-fresh-line 1 swap ! dup hex-output-metadata-indentation-depth 0 swap ! dup hex-output-metadata-current-column 0 swap ! dup hex-output-metadata-subitem-entry-stack-depth 0 swap ! dup hex-output-metadata-first-entry 0 swap ! ; ~ (pointer -- boolean) : is-in-label-loop-buffer dup transformation-state transformation-state-output-metadata @ hex-output-metadata-label-loop-buffer-start @ <= swap transformation-state transformation-state-output-metadata @ dup hex-output-metadata-label-loop-buffer-start @ swap hex-output-metadata-label-loop-buffer-length @ + > && ; : has-non-space-this-input-line@ transformation-state transformation-state-output-metadata @ hex-output-metadata-has-non-space-this-input-line @ ; : has-non-space-this-input-line! transformation-state transformation-state-output-metadata @ hex-output-metadata-has-non-space-this-input-line ! ; : is-comment-entry hex-output-metadata-entry-type @ dup hex-output-metadata-entry-type-line-comment = swap hex-output-metadata-entry-type-suffix-comment = || ; : is-push-subitem-entry ~ Notably, the subitem swap, drop, and roll entry types are not ~ push-subitem entries. hex-output-metadata-entry-type @ dup hex-output-metadata-entry-type-push-subitem-decimal = swap dup hex-output-metadata-entry-type-push-subitem-hex = 3roll || swap dup hex-output-metadata-entry-type-push-subitem-hex8 = 3roll || swap dup hex-output-metadata-entry-type-push-subitem-hex16 = 3roll || swap dup hex-output-metadata-entry-type-push-subitem-hex32 = 3roll || swap dup hex-output-metadata-entry-type-push-subitem-hex64 = 3roll || swap hex-output-metadata-entry-type-push-subitem-string = || ; : is-subitem-stack-manipulation-entry hex-output-metadata-entry-type @ dup hex-output-metadata-entry-type-drop-subitem = swap dup hex-output-metadata-entry-type-swap-subitems = 3roll || swap hex-output-metadata-entry-type-roll-subitems = || ; : is-fresh-line@ transformation-state transformation-state-output-metadata @ hex-output-metadata-is-fresh-line @ ; : is-fresh-line! transformation-state transformation-state-output-metadata @ hex-output-metadata-is-fresh-line ! ; : fresh-line is-fresh-line@ not { newline } if ; : indentation-depth@ transformation-state transformation-state-output-metadata @ hex-output-metadata-indentation-depth @ ; : indentation-depth! transformation-state transformation-state-output-metadata @ hex-output-metadata-indentation-depth ! ; : current-column@ transformation-state transformation-state-output-metadata @ hex-output-metadata-current-column @ ; : current-column! transformation-state transformation-state-output-metadata @ hex-output-metadata-current-column ! ; : advance-current-column current-column@ + current-column! ; : describe-subitem-entry-stack transformation-state transformation-state-output-metadata @ ." depth " dup hex-output-metadata-subitem-entry-stack-depth @ .hex64 newline ." capacity " hex-output-metadata-subitem-entry-stack-capacity .hex64 newline hex-output-metadata-subitem-entry-stack-zero hex-output-metadata-subitem-entry-stack-capacity 8 * hexdump-from ; : subitem-entry-stack-depth@ transformation-state transformation-state-output-metadata @ hex-output-metadata-subitem-entry-stack-depth @ ; : subitem-entry-stack-depth! transformation-state transformation-state-output-metadata @ hex-output-metadata-subitem-entry-stack-depth ! ; : is-subitem-entry-stack-empty subitem-entry-stack-depth@ 0 = ; : is-subitem-entry-stack-full subitem-entry-stack-depth@ hex-output-metadata-subitem-entry-stack-capacity = ; : push-subitem-entry-stack is-subitem-entry-stack-full not { transformation-state transformation-state-output-metadata @ hex-output-metadata-subitem-entry-stack-zero subitem-entry-stack-depth@ 8 * + ! subitem-entry-stack-depth@ 1+ subitem-entry-stack-depth! } { ~ We still consume the value, so that our caller doesn't crash. drop ." Substring entry stack overflow." newline } if-else ; : pop-subitem-entry-stack is-subitem-entry-stack-empty not { subitem-entry-stack-depth@ 1- subitem-entry-stack-depth! transformation-state transformation-state-output-metadata @ hex-output-metadata-subitem-entry-stack-zero subitem-entry-stack-depth@ 8 * + @ } { ." Substring entry stack underflow." newline ~ We still return a value, so that our caller doesn't crash. 0 } if-else ; ~ (data start, data length, entry type, string pointer, entry pointer --) : hex-output-metadata-entry! dup hex-output-metadata-entry-content 3roll swap ! dup hex-output-metadata-entry-type 3roll swap ! dup hex-output-metadata-entry-data-length 3roll swap ! dup hex-output-metadata-entry-data-start 3roll swap ! drop ; ~ (entry pointer, data start, data length, entry type, string pointer ~ -- next entry pointer) : pack-hex-output-metadata-entry 4 pick hex-output-metadata-entry! hex-output-metadata-next-entry ; ~ (data start, data length, entry type, string pointer --) : add-hex-output-metadata-entry ~ If the suppression count is greater than zero, decrement it. transformation-state transformation-state-output-metadata @ hex-output-metadata-suppression-count @ dup 0 < { 1- transformation-state transformation-state-output-metadata @ hex-output-metadata-suppression-count ! 4 ndrop exit } { drop } if-else 3 pick is-in-label-loop-buffer { transformation-state transformation-state-output-metadata @ hex-output-metadata-first-entry { dup @ dup { dup 3 pick >= drop } if } { hex-output-metadata-next-entry } while 5 unroll pack-hex-output-metadata-entry 0 pack64 drop } { drop drop drop drop } if-else ; ~ (length adjustment --) : adjust-latest-hex-output-metadata-entry-length ~ First, loop forward from the beginning of the entry array to find the ~ last actual entry. transformation-state transformation-state-output-metadata @ hex-output-metadata-first-entry dup @ { { dup hex-output-metadata-next-entry @ } { hex-output-metadata-next-entry } while } if ~ (entry pointer or 0) ~ If and only if we actually found one, now loop backwards to find the ~ most recent one that's a comment entry. All length adjustments apply to ~ comment entries, anything else needs to be skipped for this purpose. { dup { dup is-comment-entry not } { 0 } if-else } { transformation-state transformation-state-output-metadata @ hex-output-metadata-first-entry over > { hex-output-metadata-previous-entry } { drop 0 } if-else } while ~ (entry pointer or 0) ~ We've found the entry we want to act on, if it exists, so do it. dup { hex-output-metadata-entry-data-length dup @ 3roll + swap ! } { drop ~ If we get here, that's a problem. Emit an error message to make sure ~ it's easy to diagnose. ." No pre-existing metadata entry to adjust." newline crash } if-else ; ~ (count adjustment --) : adjust-hex-output-suppression-count transformation-state transformation-state-output-metadata @ hex-output-metadata-suppression-count dup @ 3roll + swap ! ; ~ This is the followup to zero-hex-output-metadata, above. Once we do have ~ the label-loop buffer, we need to create some default entries. This is ~ called in the first label-loop iteration by hex-allocate-replacement, and ~ it's called before subsequent iterations by the hook on reset-labels defined ~ in hex-colon-alternate. ~ ~ This overwrites whatever entries currently exist with the new ones, and ~ adds a zero delimiter at the end. ~ ~ In addition to setting up the entries, we also set latest-output-point to ~ the start of the label-loop buffer here. This needs to happen at the start ~ of each pass, so although it doesn't quite fit the name, we do it here. ~ ~ It requires the header to have already been initialized; in particular it ~ requires the label-loop buffer start pointer to be valid. : create-hex-output-metadata-top-of-file-entries transformation-state transformation-state-output-metadata @ dup hex-output-metadata-label-loop-buffer-start @ swap hex-output-metadata-first-entry ~ (label buffer start, metadata output point) ~ This likely won't affect anything, because every call to pack* ~ overwrites it, but we initialize the latest output point to the start of ~ the label loop buffer here. That way, in the event the very first thing in ~ the output is something that's supposed to have a magic comment on it, ~ hex-tilde-replacement will know where to attach the metadata entry. ~ ~ If that was word soup, go read about hex-tilde-replacement and ~ hex-tilde-alternate and come back. :) over transformation-state transformation-state-output-metadata @ hex-output-metadata-latest-output-point ! 0 has-non-space-this-input-line! over 0 hex-output-metadata-entry-type-line-comment s" This file is a commented hexadecimal representation of a compiled" pack-hex-output-metadata-entry over 0 hex-output-metadata-entry-type-line-comment s" program, the output of Evocation's hex transform. The comments are" pack-hex-output-metadata-entry over 0 hex-output-metadata-entry-type-line-comment s" intended to allow a human reader to audit it. You can convert it to a" pack-hex-output-metadata-entry over 0 hex-output-metadata-entry-type-line-comment s" runnable executable by piping it through the program named 'hex' and" pack-hex-output-metadata-entry over 0 hex-output-metadata-entry-type-line-comment s" chmodding the output 755. The difference between a source and a binary" pack-hex-output-metadata-entry over 0 hex-output-metadata-entry-type-line-comment s" is comments! Enjoy. :)" pack-hex-output-metadata-entry over 0 hex-output-metadata-entry-type-blank-line 0 pack-hex-output-metadata-entry 0 swap ! ~ End-of-entries delimiter drop ; : hex-self-codeword-alternate self-codeword ; : hex-string-alternate ~ The technique we use to wrap s" is analogous to how we do it in the ~ label transform, but with one critical decision different. ~ ~ In the label transform, the output buffer is going to be written ~ directly into the final executable at some point, and we'd really rather ~ not scribble temporary values into it, even if we expect to overwrite them ~ later. Additionally, everything the label transform does runs inside the ~ label loop, so the code it's transforming isn't expected to do any sort of ~ miscellaneous setup things, just define a bunch of words. In that ~ situation, making sure to use temporary space from the outer, "real" log ~ is helpful. ~ ~ In the hex transform, most of that is different. The output buffer will ~ include all sorts of things that don't become part of the final ~ executable, though they're used in producing it. So, it's fine to use it ~ for scratch space. Additionally, using the outer log for string literals ~ gets us into trouble, since some of these temporary strings need to be ~ made more durable by calling allocate-string on them. If we do that with ~ a string pointer backed by the outer log, the inner "here" will wind up ~ pointing to the end of the outer log, and all sorts of things will start ~ scribbling atop each other. ~ ~ We do still benefit from using the interpreted version of s" rather than ~ the compiled one; as with the label transform, it's convenient to handle ~ the litstring dance ourselves. ~ ~ If we're in compile mode, we have reinvented a problem which the ~ regular, non-transformed s" already deals with: The temporary space we're ~ writing to is in the same place as the code we're compiling. We solve it ~ the same way: Check beforehand and write out the call to litstring if we ~ need it, so that we won't have to slide things around later. interpreter-flags @ 0x01 & { ~ We look up the inner version of litstring to reference here. This is ~ similar to what the label transform does, except we don't use a label ~ for it. s" litstring" find entry-to-execution-token , } if ~ Now, regardless of what mode we're actually in, call the interpreted ~ version of s" to read the actual string and its null terminator. interpreter-flags @ ' s" entry-to-execution-token [ ' [ entry-to-execution-token , ] execute swap interpreter-flags ! ~ Now we have a string pointer on the stack at transform time. If we're in ~ immediate mode, that's sufficient. If we're in compile mode, we also ~ already output a litstring invocation, and the string is in the right ~ place, but "here" is pointing before it and needs to point after it, then ~ we also still need to add alignment padding. Plus, we need to be sure to ~ not leave the string pointer itself on the stack. interpreter-flags @ 0x01 & { dup stringlen 1+ + 8 packalign here ! } if ; make-immediate : hex-dot-string-alternate ' hex-string-alternate entry-to-execution-token execute interpreter-flags @ 0x01 & { ~ We look up the inner version of emitstring, too. s" emitstring" find entry-to-execution-token , } { emitstring } if-else ; make-immediate : hex-create-alternate create ; ~ This is a helper called from the patched version of "variable", described ~ in more detail in hex-colon-alternate, below. It expects to be called after ~ outputting the entry header for "variable", during the body of the ~ definition, so that it can output compiled code which will run as part of ~ the transformed "variable". ~ ~ The helper accepts a string pointer giving a variable name. The code it ~ produces checks the name of the variable being defined and, if the two names ~ match, alters the resulting inner variable to point to the same backing ~ store as the outer variable of the same name. ~ ~ In many ways the hex transform is the trippiest one. To wit, there's two ~ layers of compilation happening here... so don't get confused. When the ~ helper is called, we're compiling the inner "variable", but "variable" ~ itself is a word-defining word which also has the task of compilation... ~ which we're modifying. ~ ~ (name pointer --) : hex-variable-use-outer ~ The actual payload here is that we check whether we're defining the ~ word described by the name pointer we were given, and, if so, we make it ~ reference the outer backing store instead of the inner one. ~ ~ We want to do this all as references to inner words, which fortunately ~ have been defined by now, but we have to do that a bit indirectly... s" dup" find entry-to-execution-token , s" litstring" find entry-to-execution-token , here @ over packstring 8 packalign here ! s" stringcmp" find entry-to-execution-token , s" lit" find entry-to-execution-token , 0 , s" =" find entry-to-execution-token , ~ Also, we don't have high-level flow control yet, and even if we did, ~ it would be awkward to use it here. So we count the branch by hand. Ah ~ well. As always, remember that with forward branches, the offset to ~ branch by is the first word to be skipped, and is included in the count. s" 0branch" find entry-to-execution-token , 6 8 * , ~ If control reaches here in the generated code, the string matched. s" swap" find entry-to-execution-token , s" drop" find entry-to-execution-token , ~ To get the value of the outer variable, we just call it. Of course, ~ looking up an outer entry is a pain, but at least it's a pain in a way ~ that should be familiar by now. s" lit" find entry-to-execution-token , swap-transform-variables find swap-transform-variables entry-to-execution-token execute , s" swap" find entry-to-execution-token , ; ~ This is a helper used by postprocess-metadata-entries, below. It ~ duplicates the entry it's given, creating a second identical copy ~ immediately after it in the entry array, sliding everything else forward to ~ make room. ~ ~ (entry pointer --) : dup-metadata-entry ~ Find all the remaining entries, and the final terminator, and slide ~ them forward by the length of one entry. dup dup ~ (entry pointer, entry pointer, entry pointer) { dup @ } { hex-output-metadata-next-entry } while 8 + ~ (entry pointer, entry pointer, entry array end pointer) swap - ~ (entry pointer, entry array tail length) swap dup hex-output-metadata-next-entry 3roll ~ (entry pointer, adjusted entry pointer, entry array tail length) memmove ; ~ This is a helper used by postprocess-metadata-entries, below. It swaps ~ the contents of the entry it's given with the contents of the entry ~ immediately after it in the entry array. ~ ~ (entry pointer --) : swap-metadata-entries ~ Copy the current entry to a scratch area. dup dup dup hex-output-metadata-next-entry swap - ~ (entry pointer, entry pointer, entry length) swap-transform-variables here @ swap-transform-variables swap ~ (entry pointer, entry pointer, scratch pointer, entry length) memcopy ~ (entry pointer) ~ Copy the next entry over the current entry. dup dup hex-output-metadata-next-entry dup ~ (entry pointer, entry pointer, next entry pointer, next entry pointer) 3roll - ~ (entry pointer, next entry pointer, entry length) 2 pick swap ~ (entry pointer, next entry pointer, entry pointer, entry length) memcopy ~ (entry pointer) ~ Copy the scratch area over the next entry. dup hex-output-metadata-next-entry dup ~ (entry pointer, next entry pointer, next entry pointer) 3roll - ~ (next entry pointer, entry length) swap-transform-variables here @ swap-transform-variables 3unroll ~ (scratch pointer, next entry pointer, entry length) memcopy ; ~ Metadata entries are post-processed before they're output, in order to ~ make the structure of the output code simpler. The post-processing won't ~ happen until output actually occurs, which is important for operations that ~ modify entries in-place. ~ ~ Any time output is performed, all existing entries are post-processed. ~ Therefore, the post-processing is required to be idempotent, and is. : postprocess-metadata-entries 1 { } { 0 ~ (did anything this iteration) transformation-state transformation-state-output-metadata @ hex-output-metadata-first-entry { dup @ } { ~ (did anything, entry pointer) ~ Is the entry a suffix comment with a non-zero data length? dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-suffix-comment = over hex-output-metadata-entry-data-length @ 0 != && { ~ Split it into two entries so as not to rely on data length for ~ formatting. dup dup-metadata-entry ~ (did anything, entry pointer) ~ Now we have the original entry at the original location, and a copy ~ of it at the next location. ~ We have a feature which lets a suffix comment be created with a ~ negative length, which means it covers bytes before the current output ~ point rather than after it. This logic here is the implementation of ~ that feature. dup hex-output-metadata-entry-data-start @ dup 2 pick hex-output-metadata-entry-data-length @ + 2dup min 3unroll max ~ (..., entry pointer, low end of data, high end of data) ~ Now we modify the original in-place to turn it into a fresh-line ~ entry at the low end of the data... 2 pick hex-output-metadata-entry-type hex-output-metadata-entry-type-fresh-line swap ! ~ (..., entry pointer, low end of data, high end of data) 2 pick hex-output-metadata-entry-data-start 3roll swap ! ~ (..., entry pointer, high end of data) over hex-output-metadata-entry-data-length 0 swap ! ~ (..., entry pointer, high end of data) ~ ... then we modify the next entry in-place to set its location to ~ the end of the data instead of the beginning, and its length to zero. over hex-output-metadata-next-entry ~ (..., entry pointer, high end of data, next entry pointer) dup hex-output-metadata-entry-data-start 3roll swap ! ~ (..., entry pointer, next entry pointer) hex-output-metadata-entry-data-length 0 swap ! ~ (..., entry pointer) ~ This rule won't fire again on the fresh-line entry because it's of a ~ a different type, and it won't fire on the modified suffix-comment ~ entry because its data length is zero. ~ ~ It's possible that one or the other of the bubble-sort rules will ~ fire on either of them. ~ (did anything, entry pointer) swap drop 1 swap } if ~ (did anything, entry pointer) ~ Do this entry and the next entry both exist, and they're out of ~ order based on their data starts? dup hex-output-metadata-next-entry dup @ { hex-output-metadata-entry-data-start @ over hex-output-metadata-entry-data-start @ > } { drop 0 } if-else { ~ Swap the order of the two entries. Since this whole thing is in a ~ loop, this functions as a bubble sort. dup swap-metadata-entries swap drop 1 swap ~ This rule won't fire again on the same pair of entries because now ~ they're in the correct order. It may fire again next iteration, ~ but only until everything is sorted. ~ ~ This rule does nothing to alter whether the suffix-comment rule ~ will fire on either of the entries it swapped, so there's no ~ possibility of an infinite loop through that one. } if ~ (did anything, entry pointer) ~ Do this entry and the next entry both exist, and they have the same ~ data start, and this one is a comment entry, and the next one is a ~ stack-manipulation entry with zero length? dup is-comment-entry over hex-output-metadata-next-entry @ && { ~ (did anything, entry pointer) dup hex-output-metadata-next-entry over hex-output-metadata-entry-data-start @ over hex-output-metadata-entry-data-start @ = swap dup hex-output-metadata-entry-data-length @ 0 = 3roll && swap is-subitem-stack-manipulation-entry && } { 0 } if-else { ~ Swap the order of the two entries. Since this whole thing is in a ~ loop, this functions as a bubble sort. dup swap-metadata-entries swap drop 1 swap ~ This rule can't fire in the same iteration as the previous swap, ~ because that one doesn't fire when the starts are equal. It also ~ won't fire again on the same pair of entries, again because now ~ they're in the correct order. If it fires again in the next ~ iteration that'll only be in the usual way it does for a bubble ~ sort. ~ ~ As with the other swap rule, this rule also does nothing to alter ~ whether the suffix-comment rule will fire on either entry it ~ touches, so it won't loop through that one. } if ~ (did anything, entry pointer) hex-output-metadata-next-entry } while drop } while ; ~ (string pointer --) : hex-emit-template-string { unpack8 dup } { dup is-space { ~ Output space characters as we reach them, there's no need to do ~ anything fancy. value@ emitstring drop } { ~ (input point, first word character) ~ We use the outer log's scratch space to accumulate each word in. swap-transform-variables here @ swap-transform-variables swap pack8 swap ~ (scratch output point, input point) ~ Scan forward and find a space-separated word. { unpack8 dup dup is-space not && } { ~ (scratch output point, adjusted input point, next character) 3roll swap pack8 swap ~ (adjusted scratch output point, adjusted input point) } while ~ (scratch output point, input point, first non-word character or 0) 3roll 0 pack8 drop ~ (input point, first non-word character or 0) swap-transform-variables here @ swap-transform-variables ~ (input point, first non-word character or 0, word pointer) dup s" #" stringcmp 0 = { ~ (input point, first non-word character or 0, word pointer) drop pop-subitem-entry-stack ~ If we underflowed the stack, we got zero back, so make sure not to ~ crash. A crash here would be a pain to debug because it would be ~ unclear how much of the overall system is working, and it's a ~ complex system. dup { dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-push-subitem-decimal = { dup hex-output-metadata-entry-content @ . } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-push-subitem-hex = { ." 0x" dup hex-output-metadata-entry-content @ .hex } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-push-subitem-hex8 = { ." 0x" dup hex-output-metadata-entry-content @ .hex8 } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-push-subitem-hex16 = { ." 0x" dup hex-output-metadata-entry-content @ .hex16 } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-push-subitem-hex32 = { ." 0x" dup hex-output-metadata-entry-content @ .hex32 } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-push-subitem-hex64 = { ." 0x" dup hex-output-metadata-entry-content @ .hex64 } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-push-subitem-string = { dup hex-output-metadata-entry-content @ emitstring } if } if ~ Tidy up. We want to treat the next character normally, so we ~ return a zero to indicate that. drop 0 } { ~ (input point, first non-word character or 0, word pointer) ~ Here as well, we want to treat the next character normally, so ~ we return zero. emitstring 0 } if-else ~ (input point, first non-word character or 0, should ignore space) over { ~ If the character is non-zero, it's a space, so it can't be part of ~ a word, so we can output it... unless we were asked to skip it, ~ of course. not { value@ emitstring } if drop } { ~ If this is the end of the string, we can discard the 0, but then ~ we need to nudge the input point back so the loop will terminate. drop drop 1- } if-else ~ (input point) } if-else } while drop drop ; ~ (string pointer --) : hex-emit-comment ." ~" dup @ { space } if hex-emit-template-string ; ~ This "replacement" is a little different from an alternate: When the code ~ under transformation attempts to compile its own version of sys-write, it ~ gets a stub that calls this word instead. It's swapped out by ~ hex-colon-alternate, whereas the regular alternates are swapped out by ~ hex-transform-one. ~ ~ In the programs we're actually running the transform on, there's only ever ~ a single call to sys-write which is the whole binary in one go, but we don't ~ want to require that, so we keep all the formatting state in the output ~ metadata header. ~ ~ (length to write, base address --) : hex-sys-write-replacement ~ In intended operation, the code under transformation is a compilation ~ process, and it won't output anything that isn't executable binary. ~ However, while developing, it's common to have crashes, and it's nice to ~ get the crash dump as ASCII rather than hex. dup is-in-label-loop-buffer not { sys-write exit } if postprocess-metadata-entries ~ Importantly, postprocessing leaves the entries sorted, which means we ~ can go back and forth in a linear scan through the entry array while we ~ also do a linear scan of the output data. It's fiddly, but we can't afford ~ to be O(n^2) here, it adds up to quite a lot of runtime. transformation-state transformation-state-output-metadata @ hex-output-metadata-first-entry ~ (length to write, base address, initial metadata scan pointer) { 2 pick 0 <= } { ~ (length remaining, current output address, metadata scan pointer) ~ Keep inspecting entries as long as the output address is greater than ~ or equal to the entry address. If we're looking at the entries that come ~ before the output, this will scan through all of them first, then ~ eventually catch up. Since the scan pointer is kept across iterations, ~ it's important we not go beyond that point. { dup @ dup ~ (length remaining, current output address, metadata scan pointer, ~ entry's first field, entry's first field) { ~ This is an nop, but for clarity's sake it's best to not depend on ~ details of the structure layout that perhaps not everyone has ~ memorized... ~ ~ To get into this block, we tested for the array end indicator, but ~ now that we know we have an entry here, we're looking at its ~ contents. hex-output-metadata-entry-data-start dup 3 pick ~ (length remaining, current output address, metadata scan pointer, ~ entry's data start, entry's data start, current output address) >= swap drop } if } { dup @ 2 pick = { ~ We found a matching metadata entry. ~ (length remaining, current output address, metadata scan pointer) dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-line-comment = { fresh-line indentation-depth@ dup indent advance-current-column dup hex-output-metadata-entry-content @ hex-emit-comment newline 1 is-fresh-line! 0 current-column! } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-suffix-comment = { 40 current-column@ - 1 max indent dup hex-output-metadata-entry-content @ hex-emit-comment newline 1 is-fresh-line! 0 current-column! } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-fresh-line = { fresh-line 1 is-fresh-line! 0 current-column! } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-blank-line = { fresh-line newline 1 is-fresh-line! 0 current-column! } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-indent = { dup hex-output-metadata-entry-content @ indentation-depth@ + indentation-depth! } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-string-literal = { fresh-line indentation-depth@ dup indent advance-current-column ." ~ String literal with null terminator: " 0x22 value@ emitstring drop dup hex-output-metadata-entry-content @ emitstring 0x22 value@ emitstring drop newline 1 is-fresh-line! 0 current-column! } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-raw-string-literal = { fresh-line indentation-depth@ dup indent advance-current-column ." ~ String literal with no terminator: " 0x22 value@ emitstring drop dup hex-output-metadata-entry-content @ emitstring 0x22 value@ emitstring drop newline 1 is-fresh-line! 0 current-column! } if dup is-push-subitem-entry { dup push-subitem-entry-stack } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-drop-subitem = { pop-subitem-entry-stack drop } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-swap-subitems = { ~ If we underflow the stack, we'll get zeroes back here. In order ~ to avoid causing more confusing problems later, we make sure to ~ discard the zeroes instead of pushing them. Just like in ~ hex-emit-template-string, the reasoning is that it's easier to ~ diagnose what's wrong with this subsystem when it runs to ~ completion. pop-subitem-entry-stack pop-subitem-entry-stack swap dup { push-subitem-entry-stack } { drop } if-else dup { push-subitem-entry-stack } { drop } if-else } if dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-roll-subitems = { ~ The parameter giving the amount to roll by is in the content ~ field. dup hex-output-metadata-entry-content @ ~ (... amount to roll by) ~ We resist the temptation to do the memcopy math. We don't need ~ to, since the regular Forth roll and unroll do it for us. dup 0 < { ~ In this scenario, we're rolling. The amount to roll by is also ~ the number of items. 0 { 2dup < } { pop-subitem-entry-stack 3unroll 1+ } while drop ~ (... items, amount to roll by / number of items) ~ Please notice that the items we have popped from the subitem ~ entry stack are now, on the value stack, in the reverse of the ~ order they were on the entry stack. They will reverse again when ~ we push them back. ~ ~ The amount to roll by is positive, so the desired operation is ~ a regular roll. Since the entries are reversed right now, we ~ unroll them, which will be what we want when we put them back. ~ ~ Try it out interactively with a toy example and convince ~ yourself. It's hard to really model in your head, but it's true. ~ The intuition is that, if you're looking at the value stack, ~ the bottommost item there will be the topmost one after ~ re-reversing, so we think of our operations as proceeding ~ up-stack from there, instead of the usual operations that start ~ at the topmost item and proceed downwards. ~ ~ Anyway, this little trick does a regular unroll, which acts as ~ a roll, and keeps the value around. dup 3unroll 1+ unroll } if ~ (... items if positive, amount to roll by) ~ We did the positive case first, which means the amount to roll ~ by is still its original value, regardless of whether that case ~ ran or not. So, we can check if it's negative to see if we need ~ to do the negative case. dup 0 > { ~ In this scenario, we're unrolling. We negate the amount to ~ roll by to get the amount to unroll by, which is also the number ~ of items. negate 0 { 2dup < } { pop-subitem-entry-stack 3unroll 1+ } while drop ~ (... items, number of items) ~ The parameter was negative, so we were asked to do an unroll. ~ This trick does a roll, and keeps the value. Notice that "roll" ~ always needs a positive amount. dup 1+ roll swap } if ~ (... items, number of items) ~ Now, regardless of which case ran, we have the items and we have ~ a non-negative count of them. Notice that if we were asked to roll ~ by zero, neither case ran, but that still describes what we have ~ accurately. ~ Now we push them back. 0 { 2dup < } { 3roll ~ Again, if we underflowed we got zeros, and we discard them. dup { push-subitem-entry-stack } { drop } if-else 1+ } while drop drop } if } if hex-output-metadata-next-entry } while ~ (length remaining, current output address, metadata scan pointer) 2 pick { is-fresh-line@ { indentation-depth@ dup indent advance-current-column } { space 1 advance-current-column } if-else over 8@ .hex8 2 advance-current-column 0 is-fresh-line! } if ~ (length remaining, current output address, metadata scan pointer) 3unroll 1+ swap 1- swap 3roll } while drop ; ~ (data start, data length --) : hex-pack-trace ~ We keep a running tally of the next address in the output, for the ~ benefit of hex-tilde-replacement, which needs to know where to attach its ~ metadata entries. + dup is-in-label-loop-buffer { transformation-state transformation-state-output-metadata @ hex-output-metadata-latest-output-point ! } { drop } if-else ; ~ (output point, string pointer --) : hex-packstring-trace dup stringlen 1+ ~ (output point, string pointer, string length) 2 pick over hex-pack-trace swap ~ (output point, string length, string pointer) drop over hex-output-metadata-entry-type-string-literal swap add-hex-output-metadata-entry ; ~ The purpose of this word is to make sure that the memory-sliding ~ techniques used by the high-level flow control words are appropriately ~ reflected in the output metadata. This is accomplished by finding all ~ entries whose data start pointer or string content pointer is within the ~ slid region, and adjusting the relevant pointer appropriately. ~ ~ Notice that this strategy means there's no metadata entry describing the ~ old location of the slid memory, though sliding is non-destructive. The ~ assumption is that that location is going to be overwritten with new code, ~ which will have its own metadata entries created as the new code is written. ~ Otherwise, since we don't do anything to erase metadata entries pertaining ~ to overwritten locations, old and new metadata entries would overlap and ~ cause confusion. The assumption is correct for all existing uses of ~ memory-sliding as of the time this was written, but it's possible it will ~ need to be revisited someday. ~ ~ This word is called for both memcopy and memmove. It's called by ~ hex-memory-slide-replacement, which is itself installed by a variety of ~ means for different situations; see its documentation for more detail. ~ ~ (source, destination, length --) : hex-memory-slide-trace 2 pick is-in-label-loop-buffer 2 pick is-in-label-loop-buffer && { ~ At the time this runs, the metadata entry array isn't sorted, so we ~ check the whole thing. transformation-state transformation-state-output-metadata @ hex-output-metadata-first-entry ~ (source, destination, length, initial metadata scan pointer) { dup @ } { ~ (source, destination, length, metadata scan pointer) dup hex-output-metadata-entry-data-start @ 4 pick <= ~ (source, destination, length, metadata scan pointer, lower bound okay) over hex-output-metadata-entry-data-start @ 5 pick 4 pick + > && { ~ (source, destination, length, metadata scan pointer) dup hex-output-metadata-entry-data-start @ 4 pick - 3 pick + over hex-output-metadata-entry-data-start ! } if dup hex-output-metadata-entry-type @ dup hex-output-metadata-entry-type-string-literal = swap hex-output-metadata-entry-type-raw-string-literal = || { dup hex-output-metadata-entry-content @ ~ (source, destination, length, scan pointer, content pointer) dup 5 pick <= ~ (source, destination, length, scan pointer, content pointer, ~ lower bound okay) over 6 pick 5 pick + > && { ~ (source, destination, length, scan pointer, content pointer) 4 pick - 3 pick + over hex-output-metadata-entry-content ! } { drop } if-else } if hex-output-metadata-next-entry } while 4 ndrop } { drop drop drop } if-else ; ~ By overriding colon, we can special-case the definitions of particular ~ words. It's very metacircular. ~ ~ This lets us prepend trap code to the original definition. For those not ~ familiar, a "trap" in systems programming is code that runs instead of some ~ other, pre-existing code, by violating the usual abstractions in some way. ~ We implement our traps by creating the word header, including the docol ~ pointer, then compiling the trap code before we return from the colon ~ alternate, so that it's already been output before the original word's body ~ starts to compile. ~ ~ Prepending our trap code to the original code like this can also be used ~ to get the effect of replacing the original code entirely by calling "exit" ~ at the end of our trap. The original code will still be compiled, after the ~ trap code, but doing this will make sure it doesn't run. Most of the time, ~ though, we do want to run the original code, so we allow the trap to fall ~ through to it. We carefully note fall-through with comments, to make the ~ traps easier to maintain. ~ ~ The kinds of side-effects we care about can all be written this way, ~ though occasionally we wind up having to compute an intermediate value that ~ the code we're trapping will then compute independently, and it's important ~ to keep those implementations in sync. ~ ~ The most significant challenge is that, because our trap will be defined ~ at the same point in loading as the original word would be, it can only use ~ words that are available at that point. Occasionally this results in some ~ awkwardness. ~ ~ Code for these traps winds up looking a lot like code written for log-load ~ alternates, in that we have to do the dictionary lookups and other ~ compilation ourselves. ~ ~ At times, we also need to trap words that are implemented in assembler. ~ The most notable of these is "sys-write", which is fundamental to what the ~ hex transform does. The details of how we make our traps work with assembler ~ words are explained below, as they arise. : hex-colon-alternate word value@ ~ The word "variable" is itself a word-defining word, and we will ~ special-case its definition to special-case the definitions of particular ~ variables. It's very very metacircular. dup s" variable" stringcmp 0 = { ~ Don't lose track of the layering happening here. The word "variable" ~ is a regular docol word; it's defining a word that's implemented in ~ assembly, but it can use whatever Forthy logic it wants to do so. In ~ this case we're going to have it run a little extra logic, then continue ~ with the rest of its usual definition. ~ Before we get to the extra logic, we do want an entry header for ~ "variable" itself, so we do that... This takes care of all of colon's ~ responsibilities except switching to compile mode; we'll do that part ~ after we've output our payload. create dropstring s" docol" find entry-to-execution-token execute , make-hidden ~ There's two variables that we want to point to the outer backing ~ stores, rather than the inner ones. The code for that is a bit ~ repetitive, so we have a helper for it; see above. ~ ~ It is worth stopping to contemplate the meaning of sharing these two ~ variables in particular between the inner and outer contexts. ~ Essentially this says that they're both reading the same input stream, ~ and the two copies of the interpreter both share the same state. Thus, ~ trading off responsibility for lexing between inner and outer contexts ~ works just like trading off responsibility between two interpreters ~ when there's no transformation involved, or between a regular ~ interpreter and a transform. ~ ~ If we didn't do this, we'd still have to invent some way to control ~ what input the inner context sees, and the concept of "the next ~ character" would become more complex during the transform and require ~ care and attention. Sharing this stuff keeps it simple. s" interpreter-flags" hex-variable-use-outer s" main-input-buffer" hex-variable-use-outer ~ After this, we can return control to the regularly-scheduled ~ "variable", which will do the "create" and all that. That stuff isn't ~ colon's responsibility, so it isn't our responsibility, it'll happen ~ regardless. ~ Notably, we do NOT share transformation-state. There are at least a ~ hundred places where it would need to be carefully swapped, and we ~ already have quite enough of that kind of brittleness in the log-load ~ transform. Plus, there's no obvious way to do a real push/pop notion for ~ it, so we wouldn't get arbitrary nesting of transforms anyway. By ~ letting the code inside the hex transform have its own, separate copy of ~ transformation-state, we avoid that problem entirely, and it's still not ~ hard to access the "other" one when circumstances require. ~ Now we close out colon's responsibilities by switching to compile ~ mode. We return from colon after this. The hex transform will continue ~ by processing the source words that form the regular body of "variable", ~ eventually hitting the matching semicolon. Our friendly tampering is ~ now complete! ' ] entry-to-execution-token execute exit } if ~ Now we want to override s". As usual, that's the single most annoying ~ string to quote, so we cheat. dup ' s" entry-to-name stringcmp 0 = { ~ Create the word header. It's a normal docol word, so that much is ~ simple. create dropstring s" docol" find entry-to-execution-token execute , make-hidden ~ This time around we would really rather just always use the alternate, ~ which already untangles the layered nonsense. So we have the payload ~ call the alternate directly, then exit. We could come up with a way to ~ then skip forward in the code under transformation, but that would be ~ complex, and it's unnecessary: We let it keep running, outputting the ~ usual body of s", which we know will never be reached. ' hex-string-alternate entry-to-execution-token , s" exit" find entry-to-execution-token , ~ As before, finish up colon's responsibilities, then return control to ~ the code under transformation. ' ] entry-to-execution-token execute exit } if ~ Same deal for .". Hey, we're getting good at this! dup ' ." entry-to-name stringcmp 0 = { create dropstring s" docol" find entry-to-execution-token execute , make-hidden ' hex-dot-string-alternate entry-to-execution-token , s" exit" find entry-to-execution-token , ' ] entry-to-execution-token execute exit } if ~ We want to suppress the behavior of relink-main-input-buffer-to-stdin ~ entirely. Happily, that's easy. We need to do this because otherwise the ~ transformed code will mess with our outer interpreter! dup s" relink-main-input-buffer-to-stdin" stringcmp 0 = { create dropstring s" docol" find entry-to-execution-token execute , make-hidden ~ Return before doing anything. s" exit" find entry-to-execution-token , ' ] entry-to-execution-token execute exit } if ~ We are entirely replacing sys-write with our own version. It's an ~ assembly word, and we're replacing it with a Forth word, so there's some ~ matching code in the ;asm alternate that makes sure to not mess that up. dup s" sys-write" stringcmp 0 = { create dropstring s" docol" find entry-to-execution-token execute , make-hidden ' hex-sys-write-replacement entry-to-execution-token , s" exit" find entry-to-execution-token , ' ] entry-to-execution-token execute exit } if ~ Now we have a bunch of patches that keep track of output metadata. These ~ are all Forth words, nothing too complicated about the actual patching. dup s" reset-labels" stringcmp 0 = { create dropstring s" docol" find entry-to-execution-token execute , make-hidden ~ This is only ever called in one place, the end of a failed iteration ~ of label-loop. We need to reinitialize all the metadata entries whenever ~ that happens, and reset-labels is a good semantic match for that ~ behavior, so it's a good place for the hook. ' create-hex-output-metadata-top-of-file-entries entry-to-execution-token , ~ Fall through to the inner implementation. ' ] entry-to-execution-token execute exit } if dup s" packstring" stringcmp 0 = { create dropstring s" docol" find entry-to-execution-token execute , make-hidden ~ (output point, string pointer) s" 2dup" find entry-to-execution-token , ~ This one's a lot of work, so we defer to a single-purpose word. ' hex-packstring-trace entry-to-execution-token , ~ Fall through to the inner implementation. ' ] entry-to-execution-token execute exit } if ~ This is highly similar to packstring. dup s" pack-raw-string" stringcmp 0 = { create dropstring s" docol" find entry-to-execution-token execute , make-hidden ~ (output point, string pointer) s" 2dup" find entry-to-execution-token , s" dup" find entry-to-execution-token , s" stringlen" find entry-to-execution-token , ~ (output point, string pointer, string length NOT including terminator) ~ Before we add the metadata entry, we also want to call hex-pack-trace ~ to make sure latest-output-point gets adjusted for the string. ~ Otherwise, we'd see magic comments in the wrong place. s" 3roll" find entry-to-execution-token , s" dup" find entry-to-execution-token , s" lit" find entry-to-execution-token , 4 , s" unroll" find entry-to-execution-token , s" swap" find entry-to-execution-token , s" dup" find entry-to-execution-token , s" 3unroll" find entry-to-execution-token , ~ (output point, string pointer, string length NOT including terminator, ~ output point, string length NOT including terminator) ' hex-pack-trace entry-to-execution-token , ~ (output point, string pointer, string length including terminator) s" swap" find entry-to-execution-token , ' hex-output-metadata-entry-type-raw-string-literal entry-to-execution-token , s" swap" find entry-to-execution-token , ' add-hex-output-metadata-entry entry-to-execution-token , ~ (output point, string pointer) ~ Fall through to the inner implementation. ' ] entry-to-execution-token execute exit } if dup s" pack8" stringcmp 0 = { create dropstring s" docol" find entry-to-execution-token execute , make-hidden ~ We can't use over because this patch happens at the time pack8 is ~ being defined, and it would be a forward reference. We do the equivalent ~ by hand. ~ (output point, value) s" swap" find entry-to-execution-token , s" dup" find entry-to-execution-token , s" 3unroll" find entry-to-execution-token , ~ (output point, value, output point) s" lit" find entry-to-execution-token , 1 , ' hex-pack-trace entry-to-execution-token , ~ Fall through to the inner implementation. ' ] entry-to-execution-token execute exit } if ~ Extremely similar to the pack8 patch. dup s" pack16" stringcmp 0 = { create dropstring s" docol" find entry-to-execution-token execute , make-hidden ~ We can't use over because this patch happens at the time pack8 is ~ being defined, and it would be a forward reference. We do the equivalent ~ by hand. ~ (output point, value) s" swap" find entry-to-execution-token , s" dup" find entry-to-execution-token , s" 3unroll" find entry-to-execution-token , ~ (output point, value, output point) s" lit" find entry-to-execution-token , 2 , ' hex-pack-trace entry-to-execution-token , ~ Fall through to the inner implementation. ' ] entry-to-execution-token execute exit } if ~ Extremely similar to the pack8 patch. dup s" pack32" stringcmp 0 = { create dropstring s" docol" find entry-to-execution-token execute , make-hidden ~ We can't use over because this patch happens at the time pack8 is ~ being defined, and it would be a forward reference. We do the equivalent ~ by hand. ~ (output point, value) s" swap" find entry-to-execution-token , s" dup" find entry-to-execution-token , s" 3unroll" find entry-to-execution-token , ~ (output point, value, output point) s" lit" find entry-to-execution-token , 4 , ' hex-pack-trace entry-to-execution-token , ~ Fall through to the inner implementation. ' ] entry-to-execution-token execute exit } if ~ Extremely similar to the pack8 patch. dup s" pack64" stringcmp 0 = { create dropstring s" docol" find entry-to-execution-token execute , make-hidden ~ We can't use over because this patch happens at the time pack8 is ~ being defined, and it would be a forward reference. We do the equivalent ~ by hand. ~ (output point, value) s" swap" find entry-to-execution-token , s" dup" find entry-to-execution-token , s" 3unroll" find entry-to-execution-token , ~ (output point, value, output point) s" lit" find entry-to-execution-token , 8 , ' hex-pack-trace entry-to-execution-token , ~ Fall through to the inner implementation. ' ] entry-to-execution-token execute exit } if ~ If no special case matches, we fall back to just being a regular colon. ~ We already read the word name above, so we have to do the rest of the ~ steps ourselves as well. create dropstring s" docol" find entry-to-execution-token execute , make-hidden ' ] entry-to-execution-token execute ; ~ This word gets installed as a trap at the beginning of every Forth word, ~ so that it can examine the control stack and produce kinds of metadata that ~ require information that only exists at runtime. See ~ hex-semicolon-alterante, below, for details of how it's installed. ~ ~ It is worth noting that hex-trap can coexist with the more-targeted traps ~ installed by hex-colon-alternate, above. It runs before them, because ~ hex-colon-alternate prepends its stuff first and then ~ hex-semicolon-alternate slides that all forward to prepend the call to ~ hex-trace. ~ ~ TODO this probably doesn't serve a purpose in the end, and should go away, ~ but the actual stack-walking code is useful and should be kept until it's ~ been refactored into something worth keeping. : hex-trace exit ~ value@ here @ swap 0 hex-output-metadata-entry-type-line-comment ~ add-hex-output-metadata-entry newline ~ This stack-walking code is modeled off the code in list-callers, in ~ dynamic.e. ~ ~ This is the bit of the hex transform where all the memory-management ~ assumptions are in play at once, so, in understanding it, it's probably ~ a good idea to skim back over the background described under "hex ~ transform implementation", above, and make sure it's fresh in your mind. ~ ~ It's important to notice that, as we walk it, the values of "here" and ~ "latest" reflect the log and dictionary of the code being transformed, ie. ~ they are the ones in the output buffer, not the log and dictionary of the ~ outer program. Therefore, we can use containing-entry to find the entry ~ headers for words inside the transform, and if we want to look at words ~ outside the transform we can wrap containing-entry in ~ swap-transform-variables. We can't use is-in-log, though, because the ~ label-loop buffer is inside the output buffer, which is inside the outer ~ log, so it doesn't make the distinctions we need it to. ~ ~ Every word inside the transform will have hex-transform-one exactly once ~ in its call chain, so we walk the control stack only up to that point. control@ { ~ First, check to make sure we haven't run off the bottom of the control ~ stack. Remember, the control stack is an array of pointers, so this is a ~ simple bounds check. dup r0 @ > ~ If it is, we also want to look at what it points to. dup { ~ Dereference the pointer we've been iterating (... we're actually ~ looking at a pointer to a pointer ...), and check that it's not inside ~ hex-transform-one's body. drop dup @ ~ The inner dictionary is inside the outer log, so we'll get an entry ~ header regardless of which dictionary we consider, but it may not be ~ the one we care about. If we want to get the correct entry pointer, we ~ have to make sure we're looking at the outer dictionary. swap-transform-variables ~ Check what entry the control pointer is in. containing-entry ~ Get the entry for hex-transform-one to compare against. This would ~ be a forward reference, so we need to look it up at runtime. s" hex-transform-one" find ~ Now switch back. swap-transform-variables ~ If they're equal, we want to stop the loop. != } if } { dup @ ~ TODO this isn't in quine.asm, so if we keep this code at all, that needs ~ to be dealt with ~ symbolize-pointer space ~ Iterate to the next pointer in the control stack. It's an array of ~ pointers, so this is just arithmetic. 8 + } while drop ; ~ We want to trace every call to a Forth word, for use in generating ~ metadata. To do this, we want to add a prefix trap to the calls, but we ~ can't put the logic in hex-colon-alternate because we don't know which ~ words are Forth words and which are assembly words until we see the ~ semicolon. ~ ~ So, we do it here in hex-semicolon-alternate. The word body has already ~ been compiled at this point, so we slide the whole body forward to make ~ room. This is explicitly allowed by our compilation model; you may be ~ aware that it's also how high-level flow control is implemented. ~ ~ You might find it useful to compare this code to the implementations of ~ high-level flow-control utilities in log-load.e; it operates under a very ~ similar set of constraints, except that fortunately we don't have the ~ nightmare multi-dictionary situation that the log-load transform does. : hex-semicolon-alternate latest @ entry-to-execution-token 8 + dup dup dup ~ (start, start, start, start) ~ The actual body of the trap is just a single word long (see below). If ~ that ever changes, make sure to keep the amount we slide by in sync with ~ it. 8 + swap ~ TODO change number of words ~ (start, start, adjusted start, start) here @ swap - ~ (start, start, adjusted start, length) memmove ~ (start) ~ We're going to use comma to append compiled code, so let's swap out the ~ value of "here" to point to the space we just opened up. here @ swap here ! ~ (old "here") ~ This applies to every single word terminated with semicolon, which is ~ all the Forth words that are created directly rather than with "variable" ~ or some similar high-level facility. Because we also can't have forward ~ references, that means we can't assume we'll have any available words in ~ the transformed code to call, at all. So, the only thing we can usefully ~ have the trap do is call a word that's defined as part of the transform. ~ ~ Fortunately, we do get to assume there will be a normal entry header in ~ place for the word we're trapping. So we don't need to scrounge up any ~ runtime data for the trap's benefit; the trap will be able to get what it ~ needs by inspecting the control stack and the log. ' hex-trace entry-to-execution-token , ~ We're done compiling the trap's contents, so swap "here" back. Again, ~ keep this in sync with the length of the trap. 8 + here ! ~ Now we do the regular semicolon stuff. [ ' ; entry-to-execution-token , ] ; make-immediate : hex-semicolon-assembly-alternate latest @ entry-to-name dup s" sys-write" stringcmp 0 = { ~ As detailed in hex-colon-alternate, above, sys-write is implemented in ~ assembly but we replace it with Forth. This logic here collaborates with ~ the logic there to make that work. ~ ~ The transformed code will still have compiled some assembly, though it ~ won't be reached and would crash, so we need to fix alignment before we ~ call semicolon. drop here @ 8 packalign here ! [ ' ; entry-to-execution-token , ] exit } if drop ~ If no special case matches, we fall back to the regular behavior. [ ' ;asm entry-to-execution-token , ] ; make-immediate ~ Because docol requires it, we provide a special mini-version of the label ~ system. We only do L@' and L!', because that's all we need. Unlike with the ~ label transform, these are NOT real labels; they're restricted similarly to ~ how they are for the log-load transform. ~ ~ Per the precedence rules in hex-transform-one, this version will apply to ~ all invocations, regardless of compile mode vs. immediate execution. ~ However, its own logic defers to the inner label system when that exists. : hex-L@'-alternate ~ If there's an inner copy of L@' defined, defer to it. s" L@'" find dup { entry-to-execution-token execute exit } { drop } if-else word dropstring transformation-state transformation-state-label-scratch @ ; make-immediate : hex-L!'-alternate ~ If there's an inner copy of L!' defined, defer to it. s" L!'" find dup { entry-to-execution-token execute exit } { drop } if-else word dropstring transformation-state transformation-state-label-scratch ! ; make-immediate ~ 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 dup allocate swap ~ (result pointer, size) transformation-state transformation-state-output-metadata @ hex-output-metadata-label-loop-buffer-length ! ~ (result pointer) dup transformation-state transformation-state-output-metadata @ hex-output-metadata-label-loop-buffer-start ! ~ (result pointer) create-hex-output-metadata-top-of-file-entries ; ~ ... 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 ~ In order to handle code that slides compiled code around, most notably the ~ high-level flow-control words, we trap memcopy and memmove. These are ~ assembly words, so trapping them with hex-colon-alternate is inconvenient; ~ instead we patch their callers. This is like the "allocate" trap, but ~ simpler. There's no special logic needed here, we just unconditionally ~ install the trap. ~ ~ This word is responsible for processing the hook. For code running ~ directly under the hex transform, it's installed by hex-memcopy-alternate ~ and hex-memmove-alternate, immediately below. For code running in a nested ~ label transform, see hex-label-word-replacement, further down. Note ~ carefully that when it's in a nested transform, the hook only runs in ~ immediate mode; running it in compile mode would affect the program being ~ compiled. ~ ~ It is worth noting that, as of the time this code was written, there is ~ never actually any memory sliding of compiled code that occurs outside of a ~ nested transform. This aligns with intuition, since sliding is really only ~ done in the high-level flow-control words. However, should it happen in the ~ future, we still want it to work, so it's implemented. ~ ~ The actual metadata handling is done by hex-memory-slide-trace, which is ~ above, near the other words that trace memory operations. We let the ~ replacement handle preserving the parameters so that the trace doesn't need ~ to, since that would be a difference between it and the other words similar ~ to it. ~ ~ (source, destination, length -- source, destination, length) : hex-memory-slide-replacement 2 pick 2 pick 2 pick hex-memory-slide-trace ; ~ These two alternates are responsible for installing ~ hex-memory-slide-replacement, immediately above, in invocations of memcopy ~ and memmove that occur directly under the hex transform. For invocations ~ that occur in nested transforms, see hex-label-word-replacement, further ~ down. : hex-memcopy-alternate interpreter-flags @ 0x01 & { ' hex-memory-slide-replacement entry-to-execution-token , s" memcopy" find entry-to-execution-token , } { hex-memory-slide-replacement s" memcopy" find entry-to-execution-token execute } if-else ; make-immediate : hex-memmove-alternate interpreter-flags @ 0x01 & { ' hex-memory-slide-replacement entry-to-execution-token , s" memmove" find entry-to-execution-token , } { hex-memory-slide-replacement s" memmove" find entry-to-execution-token execute } if-else ; make-immediate ~ Similar to how we handle "allocate" as a replacement which is installed by ~ an alternate, we do the same for tilde, but for a different reason. The ~ semantics of ordinary, non-transformed tilde skip over comment text while ~ compiling, and discard it. We need to do processing of that text later, when ~ the comment's position would be reached in running the word it's part of, so ~ the alternate compiles it appropriately. ~ ~ Importantly, the replacement is only used for comments that have a special ~ comment syntax unique to the hex transform, as described in more detail in ~ the alternate, below. If it were used for all comments, it would interfere ~ with the distance of branches, which could get quite complex to work around. ~ It is the responsibility of words that use the hex-transform comment syntax ~ to avoid placing such comments within the scope of a branch. This applies ~ only to explicit, precomputed branches using the words "branch" and ~ "branch0". Fortunately, implicit branches that are part of high-level ~ flow-control words such as "if" and "while" will work fine, since the ~ substitution occurs before the flow control words start sliding code around, ~ and it updates "here" appropriately. ~ ~ Because hex-tilde-replacement is called in various situations during ~ various phases of compilation and interpreting, it can't take responsibility ~ for knowing how the string pointer it's given is allocated. It assumes the ~ string pointer will be valid indefinitely; it's the caller's responsibility ~ to make sure of that. ~ ~ (has non-space this line, string pointer --) : hex-tilde-replacement transformation-state transformation-state-output-metadata @ hex-output-metadata-latest-output-point @ swap ~ (has non-space this line, data start, string pointer) ~ If the output wouldn't go in the label-loop buffer, don't do any of ~ this. ~ ~ That may seem spurious, but remember, the same assembly instructions ~ are used for compiling the final binary and defining words within the ~ compiler. In particular, "variable" will hit this, and there are surely ~ others. over is-in-label-loop-buffer not { 3 ndrop exit } if ~ Copy the first space-separated word of the comment body into scratch ~ space to see if it's a special instruction. To minimize interference with ~ the program under transformation, we use the outer log's scratch space ~ rather than the inner one's. swap-transform-variables dup here @ ~ (... source pointer, destination pointer) { over 8@ dup 0x20 != && } { swap unpack8 swap 3unroll pack8 } while 0 pack8 drop drop here @ swap-transform-variables ~ (has non-space this line, data start, string pointer, ~ first word string pointer) dup read-integer 0 = { ~ (has non-space, data start, string pointer, first word string pointer, ~ data length) 3unroll stringlen 1+ + ~ (has non-space, data start, data length, adjusted string pointer) 4 roll drop 1 swap ~ (data start, data length, is suffix, adjusted string pointer) } { drop 0 swap ~ (has non-space, data start, data length, string pointer) 4 roll swap ~ (data start, data length, is suffix, string pointer) } if-else ~ (data start, data length, is suffix, adjusted string pointer) ~ Now look for instruction keywords. These keywords are expected to be the ~ entire line, except that a length field can come before them. dup s" adjust-length" stringcmp 0 = { ~ Modify the most recent entry by adjusting its length. drop drop swap drop adjust-latest-hex-output-metadata-entry-length exit } if dup s" suppress" stringcmp 0 = { ~ Suppress the next N entries, or adjust the remaining count of entries ~ to suppress. drop drop swap drop adjust-hex-output-suppression-count exit } if dup s" fresh-line" stringcmp 0 = { ~ Create a new fresh-line entry. drop drop hex-output-metadata-entry-type-fresh-line 0 add-hex-output-metadata-entry exit } if dup s" blank-line" stringcmp 0 = { ~ Create a new blank-line entry. drop drop hex-output-metadata-entry-type-blank-line 0 add-hex-output-metadata-entry exit } if dup s" indent" stringcmp 0 = { ~ Create a new indent entry with a positive indentation delta. drop drop hex-output-metadata-entry-type-indent 2 add-hex-output-metadata-entry exit } if dup s" deindent" stringcmp 0 = { ~ Create a new indent entry with a negative indentation delta. drop drop hex-output-metadata-entry-type-indent -2 add-hex-output-metadata-entry exit } if ~ Now we have some commands for the various -provide-subitem- variants. ~ 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 "push subitem decimal" entry. drop drop 2 pick hex-output-metadata-entry-type-push-subitem-decimal swap add-hex-output-metadata-entry exit } if dup s" provide-hex" stringcmp 0 = { ~ Create a new "push subitem hex" entry. drop drop 2 pick hex-output-metadata-entry-type-push-subitem-hex swap add-hex-output-metadata-entry exit } if dup s" provide-hex8" stringcmp 0 = { ~ Create a new "push subitem hex8" entry. drop drop 2 pick hex-output-metadata-entry-type-push-subitem-hex8 swap add-hex-output-metadata-entry exit } if dup s" provide-hex16" stringcmp 0 = { ~ Create a new "push subitem hex16" entry. drop drop 2 pick hex-output-metadata-entry-type-push-subitem-hex16 swap add-hex-output-metadata-entry exit } if dup s" provide-hex32" stringcmp 0 = { ~ Create a new "push subitem hex32" entry. drop drop 2 pick hex-output-metadata-entry-type-push-subitem-hex32 swap add-hex-output-metadata-entry exit } if dup s" provide-hex64" stringcmp 0 = { ~ Create a new "push subitem hex64" entry. drop drop 2 pick hex-output-metadata-entry-type-push-subitem-hex64 swap add-hex-output-metadata-entry exit } if dup s" provide-string" stringcmp 0 = { drop drop 2 pick hex-output-metadata-entry-type-push-subitem-string swap add-hex-output-metadata-entry exit } if dup s" provide-string-copy" stringcmp 0 = { drop drop 2 pick hex-output-metadata-entry-type-push-subitem-string swap swap-transform-variables here @ swap-transform-variables dup 3unroll ~ (copy, original, copy) over stringlen 1+ memcopy swap-transform-variables allocate-string swap-transform-variables add-hex-output-metadata-entry exit } if dup s" provide-keyword" stringcmp 0 = { ~ Create a new "push subitem string" entry given a keyword pointer. drop drop 2 pick execution-token-to-entry entry-to-name hex-output-metadata-entry-type-push-subitem-string swap add-hex-output-metadata-entry exit } if dup s" drop-subitem" stringcmp 0 = { ~ Create a new "drop subitem" entry. drop drop hex-output-metadata-entry-type-drop-subitem 0 add-hex-output-metadata-entry exit } if dup s" swap-subitems" stringcmp 0 = { ~ Create a new "swap subitem" entry. drop drop hex-output-metadata-entry-type-swap-subitems 0 add-hex-output-metadata-entry exit } if dup s" roll-subitems" stringcmp 0 = { ~ Create a new "roll subitem" entry. The parameter goes in the string ~ field, and the length is always zero. drop drop 0 swap hex-output-metadata-entry-type-roll-subitems swap add-hex-output-metadata-entry exit } if ~ If it's flagged as a suffix by the logic above, create a new ~ suffix-comment entry. swap { hex-output-metadata-entry-type-suffix-comment swap add-hex-output-metadata-entry exit } if ~ Create a new line-comment entry. hex-output-metadata-entry-type-line-comment swap add-hex-output-metadata-entry ; ~ We need to define a few helpers for use in ~ hex-read-magic-comment-introducer, below. The string pointers these return ~ are allocated in the manner described there. ~ ~ (first key -- body-string-pointer) : hex-read-nonempty-comment-body ~ This is the rare case in the transforms where we want to get into the ~ nitty-gritty of lexing. Normally we rely on the upstream implementations, ~ even when we have to go out of our way to do so, because we don't want to ~ have to update the transforms every time there's a new syntax feature. ~ Here, however, we've got a syntax that only has meaning to the transform, ~ so there's no choice. swap-transform-variables here @ swap-transform-variables ~ This little loop is a modified version of the original tilde loop. swap { dup dup 0x0a != && } { pack8 key } while drop 0 pack8 8 packalign drop swap-transform-variables here @ swap-transform-variables ; : hex-read-empty-comment-body swap-transform-variables here @ swap-transform-variables 0 pack8 8 packalign drop swap-transform-variables here @ swap-transform-variables ; ~ This is called from a tilde alternate (such as hex-tilde-alternate, but ~ there are several). Its purpose is to do the lexical analysis of the ~ sequence that introduces a magic comment; it assumes that the leading tilde ~ character has just been consumed from the main input, leaving the separating ~ space as the next character ready to be read. ~ ~ Recall that the delimiter for a regular comment is "~ " (the trailing ~ space is part of it for this purpose). The delimiter for a magic comment is ~ "~ : ". A regular comment may also have a linefeed instead of a space, ~ indicating that it's empty; magic comments likewise can be empty, by ending ~ the line immediately after the colon. ~ ~ This word does the necessary reading, then leaves the input pointing at ~ the body of the comment and returns a value indicating what type of comment ~ this is. A result code of 0 indicates it's a regular comment and the input ~ now points immediately after its ending delimiter; that is, to the start of ~ the next line of text. A value of 1 indicates it's a magic comment with ~ non-zero length and the input points immediately after the delimiter. A ~ value of 2 indicates it's a magic comment with zero length, and the input ~ again points to the start of the next line. ~ ~ Our caller will want to do things with the comment body, so we also return ~ a pointer to a string in temporary storage, for use in further processing. ~ This temporary storage is taken from the "real" log, outside the transform's ~ scope. It's not allocated, merely using the space right after "here", ~ because the caller may or may not wish to allocate it for the long term, and ~ may prefer that its long-term location be elsewhere. ~ ~ Some of the various magic-comment syntaxes care about spacing within the ~ comment body, so it's important to notice that only the first space after ~ the colon is consumed. Any subsequent spaces are part of the body. ~ ~ (-- body string pointer, result code) : hex-read-magic-comment-introducer ~ The original code goes byte-by-byte, checks that the value is nonzero ~ and not equal to 0x0a (linefeed), and exits when either property fails. ~ We want to do something different based on the very first characters of ~ the comment body. So, we unroll the first few iterations of the loop so we ~ can do that test before we fall back to the normal behavior. ~ ~ Specifically, we want to recognize a colon (0x3a) with a space (0x20) ~ immediately after it. Since the interpeter peeked at the space delimiter, ~ but didn't consume it, we also need to check for a space before the colon, ~ for a total sequence of three bytes we need to match. We can't just skip ~ over the space with "consume", because it might also be a linefeed, which ~ would satisfy the exit criterion. We need to properly match it. ~ ~ We also recognize a colon followed immediately by a linefeed, as ~ denoting an empty comment. key dup dup 0x0a != && { ~ If we got here, the first byte was not 0 or 0x0a. Now we check if it's ~ colon. 0x20 = { ~ The first byte was 0x20. Now check the second. key dup dup 0x0a != && { dup 0x3a = { ~ The second byte was 0x3a. Now check the third. drop key dup { ~ The third byte is not 0. dup 0x20 = { ~ We have a magic comment with a nonempty body. We must save ~ the rest of it so we can return it. drop key hex-read-nonempty-comment-body 1 } { ~ The third byte is not 0 or 0x20. dup 0x0a = { ~ We have a magic comment with an empty body, ending at a ~ linefeed. As with nonempty ones, we prepare a temporary ~ string to return. drop hex-read-empty-comment-body 2 } { ~ The third byte was not 0, 0x0a, or 0x20. We got a space, ~ a colon, and something else. So our special test failed, but ~ the exit condition isn't met. So we're done unrolling. hex-read-nonempty-comment-body 0 } if-else } if-else } { ~ We got a colon and a zero. This is a magic comment with an ~ empty body, ending at the end of the file. drop hex-read-empty-comment-body 2 } if-else } { ~ Again, the special test failed but the exit condition isn't met. hex-read-nonempty-comment-body 0 } if-else } { ~ Again, the exit condition is met. drop hex-read-empty-comment-body 0 } if-else } { ~ Once more, the special test failed but the exit condition isn't met. hex-read-nonempty-comment-body 0 } if-else } { ~ For the last time, the exit condition is met. drop hex-read-empty-comment-body 0 } if-else ; ~ The tilde alternate is a very important word for the hex transform; it has ~ the task of hooking comment processing to detect a special comment syntax ~ which can be used by words that generate binary output, to define comments ~ which will appear as part of the hex-dump version of that output, but which ~ will be ignored in normal execution. ~ ~ This mechanism allows us, for example, to avoid putting detailed knowledge ~ of the amd64 Evocation-assembly instructions in the hex transform; instead ~ all the details are kept in one place, the authoritative implementations of ~ those instructions. This will substantially improve the maintainability of ~ the code, especially when adding new architectures. ~ ~ This word hex-tilde-alternate only applies to code that is running ~ directly within the hex transform. When an inner transform runs within the ~ hex transform, the inner transform is responsible for lexical processing, so ~ this word never gets invoked. There is an additional variant word ~ hex-*-tilde-alternate for each inner transform that the hex transform ~ supports, responsible for conducting the analogous task within the rules of ~ that inner transform. : hex-tilde-alternate ~ The original tilde is already an immediate word, so we can take over ~ those responsibilities directly without needing to do any extra work to ~ check the mode we're in or anything like that. hex-read-magic-comment-introducer ~ (body string pointer, result code) { ~ It's a magic comment, which may or may not be empty. We want to either ~ compile or execute a call to hex-tilde-replacement. interpreter-flags @ 0x01 & { ~ We're in compile mode. ~ ~ Fortunately, we can pack the string directly into the output buffer, ~ so we don't need to mess around with accumulate-string. s" lit" find entry-to-execution-token , has-non-space-this-input-line@ , s" litstring" find entry-to-execution-token , here @ swap packstring 8 packalign here ! ' hex-tilde-replacement entry-to-execution-token , } { ~ We're in interpret mode. has-non-space-this-input-line@ swap hex-tilde-replacement } if-else } { ~ If it's a regular comment, we just ignore it. drop } if-else ~ Regardless of what path we took, we just consumed a newline, so make ~ note of the fact. 0 has-non-space-this-input-line! ; make-immediate ~ This word runs whenever the label transform, running inside the hex ~ transform, encounters a tilde. It completely replaces the normal invocation ~ of tilde, just as hex-tilde-alternate does. It has the same responsibilities ~ around magic comments as hex-tilde-alternate, but for code which is ~ lexically processed by label-transform-one rather than by hex-transform-one. ~ ~ The actions it takes upon finding various sorts of comments differ from ~ hex-tilde-alternate, because the behavior of the label transform is ~ different from the behavior of the hex transform. ~ ~ This is installed by hex-label-word-replacement, bypassing the label ~ transform's normal precedence rules, so there's no need for it to be ~ immediate. ~ ~ Installing this word is the most significant change the hex transform ~ makes to the behavior of the label transform. : hex-label-tilde-alternate hex-read-magic-comment-introducer ~ (body string pointer, result code) { ~ It's a magic comment, which may or may not be empty. We want to either ~ compile or execute a call to hex-tilde-replacement. interpreter-flags @ 0x01 & { ~ We're in compile mode. We ignore magic comments in compile mode, ~ because they shouldn't become part of the program being compiled. drop } { ~ We're in interpret mode. We run the magic comment immediately. has-non-space-this-input-line@ swap swap-transform-variables allocate-string swap-transform-variables hex-tilde-replacement } if-else } { ~ If it's a regular comment, we just ignore it. drop } if-else ~ Regardless of what path we took, we just consumed a newline, so make ~ note of the fact. 0 has-non-space-this-input-line! ; ~ This input helper is a very unusual thing: It's used by hex-transform-one ~ and hex-label-word-replacement to skip the space between words. That's ~ necessary because we need to keep track of whether we've had any non-blank ~ stuff on each line yet, so that the tilde replacement can figure out certain ~ cases where a magic comment needs to be a suffix comment rather than a line ~ comment. : hex-skip-space { peek dup is-space } { consume ~ This will set the flag once for each newline, if we have multiple ~ consecutive ones or something like that, but that's harmless. 0x0a = { 0 has-non-space-this-input-line! } if } while drop ; ~ This word is installed into label-transform-one by the hex-word-alternate, ~ when the label transform runs inside the hex transform. It has the job of ~ performing substantive changes to the label transform's behavior, as ~ required by the hex transform. ~ ~ The most important changes to the base language that this word makes are ~ to call hex-label-tilde-alternate any time a tilde is encountered as a word, ~ and to call hex-skip-space before reading a word. ~ ~ This word is also responsible for invoking hex-memory-slide-replacement ~ when memcopy or memmove are encountered in immediate mode. Note that this ~ really pushes right up against the limit of what it's possible for a ~ transform to do without altering the compilation's output; invoking the ~ replacement in compile mode would do so. : hex-label-word-replacement hex-skip-space word value@ dup s" ~" stringcmp 0 = { ~ We won't be going back to label-transform-one; clear away its state. drop dropstring hex-label-tilde-alternate ~ Return directly to label-transform, faking the "not done" return value ~ from label-transform-one. 0 2 nexit } if dup s" memcopy" stringcmp 0 = { interpreter-flags @ 0x01 & not { drop hex-memory-slide-replacement exit ~ Fall through, returning control to label-transform-one. } if } if dup s" memmove" stringcmp 0 = { interpreter-flags @ 0x01 & not { drop hex-memory-slide-replacement exit ~ Fall through, returning control to label-transform-one. } if } if drop ; ~ Just as hex-allocate-alternate has the job of installing ~ hex-allocate-replacement in only one single spot, so hex-word-alternate has ~ the job of installing hex-label-word-replacement. It gets installed when ~ "word" is called from lexically within label-transform-one, and at no other ~ time. ~ ~ Notice how the job of each transform's inner bits can be thought of as ~ calling "word" and doing something with the result, with all the lexical ~ processing delegated to "word". This makes "word" a good place to install a ~ modification to the transform's behavior. ~ ~ Its structure is highly similar to that of hex-allocate-alternate. : hex-word-alternate interpreter-flags @ 0x01 & { ~ Compile mode. latest @ entry-to-name dup s" label-transform-one" stringcmp 0 = { ~ In label-transform-one. drop ' hex-label-word-replacement entry-to-execution-token , } { ~ Not in label-transform-one. drop s" word" find entry-to-execution-token , } if-else } { ~ Immediate mode. s" word" 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. ~ ~ The hex transform runs code immediately. Whereas most transforms alter ~ what the transformed code compiles into, the hex transform alters what it ~ outputs. It's assumed that the output is a binary file of some sort; the ~ binary is output as hexadecimal, interspersed with comments describing the ~ code that produced it, including descriptions of what was executed, along ~ with any comments from the original code. ~ ~ The hex transform's alternates take priority over words defined under ~ the transform when running immediately, but for compilation, words defined ~ under the transform take precedence. In the event that neither an alternate ~ nor an entry in the inner dictionary is found, the outer dictionary is ~ checked; otherwise it's irrelevant. ~ ~ The point of this precedence rule is that string literals, which require ~ special treatment, will be using the inner implementation by the time it ~ gets to actually generating an executable image. It's important that there ~ not be any alternates altering the generated code, only the program actually ~ being compiled. Other literal syntaxes, such as tick, don't have alternates ~ at all (the hex transform manages to be more parsimonious with alternates ~ than other transforms), and will always be using inner versions. ~ ~ The precedence rule does fail to have the desired effect for label ~ references. For these, the alternates take the unusual step of manually ~ calling the inner versions when they exist. ~ TODO think through whether the precedence rule is actually doing anything... ~ ~ It expects to be called from "hex-transform", below, which loops. ~ ~ (-- done) : hex-transform-one hex-skip-space word ~ If no word was returned, exit. dup 0 = { drop 0 exit } if ~ The string is on the top of the stack, so to get a pointer to it we get ~ the stack address. ~ (string) value@ ~ If it's the magic word, end the transformation. dup transformation-state transformation-state-delimiter @ stringcmp 0 = { drop dropstring 1 exit } if ~ If it's anything but tilde, set the input state flag accordingly. dup s" ~" stringcmp 0 != { 1 has-non-space-this-input-line! } if ~ Check whether it's one of the words we have alternates for, and look up ~ the alternate if so. 0 swap ~ (name as stack string, placeholder, name pointer) dup s" self-codeword" stringcmp 0 = { swap drop ' hex-self-codeword-alternate swap } if ~ It is nontrivial to construct a string with a double-quote in it. dup ' s" entry-to-name stringcmp 0 = { swap drop ' hex-string-alternate swap } if dup ' ." entry-to-name stringcmp 0 = { swap drop ' hex-dot-string-alternate swap } if dup s" create" stringcmp 0 = { swap drop ' hex-create-alternate swap } if dup s" :" stringcmp 0 = { swap drop ' hex-colon-alternate swap } if dup s" ;" stringcmp 0 = { swap drop ' hex-semicolon-alternate swap } if dup s" ;asm" stringcmp 0 = { swap drop ' hex-semicolon-assembly-alternate swap } if dup s" L@'" stringcmp 0 = { swap drop ' hex-L@'-alternate swap } if dup s" L!'" stringcmp 0 = { swap drop ' hex-L!'-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 dup s" memcopy" stringcmp 0 = { swap drop ' hex-memcopy-alternate swap } if dup s" memmove" stringcmp 0 = { swap drop ' hex-memmove-alternate swap } if dup s" word" stringcmp 0 = { swap drop ' hex-word-alternate swap } if dup s" ~" stringcmp 0 = { swap drop ' hex-tilde-alternate swap } if ~ (name as stack string, 0 or alternate entry pointer, name pointer) find ~ (stack string, 0 or alternate entry pointer, 0 or inner entry pointer) interpreter-flags @ 0x01 & { ~ We're in compile mode. An alternate immediate entry has the highest ~ precedence; an inner entry of any kind has second-highest. over { ~ An alternate entry exists; check its flags. over entry-flags@ 0x01 & { ~ It's an immediate entry, so it has precedence, regardless of ~ what's up with the inner entry. Execute it. drop dropstring-with-result entry-to-execution-token execute 0 exit } { ~ The alternate is not immediate, so check if there's an inner entry. dup { ~ There is also an inner entry. Check its flags. dup entry-flags@ 0x01 & { ~ The inner entry is immediate, so it has precedence. Execute it. swap drop dropstring-with-result entry-to-execution-token execute 0 exit } { ~ The inner entry is not immediate, so the alternate has ~ precedence. Compile it. ~ ~ Watch this space closely for correctness issues, it's a rare ~ codepath. drop dropstring-with-result entry-to-execution-token , 0 exit } if-else } { ~ There's no inner entry. Compile the alternate. ~ ~ This path, too, is rare and should get close scrutiny for ~ correctness. drop dropstring-with-result entry-to-execution-token , 0 exit } if-else } if-else } { ~ There is no alternate entry; check for an inner entry. dup { ~ An inner entry exists; check its flags. dup entry-flags@ 0x01 & { ~ It's an immediate entry. Execute it. swap drop dropstring-with-result entry-to-execution-token execute 0 exit } { ~ It's not an immediate entry. Compile it. swap drop dropstring-with-result entry-to-execution-token , 0 exit } if-else } if ~ If we got here, there's no inner or alternate entry; fall through. } if-else } { ~ We're in immediate mode. An alternate entry of any kind has precedence. over { ~ There's an alternate entry. Execute it. drop dropstring-with-result entry-to-execution-token execute 0 exit } { ~ There's no alternate entry. Check for an inner entry. dup { ~ An inner entry exists. Execute it. swap drop dropstring-with-result entry-to-execution-token execute 0 exit } if ~ If we got here, there's no inner or alternate; fall through. } if-else } if-else drop drop ~ (stack string) ~ As a final fallback, we also check the outer dictionary, for immediate ~ use only. This will allow things like assembly words to work. value@ swap-transform-variables find swap-transform-variables dup { ~ There's an outer entry; check the mode. interpreter-flags @ 0x01 & { ~ We're in compile mode; check the outer entry's flags. dup entry-flags@ 0x01 & { ~ It's an immediate word; execute it. dropstring-with-result entry-to-execution-token execute 0 exit } { ~ It's not an immediate word. Pretend it doesn't exist, and fall ~ through. drop } if-else } { ~ We're in immediate mode. Execute the outer entry. dropstring-with-result entry-to-execution-token execute 0 exit } if-else } { ~ There's no outer entry. Fall through. drop } if-else ~ (stack string) ~ Check whether it's a number literal. value@ read-integer 0 = { ~ It's a number. ~ ~ (name as stack string, integer value) dropstring-with-result ~ (integer value) interpreter-flags @ 0x01 & { ~ TODO this probably needs a lit alternate (!) ' lit entry-to-execution-token , , 0 exit } if 0 exit } if ~ (stack string) ." No such word: " value@ emitstring newline dropstring 0 ; ~ This implements the hex transform for all words in a region given as ~ an input string. It is directly analogous to "quit", in interpret.e, but is ~ more complex. ~ ~ (output metadata 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 ~ (output metadata 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, ~ since client code will make its own updates to them and then rely on those ~ 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 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 ! 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. ~ We don't have the real values yet, so we can't create the initial ~ entries in the output metadata, but we can and should zero it out to make ~ sure everything else operating on it finds it well-formed. zero-hex-output-metadata ~ The code under the hex transform never gets a real copy of warm-start, ~ so it doesn't have the globals "here" and so on. It wants to have the ~ globals, but it can't, not without our help. Why aren't we helping? ~ ~ Oh, right, we're helping right here. We just write them into the inner ~ log and dictionary directly, by using our outer copy of "variable". These ~ definitions don't have to do anything special; we point them to the same ~ addresses as the outer ones. Note though that the actual values the ~ transformed code sees sees are the wrapped, inner ones, since we swapped ~ the values out elsewhere. ~ ~ If we provided these as alternates instead, that would work for code ~ that doesn't have a nested transform, but the inner transforms want to be ~ able to look them up by name. swap-transform-variables log swap-transform-variables s" log" variable swap-transform-variables s0 swap-transform-variables s" s0" variable swap-transform-variables r0 swap-transform-variables s" r0" variable swap-transform-variables latest swap-transform-variables s" latest" variable swap-transform-variables here swap-transform-variables s" here" variable ~ 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. { hex-transform-one ~ (done) ~ When the loop is done, get the real values of "here" and "latest" ~ back. The internal "here" is also the output point, and will become our ~ return value. The internal "latest" is discarded. { here @ transformation-state transformation-state-saved-here @ here ! transformation-state transformation-state-saved-latest @ latest ! ~ (output point) ~ Though we don't actually use transformation-state outside of this ~ invocation, for tidiness we zero it out. 0 transformation-state transformation-state-saved-here ! 0 transformation-state transformation-state-saved-latest ! 0 transformation-state transformation-state-output-buffer-start ! 0 transformation-state transformation-state-user-stack-depth ! ~ Also put the input source back how it was. main-input-buffer pop-input-buffer exit } if } forever ;