diff options
| -rw-r--r-- | core.e | 2 | ||||
| -rw-r--r-- | execution.e | 40 | ||||
| -rw-r--r-- | interpret.e | 6 | ||||
| -rw-r--r-- | transform.e | 340 |
4 files changed, 198 insertions, 190 deletions
diff --git a/core.e b/core.e index 1d7d7bb..f605296 100644 --- a/core.e +++ b/core.e @@ -1225,7 +1225,7 @@ here ! ~ It's possible the padding will be of length zero, so we have to put the ~ magic comment provide-* command first. ~ : provide-decimal - ~ : 0 (width # alignment padding) + ~ : 0 #-- (width # alignment padding) { 2dup /% drop { drop exit } unless swap 0 pack8 swap ~ : 1 adjust-length diff --git a/execution.e b/execution.e index 3800e16..536bcbf 100644 --- a/execution.e +++ b/execution.e @@ -508,44 +508,44 @@ ~ within itself. L@' log-load-log offset-to-target-address-space pack64 - ~ : -8 log-load-log (codeword pointer) + ~ : -8 log-load-log #-- (codeword pointer) L@' litstring offset-to-target-address-space pack64 - ~ : -8 litstring (codeword pointer) + ~ : -8 litstring #-- (codeword pointer) s" log" packstring 8 packalign L@' log-load-variable offset-to-target-address-space pack64 - ~ : -8 log-load-variable (codeword pointer) + ~ : -8 log-load-variable #-- (codeword pointer) L@' log-load-s0 offset-to-target-address-space pack64 - ~ : -8 log-load-s0 (codeword pointer) + ~ : -8 log-load-s0 #-- (codeword pointer) L@' litstring offset-to-target-address-space pack64 - ~ : -8 litstring (codeword pointer) + ~ : -8 litstring #-- (codeword pointer) s" s0" packstring 8 packalign L@' log-load-variable offset-to-target-address-space pack64 - ~ : -8 log-load-variable (codeword pointer) + ~ : -8 log-load-variable #-- (codeword pointer) L@' log-load-r0 offset-to-target-address-space pack64 - ~ : -8 log-load-r0 (codeword pointer) + ~ : -8 log-load-r0 #-- (codeword pointer) L@' litstring offset-to-target-address-space pack64 - ~ : -8 litstring (codeword pointer) + ~ : -8 litstring #-- (codeword pointer) s" r0" packstring 8 packalign L@' log-load-variable offset-to-target-address-space pack64 - ~ : -8 log-load-variable (codeword pointer) + ~ : -8 log-load-variable #-- (codeword pointer) L@' log-load-latest offset-to-target-address-space pack64 - ~ : -8 log-load-latest (codeword pointer) + ~ : -8 log-load-latest #-- (codeword pointer) L@' litstring offset-to-target-address-space pack64 - ~ : -8 litstring (codeword pointer) + ~ : -8 litstring #-- (codeword pointer) s" latest" packstring 8 packalign L@' log-load-variable offset-to-target-address-space pack64 - ~ : -8 log-load-variable (codeword pointer) + ~ : -8 log-load-variable #-- (codeword pointer) L@' log-load-here offset-to-target-address-space pack64 - ~ : -8 log-load-here (codeword pointer) + ~ : -8 log-load-here #-- (codeword pointer) L@' litstring offset-to-target-address-space pack64 - ~ : -8 litstring (codeword pointer) + ~ : -8 litstring #-- (codeword pointer) s" here" packstring 8 packalign L@' log-load-variable offset-to-target-address-space pack64 - ~ : -8 log-load-variable (codeword pointer) + ~ : -8 log-load-variable #-- (codeword pointer) ~ Having done that, nothing else needs to be defined in an unusual way, so ~ we can go ahead and dispatch to the log-load transform, and do the rest of @@ -568,17 +568,17 @@ ~ The next layer is built now, so let's move on to it. L@' litstring offset-to-target-address-space pack64 - ~ : -8 litstring (codeword pointer) + ~ : -8 litstring #-- (codeword pointer) s" quit" packstring 8 packalign L@' log-load-find-execution-token offset-to-target-address-space pack64 - ~ : -8 log-load-find-execution-token (codeword pointer) + ~ : -8 log-load-find-execution-token #-- (codeword pointer) L@' swap offset-to-target-address-space pack64 - ~ : -8 swap (codewored pointer) + ~ : -8 swap #-- (codewored pointer) ~ : Get rid of that heap pointer on the stack, we're finally done with it! L@' drop offset-to-target-address-space pack64 - ~ : -8 drop (codeword pointer) + ~ : -8 drop #-- (codeword pointer) L@' execute offset-to-target-address-space pack64 - ~ : -8 execute (codeword pointer) + ~ : -8 execute #-- (codeword pointer) ~ : deindent ; diff --git a/interpret.e b/interpret.e index 92b2035..7d5d429 100644 --- a/interpret.e +++ b/interpret.e @@ -414,7 +414,7 @@ latest @ ~ because that could be relevant to end-user code that compiles things ~ without using the transforms, but in the regular compiler it's not used ~ because the transforms override this whole implementation. - lit exit , ~ : -8 exit (codeword pointer) + lit exit , ~ : -8 exit #-- (codeword pointer) make-visible ~ See above regarding [. Since it's an immediate word, we have to go to ~ extra trouble to compile it as part of ;. Since it's also hidden, we have @@ -466,7 +466,7 @@ latest @ ~ The magic comment isn't active in the compiler as-written, since the ~ transformations do this bit themselves, but should still be here for ~ completeness; it could affect other things people compile. - entry-to-execution-token , ~ : -8 litstring (codeword pointer) + entry-to-execution-token , ~ : -8 litstring #-- (codeword pointer) } if here @ key { dup dup 0x22 != && } { pack8 key } while drop 0 pack8 @@ -482,7 +482,7 @@ latest @ interpreter-flags @ 1 & { [ s" emitstring" find literal ] ~ As with s", the magic comment is for completeness only. - entry-to-execution-token , ~ : -8 emitstring (codeword pointer) + entry-to-execution-token , ~ : -8 emitstring #-- (codeword pointer) } { emitstring } if-else ; make-immediate diff --git a/transform.e b/transform.e index 2ee0489..d909fd6 100644 --- a/transform.e +++ b/transform.e @@ -917,9 +917,9 @@ allocate-transformation-state s" transformation-state" variable ~ 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) + ~ : 8 #-- (previous entry pointer) latest @ host-address-space-to-target pack64 - ~ : 1 (entry flags) + ~ : 1 #-- (entry flags) 0 pack8 ~ : bidirectional-null-terminated entry name 0 pack8 @@ -955,7 +955,7 @@ allocate-transformation-state s" transformation-state" variable label-create-alternate dropstring ~ This looks up "docol" by label. - ~ : 8 (docol codeword) + ~ : 8 #-- (docol codeword) swap-transform-variables L@' docol-codeword-value L@' origin @@ -992,7 +992,7 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables L@' exit swap-transform-variables - offset-to-target-address-space , ~ : -8 exit (codeword pointer) + offset-to-target-address-space , ~ : -8 exit #-- (codeword pointer) ~ : deindent latest @ dup entry-flags@ 0x80 invert & swap entry-flags! @@ -1019,7 +1019,7 @@ allocate-transformation-state s" transformation-state" variable ~ : provide-data ~ : data-set-output-point ~ : delete-last-comment-at-output-point - ~ : 8 (self codeword) + ~ : 8 #-- (self codeword) dup 8 + host-address-space-to-target swap ! ~ : data-set-output-point @@ -1096,7 +1096,7 @@ allocate-transformation-state s" transformation-state" variable L@' litstring swap-transform-variables - offset-to-target-address-space , ~ : -8 litstring (codeword pointer) + offset-to-target-address-space , ~ : -8 litstring #-- (codeword pointer) here @ swap packstring 8 packalign here ! } if ; make-immediate @@ -1110,7 +1110,7 @@ allocate-transformation-state s" transformation-state" variable L@' emitstring swap-transform-variables - offset-to-target-address-space , ~ : -8 emitstring (codeword pointer) + offset-to-target-address-space , ~ : -8 emitstring #-- (codeword pointer) } { emitstring } if-else ; make-immediate @@ -1177,15 +1177,15 @@ allocate-transformation-state s" transformation-state" variable L@' != L@' lit swap-transform-variables - offset-to-target-address-space , ~ : -8 lit (codeword pointer) + offset-to-target-address-space , ~ : -8 lit #-- (codeword pointer) 0 ~ : provide-hex - , ~ : -8 # (integer literal) - offset-to-target-address-space , ~ : -8 != (codeword pointer) + , ~ : -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) + offset-to-target-address-space , ~ : -8 0branch #-- (codeword pointer) dup 8 + ~ : provide-hex - ~ : 8 # (branch offset) + ~ : 8 # #-- (branch offset) , ~ (old here, length) drop 5 8 * + here ! @@ -1204,15 +1204,15 @@ allocate-transformation-state s" transformation-state" variable L@' = L@' lit swap-transform-variables - offset-to-target-address-space , ~ : -8 lit (codeword pointer) + offset-to-target-address-space , ~ : -8 lit #-- (codeword pointer) 0 ~ : provide-hex - , ~ : -8 # (integer literal) - offset-to-target-address-space , ~ : -8 = (codeword pointer) + , ~ : -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) + offset-to-target-address-space , ~ : -8 0branch #-- (codeword pointer) dup 8 + ~ : provide-hex - ~ : 8 # (branch offset) + ~ : 8 # #-- (branch offset) , ~ (old here, length) drop 5 8 * + here ! @@ -1238,15 +1238,15 @@ allocate-transformation-state s" transformation-state" variable L@' != L@' lit swap-transform-variables - offset-to-target-address-space , ~ : -8 lit (codeword pointer) + offset-to-target-address-space , ~ : -8 lit #-- (codeword pointer) 0 ~ : provide-hex - , ~ : -8 # (integer literal) - offset-to-target-address-space , ~ : -8 != (codeword pointer) + , ~ : -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) + offset-to-target-address-space , ~ : -8 0branch #-- (codeword pointer) 3roll dup 4 unroll 3 8 * + ~ : provide-hex - ~ : 8 # (branch offset) + ~ : 8 # #-- (branch offset) , ~ Next, write out the unconditional branch in the middle. @@ -1254,10 +1254,10 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables L@' branch swap-transform-variables - offset-to-target-address-space , ~ : -8 branch (codeword pointer) + 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) + ~ : 8 # #-- (branch offset) , ~ Set "here" to point to the true end. @@ -1269,9 +1269,9 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables L@' branch swap-transform-variables - offset-to-target-address-space , ~ : -8 branch (codeword pointer) + offset-to-target-address-space , ~ : -8 branch #-- (codeword pointer) 8 + -1 * ~ : provide-hex - ~ : 8 # (branch offset) + ~ : 8 # #-- (branch offset) , drop ; make-immediate @@ -1286,14 +1286,14 @@ allocate-transformation-state s" transformation-state" variable L@' != L@' lit swap-transform-variables - offset-to-target-address-space , ~ : -8 lit (codeword pointer) + offset-to-target-address-space , ~ : -8 lit #-- (codeword pointer) 0 ~ : provide-hex - , ~ : -8 # (integer literal) - offset-to-target-address-space , ~ : -8 != (codeword pointer) + , ~ : -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) + offset-to-target-address-space , ~ : -8 0branch #-- (codeword pointer) dup 3 8 * + ~ : provide-hex - ~ : 8 # (branch offset) + ~ : 8 # #-- (branch offset) , ~ Set "here" to the new end. 5 8 * 6 roll + here ! @@ -1303,9 +1303,9 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables L@' branch swap-transform-variables - offset-to-target-address-space , ~ : -8 branch (codeword pointer) + offset-to-target-address-space , ~ : -8 branch #-- (codeword pointer) 6 8 * + swap drop + swap drop -1 * ~ : provide-hex - ~ : 8 # (branch offset) + ~ : 8 # #-- (branch offset) , ; make-immediate @@ -1426,7 +1426,7 @@ allocate-transformation-state s" transformation-state" variable ~ ~ Fortunately we don't have to look at it, just append it to the log ~ and clean up. - ~ : 8 # (codeword pointer) + ~ : 8 # #-- (codeword pointer) offset-to-target-address-space , drop dropstring 0 exit } if @@ -1495,10 +1495,10 @@ allocate-transformation-state s" transformation-state" variable ~ We look up "lit" as a label. swap-transform-variables L@' lit swap-transform-variables offset-to-target-address-space - ~ : 8 lit (codeword pointer) + ~ : 8 lit #-- (codeword pointer) , ~ : provide-hex - ~ : 8 # (integer literal) + ~ : 8 # #-- (integer literal) , 0 exit } if @@ -1621,7 +1621,7 @@ allocate-transformation-state s" transformation-state" variable L@' swap swap-transform-variables - offset-to-target-address-space , ~ : -8 swap (codeword pointer) + offset-to-target-address-space , ~ : -8 swap #-- (codeword pointer) exit } if @@ -1631,10 +1631,10 @@ allocate-transformation-state s" transformation-state" variable L@' lit swap-transform-variables - offset-to-target-address-space , ~ : -8 lit (codeword pointer) + offset-to-target-address-space , ~ : -8 lit #-- (codeword pointer) swap ~ : provide-hex - , ~ : -8 # (integer literal) - offset-to-target-address-space , ~ : -8 roll (codeword pointer) + , ~ : -8 # #-- (integer literal) + offset-to-target-address-space , ~ : -8 roll #-- (codeword pointer) ; @@ -1654,7 +1654,7 @@ allocate-transformation-state s" transformation-state" variable L@' swap swap-transform-variables - offset-to-target-address-space , ~ : -8 swap (codeword pointer) + offset-to-target-address-space , ~ : -8 swap #-- (codeword pointer) exit } if @@ -1664,10 +1664,10 @@ allocate-transformation-state s" transformation-state" variable L@' lit swap-transform-variables - offset-to-target-address-space , ~ : -8 lit (codeword pointer) + offset-to-target-address-space , ~ : -8 lit #-- (codeword pointer) swap ~ : provide-hex - , ~ : -8 # (integer literal) - offset-to-target-address-space , ~ : -8 unroll (codeword pointer) + , ~ : -8 # #-- (integer literal) + offset-to-target-address-space , ~ : -8 unroll #-- (codeword pointer) ; @@ -1729,12 +1729,12 @@ allocate-transformation-state s" transformation-state" variable ~ (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) + 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) + ~ : -8 log-load-find-execution-token #-- (codeword pointer) offset-to-target-address-space , - ~ : -8 log-load-comma (codeword pointer) + ~ : -8 log-load-comma #-- (codeword pointer) log-load-unroll-log-address ; @@ -1762,11 +1762,11 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables ~ (name pointer, swap, log-load-find-execution-token, litstring) - offset-to-target-address-space , ~ : -8 litstring (codeword pointer) + 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) + ~ : -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. @@ -1778,7 +1778,7 @@ allocate-transformation-state s" transformation-state" variable L@' execute swap-transform-variables - offset-to-target-address-space , ~ : -8 execute (codeword pointer) + 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. @@ -1805,13 +1805,13 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables ~ The overall stack delta of this sequence is 0. - offset-to-target-address-space , ~ : -8 litstring (codeword pointer) + 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) + ~ : -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) + ~ : -8 log-load-comma #-- (codeword pointer) log-load-unroll-log-address ; @@ -1833,17 +1833,17 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables ~ The overall stack delta of this sequence is 0. - offset-to-target-address-space , ~ : -8 litstring (codeword pointer) + 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) + ~ : -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) + ~ : -8 log-load-comma #-- (codeword pointer) + offset-to-target-address-space , ~ : -8 lit #-- (codeword pointer) swap ~ : provide-hex - , ~ : -8 # (integer literal) + , ~ : -8 # #-- (integer literal) offset-to-target-address-space , - ~ : -8 log-load-comma (codeword pointer) + ~ : -8 log-load-comma #-- (codeword pointer) log-load-unroll-log-address ; @@ -1880,9 +1880,9 @@ allocate-transformation-state s" transformation-state" variable 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 swap #-- (codeword pointer) offset-to-target-address-space , - ~ : -8 log-load-create (codeword pointer) + ~ : -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 @@ -1914,10 +1914,10 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables ~ The overall stack delta of this sequence is 0. - offset-to-target-address-space , ~ : -8 litstring (codeword pointer) + 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) + ~ : -8 log-load-create #-- (codeword pointer) log-load-unroll-log-address @@ -1959,7 +1959,7 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables offset-to-target-address-space , - ~ : -8 log-load-self-codeword (codeword pointer) + ~ : -8 log-load-self-codeword #-- (codeword pointer) log-load-unroll-log-address } if-else @@ -1983,12 +1983,12 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables ~ The overall stack delta of this sequence is 0. - offset-to-target-address-space , ~ : -8 litstring (codeword pointer) + 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) + ~ : -8 log-load-find-execution-token #-- (codeword pointer) offset-to-target-address-space , - ~ : -8 log-load-comma (codeword pointer) + ~ : -8 log-load-comma #-- (codeword pointer) log-load-unroll-log-address @@ -2019,7 +2019,7 @@ allocate-transformation-state s" transformation-state" variable ~ The stack delta of this call is 0. offset-to-target-address-space , - ~ : -8 log-load-semicolon-assembly (codeword pointer) + ~ : -8 log-load-semicolon-assembly #-- (codeword pointer) log-load-unroll-log-address @@ -2061,9 +2061,9 @@ allocate-transformation-state s" transformation-state" variable L@' swap swap-transform-variables - offset-to-target-address-space , ~ : -8 swap (codeword pointer) + offset-to-target-address-space , ~ : -8 swap #-- (codeword pointer) offset-to-target-address-space , - ~ : -8 log-load-comma (codeword pointer) + ~ : -8 log-load-comma #-- (codeword pointer) ~ We consumed the value, so we apply a delta. -1 transform-apply-stack-delta @@ -2089,9 +2089,9 @@ allocate-transformation-state s" transformation-state" variable L@' 3unroll swap-transform-variables - offset-to-target-address-space , ~ : -8 3unroll (codeword pointer) + offset-to-target-address-space , ~ : -8 3unroll #-- (codeword pointer) offset-to-target-address-space , - ~ : -8 log-load-variable (codeword pointer) + ~ : -8 log-load-variable #-- (codeword pointer) ~ We consumed the string and address, so we apply a delta. -2 transform-apply-stack-delta @@ -2117,9 +2117,9 @@ allocate-transformation-state s" transformation-state" variable L@' swap swap-transform-variables - offset-to-target-address-space , ~ : -8 swap (codeword pointer) + offset-to-target-address-space , ~ : -8 swap #-- (codeword pointer) offset-to-target-address-space , - ~ : -8 log-load-keyword (codeword pointer) + ~ : -8 log-load-keyword #-- (codeword pointer) ~ We consumed the string, so we apply a delta. -1 transform-apply-stack-delta @@ -2173,7 +2173,7 @@ allocate-transformation-state s" transformation-state" variable L@' litstring swap-transform-variables - offset-to-target-address-space , ~ : -8 litstring (codeword pointer) + 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 @@ -2201,15 +2201,15 @@ allocate-transformation-state s" transformation-state" variable ~ The overall stack delta of this sequence is 0. offset-to-target-address-space , - ~ : -8 litstring (codeword pointer) + ~ : -8 litstring #-- (codeword pointer) here @ s" litstring" packstring 8 packalign here ! offset-to-target-address-space , - ~ : -8 log-load-find-execution-token (codeword pointer) + ~ : -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) + ~ : -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) + ~ : -8 log-load-comma-string #-- (codeword pointer) ~ We consumed the string pointer at log-load time, so we apply a delta ~ for it. @@ -2238,7 +2238,7 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables offset-to-target-address-space , - ~ : -8 emitstring (codeword pointer) + ~ : -8 emitstring #-- (codeword pointer) } if-else ; make-immediate @@ -2254,7 +2254,7 @@ allocate-transformation-state s" transformation-state" variable L@' litstring swap-transform-variables - offset-to-target-address-space , ~ : -8 litstring (codeword pointer) + offset-to-target-address-space , ~ : -8 litstring #-- (codeword pointer) here @ swap packstring 8 packalign here ! ~ Apply a delta for the string pointer. @@ -2279,23 +2279,23 @@ allocate-transformation-state s" transformation-state" variable ~ The overall stack delta of this sequence is 0. offset-to-target-address-space , - ~ : -8 litstring (codeword pointer) + ~ : -8 litstring #-- (codeword pointer) here @ s" litstring" packstring 8 packalign here ! offset-to-target-address-space , - ~ : -8 log-load-find-execution-token (codeword pointer) + ~ : -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) + ~ : -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) + ~ : -8 log-load-comma-string #-- (codeword pointer) offset-to-target-address-space , - ~ : -8 litstring (codeword pointer) + ~ : -8 litstring #-- (codeword pointer) here @ s" find" packstring 8 packalign here ! offset-to-target-address-space , - ~ : -8 log-load-find-execution-token (codeword pointer) + ~ : -8 log-load-find-execution-token #-- (codeword pointer) offset-to-target-address-space , - ~ : -8 log-load-comma (codeword pointer) + ~ : -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 @@ -2311,7 +2311,7 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables offset-to-target-address-space , - ~ : -8 log-load-find (codeword pointer) + ~ : -8 log-load-find #-- (codeword pointer) ~ We leave an execution token on the log-load-time stack, so no delta ~ needed. @@ -2392,7 +2392,7 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables offset-to-target-address-space , - ~ : -8 log-load-left-curly-brace (codeword pointer) + ~ : -8 log-load-left-curly-brace #-- (codeword pointer) ~ It pushes a start pointer onto the stack. 1 transform-apply-stack-delta @@ -2413,7 +2413,7 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables offset-to-target-address-space , - ~ : -8 log-load-right-curly-brace (codeword pointer) + ~ : -8 log-load-right-curly-brace #-- (codeword pointer) ~ It pushes a length value onto the stack. 1 transform-apply-stack-delta @@ -2432,7 +2432,7 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables offset-to-target-address-space , - ~ : -8 log-load-if (codeword pointer) + ~ : -8 log-load-if #-- (codeword pointer) ~ It pops the start and length. -2 transform-apply-stack-delta @@ -2452,7 +2452,7 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables offset-to-target-address-space , - ~ : -8 log-load-unless (codeword pointer) + ~ : -8 log-load-unless #-- (codeword pointer) ~ It pops the start and length. -2 transform-apply-stack-delta @@ -2472,7 +2472,7 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables offset-to-target-address-space , - ~ : -8 log-load-if-else (codeword pointer) + ~ : -8 log-load-if-else #-- (codeword pointer) ~ It pops two pairs of start and length. -4 transform-apply-stack-delta @@ -2492,7 +2492,7 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables offset-to-target-address-space , - ~ : -8 log-load-forever (codeword pointer) + ~ : -8 log-load-forever #-- (codeword pointer) ~ It pops the start and length. -2 transform-apply-stack-delta @@ -2512,7 +2512,7 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables offset-to-target-address-space , - ~ : -8 log-load-while (codeword pointer) + ~ : -8 log-load-while #-- (codeword pointer) ~ It pops two pairs of start and length. -4 transform-apply-stack-delta @@ -2636,9 +2636,9 @@ allocate-transformation-state s" transformation-state" variable ~ 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) + offset-to-target-address-space , ~ : -8 lit #-- (codeword pointer) ~ : provide-hex - , ~ : -8 # (integer literal) + , ~ : -8 # #-- (integer literal) 1 transform-apply-stack-delta 0 exit } if @@ -2706,7 +2706,7 @@ allocate-transformation-state s" transformation-state" variable ~ 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) + ~ : -8 # #-- (codeword pointer) transform-apply-stack-delta dropstring 0 exit } if @@ -4255,6 +4255,73 @@ allocate-transformation-state s" transformation-state" variable } while drop } while ; +~ 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. +~ +~ (word pointer -- should ignore space) +: hex-emit-template-string-word + dup s" #" stringcmp 0 = { + drop + + pop-subitem-entry-stack + + ~ If we underflowed the stack, we got zero back, so make sure not to + ~ crash. A crash here would be a pain to debug because it would be + ~ unclear how much of the overall system is working, and it's a + ~ complex system. + dup { + dup hex-output-metadata-entry-type @ + hex-output-metadata-entry-type-push-subitem-decimal = { + dup hex-output-metadata-entry-content @ . + } if + + dup hex-output-metadata-entry-type @ + hex-output-metadata-entry-type-push-subitem-hex = { + ." 0x" + dup hex-output-metadata-entry-content @ .hex + } if + + dup hex-output-metadata-entry-type @ + hex-output-metadata-entry-type-push-subitem-hex8 = { + ." 0x" + dup hex-output-metadata-entry-content @ .hex8 + } if + + dup hex-output-metadata-entry-type @ + hex-output-metadata-entry-type-push-subitem-hex16 = { + ." 0x" + dup hex-output-metadata-entry-content @ .hex16 + } if + + dup hex-output-metadata-entry-type @ + hex-output-metadata-entry-type-push-subitem-hex32 = { + ." 0x" + dup hex-output-metadata-entry-content @ .hex32 + } if + + dup hex-output-metadata-entry-type @ + hex-output-metadata-entry-type-push-subitem-hex64 = { + ." 0x" + dup hex-output-metadata-entry-content @ .hex64 + } if + + dup hex-output-metadata-entry-type @ + hex-output-metadata-entry-type-push-subitem-string = { + dup hex-output-metadata-entry-content @ emitstring + } if + } if + + drop 0 exit + } if + + dup s" #--" stringcmp 0 = { + ." " + drop 1 exit + } if + + emitstring 0 ; + + ~ (string pointer --) : hex-emit-template-string { unpack8 dup } { @@ -4284,69 +4351,8 @@ allocate-transformation-state s" transformation-state" variable swap-transform-variables here @ swap-transform-variables ~ (input point, first non-word character or 0, word pointer) - dup s" #" stringcmp 0 = { - ~ (input point, first non-word character or 0, word pointer) - drop - - pop-subitem-entry-stack - - ~ If we underflowed the stack, we got zero back, so make sure not to - ~ crash. A crash here would be a pain to debug because it would be - ~ unclear how much of the overall system is working, and it's a - ~ complex system. - dup { - dup hex-output-metadata-entry-type @ - hex-output-metadata-entry-type-push-subitem-decimal = { - dup hex-output-metadata-entry-content @ . - } if - - dup hex-output-metadata-entry-type @ - hex-output-metadata-entry-type-push-subitem-hex = { - ." 0x" - dup hex-output-metadata-entry-content @ .hex - } if - - dup hex-output-metadata-entry-type @ - hex-output-metadata-entry-type-push-subitem-hex8 = { - ." 0x" - dup hex-output-metadata-entry-content @ .hex8 - } if - - dup hex-output-metadata-entry-type @ - hex-output-metadata-entry-type-push-subitem-hex16 = { - ." 0x" - dup hex-output-metadata-entry-content @ .hex16 - } if - - dup hex-output-metadata-entry-type @ - hex-output-metadata-entry-type-push-subitem-hex32 = { - ." 0x" - dup hex-output-metadata-entry-content @ .hex32 - } if - - dup hex-output-metadata-entry-type @ - hex-output-metadata-entry-type-push-subitem-hex64 = { - ." 0x" - dup hex-output-metadata-entry-content @ .hex64 - } if - - dup hex-output-metadata-entry-type @ - hex-output-metadata-entry-type-push-subitem-string = { - dup hex-output-metadata-entry-content @ emitstring - } if - } if - - ~ Tidy up. We want to treat the next character normally, so we - ~ return a zero to indicate that. - drop 0 - } { - ~ (input point, first non-word character or 0, word pointer) - - ~ Here as well, we want to treat the next character normally, so - ~ we return zero. - emitstring 0 - } if-else - ~ (input point, first non-word character or 0, should ignore space) + hex-emit-template-string-word + ~ (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 @@ -4363,12 +4369,14 @@ allocate-transformation-state s" transformation-state" variable } if-else } while drop drop ; + ~ (string pointer --) : hex-emit-comment ." ~" dup @ { space } if hex-emit-template-string ; + ~ This "replacement" is a little different from an alternate: When the code ~ under transformation attempts to compile its own version of sys-write, it ~ gets a stub that calls this word instead. It's swapped out by |