diff options
| -rw-r--r-- | quine.asm | 55 |
1 files changed, 35 insertions, 20 deletions
diff --git a/quine.asm b/quine.asm index 0d9e38d..7286da3 100644 --- a/quine.asm +++ b/quine.asm @@ -11222,13 +11222,23 @@ defword boot_source, 0x40 ; ; While it might be nice, for performance reasons, to do these in ; assembler, for now it's more important to have them at all. - dq ": over swap dup 3unroll ; " - dq ": pick 2 + dup roll dup 3roll unroll ; " - + dq ": 1- 1 - ; " + dq ": 1+ 1 + ; " dq ": max 2dup >= { swap drop } { drop } if-else ; " dq ": min 2dup <= { swap drop } { drop } if-else ; " - dq ": && * 0 != ; " + dq ": over swap dup 3unroll ; " + dq ": pick 2 + dup roll dup 3roll unroll ; " + ; Standard Forth doesn't have equivalents of our ndrop and ndup. The HP + ; calls them DROPN and DUPN but that doesn't go well with ie. 2dup or 3roll, + ; so we do it like this. + dq ": ndrop { dup } { swap drop 1- } while drop ; " + dq ": ndup dup 1+ swap { dup } " + dq " { swap dup pick 3unroll swap 1- } while 2drop ; " + dq ": 3drop drop drop drop ; " + dq ": 3dup 2 pick 2 pick 2 pick ; " + + dq ": && 0 != swap 0 != * ; " dq ": || | 0 != ; " dq ": not 0 = ; " dq ": negate -1 * ; " @@ -11238,7 +11248,8 @@ defword boot_source, 0x40 ; Some output formatting tools. dq ": space 32 value@ emitstring drop ; " dq ": newline 10 value@ emitstring drop ; " - dq ": indent { dup } { space 1 - } while drop ; " + dq ": indent { dup } { space 1- } while drop ; " + dq ": .hexn 16 swap .base-unsigned ; " ; Some debugging tools. dq ": stack " @@ -11255,7 +11266,7 @@ defword boot_source, 0x40 dq ": next-newer-entry " dq " latest @ " - dq " 2dup = { drop drop 0 exit } if " + dq " 2dup = { 2drop 0 exit } if " dq " { dup { 2dup @ != } if } " dq " { @ } while swap drop ; " @@ -11266,36 +11277,40 @@ defword boot_source, 0x40 dq ": word-heading " dq " dup entry-to-name dup emitstring space " - dq " stringlen 1 + 70 swap - 0 max indent .hex64 newline ; " + dq " stringlen 1+ 70 swap - 0 max indent .hex64 newline ; " dq ": list-dictionary " dq " oldest-entry { dup } " dq " { dup word-heading next-newer-entry } while drop ; " + ; (content end, content start, label start) 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 " 2 indent dup .hex32 dup 4 unroll " + dq " 0 { dup 16 > } " + dq " { dup 7 & 0 = { space } if space " + dq " 2dup + dup 4 pick <= swap 5 pick > && " + dq " { 2dup + 8@ .hex8 } { space space } if-else " + dq " 1+ } while " + dq " newline 5 ndrop ; " + + ; (end, start) + dq ": show-hex-between " + dq " dup 16 1- invert & " + dq " { dup 3 pick >= } " + dq " { 3dup show-hex-row 16 + } while 3 ndrop ; " dq ": describe " dq " dup word-heading " - dq " dup guess-entry-end swap entry-to-execution-token swap " + dq " dup guess-entry-end swap entry-to-execution-token " dq " show-hex-between ; " ;dq ": foo 5 { dup } " - ;dq " { 4 indent 97 value@ emitstring drop newline 1 - } " + ;dq " { 4 indent 97 value@ emitstring drop newline 1- } " ;dq " while drop ; foo " ;dq ": foo 5 6 > { 42 . } if ; foo ' foo forget " ;dq ": foo 5 6 > { 42 } { 69 } if-else . ; foo ' foo forget " ;dq ": foo { 5 . } forever ; foo ' foo forget " - ;dq ": foo 0 { dup 5 > } { dup . 1 + } while drop ; foo ' foo forget " + ;dq ": foo 0 { dup 5 > } { dup . 1+ } while drop ; foo ' foo forget " ;dq "list-dictionary " dq "' indent describe " |