From 2d9bed2e8e1b8fc3a08c3209d9528b52e3251812 Mon Sep 17 00:00:00 2001 From: Irene Knapp Date: Tue, 6 Oct 2026 17:43:31 -0700 Subject: rework the interface to "enchant" to support different kinds of executables so, in particular, "hex" now builds with the new syntax to implement this, "enchant" now passes the full structure through to "output-contents", which makes it easier to extend. additionally, when inscribing, the source of "evoke" needs to be included in the scope of the hex transform even when the program being compiled is something else, so that it can carefully interfere with the other transforms. this is now implemented, though in an inelegant way that could do with some cleanup. (that last sentence could be the slogan of the whole project :D) Change-Id: I553afadba350a62d6e97a21df2b3e821685b9c0c Force-Push: yes --- compilation/top-level.e | 247 +++++++++++++++++++++++++++++++++--------------- 1 file changed, 171 insertions(+), 76 deletions(-) (limited to 'compilation/top-level.e') diff --git a/compilation/top-level.e b/compilation/top-level.e index 7c714cb..0cc5a93 100644 --- a/compilation/top-level.e +++ b/compilation/top-level.e @@ -16,13 +16,30 @@ : compilation-definition-top-level-filename ; -: compilation-definition-static-filenames 8 + ; -: compilation-definition-dynamic-filenames 2 8 * + ; -: compilation-definition-boot-filenames 3 8 * + ; -: compilation-definition-compile-header 4 8 * + ; -: compilation-definition-compile-footer 5 8 * + ; +: 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 - 6 8 * allocate ; + 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 @@ -44,84 +61,137 @@ ~ (static source filename list, dynamic source filename list, boot source -~ filename list -- source to precompile, source to copy to log, -~ source to copy textually) +~ filename list -- source to label transform, source to log-load transform, +~ boot source) : read-inputs - here @ dup - ~ (static source filename list, dynamic source filename list, - ~ boot source filename list, source to precompile, buffer point) - 4 pick read-inputs-from-filename-list - 0 pack8 8 packalign here ! - ~ (static source filename list, dynamic source filename list, - ~ boot source filename list, source to precompile) - - here @ dup - ~ (static source filename list, dynamic source filename list, - ~ boot source filename list, source to precompile, source to copy to log, - ~ buffer point) - 5 pick read-inputs-from-filename-list - 4 pick read-inputs-from-filename-list - 0 pack8 8 packalign here ! + 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 precompile, source to copy to log) - - here @ dup + ~ 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 precompile, source to copy to log, - ~ source to copy textually, buffer point) - 4 pick read-inputs-from-filename-list - 0 pack8 8 packalign here ! + ~ 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 precompile, source to copy to log, - ~ source to copy textually) + ~ 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, -~ compile-header execution token, compile-footer execution token, -~ source to precompile, source to copy to log, source to include textually +~ (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 - 7 roll 7 roll - ~ (compile-header execution token, compile-footer execution token, - ~ source to precompile, source to copy to log, source to include textually, - ~ output memory start, current output point) - - ~ Invoke the provided header callback. - 7 roll execute - ~ (compile-footer execution token, source to precompile, - ~ source to copy to log, source to include textually, output memory start, + 6 roll 6 roll + ~ (definition structure pointer, source to label-transform, + ~ source to log-load transform, boot source, output memory start, ~ current output point) - elf-file-header - elf-program-header + ~ 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) - output-cold-start + dup :raw-executable = { + drop 3roll drop 3roll drop 3roll drop + ~ (definition structure pointer, output memory start, current output point) - ~ Warm start and the log-loaded source. - output-warm-start-header - 4 roll log-load-transform - ~ (compile-footer execution token, source to precompile, - ~ source to include textually, output memory start, current output point) - output-warm-start-post-log-load-transform - output-warm-start-attach-boot-source - output-warm-start-footer + ~ Invoke the provided header callback, if it's nonzero. + 2 pick compilation-definition-compile-header @ + dup { execute } { drop } if-else - ~ The label-transformed source. - 4 roll label-transform - ~ (compile-footer execution token, source to include textually, - ~ output memory start, current output point, final entry pointer) + ~ Invoke the provided body callback, if it's nonzero. + 2 pick compilation-definition-compile-body @ + dup { execute } { drop } if-else - ~ The boot source. - 4 roll output-boot-source - ~ (compile-footer execution token, 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 + + 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 - ~ Invoke the provided footer callback. - 3roll execute - ~ (output memory start, current output point) - ; + 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 @@ -130,21 +200,22 @@ ~ ~ (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 precompile, - ~ source to copy to log, source to copy textually) + ~ (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 , - 4 pick compilation-definition-compile-header @ literal - 4 pick compilation-definition-compile-footer @ literal + 5 roll literal 4 roll literal 3 roll literal swap literal @@ -183,6 +254,11 @@ ~ ~ (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 @@ -190,17 +266,36 @@ ~ "enchant", and having a stray unused copy of inscribe is harmless, so we ~ don't try to exclude it. here @ dup - ~ (definition structure pointer, hex-transformed source pointer, - ~ output point) + ~ (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 @ - read-inputs-from-filename-list + 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 @ - read-inputs-from-filename-list + 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 @ - read-inputs-from-filename-list + 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! -- cgit 1.4.1