add the beginnings of some word-defining words

Force-Push: yes
Change-Id: I7e4c678c27a87b79a9f2c2aad12bd65d7d5600cc

1 files changed, 201 insertions, 2 deletions

diff --git a/quine.asm b/quine.asm
index 55a3983..7568b37 100644
--- a/quine.asm
+++ b/quine.asm
@@ -874,6 +874,15 @@ macro or.qreg.qreg target, source
   modrm 3, treg, sreg
 end macro
 
+macro or.qreg.bimm target, source
+  qwordreg treg, target
+  rex.w
+  db 0x83
+  modrm 3, 1, treg
+    ; The 4 is part of the opcode.
+  db source
+end macro
+
 macro xor.qreg.qreg target, source
   qwordreg treg, target
   qwordreg sreg, source
@@ -1140,6 +1149,14 @@ macro lea.qreg.disp8.indexed.qreg target, offset, source, index, scale
   end match
 end macro
 
+macro mov.breg.bimm target, source
+  bytereg treg, target
+  db 0xC6
+  modrm 3, 0, treg
+    ; the 0 is part of the opcode
+  db source
+end macro
+
 ; Clear the DF flag. This makes string instructions increment RSI.
 macro cld
   db 0xFC
@@ -1195,6 +1212,15 @@ macro rep operation
   end match
 end macro
 
+macro repnz operation
+  match =scasb, operation
+    db 0xF2 ; rep prefix
+    db 0xAE ; opcode
+  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.
 ;
@@ -1870,8 +1896,16 @@ _start:
 
   align 8
 cold_start:
-;;; TODO this is probably where we should deal with that "heap" that we passed
-;;; on the stack
+  ;;; TODO this is probably where we should deal with that "heap" that we passed
+  ;;; on the stack
+  ;;;   Start defining some words that are allocated at runtime on the heap,
+  ;;; beginning with the minimal set of words needed to define more words.
+  dq litstring, "heap", early_create
+  dq lit, 0x42, early_comma
+  dq litstring, "s0", early_create
+  dq litstring, "r0", early_create
+  dq litstring, "latest", early_create
+  dq litstring, "here", early_create
   dq quit
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2165,6 +2199,16 @@ defword dup, 0
   push.qreg rax
   next
 
+defword dup2, 0
+  dq $ + 8
+  pop.qreg rax
+  pop.qreg rbx
+  push.qreg rbx
+  push.qreg rax
+  push.qreg rbx
+  push.qreg rax
+  next
+
 ;;;
 ;;; Arithmetic routines
 ;;; -------------------
@@ -2319,6 +2363,45 @@ defword lit, 0
   push.qreg rax
   next
 
+defword litstring, 0
+  dq $ + 8
+  ; 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.
+  push.qreg rsi
+
+  ; 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
+  ; scasb, which takes rdi as the address to look at. This means scasb is
+  ; treating its operand as analogous to the destination operand of movs*.
+  mov.qreg.qreg rdi, rsi
+  ; We want to compare for equality with zero; scasb looks in al for the other
+  ; half of the comparison, so we clear rax.
+  xor.qreg.qreg rax, rax
+  ; Counterintuitively, we do need to pass a count. We pass -1, which will
+  ; always work.
+  xor.qreg.qreg rcx, rcx
+  not.qreg rcx
+  ; The DF flag is zero per our Forth execution-model convention, which means
+  ; scasb 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 scasb
+  ; The scasb 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.
+  mov.qreg.qreg rsi, rdi
+
+  ; Finally, we need to align rsi to the next word boundary.
+  add.qreg.bimm rsi, 7
+  and.qreg.bimm rsi, NOT 7
+
+  next
+
 ;;;
 ;;; Memory access routines
 ;;; ----------------------
@@ -2429,6 +2512,23 @@ defword ccopy, 0
   mov.qreg.qreg rsi, rdx
   next
 
