invoke the heap-based docol as part of the heap copy

this adds an "execute" word, which makes execution tokens useful for something

it also builds "emitstring" on the heap, at runtime, to test that that
all works properly

Force-Push: yes
Change-Id: Ic59a489c0a035a4174db516aeef77e23c7d8528b

1 files changed, 34 insertions, 6 deletions

diff --git a/quine.asm b/quine.asm
index ff2ab50..b5822cb 100644
--- a/quine.asm
+++ b/quine.asm
@@ -1799,7 +1799,7 @@ _start:
   mov.qreg.qimm 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.qreg.qimm rdx, 0x07                    ; protection (read+write+execute)
   mov.oreg.qimm r10, 0x22                    ; flags (private+anonymous)
   mov.oreg.qimm r8, 0                        ; file descriptor (ignored)
   mov.oreg.qimm r9, 0                        ; offset (ignored)
@@ -2403,6 +2403,12 @@ cold_start:
   dq lods64
   dq pack_next, lit, 8, packalign, early_here_store
 
+  dq litstring, "execute", early_create, early_self_codeword, early_here
+  dq fetch
+  dq rax, pop_reg64
+  dq rax, jmp_abs_indirect_reg64
+  dq lit, 8, packalign, early_here_store
+
   ; This name is exactly eight bytes long. Don't even ask (go read litstring's
   ; code if you really need to know).
   dq litstring, "sys_exit", 0, early_create, early_self_codeword, early_here
@@ -2425,10 +2431,13 @@ cold_start:
   dq rsi, pop_reg64
   dq pack_next, lit, 8, packalign, early_here_store
 
-  dq litstring, "emitstring", early_create, early_self_codeword, early_here
-  dq fetch
-  ; TODO this is actually in Forth
-  dq lit, 8, packalign, early_here_store
+  dq litstring, "emitstring", early_create, early_docol_codeword
+  dq litstring, "dup", early_find, early_comma
+  dq litstring, "stringlen", early_find, early_comma
+  dq litstring, "swap", early_find, early_comma
+  dq litstring, "sys_write", early_find, early_comma
+  dq litstring, "exit", early_find, early_comma
+  dq early_here, fetch, lit, 8, packalign, early_here_store
 
   dq litstring, "crash", early_create, early_self_codeword, early_here, fetch
   ; TODO
@@ -3400,6 +3409,15 @@ zbranch_after_jmp:
   lodsq                          ; just a convenient way to skip rsi forward
   next
 
+; This is like next, but instead of using rsi as the "instruction pointer", it
+; takes a codeword address from the value stack.
+;
+; In the event that the codeword is docol, docol will handle any manipulation
+; of the control stack that needs to happen. Yes, it really is that simple.
+defword execute, 0
+  dq $ + 8
+  pop.qreg rax
+  jmp.abs.indirect.qreg rax
 
 ;;;;;;;;;;;;;;;;;;;;
 ;;; System calls ;;;
@@ -4791,6 +4809,16 @@ defword early_self_codeword, 0
 
 ; Stack in:
 ;   heap address
+; Stack out:
+;   heap address
+defword early_docol_codeword, 0
+  dq docol
+  dq litstring, "docol", early_find
+  dq entry_to_execution_token, execute, early_comma
+  dq exit
+
+; Stack in:
+;   heap address
 ;   new value to overwrite "here"
 ; Stack out:
 ;   heap address
@@ -5132,7 +5160,7 @@ defword output_start_routine, 0
   dq lit, 9, rax, mov_reg64_imm64
   dq lit, heap_requested_address, rdi, mov_reg64_imm64
   dq lit, heap_size, rsi, mov_reg64_imm64
-  dq lit, 0x03, rdx, mov_reg64_imm64
+  dq lit, 0x07, rdx, mov_reg64_imm64
   dq lit, 0x22, r10, mov_extrareg64_imm64
   dq lit, 0, r8, mov_extrareg64_imm64
   dq lit, 0, r9, mov_extrareg64_imm64