a convenience macro for word headers

Force-Push: yes
Change-Id: Ifda1a168808d541f8899a06d39bb9d13733dbadc

1 files changed, 33 insertions, 35 deletions

diff --git a/quine.asm b/quine.asm
index 2f4015d..634f660 100644
--- a/quine.asm
+++ b/quine.asm
@@ -1181,6 +1181,32 @@ cold_start:
 ;;; 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
 ;;; -------------
@@ -1208,11 +1234,7 @@ cold_start:
 ;;;
 ;;; * rsi is the callee's instruction pointer
 ;;; * rbp is the control stack pointer
-  align 8
-DOCOL_name:
-  dq 0                  ; This is the very first word, so its link is null.
-  db 0x00, "DOCOL", 0x00
-  align 8
+defword_unlabeled DOCOL, 0
 DOCOL_constant:
   ; Evaluated as a word, DOCOL is a constant which returns a pointer.
   dq $ + 0x8                     ; codeword
@@ -1229,18 +1251,14 @@ DOCOL:
   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.
 ;;;
-  align 8
-EXIT_name:
-  dq DOCOL_name
-  db 0x00, "EXIT", 0x00
-  align 8
-EXIT:
+defword EXIT, 0
   dq $ + 0x8                     ; codeword
   POPCONTROL rsi
   NEXT
@@ -1249,12 +1267,7 @@ EXIT:
 ;;;   One of the most charming naming traditions in Forth is that the
 ;;; top-level word that stays running forever, is called "quit".
 ;;;
-  align 8
-QUIT_name:
-  dq EXIT_name
-  db 0x00, "QUIT", 0x00
-  align 8
-QUIT:
+defword QUIT, 0
   dq DOCOL                       ; codeword
 
   ;;;
@@ -1286,12 +1299,7 @@ QUIT:
 ;;;
 ;;; This does the Linux exit() system call, passing it exit code zero.
 ;;;
-  align 8
-SYS_EXIT_name:
-  dq QUIT_name
-  db 0x00, "SYS_EXIT", 0x00
-  align 8
-SYS_EXIT:
+defword SYS_EXIT, 0
   dq $ + 0x8                     ; codeword
 
   mov.b rax, 60                  ; syscall number
@@ -1306,12 +1314,7 @@ SYS_EXIT:
 ;;; (new) Implementation strategy ;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
-  align 8
-QUINE_name:
-  dq SYS_EXIT_name
-  db 0x00, "QUINE", 0x00
-  align 8
-QUINE:
+defword QUINE, 0
   dq DOCOL                       ; codeword
   dq OLD_CODE
   dq EXIT
@@ -1339,12 +1342,7 @@ QUINE:
 ;;;
 ;;; * rcx points to the bottom of the buffer.
 ;;;
-  align 8
-OLD_CODE_name:
-  dq QUINE_name
-  db 0x00, "OLD_CODE", 0x00
-  align 8
-OLD_CODE:
+defword OLD_CODE, 0
   dq $ + 0x8                     ; codeword
 
   mov.qreg.qreg rcx, rdi