summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--quine.asm47
1 files changed, 46 insertions, 1 deletions
diff --git a/quine.asm b/quine.asm
index 2f3dfd5..41d2ea6 100644
--- a/quine.asm
+++ b/quine.asm
@@ -11190,10 +11190,55 @@ defword boot_source, 0x40
   dq "  6 8 * + swap drop + swap drop -1 * ,                          "
   dq "  ; make-immediate                                              "
 
+  ;   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 ": max 2dup >= { swap drop } { drop } if-else ;                  "
+  dq ": min 2dup <= { swap drop } { drop } if-else ;                  "
+
+  dq ": not 0 = ;                                                     "
+  dq ": negate -1 * ;                                                 "
+
+  ; This use of bitwise and is valid because the inputs are 0 or 1.
+  dq ": is-in-heap dup heap @ <= swap here @ > and ;                  "
+
+  dq ": space 32 value@ emitstring drop ;                             "
+  dq ": newline 10 value@ emitstring drop ;                           "
+  dq ": indent { dup } { space 1 - } while drop ;                     "
+
+  dq ": stack                                                         "
+  dq "  s0 @ 8 - { dup value@ 8 + != }                                "
+  dq "  { dup s0 @ 8 - != { space } if dup @ . 8 - }                  "
+  dq "  while drop newline ;                                          "
+  dq ": stackhex                                                      "
+  dq "  s0 @ 8 - { dup value@ 8 + != }                                "
+  dq "  { dup s0 @ 8 - != { space } if dup @ .hex64 8 - }             "
+  dq "  while drop newline ;                                          "
+
+  dq ": oldest-entry                                                  "
+  dq "  latest @ { dup @ } { @ } while ;                              "
+
+  dq ": next-newer-entry                                              "
+  dq "  latest @                                                      "
+  dq "  2dup = { drop drop 0 exit } if                                "
+  dq "  { dup { 2dup @ != } if }                                      "
+  dq "  { @ } while swap drop ;                                       "
+
+  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 ": foo 5 { dup }                                                 "
+  ;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              "
+  ;dq ": foo 0 { dup 5 > } { dup . 1 + } while drop ; foo ' foo forget "
 
   dq "                                                                "