From 77e8ce989010fbd94080e780fb0b5cb6c10434e8 Mon Sep 17 00:00:00 2001 From: Irene Knapp Date: Mon, 28 Sep 2026 18:07:52 -0700 Subject: move all the source files into subdirectories and rename one, linux-dynamic.e to language/dynamic/linux.e. also make sure all references in comments and documentation refer to the new locations and names. this directory structure reflects code organization which had existed in Irenes' head, but was likely not obvious to other readers. now hopefully it is more discoverable. Force-Push: yes Change-Id: Icfef3eae812a50fe20202191999e68e1f7db445a --- language/static/amd64.e | 1383 +++++++++++++++++++++++++++++++++++ language/static/core.e | 1371 ++++++++++++++++++++++++++++++++++ language/static/execution-support.e | 111 +++ language/static/linux.e | 153 ++++ language/static/log-load.e | 547 ++++++++++++++ language/static/output.e | 252 +++++++ 6 files changed, 3817 insertions(+) create mode 100644 language/static/amd64.e create mode 100644 language/static/core.e create mode 100644 language/static/execution-support.e create mode 100644 language/static/linux.e create mode 100644 language/static/log-load.e create mode 100644 language/static/output.e (limited to 'language/static') 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-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 ; -- cgit 1.4.1