path: root/transform.e

~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~ ~~ 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 ;


~ (output point, filename -- output point)
: pack-file-contents
  dup 0 0 sys-open
  ~ (output point, filename, open result code or file descriptor)
  dup 0 > {
    ." Couldn't open " swap emitstring space
    ." because " space . ." ." newline
    2 ndrop exit
  } if

  ~ (output point, filename, file descriptor)
  {
    dup 3 pick 1024 sys-read
    ~ (output point, filename, file descriptor, read result code or length)

    dup 0 > {
      ." Error while reading from " 3roll emitstring
      ." because " space . ." ." newline
      drop exit
    } if

    dup 0 = {
      3 ndrop exit
    } if

    4 roll + 3unroll
  } 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 7 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 7 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-output-metadata 5 8 * + ;
: allocate-transformation-state
  6 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-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" <=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 -2 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
  ~   While we could put magic comments here, and be guaranteed to catch every
  ~ word-defining word under the label transform, there's a subtle thing where
  ~ we need to make sure the "indent" command happens in the same places it
  ~ does when the same code runs under the log-load transform, and only those
  ~ places. So, we do it in the callers of "create" instead.
  dup stringlen 1 +
  ~ : provide-data
  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.
  ~ : 8 #-- (previous entry pointer)
  latest @ host-address-space-to-target pack64
  ~ : 1 #-- (entry flags)
  0 pack8
  ~ : bidirectional-null-terminated entry name
  0 pack8
  ~ : 1 data-adjust-output-point
  ~ : fresh-line
  +
  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@
  ~ : blank-line
  ~ : blank-line
  ~ : provide-string-copy
  ~ : # is defined here via the label transform; this is its entry header.
  ~ : indent
  label-create-alternate dropstring

  ~ This looks up "docol" by label.
  ~ : 8 #-- (docol codeword)
  swap-transform-variables
  L@' docol-codeword-value
  L@' origin
  swap-transform-variables
  + ,
  ~ : blank-line

  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 ,     ~ : -8 exit #-- (codeword pointer)
  ~ : 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
  ~ : provide-data
  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.
  ~ : provide-data
  ~ : data-set-output-point
  ~ : delete-last-comment-at-output-point
  ~ : 8 #-- (self codeword)
  dup 8 + host-address-space-to-target
  swap !
  ~ : data-set-output-point

  ~   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
  ~ : blank-line
  ~ : blank-line
  ~ : provide-string-copy
  ~ : # is defined here via the label transform; this is its entry header.
  ~ : indent
  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 ,   ~ : -8 litstring #-- (codeword pointer)
    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 ,   ~ : -8 emitstring #-- (codeword pointer)
  } { 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 ,     ~ : -8 lit #-- (codeword pointer)
  0                                    ~ : provide-hex
  ,                                    ~ : -8 # #-- (integer literal)
  offset-to-target-address-space ,     ~ : -8 != #-- (codeword pointer)
  ~   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 ,     ~ : -8 0branch #-- (codeword pointer)
  dup 8 +                              ~ : provide-hex
  ~ : 8 # #-- (branch offset)
  ,
  ~ (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 ,     ~ : -8 lit #-- (codeword pointer)
  0                                    ~ : provide-hex
  ,                                    ~ : -8 # #-- (integer literal)
  offset-to-target-address-space ,     ~ : -8 = #-- (codeword pointer)
  ~   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 ,     ~ : -8 0branch #-- (codeword pointer)
  dup 8 +                              ~ : provide-hex
  ~ : 8 # #-- (branch offset)
  ,
  ~ (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 ,     ~ : -8 lit #-- (codeword pointer)
  0                                    ~ : provide-hex
  ,                                    ~ : -8 # #-- (integer literal)
  offset-to-target-address-space ,     ~ : -8 != #-- (codeword pointer)
  ~   Branch past the length field, the true-block, and the unconditional
  ~ branch in the middle.
  offset-to-target-address-space ,     ~ : -8 0branch #-- (codeword pointer)
  3roll dup 4 unroll 3 8 * +           ~ : provide-hex
  ~ : 8 # #-- (branch offset)
  ,

  ~ 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 ,     ~ : -8 branch #-- (codeword pointer)
  ~ Branch past the length field and the false-block.
  dup 8 +                              ~ : provide-hex
  ~ : 8 # #-- (branch offset)
  ,

  ~ 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 ,     ~ : -8 branch #-- (codeword pointer)
  8 + -1 *                             ~ : provide-hex
  ~ : 8 # #-- (branch offset)
  , 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 ,     ~ : -8 lit #-- (codeword pointer)
  0                                    ~ : provide-hex
  ,                                    ~ : -8 # #-- (integer literal)
  offset-to-target-address-space ,     ~ : -8 != #-- (codeword pointer)
  ~ Branch past the length field, the body, and the unconditional branch.
  offset-to-target-address-space ,     ~ : -8 0branch #-- (codeword pointer)
  dup 3 8 * +                          ~ : provide-hex
  ~ : 8 # #-- (branch offset)
  ,
  ~ 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 ,     ~ : -8 branch #-- (codeword pointer)
  6 8 * + swap drop + swap drop -1 *   ~ : provide-hex
  ~ : 8 # #-- (branch offset)
  ,
  ; 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, end the transformation.
  dup 0 = { drop 1 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@

  ~   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).
        ~ : provide-string-copy
        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.
        ~ : 8 # #-- (codeword pointer)
        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
      ~ : 8 lit #-- (codeword pointer)
      ,
      ~ : provide-hex
      ~ : 8 # #-- (integer literal)
      ,
      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
~  -- 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

  main-input-buffer dup push-input-buffer
  swap 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 !
  swap transformation-state transformation-state-output-buffer-start !
  here !
  0 latest !
  ~ 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.
    { transformation-state transformation-state-output-buffer-start @
      here @
      transformation-state transformation-state-saved-here @ here !
      transformation-state transformation-state-saved-latest @ latest !
      ~ (output buffer start, 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 ,   ~ : -8 swap #-- (codeword pointer)

    exit
  } if

  swap-transform-variables
  L@' roll
  L@' lit
  swap-transform-variables

  offset-to-target-address-space ,     ~ : -8 lit #-- (codeword pointer)
  swap                                 ~ : provide-hex
  ,                                    ~ : -8 # #-- (integer literal)
  offset-to-target-address-space ,     ~ : -8 roll #-- (codeword pointer)
  ;


~   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 ,   ~ : -8 swap #-- (codeword pointer)

    exit
  } if

  swap-transform-variables
  L@' unroll
  L@' lit
  swap-transform-variables

  offset-to-target-address-space ,     ~ : -8 lit #-- (codeword pointer)
  swap                                 ~ : provide-hex
  ,                                    ~ : -8 # #-- (integer literal)
  offset-to-target-address-space ,     ~ : -8 unroll #-- (codeword pointer)
  ;


~   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 ,     ~ : -8 litstring #-- (codeword pointer)
  3roll here @ swap packstring 8 packalign here !
  offset-to-target-address-space ,
  ~ : -8 log-load-find-execution-token #-- (codeword pointer)
  offset-to-target-address-space ,
  ~ : -8 log-load-comma #-- (codeword pointer)

  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 ,     ~ : -8 litstring #-- (codeword pointer)
  3roll here @ swap packstring 8 packalign here !
  offset-to-target-address-space ,
  ~ : -8 log-load-find-execution-token #-- (codeword pointer)
  offset-to-target-address-space ,     ~ : -8 swap #-- (codeword pointer)

  ~   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 ,     ~ : -8 execute #-- (codeword pointer)

  ~   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 ,     ~ : -8 litstring #-- (codeword pointer)
  here @ s" docol" packstring 8 packalign here !
  offset-to-target-address-space ,
  ~ : -8 log-load-find-execution-token #-- (codeword pointer)
  offset-to-target-address-space ,     ~ : -8 execute #-- (codeword pointer)
  offset-to-target-address-space ,
  ~ : -8 log-load-comma #-- (codeword pointer)

  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 ,     ~ : -8 litstring #-- (codeword pointer)
  here @ s" lit" packstring 8 packalign here !
  offset-to-target-address-space ,
  ~ : -8 log-load-find-execution-token #-- (codeword pointer)
  offset-to-target-address-space ,
  ~ : -8 log-load-comma #-- (codeword pointer)
  offset-to-target-address-space ,     ~ : -8 lit #-- (codeword pointer)
  swap                                 ~ : provide-hex
  ,                                    ~ : -8 # #-- (integer literal)
  offset-to-target-address-space ,
  ~ : -8 log-load-comma #-- (codeword pointer)

  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 & {
    ~   Notice that when we're in compile mode, we aren't actually defining a
    ~ word at the time the log-load routine runs, so we don't have magic
    ~ comments.
    s" create" log-load-compile-dynamic-word
  } {
    ~ : blank-line
    ~ : create
    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 ,     ~ : -8 swap #-- (codeword pointer)
    offset-to-target-address-space ,
    ~ : -8 log-load-create #-- (codeword pointer)

    ~ 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
    ~ : blank-line
  } 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@
  ~ : blank-line
  ~ : blank-line
  ~ : provide-string-copy
  ~ : # is defined here via the log-load transform.
  ~ : indent

  ~   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 ,     ~ : -8 litstring #-- (codeword pointer)
  swap here @ swap packstring 8 packalign here !
  offset-to-target-address-space ,
  ~ : -8 log-load-create #-- (codeword pointer)

  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 ,
    ~ : -8 log-load-self-codeword #-- (codeword pointer)

    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 ,     ~ : -8 litstring #-- (codeword pointer)
  here @ s" exit" packstring 8 packalign here !
  offset-to-target-address-space ,
  ~ : -8 log-load-find-execution-token #-- (codeword pointer)
  offset-to-target-address-space ,
  ~ : -8 log-load-comma #-- (codeword pointer)

  log-load-unroll-log-address

  ~ : deindent

  ~ 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 ,
  ~ : -8 log-load-semicolon-assembly #-- (codeword pointer)

  log-load-unroll-log-address

  ~ : deindent

  ~ 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 ,     ~ : -8 swap #-- (codeword pointer)
    offset-to-target-address-space ,
    ~ : -8 log-load-comma #-- (codeword pointer)

    ~   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 ,     ~ : -8 3unroll #-- (codeword pointer)
    offset-to-target-address-space ,
    ~ : -8 log-load-variable #-- (codeword pointer)

    ~   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 ,     ~ : -8 swap #-- (codeword pointer)
    offset-to-target-address-space ,
    ~ : -8 log-load-keyword #-- (codeword pointer)

    ~   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 ,     ~ : -8 litstring #-- (codeword pointer)
  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 ,
    ~ : -8 litstring #-- (codeword pointer)
    here @ s" litstring" packstring 8 packalign here !
    offset-to-target-address-space ,
    ~ : -8 log-load-find-execution-token #-- (codeword pointer)
    offset-to-target-address-space ,
    ~ : -8 log-load-comma #-- (codeword pointer)
    offset-to-target-address-space ,     ~ : -8 swap #-- (codeword pointer)
    offset-to-target-address-space ,
    ~ : -8 log-load-comma-string #-- (codeword pointer)

    ~   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 ,
    ~ : -8 emitstring #-- (codeword pointer)
  } 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 ,     ~ : -8 litstring #-- (codeword pointer)
  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 ,
    ~ : -8 litstring #-- (codeword pointer)
    here @ s" litstring" packstring 8 packalign here !
    offset-to-target-address-space ,
    ~ : -8 log-load-find-execution-token #-- (codeword pointer)
    offset-to-target-address-space ,
    ~ : -8 log-load-comma #-- (codeword pointer)
    offset-to-target-address-space ,     ~ : -8 swap #-- (codeword pointer)
    offset-to-target-address-space ,
    ~ : -8 log-load-comma-string #-- (codeword pointer)

    offset-to-target-address-space ,
    ~ : -8 litstring #-- (codeword pointer)
    here @ s" find" packstring 8 packalign here !
    offset-to-target-address-space ,
    ~ : -8 log-load-find-execution-token #-- (codeword pointer)
    offset-to-target-address-space ,
    ~ : -8 log-load-comma #-- (codeword pointer)

    ~   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 ,
    ~ : -8 log-load-find #-- (codeword pointer)

    ~   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 ,
  ~ : -8 log-load-left-curly-brace #-- (codeword pointer)

  ~ It pushes a start pointer onto the stack.
  1 transform-apply-stack-delta

  log-load-unroll-log-address
  ~ : {
  ~ : indent
  ; make-immediate


: log-load-right-curly-brace-alternate
  ~ : deindent
  ~ : }
  log-load-roll-log-address

  swap-transform-variables
  L@' log-load-right-curly-brace
  swap-transform-variables

  offset-to-target-address-space ,
  ~ : -8 log-load-right-curly-brace #-- (codeword pointer)

  ~ 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
  ~ : if
  log-load-roll-log-address

  swap-transform-variables
  L@' log-load-if
  swap-transform-variables

  offset-to-target-address-space ,
  ~ : -8 log-load-if #-- (codeword pointer)

  ~ It pops the start and length.
  -2 transform-apply-stack-delta

  log-load-unroll-log-address
  ~ : blank-line
  ; make-immediate


~ (start pointer, length)
: log-load-unless-alternate
  ~ : unless
  log-load-roll-log-address

  swap-transform-variables
  L@' log-load-unless
  swap-transform-variables

  offset-to-target-address-space ,
  ~ : -8 log-load-unless #-- (codeword pointer)

  ~ It pops the start and length.
  -2 transform-apply-stack-delta

  log-load-unroll-log-address
  ~ : blank-line
  ; make-immediate


~ (true start, true length, false start, false length)
: log-load-if-else-alternate
  ~ : if-else
  log-load-roll-log-address

  swap-transform-variables
  L@' log-load-if-else
  swap-transform-variables

  offset-to-target-address-space ,
  ~ : -8 log-load-if-else #-- (codeword pointer)

  ~ It pops two pairs of start and length.
  -4 transform-apply-stack-delta

  log-load-unroll-log-address
  ~ : blank-line
  ; make-immediate


~ (start, length --)
: log-load-forever-alternate
  ~ : forever
  log-load-roll-log-address

  swap-transform-variables
  L@' log-load-forever
  swap-transform-variables

  offset-to-target-address-space ,
  ~ : -8 log-load-forever #-- (codeword pointer)

  ~ It pops the start and length.
  -2 transform-apply-stack-delta

  log-load-unroll-log-address
  ~ : blank-line
  ; make-immediate


~ (test start, test length, body start, body length --)
: log-load-while-alternate
  ~ : while
  log-load-roll-log-address

  swap-transform-variables
  L@' log-load-while
  swap-transform-variables

  offset-to-target-address-space ,
  ~ : -8 log-load-while #-- (codeword pointer)

  ~ It pops two pairs of start and length.
  -4 transform-apply-stack-delta

  log-load-unroll-log-address
  ~ : blank-line
  ; 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, end the transformation.
  dup 0 = { drop 1 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@

  ~   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 ,   ~ : -8 lit #-- (codeword pointer)
                                       ~ : provide-hex
    ,                                  ~ : -8 # #-- (integer literal)
    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.
    ~ : provide-string-copy
    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 ,
    ~ : -8 # #-- (codeword pointer)
    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
~  -- output buffer start, output point)
: log-load-transform
  ~ : blank-line
  ~ :   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.
  ~ :
  ~ :   The log-load routine is super important, but also extremely verbose,
  ~ : which necessarily makes it hard to read. If you're skimming this file
  ~ : for the first time to get a sense of what it contains, you might want
  ~ : to search for the words "label transform" to get to the stuff that makes
  ~ : better introductory reading.
  ~ : blank-line

  main-input-buffer dup push-input-buffer
  swap 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 !
  swap transformation-state transformation-state-output-buffer-start !
  0 transformation-state transformation-state-user-stack-depth !
  here !
  0 latest !
  ~ 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.
    { transformation-state transformation-state-output-buffer-start @
      here @
      transformation-state transformation-state-saved-here @ here !
      transformation-state transformation-state-saved-latest @ latest !
      ~ (output buffer start, 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
~   ~ : -10 adjust-start
~   ~ : 1 data-adjust-length
~   ~ : -1 data-adjust-start
~
~   ~ : 0x1000 set-output-point
~   ~ : 8 adjust-output-point
~   ~ : data-set-output-point
~   ~ : 1 data-adjust-output-point
~
~   ~ : 1 suppress
~   ~ : delete-first-comment-at-output-point
~   ~ : delete-last-comment-at-output-point
~
~   ~ : Do a thing with # and # ?
~   ~ : provide-decimal
~   ~ : provide-hex
~   ~ : provide-hex8
~   ~ : provide-hex16
~   ~ : provide-hex32
~   ~ : provide-hex64
~   ~ : provide-string
~   ~ : provide-string-copy
~   ~ : provide-keyword
~   ~ : provide-data
~   ~ : 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.
~
~   All the adjust-* commands change something immediately, as they execute.
~ What they adjust differs. In the cases of adjust-length and adjust-start,
~ it's a field of a recent entry. Notionally, adjust-start does the same thing
~ as adjust-length but for the start address the entry is attached to, rather
~ than the length of the attachment. Also, while adjust-length only affects
~ comment entries, adjust-start affects any entry that produces output, such
~ as fresh-line.
~
~   The various -output-point commands are used to directly interact with the
~ notion of the latest output point, which can be useful if a location has
~ been skipped over and there are commands which should be run before
~ outputting anything at the new location. The simplest variant is
~ set-output-point, which sets it to the parameter value. The data-set-
~ variant obtains a value in the manner of the other data-* commands, adds it
~ to the parameter value, and sets the latest output point to the result. The
~ adjust- and data-adjust- variants, like other adjust commands, add a value
~ to the existing one.
~
~   Notice that the general rule is that data-set-* commands use their
~ parameter as an addend, while data-adjust-* commands use it as a multiplier.
~
~   The data-adjust-* variants deserve further commentary, though you may find
~ it more productive to read and understand the entire explanation about
~ provide-* commands before worrying about these. These variants adjust the
~ same things as the non-data ones, but instead of adjusting by a fixed
~ amount, they look for the most recent -entry-type-saved-data metadata entry.
~ They delete that entry from the entry array entirely, and use the value
~ saved in it as the amount to adjust by. Such entries are created by the
~ provide-data command, on which more below. Additionally, the data-adjust-*
~ commands use their parameters as scaling factors to the adjustment, and
~ these factors may be negative. You'll usually specify a parameter of 1 or
~ -1.
~
~   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.
~
~   Sometimes, an entry has already been created, and you now need to get rid
~ of it. While there are reasons to be cautious of more-general mechanisms,
~ the commands delete-*-comment-at-output-point will search for a metadata
~ entry which is one of the comment types and which has its start position set
~ to the same address as the current output point. The -first- variant will
~ search forward from the start of the array, while -last- will search
~ backward from the end; both will stop as soon as they encounter one. This is
~ usually desired when overwriting a location that has already been written
~ to.
~
~   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? ;)
~
~   The -data variant treats the value as opaque, and creates an
~ -entry-type-saved-data metadata entry. Unlike the others, these entries do
~ not affect the subitem entry stack; they're consumed and removed from the
~ entry array before entry execution even starts, by the matching data-*
~ command.
~
~   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.
~
~   Now that you have this full picture in your head, you finally also have
~ the background to understand the data-adjust-* commands. You may find it
~ helpful to go re-read the explanation of them, above, to let it sink in.
~
~   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-n-bytes-this-line 8 8 * + ;
: hex-output-metadata-subitem-entry-stack-depth 9 8 * + ;
: hex-output-metadata-subitem-entry-stack-zero 10 8 * + ;
: hex-output-metadata-subitem-entry-stack-capacity 8 ;
: hex-output-metadata-first-entry
  10 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-saved-data 14 ;
: hex-output-metadata-entry-type-drop-subitem 15 ;
: hex-output-metadata-entry-type-swap-subitems 16 ;
: hex-output-metadata-entry-type-roll-subitems 17 ;

~   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-n-bytes-this-line 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-output-producing-entry
  dup is-comment-entry swap
  hex-output-metadata-entry-type @
  dup hex-output-metadata-entry-type-fresh-line = 3roll || swap
  hex-output-metadata-entry-type-blank-line = || ;

: is-saved-data-entry
  hex-output-metadata-entry-type @
  hex-output-metadata-entry-type-saved-data = ;

: 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! ;

: n-bytes-this-line@
  transformation-state transformation-state-output-metadata @
  hex-output-metadata-n-bytes-this-line @ ;

: n-bytes-this-line!
  transformation-state transformation-state-output-metadata @
  hex-output-metadata-n-bytes-this-line ! ;

: increment-bytes-this-line n-bytes-this-line@ 1+ n-bytes-this-line! ;

: 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

    ." Subitem 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 * + @
  } {
    ." Subitem 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 ;

~ (entry pointer --)
: delete-metadata-entry
  transformation-state transformation-state-output-metadata @
  hex-output-metadata-first-entry
  { dup @ } { hex-output-metadata-next-entry } while
  ~ (entry pointer, array-end marker pointer)
  over hex-output-metadata-next-entry - 8 +
  ~ (entry pointer, length of block to move)
  swap dup hex-output-metadata-next-entry swap 3roll memmove ;


~ (-- entry pointer or 0)
: find-latest-metadata-entry
  ~   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)
: find-latest-comment-metadata-entry
  find-latest-metadata-entry
  ~ (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)
  ;

~ (-- entry pointer or 0)
: find-latest-output-producing-metadata-entry
  find-latest-metadata-entry
  ~ (entry pointer or 0)

  ~   If and only if we actually found one, now loop backwards to find the
  ~ most recent one that's an output-producing entry.
  { dup { dup is-output-producing-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)
  ;

~ (-- entry pointer or 0)
: find-latest-saved-data-metadata-entry
  find-latest-metadata-entry
  ~ (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-saved-data-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)
  ;

~ (target start location -- entry pointer or 0)
: find-first-comment-metadata-entry-with-start
  ~ Find the first entry, but if it doesn't exist, we want 0 instead.
  transformation-state transformation-state-output-metadata @
  hex-output-metadata-first-entry
  ~ (target start location, entry pointer)

  ~   Now loop forwards to find the first that's a comment entry and has the
  ~ desired start location.
  { dup @ } {
    dup is-comment-entry
    over hex-output-metadata-entry-data-start @ 3 pick =
    && { swap drop exit } if
    hex-output-metadata-next-entry
  } while drop drop 0 ;


~ (target start location -- entry pointer or 0)
: find-latest-comment-metadata-entry-with-start
  find-latest-metadata-entry
  ~ (target start location, entry pointer or 0)

  dup {
    { dup @ } {
      dup is-comment-entry
      over hex-output-metadata-entry-data-start @ 3 pick =
      && { swap drop exit } if

      dup
      transformation-state transformation-state-output-metadata @
      hex-output-metadata-first-entry
      = { drop drop 0 exit } if

      hex-output-metadata-previous-entry
    } while
  } if swap drop ;


~ (length adjustment --)
: adjust-latest-comment-metadata-entry-length
  find-latest-comment-metadata-entry

  ~ 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 ;

~ (length adjustment --)
: adjust-latest-output-producing-metadata-entry-start
  find-latest-output-producing-metadata-entry

  ~ We've found the entry we want to act on, if it exists, so do it.
  dup {
    hex-output-metadata-entry-data-start 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 ;


~ (target start location --)
: delete-first-comment-metadata-entry-with-start
  find-first-comment-metadata-entry-with-start
  dup { delete-metadata-entry } { drop } if-else ;

~ (target start location --)
: delete-latest-comment-metadata-entry-with-start
  find-latest-comment-metadata-entry-with-start
  dup { delete-metadata-entry } { drop } if-else ;

: delete-first-comment-metadata-entry-at-output-point
  transformation-state transformation-state-output-metadata @
  hex-output-metadata-latest-output-point @
  delete-first-comment-metadata-entry-with-start ;

: delete-latest-comment-metadata-entry-at-output-point
  transformation-state transformation-state-output-metadata @
  hex-output-metadata-latest-output-point @
  delete-latest-comment-metadata-entry-with-start ;


~ (value --)
: set-latest-output-point
  transformation-state transformation-state-output-metadata @
  hex-output-metadata-latest-output-point ! ;

~ (adjustment --)
: adjust-latest-output-point
  transformation-state transformation-state-output-metadata @
  hex-output-metadata-latest-output-point
  dup 3unroll @ + swap ! ;

~ (-- data value)
: data-consume
  find-latest-saved-data-metadata-entry
  ~ (entry pointer or 0)

  dup {
    dup hex-output-metadata-entry-content @ swap
    ~ (data value, entry pointer)

    delete-metadata-entry
  } {
    drop

    ~   If we get here, that's a problem. Emit an error message to make sure
    ~ it's easy to diagnose.
    ." No saved-data metadata entry to take a value from." newline

    ~ We still return a value, so that our caller doesn't crash.
    0
  } if-else ;

~ (adjustment scale factor --)
: data-adjust-latest-comment-metadata-entry-length
  ~   All the entry array manipulation happens in data-consume. Once we're
  ~ done doing that, the array is now in a consistent state, so we can hand
  ~ off to the non-data implementation to do the rest of the work.
  data-consume * adjust-latest-comment-metadata-entry-length ;
~ (adjustment scale factor --)
: data-adjust-latest-output-producing-metadata-entry-start
  ~ Same as for adjusting the entry length.
  data-consume * adjust-latest-output-producing-metadata-entry-start ;

~ (value offset --)
: data-set-latest-output-point
  data-consume + set-latest-output-point ;
~ (adjustment scale factor --)
: data-adjust-latest-output-point
  data-consume * adjust-latest-output-point ;


~ (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 ;

: hex-comment-first-tab-stop 36 ;
: hex-comment-second-tab-stop 58 ;

~   This is a helper called from hex-emit-template-string. The word pointer
~ is in the outer log's scratch space, and must not be overwritten.
~
~ (queued space count, word pointer -- should ignore space)
: hex-emit-template-string-word
  dup s" #" stringcmp 0 = {
    ~ (queued space count, word pointer)
    drop

    pop-subitem-entry-stack
    ~ (queued space count, subitem entry)

    ~   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 {
      ~ (queued space count, subitem entry)

      dup hex-output-metadata-entry-type @
      hex-output-metadata-entry-type-push-subitem-decimal = {
        swap dup indent advance-current-column 0 swap

        dup hex-output-metadata-entry-content @
        dup 10 swap logfloor 1+ advance-current-column
        .
      } if

      dup hex-output-metadata-entry-type @
      hex-output-metadata-entry-type-push-subitem-hex = {
        swap dup indent advance-current-column 0 swap

        ." 0x"
        dup hex-output-metadata-entry-content @
        dup 16 swap logfloor 1+ 2 + advance-current-column
        .hex
      } if

      dup hex-output-metadata-entry-type @
      hex-output-metadata-entry-type-push-subitem-hex8 = {
        swap dup indent advance-current-column 0 swap

        ." 0x"
        dup hex-output-metadata-entry-content @ .hex8
        4 advance-current-column
      } if

      dup hex-output-metadata-entry-type @
      hex-output-metadata-entry-type-push-subitem-hex16 = {
        swap dup indent advance-current-column 0 swap

        ." 0x"
        dup hex-output-metadata-entry-content @ .hex16
        6 advance-current-column
      } if

      dup hex-output-metadata-entry-type @
      hex-output-metadata-entry-type-push-subitem-hex32 = {
        swap dup indent advance-current-column 0 swap

        ." 0x"
        dup hex-output-metadata-entry-content @ .hex32
        10 advance-current-column
      } if

      dup hex-output-metadata-entry-type @
      hex-output-metadata-entry-type-push-subitem-hex64 = {
        swap dup indent advance-current-column 0 swap

        ." 0x"
        dup hex-output-metadata-entry-content @ .hex64
        18 advance-current-column
      } if

      dup hex-output-metadata-entry-type @
      hex-output-metadata-entry-type-push-subitem-string = {
        swap dup indent advance-current-column 0 swap

        dup hex-output-metadata-entry-content @
        dup stringlen advance-current-column
        emitstring
      } if
    } if

    drop drop 0 exit
  } if

  dup s" #--" stringcmp 0 = {
    ~ (queued space count, word pointer)

    hex-comment-second-tab-stop current-column@
    2dup > {
      drop drop swap drop 0 swap
      newline
      hex-comment-first-tab-stop indent ." ~"
      hex-comment-second-tab-stop hex-comment-first-tab-stop 1+ - indent
      hex-comment-second-tab-stop current-column!
    } {
      - dup indent advance-current-column
      swap drop 0 swap
    } if-else

    drop drop 1 exit
  } if

  ~ (queued space count, word pointer)
  swap dup indent advance-current-column
  dup stringlen advance-current-column
  emitstring 0 ;


~ (string pointer --)
: hex-emit-template-string
  0 swap
  ~ (queued space count, input point)

  { unpack8 dup } {
    ~ (queued space count, input point, latest character)
    dup is-space {
      ~   Instead of outputting space characters as we reach them, we keep a
      ~ count of how many are pending. This allows us to do word-wrapping
      ~ without having to worry about trailing spaces.
      3roll 1+ 3unroll drop
    } {
      ~ (queued space count, 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
      ~ (queued space count, scratch output point, input point)

      ~   Scan forward and find a space-separated word.
      { unpack8 dup dup is-space not && } {
        ~ (queued space count, scratch output point, adjusted input point,
        ~  next character)
        3roll swap pack8 swap
        ~ (queued space count, adjusted scratch output point,
        ~  adjusted input point)
      } while
      ~ (queued space count, scratch output point, input point,
      ~  first non-word character or 0)
      3roll 0 pack8 drop
      ~ (queued space count, input point, first non-word character or 0)

      swap-transform-variables here @ swap-transform-variables
      ~ (queued space count, input point, first non-word character or 0,
      ~  word pointer)

      4 roll swap 1 max hex-emit-template-string-word 0 4 unroll
      ~ (queued space count, input point, first non-word character,
      ~  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 queue it for later output... unless we were asked
        ~ to skip it, of course.
        not {
          ~ (queued space count, input point, first non-word character)
          3roll 1+ 3unroll
        } 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
      ~ (queued space count, input point)
    } if-else
  } while drop drop drop ;


~ (string pointer --)
: hex-emit-comment
  hex-comment-second-tab-stop current-column@ > {
    newline
    hex-comment-first-tab-stop dup indent current-column!
    1 is-fresh-line!
    0 n-bytes-this-line!
  } if

  ." ~"
  1 advance-current-column

  dup @ {
    space
    1 advance-current-column
  } 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.
~
~ (file descriptor, base address, length to write -- length written)
: 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.
  over is-in-label-loop-buffer not {
    sys-write exit
  } if
  3roll drop dup 3roll
  ~   The result should be the length written. We just proactively declare
  ~ that we'll write the full length we were asked to, threading that through
  ~ as the result we'll eventually return.
  ~ (result, length to write, base address)

  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
  ~ (result, length to write, base address, initial metadata scan pointer)
  { 2 pick 0 <= } {
    ~ (result, 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
      ~ (result, 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
        ~ (result, 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.
        ~ (result, 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 n-bytes-this-line!
          0 current-column!
        } if

        dup hex-output-metadata-entry-type @
        hex-output-metadata-entry-type-suffix-comment = {
          hex-comment-first-tab-stop current-column@ - 1 max
          dup indent advance-current-column

          dup hex-output-metadata-entry-content @ hex-emit-comment
          newline

          1 is-fresh-line!
          0 n-bytes-this-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 n-bytes-this-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 n-bytes-this-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

          ." ~ "
          0x22 value@ emitstring drop
          dup hex-output-metadata-entry-content @ emitstring
          0x22 value@ emitstring drop
          ."    (string literal with null)"

          newline
          1 is-fresh-line!
          0 n-bytes-this-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

          ." ~ "
          0x22 value@ emitstring drop
          dup hex-output-metadata-entry-content @ emitstring
          0x22 value@ emitstring drop
          ."     (raw string literal)"

          newline
          1 is-fresh-line!
          0 n-bytes-this-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-saved-data = {
          ~   It's not valid to execute these, so print a diagnostic. They're
          ~ supposed to always be consumed by data-* commands.
          ." A saved-data metadata entry leaked." newline
        } 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
    ~ (result, length remaining, current output address,
    ~  metadata scan pointer)

    2 pick {
      n-bytes-this-line@ 16 = {
        newline
        1 is-fresh-line!
        0 n-bytes-this-line!
        0 current-column!
      } if

      is-fresh-line@ {
        indentation-depth@ dup indent advance-current-column
      } {
        space
        1 advance-current-column
      } if-else

      over 8@ .hex8

      2 advance-current-column
      increment-bytes-this-line
      0 is-fresh-line!
    } if
    ~ (result, length remaining, current output address,
    ~  metadata scan pointer)

    3unroll 1+ swap 1- swap 3roll
  } while drop ;

~   This has complex logic, so we do it as a trace rather than with magic
~ comments.
~
~ (new label value, label entry pointer --)
: hex-set-label-trace
  ~   If the value is zero, don't bother making an entry. There's a bunch of
  ~ unused labels set to zero and even if they were used, showing them at the
  ~ start of the file would not provide useful information.
  over 0 = { drop drop exit } if

  ~   Similarly, if the label has its non-offset bit set, we don't need an
  ~ entry for that, either
  ~
  ~   It's worth noting that this bit is set by the code being compiled,
  ~ potentially after it has already called label-set, and therefore after
  ~ this trace. This introduces an ordering dependency, though it's unlikely
  ~ to come up in practice because the bit is kept across label-loop passes
  ~ and as long as there are any forward references there will always be at
  ~ least two passes.
  dup is-label-non-offset { drop drop exit } if

  ~   Recall that label values are offsets within the output file. This is not
  ~ otherwise a requirement, compiled code can use their values for anything
  ~ it wants, but the label transform treats them as offsets and so does the
  ~ ELF code.
  ~
  ~   We want to create metadata entries associated with that offset; recall
  ~ also that entries' data starts are host addresses which must be within
  ~ the label-loop buffer. So...
  over
  transformation-state transformation-state-output-metadata @
  hex-output-metadata-label-loop-buffer-start @ +
  0
  ~ (new label value, label entry pointer, entry data start,
  ~  entry data length)

  2dup hex-output-metadata-entry-type-push-subitem-hex64 7 roll
  add-hex-output-metadata-entry
  ~ (label entry pointer, entry data start, entry data length)

  2dup hex-output-metadata-entry-type-push-subitem-string
  6 roll entry-to-name

  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

  hex-output-metadata-entry-type-line-comment
  s" label # at offset # is here."
  add-hex-output-metadata-entry ;

~ (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" set-label" stringcmp 0 = {
    create dropstring
    s" docol" find entry-to-execution-token execute ,
    make-hidden

    ~ (new label value, label entry pointer --)
    s" 2dup" find entry-to-execution-token ,
    ' hex-set-label-trace 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 comment entry by adjusting its length.
    drop drop swap drop adjust-latest-comment-metadata-entry-length
    exit
  } if
  dup s" adjust-start" stringcmp 0 = {
    ~ Modify the most recent output-producing entry by adjusting its start.
    drop drop swap drop adjust-latest-output-producing-metadata-entry-start
    exit
  } if
  dup s" set-output-point" stringcmp 0 = {
    ~ Override the latest output point.
    drop drop swap drop set-latest-output-point
    exit
  } if
  dup s" adjust-output-point" stringcmp 0 = {
    ~ Modify the latest output point.
    drop drop swap drop adjust-latest-output-point
    exit
  } if

  dup s" data-adjust-length" stringcmp 0 = {
    ~   Modify the most recent comment entry by adjusting its length, also
    ~ using data from the most recent data entry.
    drop drop swap drop data-adjust-latest-comment-metadata-entry-length
    exit
  } if
  dup s" data-adjust-start" stringcmp 0 = {
    ~   Modify the most recent output-producing entry by adjusting its start,
    ~ also using data from the most recent data entry.
    drop drop swap drop
    data-adjust-latest-output-producing-metadata-entry-start
    exit
  } if
  dup s" data-set-output-point" stringcmp 0 = {
    ~   Override the latest output point, also using data from the most recent
    ~ data entry.
    drop drop swap drop data-set-latest-output-point
    exit
  } if
  dup s" data-adjust-output-point" stringcmp 0 = {
    ~   Modify the latest output point, also using data from the most recent
    ~ data entry.
    drop drop swap drop data-adjust-latest-output-point
    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" delete-first-comment-at-output-point" stringcmp 0 = {
    4 ndrop delete-first-comment-metadata-entry-at-output-point
    exit
  } if

  dup s" delete-last-comment-at-output-point" stringcmp 0 = {
    4 ndrop delete-latest-comment-metadata-entry-at-output-point
    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" provide-data" stringcmp 0 = {
    ~ Create a new "push subitem data" entry.
    drop drop
    2 pick hex-output-metadata-entry-type-saved-data swap
    add-hex-output-metadata-entry
    exit
  } if

  ~   Next are the subitem stack manipulation commands. These deal with the
  ~ subitem entry stack, just as the provide-* commands do, but at this phase
  ~ of processing the effect is just to create an entry in the entry array,
  ~ not to do any actual stack manipulation, so their implementations are
  ~ quite simple.
  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 content
    ~ 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.
    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 word runs whenever the log-load 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 log-load-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 log-load transform is
~ different from the behavior of the hex transform.
~
~   This is installed by hex-log-load-word-replacement, bypassing the log-load
~ 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 log-load transform.
: hex-log-load-tilde-alternate
  hex-read-magic-comment-introducer
  ~ (body string pointer, result code)

  {
    ~ It's a magic comment, which may or may not be empty.
    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,
~ hex-label-word-replacement, and hex-log-load-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 ;


~   This word is installed into log-load-transform-one by the
~ hex-word-alternate, when the log-load transform runs inside the hex
~ transform. It has the job of performing substantive changes to the log-load
~ 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-log-load-tilde-alternate any time a tilde is encountered as a
~ word, and to call hex-skip-space before reading a word.
: hex-log-load-word-replacement
  hex-skip-space
  word

  value@
  dup s" ~" stringcmp 0 = {
    ~ We won't be going back to log-load-transform-one; clear away its state.
    drop dropstring

    hex-log-load-tilde-alternate

    ~   Return directly to log-load-transform, faking the "not done" return
    ~ value from log-load-transform-one.
    0
    2 nexit
  } 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 = {
      drop
      ' hex-label-word-replacement entry-to-execution-token ,
      exit
    } if

    dup s" log-load-transform-one" stringcmp 0 = {
      drop
      ' hex-log-load-word-replacement entry-to-execution-token ,
       exit
    } if

    ~ Not in a word we install stuff into.
    drop
    s" word" find entry-to-execution-token ,
  } {
    ~ 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, end the transformation.
  dup 0 = { drop 1 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 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 -- output buffer start, output point)
: hex-transform
  main-input-buffer dup push-input-buffer
  swap attach-string-to-input-buffer
  ~ (output metadata buffer start, output buffer start, output point)

  ~   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 !
  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.
    { transformation-state transformation-state-output-buffer-start @
      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 ;