diff options
Diffstat (limited to 'language/dynamic/interpret.e')
| -rw-r--r-- | language/dynamic/interpret.e | 599 |
1 files changed, 599 insertions, 0 deletions
diff --git a/language/dynamic/interpret.e b/language/dynamic/interpret.e new file mode 100644 index 0000000..0af0dab --- /dev/null +++ b/language/dynamic/interpret.e @@ -0,0 +1,599 @@ +~ ~~~~~~~~~~~~~~~~~ +~ ~~ Interpreter ~~ +~ ~~~~~~~~~~~~~~~~~ +~ +~ The code in this file defines the basic syntax and semantics of Forth as +~ a text-based language. It's written in terms of the underlying executor, +~ which is implemented and explained in compilation/execution.e and +~ language/static/execution-support.e. The execution model gives us the +~ concept of "words"; the control and value stacks; and the ability to call +~ things. It has nothing to say about text, only about the binary form of the +~ language. +~ +~ It's traditional in Forth to refer to an act of "compiling" code, which +~ in this context means turning it from text into its binary representation. +~ That binary representation most commonly takes the form of a word entry +~ header followed by an array of codeword pointers. +~ +~ It would be legitimate to critique the terminology by saying that codeword +~ pointers are still, in some sense, interpreted: They are not machine code to +~ be directly executed by the CPU; they rely on "docol" and "next" at runtime. +~ However, in language design circles, the term "compilation" takes on a +~ broader meaning, referring to any process which requires some or all of the +~ types of infrastructure we regard as being compiler internals: A successive +~ translation of code from one form into another, discarding some types of +~ information while computing others, in a careful order that results in +~ logically consistent output which in some sense has the same meaning as the +~ input. Sometimes this output may be machine code, but often it is another +~ language meant for human consumption, or an intermediate layer meant to be +~ fed into another process. +~ +~ Forth compilation is compilation in this sense, so there is no conflict +~ and we run with the established terminology. In addition, it must be noted +~ that Evocation, like many Forths, makes extensive use of words which are +~ implemented directly in machine code; the Forth execution model allows these +~ words to co-exist with words that are interpreted by "docol". +~ +~ At any rate, the code in this file is responsible for that compilation. +~ +~ It is primarily concerned with managing the contents of an area of memory +~ we call the "log"; see language/static/log-load.e for more detail on +~ terminology. + +~ As a convenience for "word", we have some facilities for working with +~ stack-allocated strings. Yeah, trippy concept. Also, it would be a +~ buffer overrun hazard if we were worried about that, which is why this +~ is no longer common practice in C. +~ +~ The most important of these is accumulate-string, but we need some +~ smaller pieces first. + +~ (stack string..., items to be left alone..., item to be unrolled, +~ number of items above string that participate in the unroll +~ -- item that was unrolled, stack string..., items left alone) +: unroll-past-string + 8 * + ~ (string, other items, top item, byte offset to string start) + dup value@ + + ~ We have two copies of the offset present, in addition to the stuff we want + ~ to rotate. So, the actual string starts two words on... We could have + ~ adjusted the offset instead, but we'll want the unmodified offset again + ~ later. + 16 + + ~ (string, other items, top item, offset to start, string pointer) + stringlen + ~ Same reasoning as in accumulate-string (see below). + 1 + 8 align-size + ~ (string, other items, top item, offset to start, string length w/ padding) + + 8 /% swap drop + ~ (string, other items, top item, number of words to unroll) + unroll ; + + + +~ (stack string..., item to be swapped +~ -- item that was swapped, stack string...) +: swap-past-string 1 unroll-past-string ; + + +~ (stack string... --) +: dropstring + value@ stringlen + ~ Same reasoning as in accumulate-string (see below). + 1 + 8 align-size value@ + + ~ At the time we fetched the stack pointer, there was an extra value atop + ~ it, so we have to add one more word. + 8 + value! ; + + +~ (stack string..., item to be kept +~ -- item that was kept) +: dropstring-with-result swap-past-string dropstring ; + + +~ (stack string-so-far..., new character byte +~ -- updated string-so-far) +: accumulate-string + ~ Compute the address of the final word of the string. + ~ + ~ It's a little bit difficult to get the start pointer right, since all + ~ our intermediate products affect what we get from value@, so we compute + ~ that just once, here at the beginning. + value@ 8 + + ~ (string so far, new character byte, pointer to start of string) + dup stringlen + ~ There are two concerns here that overlap: First, we always want at least + ~ one word. Recall that a length of zero bytes won't receive any alignment + ~ padding because it's already divisible by 8. Second, the result of + ~ stringlen doesn't include the null byte, which might be in a word by + ~ itself that needs to be counted. We can address both of them by + ~ unconditionally adding 1 to the length before applying alignment. + 1 + + ~ Pad the length for alignment. + 8 align-size + ~ We want an offset from the first word of the string to the last word of + ~ the string, so we subtract one word from the length. + 8 - + + ~ (string so far, new character byte, address of final word) + + ~ Examine the final word of the string, leaving other stuff undisturbed. + ~ Work low-to-high to figure out where to store the new byte, taking the + ~ first one that's available. + ~ (string so far, new character byte, address of final word) + dup @ dup 0x00000000000000FF & { 3roll | swap ! exit } unless + ~ (string so far, new character byte, address of final word, old value) + + ~ This next part is repeated several times, changing only the offsets, for + ~ bytes 1 through 6; bytes 0 (above) and 7 (way below) are different. + ~ (string so far, new character byte, address of final word, old value) + dup 0x000000000000FF00 & { 3roll 0x0000000000000100 * | swap ! exit } unless + dup 0x0000000000FF0000 & { 3roll 0x0000000000010000 * | swap ! exit } unless + dup 0x00000000FF000000 & { 3roll 0x0000000001000000 * | swap ! exit } unless + dup 0x000000FF00000000 & { 3roll 0x0000000100000000 * | swap ! exit } unless + dup 0x0000FF0000000000 & { 3roll 0x0000010000000000 * | swap ! exit } unless + dup 0x00FF000000000000 & { 3roll 0x0001000000000000 * | swap ! exit } unless + + ~ The top byte of the final word is always zero (or else stringlen + ~ wouldn't have called it the final word), so we don't need to check it, we + ~ can just use it. + ~ + ~ We need to put the new value in the top byte, which will mean we have no + ~ null terminator, so we also need to start a new word. + ~ + ~ There is a fiddly order-dependency here: unroll-past-string relies on + ~ being able to find the null terminator, which won't work if we've gotten + ~ rid of it. Also, calling it will move all the earlier words, including + ~ the one we intend to write to, which will invalidate any pointer we're + ~ keeping at that point. There's a few ways to resolve this; what we do is + ~ put the new terminator in place first, manually nudge the pointer, and + ~ then write the new value. + ~ (string so far, new character byte, address of final word, old value) + 3roll 0x0100000000000000 * | swap + ~ (string so far, new value, address of final word) + 0 3 unroll-past-string + ~ (new null terminator, string so far, new value, invalid address) + 8 - + ~ (new null terminator, string so far, new value, updated address) + ! ; + + +~ (byte -- boolean) +: is-space + dup 0x20 = { drop 1 exit } if + dup 0x09 = { drop 1 exit } if + dup 0x0a = { drop 1 exit } if + dup 0x0b = { drop 1 exit } if + dup 0x0c = { drop 1 exit } if + dup 0x0d = { drop 1 exit } if + drop 0 ; + + +~ (character -- 1 for true or 0 for false) +: is-alphanumeric + ~ We don't have a character-literal syntax; the hex constants here are + ~ ASCII codes. + dup 0x30 > { drop 0 exit } if ~ Less than "0". + dup 0x39 >= { drop 1 exit } if ~ Less than or equal to "9". + dup 0x41 > { drop 0 exit } if ~ Less than "A". + dup 0x5a >= { drop 1 exit } if ~ Less than or equal to "Z". + dup 0x61 > { drop 0 exit } if ~ Less than "a". + dup 0x7a >= { drop 1 exit } if ~ Less than or equal to "z". + drop 0 ; ~ Greater than "z". + + +~ Okay, this is the big one, the lexer! Wow. +~ +~ The only way this can ever return a zero-length string is if it hit EOF, +~ and callers can rely on that. +~ +~ (-- stack string occupying multiple words) +: word + ~ We allocate an empty string first, so that the result of "key" will + ~ conveniently be on the easy-to-find end of it. + 0 + + ~ Skip whitespace. + { key dup is-space } { drop } while + + ~ Early exit if it's an EOF. We leave the accumulated string on the stack; + ~ since we're not in the loop yet, it will be empty and this will function + ~ as the caller's indication we're at EOF. + dup -1 = { drop exit } if + + accumulate-string + + { + peek dup is-space { drop exit } if + + ~ If it's an EOF, exit, leaving the accumulated string on the stack. + ~ It's nonempty, since we're in the loop already, and from the caller's + ~ perspective it's valid input. + dup -1 = { drop exit } if + + consume accumulate-string + } forever ; + + + +~ (character -- value) +: generalized-digit-value + ~ We don't have a character-literal syntax; the hex constants here are + ~ ASCII codes. + dup 0x61 <= { 0x61 - 10 + exit } if ~ lowercase "a" + dup 0x41 <= { 0x41 - 10 + exit } if ~ uppercase "a" + 0x30 - ; ~ digit "0" + + +~ (character, base +~ -- value (if successful), +~ error indicator (zero equals success)) +: decode-generalized-digit + swap dup is-alphanumeric { + ~ It's alphanumeric. + ~ (base, character) + generalized-digit-value + ~ (base, value) + dup 3roll + ~ (value, value, base) + > { + ~ It's in range. + ~ (value) + 0 exit } if + ~ It's out of range. + ~ (value) + drop 1 exit } if + ~ It's not alphanumeric. + drop drop 1 ; + + +~ (string pointer, base +~ -- result (if successful), +~ error indicator (zero equals success)) +: read-base-unsigned + swap + + ~ If the first byte is null, this is an error + unpack8 + ~ (numeric base, current point in string, character) + dup 0 = { drop drop drop 1 exit } if + + ~ Decode the first byte as a generalized digit in the base. + ~ (numeric base, current point in string, character) + ~ If the first byte is less than "0", this is an error. + 3roll dup 4 unroll + ~ (numeric base, current point in string, character, numeric base) + decode-generalized-digit { + ~ (numeric base, current point in string) + drop drop 1 exit } if + + ~ The first byte is a valid generalized digit in the appropriate base, so + ~ let's get started. + ~ (numeric base, current point in string, initial value) + swap + + { + ~ (numeric base, result so far, current point in string) + unpack8 dup 0 = { + ~ A null after the first character is valid, and indicates we're done. + drop drop swap drop 0 exit } if + + ~ Decode the latest byte as a generalized digit in the base. + ~ (numeric base, result so far, current point in string, latest byte) + 4 roll dup 5 unroll + ~ (numeric base, result so far, current point in string, character + ~ numeric base) + decode-generalized-digit { + ~ If the latest character is not a valid digit, that's an error. + ~ (numeric base, result so far, current point in string) + drop drop drop 1 exit } if + + ~ The latest character is valid, so incorporate it and loop. + ~ (numeric base, result so far, current point in string, latest value) + 3roll 4 roll dup 5 unroll * + swap + } forever ; + + +~ (string pointer +~ -- result (if successful), +~ error indicator (zero equals success)) +: read-integer-unsigned + ~ We don't have a character-literal syntax; the hex constants here are + ~ ASCII codes. + dup unpack8 0x30 != { ~ digit "0" + ~ This is the case where the leading digit is not a zero. + ~ (original string pointer, advanced string pointer) + drop 10 read-base-unsigned exit } if + + ~ This is the case where the leading digit is a zero. + ~ (original string pointer, advanced string pointer) + unpack8 dup 0x78 = { ~ lowercase "x" + ~ (original string pointer, doubly advanced string pointer, character) + drop swap drop 16 read-base-unsigned exit } if + + dup 0x6f = { ~ lowercase "o" + ~ (original string pointer, doubly advanced string pointer, character) + drop swap drop 8 read-base-unsigned exit } if + + dup 0x62 = { ~ lowercase "b" + ~ (original string pointer, doubly advanced string pointer, character) + swap drop swap 2 read-base-unsigned exit } if + + ~ This is the case where the second character is something else. + ~ (original string pointer, doubly advanced string pointer, character) + drop drop 10 read-base-unsigned ; + + +~ (string pointer +~ -- result (if successful), +~ error indicator (zero equals success)) +: read-integer + ~ We don't have a character-literal syntax; this is ASCII for a hyphen. + dup unpack8 0x2d != { + ~ This is the case where it's non-negative. + ~ (original string pointer, advanced string pointer) + drop read-integer-unsigned exit + } if + + ~ This is the case where it's negative. + ~ (original string pointer, advanced string pointer) + swap drop read-integer-unsigned + ~ (result maybe, exit code) + dup { + ~ Failure + ~ (non-zero exit code) + exit + } if + + ~ Success + ~ (result, zero exit code) + swap -1 * swap ; + + +~ (string pointer +~ -- result (if successful), +~ error indicator (zero equals success)) +: read-decimal + ~ We don't have a character-literal syntax; this is ASCII for a hyphen. + dup unpack8 0x2d != { + ~ This is the case where it's non-negative. + ~ (original string pointer, advanced string pointer) + drop 10 read-base-unsigned exit + } if + + ~ This is the case where it's negative. + ~ (original string pointer, advanced string pointer) + swap drop 10 read-base-unsigned + ~ (result maybe, exit code) + dup { + ~ Failure + ~ (non-zero exit code) + exit + } if + + ~ Success + ~ (result, zero exit code) + swap -1 * swap ; + +~ Here, we allocate a single machine word's worth of space to use as the +~ backing store of a mutable variable, initialized to zero. Then we define the +~ variable which points to that address. +~ +~ We don't actually need a word header for interpreter-flags-storage, we +~ could just append a zero and point to it directly, but that would make life +~ harder for words that attempt to work with the contents of other words. So +~ we give it a name. + +s" interpreter-flags-storage" create make-hidden +here @ 0 , s" interpreter-flags" variable + + +~ There's an important bootstrapping concern: If you're loading this +~ interpreter into a running Evocation, it's important to not use the wrong +~ interpreter state value. The way we actually load this is under the log-load +~ transform, which will be running its alternate versions of these words and +~ therefore won't have trouble, but for the sake of making it easy to +~ experiment with modified versions of this file, we do the whole hide-show +~ dance. + +: [ interpreter-flags @ 0x01 invert & interpreter-flags ! + ; make-immediate make-hidden +latest @ +~ (pointer to [ entry) + +: ] interpreter-flags @ 0x01 | interpreter-flags ! + ; make-hidden +latest @ +~ (pointer to [ entry, pointer to ] entry) + +~ It may seem nonsensical to use : to define :, but the log-load transform +~ provides an alternate for it, so it works. The same, of course, goes for all +~ these other word-defining words. The syntax-centric ones such as : are here +~ in interpret.e because they need to interact with interpreter-flags, which +~ isn't defined before this point. +~ +~ If the ] at the end feels backwards, imagine to yourself that everything +~ that ISN'T defining a word body is part of an implicit [ ... ] sequence. +~ Doing so doesn't really change anything, but may make you happier. +: : word value@ create dropstring docol , make-hidden + [ dup entry-to-execution-token , ] ; + +~ The counterpart of : is ;. +: ; + ~ See commentary on "literal", in language/dynamic/dynamic.e, regarding + ~ "lit exit". + ~ + ~ In regard to the magic comment, this is in the same category as strings + ~ and high-level flow control, where it's implemented in the base code here + ~ because that could be relevant to end-user code that compiles things + ~ without using the transforms, but in the regular compiler it's not used + ~ because the transforms override this whole implementation. + lit exit , ~ : -8 exit #-- (codeword pointer) + make-visible + ~ See above regarding [. Since it's an immediate word, we have to go to + ~ extra trouble to compile it as part of ;. Since it's also hidden, we have + ~ to go behind the interpreter's back to even get its entry pointer. + ~ + ~ Adding insult to injury, the log transform breaks , for unclear reasons, + ~ so we do that by hand as well. + [ over entry-to-execution-token , ] + ; make-immediate make-hidden +latest @ +~ (pointer to [ entry, pointer to ] entry, pointer to ; entry) + + +: ;asm + here @ pack-next 8 packalign here ! + make-visible + latest @ entry-to-execution-token dup 8 + swap ! + ~ See above. + [ 2 pick entry-to-execution-token , ] + ; make-immediate make-hidden +latest @ +~ (pointer to [ entry, pointer to ], pointer to ;, pointer to ;asm) + + +~ The word "'", often pronounced "tick", quotes the following word, looking +~ it up and treating it as a constant. In immediate mode, the constant winds +~ up on the stack; in compile mode it gets compiled. +~ +~ There are a few possible implementation strategies here. Running as an +~ immediate word means there's a clear and unambiguous concept of "the +~ following word", so that's what we do; otherwise we'd have to get clever +~ about somehow finding out where we were called from. That means we take on +~ what would otherwise be the interpreter's responsibility, of checking what +~ mode we're in. Happily, that's easy to do. +~ +~ There's a cyclic dependency where "if" relies on "'", and "'" relies on +~ "if". Fortunately flow-control is done with alternates by the log-load +~ transform, so we don't have to worry about it. +: ' word value@ find dropstring-with-result + interpreter-flags @ 0x01 & { literal } if + ; make-immediate + + +~ Let's have strings now. +: s" + consume + interpreter-flags @ 0x01 & { + [ s" litstring" find literal ] + ~ The magic comment isn't active in the compiler as-written, since the + ~ transformations do this bit themselves, but should still be here for + ~ completeness; it could affect other things people compile. + entry-to-execution-token , ~ : -8 litstring #-- (codeword pointer) + } if + here @ key { dup dup 0x22 != && } { pack8 key } while + drop 0 pack8 + interpreter-flags @ 0x01 & + { 8 packalign here ! } + { drop here @ } if-else + ; make-immediate + + +~ Finicky semantics, but also important. +: ." + ' s" entry-to-execution-token execute + interpreter-flags @ 1 & + { [ s" emitstring" find literal ] + ~ As with s", the magic comment is for completeness only. + entry-to-execution-token , ~ : -8 emitstring #-- (codeword pointer) + } { emitstring } if-else + ; make-immediate + + +~ While we're thinking about input, let's also have comments. +: ~ + key { dup dup 10 != && } { drop key } while drop + ; make-immediate + + +~ Now the single most important word... +: interpret + word + + ~ If no word was returned, exit. + dup 0 = { drop exit } if + + ~ The string is on the top of the stack, so to get a pointer to it we get + ~ the stack address. + ~ (string) + value@ find + + ~ Check whether the word was found in the dictionary. + dup { + ~ If the word is in the dictionary, check what mode we're in, then... + dropstring-with-result + ~ (entry pointer) + interpreter-flags @ 0x01 & { + ~ ... if we're in compile mode, there's still a chance it's an immediate + ~ word, in which case we fall through to interpret mode... + dup entry-flags@ 1 & 0 = + + ~ ... but it's a regular word, so append it to the heap. + { entry-to-execution-token , exit } if + } if + + ~ ... if we're in interpret mode, or the word is immediate, run it. + entry-to-execution-token execute exit + } if + + ~ If it's not in the dictionary, check whether it's an integer literal. + drop + ~ As before, we get the stack address and use it as a string pointer. + ~ (string) + value@ read-integer 0 = { + ~ It's a number. + interpreter-flags @ 0x01 & { + ~ We're in compile mode; append first "lit", then the number, to the + ~ heap. The version of "lit" we use is the one that's current when we + ~ ourselves are compiled, hardcoded; doing a dynamic lookup would + ~ require dealing with what happens if it's not found. + dropstring-with-result + ' lit entry-to-execution-token + , , + exit + } if + + ~ We're in interpret mode; push the number to the stack. Or at least, that's + ~ what the code we're interpreting will see. Really it's already on the + ~ stack, just clean everything else up and leave it there. + dropstring-with-result exit + } if + + ~ If it's neither in the dictionary nor a number, just print an error. + ." No such word: " value@ emitstring newline dropstring ; + +: quit r0 @ control! { interpret } forever ; + +~ Now we enable the three words we'd been keeping hidden. It would be a +~ good idea to call "quit" as soon as possible after this, but we leave it to +~ the user. +dup entry-flags@ 0x80 invert & swap entry-flags! +dup entry-flags@ 0x80 invert & swap entry-flags! +dup entry-flags@ 0x80 invert & swap entry-flags! +dup entry-flags@ 0x80 invert & swap entry-flags! + +~ Though we only do it once, this is a bit involved so we provide it as a +~ word. Notionally there are situations in which it could come up again, so +~ it seems worth having around. +~ +~ It actually needs to run as a compiled word no matter what; if it were +~ run in interpret mode it would cut itself off from the rest of itself. +~ However, if we didn't want to keep it around we could have it forget +~ itself... +~ +~ It depends on ', so it's here in interpret.e. +: relink-main-input-buffer-to-stdin + 1024 allocate dup main-input-buffer buffer-physical-start ! + main-input-buffer buffer-logical-start ! + 1024 main-input-buffer buffer-physical-length ! + 0 main-input-buffer buffer-logical-length ! + 0 main-input-buffer buffer-file-descriptor ! + [ s" refill-input-buffer-from-stream" + find entry-to-execution-token literal ] + main-input-buffer input-buffer-refill ! + ; + +~ Of course it is perfectly reasonable to change this, but for now it's +~ hardcoded. +relink-main-input-buffer-to-stdin + |