diff options
| -rw-r--r-- | core.e | 8 | ||||
| -rw-r--r-- | dynamic.e | 370 | ||||
| -rw-r--r-- | evoke.e | 2 | ||||
| -rw-r--r-- | execution.e | 62 | ||||
| -rw-r--r-- | labels.e | 2 | ||||
| -rw-r--r-- | log-load.e | 1 | ||||
| -rw-r--r-- | output.e | 49 | ||||
| -rw-r--r-- | quine.asm | 1 | ||||
| -rw-r--r-- | transform.e | 71 |
9 files changed, 489 insertions, 77 deletions
diff --git a/core.e b/core.e index eeeb1fc..c10ac00 100644 --- a/core.e +++ b/core.e @@ -1238,8 +1238,8 @@ here ! : unpackalign align-size ; -~ Development utilities -~ ~~~~~~~~~~~~~~~~~~~~~ +~ The first hint of a debugging tool +~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~ This peforms the "hlt" instruction (Intel's mnemomic, short for "halt"), ~ which will cause the program to exit with a segmentation fault. If you're @@ -1248,7 +1248,9 @@ here ! ~ ~ It's called "crash" rather than "hlt" to distinguish it from the word ~ which outputs the instruction as machine code. - +~ +~ This is the main diagnostic tool available under the label transform. Yep. +~ That's all we get. Don't make those eyes. : crash [ here @ hlt diff --git a/dynamic.e b/dynamic.e new file mode 100644 index 0000000..7c7ff13 --- /dev/null +++ b/dynamic.e @@ -0,0 +1,370 @@ +~ ~~~~~~~~~~~~~~~~~~~~~~~~~ +~ ~~ Dynamic definitions ~~ +~ ~~~~~~~~~~~~~~~~~~~~~~~~~ +~ +~ This file provides additional facilities which are fundamental parts of +~ Evocation as a language, but which it's not possible to define until global +~ variables are available. Therefore it is incompatible with the label +~ transform, but compatible with the log-load transform and written to obey +~ its constraints; see transform.e for more details on that. +~ +~ The code here relies on the words "log", "s0", "r0", "latest", and "here". +~ These five global variables are the root of all our other data structures. +~ They are defined specially by warm-start in execution.e, since there is no +~ way to create regular definitions for them. Thus, they come to us already +~ set up. +~ +~ It may not be obvious, but when a regular docol-based Evocation word is +~ compiled, it hardcodes pointers to all the words it references, which will +~ be part of it forever after. Thus, these words can reference "here" and so +~ on, and they'll just know where to find it, no runtime mechanism for looking +~ it up is needed. That's important, because there are no good ways to build +~ such a mechanism! It would have to dedicate a register or something of that +~ nature, and registers are far too precious for such a use. +~ +~ In this file, we define a bunch of more sophisticated ways to work with +~ the log, then we use it to define a high-level flow control facility which +~ saves us from having to compute branch offsets by hand. Pleasantly, we get +~ to use this facility before it's actually defined, since the log-load +~ transform also provides it. That being the case, we might as well start with +~ whatever's most urgent - which is, of course, the debugging tools. + + +~ Debugging tools for real +~ ~~~~~~~~~~~~~~~~~~~~~~~~ + +: stack + s0 @ 8 - { dup value@ 8 + != } + { dup s0 @ 8 - != { space } if dup @ . 8 - } + while drop newline ; + +: stackhex + s0 @ 8 - { dup value@ 8 + != } + { dup s0 @ 8 - != { space } if dup @ .hex64 8 - } + while drop newline ; + +~ (pointer -- boolean) +: is-in-log dup log @ <= swap here @ > && ; + +~ (-- entry pointer or 0) +: oldest-entry + latest @ { dup @ } { @ } while ; + +~ (entry pointer -- entry pointer or 0) +: next-newer-entry + latest @ + 2dup = { 2drop 0 exit } if + { dup { 2dup @ != } if } + { @ } while swap drop ; + +~ (entry pointer -- pointer) +: guess-entry-end + dup entry-flags@ 64 & 64 = { exit } if + dup next-newer-entry dup + { drop dup is-in-log { drop here @ } { drop } if-else + exit } unless + swap drop ; + +~ (pointer -- entry pointer or 0) +: containing-entry + dup is-in-log { drop 0 exit } unless + latest @ { dup { 2dup > } { 0 } if-else } + { @ } while swap drop ; + +~ (entry pointer -- boolean) +: is-assembly-word + entry-to-execution-token dup 8 + swap @ = ; + +~ (entry pointer -- boolean) +: is-docol-itself + entry-to-name s" docol" stringcmp 0 = ; + +~ The word named "docol" has the job of returning the value that gets used +~ as the actual codeword. We make the assumption that the codeword will +~ point somewhere near the entry header; we allow for the possibility that +~ it might be before or after. +~ +~ Generally, it's possible for there to be several copies of docol due to +~ alternate logs and things like that, so the goal is to recognize any of +~ them. +~ +~ (entry pointer -- boolean) +: is-docol-codeword + dup is-in-log { drop 0 exit } unless + containing-entry dup + { dup is-docol-itself + { drop 1 } + { next-newer-entry dup { is-docol-itself } if } if-else + } if ; + + +~ TODO this only works on log words +~ +~ (entry pointer -- boolean) +: is-docol-interpreted-word + dup is-assembly-word { drop 0 exit } if + entry-to-execution-token @ is-docol-codeword ; + + +~ (pointer -- boolean) +: is-codeword-pointer + dup is-in-log { drop 0 exit } unless + dup containing-entry dup { 2drop 0 exit } unless + entry-to-execution-token = ; + + +~ (width --) +: indent { dup } { space 1- } while drop ; + +~ (entry pointer --) +: word-heading + dup entry-to-name dup emitstring space + stringlen 1+ 54 swap - 0 max indent dup .hex64 + dup entry-flags@ dup + { space + dup 128 & { s" H" emitstring } if + dup 64 & { s" M" emitstring } if + dup 1 & { s" I" emitstring } if + } if drop + dup is-assembly-word { s" asm" emitstring } + { dup is-docol-interpreted-word { s" raw" emitstring } unless + } if-else drop + newline ; + + +: list-dictionary + oldest-entry { dup } + { dup word-heading next-newer-entry } while drop ; + + +~ (content end, content start, label start --) +: hexdump-row + 2 indent dup .hex32 dup 4 unroll + 0 { dup 16 > } + { dup 7 & 0 = { space } if space + 2dup + dup 4 pick <= swap 5 pick > && + { 2dup + 8@ .hex8 } { space space } if-else + 1+ } while + newline 5 ndrop ; + + +~ (end, start --) +: hexdump-between + dup 16 1- invert & + { dup 3 pick > } + { 3dup hexdump-row 16 + } while 3 ndrop ; + + +~ (start, length --) +: hexdump-from swap dup 3unroll + swap hexdump-between ; + + +~ (start --) +: hexdump 64 hexdump-from ; + + +~ (entry pointer --) +: describe-hex + dup word-heading + dup guess-entry-end swap entry-to-execution-token + hexdump-between ; + + +~ (entry pointer --) +: describe-docol + dup word-heading + dup guess-entry-end swap entry-to-execution-token 8 + + { 2dup < } + { space dup @ dup is-codeword-pointer + { execution-token-to-entry entry-to-name emitstring } + { . } if-else + 8 + } while newline ; + + +~ (entry pointer --) +: describe + dup is-docol-interpreted-word + { describe-docol } { describe-hex } if-else ; + + +: describe-all + oldest-entry { dup } + { dup describe next-newer-entry } while drop ; + + +~ Log manipulation +~ ~~~~~~~~~~~~~~~~ + +~ In general, we're going to want to be able to go on little excursions +~ where we define utility words that are only useful for one task, then +~ deallocate that stuff after we're done with it. We implement "forget", +~ which removes both dictionary entries and heap allocations for the entry +~ pointer it's given and everything that came after. +~ +~ The implementation strategy is the same as Jonesforth's version, but +~ Jonesforth runs in immediate mode and reads a word to operate on, whereas +~ ours takes an entry pointer and runs in either compiled or immediate +~ modes. +~ +~ (entry pointer --) +: forget dup @ latest ! here ! ; + +~ (value --) +: , here @ swap pack64 here ! ; + +~ We'll be defining a lot of immediate words, so we should set up a terse +~ way to do that. +: make-immediate latest @ dup entry-flags@ 0x01 | entry-flags! ; +: make-hidden latest @ dup entry-flags@ 0x80 | entry-flags! ; +: make-visible latest @ dup entry-flags@ 0x80 invert & entry-flags! ; + +~ Sooner or later we'll want to define recursive words; this one lets us +~ do that. It compiles into a call to the word that's currently being +~ defined (strictly speaking, the one whose definition was most recently +~ begun). +: recurse latest @ entry-to-execution-token , ; make-immediate + +~ The word "'", often pronounced "tick", quotes the following word, looking +~ it up and treating it as a constant. In immediate mode, the constant winds +~ up on the stack; in compile mode it gets compiled. +~ +~ There are a few possible implementation strategies here. Running as an +~ immediate word means there's a clear and unambiguous concept of "the +~ following word", so that's what we do; otherwise we'd have to get clever +~ about somehow finding out where we were called from. That means we take on +~ what would otherwise be the interpreter's responsibility, of checking what +~ mode we're in. Happily, that's easy to do. +~ +~ Though it might be nice to have high-level flow control for this, our +~ implementation of "if" below relies on "'" several times, whereas "'" only +~ branches once. So we bootstrap "'" first. +~ : ' word value@ find dropstring-with-result +~ interpreter-flags @ 1 & 0branch [ 2 8 * , ] literal +~ ; make-immediate + + +~ High-level flow-control +~ ~~~~~~~~~~~~~~~~~~~~~~~ +~ +~ We use a novel suffix-based approach to flow control. We define words +~ { and } which describe the boundaries of blocks of code, leaving a +~ description on the value stack, while still compiling the contents +~ normally. +~ +~ Then follow-up words such as "if" can use that information to slide +~ the blocks around and insert any needed branches and other logic. +~ +~ These words get their own file because they of course have very high +~ importance to bootstrapping, and it's useful to be able to see where they +~ fall in the list of files. +~ +~ Both the label transform and the log-load transform go out of their way +~ to make sure these words work. + + +~ ~ (-- start pointer) +~ : { here @ ; make-immediate +~ +~ ~ (start pointer -- start pointer, length) +~ : } dup here @ swap - ; make-immediate +~ +~ +~ ~ (start pointer, length --) +~ : if 2dup swap dup 5 8 * + 3unroll swap +~ +~ ~ (start pointer, length, adjusted start pointer, start pointer, length) +~ memmove +~ ~ (start pointer, length) +~ swap here @ swap here ! swap +~ ~ (old here, length) +~ ' lit entry-to-execution-token , 0 , +~ ' != entry-to-execution-token , +~ ~ 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. +~ ' 0branch entry-to-execution-token , dup 8 + , +~ ~ (old here, length) +~ drop 5 8 * + here ! ; make-immediate +~ +~ +~ ~ (start pointer, length --) +~ : unless 2dup swap dup 5 8 * + 3unroll swap +~ ~ (start pointer, length, start pointer, adjusted start pointer, length) +~ memmove +~ ~ (start pointer, length) +~ swap here @ swap here ! swap +~ ~ (old here, length) +~ ' lit entry-to-execution-token , 0 , +~ ' = entry-to-execution-token , +~ ~ 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. +~ ' 0branch entry-to-execution-token , dup 8 + , +~ ~ (old here, length) +~ drop 5 8 * + here ! ; make-immediate +~ +~ +~ ~ (true start, true length, false start, false length --) +~ : if-else +~ dup 4 roll dup 5 unroll + +~ ~ +~ ~ 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 * + swap 3roll memmove +~ 4 roll dup 5 unroll 4 roll dup 5 unroll +~ swap dup 5 8 * + swap 3roll 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) +~ ' lit entry-to-execution-token , 0 , +~ ' != entry-to-execution-token , +~ ~ Branch past the length field, the true-block, and the unconditional +~ ~ branch in the middle. +~ ' 0branch entry-to-execution-token , +~ 3roll dup 4 unroll 3 8 * + , +~ ~ +~ ~ Next, write out the unconditional branch in the middle. +~ swap dup 3unroll 5 8 * + here ! +~ ' branch entry-to-execution-token , +~ ~ Branch past the length field and the false-block. +~ dup 8 + , +~ ~ +~ ~ Set "here" to point to the true end. +~ drop drop drop drop 7 8 * + here ! +~ ; make-immediate +~ +~ +~ ~ (start, length --) +~ : forever +~ ' branch entry-to-execution-token , 8 + -1 * , drop +~ ; make-immediate +~ +~ +~ ~ This slides the body forward, leaving the test where it is. It puts a +~ ~ conditional branch in-between them, then appends an unconditional branch +~ ~ at the end. +~ ~ +~ ~ (test start, test length, body start, body length --) +~ : while +~ ~ The conditional branch needs five words. +~ 2dup swap dup 5 8 * + swap 3roll memmove +~ here @ 5 unroll swap dup 3unroll here ! +~ ~ (old here, test start, test length, body start, body length) +~ ' lit entry-to-execution-token , 0 , +~ ' != entry-to-execution-token , +~ ~ Branch past the length field, the body, and the unconditional branch. +~ ' 0branch entry-to-execution-token , +~ dup 3 8 * + , +~ ~ Set "here" to the new end. +~ 5 8 * 6 roll + here ! +~ ~ (test start, test length, body start, body length) +~ ~ Unconditionally branch backwards past the branch word, the body, the +~ ~ conditional branch, and the test. +~ ' branch entry-to-execution-token , +~ 6 8 * + swap drop + swap drop -1 * , +~ ; make-immediate +~ diff --git a/evoke.e b/evoke.e index b405ab2..c1ccebc 100644 --- a/evoke.e +++ b/evoke.e @@ -2,7 +2,7 @@ ~ echo 262144 read-to-buffer; \ ~ cat core.e linux.e output.e amd64.e execution-support.e log-load.e; \ ~ echo pyrzqxgl 262144 read-to-buffer; \ -~ cat core.e linux.e output.e; \ +~ cat core.e linux.e output.e amd64.e execution-support.e dynamic.e; \ ~ echo 0 sys-exit pyrzqxgl; \ ~ cat evoke.e) \ ~ | ./quine > evoke && chmod 755 evoke && ./evoke diff --git a/execution.e b/execution.e index 2c8b869..e1b894d 100644 --- a/execution.e +++ b/execution.e @@ -27,7 +27,7 @@ ~ ~ We adopt this model of words, codewords, and variables-as-words. It's ~ really nice how it doesn't force anything else on us, not even a heap, -~ though we do end up using a heap. +~ though we do end up using the log as a sort-of heap. ~ ~ We specifically implement a version of calling and returning that Forth ~ calls indirect threaded code: The control stack is a stack of pointers @@ -48,8 +48,8 @@ ~ Notionally, we could consider not having a dictionary, and not giving ~ our words names. However, it feels silly to stop when we're so close to ~ being a full Forth, and using names for things solves a bootstrapping -~ problem related to heap management - see the write-up of _start about how -~ the heap is created, below. So, we add an additional header before the +~ problem related to log management - see the write-up of cold-start about +~ how the log is created, below. So, we add an additional header before the ~ codeword for this purpose. ~ ~ The Forth dictionary is usually a linked list of every word that has @@ -153,8 +153,8 @@ ~ ~ These are used in cold-start, just below. -: heap-requested-address 0x0000001000000000 ; ~ (very arbitrary) -: heap-size 0x0000000001000000 ; ~ 16 MiB +: log-requested-address 0x0000001000000000 ; ~ (very arbitrary) +: log-size 0x0000000001000000 ; ~ 16 MiB : control-stack-size 0x10000 ; ~ 64 KiB @@ -205,14 +205,14 @@ ~ ~ Stack out: ~ -~ * The value of "heap", as a pointer +~ * The value of "log", as a pointer ~ The meaning of this will be explained below. ~ ~ Registers within: ~ -~ * rdi points to the base the heap was allocated at, once it exists -~ This is the same value that "heap" will hold, once we reach a point -~ where we have variables. Of course, variables are stored on the heap, +~ * rdi points to the base the log was allocated at, once it exists +~ This is the same value that "log" will hold, once we reach a point +~ where we have variables. Of course, variables are stored on the log, ~ hence this temporary measure. ~ ~ We also take this opportunity to define soeme memory layout parameters @@ -224,7 +224,7 @@ current-offset L' cold-start set-label cld ~ clear the DF flag - ~ Prepare the heap. + ~ Prepare the log. ~ ~ We could ask for a data segment in the program header, but where's the ~ fun in that? Instead, we call mmap(). @@ -237,8 +237,8 @@ ~ interoperating with other runtimes. ~ 9 :rax mov-reg64-imm64 ~ mmap() - heap-requested-address :rdi mov-reg64-imm64 ~ address (very arbitrary) - heap-size :rsi mov-reg64-imm64 ~ size (one meg) + log-requested-address :rdi mov-reg64-imm64 ~ address (very arbitrary) + log-size :rsi mov-reg64-imm64 ~ size (one meg) 0x07 :rdx mov-reg64-imm64 ~ protection (read+write+exec) 0x22 :r10 mov-extrareg64-imm64 ~ flags (private+anonymous) 0 :r8 mov-extrareg64-imm64 ~ file descriptor (ignored) @@ -251,20 +251,20 @@ ~ are widely-used names for the physical tops (logical bottoms) of the ~ value and control stacks, respectively, and we will eventually set those ~ up as well, so we should keep those names in mind. The control stack - ~ lives within the heap, while the value stack is its own segment. This + ~ lives within the log, while the value stack is its own segment. This ~ value, though, is the physical bottom of the segment, meaning that it ~ stays the same even as we allocate and deallocate things within it. This ~ is unlike the two stack pointers, so we give it a name that doesn't - ~ suggest similarity: "heap". + ~ suggest similarity: "log". ~ ~ Once Forth is fully set up, its internal variables will be accessed - ~ through variable-words like any other Forth data, including "heap". To + ~ through variable-words like any other Forth data, including "log". To ~ get to that point, though, we need to be able to hold onto variable data - ~ between now and then. In fact, if we don't have at least one of "heap" + ~ between now and then. In fact, if we don't have at least one of "log" ~ and "here" (its counterpart which points to the logical top end), all ~ our efforts to hold onto anything seem a bit doomed. ~ - ~ So, we temporarily dedicate rdi to "heap" - only within this routine - + ~ So, we temporarily dedicate rdi to "log" - only within this routine - ~ and store everything else in ways that let us find things by reference ~ to it. We choose rdi because it works with the indexing modes we care ~ about, and its name suggests its function. @@ -274,7 +274,7 @@ ~ pre-allocated objects in the data segment. We are our own linker, and we ~ don't care to have a data segment. Hence, this approach. ~ - ~ Keying things off "heap" is the fundamental decision, but to make sure + ~ Keying things off "log" is the fundamental decision, but to make sure ~ our variables are accessible both during early bootstrapping, and later, ~ we also have to be thoughtful about data structures. More on that in a ~ moment. @@ -293,17 +293,17 @@ ~ :rdi control-stack-size :rbp lea-reg64-disp32-reg64 - ~ Now we save some stuff onto the heap. These are the locations that + ~ Now we save some stuff onto the log. These are the locations that ~ will eventually be the backing stores of the Forth variables, but we ~ don't create the word headers yet, since there's no requirement that ~ they be next to the backing stores. We'll do that later, once we have ~ word-writing infrastructure in place. For now, we just use their offsets - ~ relative to the physical bottom of the heap, which are fixed. + ~ relative to the physical bottom of the log, which are fixed. ~ ~ These will be the permanent homes of these values, though we have ~ copies of them elsewhere while we're still in this routine. ~ - :rdi control-stack-size 0x00 + :rdi mov-reg64-disp32-reg64 ~ heap + :rdi control-stack-size 0x00 + :rdi mov-reg64-disp32-reg64 ~ log :rsp control-stack-size 0x08 + :rdi mov-reg64-disp32-reg64 ~ s0 :rbp control-stack-size 0x10 + :rdi mov-reg64-disp32-reg64 ~ r0 L@' final-word-name :rax mov-reg64-imm64 @@ -311,8 +311,8 @@ :rdi control-stack-size 0x28 + :rax lea-reg64-disp32-reg64 :rax control-stack-size 0x20 + :rdi mov-reg64-disp32-reg64 ~ here ~ - ~ * "heap" is the physical bottom of the heap - ~ The heap grows upwards in memory, so this is also the logical + ~ * "log" is the physical bottom of the log + ~ The log grows upwards in memory, so this is also the logical ~ bottom. This comes from the address mmap() just returned to us. ~ * "s0" is the logical bottom of the value stack ~ The value stack grows downwards in memory, so this is the physical @@ -320,10 +320,10 @@ ~ with. ~ * "r0" is the logical bottom of the control stack ~ The control stack also grows downwards, so this is its pysical top - ~ as well. We allocate this dedicated space within the heap right here, + ~ as well. We allocate this dedicated space within the log right here, ~ in this routine, through our choice of where to put things. - ~ * "here" is the physical start of the unallocated space in the heap - ~ We allocate heap space from bottom to top, by incrementing this + ~ * "here" is the physical start of the unallocated space in the log + ~ We allocate log space from bottom to top, by incrementing this ~ value. So, it would also be accurate to say that it points immediately ~ after the physical top of the allocated space. At any rate, the ~ address it points to is the first one that hasn't been used yet. @@ -350,8 +350,8 @@ ~ ~ A little more detail about why we offset everything by ~ control_stack_size: We're carving out some space at the bottom of the - ~ heap - which grows low-to-high - to be the control stack - which grows - ~ high-to-low. So the control stack is allocated out of the heap as a + ~ log - which grows low-to-high - to be the control stack - which grows + ~ high-to-low. So the control stack is allocated out of the log as a ~ fixed-size, one-time thing, and then the variables come immediately ~ after that. We do need to use 32-bit displacement indexing to access ~ them this way, but that's no big deal. @@ -364,9 +364,9 @@ ~ headers that point at them, but now we're almost ready to switch to ~ proper threaded-execution, so we finish that setup first... - ~ Push the value of "heap" onto the value stack so that it can be the + ~ Push the value of "log" onto the value stack so that it can be the ~ breadcrumb the threaded code needs to find... the backing store of - ~ "heap". Yes, self-reference can be weird like that sometimes. There's + ~ "log". Yes, self-reference can be weird like that sometimes. There's ~ nothing stopping "quit" from reading rdi, it just violates the ~ abstraction... :rdi push-reg64 @@ -417,7 +417,7 @@ ~ ASLR, or embedding into other processes that impose their own addressing ~ constraints, or even coexisting with multiple versions of ourselves. ~ That choice does mean we have the hard version of this bootstrapping - ~ problem, and copying ourselves to the heap is how we solve it. + ~ problem, and copying ourselves to the log is how we solve it. ~ ~ We do have the log address right now, though that won't last. In case ~ it's unclear why not: keeping it on the stack would require all future diff --git a/labels.e b/labels.e index dcb3914..d3d95ac 100644 --- a/labels.e +++ b/labels.e @@ -288,7 +288,7 @@ 0 swap ~ TODO every time you double this to fix a crash, you must publicly ~ apologize for deferring a real fix. those are the rules - 0x40000 allocate dup + 0x80000 allocate dup ~ (iteration count, execution token, output start, output point) { 3 pick 100 > } { 2 pick execute 4 roll 1+ 4 unroll diff --git a/log-load.e b/log-load.e index 927ff38..1406270 100644 --- a/log-load.e +++ b/log-load.e @@ -553,7 +553,6 @@ ~ (test start, test length, body start, body length, log address ~ -- log address) : log-load-while - ." at start " stackhex 5 unroll 2dup ~ (log address, test start, test length, body start, body length, ~ body start, body length) diff --git a/output.e b/output.e index fe777b8..80f1577 100644 --- a/output.e +++ b/output.e @@ -191,28 +191,29 @@ ~ Debugging tools ~ ~~~~~~~~~~~~~~~ -~ ~ TODO this is a horrible, horrible hack -: s0-kludge 0x1000010008 ; - -~ TODO replace these with the implementations that use proper flow-control -: stack - s0-kludge @ 8 - - - dup value@ 8 + != - 0branch [ 19 8 * , ] - dup s0-kludge @ 8 - != 0branch [ 2 8 * , ] space dup @ . 8 - - branch [ -25 8 * , ] - - drop newline ; - - -: stackhex - s0-kludge @ 8 - - - dup value@ 8 + != - 0branch [ 19 8 * , ] - dup s0-kludge @ 8 - != 0branch [ 2 8 * , ] space dup @ .hex64 8 - - branch [ -25 8 * , ] - - drop newline ; +~ TODO remove these altogether, they're in dynamic.e now +~ ~ ~ TODO this is a horrible, horrible hack +~ : s0-kludge 0x1000010008 ; +~ +~ ~ TODO replace these with the implementations that use proper flow-control +~ : stack +~ s0-kludge @ 8 - +~ +~ dup value@ 8 + != +~ 0branch [ 19 8 * , ] +~ dup s0-kludge @ 8 - != 0branch [ 2 8 * , ] space dup @ . 8 - +~ branch [ -25 8 * , ] +~ +~ drop newline ; +~ +~ +~ : stackhex +~ s0-kludge @ 8 - +~ +~ dup value@ 8 + != +~ 0branch [ 19 8 * , ] +~ dup s0-kludge @ 8 - != 0branch [ 2 8 * , ] space dup @ .hex64 8 - +~ branch [ -25 8 * , ] +~ +~ drop newline ; diff --git a/quine.asm b/quine.asm index 2e967d8..5c085ef 100644 --- a/quine.asm +++ b/quine.asm @@ -11743,6 +11743,7 @@ defword boot_source, 0x40 ; way to do that. dq ": make-immediate latest @ set-word-immediate ; " dq ": make-hidden latest @ hide-entry ; " + dq ": make-visible latest @ unhide-entry ; " ; The word "'" quotes the following word, looking it up and treating it as ; a constant. In immediate mode, the constant winds up on the stack; in diff --git a/transform.e b/transform.e index d4c1c43..d917601 100644 --- a/transform.e +++ b/transform.e @@ -479,9 +479,6 @@ allocate-transform-state s" transform-state" variable 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 - ~ The following is a deliberate omission: s0. - dup s" stack" stringcmp 0 = { drop 0 exit } if - dup s" stackhex" stringcmp 0 = { drop 0 exit } if ~ From amd64.e. dup s" :rax" stringcmp 0 = { drop 1 exit } if @@ -691,8 +688,44 @@ allocate-transform-state s" transform-state" variable dup s" pack-pushcontrol" stringcmp 0 = { drop -1 exit } if dup s" pack-popcontrol" stringcmp 0 = { drop -1 exit } if - ~ Word not provided statically, but used during the log-load routine anyway. + ~ 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" 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 + + ~ 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" [" stringcmp 0 = { drop 0 exit } if dup s" ]" stringcmp 0 = { drop 0 exit } if dup s" :" stringcmp 0 = { drop 0 exit } if @@ -700,7 +733,6 @@ allocate-transform-state s" transform-state" variable dup s" ;asm" stringcmp 0 = { drop 0 exit } if dup s" L@'" stringcmp 0 = { drop 1 exit } if dup s" L!'" stringcmp 0 = { drop -1 exit } if - dup s" ," stringcmp 0 = { drop -1 exit } if dup s" foo" stringcmp 0 = { drop 0 exit } if ~ DO NOT SUBMIT ~ If we get here, that's a problem. Emit an error message to make sure @@ -1693,20 +1725,27 @@ allocate-transform-state s" transform-state" variable : log-load-comma-alternate - log-load-roll-log-address + ~ 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 + swap-transform-variables + L@' log-load-comma + L@' swap + swap-transform-variables - offset-to-target-address-space , ~ swap - offset-to-target-address-space , ~ log-load-comma + offset-to-target-address-space , ~ swap + offset-to-target-address-space , ~ log-load-comma - ~ We consumed the value, so we apply a delta. - -1 transform-apply-stack-delta + ~ We consumed the value, so we apply a delta. + -1 transform-apply-stack-delta - log-load-roll-log-address + log-load-roll-log-address + } if-else ; make-immediate @@ -1955,7 +1994,7 @@ allocate-transform-state s" transform-state" variable ~ (start pointer, length) -: label-unless-alternate +: log-load-unless-alternate log-load-roll-log-address swap-transform-variables |