path: root/quine.asm

;;; QUINE
;;;
;;; This file is formatted to be read at 80-columns or wider.
;;;
;;; There's some tabular information, but diagrams have been avoided, in an
;;; attempt to make this manageable in screen readers. Feedback welcome.


;;;;;;;;;;;;;;;;;;;;;
;;; Workflow tips ;;;
;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Currently, this is not yet fully self-hosting; it is based on
;;; flatassembler[1]. A minimal command to build and run it is:
;;;
;;; $ fasmg quine.asm quine && chmod 755 quine && ./quine; echo $?
;;;
;;; A workflow you may wish to use for debugging is:
;;;
;;; $ rm quine2; fasmg quine.asm quine && chmod 755 quine && ./quine > quine2; echo "exit code:" $?; echo; hexdump -C quine; echo; hexdump -C quine2; echo; cmp -l quine quine2 ; echo cmp: $?
;;;
;;; The reason this removes the old one first is that otherwise, there's a
;;; risk the error message will be scrolled off the top of the screen and
;;; you'll see stale output and not realize.
;;;
;;; You may also wish to do:
;;;
;;; $ objdump --disassemble quine
;;; $ ZydisDisasm -64 quine
;;;
;;; This relies on GNU binutils, and on zydis, respectively.
;;;
;;; [1] https://flatassembler.net/
;;;
;;;
;;; gdb
;;; ---
;;;
;;; You can run gdb on it if you want; there's no symbols, but if you are
;;; familiar with the hex it should be readable. Keep a hexdump of the program
;;; handy to look up what addresses are.
;;;
;;; If you want to see a routine implemented in assembly, look at the hexdump
;;; of the overall file, find it by looking at the ASCII names, skip past the
;;; codeword, and do ie
;;;
;;; (gdb) disassemble/r 0x0x80007c0,+32
;;;
;;; If you want to see the value stack, you can do
;;;
;;; (gdb) x/16xg $rsp
;;;
;;; The same will work with $rbp for the control stack, and don't forget that
;;; the "instruction pointer" is rsi. To see all the registers, do
;;;
;;; (gdb) info registers


;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Assembly language ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;   Before doing any actual code, we define macros for writing x86-64
;;; assembly language. This is built from scratch, relying only on
;;; flatassembler's built-in semantics. No include files of any kind are used
;;; for it.

macro pad: bytes
  if bytes > 0
    db 0x00
    pad (bytes - 1)
  end if
end macro

macro align: bytes
  if bytes > 0
    if $ mod bytes <> 0
      db 0x00
      align bytes
    end if
  end if
end macro

; The way these are all spelled out like this is slightly ridiculous, there
; must be a better way.
macro rex.0
  db 0x40
end macro
macro rex.w
  db 0x48
end macro
macro rex.r
  db 0x44
end macro
macro rex.x
  db 0x42
end macro
macro rex.b
  db 0x41
end macro
macro rex.wr
  db 0x4C
end macro
macro rex.wx
  db 0x4A
end macro
macro rex.wb
  db 0x49
end macro
macro rex.rx
  db 0x46
end macro
macro rex.rb
  db 0x45
end macro
macro rex.xb
  db 0x43
end macro
macro rex.wrx
  db 0x4E
end macro
macro rex.wrb
  db 0x4D
end macro
macro rex.wxb
  db 0x4B
end macro
macro rex.rxb
  db 0x47
end macro
macro rex.wrxb
  db 0x4F
end macro

macro modrm mod, reg, rm
  assert mod >= 0 & mod < 4
  assert reg >= 0 & reg < 8
  assert rm >= 0 & rm < 8
  db (mod shl 6) or (reg shl 3) or rm
end macro

macro sib scale, index, base
  assert scale >= 0 & scale < 4
  assert index >= 0 & index < 8
  assert base >= 0 & index < 8
  db (scale shl 6) or (index shl 3) or base
end macro

macro opcodereg opcode, reg
  assert opcode >= 0 & opcode < 256 & opcode and 7 = 0
  assert reg >= 0 & reg < 8
  db opcode or reg
end macro

macro opcodecc opcode, cc
  assert opcode >= 0 & opcode < 256 & opcode and 15 = 0
  assert cc >= 0 & cc < 16
  db opcode or cc
end macro

macro scalefield sfield, scale
  if 1 = scale
    sfield = 0
  else if 2 = scale
    sfield = 1
  else if 4 = scale
    sfield = 2
  else if 8 = scale
    sfield = 3
  else
    assert 0
  end if
end macro

; Yep, there sure is a lot of duplication in these. This is based on Intel's
; documented mnemonics...
;
; "Above" and "below" are for unsigned comparisons. "Greater" and "less" are
; for signed comparisons.
macro conditioncode cc, condition
  match =above, condition
    cc = 0x07
  else match =above.equal, condition
    cc = 0x03
  else match =below, condition
    cc = 0x02
  else match =below.equal, condition
    cc = 0x06
  else match =carry, condition
    cc = 0x02
  else match =equal, condition
    cc = 0x04
  else match =greater, condition
    cc = 0x0F
  else match =greater.equal, condition
    cc = 0x0D
  else match =less, condition
    cc = 0x0C
  else match =less.equal, condition
    cc = 0x0E
  else match =not.above, condition
    cc = 0x06
  else match =not.above.equal, condition
    cc = 0x02
  else match =not.below, condition
    cc = 0x03
  else match =not.below.equal, condition
    cc = 0x07
  else match =not.carry, condition
    cc = 0x03
  else match =not.equal, condition
    cc = 0x05
  else match =not.greater, condition
    cc = 0x0E
  else match =not.greater.equal, condition
    cc = 0x0C
  else match =not.less, condition
    cc = 0x0D
  else match =not.less.equal, condition
    cc = 0x0F
  else match =not.overflow, condition
    cc = 0x01
  else match =not.parity, condition
    cc = 0x0B
  else match =not.sign, condition
    cc = 0x09
  else match =not.zero, condition
    cc = 0x05
  else match =overflow, condition
    cc = 0x00
  else match =parity, condition
    cc = 0x0A
  else match =parity.even, condition
    cc = 0x0A
  else match =parity.odd, condition
    cc = 0x0B
  else match =sign, condition
    cc = 0x08
  else match =zero, condition
    cc = 0x04
  else
    assert 0
  end match
end macro


;;; 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

macro bytereg result, register
  match =al?, register
    result = 0
  else match =cl?, register
    result = 1
  else match =dl?, register
    result = 2
  else match =bl?, register
    result = 3
  else match =ah?, register
    result = 4
  else match =ch?, register
    result = 5
  else match =dh?, register
    result = 6
  else match =bh?, register
    result = 7
  else
    assert 0
  end match
end macro

macro wordreg result, register
  match =ax?, register
    result = 0
  else match =cx?, register
    result = 1
  else match =dx?, register
    result = 2
  else match =bx?, register
    result = 3
  else match =sp?, register
    result = 4
  else match =bp?, register
    result = 5
  else match =si?, register
    result = 6
  else match =di?, register
    result = 7
  else
    assert 0
  end match
end macro

macro dwordreg result, register
  match =eax?, register
    result = 0
  else match =ecx?, register
    result = 1
  else match =edx?, register
    result = 2
  else match =ebx?, register
    result = 3
  else match =esp?, register
    result = 4
  else match =ebp?, register
    result = 5
  else match =esi?, register
    result = 6
  else match =edi?, register
    result = 7
  else
    assert 0
  end match
end macro

macro qwordreg result, register
  match =rax?, register
    result = 0
  else match =rcx?, register
    result = 1
  else match =rdx?, register
    result = 2
  else match =rbx?, register
    result = 3
  else match =rsp?, register
    result = 4
  else match =rbp?, register
    result = 5
  else match =rsi?, register
    result = 6
  else match =rdi?, register
    result = 7
  else
    assert 0
  end match
end macro

macro owordreg result, register
  match =r8?, register
    result = 0
  else match =r9?, register
    result = 1
  else match =r10?, register
    result = 2
  else match =r11?, register
    result = 3
  else match =r12?, register
    result = 4
  else match =r13?, register
    result = 5
  else match =r14?, register
    result = 6
  else match =r15?, register
    result = 7
  else
    assert 0
  end match
end macro


;;; Instructions
;;; ------------


; TODO what register size does this use?
macro mov.b target, source
  match =rax?, target
    db 0xB8
    dd source
  else match =rdi?, target
    db 0xBF
    dd source
  else
    assert 0
  end match
end macro


; TODO what register size does this use?
macro mov.dreg.dimm target, source
  rex.w
  db 0xC7
  qwordreg reg, target
  modrm 3, 0, reg
  dd source
end macro


macro mov.qreg.qimm target, source
  qwordreg treg, target
  rex.w
  opcodereg 0xB8, treg
  dq source
end macro


; Notice the use of REX.B here; this instruction puts the register number in
; the opcode field, so it uses Table 3-1.
macro mov.oreg.qimm target, source
  owordreg treg, target
  rex.wb
  opcodereg 0xB8, treg
  dq source
end macro


macro mov.qreg.qreg target, source
  qwordreg treg, target
  qwordreg sreg, source
  rex.w
  db 0x89
  modrm 3, sreg, treg
end macro


