diff options
Diffstat (limited to 'labels.e')
| -rw-r--r-- | labels.e | 142 |
1 files changed, 142 insertions, 0 deletions
diff --git a/labels.e b/labels.e new file mode 100644 index 0000000..9c91fb6 --- /dev/null +++ b/labels.e @@ -0,0 +1,142 @@ +~ current output point, string pointer +: pack-raw-string + { unpack8 dup } { 3roll swap pack8 swap } while drop drop ; + +: origin 0x08000000 ; + +~ Status is a bit field: +~ bit zero is whether it's been used +~ bit one is whether it's been defined +~ bit two is whether it was used before being defined +~ bit three is whether the guessed value wound up equaling the actual value + +: init-labels + 8 allocate s" labels" variable + 0 s" labels" find entry-to-execution-token execute ! + ; +~ This needs to happen now because otherwise the word "labels" won't exist. +init-labels + +~ (entry pointer --) +: label-heading + dup entry-to-name dup emitstring space + stringlen 1+ 54 swap - 0 max indent + entry-to-execution-token dup 8 + @ .hex64 space @ .hex8 + newline ; + +~ (dictionary handle) +: oldest-entry-in + dup + dup { { dup @ } { @ } while } if + dup 3roll = { drop 0 } if + ; + +~ (entry pointer, dictionary handle) +: next-newer-entry-in + @ + 2dup = { 2drop 0 exit } if + { dup { 2dup @ != } if } + { @ } while swap drop ; + +: list-labels + labels oldest-entry-in { dup } + { dup label-heading labels next-newer-entry-in } while drop ; + +~ (name string pointer -- ) +: new-label labels create-in 0 , 0 , ; + +: label-status entry-to-execution-token ; +: label-value entry-to-execution-token 8 + ; + +: intern-label + dup labels swap find-in + dup { swap drop } + { drop dup new-label labels swap find-in } if-else ; + +: L' + word value@ + interpreter-flags @ 0x01 & + { ' litstring entry-to-execution-token , + here @ swap packstring 0 pack8 8 packalign here ! + ' intern-label entry-to-execution-token , + dropstring } + { intern-label dropstring-with-result } if-else + ; make-immediate + +~ (label entry pointer -- label value) +: use-label + ~ If it hasn't been defined yet, mark it used-before-set. + dup label-status dup @ dup 0x02 & not { 0x04 | swap ! } { drop drop } if-else + + ~ Mark it used. It's faster to just do this than to check if it's needed. + dup label-status dup @ 0x01 | swap ! + + ~ Return the guessed value. + label-value @ ; + ; + +~ (new label value, label entry pointer --) +: set-label + ~ We always set the defined bit to true. We leave the other status bits + ~ as-is, except that we check whether it's unused up to now, and whether + ~ the previous value equals the new value. If either of those holds, we set + ~ the guessed-equals-actual bit to true. + dup label-status @ 0x02 | + ~ (new value, entry, updated status) + 3unroll dup 4 unroll label-value @ swap dup 3unroll = + ~ (entry, updated status, new value, equality) + 3roll dup 4 unroll 0x01 & not + ~ (entry, updated status, new value, equality, unused) + || { swap 0x08 | swap } if + ~ (entry, updated status, new value) + 3roll dup 3unroll + ~ (updated status, entry, new value, entry) + label-value ! label-status ! + ; + +~ (output memory start, current output point +~ -- output memory start, current output point, offset) +: current-offset 2dup swap - ; + +~ For a label to have "converged", at least one of the following must be true: +~ +~ 1. The label must never have been used (bit zero clear); +~ 2. The label was both used and defined, but not used before it was defined +~ (bits zero and one set; bit two clear); +~ 3. The label was both used and defined, and the guessed value equalled the +~ actual value (bits zero, one, and three set). +~ (label entry pointer) +: check-label-converged + label-status @ + dup 0x01 & not swap + dup 0x03 & 0x03 = swap dup 0x04 & not swap 3unroll && swap + 0x0b & 0x0b = + || || ; + +: check-labels-converged + 1 + labels @ { dup } + { dup check-label-converged 3roll && swap + @ } while drop ; + +: reset-labels + labels @ { dup } + { dup label-status 0 swap ! + @ } while drop ; + +~ (execution token -- output start, output length) +: label-loop + 0 swap + 0x1000 allocate dup + ~ (iteration count, execution token, output start, output point) + { 3 pick 100 > } + { 2 pick execute 4 roll 1+ 4 unroll + check-labels-converged + { 4 roll drop + 3 roll drop + current-offset swap drop + exit } if + drop dup + reset-labels } while + drop drop drop ." Failed after " . ." iterations." newline ; + |