diff options
| -rw-r--r-- | core.e | 69 | ||||
| -rw-r--r-- | dynamic.e | 21 | ||||
| -rw-r--r-- | evoke.e | 2 | ||||
| -rw-r--r-- | flow-control.e | 4 | ||||
| -rw-r--r-- | log-load.e | 47 | ||||
| -rw-r--r-- | transform.e | 8 |
6 files changed, 82 insertions, 69 deletions
diff --git a/core.e b/core.e index c10ac00..51ab9f7 100644 --- a/core.e +++ b/core.e @@ -1200,12 +1200,8 @@ here ! ~ (output point, alignment byte count -- output point) : packalign - 2dup /% drop 0branch [ 8 8 * , ] - swap 0 pack8 swap branch [ -11 8 * , ] - drop ; - ~ TODO this is the implementation we could use if we had more flow-control - ~ { 2dup /% drop { drop exit } unless - ~ swap 0 pack8 swap } forever ; + { 2dup /% drop { drop exit } unless + swap 0 pack8 swap } forever ; ~ Binary unpacking @@ -1265,13 +1261,11 @@ here ! ~ assembly, or with high-level flow control, but it doesn't seem urgent... : max - 2dup >= - 0branch [ 2 8 * , ] swap + 2dup >= { swap } if drop ; : min - 2dup <= - 0branch [ 2 8 * , ] swap + 2dup <= { swap } if drop ; : over swap dup 3unroll ; @@ -1280,15 +1274,11 @@ here ! ~ Standard Forth doesn't have equivalents of our ndrop and ndup. The HP ~ calls them DROPN and DUPN but that doesn't go well with ie. 2dup or 3roll, ~ so we do it like this. -: ndrop - dup 0branch [ 6 8 * , ] swap drop 1- - branch [ -7 8 * , ] - drop ; +: ndrop { dup } { swap drop 1- } while drop ; : ndup dup 1+ swap - dup 0branch [ 9 8 * , ] swap dup pick 3unroll swap 1- - branch [ -10 8 * , ] + { dup } { swap dup pick 3unroll swap 1- } while 2drop ; : 3drop drop drop drop ; @@ -1301,3 +1291,50 @@ here ! : align-floor dup 3unroll /% swap drop * ; + +~ Find-in is the main word that provides the capability to look up words by +~ name, though it's usually used via "find" rather than being called directly. +~ +~ Find-in traverses the linked list formed by a particular dictionary's +~ next-entry pointers, looking for an entry that matches a given name. The +~ dictionary pointer is the pointer (not handle) to the root of the list, +~ which runs from newest to oldest. For example, dereferencing the value of +~ "latest" gives the pointer to the main dictionary, which can be passed to +~ find-in. +~ +~ Having find-in separated out is convenient when working with alternate +~ dictionaries, but the main reason for having it is not convenience but +~ necessity: During Evocation's startup, there is a period before global +~ variables are easily accessible, so there would be no way to implement +~ "find". The warm-start routine (see execution.e and transform.e) has the +~ job of fixing that, and it makes extensive use of find-in to do so. +~ +~ TODO this probably deserves its own file? +~ +~ (dictionary pointer, string pointer -- entry pointer or 0) +: find-in + ~ It will be more convenient to have the entry pointer on top. + swap + + { + ~ If the entry pointer is null, exit. + ~ (name pointer to find, current entry pointer) + dup 0 = { swap drop exit } if + + ~ Check this entry's "hidden" flag. + ~ (name pointer to find, current entry pointer) + dup entry-flags@ 0x80 & 0x80 != { + ~ Test whether this entry is a match. + ~ (name pointer to find, current entry pointer) + 2dup 10 + stringcmp 0 = { + ~ If we're here, it's a match. Clean up our working state and exit. + ~ (name pointer to find, current entry pointer) + swap drop exit + } if + } if + + ~ If we're here, it's not a match; traverse the pointer and repeat. + ~ (name pointer to find, current entry pointer) + @ + } forever ; + diff --git a/dynamic.e b/dynamic.e index 773511f..24fe388 100644 --- a/dynamic.e +++ b/dynamic.e @@ -339,6 +339,27 @@ here ! ; +~ Notionally, it might make sense to define "create" in terms of +~ "create-in". Any change like that is being postponed to after the removal +~ of flatassembler, when refactorings will be easier. +~ +~ The dictionary handle points to a pointer to the first item. +~ +~ (string pointer, dictionary handle --) +: create-in + dup @ here @ swap pack64 +~ (name string pointer, dictionary handle, output point) + 0 pack8 0 pack8 + 3roll packstring + 8 packalign +~ (dictionary handle, output point) + swap here @ swap ! +~ (output point) + here ! + ; + + + : self-codeword here @ 8 + , ; diff --git a/evoke.e b/evoke.e index fed48b1..2b641f3 100644 --- a/evoke.e +++ b/evoke.e @@ -3,7 +3,7 @@ ~ cat core.e linux.e output.e amd64.e execution-support.e log-load.e; \ ~ echo pyrzqxgl 262144 read-to-buffer; \ ~ cat core.e linux.e output.e amd64.e execution-support.e log-load.e \ -~ dynamic.e input.e interpret.e ; \ +~ dynamic.e input.e interpret.e flow-control.e ; \ ~ echo 0 sys-exit pyrzqxgl; \ ~ cat evoke.e) \ ~ | ./quine > evoke && chmod 755 evoke && ./evoke diff --git a/flow-control.e b/flow-control.e index a1b066d..ba6a5b6 100644 --- a/flow-control.e +++ b/flow-control.e @@ -46,7 +46,8 @@ ~ (start pointer, length --) -: unless 2dup swap dup 5 8 * + 3unroll swap +: unless + 2dup swap dup 5 8 * + 3unroll swap ~ (start pointer, length, start pointer, adjusted start pointer, length) memmove ~ (start pointer, length) @@ -63,7 +64,6 @@ ~ (true start, true length, false start, false length --) : if-else - dup 4 roll dup 5 unroll + ~ First we slide the false-block forward, then the true-block. We slide ~ them both directly into their final positions, leaving space at the start diff --git a/log-load.e b/log-load.e index 2b7cbd2..d1e4a2f 100644 --- a/log-load.e +++ b/log-load.e @@ -108,53 +108,6 @@ ~ this file. -~ Find-in is the main word that provides the capability to look up words by -~ name, though it's usually used via "find" rather than being called directly. -~ -~ Find-in traverses the linked list formed by a particular dictionary's -~ next-entry pointers, looking for an entry that matches a given name. The -~ dictionary pointer is the pointer (not handle) to the root of the list, -~ which runs from newest to oldest. For example, dereferencing the value of -~ "latest" gives the pointer to the main dictionary, which can be passed to -~ find-in. -~ -~ Having find-in separated out is convenient when working with alternate -~ dictionaries, but the main reason for having it is not convenience but -~ necessity: During Evocation's startup, there is a period before global -~ variables are easily accessible, so there would be no way to implement -~ "find". The warm-start routine (see execution.e and transform.e) has the -~ job of fixing that, and it makes extensive use of find-in to do so. -~ -~ TODO this probably deserves its own file? -~ -~ (dictionary pointer, string pointer -- entry pointer or 0) -: find-in - ~ It will be more convenient to have the entry pointer on top. - swap - - { - ~ If the entry pointer is null, exit. - ~ (name pointer to find, current entry pointer) - dup 0 = { swap drop exit } if - - ~ Check this entry's "hidden" flag. - ~ (name pointer to find, current entry pointer) - dup entry-flags@ 0x80 & 0x80 != { - ~ Test whether this entry is a match. - ~ (name pointer to find, current entry pointer) - 2dup 10 + stringcmp 0 = { - ~ If we're here, it's a match. Clean up our working state and exit. - ~ (name pointer to find, current entry pointer) - swap drop exit - } if - } if - - ~ If we're here, it's not a match; traverse the pointer and repeat. - ~ (name pointer to find, current entry pointer) - @ - } forever ; - - ~ This has the same value as the constant control-stack-size, which is ~ defined in execution.e. Everything will break if it doesn't. ~ diff --git a/transform.e b/transform.e index d148e58..6a81454 100644 --- a/transform.e +++ b/transform.e @@ -851,7 +851,8 @@ allocate-transform-state s" transform-state" variable swap-transform-variables + , - latest @ hide-entry ] ; + latest @ dup entry-flags@ 0x80 | entry-flags! + ] ; ~ This is the alternate version of ";" for use with the label transform. Its @@ -865,7 +866,7 @@ allocate-transform-state s" transform-state" variable swap-transform-variables offset-to-target-address-space , - latest @ unhide-entry + latest @ dup entry-flags@ 0x80 invert & entry-flags! ~ Since [ is an immediate word, we have to go to extra trouble to compile ~ it as part of ;. @@ -879,7 +880,8 @@ allocate-transform-state s" transform-state" variable ~ before attempting to understand label-semicolon-assembly-alternate. : label-semicolon-assembly-alternate here @ pack-next 8 packalign here ! - latest @ dup unhide-entry entry-to-execution-token + latest @ dup dup entry-flags@ 0x80 invert & entry-flags! + entry-to-execution-token ~ The codeword needs to be transformed to the target address space. dup 8 + host-address-space-to-target swap ! |