diff options
Diffstat (limited to 'quine.asm')
| -rw-r--r-- | quine.asm | 52 |
1 files changed, 47 insertions, 5 deletions
diff --git a/quine.asm b/quine.asm index d11ba48..a2cb18f 100644 --- a/quine.asm +++ b/quine.asm @@ -11126,6 +11126,21 @@ defword boot_source, 0x40 ; (old here, length) dq " drop 5 8 * + here ! ; make-immediate " + ; (start pointer, length) + dq ": unless 2dup swap dup 5 8 * + 3unroll swap " + ; (start pointer, length, start pointer, adjusted start pointer, length) + dq " memmove " + ; (start pointer, length) + dq " swap here @ swap here ! swap " + ; (old here, length) + dq " ' lit entry-to-execution-token , 0 , " + dq " ' = entry-to-execution-token , " + ; The branch length needs to be one word longer than the block length, + ; because the length field itself is part of the scope of the branch. + dq " ' 0branch entry-to-execution-token , dup 8 + , " + ; (old here, length) + dq " drop 5 8 * + here ! ; make-immediate " + ; (true start, true length, false start, false length) dq ": if-else " ;dq " dup 4 roll dup 5 unroll + " @@ -11200,7 +11215,7 @@ defword boot_source, 0x40 dq " { dup @ is-in-heap } { @ } while " dq " 0 swap ! ; " ; Do it immediately, so that we don't accidentally rely on any of that. - dq "unlink-pre-heap-words " + ;dq "unlink-pre-heap-words " ; Now some fancier stack combinators. ; @@ -11215,6 +11230,8 @@ defword boot_source, 0x40 dq ": not 0 = ; " dq ": negate -1 * ; " + dq ": align-floor dup 3unroll /% swap drop * ; " + ; Some output formatting tools. dq ": space 32 value@ emitstring drop ; " dq ": newline 10 value@ emitstring drop ; " @@ -11239,11 +11256,35 @@ defword boot_source, 0x40 dq " { dup { 2dup @ != } if } " dq " { @ } while swap drop ; " + dq ": guess-entry-end " + dq " dup entry-flags@ 64 and 64 = { exit } if " + dq " dup next-newer-entry dup { drop exit } unless " + dq " swap drop ; " + + dq ": word-heading " + dq " dup entry-to-name dup emitstring space " + dq " stringlen 1 + 70 swap - 0 max indent .hex64 newline ; " + dq ": list-dictionary " dq " oldest-entry { dup } " - dq " { dup entry-to-name dup emitstring space " - dq " stringlen 1 + 70 swap - 0 max indent dup .hex64 newline " - dq " next-newer-entry } while drop ; " + dq " { dup word-heading next-newer-entry } while drop ; " + + dq ": show-hex-row " + ; TODO string literals would be nice + dq " 2 indent over .hex64 58 value@ emitstring drop " + dq " 0 { dup 4 > } " + dq " { space 2 pick over + @ .hex64 " + dq " 1 + } while newline drop drop drop ; " + + dq ": show-hex-between stackhex " + dq " { 2dup > } " + dq " { 2dup show-hex-row swap 32 + swap } while drop drop ; " + ;dq " { space over .hex64 swap 8 + swap } while drop drop ; " + + dq ": describe " + dq " dup word-heading " + dq " dup guess-entry-end swap entry-to-execution-token swap " + dq " show-hex-between ; " ;dq ": foo 5 { dup } " ;dq " { 4 indent 97 value@ emitstring drop newline 1 - } " @@ -11253,7 +11294,8 @@ defword boot_source, 0x40 ;dq ": foo { 5 . } forever ; foo ' foo forget " ;dq ": foo 0 { dup 5 > } { dup . 1 + } while drop ; foo ' foo forget " - dq "unlink-pre-heap-words list-dictionary " + ;dq "list-dictionary " + dq "' indent describe " dq " " ; TODO define ( ... ) comments |