+; Stack in:
+;   string address
+; Stack out:
+;   string length including null byte
+defword stringlen, 0
+  dq $ + 8
+  pop.qreg rdi
+  mov.qreg.qreg rbx, rdi
+  xor.qreg.qreg rax, rax
+  xor.qreg.qreg rcx, rcx
+  not.qreg rcx
+  repnz scasb
+  sub.qreg.qreg rdi, rbx
+  push.qreg rdi
+  next
+
+
 ;;;;;;;;;;;;;;;;;
 ;;; Branching ;;;
 ;;;;;;;;;;;;;;;;;
@@ -2505,6 +2605,76 @@ defword early_latest, 0
 defword early_here, 0
   dq docol, early_heap, lit, 32, add, exit
 
+;   Allocate space by incrementing "here", and output a word header in it.
+; Also add it to the "latest" linked list. Use zero as the flag values;
+; callers that want something else can do that themselves.
+;
+;   We'll use the pack* words to do this, the way they update the pointer is
+; convenient.
+;
+;   See "Execution model", above, for reminders of the details of this format.
+; Create is responsible for everything up to the codeword, not including it.
+;
+;   This is surprisingly painful to implement, in terms of stack juggling, but
+; then there's a sense in which it's the core trick to bootstrapping the heap.
+;
+; Stack in:
+;   heap address
+;   name string
+; Stack out:
+;   heap address
+defword early_create, 0
+  dq docol
+  ; Retrieve the values of "here" and "latest".
+  dq swap, early_here, fetch, swap, early_latest, fetch, swap, lit, 4, unroll
+  ; Pack the old value of "latest" as the first field of the header, linking
+  ; from the newly-defined word to the next-newest word.
+  dq pack64
+  ; Pack a null byte as the flags.
+  dq lit, 0, pack8
+  ; Pack another null byte as the start terminator of the name (which is
+  ; terminated at both ends).
+  dq lit, 0, pack8
+  ; Pack the name and its end terminator.
+  dq swap, packstring
+  ; Alignment before the codeword.
+  dq lit, 8, packalign
+  ; Retrieve the value of "here" (which still doesn't reflect our additions),
+  ; and store it at the address of "latest". It's the start of our
+  ; newly-defined word, which makes it the latest word.
+  dq swap, early_here, fetch, swap, early_latest, swap, unroll3, store, swap
+  ; Retrieve the address of "here" again and store our updated value there.
+  dq swap, early_here, swap, unroll3, store
+  dq exit
+
+; Stack in:
+;   heap address
+;   value to append to current word-in-progress
+; Stack out:
+;   heap address
+defword early_comma, 0
+  dq docol
+  ; Retrieve the value of "here" and pack the value there.
+  dq swap, early_here, fetch, swap, unroll3, swap, pack64
+  ; Store the updated value of "here".
+  dq swap, early_here, swap, unroll3, store
+  dq exit
+
+; Stack in:
+;   heap address
+; Stack out:
+;   heap address
+defword early_self_codeword, 0
+  dq docol, early_here, fetch, lit, 8, add, early_comma, exit
+
+; Stack in:
+;   heap address
+;   new value to overwrite "here"
+; Stack out:
+;   heap address
+defword early_here_store, 0
+  dq docol, swap, early_here, swap, unroll3, store, exit
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Now.... what was our original goal, again? ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2620,6 +2790,35 @@ defword pack8, 0
   dq swap, dup, unroll3, store8, lit, 1, add
   dq exit
 
+; Includes the null terminator.
+;
+; Stack in:
+;   base address, string pointer
+; Stack out:
+;   new base address
+defword packstring, 0
+  dq docol
+  dq dup, stringlen, dup
+  ; base/destination, source, length, length
+  dq lit, 4, roll, dup, lit, 5, unroll
+  ; destination, source, length, length, base/destination
+  dq add, lit, 4, unroll
+  ; new base, destination, source, length
+  dq ccopy
+  dq exit
+
+; Stack in:
+;   base address
+;   byte size
+; Stack out:
+;   new base address
+defword packalign, 0
+  dq docol
+  dq dup2, divmod, drop, zbranch, 8*8
+  dq swap, lit, 0, pack8, swap
+  dq branch, -11*8
+  dq drop, 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.