; Take a 64-bit source register, treat it as an address and look up the 64-bit
; value it points to, store that into a 64-bit target register.
;
; For rbp, the only modes available also have displacement; we use an 8-bit
; one and set it to zero. The other registers could be encoded without the
; displacement, but for simplicity's sake we do the same thing for all of
; them.
;
; 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 3, section 3-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.
;
; We disallow rsp as a source because that's the mode that would want an SIB.
macro mov.qreg.indirect.qreg target, source
  qwordreg sreg, source
  qwordreg treg, target
  rex.w
  db 0x8B
  modrm 1, treg, sreg
  match =rsp, source
    ; R/M = rsp is the SIB case
    sib 0, 4, sreg
      ; no scaling, no indexing, source as base
  end match
  db 0
end macro


; Take a 64-bit source register, store its value into the address pointed to
; by a 64-bit target register.
;
; For rbp, the only modes available also have displacement; we use an 8-bit
; one and set it to zero. The other registers could be encoded without the
; displacement, but for simplicity's sake we do the same thing for all of
; them.
;
; In understanding this, pay close attention to the Op/En column in the opcode
; table. The "MR" variant means the ModRM byte's reg field (the middle one)
; is the source, while its R/M field (the third one) is the target. This is
; what we want, because the R/M field is the one that gets indirection applied
; to it. Opcode 0x89 with an REX.W prefix is the all-64-bit MR variant.
; [Intel] volume 2B, chapter 3, section 3-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.
;
; We disallow rsp as a target because that's the mode that would want an SIB.
; When you look at other addressing modes, be aware that the special treatment
; is for whichever register is specified in the R/M field. Sometimes that's
; the source, and sometimes it's the target, depending on the opcode.
macro mov.indirect.qreg.qreg target, source
  qwordreg sreg, source
  qwordreg treg, target
  rex.w
  db 0x89
  modrm 1, sreg, treg
  match =rsp, target
    ; R/M = rsp is the SIB case
    sib 0, 4, treg
      ; no scaling, no indexing, target as base
  end match
  db 0
end macro


; 8-bit source register
macro mov.indirect.qreg.breg target, source
  match =rsp, target
    assert 0
    ; The SIB case.
  else match =rbp, target
    assert 0
    ; An unrelated addressing mode.
  else
    bytereg sreg, source
    qwordreg treg, target
    db 0x88
    modrm 0, sreg, treg
  end match
end macro

macro mov.breg.indirect.qreg target, source
  match =rsp, source
    assert 0
    ; The SIB case.
  else match =rbp, source
    assert 0
    ; An unrelated addressing mode.
  else
    qwordreg sreg, source
    bytereg treg, target
    db 0x8A
    modrm 0, treg, sreg
  end match
end macro

; We use the operand-size prefix to specify 16-bit. No REX.W. Table 3-4.
macro mov.indirect.qreg.wreg target, source
  match =rsp, target
    assert 0
    ; The SIB case.
  else match =rbp, target
    assert 0
    ; An unrelated addressing mode.
  else
    wordreg sreg, source
    qwordreg treg, target
    db 0x66
    db 0x89
    modrm 0, sreg, treg
  end match
end macro

; We use the operand-size prefix to specify 16-bit. No REX.W. Table 3-4.
macro mov.wreg.indirect.qreg target, source
  match =rsp, source
    assert 0
    ; The SIB case.
  else match =rbp, source
    assert 0
    ; An unrelated addressing mode.
  else
    qwordreg sreg, source
    wordreg treg, target
    db 0x66
    db 0x8B
    modrm 0, treg, sreg
  end match
end macro

; It defaults to 32-bit, no prefix needed, also no REX.W. Table 3-4.
macro mov.indirect.qreg.dreg target, source
  match =rsp, target
    assert 0
    ; The SIB case.
  else match =rbp, target
    assert 0
    ; An unrelated addressing mode.
  else
    dwordreg sreg, source
    qwordreg treg, target
    db 0x89
    modrm 0, sreg, treg
  end match
end macro

; It defaults to 32-bit, no prefix needed, also no REX.W. Table 3-4.
macro mov.dreg.indirect.qreg target, source
  match =rsp, source
    assert 0
    ; The SIB case.
  else match =rbp, source
    assert 0
    ; An unrelated addressing mode.
  else
    qwordreg sreg, source
    dwordreg treg, target
    db 0x8B
    modrm 0, treg, sreg
  end match
end macro


macro mov.qreg.indexed.qreg target, source, index, scale
  match =rbp, source
    assert 0
    ; This is divided into some subcases we don't wish to deal with yet.
  else match =rsp, index
    assert 0
    ; This is the case where it's not actually indexed after all.
  else
    qwordreg treg, target
    qwordreg sreg, source
    qwordreg ireg, index
    scalefield sfield, scale
    rex.w
    db 0x8B
    modrm 0, treg, 4
    sib sfield, ireg, sreg
  end match
end macro


macro mov.indexed.qreg.qreg target, index, scale, source
  match =rbp, source
    assert 0
    ; This is divided into some subcases we don't wish to deal with yet.
  else match =rsp, index
    assert 0
    ; This is the case where it's not actually indexed after all.
  else
    qwordreg treg, target
    qwordreg sreg, source
    qwordreg ireg, index
    scalefield sfield, scale
    rex.w
    db 0x89
    modrm 0, sreg, 4
    sib sfield, ireg, treg
  end match
end macro


