diff options
| -rw-r--r-- | quine.asm | 225 |
1 files changed, 223 insertions, 2 deletions
diff --git a/quine.asm b/quine.asm index 4c68373..9e6469f 100644 --- a/quine.asm +++ b/quine.asm @@ -2383,6 +2383,7 @@ cold_start: dq rbx, pop_reg64 dq rax, rax, xor_reg64_reg64 dq rbx, al, mov_reg8_indirect_reg64 + dq rax, push_reg64 dq pack_next, lit, 8, packalign, early_here_store ; This was "store16". @@ -2397,6 +2398,7 @@ cold_start: dq rbx, pop_reg64 dq rax, rax, xor_reg64_reg64 dq rbx, ax, mov_reg16_indirect_reg64 + dq rax, push_reg64 dq pack_next, lit, 8, packalign, early_here_store ; This was "store32". @@ -2411,6 +2413,7 @@ cold_start: dq rbx, pop_reg64 dq rax, rax, xor_reg64_reg64 dq rbx, eax, mov_reg32_indirect_reg64 + dq rax, push_reg64 dq pack_next, lit, 8, packalign, early_here_store ; This was "store_control_stack". Jonesforth calls it RSP!, which looks as @@ -3025,6 +3028,55 @@ cold_start: dq swap, unroll3, pack_beforenext dq lit, 8, packalign, early_here_store + dq litstring, "unpack64", 0, early_create, early_docol_codeword + dq litstring, "dup", early_find, entry_to_execution_token, early_comma + dq litstring, "@", early_find, entry_to_execution_token, early_comma + dq litstring, "swap", early_find, entry_to_execution_token, early_comma + dq litstring, "lit", early_find, entry_to_execution_token, early_comma + dq lit, 8, early_comma + dq litstring, "+", early_find, entry_to_execution_token, early_comma + dq litstring, "swap", early_find, entry_to_execution_token, early_comma + dq litstring, "exit", early_find, entry_to_execution_token, early_comma + dq early_here, fetch, lit, 8, packalign, early_here_store + + dq litstring, "unpack32", 0, early_create, early_docol_codeword + dq litstring, "dup", early_find, entry_to_execution_token, early_comma + dq litstring, "32@", early_find, entry_to_execution_token, early_comma + dq litstring, "swap", early_find, entry_to_execution_token, early_comma + dq litstring, "lit", early_find, entry_to_execution_token, early_comma + dq lit, 4, early_comma + dq litstring, "+", early_find, entry_to_execution_token, early_comma + dq litstring, "swap", early_find, entry_to_execution_token, early_comma + dq litstring, "exit", early_find, entry_to_execution_token, early_comma + dq early_here, fetch, lit, 8, packalign, early_here_store + + dq litstring, "unpack16", 0, early_create, early_docol_codeword + dq litstring, "dup", early_find, entry_to_execution_token, early_comma + dq litstring, "16@", early_find, entry_to_execution_token, early_comma + dq litstring, "swap", early_find, entry_to_execution_token, early_comma + dq litstring, "lit", early_find, entry_to_execution_token, early_comma + dq lit, 2, early_comma + dq litstring, "+", early_find, entry_to_execution_token, early_comma + dq litstring, "swap", early_find, entry_to_execution_token, early_comma + dq litstring, "exit", early_find, entry_to_execution_token, early_comma + dq early_here, fetch, lit, 8, packalign, early_here_store + + dq litstring, "unpack8", early_create, early_docol_codeword + dq litstring, "dup", early_find, entry_to_execution_token, early_comma + dq litstring, "8@", early_find, entry_to_execution_token, early_comma + dq litstring, "swap", early_find, entry_to_execution_token, early_comma + dq litstring, "lit", early_find, entry_to_execution_token, early_comma + dq lit, 1, early_comma + dq litstring, "+", early_find, entry_to_execution_token, early_comma + dq litstring, "swap", early_find, entry_to_execution_token, early_comma + dq litstring, "exit", early_find, entry_to_execution_token, early_comma + dq early_here, fetch, lit, 8, packalign, early_here_store + + dq litstring, "unpackalign", early_create, early_docol_codeword + dq litstring, "packalign", early_find, entry_to_execution_token, early_comma + dq litstring, "exit", early_find, entry_to_execution_token, early_comma + dq early_here, fetch, lit, 8, packalign, early_here_store + ; The flatassembler names of all these were the same, but without the ; colons, and with underscores instead of hyphens. dq litstring, ":rax", early_keyword @@ -6206,7 +6258,8 @@ cold_start: dq litstring, "exit", early_find, entry_to_execution_token, early_comma dq early_here, fetch, lit, 8, packalign, early_here_store - ;;; Initialize our runtime data structures. + ;;; Here we have some imperative code that runs immediately, to initialize + ;;; some runtime data structures. ; (heap pointer) dq litstring, "allocate-input-buffer-metadata", early_find dq entry_to_execution_token, execute @@ -6229,10 +6282,134 @@ cold_start: dq litstring, "main-input-buffer", swap ; (heap pointer, metadata pointer, string pointer, execution token) dq execute + + dq litstring, "key", early_create, early_docol_codeword dq litstring, "main-input-buffer", early_find, entry_to_execution_token - dq execute + dq early_comma + dq litstring, "dup", early_find, entry_to_execution_token, early_comma + dq litstring, "buffer-logical-start", early_find, entry_to_execution_token + dq early_comma + dq litstring, "@", early_find, entry_to_execution_token, early_comma + dq litstring, "swap", early_find, entry_to_execution_token, early_comma + dq litstring, "dup", early_find, entry_to_execution_token, early_comma + dq litstring, "buffer-logical-end", early_find, entry_to_execution_token + dq early_comma + dq litstring, "@", early_find, entry_to_execution_token, early_comma + dq litstring, "swap", early_find, entry_to_execution_token, early_comma + dq litstring, "3unroll", early_find, entry_to_execution_token, early_comma + dq litstring, "eq", early_find, entry_to_execution_token, early_comma + dq litstring, "0branch", early_find, entry_to_execution_token, early_comma + dq lit, 5*8, early_comma + + ; If the start and end pointers are equal, there is no input; return zero. + ; TODO This would also be the place to call the "refill" word. + ; (metadata pointer) + dq litstring, "drop", early_find, entry_to_execution_token, early_comma + dq litstring, "lit", early_find, entry_to_execution_token, early_comma + dq lit, 0, early_comma + dq litstring, "exit", early_find, entry_to_execution_token, early_comma + + ; The buffer is non-empty, so read a byte from it. + ; (metadata pointer, input pointer) + dq litstring, "dup", early_find, entry_to_execution_token, early_comma + dq litstring, "buffer-logical-start", early_find, entry_to_execution_token + dq early_comma + dq litstring, "@", early_find, entry_to_execution_token, early_comma + dq litstring, "unpack8", early_find, entry_to_execution_token, early_comma + ; (metadata pointer, updated input pointer, result byte) + dq litstring, "swap", early_find, entry_to_execution_token, early_comma + dq litstring, "dup", early_find, entry_to_execution_token, early_comma + dq litstring, "lit", early_find, entry_to_execution_token, early_comma + dq lit, 4, early_comma + dq litstring, "roll", early_find, entry_to_execution_token, early_comma + ; (result byte, updated input pointer, updated input pointer, + ; metadata pointer) + dq litstring, "dup", early_find, entry_to_execution_token, early_comma + dq litstring, "3unroll", early_find, entry_to_execution_token, early_comma + ; (result byte, updated input pointer, metadata pointer, + ; updated input pointer, metadata pointer) + dq litstring, "buffer-physical-end", early_find, entry_to_execution_token + dq early_comma + dq litstring, "@", early_find, entry_to_execution_token, early_comma + dq litstring, "eq", early_find, entry_to_execution_token, early_comma + dq litstring, "0branch", early_find, entry_to_execution_token, early_comma + dq lit, 13*8, early_comma + + ; If the logical start pointer is now equal to the physical end pointer, + ; we want to wrap to the physical start. That's what makes it a circular + ; buffer. + ; + ; However, we skip over this behavior if the logical start is also equal to + ; the logical end. Otherwise it would loop forever, re-reading the same + ; input. + ; (result byte, updated input pointer, metadata pointer) + dq litstring, "2dup", early_find, entry_to_execution_token, early_comma + dq litstring, "buffer-logical-end", early_find, entry_to_execution_token + dq early_comma + dq litstring, "@", early_find, entry_to_execution_token, early_comma + dq litstring, "ne", early_find, entry_to_execution_token, early_comma + dq litstring, "0branch", early_find, entry_to_execution_token, early_comma + dq lit, 7*8, early_comma + + ; (result byte, updated input pointer, metadata pointer) + ; Here's the part where we swap in the physical start. + dq litstring, "swap", early_find, entry_to_execution_token, early_comma + dq litstring, "drop", early_find, entry_to_execution_token, early_comma + dq litstring, "dup", early_find, entry_to_execution_token, early_comma + dq litstring, "buffer-physical-start", early_find, entry_to_execution_token + dq early_comma + dq litstring, "@", early_find, entry_to_execution_token, early_comma + dq litstring, "swap", early_find, entry_to_execution_token, early_comma + ; Fall through to the other half of both branches. + + ; However we got here, save the updated logical end pointer. + ; (result byte, updated input pointer, metadata pointer) + dq litstring, "buffer-logical-start", early_find, entry_to_execution_token + dq early_comma + dq litstring, "!", early_find, entry_to_execution_token, early_comma + + dq litstring, "exit", early_find, entry_to_execution_token, early_comma + dq early_here, fetch, lit, 8, packalign, early_here_store + + dq lit, 0, sys_exit + ;;; TODO rethink this, it needs to not use space on the value stack + ;; Stack-allocate a buffer. + ;; + ;; For brevity's sake, in notation below here when we give the contents of + ;; the stack we'll leave out the original copy of the heap pointer, and the + ;; four words used for the buffer. + ;dq lit, 0, lit, 0, lit, 0, lit, 0, fetch_value_stack + ;; Make a copy of the heap pointer so we can have it a little closer. If we + ;; instead were to try to get to the copy on the other side of the buffer by + ;; rolling, it would move the buffer, invalidating the pointers. + ;dq lit, 6, roll, dup, lit, 7, unroll, swap + ;dq dup + ;dq lit, boot_source + ;; (heap pointer, buffer start pointer, buffer end pointer, input pointer) + ; + ;; Start of the loop + ;dq key ; 1 word + ; + ;; (heap pointer, buffer start pointer, buffer end pointer, + ;; input pointer, input byte) + ;dq dup, lit, " ", ne, zbranch, 13*8 ; 6 words + ;dq dup, lit, 0x0a, ne, zbranch, 7*8 ; 6 words + ; + ;; If we got here, it's a body character. + ;dq roll3, swap, pack8, swap, branch, -18*8 ; 6 words + ; + ;; If we got here, it's a space character. + ;dq drop, swap, lit, 0, pack8 ; 5 words + ;dq swap, roll3, dup, lit, 4, unroll ; 6 words + ; + ;; (heap pointer, buffer start pointer, buffer end pointer, + ;; input pointer, word pointer) + ;dq lit, 5, roll, swap, early_find, swap, lit, 5, unroll ; 8 words + ;dq entry_to_execution_token, execute ; 2 words + ;dq branch, -41*8 + ;;; For triage's sake, here's an inventory of everything else in the file. ;;; ;;; Macros: @@ -6982,6 +7159,7 @@ defword fetch8, 0 pop.qreg rbx xor.qreg.qreg rax, rax mov.breg.indirect.qreg al, rbx + push.qreg rax next defword store16, 0 @@ -6996,6 +7174,7 @@ defword fetch16, 0 pop.qreg rbx xor.qreg.qreg rax, rax mov.wreg.indirect.qreg ax, rbx + push.qreg rax next defword store32, 0 @@ -7010,6 +7189,7 @@ defword fetch32, 0 pop.qreg rbx xor.qreg.qreg rax, rax mov.dreg.indirect.qreg eax, rbx + push.qreg rax next ; Before we get too deep into it, we also define a few reflection routines @@ -7685,6 +7865,47 @@ defword litpack8, 0 beforenext pack8 +;;;;;;;;;;;;;;;;;;;;; +;;; Input helpers ;;; +;;;;;;;;;;;;;;;;;;;;; +;;; +;;; These routines are for examining data structures in-memory. +;;; +;;; Similarly to the output routines, each routine takes an input address, +;;; which it updates to point after the data item being read. Since this is +;;; input, the routines return data items rather than accepting them. + +; In: base address +; Out: new base address, value +defword unpack64, 0 + dq docol + dq dup, fetch, swap, lit, 8, add, swap + dq exit +defword unpack32, 0 + dq docol + dq dup, fetch32, swap, lit, 4, add, swap + dq exit +defword unpack16, 0 + dq docol + dq dup, fetch16, swap, lit, 2, add, swap + dq exit +defword unpack8, 0 + dq docol + dq dup, fetch8, swap, lit, 1, add, swap + dq exit + +; Since there's no data, this is identical to its output version, but we +; allow this name as an alias for clarity. +; +; Stack in: +; base address +; byte size +; Stack out: +; new base address +defword unpackalign, 0 + dq docol, packalign, exit + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Assembly language, but in Forth ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |