diff options
| -rw-r--r-- | compilation/transform.e | 193 |
1 files changed, 117 insertions, 76 deletions
diff --git a/compilation/transform.e b/compilation/transform.e index 5469c4c..a6c26a3 100644 --- a/compilation/transform.e +++ b/compilation/transform.e @@ -3387,17 +3387,21 @@ allocate-transformation-state s" transformation-state" variable : hex-output-metadata-indentation-depth 6 8 * + ; : hex-output-metadata-current-column 7 8 * + ; : hex-output-metadata-n-bytes-this-line 8 8 * + ; -: hex-output-metadata-subitem-entry-stack-depth 9 8 * + ; -: hex-output-metadata-subitem-entry-stack-zero 10 8 * + ; +: hex-output-metadata-entry-count 9 8 * + ; +: hex-output-metadata-subitem-entry-stack-depth 10 8 * + ; +: hex-output-metadata-subitem-entry-stack-zero 11 8 * + ; : hex-output-metadata-subitem-entry-stack-capacity 8 ; : hex-output-metadata-first-entry - 10 hex-output-metadata-subitem-entry-stack-capacity + 8 * + ; + 11 hex-output-metadata-subitem-entry-stack-capacity + 8 * + ; : hex-output-metadata-entry-data-start ; : hex-output-metadata-entry-data-length 8 + ; : hex-output-metadata-entry-type 2 8 * + ; : hex-output-metadata-entry-content 3 8 * + ; -: hex-output-metadata-next-entry 4 8 * + ; -: hex-output-metadata-previous-entry 4 8 * - ; +: hex-output-metadata-entry-structure-size 4 8 * ; +: hex-output-metadata-next-entry + hex-output-metadata-entry-structure-size + ; +: hex-output-metadata-previous-entry + hex-output-metadata-entry-structure-size - ; : hex-output-metadata-entry-type-line-comment 0 ; : hex-output-metadata-entry-type-suffix-comment 1 ; : hex-output-metadata-entry-type-fresh-line 2 ; @@ -3434,6 +3438,7 @@ allocate-transformation-state s" transformation-state" variable dup hex-output-metadata-indentation-depth 0 swap ! dup hex-output-metadata-current-column 0 swap ! dup hex-output-metadata-n-bytes-this-line 0 swap ! + dup hex-output-metadata-entry-count 0 swap ! dup hex-output-metadata-subitem-entry-stack-depth 0 swap ! dup hex-output-metadata-first-entry 0 swap ! ; @@ -3526,6 +3531,14 @@ allocate-transformation-state s" transformation-state" variable transformation-state transformation-state-output-metadata @ hex-output-metadata-n-bytes-this-line ! ; +: output-metadata-entry-count@ + transformation-state transformation-state-output-metadata @ + hex-output-metadata-entry-count @ ; + +: output-metadata-entry-count! + transformation-state transformation-state-output-metadata @ + hex-output-metadata-entry-count ! ; + : increment-bytes-this-line n-bytes-this-line@ 1+ n-bytes-this-line! ; : describe-subitem-entry-stack @@ -3580,6 +3593,17 @@ allocate-transformation-state s" transformation-state" variable 0 } if-else ; +~ This computes and returns a pointer to immediately after the end of the +~ metadata entry array and its terminator. (That is, it points AFTER the +~ terminator.) The computation is based on the entry count. +~ +~ (end pointer) +: hex-output-metadata-entry-array-end + transformation-state transformation-state-output-metadata @ + dup hex-output-metadata-first-entry + swap hex-output-metadata-entry-count @ + hex-output-metadata-entry-structure-size * + 8 + ; + ~ (data start, data length, entry type, string pointer, entry pointer --) : hex-output-metadata-entry! dup hex-output-metadata-entry-content 3roll swap ! @@ -3594,6 +3618,61 @@ allocate-transformation-state s" transformation-state" variable 4 pick hex-output-metadata-entry! hex-output-metadata-next-entry ; +~ This is a helper used by add-hex-output-metadata-entry and +~ postprocess-metadata-entries, below. It duplicates the entry it's given, +~ creating a second identical copy immediately after it in the entry array, +~ sliding everything else forward to make room. +~ +~ (entry pointer --) +: dup-metadata-entry + ~ Find all the remaining entries, and the final terminator, and slide + ~ them forward by the length of one entry. + dup hex-output-metadata-entry-array-end + ~ (entry pointer, entry pointer, entry array end pointer) + swap - + ~ (entry pointer, entry array tail length) + swap dup hex-output-metadata-next-entry 3roll + ~ (entry pointer, adjusted entry pointer, entry array tail length) + memmove + + ~ Increment the entry count. + transformation-state transformation-state-output-metadata @ + hex-output-metadata-entry-count dup + @ 1+ swap ! ; + +~ This is a helper used by postprocess-metadata-entries, below. It swaps +~ the contents of the entry it's given with the contents of the entry +~ immediately after it in the entry array. +~ +~ (entry pointer --) +: swap-metadata-entries + ~ Copy the current entry to a scratch area. + dup dup dup hex-output-metadata-next-entry swap - + ~ (entry pointer, entry pointer, entry length) + swap-transform-variables here @ swap-transform-variables swap + ~ (entry pointer, entry pointer, scratch pointer, entry length) + memcopy + ~ (entry pointer) + + ~ Copy the next entry over the current entry. + dup dup hex-output-metadata-next-entry dup + ~ (entry pointer, entry pointer, next entry pointer, next entry pointer) + 3roll - + ~ (entry pointer, next entry pointer, entry length) + 2 pick swap + ~ (entry pointer, next entry pointer, entry pointer, entry length) + memcopy + ~ (entry pointer) + + ~ Copy the scratch area over the next entry. + dup hex-output-metadata-next-entry dup + ~ (entry pointer, next entry pointer, next entry pointer) + 3roll - + ~ (next entry pointer, entry length) + swap-transform-variables here @ swap-transform-variables 3unroll + ~ (scratch pointer, next entry pointer, entry length) + memcopy ; + ~ (data start, data length, entry type, string pointer --) : add-hex-output-metadata-entry ~ If the suppression count is greater than zero, decrement it. @@ -3606,37 +3685,48 @@ allocate-transformation-state s" transformation-state" variable 4 ndrop exit } { drop } if-else + ~ Don't do anything unless the address is in the label-loop buffer. 3 pick is-in-label-loop-buffer { - transformation-state transformation-state-output-metadata @ - hex-output-metadata-first-entry - { dup @ dup { dup 3 pick >= drop } if } { - hex-output-metadata-next-entry - } while + ~ (data start, data length, entry type, string pointer) + + hex-output-metadata-entry-array-end 8 - + ~ Write the entry. 5 unroll pack-hex-output-metadata-entry + ~ Write the end-of-array marker, and clean up. 0 pack64 drop + + ~ Increment the entry count. + transformation-state transformation-state-output-metadata @ + hex-output-metadata-entry-count dup + @ 1+ swap ! } { drop drop drop drop } if-else ; ~ (entry pointer --) : delete-metadata-entry - transformation-state transformation-state-output-metadata @ - hex-output-metadata-first-entry - { dup @ } { hex-output-metadata-next-entry } while - ~ (entry pointer, array-end marker pointer) - over hex-output-metadata-next-entry - 8 + + ~ Slide memory backwards to overwrite the entry. + hex-output-metadata-entry-array-end + ~ (entry pointer, entry array end pointer) + over hex-output-metadata-next-entry - ~ (entry pointer, length of block to move) - swap dup hex-output-metadata-next-entry swap 3roll memmove ; + swap dup hex-output-metadata-next-entry swap 3roll memmove + + ~ Decrement the entry count. + transformation-state transformation-state-output-metadata @ + hex-output-metadata-entry-count dup + @ 1- swap ! ; ~ (-- entry pointer or 0) : find-latest-metadata-entry - ~ Loop forward from the beginning of the entry array to find the last - ~ actual entry. + ~ Get the entry count and make sure it's nonzero. transformation-state transformation-state-output-metadata @ - hex-output-metadata-first-entry - dup @ { - { dup hex-output-metadata-next-entry @ } - { hex-output-metadata-next-entry } while + hex-output-metadata-entry-count @ dup { + ~ Use the entry count to directly compute the offset to the last actual + ~ entry in the array. + 1 - hex-output-metadata-entry-structure-size * + transformation-state transformation-state-output-metadata @ + hex-output-metadata-first-entry + } if ; ~ (-- entry pointer or 0) @@ -3897,7 +3987,11 @@ allocate-transformation-state s" transformation-state" variable pack-hex-output-metadata-entry 0 swap ! ~ End-of-entries delimiter - drop ; + drop + + ~ Overwrite the entry count to reflect what we just did. + transformation-state transformation-state-output-metadata @ + hex-output-metadata-entry-count 7 swap ! ; : hex-self-codeword-alternate self-codeword ; @@ -4023,59 +4117,6 @@ allocate-transformation-state s" transformation-state" variable s" swap" find entry-to-execution-token , ; -~ This is a helper used by postprocess-metadata-entries, below. It -~ duplicates the entry it's given, creating a second identical copy -~ immediately after it in the entry array, sliding everything else forward to -~ make room. -~ -~ (entry pointer --) -: dup-metadata-entry - ~ Find all the remaining entries, and the final terminator, and slide - ~ them forward by the length of one entry. - dup dup - ~ (entry pointer, entry pointer, entry pointer) - - { dup @ } { hex-output-metadata-next-entry } while 8 + - ~ (entry pointer, entry pointer, entry array end pointer) - swap - - ~ (entry pointer, entry array tail length) - swap dup hex-output-metadata-next-entry 3roll - ~ (entry pointer, adjusted entry pointer, entry array tail length) - memmove ; - -~ This is a helper used by postprocess-metadata-entries, below. It swaps -~ the contents of the entry it's given with the contents of the entry -~ immediately after it in the entry array. -~ -~ (entry pointer --) -: swap-metadata-entries - ~ Copy the current entry to a scratch area. - dup dup dup hex-output-metadata-next-entry swap - - ~ (entry pointer, entry pointer, entry length) - swap-transform-variables here @ swap-transform-variables swap - ~ (entry pointer, entry pointer, scratch pointer, entry length) - memcopy - ~ (entry pointer) - - ~ Copy the next entry over the current entry. - dup dup hex-output-metadata-next-entry dup - ~ (entry pointer, entry pointer, next entry pointer, next entry pointer) - 3roll - - ~ (entry pointer, next entry pointer, entry length) - 2 pick swap - ~ (entry pointer, next entry pointer, entry pointer, entry length) - memcopy - ~ (entry pointer) - - ~ Copy the scratch area over the next entry. - dup hex-output-metadata-next-entry dup - ~ (entry pointer, next entry pointer, next entry pointer) - 3roll - - ~ (next entry pointer, entry length) - swap-transform-variables here @ swap-transform-variables 3unroll - ~ (scratch pointer, next entry pointer, entry length) - memcopy ; - ~ Metadata entries are post-processed before they're output, in order to ~ make the structure of the output code simpler. The post-processing won't ~ happen until output actually occurs, which is important for operations that |