diff options
| -rw-r--r-- | core.e | 3 | ||||
| -rw-r--r-- | execution.e | 18 | ||||
| -rw-r--r-- | transform.e | 125 |
3 files changed, 110 insertions, 36 deletions
diff --git a/core.e b/core.e index f605296..4394fd8 100644 --- a/core.e +++ b/core.e @@ -1224,8 +1224,7 @@ here ! : packalign ~ 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 #-- (alignment padding) { 2dup /% drop { drop exit } unless swap 0 pack8 swap ~ : 1 adjust-length diff --git a/execution.e b/execution.e index 536bcbf..8962578 100644 --- a/execution.e +++ b/execution.e @@ -265,13 +265,15 @@ ~ and the kernel would trust us, but this gives us more options for ~ interoperating with other runtimes. ~ - 9 :rax mov-reg64-imm64 ~ : mmap() - 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) - 0 :r9 mov-extrareg64-imm64 ~ : offset (ignored) + 9 :rax mov-reg64-imm64 ~ : mmap() + log-requested-address :rdi mov-reg64-imm64 + ~ : 0 address (very arbitrary) + log-size :rsi mov-reg64-imm64 ~ : size (one meg) + 0x07 :rdx mov-reg64-imm64 + ~ : 0 protection (read+write+exec) + 0x22 :r10 mov-extrareg64-imm64 ~ : flags (private+anonymous) + 0 :r8 mov-extrareg64-imm64 ~ : file descriptor (ignored) + 0 :r9 mov-extrareg64-imm64 ~ : offset (ignored) syscall ~ The return value of the system call is in rax, we'll use it in a sec. @@ -573,7 +575,7 @@ L@' log-load-find-execution-token offset-to-target-address-space pack64 ~ : -8 log-load-find-execution-token #-- (codeword pointer) L@' swap offset-to-target-address-space pack64 - ~ : -8 swap #-- (codewored pointer) + ~ : -8 swap #-- (codeword 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) diff --git a/transform.e b/transform.e index d909fd6..18c7fb4 100644 --- a/transform.e +++ b/transform.e @@ -4255,125 +4255,197 @@ allocate-transformation-state s" transformation-state" variable } 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. ~ -~ (word pointer -- should ignore space) +~ (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 = { - dup hex-output-metadata-entry-content @ . + 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 @ .hex + 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 = { - dup hex-output-metadata-entry-content @ emitstring + swap dup indent advance-current-column 0 swap + + dup hex-output-metadata-entry-content @ + dup stringlen advance-current-column + emitstring } if } if - drop 0 exit + drop drop 0 exit } if dup s" #--" stringcmp 0 = { - ." " - drop 1 exit + ~ (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 { - ~ Output space characters as we reach them, there's no need to do - ~ anything fancy. - value@ emitstring drop + ~ 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 } { - ~ (input point, first word character) + ~ (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 - ~ (scratch output point, input point) + ~ (queued space count, scratch output point, input point) ~ Scan forward and find a space-separated word. { unpack8 dup dup is-space not && } { - ~ (scratch output point, adjusted input point, next character) + ~ (queued space count, scratch output point, adjusted input point, + ~ next character) 3roll swap pack8 swap - ~ (adjusted scratch output point, adjusted input point) + ~ (queued space count, adjusted scratch output point, + ~ adjusted input point) } while - ~ (scratch output point, input point, first non-word character or 0) + ~ (queued space count, scratch output point, input point, + ~ first non-word character or 0) 3roll 0 pack8 drop - ~ (input point, first non-word character or 0) + ~ (queued space count, input point, first non-word character or 0) swap-transform-variables here @ swap-transform-variables - ~ (input point, first non-word character or 0, word pointer) + ~ (queued space count, input point, first non-word character or 0, + ~ word pointer) - hex-emit-template-string-word - ~ (input point, first non-word character, should ignore space) + 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 output it... unless we were asked to skip it, - ~ of course. - not { value@ emitstring } if + ~ 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 - ~ (input point) + ~ (queued space count, input point) } if-else - } while drop drop ; + } 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! + } if + ." ~" - dup @ { space } if + 1 advance-current-column + + dup @ { + space + 1 advance-current-column + } if + hex-emit-template-string ; @@ -4454,7 +4526,8 @@ allocate-transformation-state s" transformation-state" variable dup hex-output-metadata-entry-type @ hex-output-metadata-entry-type-suffix-comment = { - 40 current-column@ - 1 max indent + hex-comment-first-tab-stop current-column@ - 1 max + dup indent advance-current-column dup hex-output-metadata-entry-content @ hex-emit-comment newline |