diff options
Diffstat (limited to 'language/static')
| -rw-r--r-- | language/static/amd64.e | 1383 | ||||
| -rw-r--r-- | language/static/core.e | 1371 | ||||
| -rw-r--r-- | language/static/execution-support.e | 111 | ||||
| -rw-r--r-- | language/static/linux.e | 153 | ||||
| -rw-r--r-- | language/static/log-load.e | 547 | ||||
| -rw-r--r-- | language/static/output.e | 252 |
6 files changed, 3817 insertions, 0 deletions
diff --git a/language/static/amd64.e b/language/static/amd64.e new file mode 100644 index 0000000..925abc0 --- /dev/null +++ b/language/static/amd64.e @@ -0,0 +1,1383 @@ +~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~ ~~ Assembly language for the AMD64 architecture ~~ +~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~ +~ This is also often called the x86-64 architecture, but Intel didn't +~ invent it (they had their chance) and there's no reason to name it after +~ their product line. We have a bunch of assembler words that, taken as a +~ whole, form a sort of assembly language inside of the Forth-style language. +~ +~ It's all backwards and stuff. +~ +~ Okay, but seriously, the convention is: target on the top of the stack, +~ source behind it. This is similar to how the Forth "!" and "@" words work. +~ +~ These routines use the binary packing routines such as pack64, defined in +~ language/static/core.e. They're called in the same way: an output address +~ which we call the "output point", followed by data items specific to what's +~ being output. They also chain together in the same way, returning the +~ updated output point. +~ +~ TODO cite the Intel reference manual here and explain the notation used +~ for the section citations below +~ +~ TODO define instructions, assembly code, machine code, opcodes. if we ever +~ also want to recommend a childrens' introduction to binary, this might be +~ the place to do it. +~ +~ +~ Hex-transformed output +~ ~~~~~~~~~~~~~~~~~~~~~~ +~ +~ In addition to the actual semantics of the assembly words, there's an +~ important layer of meaning atop them. The hex transform, described in detail +~ in compilation/transform.e, modifies a compilation process to produce a +~ commented hex dump instead of a binary. It includes a magic-comment feature +~ which allows words that have opinions on what their output's hex dump should +~ look like to express them. +~ +~ The code in this file makes extensive use of the magic-comment feature. +~ Any comment which starts with : as its first word is a magic comment meant +~ for the hex transform. When the hex transform is not in use, these are +~ ordinary comments and are ignored. When it is in use, they create and modify +~ metadata annotations in a complex way. +~ +~ The magic comments in this file follows two important conventions: First, +~ entries are created by whichever word directly corresponds to a top-level +~ assembly instruction from the perspective of someone programming with it, +~ at some point prior to calling any word which might pack output. Second, +~ output bytes are accounted for by whichever word directly calls a pack* word +~ for them. +~ +~ Thus, for example, the word "syscall" has a comment which creates an entry +~ describing its length as 2 bytes, which never varies. +~ +~ The word "mov-reg64-imm32", on the other hand, has a comment which +~ creates an entry describing is length as 5 bytes - the opcode and the +~ immediate value, which are output with calls to pack8 and pack32 in that +~ word. However, the actual length of the instruction is 5 bytes. When +~ mov-reg64-imm32 calls rex-w, a magic comment there modifies the most recent +~ entry in-place, marking it as being one byte longer. Subsequently, +~ mov-reg64-imm32 calls addressing-reg64, which calls modrm, which again +~ modifies the same entry. Notice that addressing-reg64 didn't need to do +~ anything, because it isn't directly responsible for any packing. +~ +~ Notice that when an entry is modified in place, it needs to have been +~ created first. Attempting to do it in the wrong order will have an +~ undesired effect, most likely editing the entry of an unrelated instruction. +~ The hex transform doesn't have detailed knowledge of assembly, and isn't in +~ a position to know that the edits that are happening are sensible. +~ +~ Hopefully these examples show why an accounting convention is needed. The +~ good news is that the convention is quite robust and needs essentially no +~ play-by-play commentary, just this explainer at the top. + + +~ Keywords +~ ~~~~~~~~ +~ +~ We define a bunch of keywords, which evaluate to their own codeword +~ addresses. We use these to refer to registers and condition codes by name. +~ +~ +~ On registers +~ ~~~~~~~~~~~~ +~ +~ The x86 architecture has been around a while, it has been through +~ several transitions from smaller word sizes to larger ones. Therefore it +~ has different names for the "same" registers, depending on how much of +~ them you're using. +~ +~ TODO there's more to write here + +~ The names of the 64-bit registers. The second half of these are considered +~ "extended" registers because they don't correspond to 32-bit registers in +~ the way the first eight do. +s" :rax" keyword +s" :rcx" keyword +s" :rdx" keyword +s" :rbx" keyword +s" :rsp" keyword +s" :rbp" keyword +s" :rsi" keyword +s" :rdi" keyword +s" :r8" keyword +s" :r9" keyword +s" :r10" keyword +s" :r11" keyword +s" :r12" keyword +s" :r13" keyword +s" :r14" keyword +s" :r15" keyword + +~ The names of the 32-bit registers. The processor treats these as being +~ alternate names for the low halves of the 64-bit registers. There is a +~ very finicky distinction about what that means in different settings: Some +~ instructions operate on a 32-bit source or target, while others merely +~ accept a 32-bit value that gets sign-extended to 64 bits. We've taken pains +~ to clarify these cases in the instruction-specific notes, as they come up. +s" :eax" keyword +s" :ecx" keyword +s" :edx" keyword +s" :ebx" keyword +s" :esp" keyword +s" :ebp" keyword +s" :esi" keyword +s" :edi" keyword + +~ The names of the 16-bit registers. Similarly, the processor treats these +~ as being alternate names for the low halves of the 32-bit registers. +s" :ax" keyword +s" :cx" keyword +s" :dx" keyword +s" :bx" keyword +s" :sp" keyword +s" :bp" keyword +s" :si" keyword +s" :di" keyword + +~ The names of the 8-bit registers. The pattern here is a little bit +~ different; these come in "low" and "high" pairs, where for example :al is +~ the low half of :ax and :ah is the high half. Yes, this architecture grows +~ like a tree, with all the old things being still present, surrounded in the +~ new ones. +s" :al" keyword +s" :cl" keyword +s" :dl" keyword +s" :bl" keyword +s" :ah" keyword +s" :ch" keyword +s" :dh" keyword +s" :bh" keyword + +~ The condition codes. Yes, there sure is a lot of duplication in these +~ names. The names are based on Intel's documented mnemonics... +~ +~ "Above" and "below" are for unsigned comparisons. "Greater" and "less" are +~ for signed comparisons. +~ +~ This is documented on the individual opcode pages, and also in B.1.4.7. +s" :cc-overflow" keyword +s" :cc-no-overflow" keyword +s" :cc-below" keyword +s" :cc-above-equal" keyword +s" :cc-equal" keyword +s" :cc-not-equal" keyword +s" :cc-below-equal" keyword +s" :cc-above" keyword +s" :cc-sign" keyword +s" :cc-not-sign" keyword +s" :cc-even" keyword +s" :cc-odd" keyword +s" :cc-less" keyword +s" :cc-greater-equal" keyword +s" :cc-less-equal" keyword +s" :cc-greater" keyword + + +~ Bits and pieces +~ ~~~~~~~~~~~~~~~ +~ +~ Here, we have a bunch of helpers which generate specific encoded +~ representations that are part of many instructions. We start with the +~ trivial ones that handle individual fields, then work up to combinations of +~ fields. +~ +~ When we say that a word accepts a register as a parameter, what we mean +~ is it accepts the name keyword for that register. When we say that a word +~ accepts a scale factor, what we mean is that it accepts a byte count for +~ that scale factor. In the cases where we mean the encoded form, we'll say +~ "encoded value" or "value". +~ +~ (register -- 3-bit encoded value for register) +: reg64 + ~ : provide-keyword + dup :rax = { drop 0 exit } if + dup :rcx = { drop 1 exit } if + dup :rdx = { drop 2 exit } if + dup :rbx = { drop 3 exit } if + dup :rsp = { drop 4 exit } if + dup :rbp = { drop 5 exit } if + dup :rsi = { drop 6 exit } if + dup :rdi = { drop 7 exit } if + ." Parameter to reg64 is not a reg64." 1 sys-exit ; + +~ (register -- 3-bit encoded value for register) +: extrareg64 + ~ : provide-keyword + dup :r8 = { drop 0 exit } if + dup :r9 = { drop 1 exit } if + dup :r10 = { drop 2 exit } if + dup :r11 = { drop 3 exit } if + dup :r12 = { drop 4 exit } if + dup :r13 = { drop 5 exit } if + dup :r14 = { drop 6 exit } if + dup :r15 = { drop 7 exit } if + ." Parameter to extrareg64 is not an extrareg64." 1 sys-exit ; + +~ (register -- 3-bit encoded value for register) +: reg32 + ~ : provide-keyword + dup :eax = { drop 0 exit } if + dup :ecx = { drop 1 exit } if + dup :edx = { drop 2 exit } if + dup :ebx = { drop 3 exit } if + dup :esp = { drop 4 exit } if + dup :ebp = { drop 5 exit } if + dup :esi = { drop 6 exit } if + dup :edi = { drop 7 exit } if + ." Parameter to reg32 is not a reg32." 1 sys-exit ; + +~ (register -- 3-bit encoded value for register) +: reg16 + ~ : provide-keyword + dup :ax = { drop 0 exit } if + dup :cx = { drop 1 exit } if + dup :dx = { drop 2 exit } if + dup :bx = { drop 3 exit } if + dup :sp = { drop 4 exit } if + dup :bp = { drop 5 exit } if + dup :si = { drop 6 exit } if + dup :di = { drop 7 exit } if + ." Parameter to reg16 is not a reg16." 1 sys-exit ; + +~ (register -- 3-bit encoded value for register) +: reg8 + ~ : provide-keyword + dup :al = { drop 0 exit } if + dup :cl = { drop 1 exit } if + dup :dl = { drop 2 exit } if + dup :bl = { drop 3 exit } if + dup :ah = { drop 4 exit } if + dup :ch = { drop 5 exit } if + dup :dh = { drop 6 exit } if + dup :bh = { drop 7 exit } if + ." Parameter to reg8 is not a reg8." 1 sys-exit ; + + +~ There's a packed format called the SIB byte, which we'll get to in a +~ second. One of its bitfields is called the scale field. This word produces +~ an encoded value for that field. +~ +~ The input value is a byte count; the output value is suitable for use in +~ the SIB byte. +~ +~ (scale factor -- 2-bit encoded value) +: scalefield + ~ : provide-decimal + dup 1 = { drop 0 exit } if + dup 2 = { drop 1 exit } if + dup 4 = { drop 2 exit } if + dup 8 = { drop 3 exit } if + ." Parameter to scalefield is not 1, 2, 4, or 8." 1 sys-exit ; + + +~ [Intel] volume 2D, appendix B, section B-1.4.7, table B-10. Also see the +~ individual opcode pages. +~ +~ Every instruction has an "opcode", a specific byte or sequence of bytes +~ which uniquely identifies the combination of operation, addressing mode, +~ and certain miscellaneous characteristics. This is not just another way of +~ referring to the entire sequence of bytes corresponding to the instruction; +~ the opcode is a specific part within that, as distinct from ie. the rex +~ byte, the SIB byte, the Mod/RM byte, and various immediate values and other +~ rare tidbits. +~ +~ Some of these opcodes have bitfields within them, to specify condition +~ codes. This word produces an encoded value for that condition-code field. +~ +~ (condition -- 4-bit encoded value) +: condition-code + ~ : provide-keyword + dup :cc-overflow = { drop 0 exit } if + dup :cc-no-overflow = { drop 1 exit } if + dup :cc-below = { drop 2 exit } if + dup :cc-above-equal = { drop 3 exit } if + dup :cc-equal = { drop 4 exit } if + dup :cc-not-equal = { drop 5 exit } if + dup :cc-below-equal = { drop 6 exit } if + dup :cc-above = { drop 7 exit } if + dup :cc-sign = { drop 8 exit } if + dup :cc-not-sign = { drop 9 exit } if + dup :cc-even = { drop 10 exit } if + dup :cc-odd = { drop 11 exit } if + dup :cc-less = { drop 12 exit } if + dup :cc-greater-equal = { drop 13 exit } if + dup :cc-less-equal = { drop 14 exit } if + dup :cc-greater = { drop 15 exit } if + ." Parameter to condition-code is not a condition code." 1 sys-exit ; + + +~ The "rex" byte appears before an opcode to modify its behavior in various +~ ways. It has four distinct bits within it, leading to sixteen variations, +~ as you can see. +~ +~ The way these are all spelled out like this is slightly ridiculous, there +~ must be a better way. We only ever use rex-w and rex-wb, so it's tempting to +~ get rid of the rest, but they're worth having so that our future selves +~ don't have to revisit this topic. +~ +~ (output point -- output point) +: rex-0 + ~ : 1 adjust-length + 0x40 pack8 ; +: rex-w + ~ : 1 adjust-length + 0x48 pack8 ; +: rex-r + ~ : 1 adjust-length + 0x44 pack8 ; +: rex-x + ~ : 1 adjust-length + 0x42 pack8 ; +: rex-b + ~ : 1 adjust-length + 0x41 pack8 ; +: rex-wr + ~ : 1 adjust-length + 0x4C pack8 ; +: rex-wx + ~ : 1 adjust-length + 0x4A pack8 ; +: rex-wb + ~ : 1 adjust-length + 0x49 pack8 ; +: rex-rx + ~ : 1 adjust-length + 0x46 pack8 ; +: rex-rb + ~ : 1 adjust-length + 0x45 pack8 ; +: rex-xb + ~ : 1 adjust-length + 0x43 pack8 ; +: rex-wrx + ~ : 1 adjust-length + 0x4E pack8 ; +: rex-wrb + ~ : 1 adjust-length + 0x4D pack8 ; +: rex-wxb + ~ : 1 adjust-length + 0x4B pack8 ; +: rex-rxb + ~ : 1 adjust-length + 0x47 pack8 ; +: rex-wrxb + ~ : 1 adjust-length + 0x4F pack8 ; + + +~ Some opcodes use their low three bits as a field to give a register name. +~ This is usually in addition to a register name given in a Mod/RM byte, +~ serving a different role for the instruction. +~ +~ This word accepts an opcode byte with those three bits clear, and combines +~ it with a register value, then outputs the resulting byte. Each opcode +~ accepts some specific kind of register; to allow different kinds, here we +~ expect the step of converting the register name to the encoded bits to have +~ already been done. +~ +~ (output point, 3-bit encoded value for register, opcode byte +~ -- output point) +: opcodereg + ~ : 1 adjust-length + | pack8 ; + + +~ Some opcodes use their low four bits as a field to give a condition code. +~ This word accepts an opcode byte with those four bits clear, and combines it +~ with a condition code value, then outputs the resulting byte. For +~ consistency with opcodereg, we expect the step of converting the condition +~ code name to the encoded bits to have already been done. +~ +~ (output point, 4-bit encoded value for condition code, opcode byte +~ -- output point) +: opcodecc + ~ : 1 adjust-length + | pack8 ; + + +~ A Mod/RM byte ("mode / register-or-memory") is part of the encoding of +~ many instructions. It's divided into three fields: "mod" (mode), +~ register/opcode, and register/memory ("RM"). +~ +~ This word outputs a Mod/RM byte given fully-processed, numeric values for +~ its fields. Most code will want to call one of the higher-level +~ addressing-* words, instead. +~ +~ (output point, mod field, register/opcode field, register/memory field +~ -- output point) +: modrm + ~ : 1 adjust-length + swap 8 * | swap 64 * | pack8 ; + +~ An SIB byte ("scale, index, base") is part of the encoding of many +~ instructions. It's divided into three fields, with the names you've already +~ guessed. +~ +~ This word outputs an SIB byte given fully-processed, numeric values for +~ its fields. +~ +~ (output point, scale field, index field, base field -- output point) +: sib + ~ : 1 adjust-length + swap 8 * | swap 64 * | pack8 ; + + +~ Addressing modes +~ ~~~~~~~~~~~~~~~~ +~ +~ These are higher-level words meant to be easier to use than the bits and +~ pieces above. Each corresponds to some specific addressing mode. When +~ applicable, they accept keywords rather than pre-encoded values. +~ +~ That's not all the time, because there are cases, such as the reg/op +~ field, where the meaning is up to the individual instruction. In those +~ cases, these words do accept fully-processed, numeric values. +~ +~ The general rule is that the responsibility of these addressing-mode words +~ is for the parts that are common to all instructions using that addressing +~ mode. + + +~ The simplest of the addressing modes: Direct register addressing. There +~ are no special cases to check. +~ +~ It's important to notice that the R/M field may describe either a source, +~ or a target, depending on what the instruction is. So, this helper doesn't +~ get to know that. It also doesn't get to know whether the value in the +~ reg/op field describes a register, or if instead it's an extension of the +~ opcode. The caller is responsible for figuring that all out. +~ +~ (output point, reg/op field value, reg/mem field register +~ -- output point) +: addressing-reg64 reg64 3 3unroll modrm ; +: addressing-reg8 reg8 3 3unroll modrm ; + + +~ This is a helper for assembly instructions that want to do a form of +~ addressing that requires a value of 1 in the modrm byte's mode field, and +~ do not want to do any indexing. That's the indirect mode, which takes a +~ 64-bit register, treats it as an address, and looks up the 64-bit value it +~ points to. +~ +~ The helper's main responsibility is to deal with the scenario that +~ requires an SIB byte, which happens when the R/M field has a value of 4, +~ which would otherwise refer to the register rsp. In that situation, it also +~ generates an SIB byte which indicates a scale of 1, no indexing, and rsp as +~ the base register. +~ +~ When the register is :rbp, the only modes available also have +~ displacement; we disallow that. For that case, use an instruction that +~ uses a disp8 mode, and set a displacement of 0. +~ +~ In understanding this, pay close attention to the Op/En column in the +~ opcode table. The "RM" variant means the ModRM byte's R/M field (the third +~ one) is the source, while its reg field (the middle one) is the target. This +~ is what we want, because the R/M field is the one that gets indirection +~ applied to it. Opcode 0x8B with an REX.W prefix is the all-64-bit RM +~ variant. [Intel] volume 2B, chapter 4, section 4-3, "MOV". +~ +~ For the indirection modes, don't be confused by the many similar tables. +~ 64-bit mode is encoded the same as 32-bit mode except for adding a REX.W +~ prefix, as per 2.2.1.1, so you want table 2-2 to understand the ModRM byte. +~ The presence or absence of an SIB byte is determined by where in that table +~ we fall, and we aren't using a mode that has one. [Intel] volume 2A, +~ chapter 2, section 2-1.5, table 2-2. +~ +~ (output point, reg/op field value, reg/mem field register +~ -- output point) +: addressing-indirect-reg64 + ~ Exit with an error if the R/M register is :rbp. + dup :rbp != { + ~ Check whether the R/M register is :rsp. Save the test result for later. + dup :rsp = 4 unroll + ~ (equality result, output point, reg/op value, reg/mem name) + reg64 0 3unroll modrm + ~ (equality result, output point) + ~ If the R/M register was rsp, we need an SIB byte; otherwise, skip it. + swap { + 0 4 :rsp reg64 + ~ : drop-subitem + sib + } if + exit + } if + ." R/M parameter to addressing-indirect-reg64 is :rbp." 1 sys-exit ; + +~ (output point, reg/op field value, reg/mem field register, +~ displacement value -- output point) +: addressing-disp8-reg64 + ~ This mode can do :rbp fine, so no need to check for that. + ~ Check whether the R/M register is :rsp. Save the test result for later. + swap dup :rsp = 5 unroll swap + ~ Stash the displacement value out of the way, too. + 4 unroll + reg64 1 3unroll modrm + ~ If the R/M register was rsp, we need an SIB byte; otherwise, skip it. + 3roll { + 0 4 :rsp reg64 + ~ : drop-subitem + sib + } if + + ~ The displacement byte. + ~ + ~ When addressing-disp8-reg64 references a source, as in + ~ lea-reg64-disp8-reg64, the first two parameters of the assembly word + ~ calling it are the source register and the source displacement value. When + ~ it references a target or destination, as in mov-disp8-reg64-reg64, the + ~ LAST two parameters are the target registera and target displacement + ~ value. + ~ + ~ In both cases, the register comes first and the displacement value + ~ comes second. When these are used in a comment template without any other + ~ rearranging going on, whichever is on the top of the stack will be popped + ~ off first. So, we swap them here, thus putting the register on the top. + swap + ~ : 1 adjust-length + ~ : provide-hex8 + ~ : swap-subitems + pack8 ; + +~ (output point, reg/op field value, reg/mem field register, +~ displacement value -- output point) +: addressing-disp32-reg64 + ~ This mode can do :rbp fine, so no need to check for that. + ~ Check whether the R/M register is :rsp. Save the test result for later. + swap dup :rsp = 5 unroll swap + ~ Stash the displacement value out of the way, too. + 4 unroll + reg64 2 3unroll modrm + ~ If the R/M register was rsp, we need an SIB byte; otherwise, skip it. + 3roll { + 0 4 :rsp reg64 + ~ : drop-subitem + sib + } if + + ~ The displacement value. This is subject to the same considerations as in + ~ addressing-disp8-reg64. + swap + ~ : 4 adjust-length + ~ : provide-hex32 + ~ : swap-subitems + pack32 ; + +~ (output point, reg/op field value, +~ scale factor, index register, base field register +~ -- output point) +: addressing-indexed-reg64 + ~ Exit with an error if the base register is :rbp. + dup :rbp != { + ~ Reg/mem value 4 means to use an SIB byte (at least, with this mode). + 5 roll 0 6 roll 4 modrm 4 unroll + reg64 3unroll reg64 3unroll scalefield 3unroll + ~ We want the scale factor to show after the registers, so we put it + ~ last on the stack. We also want the base register to show before the + ~ index register, so the base comes first. + ~ + ~ Importantly, we have to do this before the sib so it'll count as being + ~ inside the span the assembly word's description attaches to. + ~ + ~ : -3 roll-subitems + ~ : swap-subitems + sib + exit + } if + ." Base parameter to addressing-indexed-reg64 is :rbp." 1 sys-exit ; + +~ (output point, reg/op field value, +~ scale factor, index register, base field register, +~ displacement value -- output point) +: addressing-disp8-indexed-reg64 + ~ This mode can do :rbp fine, so no need to check for that. + ~ Reg/mem value 4 means to use an SIB byte (at least, with this mode). + 6 roll 1 7 roll 4 modrm 5 unroll + 5 unroll reg64 3unroll reg64 3unroll scalefield 3unroll sib + swap + ~ : 1 adjust-length + ~ : provide-hex8 + ~ + ~ We want the parameters to be shown in the order: + ~ + ~ base register, index register, index scale factor, displacement + ~ + ~ So, we put them on the stack in the opposite of that order. + ~ + ~ Importantly, we have to do this before the pack8 so it'll count as being + ~ inside the span the assembly word's description attaches to. + ~ + ~ : -4 roll-subitems + ~ : -3 roll-subitems + ~ : swap-subitems + pack8 + ; + + +~ Easy instructions +~ ~~~~~~~~~~~~~~~~~ +~ +~ It's not worth pretending there's a coherent category behind this +~ grouping. These are the ones that were easy to deal with. + +~ (output point -- output point) +: cld + ~ : 1 cld + 0xFC pack8 ; +: std + ~ : 1 std + 0xFD pack8 ; +: syscall + ~ : 2 syscall + 0x0F pack8 0x05 pack8 ; +: hlt + ~ : 1 hlt + 0xF4 pack8 ; + +~ (output point, source register -- output point) +: push-reg64 + ~ : 0 # push-reg64 + reg64 0x50 opcodereg ; +: push-extrareg64 + ~ : 0 # push-extrareg64 + swap rex-b swap extrareg64 0x50 opcodereg ; + ~ Note the use of the B rex bit here; this instruction puts the register + ~ number in the opcode field, so it uses Table 3-1. + +~ (output point, target register -- output point) +: pop-reg64 + ~ : 0 # pop-reg64 + reg64 0x58 opcodereg ; +: pop-extrareg64 + ~ : 0 # pop-extrareg64 + swap rex-b swap extrareg64 0x58 opcodereg ; + ~ Note the use of the B rex bit here; this instruction puts the register + ~ number in the opcode field, so it uses Table 3-1. + +~ (output point, immediate value -- output point) +: push-imm32-extended64 + ~ : 5 # push-imm32-extended64 + swap 0x68 pack8 swap + ~ : provide-hex + pack32 ; + +~ (output point, source register, source displacement value, target register +~ -- output point) +: lea-reg64-disp8-reg64 + ~ : 1 # # # lea-reg64-disp8-reg64 + 4 roll rex-w 0x8D pack8 4 unroll + reg64 3unroll addressing-disp8-reg64 ; + +~ (output point, source register, source displacement value, target register +~ -- output point) +: lea-reg64-disp32-reg64 + ~ : 1 # # # lea-reg64-disp32-reg64 + 4 roll rex-w 0x8D pack8 4 unroll + reg64 3unroll addressing-disp32-reg64 ; + +~ (output point, +~ source base register, source index register, source index scale factor, +~ target register -- output point) +: lea-reg64-indexed-reg64 + ~ : 1 # # # # lea-reg64-indexed-reg64 + 5 roll rex-w 0x8D pack8 5 unroll + reg64 4 unroll 3unroll swap addressing-indexed-reg64 ; + +~ (output point, +~ source base register, source index register, source index scale factor, +~ source displacement value, +~ target register -- output point) +: lea-reg64-disp8-indexed-reg64 + ~ : 1 # # # # # lea-reg64-disp8-indexed-reg64 + 6 roll rex-w 0x8D pack8 6 unroll + reg64 5 unroll 3 roll 4 roll 3 roll addressing-disp8-indexed-reg64 ; + + +~ Move instructions +~ ~~~~~~~~~~~~~~~~~ +~ +~ These are, like, MOST of what we care about, so they get their own +~ section. Although it's very much the case that almost every two-operand +~ instruction offers this many distinct modes, we don't care about most of +~ those and don't yet implement them. We do care about all the modes for move +~ instructions. +~ +~ Someday perhaps we'll have extra-high-level features which generate all +~ the distinct versions of each instruction in a concise way, but that is not +~ this day. + +~ (output point, immediate value, register -- output point) +: mov-reg64-imm32 + ~ : 5 # # mov-reg64-imm32 + 3roll + rex-w 0xC7 pack8 swap + 0 swap addressing-reg64 + swap + ~ : provide-hex + pack32 ; +: mov-reg64-imm64 + ~ : 8 # # mov-reg64-imm64 + 3roll rex-w swap reg64 0xB8 opcodereg swap + ~ : provide-hex + pack64 ; +: mov-extrareg64-imm64 + ~ : 8 # # mov-extrareg64-imm64 + ~ Note the use of the B rex bit here; this instruction puts the register + ~ number in the opcode field, so it uses Table 3-1. + 3roll rex-wb swap extrareg64 0xB8 opcodereg swap + ~ : provide-hex + pack64 ; + +~ (output point, source register, target register -- output point) +: mov-reg64-reg64 + ~ : 1 # # mov-reg64-reg64 + 3roll rex-w 0x89 pack8 3unroll + swap reg64 swap addressing-reg64 + ~ : swap-subitems + ; +: mov-indirect-reg64-reg64 + ~ : 1 # # mov-indirect-reg64-reg64 + 3roll rex-w 0x89 pack8 3unroll + swap reg64 swap addressing-indirect-reg64 + ~ : swap-subitems + ; + +~ (output point, source register, target register, target displacement value +~ -- output point) +: mov-disp8-reg64-reg64 + ~ : 1 # # # mov-disp8-reg64-reg64 + 4 roll rex-w 0x89 pack8 4 unroll + 3roll reg64 3unroll addressing-disp8-reg64 + ~ : 3 roll-subitems + ; + +~ (output point, source register, target register -- output point) +: mov-reg64-indirect-reg64 + ~ : 1 # # mov-reg64-indirect-reg64 + 3roll rex-w 0x8B pack8 3unroll + reg64 swap addressing-indirect-reg64 ; + +~ (output point, source register, source displacement value, target register +~ -- output point) +: mov-reg64-disp8-reg64 + ~ : 1 # # # mov-reg64-disp8-reg64 + 4 roll rex-w 0x8B pack8 4 unroll + reg64 3unroll addressing-disp8-reg64 ; +: mov-reg64-disp32-reg64 + ~ : 1 # # # mov-reg64-disp32-reg64 + 4 roll rex-w 0x89 pack8 4 unroll + 3roll reg64 swap 3roll addressing-disp32-reg64 + ~ : swap-subitems + ~ : 3 roll-subitems + ; + +~ (output point, +~ source base register, source index register, source index scale factor, +~ target register -- output point) +: mov-reg64-indexed-reg64 + ~ : 1 # # # # mov-reg64-indexed-reg64 + 5 roll rex-w 0x8B pack8 5 unroll + reg64 4 unroll 3unroll swap addressing-indexed-reg64 ; + +~ (output point, source register, +~ target base register, target index register, target index scale factor +~ -- output point) +: mov-indexed-reg64-reg64 + ~ : 1 # # # # mov-indexed-reg64-reg64 + 5 roll rex-w 0x89 pack8 5 unroll + 4 roll reg64 4 unroll + 3unroll swap addressing-indexed-reg64 + ~ : 4 roll-subitems + ; + +~ (output point, source register, target register -- output point) +: mov-indirect-reg64-reg32 + ~ : 1 # # mov-indirect-reg64-reg32 + 3roll 0x89 pack8 3unroll + swap reg32 swap addressing-indirect-reg64 + ~ : swap-subitems + ; + +~ (output point, source register, target register, target displacement value +~ -- output point) +: mov-disp8-reg64-reg32 + ~ : 1 # # # mov-disp8-reg64-reg32 + 4 roll 0x89 pack8 4 unroll + 3roll reg32 3unroll addressing-disp8-reg64 + ~ : 3 roll-subitems + ; + +~ (output point, source register, target register -- output point) +: mov-reg32-indirect-reg64 + ~ : 1 # # mov-reg32-indirect-reg64 + 3roll 0x8B pack8 3unroll + reg32 swap addressing-indirect-reg64 ; + +~ (output point, source register, source displacement value, target register +~ -- output point) +: mov-reg32-disp8-reg64 + ~ : 1 # # # mov-reg32-disp8-reg64 + 4 roll 0x8B pack8 4 unroll + reg32 3unroll addressing-disp8-reg64 ; + +~ (output point, source register, target register -- output point) +: mov-indirect-reg64-reg16 + ~ : 2 # # mov-indirect-reg64-reg16 + 3roll 0x66 pack8 0x89 pack8 3unroll + swap reg16 swap addressing-indirect-reg64 + ~ : swap-subitems + ; + +~ (output point, source register, target register, target displacement value +~ -- output point) +: mov-disp8-reg64-reg16 + ~ : 2 # # # mov-disp8-reg64-reg16 + 4 roll 0x66 pack8 0x89 pack8 4 unroll + 3roll reg16 3unroll addressing-disp8-reg64 + ~ : 3 roll-subitems + ; + +~ (output point, source register, target register -- output point) +: mov-reg16-indirect-reg64 + ~ : 2 # # mov-reg16-indirect-reg64 + 3roll 0x66 pack8 0x8B pack8 3unroll + reg16 swap addressing-indirect-reg64 ; + +~ (output point, source register, target displacement value, target register +~ -- output point) +: mov-reg16-disp8-reg64 + ~ : 2 # # # mov-reg16-disp8-reg64 + 4 roll 0x66 pack8 0x8B pack8 4 unroll + reg16 3unroll addressing-disp8-reg64 ; + +~ (output point, source register, target register -- output point) +: mov-indirect-reg64-reg8 + ~ : 1 # # mov-indirect-reg64-reg8 + 3roll 0x88 pack8 3unroll + swap reg8 swap addressing-indirect-reg64 + ~ : swap-subitems + ; + +~ (output point, source register, target register, target displacement value +~ -- output point) +: mov-disp8-reg64-reg8 + ~ : 1 # # # mov-disp8-reg64-reg8 + 4 roll 0x88 pack8 4 unroll + 3roll reg8 3unroll addressing-disp8-reg64 + ~ : 3 roll-subitems + ; + +~ (output point, source register, target register -- output point) +: mov-reg8-indirect-reg64 + ~ : 1 # # mov-reg8-indirect-reg64 + 3roll 0x8A pack8 3unroll + reg8 swap addressing-indirect-reg64 ; + +~ (output point, source register, source displacement value, target register +~ -- output point) +: mov-reg8-disp8-reg64 + ~ : 2 # # # mov-reg8-disp8-reg64 + 4 roll 0x8A pack8 4 unroll + reg8 3unroll addressing-disp8-reg64 ; + +~ (output point, source register, target register -- output point) +: mov-reg8-reg8 + ~ : 1 # # mov-reg8-reg8 + 3roll 0x88 pack8 3unroll + swap reg8 swap addressing-reg8 + ~ : swap-subitems + ; + + +~ String instructions +~ ~~~~~~~~~~~~~~~~~~~ +~ +~ These are in their own section because there's an awful lot of +~ combinations, and fortunately they are very uniform in structure. +~ +~ What makes these useful is that they take their parameters from certain +~ fixed registers, which are chosen such that the operations chain into each +~ other well. Thus you can use them to build various block-memory and string +~ operations, and even if you need unusual forms of loop unrolling or +~ alignment tweaking, the code will end up uniform in structure. On modern +~ processors, this is even the high-performance approach, due to highly +~ optimized microcode, though these operations were inefficient when they +~ were first invented. +~ +~ We break with the Intel mnemonics, which follow the pattern +~ movsb/movsw/movsd/movsq, because this would otherwise be the only place we +~ use the b/w/d/q thing instead of 8/16/32/64. Tradition and pronounceability +~ are both nice things, but approachability to newcomers is important, too. +~ +~ Some of these are repeatable; whether you view the repeatable variants +~ as different instructions is up to you. At any rate the machine code +~ representation of the repeatable variants is the same as for the regular +~ variants with an extra prefix, so we define them together. +~ +~ This is a proper superset of the flatassembler implementations of string +~ instructions. The wisdom of that is questionable, but at least it's noted +~ here... + +~ (output point -- output point) +: movs8 + ~ : 1 movs8 + 0xA4 pack8 ; +: movs16 + ~ : 2 movs16 + 0x66 pack8 0xA5 pack8 ; +: movs32 + ~ : 1 movs32 + 0xA5 pack8 ; +: movs64 + ~ : 1 movs64 + rex-w 0xA5 pack8 ; +: rep-movs8 + ~ : 2 rep-movs8 + 0xF3 pack8 0xA4 pack8 ; +: rep-movs16 + ~ : 3 rep-movs16 + 0xF3 pack8 0x66 pack8 0xA5 pack8 ; +: rep-movs32 + ~ : 2 rep-movs32 + 0xF3 pack8 0xA5 pack8 ; +: rep-movs64 + ~ : 2 rep-movs64 + 0xF3 pack8 rex-w 0xA5 pack8 ; + +~ (output point -- output point) +: lods8 + ~ : 1 lods8 + 0xAC pack8 ; +: lods16 + ~ : 2 lods16 + 0x66 pack8 0xAd pack8 ; +: lods32 + ~ : 1 lods32 + 0xAD pack8 ; +: lods64 + ~ : 1 lods64 + rex-w 0xAD pack8 ; +: rep-lods8 + ~ : 2 rep-lods8 + 0xF3 pack8 0xAC pack8 ; +: rep-lods16 + ~ : 3 rep-lods16 + 0xF3 pack8 0x66 pack8 0xAD pack8 ; +: rep-lods32 + ~ : 2 rep-lods32 + 0xF3 pack8 0xAD pack8 ; +: rep-lods64 + ~ : 2 rep-lods64 + 0xF3 pack8 rex-w 0xAD pack8 ; + +~ (output point -- output point) +: stos8 + ~ : 1 stos8 + 0xAA pack8 ; +: stos16 + ~ : 2 stos16 + 0x66 pack8 0xAB pack8 ; +: stos32 + ~ : 1 stos32 + 0xAB pack8 ; +: stos64 + ~ : 1 stos64 + rex-w 0xAB pack8 ; +: rep-stos8 + ~ : 2 rep-stos8 + 0xF3 pack8 0xAA pack8 ; +: rep-stos16 + ~ : 3 rep-stos16 + 0xF3 pack8 0x66 pack8 0xAB pack8 ; +: rep-stos32 + ~ : 2 rep-stos32 + 0xF3 pack8 0xAB pack8 ; +: rep-stos64 + ~ : 2 rep-stos64 + 0xF3 pack8 rex-w 0xAB pack8 ; + +~ (output point -- output point) +: cmps8 + ~ : 1 cmps8 + 0xA6 pack8 ; +: cmps16 + ~ : 2 cmps16 + 0x66 pack8 0xA7 pack8 ; +: cmps32 + ~ : 1 cmps32 + 0xA7 pack8 ; +: cmps64 + ~ : 1 cmps64 + rex-w 0xA7 pack8 ; +: repz-cmps8 + ~ : 2 repz-cmps8 + 0xF3 pack8 0xA6 pack8 ; +: repz-cmps16 + ~ : 3 repz-cmps16 + 0xF3 pack8 0x66 pack8 0xA7 pack8 ; +: repz-cmps32 + ~ : 2 repz-cmps32 + 0xF3 pack8 0xA7 pack8 ; +: repz-cmps64 + ~ : 2 repz-cmps64 + 0xF3 pack8 rex-w 0xA7 pack8 ; +: repnz-cmps8 + ~ : 2 repnz-cmps8 + 0xF2 pack8 0xA6 pack8 ; +: repnz-cmps16 + ~ : 3 repnz-cmps16 + 0xF2 pack8 0x66 pack8 0xA7 pack8 ; +: repnz-cmps32 + ~ : 2 repnz-cmps32 + 0xF2 pack8 0xA7 pack8 ; +: repnz-cmps64 + ~ : 2 repnz-cmps64 + 0xF2 pack8 rex-w 0xA7 pack8 ; + +~ (output point -- output point) +: scas8 + ~ : 1 scas8 + 0xA8 pack8 ; +: scas16 + ~ : 2 scas16 + 0x66 pack8 0xAF pack8 ; +: scas32 + ~ : 1 scas32 + 0xAF pack8 ; +: scas64 + ~ : 1 scas64 + rex-w 0xAF pack8 ; +: repz-scas8 + ~ : 2 repz-scas8 + 0xF3 pack8 0xAE pack8 ; +: repz-scas16 + ~ : 3 repz-scas16 + 0xF3 pack8 0x66 pack8 0xAF pack8 ; +: repz-scas32 + ~ : 2 repz-scas32 + 0xF3 pack8 0xAF pack8 ; +: repz-scas64 + ~ : 2 repz-scas64 + 0xF3 pack8 rex-w 0xAF pack8 ; +: repnz-scas8 + ~ : 2 repnz-scas8 + 0xF2 pack8 0xAE pack8 ; +: repnz-scas16 + ~ : 3 repnz-scas16 + 0xF2 pack8 0x66 pack8 0xAF pack8 ; +: repnz-scas32 + ~ : 2 repnz-scas32 + 0xF2 pack8 0xAF pack8 ; +: repnz-scas64 + ~ : 2 repnz-scas64 + 0xF2 pack8 rex-w 0xAF pack8 ; + + +~ Arithmetic instructions +~ ~~~~~~~~~~~~~~~~~~~~~~~ +~ +~ Operations between two registers always have the target register as the +~ last parameter. Operations between a register and an immediate ALSO have the +~ target register as the last parameter, which is obvious for add-reg64-imm8 +~ but can be confusing for sub-reg64-imm8 or cmp-reg64-imm8. Also note what +~ this means for sub-reg64-reg64 and cmp-reg64-reg64. +~ +~ Every possible convention here leads to counterintuitive behavior in some +~ cases. This one has proven to be more memorable than the other obvious +~ choices, and that'll have to be enough. + +~ (output point, source register, target register -- output point) +: add-reg64-reg64 + ~ : 1 # # add-reg64-reg64 + 3roll rex-w 0x01 pack8 3unroll + swap reg64 swap addressing-reg64 + ~ : swap-subitems + ; + +~ (output point, source register, target register -- output point) +: add-indirect-reg64-reg64 + ~ : 1 # # add-indirect-reg64-reg64 + 3roll rex-w 0x01 pack8 3unroll + swap reg64 swap addressing-indirect-reg64 + ~ : swap-subitems + ; + +~ (output point, source register, target register -- output point) +: add-reg64-indirect-reg64 + ~ : 1 # # add-reg64-indirect-reg64 + 3roll rex-w 0x03 pack8 3unroll + reg64 swap addressing-indirect-reg64 ; + +~ (output point, immediate value, target register -- output point) +: add-reg64-imm8 + ~ : 2 # # add-reg64-imm8 + 3roll rex-w 0x83 pack8 swap 0 swap addressing-reg64 + swap + ~ : provide-hex + pack8 ; + +~ See above re: parameter order. +~ +~ (output point, source register, target register -- output point) +: sub-reg64-reg64 + ~ : 1 # # sub-reg64-reg64 + 3roll rex-w 0x2B pack8 3unroll + reg64 swap addressing-reg64 ; + +~ (output point, source register, target register -- output point) +: sub-indirect-reg64-reg64 + ~ : 1 # # sub-indirect-reg64-reg64 + 3roll rex-w 0x2B pack8 3unroll + swap reg64 swap addressing-indirect-reg64 + ~ : swap-subitems + ; + +~ See above re: parameter order. +~ +~ (output point, immediate value, target register -- output point) +: sub-reg64-imm8 + ~ : 2 # # sub-reg64-imm8 + 3roll rex-w 0x83 pack8 swap 5 swap addressing-reg64 + swap + ~ : provide-hex + pack8 ; + +~ See above re: parameter order. +~ +~ (output point, source register, target register -- output point) +: sbb-reg64-imm8 + ~ : 2 # # sbb-reg64-imm8 + 3roll rex-w 0x83 pack8 swap 3 swap addressing-reg64 + swap + ~ : provide-hex + pack8 ; + +~ The target register is always rax. +~ +~ (output point, source register -- output point) +: mul-reg64 + ~ : 1 # mul-reg64 + swap rex-w 0xF7 pack8 swap + 4 swap addressing-reg64 ; + +~ The dividend is 128 bits, and is formed from rdx as the high half and rax +~ as the low half. The divisor is a specified register. The quotient is +~ returned in rax, truncated towards zero. The remainder is in rdx. This +~ entire process is unsigned. +~ +~ The official mnemonic for this is "div", but divmod is what it does. +~ +~ (output point, divisor register -- output point) +: divmod-reg64 + ~ : 1 # divmod-reg64 + swap rex-w 0xF7 pack8 swap + 6 swap addressing-reg64 ; + +~ Same as divmod, but signed. +~ +~ (output point, divisor register -- output point) +: idivmod-reg64 + ~ : 1 # idivmod-reg64 + swap rex-w 0xF7 pack8 swap + 7 swap addressing-reg64 ; + +~ (output point, target register -- output point) +: inc-reg64 + ~ : 1 # inc-reg64 + swap rex-w 0xFF pack8 swap 0 swap addressing-reg64 ; + +~ (output point, target register -- output point) +: dec-reg64 + ~ : 1 # dec-reg64 + swap rex-w 0xFF pack8 swap 1 swap addressing-reg64 ; + +~ (output point, source register, target register -- output point) +: and-reg64-reg64 + ~ : 1 # # and-reg64-reg64 + 3roll rex-w 0x23 pack8 3unroll + reg64 swap addressing-reg64 ; + +~ (output point, source value, target register -- output point) +: and-reg64-imm8 + ~ : 2 # # and-reg64-imm8 + 3roll rex-w 0x83 pack8 swap + 4 swap addressing-reg64 + swap + ~ : provide-hex + pack8 ; + +~ (output point, source register, target register -- output point) +: or-reg64-reg64 + ~ : 1 # # or-reg64-reg64 + 3roll rex-w 0x0B pack8 3unroll + reg64 swap addressing-reg64 ; + +~ (output point, source value, target register -- output point) +: or-reg64-imm8 + ~ : 2 # # or-reg64-imm8 + 3roll rex-w 0x83 pack8 swap + 1 swap addressing-reg64 + swap + ~ : provide-hex + pack8 ; + +~ (output point, source register, target register -- output point) +: xor-reg64-reg64 + ~ : 1 # # xor-reg64-reg64 + 3roll rex-w 0x33 pack8 3unroll + reg64 swap addressing-reg64 ; + +~ (output point, target register -- output point) +: not-reg64 + ~ : 1 # not-reg64 + swap rex-w 0xF7 pack8 + swap 2 swap addressing-reg64 ; + +~ (output point, bit count, target register -- output point) +: rol-reg64-imm8 + ~ : 2 # # rol-reg64-imm8 + 3roll rex-w 0xC1 pack8 swap + 0 swap addressing-reg64 + swap + ~ : provide-hex + pack8 ; + +~ (output point, bit count, target register -- output point) +: rol-reg8-imm8 + ~ : 2 # # rol-reg8-imm8 + 3roll 0xC0 pack8 swap + 0 swap addressing-reg8 + swap + ~ : provide-hex + pack8 ; + +~ (output point, bit count, target register -- output point) +: ror-reg64-imm8 + ~ : 1 # # ror-reg64-imm8 + 3roll rex-w 0xC1 pack8 swap + 1 swap addressing-reg64 + swap + ~ : provide-hex + pack8 ; + +~ (output point, bit count, target register -- output point) +: ror-reg8-imm8 + ~ : 2 # # ror-reg8-imm8 + 3roll 0xC0 pack8 swap + 1 swap addressing-reg64 + swap + ~ : provide-hex + pack8 ; + + +~ Control flow instructions +~ ~~~~~~~~~~~~~~~~~~~~~~~~~ +~ +~ The comparator instructions cmp and test follow the same argument-order +~ conventions as the arithmetic instructions: The target register always comes +~ last. See the arithmetic section for more discussion. + +~ Pretend to subtract right from left, and set the flags the same way as if +~ we actually had. +~ +~ (output point, left register, right register -- output point) +: cmp-reg64-reg64 + ~ : 1 # # cmp-reg64-reg64 + 3roll rex-w 0x3B pack8 3unroll + reg64 swap addressing-reg64 ; + +~ See above re: parameter order. +~ +~ (output point, immediate value, target register -- output point) +: cmp-reg64-imm8 + ~ : 2 # # cmp-reg64-imm8 + 3roll rex-w 0x83 pack8 + ~ (immediate value, register, output point) + swap 7 swap addressing-reg64 + ~ ( output point, immediate value) + swap + ~ : provide-hex + pack8 ; + +~ Pretend to bitwise-and left with right, and set the flags the same way as +~ if we actually had. +~ +~ The names of the condition codes can be a little confusing when using them +~ after "test", because they're really premised on the idea that you did +~ "cmp". +~ +~ (output point, left register, right register -- output point) +: test-reg64-reg64 + ~ : 1 # # test-reg64-reg64 + 3roll rex-w 0x85 pack8 3unroll + swap reg64 swap addressing-reg64 + ~ : swap-subitems + ; + +~ (output point, condition code, target register -- output point) +: set-reg8-cc + ~ : 1 # # set-reg8-cc + 3roll 0x0F pack8 + 3roll condition-code 0x90 opcodecc + swap reg8 3 0 3roll modrm + ~ : swap-subitems + ; + +~ (output point, address offset value, condition code -- output point) +: jmp-cc-rel-imm8 + ~ : 1 # # jmp-cc-rel-imm8 + 3roll swap condition-code 0x70 opcodecc + swap + ~ : provide-hex + pack8 ; + +~ (output point, address offset value, condition code -- output point) +: jmp-cc-rel-imm32 + ~ : 5 # # jmp-cc-rel-imm32 + 3roll 0x0F pack8 + swap condition-code 0x70 opcodecc + swap + ~ : provide-hex + pack32 ; + +~ (output point, register -- output point) +: jmp-abs-indirect-reg64 + ~ : 1 # jmp-abs-indirect-reg64 + swap 0xFF pack8 swap + 4 swap addressing-indirect-reg64 ; + +~ (output point, address offset value -- output point) +: jmp-rel-imm8 + ~ : 2 # jmp-rel-imm8 + swap 0xEB pack8 + swap + ~ : provide-hex + pack8 ; + +~ (output point, address offset value -- output point) +: jmp-rel-imm32 + ~ : 5 # jmp-rel-imm32 + swap 0xE9 pack8 + swap + ~ : provide-hex + pack32 ; + +~ This is technically a "near" call. The name intentionally doesn't say so. +~ +~ (output point, address offset value -- output point) +: call-rel-imm32 + ~ : 5 # call-rel-imm32 + swap 0xE8 pack8 + swap + ~ : provide-hex + pack32 ; + +~ Similarly, this is a "near" return. +~ +~ (output point) +: ret + ~ : 1 ret + 0xC3 pack8 ; + 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 ; + diff --git a/language/static/execution-support.e b/language/static/execution-support.e new file mode 100644 index 0000000..1592643 --- /dev/null +++ b/language/static/execution-support.e @@ -0,0 +1,111 @@ +~ Execution support +~ ~~~~~~~~~~~~~~~~~ +~ +~ These macros are an important part of the execution model described in +~ compilation/execution.e. They're here, in this file, because they need to be +~ statically available via the label transform, so that the log-load transform +~ can rely on them. + + +~ Macro next +~ ~~~~~~~~~~ +~ +~ Include this inline at the end of a word implemented in machine-code. +~ Conceptually, it returns. What it actually does is do the next thing the +~ caller would do, which is call the next word from the caller's array of +~ word pointers. +~ +~ This is a widespread technique in Forth implementation, referred to as +~ indirect threaded code. It's "threaded" in the sense that each word takes +~ responsibility for finishing up by following the notional thread through the +~ metaphorical labyrinth to figure out the next word that its caller wants to +~ run after it. In other words, control never directly returns to the parent, +~ it proceeds directly to the sibling. +~ +~ Registers in: +~ +~ * rsi points to the address of the word to execute +~ +~ Registers out: +~ +~ * rax points to the codeword in the contents of the word that was executed +~ * rsi points to the next word-address after this one +~ +~ Flags +~ * DF = 0 is required +~ +~ (output point -- output point) +: pack-next + ~ : "next" macro + ~ Copy the next word's address from *rsi into rax. Increment rsi (as per + ~ the DF flag). + lods64 + + ~ Load the codeword from the word's contents, and jump to the interpreter + ~ it points to. + :rax jmp-abs-indirect-reg64 ; + + +~ Macro beforenext +~ ~~~~~~~~~~~~~~~~ +~ +~ Sometimes we want to transfer control from a word implemented in +~ machine-code to another word, without coming back after, as if we were +~ simply jumping to it. This is an innovation of ours; Jonesforth doesn't do +~ it. It is similar to the tail-call optimization that many Lisp dialects +~ have. +~ +~ This implementation will work regardless of how the receiving word is +~ implemented. It impersonates the "next" snippet, setting up rax to point +~ to the codeword then jumping to the interpreter. Since it doesn't change +~ the control stack or rsi, when the receiving word eventually invokes +~ "next"; it will pick up in the same place as if this sending word had done +~ it. +~ +~ Thus, notionally we are doing just this one transfer of control before +~ eventually getting around to inlining "next". Hence the name. +~ +~ (output point, target address -- output point) +: pack-beforenext + ~ : "beforenext" macro + ~ Do a permanent transfer of control by setting rax and invoking the + ~ codeword. Of course, we could jump to docol ourselves but this will work + ~ regardless of what the receiving codeword is. + :rax mov-reg64-imm64 + :rax jmp-abs-indirect-reg64 ; + + +~ Macros pushcontrol +~ popcontrol +~ ~~~~~~~~~~~~~~~~~~ +~ +~ Include these inline to push an address onto the control stack, or pop +~ one off of it. You will recall the control stack is kept in rbp. The +~ parameter is given in a user-specified register. +~ +~ Jonesforth's analogous macros are called PUSHRSP and POPRSP but I think +~ that's super confusing, since rsp is also the name of a register, but a +~ different one. I guess it was less confusing in 32-bit, since esp doesn't +~ start with an "r". Anyway, this has to be named something that +~ distinguishes it from Intel's PUSH and POP opcodes, so... +~ +~ "Load effective address" is just a cute way to do arithmetic on a +~ register, here. To push or pop we decrement or increment rbp by 8. To +~ actually interact with the space in the stack, we indirect through rbp. +~ +~ Registers in and out: +~ +~ * rbp points to the top of the control stack. +~ +~ (output point, source register -- output point) +: pack-pushcontrol + ~ : "pushcontrol" macro + swap :rbp -8 :rbp lea-reg64-disp8-reg64 + swap :rbp 0 mov-disp8-reg64-reg64 ; + +~ (output point, target register -- output point) +: pack-popcontrol + ~ : "popcontrol" macro + :rbp 0 3roll mov-reg64-disp8-reg64 + :rbp 8 :rbp lea-reg64-disp8-reg64 ; + diff --git a/language/static/linux.e b/language/static/linux.e new file mode 100644 index 0000000..fd15ae0 --- /dev/null +++ b/language/static/linux.e @@ -0,0 +1,153 @@ +~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~ ~~ System calls for the Linux kernel ~~ +~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~ +~ The kernel preserves every register except rax, rcx, and r11. The system +~ call number goes in rax, as does the return value. Parameters go in rdi, +~ rsi, rdx, r10, r8, and r9, in that order. [SysV] A.2.1. +~ +~ Notice that rsi is our control stack, so we have to save it (for +~ syscalls with at least two parameters). We can use the value stack to do +~ that, since rsp is preserved, or we can use one of the other registers. We +~ don't ourselves save other registers because our caller should do that, if +~ it cares. +~ +~ In the kernel source, you may find the following files useful to +~ reference: +~ +~ * arch/x86/entry/syscalls/syscall_64.tbl +~ * include/linux/syscalls.h +~ * include/linux/compat.h +~ +~ Don't be confused by tools/scripts/syscall.tbl, it's not for x86. +~ +~ This file loads early, before anything in language/dynamic/. So, although +~ it superficially appears to be able to do allocation and high-level flow +~ control, those come from the transforms, which means they're shallow +~ implementations. The stuff here can't be moved later, because +~ language/dynamic/input.e relies on it, and the other dynamic stuff relies on +~ that. So, there's additional Linux functionality in another file that loads +~ later, language/dynamic/linux.e. + + +~ (call number -- return value) +: syscall-0 + [ here @ + :rax pop-reg64 ~ syscall number + syscall + :rax push-reg64 ~ return value + here ! ] ;asm + +~ (first param, call number -- return value) +: syscall-1 + [ here @ + :rax pop-reg64 ~ syscall number + :rdi pop-reg64 ~ first param + syscall + :rax push-reg64 ~ return value + here ! ] ;asm + +~ (first param, second param, call number -- return value) +: syscall-2 + [ here @ + :rsi :rbx mov-reg64-reg64 ~ save rsi + :rax pop-reg64 ~ syscall number + :rsi pop-reg64 ~ second param + :rdi pop-reg64 ~ first param + syscall + :rbx :rsi mov-reg64-reg64 ~ restore rsi + :rax push-reg64 ~ return value + here ! ] ;asm + +~ (first param, second param, third param, call number -- return value) +: syscall-3 + [ here @ + :rsi :rbx mov-reg64-reg64 ~ save rsi + :rax pop-reg64 ~ syscall number + :rdx pop-reg64 ~ third param + :rsi pop-reg64 ~ second param + :rdi pop-reg64 ~ first param + syscall + :rbx :rsi mov-reg64-reg64 ~ restore rsi + :rax push-reg64 ~ return value + here ! ] ;asm + +~ (first param, second param, third param, fourth param, call number +~ -- return value) +: syscall-4 + [ here @ + :rsi :rbx mov-reg64-reg64 ~ save rsi + :rax pop-reg64 ~ syscall number + :r10 pop-extrareg64 ~ fourth param + :rdx pop-reg64 ~ third param + :rsi pop-reg64 ~ second param + :rdi pop-reg64 ~ first param + syscall + :rbx :rsi mov-reg64-reg64 ~ restore rsi + :rax push-reg64 ~ return value + here ! ] ;asm + + +~ (first param, second param, third param, fourth param, fifth param, +~ call number -- return value) +: syscall-5 + [ here @ + :rsi :rbx mov-reg64-reg64 ~ save rsi + :rax pop-reg64 ~ syscall number + :r8 pop-extrareg64 ~ fifth param + :r10 pop-extrareg64 ~ fourth param + :rdx pop-reg64 ~ third param + :rsi pop-reg64 ~ second param + :rdi pop-reg64 ~ first param + syscall + :rbx :rsi mov-reg64-reg64 ~ restore rsi + :rax push-reg64 ~ return value + here ! ] ;asm + + +~ (first param, second param, third param, fourth param, fifth param, +~ sixth param, call number -- return value) +: syscall-6 + [ here @ + :rsi :rbx mov-reg64-reg64 ~ save rsi + :rax pop-reg64 ~ syscall number + :r9 pop-extrareg64 ~ sixth param + :r8 pop-extrareg64 ~ fifth param + :r10 pop-extrareg64 ~ fourth param + :rdx pop-reg64 ~ third param + :rsi pop-reg64 ~ second param + :rdi pop-reg64 ~ first param + syscall + :rbx :rsi mov-reg64-reg64 ~ restore rsi + :rax push-reg64 ~ return value + here ! ] ;asm + + +~ Raw system calls +~ ~~~~~~~~~~~~~~~~ + +~ This does the Linux exit() system call, passing it an exit code taken +~ from the stack. It does not return. +~ +~ (exit code -- *) +: sys-exit 60 syscall-1 + ~ In the event we're still here, let's minimize confusion. + crash ; + +~ This does the Linux write() system call, passing it an address from the +~ top of the stack and a length from the second position on the stack. It +~ uses a Unix file descriptor, which is a non-negative integer, to tell it +~ where to write to. For stdout, use fd 1. +~ +~ (file descriptor, base address, length to write -- result code or length) +: sys-write 1 syscall-3 ; + +~ (file descriptor, base address, length to read -- result code or length) +: sys-read 0 syscall-3 ; + +~ (filename, flags, mode -- result code or file descriptor) +: sys-open 2 syscall-3 ; + +~ (file descriptor -- result code) +: sys-close 3 syscall-1 ; + diff --git a/language/static/log-load.e b/language/static/log-load.e new file mode 100644 index 0000000..54a9d42 --- /dev/null +++ b/language/static/log-load.e @@ -0,0 +1,547 @@ +~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~ ~~ Bootstrapping the log ~~ +~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~ +~ The log is the main region of memory within which most dynamic allocation +~ happens. It's a single contiguous segment of virtual memory, which is +~ requested from the kernel when Evocation starts up. Almost all of +~ Evocation's dynamic data is kept in the log, including the main dictionary; +~ several important global variables which make it possible to find and +~ allocate other data structures; and the control stack. +~ +~ This file has the task of providing words which are useful for working +~ with the log, and more specifically which are useful for helping to bring +~ the log into existence. Once the log exists, it can be used to manage +~ itself, but there's a bootstrapping challenge in getting there. That +~ challenge is solved by the warm-start routine in compilation/execution.e, +~ which relies on the words in this file and should load after it. +~ +~ Some modern Forths, including Jonesforth, refer to the log as the heap. +~ This is a misnomer; a heap is a data structure that allows non-contiguous +~ allocation. Although there are Forths that have true heaps, Evocation is not +~ one of them. Space in the log is allocated by incrementing the "here" +~ variable (one of those important globals), which necessarily can only +~ allocate contiguous blocks; there is no way to compact allocations to +~ reclaim fragmented, unused space in between them. Evocation does allow +~ deallocation using "forget", but this is done by resetting "here" and +~ "latest" to older values, unwinding every allocation that's been done since +~ the point in time they return to. +~ +~ It would be a mistake to confuse this allocation strategy with the +~ more-general facilities for allocation, reallocation, and deallocation of +~ individual memory blocks that many other languages have. To avoid confusion, +~ we stay away from the name "heap", though it may still occasionally be used +~ colloquially because it's familiar from other Forths, and because most +~ programming languages have a heap as the main memory segment they request +~ from the kernel. +~ +~ In the strictest technical sense, the log is a stack: Things are added +~ to the end of it, and removed from that same end. However, Evocation already +~ has two other stacks, the control and value stacks. Adding to the potential +~ confusion, the control stack is actually stored inside the log (as a +~ fixed-size chunk at the bottom). However, the log isn't really that much +~ like a stack when you look at how it's actually used. Unlike Evocation's +~ control and value stacks, data structures on the log tend to be rich and +~ complex, interlinked in various ways through the use of pointers. They also +~ tend to be long-lived, with the log tending to grow over time, whereas the +~ control and value stacks tend to remain roughly the same size through cycles +~ of growth and shrinking. In order to be able to speak precisely about what +~ we're doing, we introduce the name "log" to refer to the entire memory +~ segment and everything stored within it. +~ +~ Another linguistic choice we make is to be clear about dictionaries. A +~ dictionary is a linked list of word entries. Each dictionary has a specific +~ handle, a pointer to a pointer, which is the root of the list. Each +~ word entry begins with a specific data structure, which among other things +~ includes a next-entry pointer, a flags byte, and a string that serves as +~ the entry's name. Older entries in a dictionary seldom change; newer entries +~ are added at the beginning of it, with their next-entry pointers leading to +~ the older entries. It is possible for several dictionaries to exist at once, +~ each with its own dictionary handle. +~ +~ Since dictionaries are managed using pointers to individual entries, there +~ is no specific requirement about the order in which those entries occur in +~ memory or where they are allocated, but usually a new entry is allocated at +~ the end of the log, by incrementing the variable "here", in the same manner +~ as any other allocation. There is one particular dictionary, the main +~ dictionary, whose handle is the variable "latest". The main dictionary holds +~ every executable word that can be used normally via Evocation's interpreter. +~ +~ Since the main dictionary is by far the most important thing in the log, +~ it can be tempting to conflate the log with the main dictionary. This is +~ accurate enough for some purposes, but note that other dictionaries are +~ often interleaved with it, their allocations entwining like grape vines even +~ while each remains separate, reachable only via its own root. See the +~ machine label facility, in compilation/labels.e, for an example of how a +~ secondary dictionary can be useful. +~ +~ This may feel tangential, but it's important background and there's no +~ better place to explain it: A handle is a pointer to a pointer. The variable +~ "latest" returns a handle, a fixed address which always holds the pointer to +~ the root entry of the main dictionary. Dereferencing that handle gives you +~ the dictionary pointer, the address of the root entry, which is suitable to +~ pass to find-in and similar words that read the dictionary's contents. When +~ you want to add a new entry to a dictionary, you need the dictionary's +~ handle, so that the root pointer can be changed. When you only want to write +~ it, you only need the regular single pointer. +~ +~ When reading the documentation of words that work with dictionaries, pay +~ close attention to whether their parameters include a dictionary handle, or +~ a dictionary pointer. +~ +~ The term "handle" was widely known in the early days of microcomputing, +~ when memory-safe languages without direct pointer access were less common. +~ Today it is usually considered specific to systems programming, the type of +~ programming which lies beneath other software and deals with topics such as +~ memory management and processes. Evocation is a systems-programming +~ language, in the sense that it takes pains to not introduce mandatory +~ abstractions which would make it difficult or inefficient to work directly +~ with these topics. So, in understanding Evocation, it's important to know +~ about handles. +~ +~ Some of these bootstrap words rely on being able to invoke assembler words +~ that output machine code. Therefore, those words must be available at +~ runtime. Since nothing can be dynamically available at runtime until after +~ we've already run the log-load routine, which relies on the stuff in this +~ file, the assembler words must be statically available via the label +~ transform. That means their definitions in arm64.e must be loaded before +~ this file. + + +~ This has the same value as the constant control-stack-size, which is +~ defined in compilation/execution.e. Everything will break if it doesn't. +~ +~ TODO: remove one of them. Probably the other one. +: log-offset 0x10000 ; ~ 64 KiB + +~ (log address -- log address, "log" pointer) +: log-load-log + dup log-offset + ; +~ (log address -- log address, "s0" pointer) +: log-load-s0 + dup log-offset + 8 + ; +~ (log address -- log address, "r0" pointer) +: log-load-r0 + dup log-offset + 2 8 * + ; +~ (log address -- log address, "latest" pointer) +: log-load-latest + dup log-offset + 3 8 * + ; +~ (log address -- log address, "here" pointer) +: log-load-here + dup log-offset + 4 8 * + ; + + +~ This is a helper used by warm-start, which invokes find-in using "latest". +~ It relies on being passed the root address of the log, which is used to find +~ the global variable "latest". It's inconvenient to keep a log pointer around +~ all the time, which is why we stop doing it as soon as possible, but during +~ Evocation's startup there's no alternative. This word is used extensively +~ by code that's been compiled via the log-load transform; see +~ compilation/transform.e for details. +~ +~ It would be possible to unload this word after the log is created, but +~ there are rare situations in which it's still useful, such as injecting +~ Evocation into another process's address space. Plus, it's small. So, we +~ keep it around. +~ +~ (log address, string pointer -- log address, entry pointer or 0) +: log-load-find + swap log-load-latest @ swap 3unroll swap find-in ; + +~ In the code generated by the log-load transform, it's convenient to have +~ only a single step needed to look up a word's execution token. This helper +~ does log-load-find, then gets the execution token if an entry is found. +~ +~ (log address, string pointer -- log address, execution token or 0) +: log-load-find-execution-token + dup 3unroll log-load-find dup + { + 3roll drop + entry-to-execution-token + } { + drop swap + ." No such word: " emitstring newline + 0 + } if-else ; + + +~ This is the same as "create", from language/dynamic/dynamic.e, except that +~ it takes the log's address as a parameter rather than hardcoding it, so that +~ it can be used in situations where the normal compilation process isn't yet +~ available. +~ +~ The requisite stack juggling is kind of finicky, sorry if it's hard to +~ read, but it's doing the same steps in the same order as the regular +~ "create". +~ +~ (log address, string pointer -- log address) +: log-load-create + dup stringlen 1 + dup 3unroll + ~ (log address, name field length, string pointer, name field length) + + 3 pick log-load-here swap drop @ 10 + swap memmove + ~ (log address, name field length) + + over log-load-here swap drop @ + ~ (log address, name field length, output point) + + 2 pick log-load-latest swap drop @ pack64 + ~ (log address, name field length, output point) + 0 pack8 + 0 pack8 + + + ~ (log address, output point) + 8 packalign + ~ (log address, output point) + + over log-load-here swap drop @ + ~ (log address, output point, old here value) + 2 pick log-load-latest swap drop ! + ~ (log address, output point) + over log-load-here swap drop ! ; + + +~ (log address -- log address) +: log-load-self-codeword + log-load-here dup @ + ~ (log address, here, output point) + + dup 8 + pack64 + ~ (log address, here, output point) + + swap ! ; + + + +~ This is the same as ",", from language/dynamic/dynamic.e, except that it +~ takes the log's address as a parameter rather than hardcoding it, so that it +~ can be used in situations where the normal compilation process isn't yet +~ available. +~ +~ Again, the stack juggling is kind of a lot, sorry about that. +~ +~ (log address, value -- log address) +: log-load-comma + swap log-load-here swap 3unroll + ~ (log address, value, here) + @ swap pack64 + ~ (log address, updated here value) + swap log-load-here swap 3unroll + ~ (log address, updated here value, here) + ! ; + + +~ This is the same as `;asm`, from language/dynamic/dynamic.e, except that +~ it takes the log's address as a parameter rather than hardcoding it, so that +~ it can be used in situations where the normal compilation process isn't yet +~ available. +~ +~ Its two main responsibilities are to call `pack-next`, from +~ language/static/execution-support.e, and to overwrite the codeword. It also +~ deals with alignment. +~ (log address) +: log-load-semicolon-assembly + log-load-here @ + ~ (log address, output point) + + pack-next + 8 packalign + ~ (log address, output point) + + swap log-load-here swap 3unroll ! + ~ (log address) + + log-load-latest @ + ~ (log address, entry pointer) + entry-to-execution-token + dup 8 + swap ! ; + + +~ This is the same as "variable", from language/dynamic/dynamic.e, except +~ that it takes the log's address as a parameter rather than hardcoding it, so +~ that it can be used in situations where the normal compilation process isn't +~ yet available. +~ +~ (log address, address for new variable word, string pointer -- log address) +: log-load-variable + 3roll swap log-load-create + ~ (address for new variable word, log address) + + log-load-here swap 3unroll + ~ (log address, address for new variable word, here) + + dup @ + ~ (log address, address for new variable word, here, output point) + dup 8 + pack64 + + 3roll :rax mov-reg64-imm64 + ~ (log address, here, output point) + + :rax push-reg64 + pack-next + 8 packalign + + swap ! ; + + +~ A keyword is a word that evaluates to its own address, which makes it +~ suitable for use as a constant. See more detail on that in +~ language/dynamic/dynamic.e, where "keyword" is defined. +~ +~ Unlike Common Lisp, the lexer doesn't create keywords for us, we have to +~ do it explicitly. If if that were to someday change, the log-load routine +~ would still need a way to do it, which is this. +~ +~ It's kind of a pain to look up the appropriate "docol" from here, so we +~ do it in assembler instead. +~ +~ (log address, string pointer -- log address) +: log-load-keyword + log-load-create + ~ (log address) + + log-load-here @ dup + ~ (log address, self execution token, output point) + + dup 8 + pack64 + ~ (log address, self execution token, output point) + + swap :rax mov-reg64-imm64 + ~ (log address, output point) + + :rax push-reg64 + pack-next + 8 packalign + ~ (log address, output point) + + swap log-load-here + ~ (output point, log address, here) + swap 3unroll + ~ (log address, output point, here) + ! ; + + +~ This is a helper used by log-load-string-alternate. It does the usual +~ string packing thing, but at one layer of indirection more than usual. Its +~ responsibility includes alignment, unlike packstring. +~ +~ (log address, string pointer -- log address) +: log-load-comma-string + swap log-load-here @ 3roll + ~ (log address, output point, string pointer) + + packstring + 8 packalign + ~ (log address, output point) + + swap log-load-here 3roll swap + ~ (log address, output point, here) + ! ; + + +~ Now we have a bunch of words that are the back-ends for the log-load +~ transform's high-level flow control alternates. These implementations +~ closely parallel the non-transformed versions in +~ language/dynamic/flow-control.e, which should be referenced in understanding +~ them. +~ +~ These variants are a bit unusual in their interfaces: They end with the +~ log address at the top of the stack, even when they have values to return. +~ That's because they're really just "talking" to each other; they don't need +~ to interact with anything else, and doing it this way saves the alternates +~ the work of swapping things around after. +~ +~ Notice also that, because these run entirely at log-load time, they are +~ always dealing with target pointers and don't have to convert address +~ spaces. +~ +~ (log address -- start pointer, log address) +: log-load-left-curly-brace + log-load-here @ swap ; + + +~ (start pointer, log address -- start pointer, length, log address) +: log-load-right-curly-brace + swap dup 3roll + ~ (start pointer, start pointer, log address) + log-load-here @ swap + ~ (start pointer, start pointer, end pointer, log address) + 3unroll swap - swap ; + + +~ (start, length, log address -- log address) +: log-load-if + 3unroll + ~ (log address, start, length) + 2dup swap dup + ~ (log address, start, length, length, start, start) + 5 8 * + + ~ (log address, start, length, length, start, adjusted start) + 3roll + ~ (log address, start, length, start, adjusted start, length) + memmove + ~ (log address, start, length) + swap 3roll log-load-here dup @ + ~ (length, start, log address, here pointer, old here) + swap 4 roll swap + ~ (length, log address, old here, start, here pointer) + ! + ~ (length, log address, old here) + 3unroll + ~ (old here, length, log address) + s" lit" log-load-find entry-to-execution-token log-load-comma + 0 log-load-comma + s" !=" log-load-find entry-to-execution-token log-load-comma + s" 0branch" log-load-find entry-to-execution-token log-load-comma + ~ (old here, length, log address) + swap dup 3unroll + ~ (old here, length, log address, length) + 8 + log-load-comma + ~ (old here, length, log-address) + 3unroll + ~ (log address, old here, length) + drop 5 8 * + + ~ (log address, new here) + swap log-load-here + ~ (new here, log address, here pointer) + 3roll swap ! ; + + +~ (start, length, log address -- log address) +: log-load-unless + 3unroll + ~ (log address, start, length) + 2dup swap dup + ~ (log address, start, length, length, start, start) + 5 8 * + + ~ (log address, start, length, length, start, adjusted start) + 3roll + ~ (log address, start, length, start, adjusted start, length) + memmove + ~ (log address, start, length) + swap 3roll log-load-here dup @ + ~ (length, start, log address, here pointer, old here) + swap 4 roll swap + ~ (length, log address, old here, start, here pointer) + ! + ~ (length, log address, old here) + 3unroll + ~ (old here, length, log address) + s" lit" log-load-find entry-to-execution-token log-load-comma + 0 log-load-comma + s" =" log-load-find entry-to-execution-token log-load-comma + s" 0branch" log-load-find entry-to-execution-token log-load-comma + ~ (old here, length, log address) + swap dup 3unroll + ~ (old here, length, log address, length) + 8 + log-load-comma + ~ (old here, length, log-address) + 3unroll + ~ (log address, old here, length) + drop 5 8 * + + ~ (log address, new here) + swap log-load-here + ~ (new here, log address, here pointer) + 3roll swap ! ; + + +~ (true start, true length, false start, false length, log address +~ -- log address) +: log-load-if-else + 5 unroll 2dup + ~ (log address, true start, true length, false start, false length, + ~ false start, false length) + swap dup 7 8 * + 3roll + ~ (log address, true start, true length, false start, false length, + ~ false start, adjusted false start, false length) + memmove + ~ (log address, true start, true length, false start, false length) + 3 pick dup 5 8 * + + ~ (log address, true start, true length, false start, false length, + ~ true start, adjusted true start) + 4 pick + ~ (log address, true start, true length, false start, false length, + ~ true start, adjusted true start, true length) + memmove + ~ (log address, true start, true length, false start, false length) + + 4 roll dup 5 unroll + ~ (log address, true start, true length, false start, false length, + ~ true start) + 6 roll log-load-here @ 7 unroll + ~ (old here, true start, true length, false start, false length, true start, + ~ log address) + log-load-here 3roll swap ! + ~ (old here, true start, true length, false start, false length, + ~ log address) + s" lit" log-load-find entry-to-execution-token log-load-comma + 0 log-load-comma + s" !=" log-load-find entry-to-execution-token log-load-comma + s" 0branch" log-load-find entry-to-execution-token log-load-comma + ~ (old here, true start, true length, false start, false length, + ~ log address) + 4 roll dup 5 unroll + ~ (old here, true start, true length, false start, false length, + ~ log address, true length) + 3 8 * + log-load-comma + ~ (old here, true start, true length, false start, false length, + ~ log address) + 3unroll + ~ (old here, true start, true length, log address, + ~ false start, false length) + swap dup 3unroll + ~ (old here, true start, true length, log address, + ~ false start, false length, false start) + 5 8 * + + ~ (old here, true start, true length, log address, + ~ false start, false length, adjusted false start) + 4 roll log-load-here 3roll swap ! + ~ (old here, true start, true length, + ~ false start, false length, log address) + s" branch" log-load-find entry-to-execution-token log-load-comma + swap 8 + log-load-comma + ~ (old here, true start, true length, false start, log address) + 4 unroll + ~ (old here, log address, true start, true length, false start) + drop drop drop + ~ (old here, log address) + log-load-here + 3roll 7 8 * + swap ! ; + + +~ (start, length, log address -- log address) +: log-load-forever + s" branch" log-load-find entry-to-execution-token log-load-comma + swap 8 + -1 * log-load-comma + swap drop ; + + +~ (test start, test length, body start, body length, log address +~ -- log address) +: log-load-while + 5 unroll 2dup + ~ (log address, test start, test length, body start, body length, + ~ body start, body length) + swap dup 5 8 * + 3roll + ~ (log address, test start, test length, body start, body length, + ~ body start, adjusted body start, body length) + memmove + + ~ (log address, test start, test length, body start, body length) + 5 roll log-load-here @ 6 unroll + ~ (old here, test start, test length, body start, body length, log address) + log-load-here 4 roll dup 5 unroll swap ! + ~ (old here, test start, test length, body start, body length, log address) + s" lit" log-load-find entry-to-execution-token log-load-comma + 0 log-load-comma + s" !=" log-load-find entry-to-execution-token log-load-comma + s" 0branch" log-load-find entry-to-execution-token log-load-comma + swap dup 3unroll 3 8 * + log-load-comma + ~ (old here, test start, test length, body start, body length, log address) + log-load-here 5 8 * 8 roll + swap ! + ~ (test start, test length, body start, body length, log address) + s" branch" log-load-find entry-to-execution-token log-load-comma + 5 unroll + ~ (log address, test start, test length, body start, body length) + 6 8 * + swap drop + swap drop -1 * log-load-comma ; + diff --git a/language/static/output.e b/language/static/output.e new file mode 100644 index 0000000..cadd5fb --- /dev/null +++ b/language/static/output.e @@ -0,0 +1,252 @@ +~ Output +~ ~~~~~~ +~ +~ It is convenient to be able to output text. This depends on the +~ OS-specific stuff in language/static/linux.e, so it's in its own file. +~ +~ The most interesting word we define here is ".", pronounced "dot"; the +~ math stuff is needed to implement it. +~ +~ Unlike Jonesforth, we do not have a global "base" variable, and this word +~ does not change its behavior depending on that value. It's always base ten. + + +~ Strings are comparatively easy. +~ +~ (string pointer --) +: emitstring dup stringlen 1 3unroll sys-write drop ; + +: space 32 value@ emitstring drop ; +: newline 10 value@ emitstring drop ; + + +~ (base, exponent -- base to the power of exponent) +: pow + 1 swap + + { + ~ If the count of remaining powers is equal to zero, exit. + dup { drop swap drop exit } unless + ~ (base, result so far, count of remaining powers) + + 1 - 3unroll + ~ (updated count of remaining powers, base, result so far) + + swap dup 4 unroll + ~ (base, updated count of remaining powers, result so far, base) + + * swap + ~ (base, updated result so far, updated count of remaining powers) + } forever ; + + +~ (base, value -- floor of logarithm of value in base base) +: logfloor + ~ Start with a product equal to the base, and a count of 0. + swap dup 3unroll 0 + + { + ~ This is the start of the loop body. + ~ (base, value, product so far, count of powers included so far) + 3unroll 2dup + ~ (base, count so far, value, product so far) + + ~ If we get here, we're done. + ~ (base, count so far, value, product so far) + >unsigned { drop drop swap drop exit } if + + ~ If we're here, we need to do another loop. + ~ (base, count so far, value, product so far) + 4 roll dup 5 unroll * 3roll 1 + + ~ (base, value, updated product so far, updated count so far) + + ~ If the product is less than the base, we overflowed. In that case, the + ~ product-so-far is the maximum, so just return it. + 4 roll dup 5 unroll 3roll dup 4 unroll + < { 4 unroll drop drop drop exit } if + + ~ Nothing else weird going on, so loop. + } forever ; + + +~ (base, value -- ceiling of logarithm of value in base base) +: logceil + ~ Start with a product of 1 and a count of 0. + 1 0 + + { + ~ This is the start of the loop body. + ~ (base, value, product so far, count of powers included so far) + 3unroll 2dup + ~ (base, count so far, value, product so far) + + ~ If we get here, we're done. + ~ (base, count so far, value, product so far) + >=unsigned { drop drop swap drop exit } if + + ~ If we're here, we need to do another loop. + ~ (base, count so far, value, product so far) + 4 roll dup 5 unroll * 3roll 1 + + ~ (base, value, updated product so far, updated count so far) + + ~ If the product is less than the base, we overflowed. In that case, the + ~ product-so-far is the maximum, so just return it. + 4 roll dup 5 unroll 3roll dup 4 unroll + < { 4 unroll drop drop drop exit } if + + ~ Nothing else weird going on, so loop. + } forever ; + + +~ This is an extremely inefficient implementation, but on the plus side, +~ doing that avoids having to think about any sort of memory management or +~ recursion, and lets us stick entirely with the trivial control-flow +~ constructs we already have. +~ +~ (integer to print, base to print in, width to zero-pad to --) +: .base-unsigned + ~ (input, base, width) + ~ Compute how many digits we need to display. Because we use logfloor, the + ~ logic of always printing at least one digit is already handled for us. + 3unroll swap 2dup logfloor 1 + + ~ (width, base, input, number of digits if no padding) + 4 roll 2dup > { + ~ (base, input, number of digits if no padding, width) + ~ If we're here, we should use the padded width + swap drop + } { + ~ (base, input, number of digits if no padding, width) + ~ If we're here, we should use the unpadded width + drop + } if-else + + { + ~ (base, input, number of digits remaining) + ~ This is the start of the loop. + 2dup 1 - + ~ (base, input, number of digits remaining, input, intermediate value) + 5 roll dup 6 unroll swap + ~ (base, input, number of digits remaining, input, base, intermediate value) + pow /% swap drop + ~ (base, input, number of digits remaining, + ~ input divided by base^x appropriately) + 4 roll dup 5 unroll + ~ (base, input, number of digits remaining, + ~ input divided by base^x appropriately, base) + /% drop + ~ (base, input, number of digits remaining, current digit) + + ~ We construct a one-character string on the stack, then use a pointer to + ~ it. It will always contain its own null-termination without us having to + ~ do anything special to that end. + dup 10 > { + 0x30 ~ ASCII "0" + } { + 10 - 0x61 ~ ASCII "a" + } if-else + + + value@ emitstring + + ~ We deallocate the string by dropping it. + ~ + ~ Saying it like that makes it sound obvious; contemplate it until it feels + ~ surprising. + drop + + 1 - + dup { drop drop drop exit } unless + } forever ; + + +~ (integer to print, base to print in --) +: .base + swap + ~ (base, input) + + ~ Deal with negative numbers. + dup 0 > { + -1 * + s" -" emitstring + } if + + swap 0 .base-unsigned ; + + +~ Although this could notionally be called emitinteger for symmetry, it's +~ well-known under the name dot and as a single period character, and that +~ name participates in conventions for names of other things. So, we go with +~ it. +~ +~ (integer to print --) +: . 10 .base ; +: .hex 16 0 .base-unsigned ; +: .hex8 16 2 .base-unsigned ; +: .hex16 16 4 .base-unsigned ; +: .hex32 16 8 .base-unsigned ; +: .hex64 16 16 .base-unsigned ; + +~ (integer to print, width --) +: .hexn 16 swap .base-unsigned ; + + + +~ The control structure here is the same as .base-unsigned, but it outputs +~ to a string. +~ +~ The use of the "pack" nomenclature here is a little odd in that most other +~ uses are for binary structures rather than text, but compare packstring. +~ +~ (output point, integer to print, base to print in, width to zero-pad to +~ -- output point) +: pack-base-unsigned + 3unroll swap 2dup logfloor 1 + + 4 roll 2dup > { + swap drop + } { + drop + } if-else + + { + ~ (output point, base, input, number of digits remaining) + 2dup 1 - + 5 roll dup 6 unroll swap + pow /% swap drop + 4 roll dup 5 unroll + /% drop + + dup 10 > { + 0x30 ~ ASCII "0" + } { + 10 - 0x61 ~ ASCII "a" + } if-else + + + ~ (output point, base, input, number of digits remaining, character) + 5 roll swap pack8 4 unroll + + 1 - + dup { drop drop drop exit } unless + } forever ; + + +~ (output point, integer to print, base to print in -- output point) +: pack-base + swap + + dup 0 > { + -1 * + 3roll s" -" packstring 3unroll + } if + + swap 0 .base-unsigned ; + + +~ (output point, integer to print -- output point) +: pack-decimal 10 pack-base ; +: pack-hex 16 0 pack-base-unsigned ; +: pack-hex8 16 2 pack-base-unsigned ; +: pack-hex16 16 4 pack-base-unsigned ; +: pack-hex32 16 8 pack-base-unsigned ; +: pack-hex64 16 16 pack-base-unsigned ; + +~ (output point, integer to print, width -- output point) +: pack-hexn 16 swap pack-base-unsigned ; |