diff options
Diffstat (limited to 'language/static/core.e')
| -rw-r--r-- | language/static/core.e | 1371 |
1 files changed, 1371 insertions, 0 deletions
diff --git a/language/static/core.e b/language/static/core.e new file mode 100644 index 0000000..10d5d61 --- /dev/null +++ b/language/static/core.e @@ -0,0 +1,1371 @@ +~ ~~~~~~~~~~~~~~~~~~~~~~~~~ +~ ~~ Core Forth features ~~ +~ ~~~~~~~~~~~~~~~~~~~~~~~~~ +~ +~ This file provides extremely fundamental functionality which is a +~ necessary component of any Forth dialect, including Evocation. It is +~ included statically as part of any generated executable, and a second copy +~ of it is later copied into the log when that executable runs. Therefore, it +~ is written to obey the constraints of both the label transform, and the +~ log-load transform; see compilation/transform.e for more details on that. + + +~ Execution support +~ ~~~~~~~~~~~~~~~~~ +~ +~ There's two words, docol and exit, which are essential parts of the +~ indirect-threaded execution model. It would be tempting to put them in +~ compilation/execution.e, so they'd be closer to the explanation of what they +~ do, but we need two copies of them (just like we do of every other word in +~ this file), one statically compiled and one in the log. So, they're here, +~ because that's significantly simpler, even though it creates a little bit of +~ extra work for the label transform. + + +~ Docol is the "interpreter" that is responsible for the semantics of words +~ written as Forth high-level code. The name is said to be short for +~ "do colon", because word definitions begin with a colon. +~ +~ Concretely, when interpreting, it saves rsi (the "instruction pointer") to +~ the control stack, takes the address of the codeword from rax and increments +~ it in-place to form the new instruction pointer, and copies that to rsi. +~ +~ Having then done this, we're now in the state that normal execution +~ expects, so docol ends by it using "next" to begin the callee's execution, +~ kicking off a nested call. +~ +~ At runtime, invoke docol directly and it will return the value that should +~ be used as a codeword. When compiling to a binary executable, the +~ transformation facility needs to reference it directly, and for that +~ purpose, the label "docol-codeword-value" points to the correct place. +~ +~ Registers in: +~ +~ * rsi is the caller's instruction pointer +~ * rbp is the control stack pointer +~ * rax is the address of the callee's codeword +~ +~ Registers out: +~ +~ * rsi is the callee's instruction pointer +~ * rbp is the control stack pointer + +~ We need this one snippet of assembly code that's just on the log raw, +~ without a word header, because of its role in making words work. We define +~ a label pointing to it. +~ +~ This is the only use of labels in core.e. There's no easy way to +~ remove it. We can't use immediate computation based on "here" because +~ the label transform uses the host address space, not the target address +~ space. The transformation facility's support for labels in transformed +~ code was added just for this. +~ +~ It may seem as if we could have used some extra space in the middle of +~ the proper docol word, which is defined just below. That would work fine +~ with the label transform, which can do forward references, but the log-load +~ transform's label support is special-cased to ONLY do this, and it will only +~ work with a backward reference. +~ +~ We begin by outputting the actual docol routine, the one that codewords +~ should point to. Note that this is before we've done any word header. +~ +~ : This is the actual docol routine, the interpreter which is pointed to by +~ : the codeword of every interpreted word. It does not itself have an entry +~ : in the dictionary; the word "docol" will return a pointer to this routine. +~ : The word's entry follows immediately after the routine. +~ : indent +here @ +dup L!' docol-codeword-value +:rsi pack-pushcontrol +8 :rax add-reg64-imm8 +:rax :rsi mov-reg64-reg64 +pack-next +8 packalign +here ! +~ : deindent + +~ We can't use colon to create docol, not even the part that's a word, +~ because colon tries to dynamically invoke docol to fill in the codeword. +~ : blank-line +~ : This is the dictionary entry for docol. +~ : indent +s" docol" create +self-codeword +here @ +L@' docol-codeword-value :rax mov-reg64-imm64 +:rax push-reg64 +pack-next +8 packalign +here ! +~ : deindent +~ Now that we have docol, colon will work and we can define words the normal +~ way. + +~ This is the mechanism to "return" from a word interpreted by docol. +~ We pop the control stack, and then, since this is threaded execution, we +~ do the next thing the caller wants to do, by inlining "next". +: exit + [ here @ + :rsi pack-popcontrol + here ! ] ;asm + +~ Now that we have exit, semicolon will also work and we can define +~ non-assembly words. However, it will be hard to make them do much until we +~ have lit as well. There's no special hurry; most of the words in core.e are +~ assembly words. We'll get to it further down. + + +~ Stack manipulation routines +~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~ +~ We start with the three traditional stack operations, swap drop and +~ roll. Sorry to fans of the name "ROT"; we were an HP calculator kid. It'll +~ always be roll to us. Anyway, we do a couple other operations too. Since +~ our goal right now is just to bootstrap the heap, we keep this short and +~ sweet. +~ +~ This code has been written to satisfy the assumptions needed by the label +~ transform, described in-depth in compilation/transform.e. This means that it +~ is, in effect, written in a restricted dialect of Evocation rather than in +~ the full language. +~ +~ There is definitely plenty of optimization that could be done. + +: swap + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rax push-reg64 + :rbx push-reg64 + here ! ] ;asm + +: drop + [ here @ + :rax pop-reg64 + here ! ] ;asm + +: 2drop + [ here @ + :rax pop-reg64 + :rax pop-reg64 + here ! ] ;asm + +~ Rotates "up" (pops its parameter, n; nth item then becomes current item). +~ +~ We implement this the high-performance way, with rep movsq, aka the +~ instruction that exists to optimize C's memcpy(). The details of setting +~ that up are complex; see below. +: roll + [ here @ + + ~ Pop our parameter. The rep instruction takes rcx as its count, so we + ~ reduce copying by using it to hold our count, as well. + :rcx pop-reg64 + + ~ We have n - 1 items to slide, so decrement rcx. For the purpose of + ~ counting how many repetitions will happen, it's one-based. This is because + ~ the rep instruction performs a single movsq, then decrements rcx, then + ~ stops if rcx is zero. + :rcx dec-reg64 + + ~ Retrieve the nth item, for later. For this purpose we're thinking in + ~ zero-based terms, so we do this after already having decremented rcx. + :rsp :rcx 8 :rbx mov-reg64-indexed-reg64 + + ~ The source address for movsq is rsi and the destination is rdi; we can + ~ use rdi as we wish, but rsi is our Forth "instruction pointer", so we must + ~ save and restore it. Doing so alters rsp, so we have to adjust the address + ~ calculations by eight bytes as compared to the expressions above, but + ~ happily we can use the disp8 field to do that. We'd be using disp8 anyway + ~ because it's helpful. + :rsi push-reg64 + + ~ Now we set up parameters for the memory-sliding operation. We have + ~ n - 1 items to copy, moving the range rsp through rsp + (n-2)*8 onto the + ~ range rsp + 8 through rsp + (n-1)*8. That's with the value of rsp as it + ~ exists at this moment (it's going to change soon). + ~ + ~ We're sliding them upwards in memory, so we start at the high end so + ~ that we're always moving into a location that doesn't have anything + ~ precious. We use lea as a convenient way to do the stack math. + ~ + ~ When rcx is 1, we want rsp + 8. + :rsp :rcx 8 :rsi lea-reg64-indexed-reg64 + ~ When rcx is 1, we want rsp + 16. + :rsp :rcx 8 8 :rdi lea-reg64-disp8-indexed-reg64 + ~ + ~ Using rcx = 1 is the most convenient example to use for figuring out the + ~ arithmetic. It's a linear relationship, so as long as we get the 8-byte + ~ stride correct, we just need to pick a single point and verify that our + ~ math is right for that point, and it'll be right for any value of rcx. + + ~ Another of our Forth conventions is that the DF flag should be kept at + ~ zero, which directs string instruction to increment rsi. Here, however, + ~ because our source and destination ranges overlap, we need to start at the + ~ high end, which means we need it to decrement. So we set DF to one, and + ~ we'll clear it after. + std + rep-movs64 + + ~ Set everything back. + cld + :rsi pop-reg64 + + ~ There is now an extra item at the low end of the stack (the top) that + ~ needs to go away, and coincidentally we have a value in rbx that needs to + ~ be in that spot. Rather than doing a drop and push, we overwrite it, to + ~ save a little work. + :rbx :rsp mov-indirect-reg64-reg64 + + ~ All done, wow! What a mouthful. + here ! ] ;asm + +~ Rotates "down" (pops its parameter, n; current item then becomes nth +~ item). +~ +~ Jonesforth calls this "-roll" and we could do that, but honestly the name +~ unroll sounds nicer and it's only a single character longer. You might say +~ it rolls off the tongue better. +~ +~ We implement this the high-performance way, with rep movsq, aka the +~ instruction that exists to optimize C's memcpy(). The details of setting +~ that up are complex; see below. +: unroll + [ here @ + + ~ Pop our parameter. The rep instruction takes rcx as its count, so we + ~ reduce copying by using it to hold our count, as well. + :rcx pop-reg64 + + ~ We have n - 1 items to slide, so decrement rcx. Also, save a copy of it in + ~ rdx after doing that, for later. + :rcx dec-reg64 + :rcx :rdx mov-reg64-reg64 + + ~ Retrieve the 0th item, for later. + :rsp :rbx mov-reg64-indirect-reg64 + + ~ Now we set up parameters for the memory-sliding operation. We have + ~ n - 1 items to copy, moving the range rsp + 8 through rsp + (n-1)*8 onto + ~ the range rsp through rsp + (n-2)*8. That's with the value of rsp as it + ~ exists at this moment (it's going to change soon). + ~ + ~ We're sliding them downwards in memory, so we start at the low end so + ~ that we're always moving into a location that doesn't have anything + ~ precious. We use lea as a convenient way to do the stack math. + ~ + ~ As with roll, we need to save rsi and adjust those rsp calculations + ~ accordingly. + :rsi push-reg64 + + ~ Regardless of rcx, we want rsp + 16. + :rsp 16 :rsi lea-reg64-disp8-reg64 + ~ Regardless of rcx, we want rsp + 8. + :rsp 8 :rdi lea-reg64-disp8-reg64 + + ~ With roll, we were starting at the high end. Here, we start at the low + ~ end, which means we need rsi to increment after each repetition. That's + ~ what it does when the DF flag is clear, and another of our Forth + ~ conventions is to keep it clear normally. So, we don't have to touch DF! + ~ Yay! + rep-movs64 + + ~ Restore our original rsi. + :rsi pop-reg64 + + ~ There is now an extra item in the middle of the stack, at the high end of + ~ the sliding we did, that needs to be overwritten with our value in rbx. + ~ Since we destructively updated our count in rcx, we saved a copy of the + ~ count in rdx, and we use that to find the right address. + ~ + ~ When the original count was n, we want rsp + (n-1)*8, so we saved rdx + ~ after decrementing rcx, above. + :rbx :rsp :rdx 8 mov-indexed-reg64-reg64 + + ~ All done, wow! What a mouthful. + here ! ] ;asm + +~ Rotates "up" (third item becomes current item) +: 3roll + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rcx pop-reg64 + :rbx push-reg64 + :rax push-reg64 + :rcx push-reg64 + here ! ] ;asm + +~ Rotates "down" (current item becomes third item) +: 3unroll + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rcx pop-reg64 + :rax push-reg64 + :rcx push-reg64 + :rbx push-reg64 + here ! ] ;asm + +: dup + [ here @ + :rax pop-reg64 + :rax push-reg64 + :rax push-reg64 + here ! ] ;asm + +: 2dup + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rbx push-reg64 + :rax push-reg64 + :rbx push-reg64 + :rax push-reg64 + here ! ] ;asm + + +~ Arithmetic routines +~ ~~~~~~~~~~~~~~~~~~~ +~ +~ No surprises here. Again, since our goal is to bootstrap the heap, we +~ keep it short. Also again, this is nowhere near optimal. + +: + + [ here @ + :rbx pop-reg64 + :rax pop-reg64 + :rbx :rax add-reg64-reg64 + :rax push-reg64 + here ! ] ;asm + +: - + [ here @ + :rbx pop-reg64 + :rax pop-reg64 + :rbx :rax sub-reg64-reg64 + :rax push-reg64 + here ! ] ;asm + +: * + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rbx mul-reg64 + :rax push-reg64 + here ! ] ;asm + +~ Jonesforth calls this "/mod" but % is widely recognized and has no special +~ Forth significance. +: /% + [ here @ + :rdx :rdx xor-reg64-reg64 ~ rdx is the high bits of the input; zero it + :rbx pop-reg64 + :rax pop-reg64 + :rbx divmod-reg64 + :rdx push-reg64 ~ remainder + :rax push-reg64 ~ quotient + here ! ] ;asm + +~ We define a pair of words that increment and decrement a single item. +~ These were inspired by Common Lisp, where they're constantly useful. +: 1+ + [ here @ + :rax pop-reg64 + :rax inc-reg64 + :rax push-reg64 + here ! ] ;asm + +: 1- + [ here @ + :rax pop-reg64 + :rax dec-reg64 + :rax push-reg64 + here ! ] ;asm + + +~ Comparison routines +~ ~~~~~~~~~~~~~~~~~~~ +~ +~ So. This is subtle. These comparison routines all have the same structure. +~ Notice that = and != are commutative, whereas the others are not, so +~ consider > as the archetypical one when reasoning about correctness. To +~ test if A > B, we do cmp A, B, which sets the flags the same way as +~ subtracting B from A does. The mnemonic names of the condition codes are +~ based on the assumption you do it in this order. +~ +~ We want to treat the top of the stack as the first operand, so we +~ carefully pop in the appropriate order. +~ +~ There are both signed and unsigned variants of the condition codes. We +~ provide both; the unmarked comparisons such as > and <= are signed, while +~ the marked ones such as >unsigned and <=unsigned are of course unsigned. + +~ Jonesforth calls this "="; most languages would call it "==". +: = + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rbx :rax cmp-reg64-reg64 + :cc-equal :al set-reg8-cc + 0x01 :rax and-reg64-imm8 + :rax push-reg64 + here ! ] ;asm + +~ Jonesforth calls this "<>", but even most modern SQL dialects recognize +~ C's legacy and allow "!=" these days. As someone who learned C in childhood, +~ this is not actually a hard call for us. +: != + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rbx :rax cmp-reg64-reg64 + :cc-not-equal :al set-reg8-cc + 0x01 :rax and-reg64-imm8 + :rax push-reg64 + here ! ] ;asm + +~ Is the top of the stack greater than the second item in the stack, when +~ both are treated as signed? +: > + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rbx :rax cmp-reg64-reg64 + :cc-greater :al set-reg8-cc + 0x01 :rax and-reg64-imm8 + :rax push-reg64 + here ! ] ;asm + +~ Is the top of the stack less than the second item in the stack, when both +~ are treated as signed? +: < + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rbx :rax cmp-reg64-reg64 + :cc-less :al set-reg8-cc + 0x01 :rax and-reg64-imm8 + :rax push-reg64 + here ! ] ;asm + +~ Is the top of the stack greater than or equal to the second item in the +~ stack, when both are treated as signed? +: >= + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rbx :rax cmp-reg64-reg64 + :cc-greater-equal :al set-reg8-cc + 0x01 :rax and-reg64-imm8 + :rax push-reg64 + here ! ] ;asm + +~ Is the top of the stack less than or equal to the second item in the +~ stack, when both are treated as signed? +: <= + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rbx :rax cmp-reg64-reg64 + :cc-less-equal :al set-reg8-cc + 0x01 :rax and-reg64-imm8 + :rax push-reg64 + here ! ] ;asm + +~ Is the top of the stack greater than the second item in the stack, when +~ both are treated as unsigned? +: >unsigned + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rbx :rax cmp-reg64-reg64 + :cc-above :al set-reg8-cc + 0x01 :rax and-reg64-imm8 + :rax push-reg64 + here ! ] ;asm + +~ Is the top of the stack less than the second item in the stack, when +~ both are treated as unsigned? +: <unsigned + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rbx :rax cmp-reg64-reg64 + :cc-below :al set-reg8-cc + 0x01 :rax and-reg64-imm8 + :rax push-reg64 + here ! ] ;asm + +~ Is the top of the stack greater than or equal to the second item in the +~ stack, when both are treated as unsigned? +: >=unsigned + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rbx :rax cmp-reg64-reg64 + :cc-above-equal :al set-reg8-cc + 0x01 :rax and-reg64-imm8 + :rax push-reg64 + here ! ] ;asm + +~ Is the top of the stack less than or equal to the second item in the +~ stack, when both are treated as unsigned? +: <=unsigned + [ here @ + :rax pop-reg64 + :rbx pop-reg64 + :rbx :rax cmp-reg64-reg64 + :cc-below-equal :al set-reg8-cc + 0x01 :rax and-reg64-imm8 + :rax push-reg64 + here ! ] ;asm + + +~ Bitwise routines +~ ~~~~~~~~~~~~~~~~ +~ + +: & + [ here @ + :rbx pop-reg64 + :rax pop-reg64 + :rbx :rax and-reg64-reg64 + :rax push-reg64 + here ! ] ;asm + +: | + [ here @ + :rbx pop-reg64 + :rax pop-reg64 + :rbx :rax or-reg64-reg64 + :rax push-reg64 + here ! ] ;asm + +: xor + [ here @ + :rbx pop-reg64 + :rax pop-reg64 + :rbx :rax xor-reg64-reg64 + :rax push-reg64 + here ! ] ;asm + +~ The HP overloads the name "not", so we follow the Forth convention. +: invert + [ here @ + :rax pop-reg64 + :rax not-reg64 + :rax push-reg64 + here ! ] ;asm + + +~ Literal routines +~ ~~~~~~~~~~~~~~~~ +~ +~ These words are rarely used directly from user code, but are emitted by +~ the interpreter, in compile mode. They allow literal values of various kinds +~ to exist inline as part of compiled code, which would otherwise be only an +~ array of codeword pointers. They do this, in their various ways, by pushing +~ any appropriate value on the stack and making sure execution skips over the +~ bytes used to represent it. + +: lit + [ here @ + lods64 + :rax push-reg64 + here ! ] ;asm + +: litstring + [ here @ + ~ The string immediately follows the codeword in memory, so rsi is + ~ already pointing to it. That address will be our returned result, so we + ~ push it to the stack. + :rsi push-reg64 + + ~ Now we need to skip over the string, so that rsi will be valid for the + ~ next Forth word. To do that, we're going to do a string operation with + ~ scas8, which takes rdi as the address to look at. This means scas8 is + ~ treating its operand as analogous to the destination operand of movs*. + :rsi :rdi mov-reg64-reg64 + ~ We want to compare for equality with zero; scas8 looks in al for the + ~ other half of the comparison, so we clear rax. + :rax :rax xor-reg64-reg64 + ~ Counterintuitively, we do need to pass a count. We pass -1, which will + ~ always work. + :rcx :rcx xor-reg64-reg64 + :rcx not-reg64 + ~ The DF flag is zero per our Forth execution-model convention, which + ~ means scas8 increments rdi after each iteration. This is what we want, + ~ so there's no need to mess with it. + ~ + ~ We also need to worry about ZF, but fortunately that "not" will make + ~ sure it's clear. + ~ + ~ So, we're ready; do it! + repnz-scas8 + ~ The scas8 completes, incrementing rdi, before the repnz checks its + ~ condition. So, rdi is now pointing immediately after the terminating + ~ null byte. Of course, we want this in rsi for Forth's purposes. + :rdi :rsi mov-reg64-reg64 + + ~ Finally, we need to align rsi to the next word boundary. + 7 :rsi add-reg64-imm8 + 7 invert :rsi and-reg64-imm8 + + here ! ] ;asm + + +~ Memory access routines +~ ~~~~~~~~~~~~~~~~~~~~~~ +~ +~ We go with Forth names for this stuff. The HP's names for memory and +~ storage operations heavily leverage the fact they have an object system +~ with type tags and so on; we want to stay close to the bytes. + +~ (value, address --) +: ! + [ here @ + :rbx pop-reg64 + :rax pop-reg64 + :rax :rbx mov-indirect-reg64-reg64 + here ! ] ;asm + +~ (address -- value) +: @ + [ here @ + :rax pop-reg64 + :rax :rax mov-reg64-indirect-reg64 + :rax push-reg64 + here ! ] ;asm + +~ This follows the general convention that words that set things take the +~ destination as the final parameter. +~ +~ (value, address --) +: +! + [ here @ + :rbx pop-reg64 + :rax pop-reg64 + :rax :rbx add-indirect-reg64-reg64 + here ! ] ;asm + +~ (value, address --) +: -! + [ here @ + :rbx pop-reg64 + :rax pop-reg64 + :rax :rbx sub-indirect-reg64-reg64 + here ! ] ;asm + +~ Jonesforth calls this "c!" but we categorically reject the use of letters +~ that are meant to indicate byte sizes. It's unfriendly to newcomers. There's +~ some risk that this name will be confused for meaning "store a value of 8", +~ but that would not be a useful task, so hopefully it'll be okay. +: 8! + [ here @ + :rbx pop-reg64 + :rax pop-reg64 + :al :rbx mov-indirect-reg64-reg8 + here ! ] ;asm + +: 8@ + [ here @ + :rbx pop-reg64 + :rax :rax xor-reg64-reg64 + :rbx :al mov-reg8-indirect-reg64 + :rax push-reg64 + here ! ] ;asm + +: 16! + [ here @ + :rbx pop-reg64 + :rax pop-reg64 + :ax :rbx mov-indirect-reg64-reg16 + here ! ] ;asm + +: 16@ + [ here @ + :rbx pop-reg64 + :rax :rax xor-reg64-reg64 + :rbx :ax mov-reg16-indirect-reg64 + :rax push-reg64 + here ! ] ;asm + +: 32! + [ here @ + :rbx pop-reg64 + :rax pop-reg64 + :eax :rbx mov-indirect-reg64-reg32 + here ! ] ;asm + +: 32@ + [ here @ + :rbx pop-reg64 + :rax :rax xor-reg64-reg64 + :rbx :eax mov-reg32-indirect-reg64 + :rax push-reg64 + here ! ] ;asm + +~ Before we get too deep into it, we also define a few reflection routines +~ that retrieve, or set, the address of either of the two stacks. +~ +~ The result, or the new value, is on the top of the data stack. That's the +~ same as how it works for any other word, but given the metacircular nature +~ of these ones it's easy to get confused about that... +~ +~ Jonesforth calls this RSP!, which looks as if it's meant to be an Intel +~ register name but is actually short for return stack pointer. There is no +~ register by that name, it's a Forth-provided abstraction. That's super +~ confusing, plus as discussed above we call it the control stack not the +~ return stack, so we call the words... +~ +~ (stack pointer --) +: control! + [ here @ + :rbp pop-reg64 + here ! ] ;asm + +~ (-- stack pointer) +: control@ + [ here @ + :rbp push-reg64 + here ! ] ;asm + +~ Jonesforth calls this DSP!, for data stack pointer. Again, there's no +~ Intel register by that name, and we call it the value stack, so... +~ +~ (stack pointer --) +: value! + [ here @ + ~ Per Intel's description of POP this reads from the old location, and + ~ there is no increment applied to the resulting value. See, the + ~ description says it increments the register then overwrites it, in that + ~ order. + :rsp pop-reg64 + here ! ] ;asm + +~ (-- stack pointer) +: value@ + [ here @ + ~ Per Intel's description of PUSH this pushes the old value. + :rsp push-reg64 + here ! ] ;asm + +~ Copy one non-overlapping block of memory over another. For the overlapping +~ logic, see roll and unroll. This always copies at byte granularity, for ease +~ of implementation. +~ +~ Jonesforth calls this CMOVE and has a CCOPY which is a single byte. POSIX, +~ however, has memcpy() for non-overlapping blocks and memmove() for +~ overlapping blocks. We follow the latter convention, because it feels like +~ the more important distinction. +~ +~ Also, the "c" was meant to indicate that it works at one-byte granularity, +~ but that isn't, uh... actually an important property here, and as a blanket +~ call we're not using letters to denote data sizes. So we call it "memcopy". +~ Apologies to the C programming tradition but vowels are good, actually. +~ +~ Jonesforth also offers C@C! as another name for its CCOPY, but neither +~ "@!" nor "mem@mem!" seems particularly nice. +~ +~ (source, destination, length --) +: memcopy + [ here @ + ~ We need to save and restore rsi; the other registers we can trample. + :rsi :rdx mov-reg64-reg64 + :rcx pop-reg64 + :rdi pop-reg64 + :rsi pop-reg64 + ~ We start from the low end, since that's easier arithmetic. So, we get + ~ to leave the DF flag alone. + rep-movs8 + :rdx :rsi mov-reg64-reg64 + here ! ] ;asm + +~ This does the same thing as memcopy, but correctly handles situations +~ where the destination overlaps with the source. It achieves this by being +~ careful about which end the transfer starts from. This "move" vs. "copy" +~ distinction mirrors C terminology. +~ +~ (source, destination, length --) +: memmove + [ here @ + ~ We need to save and restore rsi; the other registers we can trample. + :rsi :rdx mov-reg64-reg64 + :rcx pop-reg64 + :rdi pop-reg64 + :rsi pop-reg64 + + ~ We need to check source < destination to decide which end to start from. + :rsi :rax mov-reg64-reg64 + :rdi :rax cmp-reg64-reg64 + ~ Relative offsets are from the start of the instruction after the jmp. + 4 :cc-below jmp-cc-rel-imm8 + + ~ If source is greater, we are sliding downwards so we start from the low + ~ end. So, we get to leave the DF flag alone. + rep-movs8 ~ 2 bytes + 16 jmp-rel-imm8 ~ 2 bytes + + ~ If destination is greater, we are sliding upwards so we start from the + ~ high end. So, we have to save and restore DF. Also, we have to adjust the + ~ pointers. + :rcx :rsi add-reg64-reg64 ~ 3 bytes + :rsi dec-reg64 ~ 3 bytes + :rcx :rdi add-reg64-reg64 ~ 3 bytes + :rdi dec-reg64 ~ 3 bytes + std ~ 1 byte + rep-movs8 ~ 2 bytes + cld ~ 1 byte + + :rdx :rsi mov-reg64-reg64 + here ! ] ;asm + + +~ (string pointer -- string length not including null byte) +: stringlen + [ here @ + :rdi pop-reg64 + :rdi :rbx mov-reg64-reg64 + :rax :rax xor-reg64-reg64 + :rcx :rcx xor-reg64-reg64 + :rcx not-reg64 + repnz-scas8 + :rbx :rdi sub-reg64-reg64 + 1 :rdi sub-reg64-imm8 + :rdi push-reg64 + here ! ] ;asm + +~ This word is for working with strings that are null-terminated at both +~ ends. It counts backwards from the end to find the string length. It accepts +~ an input pointer to the final non-null byte at the end of the string, and +~ returns the length not including either null byte. +~ +~ (string end pointer -- string length not including null) +: reverse-stringlen + [ here @ + :rdi pop-reg64 + + :rdi :rbx mov-reg64-reg64 + :rax :rax xor-reg64-reg64 + :rcx :rcx xor-reg64-reg64 + :rcx not-reg64 + + std + repnz-scas8 + cld + + :rdi :rbx sub-reg64-reg64 + 1 :rbx sub-reg64-imm8 + + :rbx push-reg64 + here ! ] ;asm + + +~ If you have a variable-length string followed by alignment padding, and +~ you want to traverse it in reverse, you also need to skip the alignment +~ padding... +~ +~ The alignment padding can have a total length of no more than 8 bytes. The +~ returned value counts from the end, backwards, to the nearest non-null byte, +~ or at most a distance of eight. +~ +~ (address of final null byte in padding -- count of null bytes in padding) +: reverse-padding-len + [ here @ + :rdi pop-reg64 + + :rdi :rbx mov-reg64-reg64 + :rax :rax xor-reg64-reg64 + 9 :rcx mov-reg64-imm32 + + std + repz-scas8 + cld + + :rdi :rbx sub-reg64-reg64 + 1 :rbx sub-reg64-imm8 + + :rbx push-reg64 + here ! ] ;asm + + +~ We make this work using exactly two jump instructions, which is likely the +~ minimum possible. To avoid relying on labels, we hand-compute the byte +~ offsets, so every instruction within their ranges is annotated with its +~ length in bytes. Good fun. +~ +~ The returned comparsion value is 0 for equal, 1 to indicate the left +~ string (lower on the stack) is greater, and -1 to indicate the right string +~ (top of the stack) is greater. +~ +~ (left string pointer, right string pointer -- comparison value) +: stringcmp + [ here @ + ~ Save the rsi register. + ~ + ~ Happily, we don't need a lot of registers for this code, so we can + ~ dedicate rdx to this and not have to deal with stack juggling.. + :rsi :rdx mov-reg64-reg64 + + ~ Get the parameters off the stack. + ~ + ~ For reasons that will be explained below, the left and right strings + ~ from our caller's perspective are swapped from the perspective of the + ~ comparisons we'll be doing. The rdi register points to the right-hand + ~ operand of the "cmps" instruction, while rsi points to the left-hand + ~ operand; [Intel] volume 2A, chapter 3, section 4-3.3, "CMPS"; note that + ~ the PDF mis-numbers the sections in the second half of chapter 3. + :rsi pop-reg64 + :rdi pop-reg64 + + ~ For the comparison-unequal loop-exit code, we'll need rbx set to zero. + ~ The easy way to do that is by xor'ing it with itself, but doing it at + ~ the end of the loop would overwrite the comparison flags, which we need. + ~ So we do it in advance, and carefully don't touch it anywhere else. + ~ + ~ See the list of which instructions affect the flags in [Intel] + ~ volume 1, appendix A, section A-1, table A-2. + :rbx :rbx xor-reg64-reg64 + + ~ We also clear rax; we'll be using al later, and it will be convenient + ~ to know the upper bits are always zero. + :rax :rax xor-reg64-reg64 + + ~ Now we've initialized everything we need; everything after this point is + ~ part of the loop. + + ~ At the start of each iteration, save a copy of the byte we're at now. + ~ We need to do this before cmps because the pointers will increment; + ~ we'll eventually use it to test whether we've reached the end delimiter. + ~ + ~ We do a 64-bit load into rcx, which is otherwise unused, then copy the + ~ low byte from cl to al. This avoids having to think about addressing + ~ modes that combine 64-bit addresses with smaller data sizes; those are + ~ very subtle. + :rsi :rcx mov-reg64-indirect-reg64 ~ 3 bytes + :cl :al mov-reg8-reg8 ~ 2 bytes + + ~ Now do the cmps, which is the heart of the loop. + ~ + ~ Note that, in addition to relying on this comparison to test content + ~ bytes against each other, in the event that one string is a prefix of + ~ the other, this will also test content bytes against null delimiters. + ~ The longer string will compare as "greater", because zero is less than + ~ all other possible byte values. This is what we want. + ~ + ~ Since strings of different lengths are necessarily unequal, letting + ~ this test do the work of detecting that also means we don't have to deal + ~ with scenarios where we're past the end of one string but not the other. + cmps8 ~ 1 byte + + ~ The flags are now set based on the simulated subtraction of the next + ~ bytes from the two strings. If they were unequal, the loop will end. If + ~ they were equal, we have another test to do before we're finished with + ~ this iteration. So we put the loop-end code next, and conditionally jump + ~ forward past it. + ~ + ~ Recall that relative offsets are from the start of the instruction after + ~ the jmp. + 15 :cc-equal jmp-cc-rel-imm8 ~ 2 bytes + + ~ If we got here, the strings are unequal, so we need to turn the flags + ~ into a comparison value. We cleared rbx earlier; now we set its low bit + ~ to the "above" flag, then use sbb to subtract the "carry" flag (which it + ~ thinks of as the "borrow" flag). + ~ + ~ Recall that "carry" is based on whether the comparison would cause a + ~ change to the next bit "outside" the bits being compared; [Intel] + ~ volume 1, chapter 3, section 3-4.3.1. Since the comparison is a + ~ subtraction, "carry" is true when the right-hand byte is strictly + ~ greater than the left-hand byte. + ~ + ~ Also recall that "zero", also called "equal", is based on whether the + ~ comparison's result produces output that's all zero bits. Since the + ~ comparison is a subtraction, "zero" is true when the two bytes are + ~ identical. + ~ + ~ The "above" condition is not a flag, but a composite of flags. It's + ~ true when both "carry" and "zero" are false; [Intel] volume 1, chapter + ~ 7, section 7-3.1.1, table 7-2. For us, this is equivalent to saying the + ~ left-hand byte is strictly greater than the right-hand. + ~ + ~ So, after the "set" instruction, rbx is 1 if left > right, and 0 if + ~ left = right or left < right. The "sbb" instruction with an immediate + ~ value of zero subtracts the value of the carry flag from rbx; the flag + ~ is true in the case where left < right, and false otherwise. So, after + ~ the "sbb", rbx is 1 if left > right, 0 if left = right, and -1 if + ~ left < right. + ~ + ~ This sounds like the opposite of what we want, but recall that we + ~ exchanged the operands, so these are the values our caller is expecting. + ~ While it might be tempting to look for a way to not need that + ~ transposition, and indeed there exists an approach using "not above", + ~ it's fiddly in a way that's even harder to explain. + ~ + ~ Note that it's important that the "jmp" and "set" instructions don't + ~ change the flags (see table A-2 again), so the "cmps" is the most recent + ~ thing that did. The "sbb" instruction does change them, but we don't + ~ need them again after that point so it doesn't matter. + ~ + ~ Finally, we need to restore rsi before we return to Forth. + ~ + ~ The two-instruction set-sbb sequence is one of those classic assembly + ~ programming tricks that often goes unexplained, because most of its + ~ appeal is its brevity and a proper explanation is quite lengthy. Please + ~ enjoy this gift of knowledge, and thanks to our friends who showed it to + ~ us. + :cc-above :bl set-reg8-cc ~ 3 bytes + 0 :rbx sbb-reg64-imm8 ~ 4 bytes + :rbx push-reg64 ~ 1 byte + :rdx :rsi mov-reg64-reg64 ~ 3 bytes + pack-next ~ 4 bytes + + ~ If we got here, the current bytes are equal to each other. We still + ~ need to test if they're null terminators; if so, we exit, and if not, we + ~ loop. + ~ + ~ At the beginning of this iteration, we saved a copy of the byte being + ~ inspected in rax. The "test" instruction simulates a xor and sets the + ~ flags accordingly. We check the "not equal" condition, also known as + ~ "not zero", and jump backwards to the start of the loop when that's the + ~ case. + ~ + ~ Recall that relative offsets are from the start of the instruction + ~ after the jmp. + :rax :rax test-reg64-reg64 ~ 3 bytes + -28 :cc-not-equal jmp-cc-rel-imm8 ~ 2 bytes + + ~ If we got here, we got all the way to the end of both strings and + ~ found a null byte, so we return 0 to indicate they're equal. + ~ + ~ We can use push-imm32-extended64 even though our stack holds 64-bit + ~ values, because it gets sign-extended. + ~ + ~ We need to restore rsi before we return to Forth. + 0 push-imm32-extended64 + :rdx :rsi mov-reg64-reg64 + here ! ] ;asm + + +~ Branching +~ ~~~~~~~~~ + +~ Okay, so there's a weird thing about how branch and 0branch are defined. +~ 0branch jumps into branch, so they need to be next to each other in the log. +~ To compute the offset to jump by, we pass an address on the stack. Notice +~ that assembly words are always defined in immediate mode; it's just they +~ usually only do trivial logic. + +~ This takes a number of bytes, not machine words. That allows it to be used +~ for putting weird things embedded in the code. +~ +~ The offset is relative to the start of the word the number of bytes is in, +~ so, make sure to have it skip itself. +: branch + [ here @ + dup swap ~ Save a copy of this address for later. + :rsi :rsi add-reg64-indirect-reg64 + here ! ] ;asm +~ (jump destination) + +: 0branch + [ here @ + ~ (jump destination, output point) + + :rax pop-reg64 + :rax :rax test-reg64-reg64 + + ~ Please notice the 8-bit branch to the nearby word. This is the offset + ~ from the end of the jmp instruction, to the start of the target + ~ instruction. To avoid needing the label system for this, we compute it + ~ based on the address before the jmp; the jmp itself is two bytes. + ~ + ~ Remember, with jump arithmetic, subtract the start from the + ~ destination. + ~ + ~ What we're testing with :cc-equal is that the input value is zero. + ~ The name is slightly counterintuitive; it's a result of the condition + ~ names favoring cmp over test. While cmp simulates subtraction, test + ~ simulates bitwise AND. + dup 2 + 3roll swap - :cc-equal jmp-cc-rel-imm8 + ~ (output point) + + ~ In the event we didn't jump, we still need to skip over the literal + ~ value. Using lods here is just a convenient way to skip rsi forward. + lods64 + + here ! ] ;asm +~ the stack is empty once more + + +~ This is like next, but instead of using rsi as the "instruction pointer", +~ it takes a codeword address from the value stack. +~ +~ In the event that the codeword is docol, docol will handle any +~ manipulation of the control stack that needs to happen. Yes, it really is +~ that simple. +~ +~ (execution token --) +: execute + [ here @ + :rax pop-reg64 + :rax jmp-abs-indirect-reg64 + here ! ] ;asm + + +~ Dictionary entries +~ ~~~~~~~~~~~~~~~~~~ +~ +~ Now, we have a bunch of words that are used for traversing the Forth +~ core data structures that describe words. First, we have a couple that +~ relate to individual words and their pieces... +~ +~ The log-load transform produces code that requires +~ entry-to-execution-token, which means it's needed statically. So this stuff +~ to deal with word entry headers might as well go in core, since it has no +~ dependencies to speak of. +~ +~ These are the first words in core that are implemented in Forth rather +~ than assembler. That's not as big a deal as it may seem; the Forth execution +~ model has been ready-to-go ever since we implemented docol and exit, and +~ at this point we have enough basics to do useful things with it. + +~ Jonesforth calls this "TFCA" and ">CFA"; its author speculates that the +~ original meaning is "code field address". +~ +~ (entry pointer -- execution token) +: entry-to-execution-token + ~ Skip next-entry pointer, flag byte, and start terminator. + 10 + + ~ Skip string contents. + dup stringlen + + ~ Skip one for the null terminator, seven more for alignment. + 8 + + ~ Zero the low bits and now it's aligned. + 7 invert & ; + +~ Jonesforth calls this "CFA>". Jonesforth's implementation searches the +~ entire dictionary, since its word header format isn't designed to be +~ traversed in reverse, but ours is, so it should be fast. +~ +~ (execution token -- entry pointer) +: execution-token-to-entry + 1 - + dup reverse-padding-len - + dup reverse-stringlen - + 9 - ; + +~ (entry pointer -- flags byte) +: entry-flags@ + 8 + @ 0xFF & ; + +~ (new flags byte, entry pointer --) +: entry-flags! + 8 + + dup @ 3roll + 0xFF & + swap 0xFFFFFFFFFFFFFF00 & | + swap ! + ; + +~ (entry pointer -- name string pointer) +: entry-to-name 10 + ; + + +~ Binary packing +~ ~~~~~~~~~~~~~~ +~ +~ These routines are for building up data structures in-memory. Sometimes +~ they're used for structures that are meant to stay in memory; other times +~ it's a buffer that will become output. +~ +~ The general pattern is that each routine takes an output address and +~ some specific datum, and returns the output address adjusted to point +~ after the new datum. That makes them easy to chain together. We call this +~ address the "output point", to capture the idea that it's a running total +~ which gets updated by each new datum as it's packed. + +~ (output point, value -- output point) +: pack64 swap dup 3unroll ! 8 + ; +: pack32 swap dup 3unroll 32! 4 + ; +: pack16 swap dup 3unroll 16! 2 + ; +: pack8 swap dup 3unroll 8! 1 + ; + +~ This works on C-style strings, which are characters followed by a null +~ terminator. The packed data includes the null terminator. +~ +~ (output point, string pointer -- output point) +: packstring + dup stringlen 1 + dup + ~ (output point, source, length, length) + 4 roll dup 4 unroll + + ~ (source, destination, length, length, output point) + + 4 unroll + ~ (output point, source, destination, length) + memcopy ; + +~ This also works on C-style strings, relying on the null terminator, but +~ the packed data does not include it. +~ +~ (output point, string pointer -- output point) +: pack-raw-string + dup stringlen dup + ~ (output point, source, length, length) + 4 roll dup 4 unroll + + ~ (source, destination, length, length, output point) + + 4 unroll + ~ (output point, source, destination, length) + memcopy ; + +~ (output point, alignment byte width -- output point) +: packalign + ~ It's possible the padding will be of length zero; keep that in mind + ~ while maintaining these magic comments, as it comes up in several ways. + ~ : fresh-line + ~ : 0 #-- (alignment padding) + { 2dup /% drop { drop exit } unless + swap 0 pack8 swap + ~ : 1 adjust-length + } forever ; + + +~ Binary unpacking +~ ~~~~~~~~~~~~~~~~ +~ +~ These routines are for examining data structures in-memory. +~ +~ Similarly to the output routines, each routine takes an input address, +~ which it updates to point after the data item being read. We call this the +~ "input point". Since this is input, the routines return data items rather +~ than accepting them. + +~ (input point -- input point, value) +: unpack64 dup @ swap 8 + swap ; +: unpack32 dup 32@ swap 4 + swap ; +: unpack16 dup 16@ swap 2 + swap ; +: unpack8 dup 8@ swap 1 + swap ; + +~ (proposed size, alignment byte width -- adjusted size) +: align-size + dup 3unroll dup 3unroll + ~ (alignment, alignment, proposed size, alignment) + 1 - + swap /% swap drop * ; + +~ You might think this would be identical to packalign, but packalign has +~ side effects. +~ +~ (input point, alignment byte width -- input point) +: unpackalign align-size ; + + +~ The first hint of a debugging tool +~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +~ This peforms the "hlt" instruction (Intel's mnemomic, short for "halt"), +~ which will cause the program to exit with a segmentation fault. If you're +~ running under a debugger, this is a convenient way to get execution to stop +~ at a certain point. +~ +~ It's called "crash" rather than "hlt" to distinguish it from the word +~ which outputs the instruction as machine code. +~ +~ This is the main diagnostic tool available under the label transform. Yep. +~ That's all we get. Don't make those eyes. +: crash + [ here @ + hlt + here ! ] ;asm + + +~ Additional conveniences +~ ~~~~~~~~~~~~~~~~~~~~~~~ +~ +~ Please feel free to find an organizing principle for these and put them +~ where they go. It would be kind of nice to re-write these either in +~ assembly, or with high-level flow control, but it doesn't seem urgent... + +: max + 2dup >= { swap } if + drop ; + +: min + 2dup <= { swap } if + drop ; + +: over swap dup 3unroll ; + +~ 0 pick is equivalent to dup. 1 pick is equivlent to over. +: pick 2 + dup roll dup 3roll unroll ; + +~ 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 } { swap drop 1- } while drop ; + +: ndup + dup 1+ swap + { dup } { swap dup pick 3unroll swap 1- } while + 2drop ; + +: 3drop drop drop drop ; +: 3dup 2 pick 2 pick 2 pick ; + +: && 0 != swap 0 != * ; +: || | 0 != ; +: not 0 = ; +: negate -1 * ; + +: 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 compilation/execution.e and +~ compilation/transform.e) has the job of fixing that, and it makes extensive +~ use of find-in to do so. +~ +~ The definition of "find" is in language/dynamic/dynamic.e, with the other +~ stuff that needs to access the log. +~ +~ (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 ; + |