~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~ ~~ Top-level executable builders ~~ ~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~ ~ Although it's perfectly possible to manually invoke the pieces of the ~ compiler, it's inconvenient to do so. This file has helper words which kick ~ off the process of compilation from the top level. ~ ~ The two most important words in the top-level facility are "enchant", ~ which produces an executable binary, and "inscribe", which produces a ~ commented hex dump corresponding to that same binary. ~ ~ Significant effort has been expended to make sure that the interfaces to ~ "enchant" and "inscribe" are the same, despite them notionally existing at ~ different levels of abstraction. : compilation-definition-top-level-filename ; : compilation-definition-executable-type 8 + ; : compilation-definition-static-filenames 2 8 * + ; : compilation-definition-dynamic-filenames 3 8 * + ; : compilation-definition-boot-filenames 4 8 * + ; : compilation-definition-compile-header 5 8 * + ; : compilation-definition-compile-body 6 8 * + ; : compilation-definition-compile-footer 7 8 * + ; : allocate-compilation-definition 8 8 * allocate ; s" :raw-executable" keyword s" :forth-executable" keyword ~ (definition structure pointer --) : zero-compilation-definition dup compilation-definition-top-level-filename 0 swap ! dup compilation-definition-executable-type 0 swap ! dup compilation-definition-static-filenames 0 swap ! dup compilation-definition-dynamic-filenames 0 swap ! dup compilation-definition-boot-filenames 0 swap ! dup compilation-definition-compile-header 0 swap ! dup compilation-definition-compile-body 0 swap ! dup compilation-definition-compile-footer 0 swap ! drop ; ~ This accepts a pointer to an existing buffer for file contents to be ~ appended to, and another pointer to the start of a packed list of filenames. ~ The filename list consists of null-terminated strings, all directly abutting ~ each other in memory, terminated by a zero-length string (which can also ~ be thought of as a freestanding null byte). ~ ~ It reads the contents of the named files into the buffer, with no ~ separation between them, and returns a pointer to the end of the contents. ~ ~ (buffer point, filename list point -- buffer point) : read-inputs-from-filename-list ~ (buffer point, filename list point) { dup 8@ } { dup 3roll swap pack-file-contents swap dup stringlen 1+ + } while drop ; ~ (static source filename list, dynamic source filename list, boot source ~ filename list -- source to label transform, source to log-load transform, ~ boot source) : read-inputs 2 pick { here @ dup ~ (static source filename list, dynamic source filename list, ~ boot source filename list, source to label-transform, buffer point) 4 pick read-inputs-from-filename-list 0 pack8 8 packalign here ! } { 0 } if-else ~ (static source filename list, dynamic source filename list, ~ boot source filename list, source to label-transform) 3 pick 3 pick || { here @ dup ~ (static source filename list, dynamic source filename list, ~ boot source filename list, source to label-transform, ~ source to log-load transform, buffer point) 5 pick dup { read-inputs-from-filename-list } { drop } if-else 4 pick dup { read-inputs-from-filename-list } { drop } if-else 0 pack8 8 packalign here ! } { 0 } if-else ~ (static source filename list, dynamic source filename list, ~ boot source filename list, source to label-transform, ~ source to log-load transform) 2 pick { here @ dup ~ (static source filename list, dynamic source filename list, ~ boot source filename list, source to label-transform, ~ source to log-load transform, boot source, buffer point) 4 pick read-inputs-from-filename-list 0 pack8 8 packalign here ! } { 0 } if-else ~ (static source filename list, dynamic source filename list, ~ boot source filename list, source to label-transform, ~ source to log-load transform, boot source) 4 roll drop 4 roll drop 4 roll drop ; ~ (output memory start, current output point, definition structure pointer, ~ source to label-transform, source to log-load transform, boot source ~ -- output memory start, current output point) : output-contents 6 roll 6 roll ~ (definition structure pointer, source to label-transform, ~ source to log-load transform, boot source, output memory start, ~ current output point) ~ Switch based on the executable type. 5 pick compilation-definition-executable-type @ ~ (definition structure pointer, source to label-transform, ~ source to log-load transform, boot source, output memory start, ~ current output point, executable type) dup :raw-executable = { drop 3roll drop 3roll drop 3roll drop ~ (definition structure pointer, output memory start, current output point) ~ Invoke the provided header callback, if it's nonzero. 2 pick compilation-definition-compile-header @ dup { execute } { drop } if-else ~ Invoke the provided body callback, if it's nonzero. 2 pick compilation-definition-compile-body @ dup { execute } { drop } if-else ~ Invoke the provided footer callback, if it's nonzero. 2 pick compilation-definition-compile-footer @ dup { execute } { drop } if-else 3roll drop ~ (output memory start, current output point) exit } if dup :forth-executable = { drop ~ (definition structure pointer, source to label-transform, ~ source to log-load transform, boot source, output memory start, ~ current output point) ~ Invoke the provided header callback, if it's nonzero. 5 pick compilation-definition-compile-header @ dup { execute } { drop } if-else elf-file-header elf-program-header output-cold-start ~ Warm start and the log-loaded source. output-warm-start-header 4 roll log-load-transform ~ (definition structure pointer, source to label-transform, boot source, ~ output memory start, current output point) output-warm-start-post-log-load-transform output-warm-start-attach-boot-source output-warm-start-footer ~ The label-transformed source. 4 roll label-transform ~ (definition structure pointer, boot source, output memory start, ~ current output point, final entry pointer) 3unroll ~ Invoke the provided body callback, if it's nonzero. 4 pick compilation-definition-compile-body @ dup { execute } { drop } if-else 3roll ~ The boot source. 4 roll output-boot-source ~ (definition structure pointer, output memory start, ~ current output point) ~ Invoke the provided footer callback, if it's nonzero. 2 pick compilation-definition-compile-footer @ dup { execute } { drop } if-else 3roll drop ~ (output memory start, current output point) exit } if ." Invalid executable type in compilation definition." 1 sys-exit ; ~ Given a compilation-definition structure which is a description of an ~ executable, compile and output that executable as runnable binary, to ~ standard output. ~ ~ (definition structure pointer --) : enchant-from-definition ~ We do this work here, rather than inside output-contents, because it ~ would be wasteful to do it in every iteration of the label-loop. dup dup dup compilation-definition-boot-filenames @ 3unroll compilation-definition-dynamic-filenames @ 3unroll compilation-definition-static-filenames @ 3unroll read-inputs ~ (definition structure pointer, source to label-transform, ~ source to log-load transform, boot source) ~ We need an execution token to pass to label-loop. There's no reason to ~ create a dictionary entry for it; we just allocate space for the ~ executable word body directly. here @ docol , 5 roll literal 4 roll literal 3 roll literal swap literal x' output-contents , x' exit , label-loop 1 3unroll sys-write bye ; ~ Look up the word "latest-executable-data" dynamically, thus taking the ~ most recent copy of it at runtime, invoke it, and use the resulting value ~ as the compilation definition for enchant-from-definition. ~ ~ The typical way to use this word is immediately after including the ~ top-level source file of the executable you want to enchant. : enchant s" latest-executable-data" find entry-to-execution-token execute enchant-from-definition ; ~ Given a compilation-definition structure which is a description of an ~ executable, compile and output that executable as commented hex dump, to ~ standard output. Processing that hex dump through "hex" will give an ~ identical binary to what "enchant" would have produced, with the same ~ inputs. ~ ~ Please notice that if the thing we're compiling is "evoke" and its list ~ of source files has changed, we'll be working with the new list, not ~ the old list. This is the same as what "enchant" does, and it's strictly ~ preferable behavior. We match the behavior of enchant as closely as ~ possible in terms of what's taken from the host compiler vs. the compiler ~ being compiled; see the description of "enchant", above, for more details ~ and discussion of the implications. ~ ~ (definition structure pointer --) : inscribe-from-definition ~ If we're inscribing something other than "evoke", we need to load ~ evoke's source also, first. s" evoke-executable-data" find dup { entry-to-execution-token execute } if swap ~ We begin by constructing the full text of all the source that will be ~ run inside the scope of the hex transform. That necessarily includes not ~ only the compilation machinery, but the transformation system. Notably ~ it does not need to include "inscribe", but does need to include ~ "enchant", and having a stray unused copy of inscribe is harmless, so we ~ don't try to exclude it. here @ dup ~ (parent definition structure pointer, definition structure pointer, ~ hex-transformed source pointer, output point) 3 pick 3 pick != { 3 pick compilation-definition-static-filenames @ dup { read-inputs-from-filename-list } { drop } if-else } if 2 pick compilation-definition-static-filenames @ dup { read-inputs-from-filename-list } { drop } if-else 3 pick 3 pick != { 3 pick compilation-definition-dynamic-filenames @ dup { read-inputs-from-filename-list } { drop } if-else } if 2 pick compilation-definition-dynamic-filenames @ dup { read-inputs-from-filename-list } { drop } if-else 3 pick 3 pick != { 3 pick compilation-definition-boot-filenames @ dup { read-inputs-from-filename-list } { drop } if-else } if 2 pick compilation-definition-boot-filenames @ dup { read-inputs-from-filename-list } { drop } if-else 4 roll drop ~ (definition structure pointer, hex-transformed source pointer, ~ output point) ~ The top-level source file will try to look up its own filename, but this ~ is all on standard input, so it doesn't have one. We must deceive it! s" : current-input-file-name [ s" pack-raw-string ~ Outputting quotation marks is, as always, a pain. 0x22 pack8 s" " pack-raw-string 2 pick compilation-definition-top-level-filename @ pack-raw-string 0x22 pack8 s" literal-string ] ; " pack-raw-string ~ Having set that up, now we can include the actual top-level file. 2 pick compilation-definition-top-level-filename @ pack-file-contents ~ We need to create a call to "enchant" in the code under transformation. ~ That call doesn't need to be arrived at in exactly the same way as an ~ independent call would be, since it doesn't become part of the output, it ~ only needs to have the same effect. ~ ~ With that said, though, since one way or another it's going to be ~ looking up latest-executable-data dynamically, there's no reason to try ~ any sophisticated means of passing individual fields or anything. ~ ~ It might seem as if that's an unnecessary level of indirection, but for ~ the two compile hooks we specifically need to make sure the enchantment ~ uses the copies of them that are under the hex transform. So, one way or ~ another it's always relying on the code from the top-level source file. s" enchant" pack-raw-string ~ (definition struction pointer, hex-transformed source pointer, ~ output point) 0 pack8 8 packalign here ! ~ That's everything we need from the definition. swap drop ~ (hex-transformed source pointer) 1024 1024 4 * * allocate 1024 1024 8 * * allocate ~ (hex-transformed source pointer, binary buffer pointer, ~ metadata buffer pointer) swap dup 4 roll hex-transform bye ; ~ Look up the word "latest-executable-data" dynamically, thus taking the ~ most recent copy of it at runtime, invoke it, and use the resulting value ~ as the compilation definition for enchant-from-definition. ~ ~ The typical way to use this word is immediately after including the ~ top-level source file of the executable you want to inscribe. : inscribe s" latest-executable-data" find entry-to-execution-token execute inscribe-from-definition ;