diff options
Diffstat (limited to 'transform.e')
| -rw-r--r-- | transform.e | 46 |
1 files changed, 19 insertions, 27 deletions
diff --git a/transform.e b/transform.e index 6d12ea1..17d1396 100644 --- a/transform.e +++ b/transform.e @@ -4247,7 +4247,7 @@ allocate-transformation-state s" transformation-state" variable 3unroll 1+ swap 1- swap 3roll } while drop ; -~ (data start, data length) +~ (data start, data length --) : hex-pack-trace ~ We keep a running tally of the next address in the output, for the ~ benefit of hex-tilde-replacement, which needs to know where to attach its @@ -4258,6 +4258,22 @@ allocate-transformation-state s" transformation-state" variable hex-output-metadata-latest-output-point ! } { drop } if-else ; +~ (output point, string pointer --) +: hex-packstring-trace + dup stringlen 1+ + ~ (output point, string pointer, string length) + 2 pick over hex-pack-trace + swap + ~ (output point, string length, string pointer) + swap-transform-variables here @ swap-transform-variables + ~ (output point, string length, string pointer, temporary space pointer) + 2 pick memcopy + ~ (output point, string length) + swap-transform-variables here @ allocate-string swap-transform-variables + ~ (output point, string length, moved string pointer) + hex-output-metadata-entry-type-string-literal swap + add-hex-output-metadata-entry ; + ~ By overriding colon, we can special-case the definitions of particular ~ words. It's very metacircular. ~ @@ -4451,32 +4467,8 @@ allocate-transformation-state s" transformation-state" variable ~ (output point, string pointer) s" 2dup" find entry-to-execution-token , - s" dup" find entry-to-execution-token , - s" stringlen" find entry-to-execution-token , - s" 1+" find entry-to-execution-token , - ~ (output point, string pointer, string length including terminator) - - ~ Before we add the metadata entry, we also want to call hex-pack-trace - ~ to make sure latest-output-point gets adjusted for the string. - ~ Otherwise, we'd see magic comments in the wrong place. - s" 3roll" find entry-to-execution-token , - s" dup" find entry-to-execution-token , - s" lit" find entry-to-execution-token , - 4 , - s" unroll" find entry-to-execution-token , - s" swap" find entry-to-execution-token , - s" dup" find entry-to-execution-token , - s" 3unroll" find entry-to-execution-token , - ~ (output point, string pointer, string length including terminator, - ~ output point, string length including terminator) - ' hex-pack-trace entry-to-execution-token , - - ~ (output point, string pointer, string length including terminator) - s" swap" find entry-to-execution-token , - ' hex-output-metadata-entry-type-string-literal entry-to-execution-token , - s" swap" find entry-to-execution-token , - ' add-hex-output-metadata-entry entry-to-execution-token , - ~ (output point, string pointer) + ~ This one's a lot of work, so we defer to a single-purpose word. + ' hex-packstring-trace entry-to-execution-token , ~ Fall through to the inner implementation. ' ] entry-to-execution-token execute |