; Take a 64-bit source register, store its value into a high 64-bit target
; register (r8-r15).
;
; Notice that there are two ways to add another bit to the register encoding.
; Table 3-1 is about REX.B, but does not apply here, it's for instructions
; that use opcode bits to specify a register, and none of the
; register-to-register MOV variants do that (it's for immediate mode).
;
; Instead, we want the mechanism that uses REX.R as the extra bit, and it
; combines with the reg field of ModRM, as per 2.2.1.2.
;
; Therefore, we want the variant of MOV which puts the target in the reg
; field. That's Op/En "RM", opcode 0x8B with REX.WR.
;
; Mode 3 is direct addressing.
macro mov.oreg.qreg target, source
  owordreg treg, target
  qwordreg sreg, source
  rex.wr
  db 0x8B
  modrm 3, treg, sreg
end macro


; Take a high 64-bit source register (r8-r15), store its value into a 64-bit
; target register.
;
; Notice that there are two ways to add another bit to the register encoding.
; Table 3-1 is about REX.B, but does not apply here, it's for instructions
; that use opcode bits to specify a register, and none of the
; register-to-register MOV variants do that (it's for immediate mode).
;
; Instead, we want the mechanism that uses REX.R as the extra bit, and it
; combines with the reg field of ModRM, as per 2.2.1.2.
;
; Therefore, we want the variant of MOV which puts the source in the reg
; field. That's Op/En "MR", opcode 0x89 with REX.WR.
;
; Mode 3 is direct addressing.
macro mov.qreg.oreg target, source
  qwordreg treg, target
  owordreg sreg, source
  rex.wr
  db 0x89
  modrm 3, sreg, treg
end macro


; This increments a 64-bit register by 1, in place;
macro inc.qreg target
  qwordreg treg, target
  rex.w
  db 0xFF
  modrm 3, 0, treg
    ; The 0 is part of the opcode.
end macro

; This decrements a 64-bit register by 1, in place;
macro dec.qreg target
  qwordreg treg, target
  rex.w
  db 0xFF
  modrm 3, 1, treg
    ; The 1 is part of the opcode.
end macro

; This adds a 64-bit register to another 64-bit register, in place.
macro add.qreg.qreg target, source
  qwordreg treg, target
  qwordreg sreg, source
  rex.w
  db 0x01
  modrm 3, sreg, treg
end macro


macro add.indirect.qreg.qreg target, source
  match =rsp, target
    assert 0
    ; The SIB case.
  else match =rbp, target
    assert 0
    ; An unrelated addressing mode.
  else
    qwordreg treg, target
    qwordreg sreg, source
    rex.w
    db 0x01
    modrm 0, sreg, treg
  end match
end macro


macro add.qreg.indirect.qreg target, source
  match =rsp, source
    assert 0
    ; The SIB case.
  else match =rbp, source
    assert 0
    ; An unrelated addressing mode
  else
    qwordreg treg, target
    qwordreg sreg, source
    rex.w
    db 0x03
    modrm 0, treg, sreg
  end match
end macro


; This adds a signed 8-bit immediate value to a 64-bit register, in place.
;
; Notice the use of 3 as the addressing mode. This says to use the register
; itself. The 0 in the reg field is part of the opcode.
macro add.qreg.bimm target, source
  qwordreg treg, target
  rex.w
  db 0x83
  modrm 3, 0, treg
  db source
end macro


; This adds a signed 32-bit immediate value to a 64-bit register, in place.
;
; Notice the use of 3 as the addressing mode. This says to use the register
; itself. The 0 in the reg field is part of the opcode.
macro add.qreg.dimm target, source
  qwordreg treg, target
  rex.w
  db 0x81
  modrm 3, 0, treg
  dd source
end macro

; This subtracts a 64-bit register from another 64-bit register, in place.
macro sub.qreg.qreg target, source
  qwordreg treg, target
  qwordreg sreg, source
  rex.w
  db 0x2B
  modrm 3, treg, sreg
end macro


macro sub.indirect.qreg.qreg target, source
  match =rsp, target
    ; The SIB case.
    assert 0
  else
    qwordreg treg, target
    qwordreg sreg, source
    rex.w
    db 0x2B
    modrm 0, sreg, treg
  end match
end macro


; This subtracts a signed 8-bit immediate value from a 64-bit register, in
; place.
;
; Notice the use of 3 as the addressing mode. This says to use the register
; itself. The 5 in the reg field is part of the opcode.
macro sub.qreg.bimm target, source
  qwordreg treg, target
  rex.w
  db 0x83
  modrm 3, 5, treg
  db source
end macro

; This subtracts a signed 32-bit immediate value from a 64-bit register, in
; place.
;
; Notice the use of 3 as the addressing mode. This says to use the register
; itself. The 5 in the reg field is part of the opcode.
macro sub.qreg.dimm target, source
  qwordreg treg, target
  rex.w
  db 0x81
  modrm 3, 5, treg
  dd source
end macro

; This multiplies rax, as 64-bits, with another 64-bit register, in place.
;
; The 4 in the reg field is part of the opcode.
macro mul.rax.qreg source
  qwordreg sreg, source
  rex.w
  db 0xF7
  modrm 3, 4, sreg
end macro

; The official mnemonic for this is "div", but it's divmod: It takes a 128-bit
; dividend formed from concatenating rdx as the high half with rax as the low
; half, and divides it by a 64-bit divisor from a specified register. It
; stores the quotient, truncated towards zero, in rax, and it stores the
; remainder in rdx. This entire process is unsigned.
;
; The 6 in the reg field is part of the opcode.
macro div.rdxrax.qreg source
  qwordreg sreg, source
  rex.w
  db 0xF7
  modrm 3, 6, sreg
end macro

; Same as div, but signed.
;
; The 7 in the reg field is part of the opcode.
macro idiv.rdxrax.qreg source
  qwordreg sreg, source
  rex.w
  db 0xF7
  modrm 3, 7, sreg
end macro


macro and.qreg.qreg target, source
  qwordreg treg, target
  qwordreg sreg, source
  rex.w
  db 0x23
  modrm 3, treg, sreg
end macro

macro and.qreg.bimm target, source
  qwordreg treg, target
  rex.w
  db 0x83
  modrm 3, 4, treg
    ; The 4 is part of the opcode.
  db source
end macro

macro or.qreg.qreg target, source
  qwordreg treg, target
  qwordreg sreg, source
  rex.w
  db 0x0B
  modrm 3, treg, sreg
end macro

macro xor.qreg.qreg target, source
  qwordreg treg, target
  qwordreg sreg, source
  rex.w
  db 0x33
  modrm 3, treg, sreg
end macro

macro not.qreg target
  qwordreg treg, target
  rex.w
  db 0xF7
  modrm 3, 2, treg
    ; The 2 is part of the opcode.
end macro


; This sets the flags to the same things they'd be set to if subtracting
; right from left.
macro cmp.qreg.qreg left, right
  qwordreg lreg, left
  qwordreg rreg, right
  rex.w
  db 0x3B
  modrm 3, lreg, rreg
end macro

; This sets the flags to the same things they'd be set to if AND'ing right
; with left.
macro test.qreg.qreg left, right
  qwordreg lreg, left
  qwordreg rreg, right
  rex.w
  db 0x85
  modrm 3, rreg, lreg
end macro

macro set.breg.cc target, condition
  bytereg treg, target
  conditioncode cc, condition
  db 0x0F
  opcodecc 0x90, cc
  modrm 3, 0, treg
end macro


; Move from an 8-bit immediate value, to a location relative to a 64-bit
; register, with an 8-bit displacement and no indexing.
;
; This uses opcode 0xC6, which has w = 0. Since we run in 64-bit mode, that
; makes the operand size 8 bits, regardless of the current operand-size
; attribute. [Intel] volume 2D, appendix B, section B-1.4.3, table B-6.
macro mov.qreg.disp8.bimm target, offset, source
  qwordreg treg, target
  db 0xC6
  modrm 1, 0, treg
    ; the 0 is part of the opcode
    ; 4 is rsp, but it's a special case
  match =rsp, target
    ; R/M = rsp is the SIB case
    sib 0, 4, treg
      ; no scaling, no indexing, target as base
  end match
  db offset
  db source
end macro

; Move from a 16-bit immediate value, to a location relative to a 64-bit
; register, with an 8-bit displacement and no indexing.
;
; This uses opcode 0xC7, which has w = 1. We run in 64-bit mode, so that gives
; us an operand size of 32 bits by default. [Intel] volume 1, chapter 3,
; section 3-6.1, table 3-4. We want a 16-bit operand, so we use the
; operand-size prefix, 0x66, and we leave REX.W unset.
;
; We need to treat rsp specially because it's the SIB case, per table 2-2.
macro mov.qreg.disp8.wimm target, offset, source
  qwordreg treg, target
  db 0x66
  db 0xC7
  modrm 1, 0, treg
    ; the 0 is part of the opcode
  match =rsp, target
    ; R/M = rsp is the SIB case
    sib 0, 4, treg
      ; no scaling, no indexing, target as base
  end match
  db offset
  dw source
end macro

; Move from a 32-bit immediate value, to a location relative to a 64-bit
; register, with an 8-bit displacement and no indexing.
;
; This uses opcode 0x67, which has w = 1. We run in 64-bit mode, so that gives
; us an operand size of 32 by default. [Intel] volume 2D, section B.1.43,
; table B-6. This is what we want, so we leave it.
macro mov.qreg.disp8.dimm target, offset, source
  qwordreg treg, target
  db 0xC7
  modrm 1, 0, treg
    ; the 0 is part of the opcode
  match =rsp, target
    ; R/M = rsp is the SIB case
    sib 0, 4, treg
      ; no scaling, no indexing, target as base
  end match
  db offset
  dd source
end macro

; Move from a 64-bit register, to a 64-bit location relative to a 64-bit
; register, with an 8-bit displacement and no indexing.
;
; This uses opcode 0x89 with REX.W, so that gives us the reg field as the
; 64-bit source and the R/M field as the 64-bit destination.
;
; We need to treat a target of rsp specially because it's the SIB case per
; table 2-2.
macro mov.qreg.disp8.qreg target, offset, source
  qwordreg sreg, source
  qwordreg treg, target
  rex.w
  db 0x89
  modrm 1, sreg, treg
  match =rsp, source
    ; R/M = rsp is the SIB case
    sib 0, 4, 4
      ; no scaling, no indexing, rsp as base
  end match
  db offset
end macro

; Move from a 64-bit register, to a 64-bit location relative to a 64-bit
; register, with a 32-bit displacement and no indexing.
;
; This uses opcode 0x89 with REX.W, so that gives us the reg field as the
; 64-bit source and the R/M field as the 64-bit destination.
;
; We need to treat a target of rsp specially because it's the SIB case per
; table 2-2.
macro mov.qreg.disp32.qreg target, offset, source
  qwordreg sreg, source
  qwordreg treg, target
  match =rsp, target
    rex.w
    db 0x89
    modrm 2, sreg, treg
      ; treg is rsp by assumption, and R/M = rsp is the SIB case
    sib 0, 4, 4
      ; no scaling, no indexing, rsp as base
    dd offset
  else
    rex.w
    db 0x89
    modrm 2, sreg, treg
    dd offset
  end match
end macro

; Move from a 32-bit immediate value, to a 64-bit location relative to a
; 64-bit register, with an 8-bit displacement and no indexing.
;
; Note that there is no instruction to move a 64-bit immediate to memory.
;
; This uses opcode 0xC7, which has w = 1. We run in 64-bit mode, so that
; gives us an operand size of 32 by default. [Intel] volume 2D,
; section B.1.43, table B-6. We want a 64-bit operand, so we use the REX.W
; prefix, 0x48.
macro mov.qreg.disp8.dimm target, offset, source
  qwordreg treg, target
  match =rsp, target
    rex.w
    db 0xC7
    modrm 1, 0, treg
      ; the 0 is part of the opcode
      ; 4 is rsp, but it's a special case
    sib 0, 4, treg
      ; no scaling, no indexing, rsp as base
    db offset
    dd source
  else
    rex.w
    db 0xC7
    modrm 1, 0, treg
      ; the 0 is part of the opcode
    db offset
    dd source
  end match
end macro

; "Load effective address". Compute a 64-bit address as you would for
;  indexed addressing, with an 8-bit displacement and no indexing, but instead
; of doing anything with the memory, just store the address itself into a
; register.
macro lea.qreg.disp8.qreg target, offset, source
  qwordreg treg, target
  qwordreg sreg, source
  rex.w
  db 0x8D
  modrm 1, treg, sreg
  match =rsp, source
    ; R/M = rsp is the SIB case
    sib 0, 4, sreg
      ; no scaling, no indexing, rsp as base
  end match
  db offset
end macro

macro lea.qreg.disp32.qreg target, offset, source
  qwordreg treg, target
  qwordreg sreg, source
  rex.w
  db 0x8D
  modrm 2, treg, sreg
  match =rsp, source
    ; R/M = rsp is the SIB case
    sib 0, 4, sreg
      ; no scaling, no indexing, rsp as base
  end match
  dd offset
end macro

macro lea.qreg.indexed.qreg target, source, index, scale
  match =rbp, source
    assert 0
    ; This is divided into some subcases we don't wish to deal with yet.
  else match =rsp, index
    assert 0
    ; This is the case where it's not actually indexed after all.
  else
    qwordreg treg, target
    qwordreg sreg, source
    qwordreg ireg, index
    scalefield sfield, scale
    rex.w
    db 0x8D
    modrm 0, treg, 4
    sib sfield, ireg, sreg
  end match
end macro

; Wow, we use ALL the instruction suffixes for this, huh. See [Intel] volume
; 2A, chapter 2, section 2-1, with particular attention to figure 2-1.
macro lea.qreg.disp8.indexed.qreg target, offset, source, index, scale
  match =rbp, source
    assert 0
    ; This is divided into some subcases we don't wish to deal with yet.
  else match =rsp, index
    assert 0
    ; This is the case where it's not actually indexed after all.
  else
    qwordreg treg, target
    qwordreg sreg, source
    qwordreg ireg, index
    scalefield sfield, scale
    rex.w
    db 0x8D
    modrm 1, treg, 4
      ; 1 in the mode field says we want a disp8.
      ; 4 in the R/M field says we want an SIB byte.
    sib sfield, ireg, sreg
    db offset
  end match
end macro

; Clear the DF flag. This makes string instructions increment RSI.
macro cld
  db 0xFC
end macro

; Set the DF flag. This makes string instructions decrement RSI.
macro std
  db 0xFD
end macro

; Load 64 bits from the address in RSI into RAX. Then, increment or decrement
; RSI by 8 bytes, depending on the value of the DF flag.
macro lodsq
  rex.w
  db 0xAD
end macro

;   [Intel] describes two different styles of mnemonic for the repeated string
; operations. See, their parameters are always rsi and rdi, or the smaller
; versions of those same specific registers. Intel thinks we might want to
; write out "rsi" explicitly, even though the only information it conveys is
; the size. The position we take is that it's better to let that be conveyed
; by the instruction name; otherwise it'd be a point of confusion for new
; readers, who might mistakenly think it's possible to pass it different
; registers.
;
;   With the string instructions, the reader SHOULD be thinking, "Wait...
; where does this get its parameters from?" Writing them in a way that makes
; them appear simpler than they are would be confusing.
macro rep operation
  match =movsq, operation
    ; The "rep" instruction can also be thought of as a prefix to other
    ; instructions, though only a few specific ones are allowed. Anyway, it
    ; comes before the REX byte.
    db 0xF3
    ; The rest of this is the same as the encoding of normal, non-repeated
    ; movsq.
    rex.w
    db 0xA5
    ; There's no explicit parameters. String operations are magic.
  else
    assert 0
  end match
end macro

; Push a 64-bit value from a register onto the stack (the one pointed to by
; rsp). Decrement rsp, then write the value at the new location.
;
; In the corner case where rsp is also the value being pushed, the old value
; is the one used.
;
; There's an alternate encoding of this that uses a ModRM byte, but doing it
; without is more compact, so we do without.
macro push.qreg source
  qwordreg sreg, source
  opcodereg 0x50, sreg
end macro

macro push.bimm source
  db 0x6A
  db source
end macro

; Operand-size prefix makes it 16-bit.
;
; If you're trying to fake pushing a larger size by doing several 16-bit
; pushes, remember to start by pushing the low end and proceed upwards.
; [Intel] volume 1, chapter 9, section 9-2.4, "Memory Data Formats".
macro push.wimm source
  db 0x66
  db 0x68
  dw source
end macro

; There is no 64-bit immediate push. So, can we have a push instruction that
; pushes a 32-bit immediate value? Sort-of, but it's sign-extended to 64 bits,
; so rsp is decremented by 8, not by 4. This is that instruction.
;
; You need to do a really close read of a number of things to understand why.
; The opcode tables in [Intel] in volume 2D, appendix A, section A-3 give it
; the d64 annotation, which per table A-1 in section A-2.5 indicates that the
; operand size is always 64 bits and that there is no corresponding 32-bit
; version. Yet, the actual immediate value is still only 32 bits! Direct your
; attention to the instruction's details page, volume 2B, chapter 4, section
; 4-3, "PUSH". The description section clearly details that the immediate may
; be less than the operand size, which makes sense once you know it, but it
; doesn't explictly call out that the operand size is still 64 bits here.
;
; In general, the size of an immediate doesn't determine operand size, as you
; can read about in detail in [Intel] volume 1, chapter 3, section 3-6.1, with
; particular attention to table 3-4.
;
; Why is this surprising, given that it's consistent with the behavior of
; other instructions? Well, most instructions don't have such obvious
; side-effects. It's easy to not notice the operand size disagreeing with the
; immediate size when you'e only writing to a register, but changing the stack
; in an unexpected way breaks things much more obviously.
;
; Anyway, if you really want to decrement the stack pointer by 32 bits after
; a push, consider pushing a register.
macro push.dimm source
  db 0x68
  dd source
end macro

; Pop a 64-bit value into a register from the stack (the one pointed to by
; rsp). Read the value from the old location, then increment rsp.
;
; In the corner case where rsp is also the destination being written to, the
; read happens from the old location, then the write causes the increment to
; be irrelevant.
;
; There's an alternate encoding of this that uses a ModRM byte, but doing it
; without is more compact, so we do without.
macro pop.qreg target
  qwordreg treg, target
  opcodereg 0x58, treg
end macro


; Do an absolute indirect jump with a 64-bit register operand. That is: given
; a register which holds a pointer, read another address from the pointed-to
; memory and jump to it.
;
; Technically this is a "near" jump in x86 terms, but we just pretend far
; jumps and segments don't exist. They are still a thing in 64-bit mode, we
; just don't use them.
macro jmp.abs.indirect.qreg location
  qwordreg lreg, location
  db 0xFF
  modrm 0, 4, lreg
end macro

; There in no 64-bit immediate "near" jump, so we use 32-bit. It's relatve,
; so that's honestly plenty.
;
; The location is relative to the start of the instruction immediately
; following the jmp.
macro jmp.rel.dimm location
  db 0xE9
  dd location
end macro

; The location is relative to the start of the instruction immediately
; following the jmp.
macro jmp.cc.rel.bimm condition, location
  conditioncode cc, condition
  opcodecc 0x70, cc
  db location
end macro

; The location is relative to the start of the instruction immediately
; following the jmp.
macro jmp.cc.rel.dimm condition, location
  conditioncode cc, condition
  db 0x0F
  opcodecc 0x70, cc
  dd location
end macro

; Invoke a system call provided by the kernel. On Linux, the System V ABI
; describes the semantics of such calls (at least, on x86).
macro syscall
  db 0x0F, 0x05
end macro


; Halts the CPU. We can't actually run this in userspace, but the kernel will
; kill our process or the debugger will break, and those are the outcomes we
; actually want.
macro hlt
  db 0xf4
end macro



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Executable file format ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;   Before we get into the body of the program, we do a lot of ELF-specific
;;; stuff to ensure that our output is in a format Linux knows how to run.
;;;
;;;   First, we set the origin to load at. This is arbitrary, but it can't be
;;; zero. We tell flatassembler about it because it's used in label
;;; calculations; we can reference it as $$ any time we need it in future.
org 0x08000000

;;;
;;;   Second, we output ELF's top-level file header. The only interesting
;;; thing here is the entry pointer.
;;;
elf_header:
  ; * denotes mandatory fields according to breadbox
  db 0x7F, "ELF"                 ; *magic number
  db 2                           ; 64-bit
  db 1                           ; little-endian
  db 1                           ; ELF header format version 1
  db 0                           ; System-V ABI
  db 8 dup 0                     ; (padding)

  dw 2                           ; *executable
  dw 0x3E                        ; *Intel x86-64
  dd 1                           ; ELF format version

  dq _start                      ; *entry point
  dq program_header - $$         ; *program header offset
  dq 0                           ; section header offset
  dd 0                           ; processor flags
  dw elf_header_size
  dw program_header_entry_size   ; *
  dw 1                           ; *number of program header entries
  dw 0                           ; section header entry size
  dw 0                           ; number of section header entries
  dw 0                           ; section name string table index
; Save a copy of the size of this chunk for our future reference, by comparing
; the current posiion to the label above.
elf_header_size = $ - elf_header

;;;
;;;   Third, immediately after the ELF file header, we output ELF's program
;;; header, which lists the memory regions ("segments") we want to have and
;;; where we want them to come from. We list just a single region, which is
;;; the entire contents of the ELF file from disk.
;;;
;;;   It would be more typical to use this header to ask the loader to give us
;;; separate code and data segments, and perhaps a stack or heap, but this
;;; keeps things simple, and we can create those things for ourselves later.
;;;
;;;    We do have a little stack space available, though we don't explicitily
;;; request any; the kernel allocates it for us as part of exec() so that it
;;; can pass us argc and argv (which we ignore). That stack space will be at a
;;; random address, different every time, because of ASLR; that's a neat
;;; security feature, so we leave it as-is.
;;;
program_header:
  dd 1                           ; *"loadable" segment type
  dd 0x05                        ; *read+execute permission
  dq 0                           ; *offset in file
  dq $$                          ; *virtual address
    ; required, but can be anything, subject to alignment
  dq 0                           ; physical address (ignored)
  dq file_size                   ; *size in file
  dq file_size                   ; *size in memory
  dq 0                           ; segment alignment
                                 ;   for relocation - will we be ASLR'd?
; Save the size of this chunk, as well.
program_header_entry_size = $ - program_header

; Everything after this point is code or data, not headers, so save the start
; of it for use in size calculations later.
code_start:


;;;;;;;;;;;;;;;;;;;;;;;
;;; Execution model ;;;
;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;   We use Forth-style dual stacks, one for values and one for control. We
;;; use rsp for values, just like C does. We use rbp for the control stack,
;;; which is a special Forth-y stack: These are pointers into the bodies of
;;; Forth words, not return addresses.
;;;
;;;   The choice of rsp and rbp for the stack pointers imitates Jonesforth;
;;; I'm hopeful that it gives us convenient addressing modes, and will report
;;; back about that when I feel that I understand the implications.
;;;
;;;   In Forth, everything is a "word", including mutable variables.
;;; Conceptually, a word is a unit of execution, which may be implemented
;;; either in machine code or as an array of pointer to other words.
;;;
;;;   This polymorphism is implemented by having each word's contents begin
;;; with a "codeword", which is a pointer to machine code that "interprets"
;;; the rest of the contents. In the case of words implemented in machine
;;; code, the codeword points directly to that code, which is normally right
;;; next to it.
;;;
;;;   Variables, to Forth, are simply one more thing that can be executed; the
;;; effect of executing a variable is to push its address onto the value
;;; stack.
;;;
;;;   We adopt this model of words, codewords, and variables-as-words. It's
;;; really nice how it doesn't force anything else on us, not even a heap,
;;; though we do end up using a heap.
;;;
;;;   We specifically implement a version of calling and returning that Forth
;;; calls indirect threaded code: The control stack is a stack of pointers
;;; into the middle of interpreted words. The interpreter snippet, called
;;; DOCOL, implements calling.  Each word is responsible for making sure
;;; returning works properly. Interpreted words accomplish this by ending with
;;; the word EXIT, while machine-code words accomplish it by ending with a
;;; verbatim snippet called NEXT.
;;;
;;;   Conceptually, NEXT returns, but more specifically it accomplishes this
;;; by doing the caller's next dispatch for it; thus control never actually
;;; goes back to the caller's interpreter after initial setup. For performance
;;; reasons, NEXT is always inlined, so we define it as a macro.
;;;
;;;   DOCOL is just ordinary code, not a macro. It's defined later in this
;;; file, as a label.
;;;
;;;   Notionally, we could consider not having a dictionary, and not giving
;;; our words names. However, it feels silly to stop when we're so close to
;;; being a full Forth, and using names for things solves a bootstrapping
;;; problem related to heap management - see the write-up of _start about how
;;; the heap is created, below. So, we add an additional header before the
;;; codeword for this purpose.
;;;
;;;   The Forth dictionary is usually a linked list of every word that has
;;; ever been defined, with the newest at the head; the names of words are
;;; stored in string fields, often right next to the link pointer. We adopt
;;; this model, with the field sizes and order shown in the quick reference
;;; below. We break with Forth tradition in one way: Rather than having a
;;; length field, we use a null-terminated string. Thus, there's no length
;;; limit on names. This necessitates breaking out the flags (to be explained
;;; later) into their own byte, rather than taking bits from the length field
;;; for them.
;;;
;;;   There's an important performance consideration: Executable words
;;; reference each other by pointers to their respective codewords. However,
;;; dictionary entries reference each other by pointers to their respective
;;; link fields. Traversing from the link field to the codeword is easy,
;;; though it's a non-constant-time operation: Just walk the string. In order
;;; to make Forth words easy to "decompile", it would be nice to also have a
;;; way to traverse backwards. We solve this by making the name field be
;;; null-terminated at both ends. Fun, yeah?
;;;
;;;
;;;
;;;
;;; --------------------------------------------------------------------------
;;;  Quick Reference
;;; --------------------------------------------------------------------------
;;;
;;; The layout of an interpreted word:
;;;
;;; (overall start)
;;;            0x00 - 0x08                     Link (to next-oldest word)
;;;            0x09 - 0x09  I0H00000           Flags
;;;                                                I - immediate
;;;                                                H - hidden
;;;                                                all other bits reserved
;;; (name start)
;;;            0x0a - 0x0a                     Null byte (terminates name)
;;;            0x0b - name-end - 1             Name, as UTF-8
;;;        name-end - name-end                 Null byte (terminates name)
;;; (padding start)
;;;    name-end + 1 - codeword-start - 1       Zero-pad to 8-byte boundary
;;;    (it's possible this will be zero bytes long)
;;; (codeword start)
;;;      ... + 0x00 - ... + 0x08               Codeword (ie. address of DOCOL)
;;;          (8-byte chunks)                   Addresses of other words
;;;                 - ... (end)                Address of EXIT word
;;;
;;; The layout of a machine-code word is different only from the codeword on:
;;;
;;;      ... + 0x00 - ... + 0x08               Addresss of next byte
;;;      ... + 0x08 - ????                     Arbitrary machine code
;;;                 - ... (end)                Inlined implementation of NEXT
;;;
;;; Also, words always start at 8-byte boundaries.
;;;
;;;
;;; REGISTER usage conventions:
;;;
;;; * rsi is the "instruction pointer" for the "interpreter".
;;;     That is, it points to some word-pointer inside an array of
;;;   word-pointers inside the content of the word they're part of. It always
;;;   points to the next word that should be executed, whose execution hasn't
;;;   begun yet.
;;;
;;; * rbp points to the top of the control stack
;;;     These are former values of rsi, to eventually be returned to, from
;;;   successively older callers as you look further up the stack. The stack
;;;   grows downwards in memory. Since values are kept separately, the only
;;;   thing on the control stack is return addresses, one per layer of call.
;;;
;;; * rsp points to the top of the value stack
;;;     The value stack has no specific format, but it grows downwards in
;;;   memory. In particular there's no concept of stack frames, because items
;;;   on the stack don't belong to any particular word; the value stack in
;;;   Forth is in part a mechanism for passing values between words.
;;;
;;; Additionally, immediately after beginning execution of a word:
;;;
;;; * rax points to the address of the codeword being executed
;;;     The value of rax is purely for the callee's benefit, and does not need
;;;   to be preserved.
;;;
;;;   Other registers are purely discretionary, and are not preserved across
;;; calls.
;;;
;;;
;;; FLAG usage:
;;;
;;; * DF should be 0
;;;   We use lodsq extensively and that makes it increment rsi after using it.
;;;
;;; --------------------------------------------------------------------------

;;;
;;; 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.
;;;
;;; 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
;;;
macro NEXT
  ; Copy the next word's address from *rsi into rax. Increment rsi (as per the
  ; DF flag).
  lodsq

  ; Load the codeword from the word's contents, and jump to the interpreter it
  ; points to.
  jmp.abs.indirect.qreg rax
end macro

;;;
;;; 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.
;;;
;;;   This implementation will work regardless of how the receiving word is
;;; implemented. It impersonates NEXT, 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.
;;;
macro BEFORENEXT target
  ; 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.
  mov.qreg.qimm rax, target
  jmp.abs.indirect.qreg rax
end macro

;;;
;;; 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.
;;;
macro PUSHCONTROL source
  lea.qreg.disp8.qreg rbp, -8, rbp
  mov.indirect.qreg.qreg rbp, source
end macro

macro POPCONTROL target
  mov.qreg.indirect.qreg target, rbp
  lea.qreg.disp8.qreg rbp, 8, rbp
end macro

;;;
;;; Routine _start
;;; --------------
;;;
;;;   This is the entry point of the whole program, the very first code we
;;; actually execute. Linkers traditionally call this _start, and on balance
;;; I think it's probably best to keep that name, though I've honestly never
;;; liked it... Anyway, the ELF header points to it and exec() jumps to it.
;;; Also, though it could be anywhere in the code part of the output, in order
;;; to make the hexdump pretty we put it at the start.
;;;
;;;   The kernel gives us most registers zeroed, and rsp pointing to the
;;; command-line stuff (argc, argv, envp), which is at an ASLR'd address with
;;; some stack space allocated for us, despite the fact we didn't request any.
;;; It also gives us all the flags clear except IF, but we don't rely on that.
;;; Lastly, of course, it loads our code segment and sets the instruction
;;; pointer where we asked; we don't need to check what those addresses are,
;;; because they're not randomized.
;;;
;;;   This routine is really only responsible for one-time initialization.
;;;
;;; Registers in:
;;;
;;; * rsp points to the logical top  of the value stack
;;;     The kernel sets this up for us, and we need to save it somewhere so
;;;   Forth can use it.
;;;
;;; Registers out:
;;;
;;; * rsi points within QUIT
;;;     QUIT is the word that's Forth's closest equivalent to main().
;;; * rsp points to the top of the value stack
;;;
;;;   Notably, rbp is still uninitialialized after _start.
;;;
;;; Stack in:
;;;
;;; * argc, argv, envp in the usual Unix way
;;;     We ignore them, though.
;;;
;;; Stack out:
;;;
;;; * The value of HEAP, as a pointer
;;;     The meaning of this will be explained below.
;;;
;;; Registers within:
;;;
;;; * rdi points to the base the heap was allocated at, once it exists
;;;     This is the same value that HEAP will hold, once we reach a point
;;;   where we have variables. Of course, variables are stored on the heap,
;;;   hence this temporary measure.
;;;
;;;   We also take this opportunity to define soeme memory layout parameters
;;; that this routine will be responsible for doing something with:
;;;
heap_requested_address = 0x0000001000000000 ; (very arbitrary)
heap_size =              0x0000000001000000 ; 16 MiB
control_stack_size =                0x10000 ; 64 KiB

_start:
  cld                                      ; clear the DF flag

  ;;;
  ;;; Prepare the heap.
  ;;;
  ;;;   We could ask for a data segment in the program header, but where's the
  ;;; fun in that? Instead, we call mmap().
  ;;;
  ;;;   If we wanted the kernel to do ASLR for us, passing address zero would
  ;;; cause it to pick somewhere at random, but instead we choose our own
  ;;; location. It's still not guaranteed to be where we ask for, so we still
  ;;; do the work to record where it wound up. We could pass the "fixed" flag
  ;;; and the kernel would trust us, but this gives us more options for
  ;;; interoperating with other runtimes.
  ;;;
  mov.b rax, 9                               ; mmap()
  mov.qreg.qimm rdi, heap_requested_address  ; address (very arbitrary)
  mov.qreg.qimm rsi, heap_size               ; size (one meg)
  mov.qreg.qimm rdx, 0x03                    ; protection (read+write)
  mov.oreg.qimm r10, 0x22                    ; flags (private+anonymous)
  mov.oreg.qimm r8, 0                        ; file descriptor (ignored)
  mov.oreg.qimm r9, 0                        ; offset (ignored)
  syscall

  ;;;
  ;;;   The return value of the system call is in rax, we'll use it in a sec.
  ;;; We need to save this somewhere in case we ever want to munmap() it;
  ;;; there's no widely-used name for it so we have to make one up. S0 and R0
  ;;; are widely-used names for the logical tops of the value and control
  ;;; stacks, respectively, and we will eventually set those up as well, so we
  ;;; should keep those names in mind. The control stack lives within the
  ;;; heap, while the value stack is its own segment. This value, though, is
  ;;; the physical bottom of the segment, meaning that it stays the same even
  ;;; as we allocate and deallocate things within it. This is unlike the two
  ;;; stack pointers, so we give it a name that doesn't suggest similarity:
  ;;; HEAP.
  ;;;
  ;;;   Once Forth is fully set up, its internal variables will be accessed
  ;;; through variable-words like any other Forth data, including HEAP. To get
  ;;; to that point, though, we need to be able to hold onto variable data
  ;;; between now and then. In fact, if we don't have at least one of HEAP and
  ;;; HERE (its counterpart which points to the logical top end), all our
  ;;; efforts to hold onto anything seem a bit doomed.
  ;;;
  ;;;   So, we temporarily dedicate rdi to HEAP - only within this routine -
  ;;; and store everything else in ways that let us find things by reference
  ;;; to it. We choose rdi because it works with the indexing modes we care
  ;;; about, and its name suggests its function.
  ;;;
  ;;;   The strategy Jonesforth uses is not applicable to us; Jonesforth
  ;;; takes advantage of the linker to let its code segment refer to specific,
  ;;; pre-allocated objects in the data segment. We are our own linker.
  ;;; Hence, this approach.
  ;;;
  ;;;   Keying things off HEAP is the fundamental decision, but to make sure
  ;;; our variables are accessible both during early bootstrapping, and later,
  ;;; we also have to be thoughtful about data structures. More on that in a
  ;;; moment.
  ;;;
  mov.qreg.qreg rdi, rax

  ;;;
  ;;;   We also initialize rbp. We could hold off and let QUIT do this, but
  ;;; doing it now is the easiest way to initialize the R0 variable, since
  ;;; there's no instruction that moves a 64-bit immediate to memory.
  ;;;
  ;;;   This is the moment at which we decide where the control stack starts!
  ;;; Fun, right? "Allocation" is just a fancy word for picking where we want
  ;;; something, then being consistent about it - like placing furniture in
  ;;; your home. See below for a little more thought about why here in
  ;;; particular.
  ;;;
  lea.qreg.disp32.qreg rbp, control_stack_size, rdi

  ;;;
  ;;;   Now we save some stuff onto the heap. These are the locations that
  ;;; will eventually be the backing stores of the Forth variables, but we
  ;;; don't create the word headers yet, since there's no requirement that
  ;;; they be next to the backing stores. We'll do that later, once we have
  ;;; word-writing infrastructure in place. For now, we just use their offsets
  ;;; relative to the physical bottom of the heap, which are fixed.
  ;;;
  ;;;   These will be the permanent homes of these values, though we have
  ;;; copies of them elsewhere while we're still in this routine.
  ;;;
  mov.qreg.disp32.qreg rdi, control_stack_size + 0x00, rdi    ; HEAP
  mov.qreg.disp32.qreg rdi, control_stack_size + 0x08, rsp    ; S0
  mov.qreg.disp32.qreg rdi, control_stack_size + 0x10, rbp    ; R0
  lea.qreg.disp32.qreg rax, control_stack_size + 0x20, rdi
  mov.qreg.disp32.qreg rdi, control_stack_size + 0x18, rax    ; HERE
  ; TODO also consider LATEST and STATE
  ; strictly speaking, R0 could be a constant... but it isn't known until
  ; runtime, so we might as well make it a variable
  ;;;
  ;;; * HEAP is the physical bottom of the heap
  ;;;     The heap grows upwards in memory, so this is also the logical
  ;;;   bottom. This comes from the address mmap() just returned to us.
  ;;; * S0 is the logical bottom of the value stack
  ;;;     The value stack grows downwards in memory, so this is the physical
  ;;;   top of it. This comes from the stack pointer the kernel initialized us
  ;;;   with.
  ;;; * R0 is the logical bottom of the control stack
  ;;;     The control stack also grows downwards, so this is its pysical top
  ;;;   as well. We allocate this dedicated space within the heap right here,
  ;;;   in this routine, through our choice of where to put things.
  ;;; * HERE is the physical start of the unallocated space in the heap
  ;;;     We allocate heap space from bottom to top, by incrementing this
  ;;;   value. So, it would also be accurate to say that it points immediately
  ;;;   after the physical top of the allocated space. At any rate, the
  ;;;   address it points to is the first one that hasn't been used yet.
  ;;;
  ;;;   S0 and R0 are mostly used when we want to initialize or reinitialize
  ;;; their respective stacks - that is, discard all their contents at once.
  ;;;
  ;;;   The value of R0 is the same address these variables start at, so
  ;;; you'll want to do a close read of the implementation of PUSHCONTROL and
  ;;; convince yourself that it only ever writes things just below the rbp
  ;;; address it receives, never right on top of it.
  ;;;
  ;;;   Notice that HERE points immediately after itself. This is just a
  ;;; convenience, making it the last one like that so that the concern is
  ;;; dealt with in a single place and is easy to keep up-to-date with code
  ;;; changes.
  ;;;
  ;;;   A little more detail about why we offset everything by
  ;;; control_stack_size: We're carving out some space at the bottom of the
  ;;; heap - which grows low-to-high - to be the control stack - which grows
  ;;; high-to-low. So the control stack is allocated out of the heap as a
  ;;; fixed-size, one-time thing, and then the variables come immediately
  ;;; after that. We do need to use 32-bit displacement indexing to access
  ;;; them this way, but that's no big deal.
  ;;;
  ;;;   This is perhaps questionable, they should maybe be separate segments
  ;;; created with separate calls to mmap(), but for now we're not worried
  ;;; about overflow so we use the same allocation for both.
  ;;;
  ;;;   We'll come back to these variables a bit later and generate the word
  ;;; headers that point at them, but now we're almost ready to switch to
  ;;; proper threaded-execution, so we finish that setup first...
  ;;;

  ;;;
  ;;;   Push the value of HEAP onto the value stack so that it can be the
  ;;; breadcrumb the threaded code needs to find... the backing store of HEAP.
  ;;; Yes, self-reference can be weird like that sometimes. There's nothing
  ;;; stopping QUIT from reading rdi, it just violates the abstraction...
  ;;;
  push.qreg rdi

  ;;;
  ;;;   We are about to set up rsi, we did rbp already, and rsp came to us
  ;;; already set up. That's all that NEXT needs, so take it away!
  ;;;
  mov.qreg.qimm rsi, cold_start
  NEXT

;;;
;;;   This isn't really a routine so much as it's an array of words (exactly
;;; one of them), which is what NEXT wants rsi to point to. It's only ever
;;; used this one time, so we just put it right here.
;;;

  align 8
cold_start:
;;; TODO this is probably where we should deal with that HEAP that we passed
;;; on the stack
  dq QUIT

;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Now we are in Forth ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;   Everything we define from here on out is an actual Forth word, with a
;;; proper header and everything. So, you'll see some more preamble before the
;;; definitions.
;;;
;;;   Keep in mind, though, that, although we have threaded execution, we
;;; don't yet have Forth-style variables. That's because the heap is at a
;;; dynamically-chosen location, so none of this read-only code that we're
;;; defining now can reference it. Before invoking cold_start, we thoughtfully
;;; put the value of HEAP on the stack for ourselves; our first task will be
;;; to dynamically allocate some words on the heap that know how to find the
;;; heap. We'll do that by defining bootstrapping versions of the
;;; word-defining words, which will eventually be replaced.

; Token pasting is possible in flatassembler, but kind of a pain.
calminstruction defword_label_helper name
  local full_name, address
  arrange full_name, name#=_name        ; do the token-pasting
  compute address, $                    ; compute the current address
  publish full_name:, address           ; bind the label
end calminstruction

; The only time we actually use this variant is DOCOL.
macro defword_unlabeled name, flags
  align 8
  defword_label_helper name
  dq latest_word
  latest_word = $ - 8
  db flags, 0x00, `name, 0x00
  align 8
end macro

; This is the variant we use to define ordinary words.
macro defword name, flags
  defword_unlabeled name, flags
  label name
end macro

latest_word = 0

;;;
;;; Routine DOCOL
;;; -------------
;;;
;;;   Reference this via its label as the codeword of a word to make it an
;;; "interpreted" word. Concretely, 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.
;;;
;;;   The name is said to be short for "do colon", because Forth high-level
;;; code begins word definitions with a colon.
;;;
;;; 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
defword_unlabeled DOCOL, 0
DOCOL_constant:
  ; Evaluated as a word, DOCOL is a constant which returns a pointer.
  dq $ + 0x8                     ; codeword
  mov.qreg.qimm rax, DOCOL
  push.qreg rax
  NEXT
  align 8
DOCOL:
  ; Since DOCOL is not a normal word, the label points to the value we care
  ; about from the assembly side of things, wich is the address we use as the
  ; codeword.
  PUSHCONTROL rsi
  add.qreg.bimm rax, 8
  mov.qreg.qreg rsi, rax
  NEXT

latest_word = DOCOL_name

;;;
;;;   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.
;;;
defword EXIT, 0
  dq $ + 0x8                     ; codeword
  POPCONTROL rsi
  NEXT


;;;
;;; 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.
;;;
;;;   There is definitely plenty of optimization that could be done.
;;;

defword SWAP, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rax
  pop.qreg rbx
  push.qreg rax
  push.qreg rbx
  NEXT

defword DROP, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rax
  NEXT

defword DROP2, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rax
  pop.qreg rax
  NEXT

; 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.
defword ROLL, 0
  dq $ + 0x8                     ; codeword

  ;   Pop our parameter. The rep instruction takes rcx as its count, so we
  ; reduce copying by using it to hold our count, as well.
  pop.qreg rcx

  ;   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.
  dec.qreg rcx

  ;   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.
  mov.qreg.indexed.qreg rbx, rsp, rcx, 8

  ;   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.
  push.qreg rsi

  ;   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.
  lea.qreg.indexed.qreg rsi, rsp, rcx, 8
  ;   When rcx is 1, we want rsp + 16.
  lea.qreg.disp8.indexed.qreg rdi, 8, rsp, rcx, 8
  ;
  ;   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 movsq

  ; Set everything back.
  cld
  pop.qreg rsi

  ; 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.
  mov.indirect.qreg.qreg rsp, rbx

  ; All done, wow! What a mouthful.
  NEXT

; Rotates "down" (pops its parameter, n; current item then becomes nth 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.
defword UNROLL, 0
  dq $ + 0x8                     ; codeword

  ;   Pop our parameter. The rep instruction takes rcx as its count, so we
  ; reduce copying by using it to hold our count, as well.
  pop.qreg rcx

  ; We have n - 1 items to slide, so decrement rcx. Also, save a copy of it in
  ; rdx after doing that, for later.
  dec.qreg rcx
  mov.qreg.qreg rdx, rcx

  ;   Retrieve the 0th item, for later.
  mov.qreg.indirect.qreg rbx, rsp

  ;   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.
  push.qreg rsi

  ;   Regardless of rcx, we want rsp + 16.
  lea.qreg.disp8.qreg rsi, 16, rsp
  ;   Regardless of rcx, we want rsp + 8.
  lea.qreg.disp8.qreg rdi, 8, rsp

  ;   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 movsq

  ; Restore our original rsi.
  pop.qreg rsi

  ; 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.
  mov.indexed.qreg.qreg rsp, rdx, 8, rbx

  ; All done, wow! What a mouthful.
  NEXT

; Rotates "up" (third item becomes current item)
defword ROLL3, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rax
  pop.qreg rbx
  pop.qreg rcx
  push.qreg rbx
  push.qreg rax
  push.qreg rcx
  NEXT

; Rotates "down" (current item becomes third item)
defword UNROLL3, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rax
  pop.qreg rbx
  pop.qreg rcx
  push.qreg rax
  push.qreg rcx
  push.qreg rbx
  NEXT

defword DUP, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rax
  push.qreg rax
  push.qreg rax
  NEXT

;;;
;;; 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.
;;;

defword ADD, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  add.qreg.qreg rax, rbx
  push.qreg rax
  NEXT

defword SUB, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  sub.qreg.qreg rax, rbx
  push.qreg rax
  NEXT

defword MUL, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rax
  pop.qreg rbx
  mul.rax.qreg rbx
  push.qreg rax
  NEXT

defword DIVMOD, 0
  dq $ + 0x8                     ; codeword
  xor.qreg.qreg rdx, rdx         ; rdx is the high bits of the input; zero it
  pop.qreg rbx
  pop.qreg rax
  div.rdxrax.qreg rbx
  push.qreg rdx                  ; remainder
  push.qreg rax                  ; quotient
  NEXT

;;;
;;; Comparison routines
;;; -------------------
;;;

defword EQ, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  cmp.qreg.qreg rax, rbx
  set.breg.cc al, equal
  and.qreg.bimm rax, 0x01
  push.qreg rax
  NEXT

defword NE, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  cmp.qreg.qreg rax, rbx
  set.breg.cc al, not.equal
  and.qreg.bimm rax, 0x01
  push.qreg rax
  NEXT

defword GT, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  cmp.qreg.qreg rax, rbx
  set.breg.cc al, greater
  and.qreg.bimm rax, 0x01
  push.qreg rax
  NEXT

; Is the top of the stack less than the second item in the stack?
defword LT, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  cmp.qreg.qreg rax, rbx
  set.breg.cc al, less
  and.qreg.bimm rax, 0x01
  push.qreg rax
  NEXT

defword GE, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  set.breg.cc al, greater.equal
  cmp.qreg.qreg rax, rbx
  push.qreg rax
  NEXT

defword LE, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  set.breg.cc al, less.equal
  cmp.qreg.qreg rax, rbx
  push.qreg rax
  NEXT

;;;
;;; Bitwise routines
;;; ----------------
;;;

defword AND, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  and.qreg.qreg rax, rbx
  push.qreg rax
  NEXT

defword OR, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  or.qreg.qreg rax, rbx
  push.qreg rax
  NEXT

defword XOR, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  xor.qreg.qreg rax, rbx
  push.qreg rax
  NEXT

; The HP overloads the name "not", so we follow the Forth convention.
defword INVERT, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rax
  not.qreg rax
  push.qreg rax
  NEXT

;;;
;;; Routine LIT
;;; ------------
;;;

defword LIT, 0
  dq $ + 0x8                     ; codeword
  lodsq
  push.qreg rax
  NEXT

;;;
;;; 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.
;;;

; Address on the top of the stack, value in the second position
defword STORE, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  mov.indirect.qreg.qreg rbx, rax
  NEXT

defword FETCH, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rax
  mov.qreg.indirect.qreg rax, rax
  push.qreg rax
  NEXT

; Address on top, value second
; I might have done it the other way, but this is what Jonesforth does and it
; seems reasonable enough.
defword ADDSTORE, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  add.indirect.qreg.qreg rbx, rax
  NEXT

defword SUBSTORE, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  sub.indirect.qreg.qreg rbx, rax
  NEXT

defword STORE8, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  mov.indirect.qreg.breg rbx, al
  NEXT

defword FETCH8, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  xor.qreg.qreg rax, rax
  mov.breg.indirect.qreg al, rbx
  NEXT

defword STORE16, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  mov.indirect.qreg.wreg rbx, ax
  NEXT

defword FETCH16, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  xor.qreg.qreg rax, rax
  mov.wreg.indirect.qreg ax, rbx
  NEXT

defword STORE32, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  pop.qreg rax
  mov.indirect.qreg.dreg rbx, eax
  NEXT

defword FETCH32, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rbx
  xor.qreg.qreg rax, rax
  mov.dreg.indirect.qreg eax, rbx
  NEXT

;;;;;;;;;;;;;;;;;
;;; Branching ;;;
;;;;;;;;;;;;;;;;;

;   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.
defword BRANCH, 0
  dq $ + 0x8                     ; codeword
  add.qreg.indirect.qreg rsi, rsi
  NEXT

; This should probably be 0BRANCH, but right now the auto-label code is picky.
defword ZBRANCH, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rax
  test.qreg.qreg rax, rax
  ; Please notice the 8-bit branch to the nearby word.
  jmp.cc.rel.bimm zero, BRANCH + 8 - zbranch_after_jmp
zbranch_after_jmp:
  lodsq                          ; just a convenient way to skip rsi forward
  NEXT

;;;
;;;   One of the most charming naming traditions in Forth is that the
;;; top-level word that stays running forever, is called "quit".
;;;
defword QUIT, 0
  dq DOCOL                       ; codeword

  ;;;
  ;;; Although we initialized rbp already, we do so again because we'll want
  ;;; that on subsequent visits to this word - it's the main thing it's for.
  ;;; Keep in mind that rsi is the actual "instruction pointer", and we're
  ;;; leaving it unchanged, we just get rid of everything above it.
  ;;;
  ;dq R0, CONTROL!                ; overwrite rbp to reset the control stack
    ; TODO though the implementation of R0 is trivial, it depends on where we
    ; put the heap, so it can't be hardcoded, we'll have to build it in RAM.
    ; the same therefore goes for anything that needs to call it. so we can't
    ; call it here, now, yet - we have prep work to do first

  ;;;
  ;;; Do the read-eval-print-loop, which is the main body of the Forth
  ;;; interpreter.
  ;;;
  ;dq INTERPRET                   ; run the repl
  dq QUINE

  ;;;
  ;;; If the repl ever exits, do it all again.
  ;;;
  ;dq BRANCH, QUIT - $
  dq SYS_EXIT


;;;;;;;;;;;;;;;;;;;;
;;; System calls ;;;
;;;;;;;;;;;;;;;;;;;;
;;;
;;;   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. We don't save other registers because our
;;; caller should do that, if it cares.
;;;

;;;
;;;   This does the Linux exit() system call, passing it exit code zero.
;;;
defword SYS_EXIT, 0
  dq $ + 0x8                     ; codeword

  mov.b rax, 60                  ; syscall number
  mov.b rdi, 0                   ; exit code
  syscall

  ; In the event we're still here, let's minimize confusion.
  hlt


;;;
;;;   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
;;; writes to file descriptor 1, which is stdout.
;;;
;;;   For our length parameter, we can pop directly from the stack into rdx,
;;; which directly becomes the syscall parameter. For our address parameter,
;;; the syscall wants it in rsi, which we also care about, so we have to do a
;;; little juggling.
;;;
defword SYS_WRITE, 0
  dq $ + 0x8                     ; codeword
  pop.qreg rcx                   ; address from stack
  pop.qreg rdx                   ; length from stack, passed directly
  push.qreg rsi                  ; save rsi
  mov.b rax, 1                   ; syscall number
  mov.qreg.qimm rdi, 1           ; file descriptor
  mov.qreg.qreg rsi, rcx         ; pass address
  syscall
  pop.qreg rsi                   ; restore rsi
  NEXT


;;;;;;;;;;;;;;;;;;;;;;
;;; Ouptut helpers ;;;
;;;;;;;;;;;;;;;;;;;;;;

; In: base address, value
; Out: new base address
defword PACK64, 0
  dq DOCOL                       ; codeword
  dq SWAP, DUP, UNROLL3, STORE, LIT, 8, ADD
  dq EXIT
defword PACK32, 0
  dq DOCOL                       ; codeword
  dq SWAP, DUP, UNROLL3, STORE32, LIT, 4, ADD
  dq EXIT
defword PACK16, 0
  dq DOCOL                       ; codeword
  dq SWAP, DUP, UNROLL3, STORE16, LIT, 2, ADD
  dq EXIT
defword PACK8, 0
  dq DOCOL                       ; codeword
  dq SWAP, DUP, UNROLL3, STORE8, LIT, 1, ADD
  dq EXIT

; In the interests of reducing our executable's size, since a lot of it goes
; to PACK* invocations, we define words that combine LIT with PACK*. This
; shaves roughly 700 bytes as of when it was added.
defword LITPACK64, 0
  dq $ + 0x8                     ; codeword
  lodsq
  push.qreg rax
  BEFORENEXT PACK64
defword LITPACK32, 0
  dq $ + 0x8                     ; codeword
  lodsq
  push.qreg rax
  BEFORENEXT PACK32
defword LITPACK16, 0
  dq $ + 0x8                     ; codeword
  lodsq
  push.qreg rax
  BEFORENEXT PACK16
defword LITPACK8, 0
  dq $ + 0x8                     ; codeword
  lodsq
  push.qreg rax
  BEFORENEXT PACK8


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; (new) Implementation strategy ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;   We assemble the entire file contents in a heap-allocated buffer. When
;;; the file is fully assembled, we output it.
;;;
defword QUINE, 0
  dq DOCOL                       ; codeword

  ; We still have HEAP on the stack. Use it to find HERE...
  dq DUP, LIT, control_stack_size + 0x18, ADD
  ; ... add a constant to HERE in-place, keeping a copy of the pointer ...
  dq DUP, LIT, 0x78, SWAP, ADDSTORE
  ; ... and now we have allocated a block of memory, with its address on the
  ; stack. We also still have HEAP at the bottom of the stack, for future use.

  ; We have one label, and three pieces of information about it: Guessed value,
  ; actual value, and status. We keep them on the stack in this order, from
  ; top to bottom: guess, actual, status. Above that, at the actual top of
  ; the stack, we have a mutable copy of the buffer's address.
  ;
  ; Status is a bit field:
  ;    bit zero is whether it was used before being defined
  ;    bit one is whether it's been defined
  ;    bit two is whether the guessed value wound up equaling the actual value
  dq DUP, LIT, 0, LIT, 0, LIT, 0, LIT, 4, ROLL

  ; This takes an address to write to on the stack and adds an ELF file header
  ; to it, leaving the adjusted address with the size of the header added.
  ; Then it does the same thing with an ELF program header.
  dq ELF_FILE_HEADER, ELF_PROGRAM_HEADER

  ; The two-pass magick.
  dq LIT, file_size - 0x78, ADD
  dq SET_LABEL
  dq DROP, LIT, 4, ROLL, DUP, LIT, 5, UNROLL
  dq ELF_FILE_HEADER, ELF_PROGRAM_HEADER

  ; Drop the copy of the buffer's address.
  dq DROP

  ; Drop the label data.
  dq DROP, DROP, DROP

  ; This takes a buffer's address on the stack, skips an ELF file header and
  ; program header based on hardcoded size, computes an offset (secretly
  ; hardcoded), and writes that offset into an appopriate place in the middle
  ; of those headers. It then returns the length of the used portion of the
  ; buffer.
  dq LIT, 0x78, SWAP

  ; write() from stack-allocated buffer
  dq SYS_WRITE

  ; write() the machine code by using self-reference
  ; TODO do this in a "real" quine way
  dq WRITE_SELF_RAW_H
  dq SYS_WRITE

  dq EXIT

; Stack in:
;   output memory start
;   label actual value
;   label guessed value
;   label status
;   output memory current point
; Stack out:
;   output memory start
;   label actual value
;   label guessed value
;   label status (potentially modified)
;   output memory current point
;   label value for caller to use
defword USE_LABEL, 0
  dq DOCOL

  ; Fetch the status
  dq SWAP
  ; Check the bit that indicates it's been set.
  dq DUP, LIT, 2, AND, ZBRANCH, 12*8

  ; If we're here, it has been set already, so just put the status back...
  dq LIT, 2, UNROLL
  ; Fetch the actual value...
  dq LIT, 4, ROLL, DUP, LIT, 5, UNROLL
  ; ... and exit
  dq EXIT

  ; If we're here, it hasn't been set yet, so mark it used-before-set.
  dq LIT, 1, OR
  ; Put the status back...
  dq SWAP
  ; Fetch the guessed value...
  dq LIT, 3, ROLL, DUP, LIT, 4, UNROLL
  ; ... and exit
  dq EXIT

; Stack in:
;   output memory start
;   label actual value (not yet set)
;   label guessed value
;   label status
;   output memory current point
; Stack out:
;   output memory start
;   label actual value (now set)
;   label guessed value
;   label status (modified)
;   output memory current point
defword SET_LABEL, 0
  dq DOCOL

  ; Compute the current offset, to use as the actual value
  dq DUP, LIT, 6, ROLL, DUP, LIT, 7, UNROLL, SUB

  ; Overwrite the old actual value; keep a copy
  dq LIT, 5, ROLL, DROP, DUP, LIT, 5, UNROLL

  ; Check equality with the guessed value
  dq LIT, 4, ROLL, DUP, LIT, 5, UNROLL, EQ

  ; We don't need to branch. Now we mark the status as having been defined,
  ; and we also set bit 2 if appropriate.
  dq LIT, 4, MUL
  dq LIT, 3, ROLL, OR, LIT, 2, OR, LIT, 2, UNROLL

  dq EXIT


defword HLT, 0
  dq $ + 0x8                     ; codeword
  hlt

defword WRITE_SELF_RAW_H, 0
  dq $ + 0x8                     ; codeword
  mov.qreg.qimm rax, file_size - 0x78
  push.qreg rax
  mov.qreg.qimm rax, elf_header + 0x78
  push.qreg rax
  NEXT


;;;
;;; ELF header
;;;
;;;   This is the top-level ELF header, for the entire file. An ELF always has
;;; exactly one of this header, which is always at the start of the file.
;;;
defword ELF_FILE_HEADER, 0
  dq DOCOL                       ; codeword

  dq LITPACK32, 0x7f bappend "ELF"          ; magic number
  dq LITPACK8, 2                            ; 64-bit
  dq LITPACK8, 1                            ; little-endian
  dq LITPACK8, 1                            ; ELF header format v1
  dq LITPACK8, 0                            ; System-V ABI
  dq LITPACK64, 0                           ; (padding)

  dq LITPACK16, 2                           ; executable
  dq LITPACK16, 0x3e                        ; Intel x86-64
  dq LITPACK32, 1                           ; ELF format version

  ; Compute the entry pointer.
  dq LITPACK64, _start                      ; entry point
    ; The offset of _start. This includes the origin, intentionally.

  dq LITPACK64, 64                          ; program header offset
    ; We place the program header immediately after the ELF header. This
    ; offset is from the start of the file.
  dq LITPACK64, 0                           ; section header offset
  dq LITPACK32, 0                           ; processor flags
  dq LITPACK16, 64                          ; ELF header size
  dq LITPACK16, 56                          ; program header entry size
  dq LITPACK16, 1                           ; number of program header entries
  dq LITPACK16, 0                           ; section header entry size
  dq LITPACK16, 0                           ; number of section header entries
  dq LITPACK16, 0                           ; section name string table index

  dq EXIT


;;;
;;; Program header
;;;
;;;   An ELF program header consists of any number of these entries; they are
;;; always consecutive, but may be anywhere in the file. We always have
;;; exactly one, and it's always right after the ELF file header.
;;;
defword ELF_PROGRAM_HEADER, 0
  dq DOCOL                       ; codeword

  dq LITPACK32, 1                          ; "loadable" segment type
  dq LITPACK32, 0x05                       ; read+execute permission
  dq LITPACK64, 0                          ; offset in file
  dq LITPACK64, $$                         ; virtual address
    ; required, but can be anything, subject to alignment
  dq LITPACK64, 0                          ; physical address (ignored)

  ; Fill in 0 as the file size for now, to avoid unitialized memory.
  dq USE_LABEL, PACK64                     ; size in file
  dq USE_LABEL, PACK64                     ; size in memory

  dq LITPACK64, 0                          ; segment alignment
    ; for relocation, but this doesn't apply to us

  dq EXIT

code_size = $ - code_start
file_size = $ - $$