From dd60caa3f51c5117c0193f8f3272e1c7f5230eb7 Mon Sep 17 00:00:00 2001 From: Kartik Agaram Date: Tue, 15 Jun 2021 21:50:13 -0700 Subject: . --- html/shell/cell.mu.html | 14 +- html/shell/environment.mu.html | 1459 +++++++++++----- html/shell/evaluate.mu.html | 3397 ++++++++++++++++++------------------ html/shell/gap-buffer.mu.html | 2116 +++++++++++------------ html/shell/global.mu.html | 1112 ++++++------ html/shell/grapheme-stack.mu.html | 52 +- html/shell/macroexpand.mu.html | 68 +- html/shell/main.mu.html | 14 +- html/shell/parse.mu.html | 42 +- html/shell/primitives.mu.html | 3412 +++++++++++++++++++++---------------- html/shell/print.mu.html | 6 +- html/shell/read.mu.html | 2 +- html/shell/sandbox.mu.html | 1969 +++++++++++---------- html/shell/tokenize.mu.html | 2113 ++++++++++++----------- html/shell/trace.mu.html | 426 ++--- 15 files changed, 8700 insertions(+), 7502 deletions(-) (limited to 'html/shell') diff --git a/html/shell/cell.mu.html b/html/shell/cell.mu.html index ec5bbc40..ffc4ba02 100644 --- a/html/shell/cell.mu.html +++ b/html/shell/cell.mu.html @@ -17,10 +17,10 @@ a { color:inherit; } .PreProc { color: #c000c0; } .Special { color: #ff6060; } .LineNr { } -.muRegEsi { color: #87d787; } .Constant { color: #008787; } -.muRegEax { color: #875f00; } .muRegEcx { color: #af875f; } +.muRegEsi { color: #87d787; } +.muRegEax { color: #875f00; } .Delimiter { color: #c000c0; } .muFunction { color: #af5f00; text-decoration: underline; } .muComment { color: #005faf; } @@ -219,10 +219,10 @@ if ('onhashchange' in window) { 158 var dest-ah/eax: (addr handle screen) <- get out-addr, screen-data 159 allocate dest-ah 160 var dest-addr/eax: (addr screen) <- lookup *dest-ah -161 initialize-screen dest-addr, width, height, pixel-graphics? +161 initialize-screen dest-addr, width, height, pixel-graphics? 162 } 163 -164 fn clear-screen-cell _self-ah: (addr handle cell) { +164 fn clear-screen-var _self-ah: (addr handle cell) { 165 var self-ah/eax: (addr handle cell) <- copy _self-ah 166 var self/eax: (addr cell) <- lookup *self-ah 167 compare self, 0 @@ -232,7 +232,7 @@ if ('onhashchange' in window) { 171 } 172 var screen-ah/eax: (addr handle screen) <- get self, screen-data 173 var screen/eax: (addr screen) <- lookup *screen-ah -174 clear-screen screen +174 clear-screen screen 175 } 176 177 fn allocate-keyboard _out: (addr handle cell) { @@ -253,7 +253,7 @@ if ('onhashchange' in window) { 192 initialize-gap-buffer dest-addr, capacity 193 } 194 -195 fn rewind-keyboard-cell _self-ah: (addr handle cell) { +195 fn rewind-keyboard-var _self-ah: (addr handle cell) { 196 var self-ah/eax: (addr handle cell) <- copy _self-ah 197 var self/eax: (addr cell) <- lookup *self-ah 198 compare self, 0 @@ -263,7 +263,7 @@ if ('onhashchange' in window) { 202 } 203 var keyboard-ah/eax: (addr handle gap-buffer) <- get self, keyboard-data 204 var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah -205 rewind-gap-buffer keyboard +205 rewind-gap-buffer keyboard 206 } diff --git a/html/shell/environment.mu.html b/html/shell/environment.mu.html index 7fd41c4d..5c0c1ff7 100644 --- a/html/shell/environment.mu.html +++ b/html/shell/environment.mu.html @@ -16,18 +16,19 @@ a { color:inherit; } * { font-size:12pt; font-size: 1em; } .LineNr { } .Delimiter { color: #c000c0; } -.muFunction { color: #af5f00; text-decoration: underline; } +.CommentedCode { color: #8a8a8a; } +.muRegEdx { color: #878700; } .muRegEbx { color: #8787af; } .muRegEsi { color: #87d787; } .muRegEdi { color: #87ffd7; } .Constant { color: #008787; } .Special { color: #ff6060; } .PreProc { color: #c000c0; } -.CommentedCode { color: #8a8a8a; } +.muFunction { color: #af5f00; text-decoration: underline; } +.muTest { color: #5f8700; } .muComment { color: #005faf; } .muRegEax { color: #875f00; } .muRegEcx { color: #af875f; } -.muRegEdx { color: #878700; } --> @@ -63,429 +64,1035 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/main/shell/environment.mu 
-  1 type environment {
-  2   globals: global-table
-  3   sandbox: sandbox
-  4   partial-function-name: (handle gap-buffer)
-  5   cursor-in-globals?: boolean
-  6   cursor-in-function-modal?: boolean
-  7 }
-  8 
-  9 fn initialize-environment _self: (addr environment) {
- 10   var self/esi: (addr environment) <- copy _self
- 11   var globals/eax: (addr global-table) <- get self, globals
- 12   initialize-globals globals
- 13   var sandbox/eax: (addr sandbox) <- get self, sandbox
- 14   initialize-sandbox sandbox, 1/with-screen
- 15   var partial-function-name-ah/eax: (addr handle gap-buffer) <- get self, partial-function-name
- 16   allocate partial-function-name-ah
- 17   var partial-function-name/eax: (addr gap-buffer) <- lookup *partial-function-name-ah
- 18   initialize-gap-buffer partial-function-name, 0x40/function-name-capacity
- 19 }
- 20 
- 21 fn render-environment screen: (addr screen), _self: (addr environment) {
- 22   # globals layout: 1 char padding, 41 code, 1 padding, 41 code, 1 padding =  85
- 23   # sandbox layout: 1 padding, 41 code, 1 padding                          =  43
- 24   #                                                                  total = 128 chars
- 25   var self/esi: (addr environment) <- copy _self
- 26   var cursor-in-globals-a/eax: (addr boolean) <- get self, cursor-in-globals?
- 27   var cursor-in-globals?/eax: boolean <- copy *cursor-in-globals-a
- 28   var globals/ecx: (addr global-table) <- get self, globals
- 29   render-globals screen, globals, cursor-in-globals?
- 30   var sandbox/edx: (addr sandbox) <- get self, sandbox
- 31   var cursor-in-sandbox?/ebx: boolean <- copy 1/true
- 32   cursor-in-sandbox? <- subtract cursor-in-globals?
- 33   render-sandbox screen, sandbox, 0x55/sandbox-left-margin, 0/sandbox-top-margin, 0x80/screen-width, 0x2f/screen-height-without-menu, cursor-in-sandbox?
- 34   # modal if necessary
- 35   {
- 36     var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
- 37     compare *cursor-in-function-modal-a, 0/false
- 38     break-if-=
- 39     render-function-modal screen, self
- 40     render-function-modal-menu screen, self
- 41     return
- 42   }
- 43   # render menu
- 44   {
- 45     var cursor-in-globals?/eax: (addr boolean) <- get self, cursor-in-globals?
- 46     compare *cursor-in-globals?, 0/false
- 47     break-if-=
- 48     render-globals-menu screen, globals
- 49     return
- 50   }
- 51   render-sandbox-menu screen, sandbox
- 52 }
- 53 
- 54 fn edit-environment _self: (addr environment), key: grapheme, data-disk: (addr disk) {
- 55   var self/esi: (addr environment) <- copy _self
- 56   var globals/edi: (addr global-table) <- get self, globals
- 57   var sandbox/ecx: (addr sandbox) <- get self, sandbox
- 58   # ctrl-r
- 59   # Assumption: 'real-screen' and 'real-keyboard' are 0
- 60   {
- 61     compare key, 0x12/ctrl-r
- 62     break-if-!=
- 63     var tmp/eax: (addr handle cell) <- copy 0
- 64     var nil: (handle cell)
- 65     tmp <- address nil
- 66     allocate-pair tmp
- 67     # (main real-screen real-keyboard)
- 68     var real-keyboard: (handle cell)
- 69     tmp <- address real-keyboard
- 70     allocate-keyboard tmp
- 71     # args = cons(real-keyboard, nil)
- 72     var args: (handle cell)
- 73     tmp <- address args
- 74     new-pair tmp, real-keyboard, nil
- 75     #
- 76     var real-screen: (handle cell)
- 77     tmp <- address real-screen
- 78     allocate-screen tmp
- 79     #  args = cons(real-screen, args)
- 80     tmp <- address args
- 81     new-pair tmp, real-screen, *tmp
- 82     #
- 83     var main: (handle cell)
- 84     tmp <- address main
- 85     new-symbol tmp, "main"
- 86     # args = cons(main, args)
- 87     tmp <- address args
- 88     new-pair tmp, main, *tmp
- 89     # clear real screen
- 90     clear-screen 0/screen
- 91     set-cursor-position 0/screen, 0, 0
- 92     # run
- 93     var out: (handle cell)
- 94     var out-ah/ecx: (addr handle cell) <- address out
- 95     var trace-storage: trace
- 96     var trace/ebx: (addr trace) <- address trace-storage
- 97     initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
- 98     evaluate tmp, out-ah, nil, globals, trace, 0/no-fake-screen, 0/no-fake-keyboard, 0/call-number
- 99     # wait for a keypress
-100     {
-101       var tmp/eax: byte <- read-key 0/keyboard
-102       compare tmp, 0
-103       loop-if-=
-104     }
-105     #
-106     return
-107   }
-108   # ctrl-s: send multiple places
-109   {
-110     compare key, 0x13/ctrl-s
-111     break-if-!=
-112     {
-113       # cursor in function modal? do nothing
-114       var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
-115       compare *cursor-in-function-modal-a, 0/false
-116       break-if-!=
-117       {
-118         # cursor in globals? update current definition
-119         var cursor-in-globals-a/edx: (addr boolean) <- get self, cursor-in-globals?
-120         compare *cursor-in-globals-a, 0/false
-121         break-if-=
-122         edit-globals globals, key
-123       }
-124       # update sandbox whether the cursor is in globals or sandbox
-125       edit-sandbox sandbox, key, globals, data-disk, 1/tweak-real-screen
-126     }
-127     return
-128   }
-129   # ctrl-g: go to a function (or the repl)
-130   {
-131     compare key, 7/ctrl-g
-132     break-if-!=
-133     var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
-134     compare *cursor-in-function-modal-a, 0/false
-135     break-if-!=
-136     # look for a word to prepopulate the modal
-137     var current-word-storage: (stream byte 0x40)
-138     var current-word/edi: (addr stream byte) <- address current-word-storage
-139     word-at-cursor self, current-word
-140     var partial-function-name-ah/eax: (addr handle gap-buffer) <- get self, partial-function-name
-141     var partial-function-name/eax: (addr gap-buffer) <- lookup *partial-function-name-ah
-142     clear-gap-buffer partial-function-name
-143     load-gap-buffer-from-stream partial-function-name, current-word
-144     # enable the modal
-145     var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
-146     copy-to *cursor-in-function-modal-a, 1/true
-147     return
-148   }
-149   # dispatch to function modal if necessary
-150   {
-151     var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
-152     compare *cursor-in-function-modal-a, 0/false
-153     break-if-=
-154     # nested events for modal dialog
-155     # ignore spaces
-156     {
-157       compare key, 0x20/space
-158       break-if-!=
-159       return
-160     }
-161     # esc = exit modal dialog
-162     {
-163       compare key, 0x1b/escape
-164       break-if-!=
-165       var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
-166       copy-to *cursor-in-function-modal-a, 0/false
-167       return
-168     }
-169     # enter = switch to function name and exit modal dialog
-170     {
-171       compare key, 0xa/newline
-172       break-if-!=
-173       var cursor-in-globals-a/edx: (addr boolean) <- get self, cursor-in-globals?
-174       copy-to *cursor-in-globals-a, 1/true
-175       var partial-function-name-ah/eax: (addr handle gap-buffer) <- get self, partial-function-name
-176       var partial-function-name/eax: (addr gap-buffer) <- lookup *partial-function-name-ah
-177       {
-178         {
-179           var empty?/eax: boolean <- gap-buffer-empty? partial-function-name
-180           compare empty?, 0/false
-181         }
-182         break-if-!=
-183         set-global-cursor-index globals, partial-function-name
-184       }
-185       var cursor-in-globals-a/ecx: (addr boolean) <- get self, cursor-in-globals?
-186       copy-to *cursor-in-globals-a, 1/true
-187       {
-188         var empty?/eax: boolean <- gap-buffer-empty? partial-function-name
-189         compare empty?, 0/false
-190         break-if-=
-191         copy-to *cursor-in-globals-a, 0/false
-192       }
-193       clear-gap-buffer partial-function-name
-194       var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
-195       copy-to *cursor-in-function-modal-a, 0/false
-196       return
-197     }
-198     # otherwise process like a regular gap-buffer
-199     var partial-function-name-ah/eax: (addr handle gap-buffer) <- get self, partial-function-name
-200     var partial-function-name/eax: (addr gap-buffer) <- lookup *partial-function-name-ah
-201     edit-gap-buffer partial-function-name, key
-202     return
-203   }
-204   # dispatch the key to either sandbox or globals
-205   {
-206     var cursor-in-globals-a/eax: (addr boolean) <- get self, cursor-in-globals?
-207     compare *cursor-in-globals-a, 0/false
-208     break-if-=
-209     edit-globals globals, key
-210     return
-211   }
-212   edit-sandbox sandbox, key, globals, data-disk, 1/tweak-real-screen
-213 }
-214 
-215 fn word-at-cursor _self: (addr environment), out: (addr stream byte) {
-216   var self/esi: (addr environment) <- copy _self
-217   var cursor-in-function-modal-a/eax: (addr boolean) <- get self, cursor-in-function-modal?
-218   compare *cursor-in-function-modal-a, 0/false
-219   {
-220     break-if-=
-221     # cursor in function modal
-222     return
-223   }
-224   var cursor-in-globals-a/edx: (addr boolean) <- get self, cursor-in-globals?
-225   compare *cursor-in-globals-a, 0/false
-226   {
-227     break-if-=
-228     # cursor in some function editor
-229     var globals/eax: (addr global-table) <- get self, globals
-230     var cursor-index-addr/ecx: (addr int) <- get globals, cursor-index
-231     var cursor-index/ecx: int <- copy *cursor-index-addr
-232     var globals-data-ah/eax: (addr handle array global) <- get globals, data
-233     var globals-data/eax: (addr array global) <- lookup *globals-data-ah
-234     var cursor-offset/ecx: (offset global) <- compute-offset globals-data, cursor-index
-235     var curr-global/eax: (addr global) <- index globals-data, cursor-offset
-236     var curr-global-data-ah/eax: (addr handle gap-buffer) <- get curr-global, input
-237     var curr-global-data/eax: (addr gap-buffer) <- lookup *curr-global-data-ah
-238     word-at-gap curr-global-data, out
-239     return
-240   }
-241   # cursor in sandbox
-242   var sandbox/ecx: (addr sandbox) <- get self, sandbox
-243   var sandbox-data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
-244   var sandbox-data/eax: (addr gap-buffer) <- lookup *sandbox-data-ah
-245   word-at-gap sandbox-data, out
-246 }
-247 
-248 fn render-function-modal screen: (addr screen), _self: (addr environment) {
-249   var self/esi: (addr environment) <- copy _self
-250   var width/eax: int <- copy 0
-251   var height/ecx: int <- copy 0
-252   width, height <- screen-size screen
-253   # xmin = max(0, width/2 - 0x20)
-254   var xmin: int
-255   var tmp/edx: int <- copy width
-256   tmp <- shift-right 1
-257   tmp <- subtract 0x20/half-function-name-capacity
-258   {
-259     compare tmp, 0
-260     break-if->=
-261     tmp <- copy 0
-262   }
-263   copy-to xmin, tmp
-264   # xmax = min(width, width/2 + 0x20)
-265   var xmax: int
-266   tmp <- copy width
-267   tmp <- shift-right 1
-268   tmp <- add 0x20/half-function-name-capacity
-269   {
-270     compare tmp, width
-271     break-if-<=
-272     tmp <- copy width
-273   }
-274   copy-to xmax, tmp
-275   # ymin = height/2 - 2
-276   var ymin: int
-277   tmp <- copy height
-278   tmp <- shift-right 1
-279   tmp <- subtract 2
-280   copy-to ymin, tmp
-281   # ymax = height/2 + 1
-282   var ymax: int
-283   tmp <- add 3
-284   copy-to ymax, tmp
-285   #
-286   clear-rect screen, xmin, ymin, xmax, ymax, 0xf/bg=modal
-287   add-to xmin, 4
-288   set-cursor-position screen, xmin, ymin
-289   draw-text-rightward-from-cursor screen, "go to function (or leave blank to go to REPL)", xmax, 8/fg=dark-grey, 0xf/bg=modal
-290   var partial-function-name-ah/eax: (addr handle gap-buffer) <- get self, partial-function-name
-291   var _partial-function-name/eax: (addr gap-buffer) <- lookup *partial-function-name-ah
-292   var partial-function-name/edx: (addr gap-buffer) <- copy _partial-function-name
-293   subtract-from xmin, 4
-294   add-to ymin 2
-295   var dummy/eax: int <- copy 0
-296   var dummy2/ecx: int <- copy 0
-297   dummy, dummy2 <- render-gap-buffer-wrapping-right-then-down screen, partial-function-name, xmin, ymin, xmax, ymax, 1/always-render-cursor, 0/fg=black, 0xf/bg=modal
-298 }
-299 
-300 fn render-function-modal-menu screen: (addr screen), _self: (addr environment) {
-301   var self/esi: (addr environment) <- copy _self
-302   var _width/eax: int <- copy 0
-303   var height/ecx: int <- copy 0
-304   _width, height <- screen-size screen
-305   var width/edx: int <- copy _width
-306   var y/ecx: int <- copy height
-307   y <- decrement
-308   var height/ebx: int <- copy y
-309   height <- increment
-310   clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg
-311   set-cursor-position screen, 0/x, y
-312   draw-text-rightward-from-cursor screen, " ^r ", width, 0/fg, 0x5c/bg=menu-highlight
-313   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0xc5/bg=blue-bg
-314   draw-text-rightward-from-cursor screen, " enter ", width, 0/fg, 0x5c/bg=menu-highlight
-315   draw-text-rightward-from-cursor screen, " submit  ", width, 7/fg, 0xc5/bg=blue-bg
-316   draw-text-rightward-from-cursor screen, " esc ", width, 0/fg, 0x5c/bg=menu-highlight
-317   draw-text-rightward-from-cursor screen, " cancel  ", width, 7/fg, 0xc5/bg=blue-bg
-318   draw-text-rightward-from-cursor screen, " ^a ", width, 0/fg, 0x5c/bg=menu-highlight
-319   draw-text-rightward-from-cursor screen, " <<  ", width, 7/fg, 0xc5/bg=blue-bg
-320   draw-text-rightward-from-cursor screen, " ^b ", width, 0/fg, 0x5c/bg=menu-highlight
-321   draw-text-rightward-from-cursor screen, " <word  ", width, 7/fg, 0xc5/bg=blue-bg
-322   draw-text-rightward-from-cursor screen, " ^f ", width, 0/fg, 0x5c/bg=menu-highlight
-323   draw-text-rightward-from-cursor screen, " word>  ", width, 7/fg, 0xc5/bg=blue-bg
-324   draw-text-rightward-from-cursor screen, " ^e ", width, 0/fg, 0x5c/bg=menu-highlight
-325   draw-text-rightward-from-cursor screen, " >>  ", width, 7/fg, 0xc5/bg=blue-bg
-326 }
-327 
-328 # Gotcha: some saved state may not load.
-329 fn load-state _self: (addr environment), data-disk: (addr disk) {
-330   var self/esi: (addr environment) <- copy _self
-331   # data-disk -> stream
-332   var s-storage: (stream byte 0x1000)  # space for 8/sectors
-333   var s/ebx: (addr stream byte) <- address s-storage
-334   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sectors from data disk", 3/fg, 0/bg
-335   move-cursor-to-left-margin-of-next-line 0/screen
-336   load-sectors data-disk, 0/lba, 8/sectors, s
-337 #?   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg, 0xc5/bg=blue-bg
-338   # stream -> gap-buffer (HACK: we temporarily cannibalize the sandbox's gap-buffer)
-339   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "parsing", 3/fg, 0/bg
-340   move-cursor-to-left-margin-of-next-line 0/screen
-341   var sandbox/eax: (addr sandbox) <- get self, sandbox
-342   var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
-343   var data/eax: (addr gap-buffer) <- lookup *data-ah
-344   load-gap-buffer-from-stream data, s
-345   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "  into gap buffer", 3/fg, 0/bg
-346   move-cursor-to-left-margin-of-next-line 0/screen
-347   clear-stream s
-348   # read: gap-buffer -> cell
-349   var initial-root-storage: (handle cell)
-350   var initial-root/ecx: (addr handle cell) <- address initial-root-storage
-351   var trace-storage: trace
-352   var trace/edi: (addr trace) <- address trace-storage
-353   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
-354   read-cell data, initial-root, trace
-355   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "  into s-expressions", 3/fg, 0/bg
-356   move-cursor-to-left-margin-of-next-line 0/screen
-357   clear-gap-buffer data
-358   #
-359   {
-360     var initial-root-addr/eax: (addr cell) <- lookup *initial-root
-361     compare initial-root-addr, 0
-362     break-if-!=
-363     return
-364   }
-365   # load globals from assoc(initial-root, 'globals)
-366   var globals-literal-storage: (handle cell)
-367   var globals-literal-ah/eax: (addr handle cell) <- address globals-literal-storage
-368   new-symbol globals-literal-ah, "globals"
-369   var globals-literal/eax: (addr cell) <- lookup *globals-literal-ah
-370   var globals-cell-storage: (handle cell)
-371   var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage
-372   clear-trace trace
-373   lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
-374   var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah
-375   {
-376     compare globals-cell, 0
-377     break-if-=
-378     var globals/eax: (addr global-table) <- get self, globals
-379     load-globals globals-cell-ah, globals
-380   }
-381   # sandbox = assoc(initial-root, 'sandbox)
-382   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sandbox", 3/fg, 0/bg
-383   var sandbox-literal-storage: (handle cell)
-384   var sandbox-literal-ah/eax: (addr handle cell) <- address sandbox-literal-storage
-385   new-symbol sandbox-literal-ah, "sandbox"
-386   var sandbox-literal/eax: (addr cell) <- lookup *sandbox-literal-ah
-387   var sandbox-cell-storage: (handle cell)
-388   var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage
-389   clear-trace trace
-390   lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
-391   var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah
-392   {
-393     compare sandbox-cell, 0
-394     break-if-=
-395     # print: cell -> stream
-396     clear-trace trace
-397     print-cell sandbox-cell-ah, s, trace
-398     # stream -> gap-buffer
-399     var sandbox/eax: (addr sandbox) <- get self, sandbox
-400     var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
-401     var data/eax: (addr gap-buffer) <- lookup *data-ah
-402     load-gap-buffer-from-stream data, s
-403   }
-404 }
-405 
-406 # Save state as an alist of alists:
-407 #   ((globals . ((a . (fn ...))
-408 #                ...))
-409 #    (sandbox . ...))
-410 fn store-state data-disk: (addr disk), sandbox: (addr sandbox), globals: (addr global-table) {
-411   compare data-disk, 0/no-disk
-412   {
-413     break-if-!=
-414     return
-415   }
-416   var stream-storage: (stream byte 0x1000)  # space enough for 8/sectors
-417   var stream/edi: (addr stream byte) <- address stream-storage
-418   write stream, "(\n"
-419   write-globals stream, globals
-420   write-sandbox stream, sandbox
-421   write stream, ")\n"
-422   store-sectors data-disk, 0/lba, 8/sectors, stream
-423 }
+   1 # The top-level data structure for the Mu shell.
+   2 #
+   3 # vim:textwidth&
+   4 # It would be nice for tests to use a narrower screen than the standard 0x80 of
+   5 # 1024 pixels with 8px-wide graphemes. But it complicates rendering logic to
+   6 # make width configurable, so we just use longer lines than usual.
+   7 
+   8 type environment {
+   9   globals: global-table
+  10   sandbox: sandbox
+  11   # some state for a modal dialog for navigating between globals
+  12   partial-global-name: (handle gap-buffer)
+  13   go-modal-error: (handle array byte)
+  14   #
+  15   cursor-in-globals?: boolean
+  16   cursor-in-go-modal?: boolean
+  17 }
+  18 
+  19 # Here's a sample usage session and what it will look like on the screen.
+  20 fn test-environment {
+  21   var env-storage: environment
+  22   var env/esi: (addr environment) <- address env-storage
+  23   initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
+  24   # setup: screen
+  25   var screen-on-stack: screen
+  26   var screen/edi: (addr screen) <- address screen-on-stack
+  27   initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
+  28   # type some code into sandbox
+  29   type-in env, screen, "(+ 3 4)"  # we don't have any global definitions here, so no macros
+  30   # run code in sandbox
+  31   edit-environment env, 0x13/ctrl-s, 0/no-disk
+  32   render-environment screen, env
+  33   #                                                         | global definitions                                                                 | sandbox
+  34   # top row blank for now
+  35   check-screen-row                     screen,         0/y, "                                                                                                                                ", "F - test-environment/0"
+  36   check-screen-row                     screen,         1/y, "                                                                                      screen:                                   ", "F - test-environment/1"
+  37   check-background-color-in-screen-row screen, 0/bg,   2/y, "                                                                                        ........                                ", "F - test-environment/2"
+  38   check-background-color-in-screen-row screen, 0/bg,   3/y, "                                                                                        ........                                ", "F - test-environment/3"
+  39   check-background-color-in-screen-row screen, 0/bg,   4/y, "                                                                                        ........                                ", "F - test-environment/4"
+  40   check-screen-row                     screen,         5/y, "                                                                                                                                ", "F - test-environment/5"
+  41   check-screen-row                     screen,         6/y, "                                                                                      keyboard:                                 ", "F - test-environment/6"
+  42   check-background-color-in-screen-row screen, 0/bg,   6/y, "                                                                                                ................                ", "F - test-environment/6-2"
+  43   check-screen-row                     screen,         7/y, "                                                                                                                                ", "F - test-environment/7"
+  44   check-screen-row                     screen,         8/y, "                                                                                      (+ 3 4)                                   ", "F - test-environment/8"
+  45   check-screen-row                     screen,         9/y, "                                                                                      ...                       trace depth: 4  ", "F - test-environment/9"
+  46   check-screen-row                     screen,       0xa/y, "                                                                                      => 7                                      ", "F - test-environment/10"
+  47   check-screen-row                     screen,       0xb/y, "                                                                                                                                ", "F - test-environment/11"
+  48   check-screen-row                     screen,       0xc/y, "                                                                                                                                ", "F - test-environment/12"
+  49   check-screen-row                     screen,       0xd/y, "                                                                                                                                ", "F - test-environment/13"
+  50   check-screen-row                     screen,       0xe/y, "                                                                                                                                ", "F - test-environment/14"
+  51   # bottom row is for a wordstar-style menu
+  52   check-screen-row                     screen,       0xf/y, " ^r  run main   ^s  run sandbox   ^g  go to   ^m  to trace   ^a  <<   ^b  <word   ^f  word>   ^e  >>                            ", "F - test-environment/15"
+  53 }
+  54 
+  55 fn test-definition-in-environment {
+  56   var env-storage: environment
+  57   var env/esi: (addr environment) <- address env-storage
+  58   initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
+  59   # setup: screen
+  60   var screen-on-stack: screen
+  61   var screen/edi: (addr screen) <- address screen-on-stack
+  62   initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
+  63   # define a global on the right (sandbox) side
+  64   type-in env, screen, "(define f 42)"
+  65   edit-environment env, 0x13/ctrl-s, 0/no-disk
+  66   render-environment screen, env
+  67   #                                                         | global definitions                                                                 | sandbox
+  68   check-screen-row                     screen,         0/y, "                                                                                                                                ", "F - test-definition-in-environment/0"
+  69   # global definition is now on the left side
+  70   check-screen-row                     screen,         1/y, "                                           (define f 42)                              screen:                                   ", "F - test-definition-in-environment/1"
+  71   check-background-color-in-screen-row screen, 0/bg,   2/y, "                                                                                        ........                                ", "F - test-environment/2"
+  72   check-background-color-in-screen-row screen, 0/bg,   3/y, "                                                                                        ........                                ", "F - test-environment/3"
+  73   check-background-color-in-screen-row screen, 0/bg,   4/y, "                                                                                        ........                                ", "F - test-environment/4"
+  74   check-screen-row                     screen,         5/y, "                                                                                                                                ", "F - test-definition-in-environment/4"
+  75   check-screen-row                     screen,         6/y, "                                                                                      keyboard:                                 ", "F - test-definition-in-environment/5"
+  76   check-background-color-in-screen-row screen, 0/bg,   6/y, "                                                                                                ................                ", "F - test-definition-in-environment/5-2"
+  77   check-screen-row                     screen,         7/y, "                                                                                                                                ", "F - test-definition-in-environment/6"
+  78   check-screen-row                     screen,         8/y, "                                                                                                                                ", "F - test-definition-in-environment/7"
+  79   # you can still see the trace on the right for what you just added to the left
+  80   check-screen-row                     screen,         9/y, "                                                                                      ...                       trace depth: 4  ", "F - test-definition-in-environment/8"
+  81 }
+  82 
+  83 # helper for testing
+  84 fn type-in self: (addr environment), screen: (addr screen), keys: (addr array byte) {
+  85   # clear the buffer
+  86   edit-environment self, 0x15/ctrl-u, 0/no-disk
+  87   render-environment screen, self
+  88   # type in all the keys
+  89   var input-stream-storage: (stream byte 0x40/capacity)
+  90   var input-stream/ecx: (addr stream byte) <- address input-stream-storage
+  91   write input-stream, keys
+  92   {
+  93     var done?/eax: boolean <- stream-empty? input-stream
+  94     compare done?, 0/false
+  95     break-if-!=
+  96     var key/eax: grapheme <- read-grapheme input-stream
+  97     edit-environment self, key, 0/no-disk
+  98     render-environment screen, self
+  99     loop
+ 100   }
+ 101 }
+ 102 
+ 103 fn initialize-environment _self: (addr environment), fake-screen-width: int, fake-screen-height: int {
+ 104   var self/esi: (addr environment) <- copy _self
+ 105   var globals/eax: (addr global-table) <- get self, globals
+ 106   initialize-globals globals
+ 107   var sandbox/eax: (addr sandbox) <- get self, sandbox
+ 108   initialize-sandbox sandbox, fake-screen-width, fake-screen-height
+ 109   var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
+ 110   allocate partial-global-name-ah
+ 111   var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
+ 112   initialize-gap-buffer partial-global-name, 0x40/global-name-capacity
+ 113 }
+ 114 
+ 115 fn render-environment screen: (addr screen), _self: (addr environment) {
+ 116   # globals layout: 1 char padding, 41 code, 1 padding, 41 code, 1 padding =  85
+ 117   # sandbox layout: 1 padding, 41 code, 1 padding                          =  43
+ 118   #                                                                  total = 128 chars
+ 119   var self/esi: (addr environment) <- copy _self
+ 120   var cursor-in-globals-a/eax: (addr boolean) <- get self, cursor-in-globals?
+ 121   var cursor-in-globals?/eax: boolean <- copy *cursor-in-globals-a
+ 122   var globals/ecx: (addr global-table) <- get self, globals
+ 123   render-globals screen, globals, cursor-in-globals?
+ 124   var sandbox/edx: (addr sandbox) <- get self, sandbox
+ 125   var cursor-in-sandbox?/ebx: boolean <- copy 1/true
+ 126   cursor-in-sandbox? <- subtract cursor-in-globals?
+ 127   render-sandbox screen, sandbox, 0x55/sandbox-left-margin, 0/sandbox-top-margin, 0x80/screen-width, 0x2f/screen-height-without-menu, cursor-in-sandbox?
+ 128   # modal if necessary
+ 129   {
+ 130     var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
+ 131     compare *cursor-in-go-modal-a, 0/false
+ 132     break-if-=
+ 133     render-go-modal screen, self
+ 134     render-go-modal-menu screen, self
+ 135     return
+ 136   }
+ 137   # render menu
+ 138   {
+ 139     var cursor-in-globals?/eax: (addr boolean) <- get self, cursor-in-globals?
+ 140     compare *cursor-in-globals?, 0/false
+ 141     break-if-=
+ 142     render-globals-menu screen, globals
+ 143     return
+ 144   }
+ 145   render-sandbox-menu screen, sandbox
+ 146 }
+ 147 
+ 148 fn edit-environment _self: (addr environment), key: grapheme, data-disk: (addr disk) {
+ 149   var self/esi: (addr environment) <- copy _self
+ 150   var globals/edi: (addr global-table) <- get self, globals
+ 151   var sandbox/ecx: (addr sandbox) <- get self, sandbox
+ 152   # ctrl-r
+ 153   # Assumption: 'real-screen' and 'real-keyboard' are 0
+ 154   {
+ 155     compare key, 0x12/ctrl-r
+ 156     break-if-!=
+ 157     var tmp/eax: (addr handle cell) <- copy 0
+ 158     var nil: (handle cell)
+ 159     tmp <- address nil
+ 160     allocate-pair tmp
+ 161     # (main real-screen real-keyboard)
+ 162     var real-keyboard: (handle cell)
+ 163     tmp <- address real-keyboard
+ 164     allocate-keyboard tmp
+ 165     # args = cons(real-keyboard, nil)
+ 166     var args: (handle cell)
+ 167     tmp <- address args
+ 168     new-pair tmp, real-keyboard, nil
+ 169     #
+ 170     var real-screen: (handle cell)
+ 171     tmp <- address real-screen
+ 172     allocate-screen tmp
+ 173     #  args = cons(real-screen, args)
+ 174     tmp <- address args
+ 175     new-pair tmp, real-screen, *tmp
+ 176     #
+ 177     var main: (handle cell)
+ 178     tmp <- address main
+ 179     new-symbol tmp, "main"
+ 180     # args = cons(main, args)
+ 181     tmp <- address args
+ 182     new-pair tmp, main, *tmp
+ 183     # clear real screen
+ 184     clear-screen 0/screen
+ 185     set-cursor-position 0/screen, 0, 0
+ 186     # run
+ 187     var out: (handle cell)
+ 188     var out-ah/ecx: (addr handle cell) <- address out
+ 189     var trace-storage: trace
+ 190     var trace/ebx: (addr trace) <- address trace-storage
+ 191     initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 192     evaluate tmp, out-ah, nil, globals, trace, 0/no-fake-screen, 0/no-fake-keyboard, 0/definitions-created, 0/call-number
+ 193     # wait for a keypress
+ 194     {
+ 195       var tmp/eax: byte <- read-key 0/keyboard
+ 196       compare tmp, 0
+ 197       loop-if-=
+ 198     }
+ 199     #
+ 200     return
+ 201   }
+ 202   # ctrl-s: send multiple places
+ 203   {
+ 204     compare key, 0x13/ctrl-s
+ 205     break-if-!=
+ 206     {
+ 207       # cursor in go modal? do nothing
+ 208       var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
+ 209       compare *cursor-in-go-modal-a, 0/false
+ 210       break-if-!=
+ 211       {
+ 212         # cursor in globals? update current definition
+ 213         var cursor-in-globals-a/edx: (addr boolean) <- get self, cursor-in-globals?
+ 214         compare *cursor-in-globals-a, 0/false
+ 215         break-if-=
+ 216         edit-globals globals, key
+ 217       }
+ 218       # update sandbox whether the cursor is in globals or sandbox
+ 219       edit-sandbox sandbox, key, globals, data-disk
+ 220     }
+ 221     return
+ 222   }
+ 223   # dispatch to go modal if necessary
+ 224   {
+ 225     var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
+ 226     compare *cursor-in-go-modal-a, 0/false
+ 227     break-if-=
+ 228     # nested events for modal dialog
+ 229     # ignore spaces
+ 230     {
+ 231       compare key, 0x20/space
+ 232       break-if-!=
+ 233       return
+ 234     }
+ 235     # esc = exit modal dialog
+ 236     {
+ 237       compare key, 0x1b/escape
+ 238       break-if-!=
+ 239       var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
+ 240       copy-to *cursor-in-go-modal-a, 0/false
+ 241       var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
+ 242       clear-object go-modal-error-ah
+ 243       return
+ 244     }
+ 245     # enter = switch to global name and exit modal dialog
+ 246     {
+ 247       compare key, 0xa/newline
+ 248       break-if-!=
+ 249       # if no global name typed in, switch to sandbox
+ 250       var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
+ 251       var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
+ 252       {
+ 253         var empty?/eax: boolean <- gap-buffer-empty? partial-global-name
+ 254         compare empty?, 0/false
+ 255         break-if-=
+ 256         var cursor-in-globals-a/eax: (addr boolean) <- get self, cursor-in-globals?
+ 257         copy-to *cursor-in-globals-a, 0/false
+ 258         # reset error state
+ 259         var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
+ 260         clear-object go-modal-error-ah
+ 261         # done with go modal
+ 262         var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
+ 263         copy-to *cursor-in-go-modal-a, 0/false
+ 264         return
+ 265       }
+ 266       # turn global name into a stream
+ 267       var name-storage: (stream byte 0x40)
+ 268       var name/ecx: (addr stream byte) <- address name-storage
+ 269       emit-gap-buffer partial-global-name, name
+ 270       # compute global index
+ 271       var index/ecx: int <- find-symbol-in-globals globals, name
+ 272       # if global not found, set error and return
+ 273       {
+ 274         compare index, 0
+ 275         break-if->=
+ 276         var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
+ 277         copy-array-object "no such global", go-modal-error-ah
+ 278         return
+ 279       }
+ 280       # otherwise clear modal state
+ 281       clear-gap-buffer partial-global-name
+ 282       var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
+ 283       clear-object go-modal-error-ah
+ 284       var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
+ 285       copy-to *cursor-in-go-modal-a, 0/false
+ 286       # switch focus to global at index
+ 287       var globals-cursor-index/eax: (addr int) <- get globals, cursor-index
+ 288       copy-to *globals-cursor-index, index
+ 289       var cursor-in-globals-a/ecx: (addr boolean) <- get self, cursor-in-globals?
+ 290       copy-to *cursor-in-globals-a, 1/true
+ 291       return
+ 292     }
+ 293     # ctrl-m = create given global name and exit modal dialog
+ 294     {
+ 295       compare key, 0xd/ctrl-m
+ 296       break-if-!=
+ 297       # if no global name typed in, set error and return
+ 298       var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
+ 299       var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
+ 300       {
+ 301         var empty?/eax: boolean <- gap-buffer-empty? partial-global-name
+ 302         compare empty?, 0/false
+ 303         break-if-=
+ 304         var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
+ 305         copy-array-object "create what?", go-modal-error-ah
+ 306         return
+ 307       }
+ 308       # turn global name into a stream
+ 309       var name-storage: (stream byte 0x40)
+ 310       var name/edx: (addr stream byte) <- address name-storage
+ 311       emit-gap-buffer partial-global-name, name
+ 312       # compute global index
+ 313       var index/ecx: int <- find-symbol-in-globals globals, name
+ 314       # if global found, set error and return
+ 315       {
+ 316         compare index, 0
+ 317         break-if-<
+ 318         var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
+ 319         copy-array-object "already exists", go-modal-error-ah
+ 320         return
+ 321       }
+ 322       # otherwise clear modal state
+ 323       clear-gap-buffer partial-global-name
+ 324       var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
+ 325       clear-object go-modal-error-ah
+ 326       var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
+ 327       copy-to *cursor-in-go-modal-a, 0/false
+ 328       # create new global
+ 329       create-empty-global globals, name, 0x2000/default-gap-buffer-size=8KB
+ 330       var globals-final-index/eax: (addr int) <- get globals, final-index
+ 331       var new-index/ecx: int <- copy *globals-final-index
+ 332       var globals-cursor-index/eax: (addr int) <- get globals, cursor-index
+ 333       copy-to *globals-cursor-index, new-index
+ 334       var cursor-in-globals-a/ecx: (addr boolean) <- get self, cursor-in-globals?
+ 335       copy-to *cursor-in-globals-a, 1/true
+ 336       return
+ 337     }
+ 338     # otherwise process like a regular gap-buffer
+ 339     var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
+ 340     var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
+ 341     edit-gap-buffer partial-global-name, key
+ 342     return
+ 343   }
+ 344   # ctrl-g: go to a global (or the repl)
+ 345   {
+ 346     compare key, 7/ctrl-g
+ 347     break-if-!=
+ 348     # look for a word to prepopulate the modal
+ 349     var current-word-storage: (stream byte 0x40)
+ 350     var current-word/edi: (addr stream byte) <- address current-word-storage
+ 351     word-at-cursor self, current-word
+ 352     var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
+ 353     var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
+ 354     clear-gap-buffer partial-global-name
+ 355     load-gap-buffer-from-stream partial-global-name, current-word
+ 356     # enable the modal
+ 357     var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
+ 358     copy-to *cursor-in-go-modal-a, 1/true
+ 359     return
+ 360   }
+ 361   # dispatch the key to either sandbox or globals
+ 362   {
+ 363     var cursor-in-globals-a/eax: (addr boolean) <- get self, cursor-in-globals?
+ 364     compare *cursor-in-globals-a, 0/false
+ 365     break-if-=
+ 366     edit-globals globals, key
+ 367     return
+ 368   }
+ 369   edit-sandbox sandbox, key, globals, data-disk
+ 370 }
+ 371 
+ 372 fn read-and-evaluate-and-save-gap-buffer-to-globals _in-ah: (addr handle gap-buffer), result-ah: (addr handle cell), globals: (addr global-table), definitions-created: (addr stream int), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell) {
+ 373   var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah
+ 374   var in/eax: (addr gap-buffer) <- lookup *in-ah
+ 375   var read-result-h: (handle cell)
+ 376   var read-result-ah/esi: (addr handle cell) <- address read-result-h
+ 377   read-cell in, read-result-ah, trace
+ 378   var error?/eax: boolean <- has-errors? trace
+ 379   {
+ 380     compare error?, 0/false
+ 381     break-if-=
+ 382     return
+ 383   }
+ 384   macroexpand read-result-ah, globals, trace
+ 385   var error?/eax: boolean <- has-errors? trace
+ 386   {
+ 387     compare error?, 0/false
+ 388     break-if-=
+ 389     return
+ 390   }
+ 391   var nil-h: (handle cell)
+ 392   var nil-ah/eax: (addr handle cell) <- address nil-h
+ 393   allocate-pair nil-ah
+ 394 #?   set-cursor-position 0/screen, 0 0
+ 395 #?   turn-on-debug-print
+ 396   var call-number-storage: int
+ 397   var call-number/edi: (addr int) <- address call-number-storage
+ 398   debug-print "^", 4/fg, 0/bg
+ 399   evaluate read-result-ah, result-ah, *nil-ah, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number
+ 400   debug-print "$", 4/fg, 0/bg
+ 401   var error?/eax: boolean <- has-errors? trace
+ 402   {
+ 403     compare error?, 0/false
+ 404     break-if-=
+ 405     return
+ 406   }
+ 407   # refresh various rendering caches
+ 408   mark-lines-dirty trace
+ 409   # If any definitions were created or modified in the process, link this gap
+ 410   # buffer to them.
+ 411   # TODO: detect and create UI for conflicts.
+ 412   stash-gap-buffer-to-globals globals, definitions-created, _in-ah
+ 413 }
+ 414 
+ 415 fn test-go-modal {
+ 416   var env-storage: environment
+ 417   var env/esi: (addr environment) <- address env-storage
+ 418   initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
+ 419   # setup: screen
+ 420   var screen-on-stack: screen
+ 421   var screen/edi: (addr screen) <- address screen-on-stack
+ 422   initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
+ 423   # hit ctrl-g
+ 424   edit-environment env, 7/ctrl-g, 0/no-disk
+ 425   render-environment screen, env
+ 426   #
+ 427   check-background-color-in-screen-row screen, 0xf/bg=modal,   0/y, "                                                                                                                                ", "F - test-go-modal/0"
+ 428   check-background-color-in-screen-row screen, 0xf/bg=modal,   1/y, "                                                                                                                                ", "F - test-go-modal/1"
+ 429   check-background-color-in-screen-row screen, 0xf/bg=modal,   2/y, "                                                                                                                                ", "F - test-go-modal/2"
+ 430   check-background-color-in-screen-row screen, 0xf/bg=modal,   3/y, "                                                                                                                                ", "F - test-go-modal/3"
+ 431   check-background-color-in-screen-row screen, 0xf/bg=modal,   4/y, "                                                                                                                                ", "F - test-go-modal/4"
+ 432   check-background-color-in-screen-row screen, 0xf/bg=modal,   5/y, "                                                                                                                                ", "F - test-go-modal/5"
+ 433   check-screen-row                     screen,                 6/y, "                                    go to global (or leave blank to go to REPL)                                                 ", "F - test-go-modal/6-text"
+ 434   check-background-color-in-screen-row screen, 0xf/bg=modal,   6/y, "                                ................................................................                                ", "F - test-go-modal/6"
+ 435   check-background-color-in-screen-row screen, 0xf/bg=modal,   7/y, "                                ................................................................                                ", "F - test-go-modal/7"
+ 436   # cursor is in the modal
+ 437   check-background-color-in-screen-row screen,   0/bg=cursor,  8/y, "                                |                                                                                               ", "F - test-go-modal/8-cursor"
+ 438   check-background-color-in-screen-row screen, 0xf/bg=modal,   8/y, "                                 ...............................................................                                ", "F - test-go-modal/8"
+ 439   check-background-color-in-screen-row screen, 0xf/bg=modal,   9/y, "                                                                                                                                ", "F - test-go-modal/9"
+ 440   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, "                                                                                                                                ", "F - test-go-modal/10"
+ 441   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, "                                                                                                                                ", "F - test-go-modal/11"
+ 442   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, "                                                                                                                                ", "F - test-go-modal/12"
+ 443   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, "                                                                                                                                ", "F - test-go-modal/13"
+ 444   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, "                                                                                                                                ", "F - test-go-modal/14"
+ 445   # menu at bottom is correct in context
+ 446   check-screen-row                     screen,               0xf/y, " ^r  run main   enter  go   ^m  create   esc  cancel   ^a  <<   ^b  <word   ^f  word>   ^e  >>                                  ", "F - test-go-modal/15-text"
+ 447   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, "                                                                                                                                ", "F - test-go-modal/15"
+ 448 }
+ 449 
+ 450 fn test-leave-go-modal {
+ 451   var env-storage: environment
+ 452   var env/esi: (addr environment) <- address env-storage
+ 453   initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
+ 454   # setup: screen
+ 455   var screen-on-stack: screen
+ 456   var screen/edi: (addr screen) <- address screen-on-stack
+ 457   initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
+ 458   # hit ctrl-g
+ 459   edit-environment env, 7/ctrl-g, 0/no-disk
+ 460   render-environment screen, env
+ 461   # cancel
+ 462   edit-environment env, 0x1b/escape, 0/no-disk
+ 463   render-environment screen, env
+ 464   # no modal
+ 465   check-background-color-in-screen-row screen, 0xf/bg=modal,   0/y, "                                                                                                                                ", "F - test-leave-go-modal/0"
+ 466   check-background-color-in-screen-row screen, 0xf/bg=modal,   1/y, "                                                                                                                                ", "F - test-leave-go-modal/1"
+ 467   check-background-color-in-screen-row screen, 0xf/bg=modal,   2/y, "                                                                                                                                ", "F - test-leave-go-modal/2"
+ 468   check-background-color-in-screen-row screen, 0xf/bg=modal,   3/y, "                                                                                                                                ", "F - test-leave-go-modal/3"
+ 469   check-background-color-in-screen-row screen, 0xf/bg=modal,   4/y, "                                                                                                                                ", "F - test-leave-go-modal/4"
+ 470   check-background-color-in-screen-row screen, 0xf/bg=modal,   5/y, "                                                                                                                                ", "F - test-leave-go-modal/5"
+ 471   check-background-color-in-screen-row screen, 0xf/bg=modal,   6/y, "                                                                                                                                ", "F - test-leave-go-modal/6"
+ 472   check-background-color-in-screen-row screen, 0xf/bg=modal,   7/y, "                                                                                                                                ", "F - test-leave-go-modal/7"
+ 473   check-background-color-in-screen-row screen, 0xf/bg=modal,   8/y, "                                                                                                                                ", "F - test-leave-go-modal/8"
+ 474   check-background-color-in-screen-row screen, 0xf/bg=modal,   9/y, "                                                                                                                                ", "F - test-leave-go-modal/9"
+ 475   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, "                                                                                                                                ", "F - test-leave-go-modal/10"
+ 476   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, "                                                                                                                                ", "F - test-leave-go-modal/11"
+ 477   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, "                                                                                                                                ", "F - test-leave-go-modal/12"
+ 478   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, "                                                                                                                                ", "F - test-leave-go-modal/13"
+ 479   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, "                                                                                                                                ", "F - test-leave-go-modal/14"
+ 480   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, "                                                                                                                                ", "F - test-leave-go-modal/15"
+ 481 }
+ 482 
+ 483 fn test-jump-to-global {
+ 484   var env-storage: environment
+ 485   var env/esi: (addr environment) <- address env-storage
+ 486   initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
+ 487   # setup: screen
+ 488   var screen-on-stack: screen
+ 489   var screen/edi: (addr screen) <- address screen-on-stack
+ 490   initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
+ 491   # define a global
+ 492   type-in env, screen, "(define f 42)"
+ 493   edit-environment env, 0x13/ctrl-s, 0/no-disk
+ 494   render-environment screen, env
+ 495   # hit ctrl-g
+ 496   edit-environment env, 7/ctrl-g, 0/no-disk
+ 497   render-environment screen, env
+ 498   # type global name
+ 499   type-in env, screen, "f"
+ 500   # submit
+ 501   edit-environment env, 0xa/newline, 0/no-disk
+ 502   render-environment screen, env
+ 503   #                                                                 | global definitions                                                                 | sandbox
+ 504   # cursor now in global definition
+ 505   check-screen-row                     screen,                 1/y, "                                           (define f 42)                              screen:                                   ", "F - test-jump-to-global/1"
+ 506   check-background-color-in-screen-row screen,   7/bg=cursor,  1/y, "                                                        |                                                                       ", "F - test-jump-to-global/1-cursor"
+ 507   # no modal
+ 508   check-background-color-in-screen-row screen, 0xf/bg=modal,   0/y, "                                                                                                                                ", "F - test-jump-to-global/bg0"
+ 509   check-background-color-in-screen-row screen, 0xf/bg=modal,   1/y, "                                                                                                                                ", "F - test-jump-to-global/bg1"
+ 510   check-background-color-in-screen-row screen, 0xf/bg=modal,   2/y, "                                                                                                                                ", "F - test-jump-to-global/bg2"
+ 511   check-background-color-in-screen-row screen, 0xf/bg=modal,   3/y, "                                                                                                                                ", "F - test-jump-to-global/bg3"
+ 512   check-background-color-in-screen-row screen, 0xf/bg=modal,   4/y, "                                                                                                                                ", "F - test-jump-to-global/bg4"
+ 513   check-background-color-in-screen-row screen, 0xf/bg=modal,   5/y, "                                                                                                                                ", "F - test-jump-to-global/bg5"
+ 514   check-background-color-in-screen-row screen, 0xf/bg=modal,   6/y, "                                                                                                                                ", "F - test-jump-to-global/bg6"
+ 515   check-background-color-in-screen-row screen, 0xf/bg=modal,   7/y, "                                                                                                                                ", "F - test-jump-to-global/bg7"
+ 516   check-background-color-in-screen-row screen, 0xf/bg=modal,   8/y, "                                                                                                                                ", "F - test-jump-to-global/bg8"
+ 517   check-background-color-in-screen-row screen, 0xf/bg=modal,   9/y, "                                                                                                                                ", "F - test-jump-to-global/bg9"
+ 518   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, "                                                                                                                                ", "F - test-jump-to-global/bg10"
+ 519   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, "                                                                                                                                ", "F - test-jump-to-global/bg11"
+ 520   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, "                                                                                                                                ", "F - test-jump-to-global/bg12"
+ 521   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, "                                                                                                                                ", "F - test-jump-to-global/bg13"
+ 522   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, "                                                                                                                                ", "F - test-jump-to-global/bg14"
+ 523   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, "                                                                                                                                ", "F - test-jump-to-global/bg15"
+ 524 }
+ 525 
+ 526 fn test-go-modal-prepopulates-word-at-cursor {
+ 527   var env-storage: environment
+ 528   var env/esi: (addr environment) <- address env-storage
+ 529   initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
+ 530   # setup: screen
+ 531   var screen-on-stack: screen
+ 532   var screen/edi: (addr screen) <- address screen-on-stack
+ 533   initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
+ 534   # type a word at the cursor
+ 535   type-in env, screen, "fn1"
+ 536   # hit ctrl-g
+ 537   edit-environment env, 7/ctrl-g, 0/no-disk
+ 538   render-environment screen, env
+ 539   # modal prepopulates word at cursor
+ 540   check-background-color-in-screen-row screen, 0xf/bg=modal,   0/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/0"
+ 541   check-background-color-in-screen-row screen, 0xf/bg=modal,   1/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/1"
+ 542   check-background-color-in-screen-row screen, 0xf/bg=modal,   2/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/2"
+ 543   check-background-color-in-screen-row screen, 0xf/bg=modal,   3/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/3"
+ 544   check-background-color-in-screen-row screen, 0xf/bg=modal,   4/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/4"
+ 545   check-background-color-in-screen-row screen, 0xf/bg=modal,   5/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/5"
+ 546   check-screen-row                     screen,                 6/y, "                                    go to global (or leave blank to go to REPL)                                                 ", "F - test-go-modal-prepopulates-word-at-cursor/6-text"
+ 547   check-background-color-in-screen-row screen, 0xf/bg=modal,   6/y, "                                ................................................................                                ", "F - test-go-modal-prepopulates-word-at-cursor/6"
+ 548   check-background-color-in-screen-row screen, 0xf/bg=modal,   7/y, "                                ................................................................                                ", "F - test-go-modal-prepopulates-word-at-cursor/7"
+ 549   # word at cursor
+ 550   check-screen-row                     screen,                 8/y, "                                fn1                                                                                             ", "F - test-go-modal-prepopulates-word-at-cursor/8-text"
+ 551   # new cursor position
+ 552   check-background-color-in-screen-row screen,   0/bg=cursor,  8/y, "                                   |                                                                                            ", "F - test-go-modal-prepopulates-word-at-cursor/8-cursor"
+ 553   check-background-color-in-screen-row screen, 0xf/bg=modal,   8/y, "                                ... ............................................................                                ", "F - test-go-modal-prepopulates-word-at-cursor/8"
+ 554   check-background-color-in-screen-row screen, 0xf/bg=modal,   9/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/9"
+ 555   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/10"
+ 556   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/11"
+ 557   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/12"
+ 558   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/13"
+ 559   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/14"
+ 560   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/15"
+ 561   # cancel
+ 562   edit-environment env, 0x1b/escape, 0/no-disk
+ 563   render-environment screen, env
+ 564   # type one more space
+ 565   edit-environment env, 0x20/space, 0/no-disk
+ 566   render-environment screen, env
+ 567   # hit ctrl-g again
+ 568   edit-environment env, 7/ctrl-g, 0/no-disk
+ 569   render-environment screen, env
+ 570   # no word prepopulated since cursor is not on the word
+ 571   check-background-color-in-screen-row screen, 0xf/bg=modal,   0/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-0"
+ 572   check-background-color-in-screen-row screen, 0xf/bg=modal,   1/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-1"
+ 573   check-background-color-in-screen-row screen, 0xf/bg=modal,   2/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-2"
+ 574   check-background-color-in-screen-row screen, 0xf/bg=modal,   3/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-3"
+ 575   check-background-color-in-screen-row screen, 0xf/bg=modal,   4/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-4"
+ 576   check-background-color-in-screen-row screen, 0xf/bg=modal,   5/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-5"
+ 577   check-screen-row                     screen,                 6/y, "                                    go to global (or leave blank to go to REPL)                                                 ", "F - test-go-modal-prepopulates-word-at-cursor/test2-6-text"
+ 578   check-background-color-in-screen-row screen, 0xf/bg=modal,   6/y, "                                ................................................................                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-6"
+ 579   check-background-color-in-screen-row screen, 0xf/bg=modal,   7/y, "                                ................................................................                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-7"
+ 580   # no word at cursor
+ 581   check-screen-row                     screen,                 8/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-8-text"
+ 582   # new cursor position
+ 583   check-background-color-in-screen-row screen,   0/bg=cursor,  8/y, "                                |                                                                                               ", "F - test-go-modal-prepopulates-word-at-cursor/test2-8-cursor"
+ 584   check-background-color-in-screen-row screen, 0xf/bg=modal,   8/y, "                                 ...............................................................                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-8"
+ 585   check-background-color-in-screen-row screen, 0xf/bg=modal,   9/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-9"
+ 586   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-10"
+ 587   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-11"
+ 588   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-12"
+ 589   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-13"
+ 590   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-14"
+ 591   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test2-15"
+ 592   # cancel
+ 593   edit-environment env, 0x1b/escape, 0/no-disk
+ 594   render-environment screen, env
+ 595   # move cursor to the left until it's on the word again
+ 596   edit-environment env, 0x80/left-arrow, 0/no-disk
+ 597   render-environment screen, env
+ 598   edit-environment env, 0x80/left-arrow, 0/no-disk
+ 599   render-environment screen, env
+ 600   # hit ctrl-g again
+ 601   edit-environment env, 7/ctrl-g, 0/no-disk
+ 602   render-environment screen, env
+ 603   # word prepopulated like before
+ 604   check-background-color-in-screen-row screen, 0xf/bg=modal,   0/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-0"
+ 605   check-background-color-in-screen-row screen, 0xf/bg=modal,   1/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-1"
+ 606   check-background-color-in-screen-row screen, 0xf/bg=modal,   2/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-2"
+ 607   check-background-color-in-screen-row screen, 0xf/bg=modal,   3/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-3"
+ 608   check-background-color-in-screen-row screen, 0xf/bg=modal,   4/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-4"
+ 609   check-background-color-in-screen-row screen, 0xf/bg=modal,   5/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-5"
+ 610   check-screen-row                     screen,                 6/y, "                                    go to global (or leave blank to go to REPL)                                                 ", "F - test-go-modal-prepopulates-word-at-cursor/test3-6-text"
+ 611   check-background-color-in-screen-row screen, 0xf/bg=modal,   6/y, "                                ................................................................                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-6"
+ 612   check-background-color-in-screen-row screen, 0xf/bg=modal,   7/y, "                                ................................................................                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-7"
+ 613   # word at cursor
+ 614   check-screen-row                     screen,                 8/y, "                                fn1                                                                                             ", "F - test-go-modal-prepopulates-word-at-cursor/test3-8-text"
+ 615   # new cursor position
+ 616   check-background-color-in-screen-row screen,   0/bg=cursor,  8/y, "                                   |                                                                                            ", "F - test-go-modal-prepopulates-word-at-cursor/test3-8-cursor"
+ 617   check-background-color-in-screen-row screen, 0xf/bg=modal,   8/y, "                                ... ............................................................                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-8"
+ 618   check-background-color-in-screen-row screen, 0xf/bg=modal,   9/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-9"
+ 619   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-10"
+ 620   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-11"
+ 621   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-12"
+ 622   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-13"
+ 623   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-14"
+ 624   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, "                                                                                                                                ", "F - test-go-modal-prepopulates-word-at-cursor/test3-15"
+ 625 }
+ 626 
+ 627 fn test-jump-to-nonexistent-global {
+ 628   var env-storage: environment
+ 629   var env/esi: (addr environment) <- address env-storage
+ 630   initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
+ 631   # setup: screen
+ 632   var screen-on-stack: screen
+ 633   var screen/edi: (addr screen) <- address screen-on-stack
+ 634   initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
+ 635   # type in any (nonexistent) global name
+ 636   type-in env, screen, "f"
+ 637   # hit ctrl-g
+ 638   edit-environment env, 7/ctrl-g, 0/no-disk
+ 639   render-environment screen, env
+ 640   # submit
+ 641   edit-environment env, 0xa/newline, 0/no-disk
+ 642   render-environment screen, env
+ 643   # modal now shows an error
+ 644   #                                                                 | global definitions                                                                 | sandbox
+ 645   check-background-color-in-screen-row screen, 0xf/bg=modal,   0/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/0"
+ 646   check-background-color-in-screen-row screen, 0xf/bg=modal,   1/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/1"
+ 647   check-background-color-in-screen-row screen, 0xf/bg=modal,   2/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/2"
+ 648   check-background-color-in-screen-row screen, 0xf/bg=modal,   3/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/3"
+ 649   check-background-color-in-screen-row screen, 0xf/bg=modal,   4/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/4"
+ 650   check-background-color-in-screen-row screen, 0xf/bg=modal,   5/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/5"
+ 651   check-screen-row                     screen,                 6/y, "                                    go to global (or leave blank to go to REPL)                                                 ", "F - test-jump-to-nonexistent-global/6-text"
+ 652   check-background-color-in-screen-row screen, 0xf/bg=modal,   6/y, "                                ................................................................                                ", "F - test-jump-to-nonexistent-global/6"
+ 653   check-screen-row-in-color            screen, 4/fg=error,     7/y, "                                no such global                                                                                  ", "F - test-jump-to-nonexistent-global/7-text"
+ 654   check-background-color-in-screen-row screen, 0xf/bg=modal,   7/y, "                                ................................................................                                ", "F - test-jump-to-nonexistent-global/7"
+ 655   check-screen-row                     screen,                 8/y, "                                f                                                                                               ", "F - test-jump-to-nonexistent-global/8-text"
+ 656   check-background-color-in-screen-row screen,   0/bg=cursor,  8/y, "                                 |                                                                                              ", "F - test-jump-to-nonexistent-global/8-cursor"
+ 657   check-background-color-in-screen-row screen, 0xf/bg=modal,   8/y, "                                . ..............................................................                                ", "F - test-jump-to-nonexistent-global/8"
+ 658   check-background-color-in-screen-row screen, 0xf/bg=modal,   9/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/9"
+ 659   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/10"
+ 660   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/11"
+ 661   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/12"
+ 662   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/13"
+ 663   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/14"
+ 664   # menu at bottom is correct in context
+ 665   check-screen-row                     screen,               0xf/y, " ^r  run main   enter  go   ^m  create   esc  cancel   ^a  <<   ^b  <word   ^f  word>   ^e  >>                                  ", "F - test-jump-to-nonexistent-global/15-text"
+ 666   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/15"
+ 667   # cancel
+ 668   edit-environment env, 0x1b/escape, 0/no-disk
+ 669   render-environment screen, env
+ 670   # hit ctrl-g again
+ 671   edit-environment env, 7/ctrl-g, 0/no-disk
+ 672   render-environment screen, env
+ 673   # word prepopulated like before, but no error
+ 674   check-background-color-in-screen-row screen, 0xf/bg=modal,   0/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-0"
+ 675   check-background-color-in-screen-row screen, 0xf/bg=modal,   1/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-1"
+ 676   check-background-color-in-screen-row screen, 0xf/bg=modal,   2/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-2"
+ 677   check-background-color-in-screen-row screen, 0xf/bg=modal,   3/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-3"
+ 678   check-background-color-in-screen-row screen, 0xf/bg=modal,   4/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-4"
+ 679   check-background-color-in-screen-row screen, 0xf/bg=modal,   5/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-5"
+ 680   check-screen-row                     screen,                 6/y, "                                    go to global (or leave blank to go to REPL)                                                 ", "F - test-jump-to-nonexistent-global/test2-6-text"
+ 681   check-background-color-in-screen-row screen, 0xf/bg=modal,   6/y, "                                ................................................................                                ", "F - test-jump-to-nonexistent-global/test2-6"
+ 682   check-screen-row-in-color            screen, 4/fg=error,     7/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-7-text"
+ 683   check-background-color-in-screen-row screen, 0xf/bg=modal,   7/y, "                                ................................................................                                ", "F - test-jump-to-nonexistent-global/test2-7"
+ 684   # same word at cursor
+ 685   check-screen-row                     screen,                 8/y, "                                f                                                                                               ", "F - test-jump-to-nonexistent-global/test2-8-text"
+ 686   # new cursor position
+ 687   check-background-color-in-screen-row screen,   0/bg=cursor,  8/y, "                                 |                                                                                              ", "F - test-jump-to-nonexistent-global/test2-8-cursor"
+ 688   check-background-color-in-screen-row screen, 0xf/bg=modal,   8/y, "                                . ..............................................................                                ", "F - test-jump-to-nonexistent-global/test2-8"
+ 689   check-background-color-in-screen-row screen, 0xf/bg=modal,   9/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-9"
+ 690   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-10"
+ 691   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-11"
+ 692   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-12"
+ 693   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-13"
+ 694   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-14"
+ 695   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, "                                                                                                                                ", "F - test-jump-to-nonexistent-global/test2-15"
+ 696 }
+ 697 
+ 698 fn test-create-global {
+ 699   var env-storage: environment
+ 700   var env/esi: (addr environment) <- address env-storage
+ 701   initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
+ 702   # setup: screen
+ 703   var screen-on-stack: screen
+ 704   var screen/edi: (addr screen) <- address screen-on-stack
+ 705   initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
+ 706   # hit ctrl-g
+ 707   edit-environment env, 7/ctrl-g, 0/no-disk
+ 708   render-environment screen, env
+ 709   # type global name
+ 710   type-in env, screen, "fn1"
+ 711   # create
+ 712   edit-environment env, 0xd/ctrl-m, 0/no-disk
+ 713   render-environment screen, env
+ 714   #                                                                 | global definitions                                                                 | sandbox
+ 715   # cursor now on global side
+ 716   check-background-color-in-screen-row screen,   7/bg=cursor,  1/y, "                                           |                                                                                    ", "F - test-create-global/1-cursor"
+ 717   # no modal
+ 718   check-background-color-in-screen-row screen, 0xf/bg=modal,   0/y, "                                                                                                                                ", "F - test-create-global/bg0"
+ 719   check-background-color-in-screen-row screen, 0xf/bg=modal,   1/y, "                                                                                                                                ", "F - test-create-global/bg1"
+ 720   check-background-color-in-screen-row screen, 0xf/bg=modal,   2/y, "                                                                                                                                ", "F - test-create-global/bg2"
+ 721   check-background-color-in-screen-row screen, 0xf/bg=modal,   3/y, "                                                                                                                                ", "F - test-create-global/bg3"
+ 722   check-background-color-in-screen-row screen, 0xf/bg=modal,   4/y, "                                                                                                                                ", "F - test-create-global/bg4"
+ 723   check-background-color-in-screen-row screen, 0xf/bg=modal,   5/y, "                                                                                                                                ", "F - test-create-global/bg5"
+ 724   check-background-color-in-screen-row screen, 0xf/bg=modal,   6/y, "                                                                                                                                ", "F - test-create-global/bg6"
+ 725   check-background-color-in-screen-row screen, 0xf/bg=modal,   7/y, "                                                                                                                                ", "F - test-create-global/bg7"
+ 726   check-background-color-in-screen-row screen, 0xf/bg=modal,   8/y, "                                                                                                                                ", "F - test-create-global/bg8"
+ 727   check-background-color-in-screen-row screen, 0xf/bg=modal,   9/y, "                                                                                                                                ", "F - test-create-global/bg9"
+ 728   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, "                                                                                                                                ", "F - test-create-global/bg10"
+ 729   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, "                                                                                                                                ", "F - test-create-global/bg11"
+ 730   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, "                                                                                                                                ", "F - test-create-global/bg12"
+ 731   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, "                                                                                                                                ", "F - test-create-global/bg13"
+ 732   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, "                                                                                                                                ", "F - test-create-global/bg14"
+ 733   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, "                                                                                                                                ", "F - test-create-global/bg15"
+ 734 }
+ 735 
+ 736 fn test-create-nonexistent-global {
+ 737   var env-storage: environment
+ 738   var env/esi: (addr environment) <- address env-storage
+ 739   initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
+ 740   # setup: screen
+ 741   var screen-on-stack: screen
+ 742   var screen/edi: (addr screen) <- address screen-on-stack
+ 743   initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
+ 744   # define a global
+ 745   type-in env, screen, "(define f 42)"
+ 746   edit-environment env, 0x13/ctrl-s, 0/no-disk
+ 747   render-environment screen, env
+ 748   # type in its name
+ 749   type-in env, screen, "f"
+ 750   # hit ctrl-g
+ 751   edit-environment env, 7/ctrl-g, 0/no-disk
+ 752   render-environment screen, env
+ 753   # submit
+ 754   edit-environment env, 0xd/ctrl-m, 0/no-disk
+ 755   render-environment screen, env
+ 756   # modal now shows an error
+ 757   #                                                                 | global definitions                                                                 | sandbox
+ 758   check-background-color-in-screen-row screen, 0xf/bg=modal,   0/y, "                                                                                                                                ", "F - test-create-nonexistent-global/0"
+ 759   check-background-color-in-screen-row screen, 0xf/bg=modal,   1/y, "                                                                                                                                ", "F - test-create-nonexistent-global/1"
+ 760   check-background-color-in-screen-row screen, 0xf/bg=modal,   2/y, "                                                                                                                                ", "F - test-create-nonexistent-global/2"
+ 761   check-background-color-in-screen-row screen, 0xf/bg=modal,   3/y, "                                                                                                                                ", "F - test-create-nonexistent-global/3"
+ 762   check-background-color-in-screen-row screen, 0xf/bg=modal,   4/y, "                                                                                                                                ", "F - test-create-nonexistent-global/4"
+ 763   check-background-color-in-screen-row screen, 0xf/bg=modal,   5/y, "                                                                                                                                ", "F - test-create-nonexistent-global/5"
+ 764   check-screen-row                     screen,                 6/y, "                                    go to global (or leave blank to go to REPL)                                                 ", "F - test-create-nonexistent-global/6-text"
+ 765   check-background-color-in-screen-row screen, 0xf/bg=modal,   6/y, "                                ................................................................                                ", "F - test-create-nonexistent-global/6"
+ 766   check-screen-row-in-color            screen, 4/fg=error,     7/y, "                                already exists                                                                                  ", "F - test-create-nonexistent-global/7-text"
+ 767   check-background-color-in-screen-row screen, 0xf/bg=modal,   7/y, "                                ................................................................                                ", "F - test-create-nonexistent-global/7"
+ 768   check-screen-row-in-color            screen, 0/fg,           8/y, "                                f                                                                                               ", "F - test-create-nonexistent-global/8-text"
+ 769   check-background-color-in-screen-row screen,   0/bg=cursor,  8/y, "                                 |                                                                                              ", "F - test-create-nonexistent-global/8-cursor"
+ 770   check-background-color-in-screen-row screen, 0xf/bg=modal,   8/y, "                                . ..............................................................                                ", "F - test-create-nonexistent-global/8"
+ 771   check-background-color-in-screen-row screen, 0xf/bg=modal,   9/y, "                                                                                                                                ", "F - test-create-nonexistent-global/9"
+ 772   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, "                                                                                                                                ", "F - test-create-nonexistent-global/10"
+ 773   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, "                                                                                                                                ", "F - test-create-nonexistent-global/11"
+ 774   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, "                                                                                                                                ", "F - test-create-nonexistent-global/12"
+ 775   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, "                                                                                                                                ", "F - test-create-nonexistent-global/13"
+ 776   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, "                                                                                                                                ", "F - test-create-nonexistent-global/14"
+ 777   # menu at bottom is correct in context
+ 778   check-screen-row                     screen,               0xf/y, " ^r  run main   enter  go   ^m  create   esc  cancel   ^a  <<   ^b  <word   ^f  word>   ^e  >>                                  ", "F - test-create-nonexistent-global/15-text"
+ 779   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, "                                                                                                                                ", "F - test-create-nonexistent-global/15"
+ 780   # cancel
+ 781   edit-environment env, 0x1b/escape, 0/no-disk
+ 782   render-environment screen, env
+ 783   # hit ctrl-g again
+ 784   edit-environment env, 7/ctrl-g, 0/no-disk
+ 785   render-environment screen, env
+ 786   # word prepopulated like before, but no error
+ 787   check-background-color-in-screen-row screen, 0xf/bg=modal,   0/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-0"
+ 788   check-background-color-in-screen-row screen, 0xf/bg=modal,   1/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-1"
+ 789   check-background-color-in-screen-row screen, 0xf/bg=modal,   2/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-2"
+ 790   check-background-color-in-screen-row screen, 0xf/bg=modal,   3/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-3"
+ 791   check-background-color-in-screen-row screen, 0xf/bg=modal,   4/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-4"
+ 792   check-background-color-in-screen-row screen, 0xf/bg=modal,   5/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-5"
+ 793   check-screen-row                     screen,                 6/y, "                                    go to global (or leave blank to go to REPL)                                                 ", "F - test-create-nonexistent-global/test2-6-text"
+ 794   check-background-color-in-screen-row screen, 0xf/bg=modal,   6/y, "                                ................................................................                                ", "F - test-create-nonexistent-global/test2-6"
+ 795   check-screen-row-in-color            screen, 4/fg=error,     7/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-7-text"
+ 796   check-background-color-in-screen-row screen, 0xf/bg=modal,   7/y, "                                ................................................................                                ", "F - test-create-nonexistent-global/test2-7"
+ 797   # same word at cursor
+ 798   check-screen-row-in-color            screen, 0/fg,           8/y, "                                f                                                                                               ", "F - test-create-nonexistent-global/test2-8-text"
+ 799   # new cursor position
+ 800   check-background-color-in-screen-row screen,   0/bg=cursor,  8/y, "                                 |                                                                                              ", "F - test-create-nonexistent-global/test2-8-cursor"
+ 801   check-background-color-in-screen-row screen, 0xf/bg=modal,   8/y, "                                . ..............................................................                                ", "F - test-create-nonexistent-global/test2-8"
+ 802   check-background-color-in-screen-row screen, 0xf/bg=modal,   9/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-9"
+ 803   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-10"
+ 804   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-11"
+ 805   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-12"
+ 806   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-13"
+ 807   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-14"
+ 808   check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, "                                                                                                                                ", "F - test-create-nonexistent-global/test2-15"
+ 809 }
+ 810 
+ 811 fn render-go-modal screen: (addr screen), _self: (addr environment) {
+ 812   var self/esi: (addr environment) <- copy _self
+ 813   var width/eax: int <- copy 0
+ 814   var height/ecx: int <- copy 0
+ 815   width, height <- screen-size screen
+ 816   # xmin = max(0, width/2 - 0x20)
+ 817   var xmin: int
+ 818   var tmp/edx: int <- copy width
+ 819   tmp <- shift-right 1
+ 820   tmp <- subtract 0x20/half-global-name-capacity
+ 821   {
+ 822     compare tmp, 0
+ 823     break-if->=
+ 824     tmp <- copy 0
+ 825   }
+ 826   copy-to xmin, tmp
+ 827   # xmax = min(width, width/2 + 0x20)
+ 828   var xmax: int
+ 829   tmp <- copy width
+ 830   tmp <- shift-right 1
+ 831   tmp <- add 0x20/half-global-name-capacity
+ 832   {
+ 833     compare tmp, width
+ 834     break-if-<=
+ 835     tmp <- copy width
+ 836   }
+ 837   copy-to xmax, tmp
+ 838   # ymin = height/2 - 2
+ 839   var ymin: int
+ 840   tmp <- copy height
+ 841   tmp <- shift-right 1
+ 842   tmp <- subtract 2
+ 843   copy-to ymin, tmp
+ 844   # ymax = height/2 + 1
+ 845   var ymax: int
+ 846   tmp <- add 3
+ 847   copy-to ymax, tmp
+ 848   #
+ 849   clear-rect screen, xmin, ymin, xmax, ymax, 0xf/bg=modal
+ 850   add-to xmin, 4
+ 851   set-cursor-position screen, xmin, ymin
+ 852   draw-text-rightward-from-cursor screen, "go to global (or leave blank to go to REPL)", xmax, 8/fg=dark-grey, 0xf/bg=modal
+ 853   var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
+ 854   var _partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
+ 855   var partial-global-name/edx: (addr gap-buffer) <- copy _partial-global-name
+ 856   subtract-from xmin, 4
+ 857   increment ymin
+ 858   {
+ 859     var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
+ 860     var go-modal-error/eax: (addr array byte) <- lookup *go-modal-error-ah
+ 861     compare go-modal-error, 0
+ 862     break-if-=
+ 863     var dummy/eax: int <- draw-text-rightward screen, go-modal-error, xmin, xmax, ymin, 4/fg=error, 0xf/bg=modal
+ 864   }
+ 865   increment ymin
+ 866   var dummy/eax: int <- copy 0
+ 867   var dummy2/ecx: int <- copy 0
+ 868   dummy, dummy2 <- render-gap-buffer-wrapping-right-then-down screen, partial-global-name, xmin, ymin, xmax, ymax, 1/always-render-cursor, 0/fg=black, 0xf/bg=modal
+ 869 }
+ 870 
+ 871 fn render-go-modal-menu screen: (addr screen), _self: (addr environment) {
+ 872   var self/esi: (addr environment) <- copy _self
+ 873   var _width/eax: int <- copy 0
+ 874   var height/ecx: int <- copy 0
+ 875   _width, height <- screen-size screen
+ 876   var width/edx: int <- copy _width
+ 877   var y/ecx: int <- copy height
+ 878   y <- decrement
+ 879   var height/ebx: int <- copy y
+ 880   height <- increment
+ 881   clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg
+ 882   set-cursor-position screen, 0/x, y
+ 883   draw-text-rightward-from-cursor screen, " ^r ", width, 0/fg, 0x5c/bg=menu-highlight
+ 884   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0xc5/bg=blue-bg
+ 885   draw-text-rightward-from-cursor screen, " enter ", width, 0/fg, 0xc/bg=menu-really-highlight
+ 886   draw-text-rightward-from-cursor screen, " go  ", width, 7/fg, 0xc5/bg=blue-bg
+ 887   draw-text-rightward-from-cursor screen, " ^m ", width, 0/fg, 0xc/bg=menu-really-highlight
+ 888   draw-text-rightward-from-cursor screen, " create  ", width, 7/fg, 0xc5/bg=blue-bg
+ 889   draw-text-rightward-from-cursor screen, " esc ", width, 0/fg, 0x5c/bg=menu-highlight
+ 890   draw-text-rightward-from-cursor screen, " cancel  ", width, 7/fg, 0xc5/bg=blue-bg
+ 891   draw-text-rightward-from-cursor screen, " ^a ", width, 0/fg, 0x5c/bg=menu-highlight
+ 892   draw-text-rightward-from-cursor screen, " <<  ", width, 7/fg, 0xc5/bg=blue-bg
+ 893   draw-text-rightward-from-cursor screen, " ^b ", width, 0/fg, 0x5c/bg=menu-highlight
+ 894   draw-text-rightward-from-cursor screen, " <word  ", width, 7/fg, 0xc5/bg=blue-bg
+ 895   draw-text-rightward-from-cursor screen, " ^f ", width, 0/fg, 0x5c/bg=menu-highlight
+ 896   draw-text-rightward-from-cursor screen, " word>  ", width, 7/fg, 0xc5/bg=blue-bg
+ 897   draw-text-rightward-from-cursor screen, " ^e ", width, 0/fg, 0x5c/bg=menu-highlight
+ 898   draw-text-rightward-from-cursor screen, " >>  ", width, 7/fg, 0xc5/bg=blue-bg
+ 899 }
+ 900 
+ 901 fn word-at-cursor _self: (addr environment), out: (addr stream byte) {
+ 902   var self/esi: (addr environment) <- copy _self
+ 903   var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
+ 904   compare *cursor-in-go-modal-a, 0/false
+ 905   {
+ 906     break-if-=
+ 907     # cursor in go modal
+ 908     return
+ 909   }
+ 910   var cursor-in-globals-a/edx: (addr boolean) <- get self, cursor-in-globals?
+ 911   compare *cursor-in-globals-a, 0/false
+ 912   {
+ 913     break-if-=
+ 914     # cursor in some global editor
+ 915     var globals/eax: (addr global-table) <- get self, globals
+ 916     var cursor-index-addr/ecx: (addr int) <- get globals, cursor-index
+ 917     var cursor-index/ecx: int <- copy *cursor-index-addr
+ 918     var globals-data-ah/eax: (addr handle array global) <- get globals, data
+ 919     var globals-data/eax: (addr array global) <- lookup *globals-data-ah
+ 920     var cursor-offset/ecx: (offset global) <- compute-offset globals-data, cursor-index
+ 921     var curr-global/eax: (addr global) <- index globals-data, cursor-offset
+ 922     var curr-global-data-ah/eax: (addr handle gap-buffer) <- get curr-global, input
+ 923     var curr-global-data/eax: (addr gap-buffer) <- lookup *curr-global-data-ah
+ 924     word-at-gap curr-global-data, out
+ 925     return
+ 926   }
+ 927   # cursor in sandbox
+ 928   var sandbox/ecx: (addr sandbox) <- get self, sandbox
+ 929   var sandbox-data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
+ 930   var sandbox-data/eax: (addr gap-buffer) <- lookup *sandbox-data-ah
+ 931   word-at-gap sandbox-data, out
+ 932 }
+ 933 
+ 934 # Gotcha: some saved state may not load.
+ 935 fn load-state _self: (addr environment), data-disk: (addr disk) {
+ 936   var self/esi: (addr environment) <- copy _self
+ 937   # data-disk -> stream
+ 938   var s-storage: (stream byte 0x2000)  # space for 16/sectors
+ 939   var s/ebx: (addr stream byte) <- address s-storage
+ 940   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sectors from data disk", 3/fg, 0/bg
+ 941   move-cursor-to-left-margin-of-next-line 0/screen
+ 942   load-sectors data-disk, 0/lba, 0x10/sectors, s
+ 943 #?   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg, 0xc5/bg=blue-bg
+ 944   # stream -> gap-buffer (HACK: we temporarily cannibalize the sandbox's gap-buffer)
+ 945   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "parsing", 3/fg, 0/bg
+ 946   move-cursor-to-left-margin-of-next-line 0/screen
+ 947   var sandbox/eax: (addr sandbox) <- get self, sandbox
+ 948   var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
+ 949   var data/eax: (addr gap-buffer) <- lookup *data-ah
+ 950   load-gap-buffer-from-stream data, s
+ 951   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "  into gap buffer", 3/fg, 0/bg
+ 952   move-cursor-to-left-margin-of-next-line 0/screen
+ 953   clear-stream s
+ 954   # read: gap-buffer -> cell
+ 955   var initial-root-storage: (handle cell)
+ 956   var initial-root/ecx: (addr handle cell) <- address initial-root-storage
+ 957   var trace-storage: trace
+ 958   var trace/edi: (addr trace) <- address trace-storage
+ 959   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 960   read-cell data, initial-root, trace
+ 961   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "  into s-expressions", 3/fg, 0/bg
+ 962   move-cursor-to-left-margin-of-next-line 0/screen
+ 963   clear-gap-buffer data
+ 964   #
+ 965   {
+ 966     var initial-root-addr/eax: (addr cell) <- lookup *initial-root
+ 967     compare initial-root-addr, 0
+ 968     break-if-!=
+ 969     return
+ 970   }
+ 971   # load globals from assoc(initial-root, 'globals)
+ 972   var globals-literal-storage: (handle cell)
+ 973   var globals-literal-ah/eax: (addr handle cell) <- address globals-literal-storage
+ 974   new-symbol globals-literal-ah, "globals"
+ 975   var globals-literal/eax: (addr cell) <- lookup *globals-literal-ah
+ 976   var globals-cell-storage: (handle cell)
+ 977   var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage
+ 978   clear-trace trace
+ 979   lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
+ 980   var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah
+ 981   {
+ 982     compare globals-cell, 0
+ 983     break-if-=
+ 984     var globals/eax: (addr global-table) <- get self, globals
+ 985     load-globals globals-cell-ah, globals
+ 986   }
+ 987   # sandbox = assoc(initial-root, 'sandbox)
+ 988   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sandbox", 3/fg, 0/bg
+ 989   var sandbox-literal-storage: (handle cell)
+ 990   var sandbox-literal-ah/eax: (addr handle cell) <- address sandbox-literal-storage
+ 991   new-symbol sandbox-literal-ah, "sandbox"
+ 992   var sandbox-literal/eax: (addr cell) <- lookup *sandbox-literal-ah
+ 993   var sandbox-cell-storage: (handle cell)
+ 994   var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage
+ 995   clear-trace trace
+ 996   lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
+ 997   var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah
+ 998   {
+ 999     compare sandbox-cell, 0
+1000     break-if-=
+1001     # print: cell -> stream
+1002     clear-trace trace
+1003     print-cell sandbox-cell-ah, s, trace
+1004     # stream -> gap-buffer
+1005     var sandbox/eax: (addr sandbox) <- get self, sandbox
+1006     var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
+1007     var data/eax: (addr gap-buffer) <- lookup *data-ah
+1008     load-gap-buffer-from-stream data, s
+1009   }
+1010 }
+1011 
+1012 # Save state as an alist of alists:
+1013 #   ((globals . ((a . (fn ...))
+1014 #                ...))
+1015 #    (sandbox . ...))
+1016 fn store-state data-disk: (addr disk), sandbox: (addr sandbox), globals: (addr global-table) {
+1017   compare data-disk, 0/no-disk
+1018   {
+1019     break-if-!=
+1020     return
+1021   }
+1022   var stream-storage: (stream byte 0x2000)  # space enough for 16/sectors
+1023   var stream/edi: (addr stream byte) <- address stream-storage
+1024   write stream, "(\n"
+1025   write-globals stream, globals
+1026   write-sandbox stream, sandbox
+1027   write stream, ")\n"
+1028   store-sectors data-disk, 0/lba, 0x10/sectors, stream
+1029 }
diff --git a/html/shell/evaluate.mu.html b/html/shell/evaluate.mu.html index 7e81fa31..cb252db0 100644 --- a/html/shell/evaluate.mu.html +++ b/html/shell/evaluate.mu.html @@ -17,6 +17,7 @@ a { color:inherit; } .LineNr { } .Delimiter { color: #c000c0; } .CommentedCode { color: #8a8a8a; } +.muRegEdx { color: #878700; } .muRegEbx { color: #8787af; } .muRegEsi { color: #87d787; } .muRegEdi { color: #87ffd7; } @@ -29,7 +30,6 @@ a { color:inherit; } .muComment { color: #005faf; } .muRegEax { color: #875f00; } .muRegEcx { color: #af875f; } -.muRegEdx { color: #878700; } --> @@ -69,533 +69,533 @@ if ('onhashchange' in window) { 2 # we never modify `_in-ah` or `env` 3 # ignore args past 'trace' on a first reading; they're for the environment not the language 4 # 'call-number' is just for showing intermediate progress; this is a _slow_ interpreter - 5 # side-effects if not in a test (screen-cell != 0): - 6 # prints intermediate states of the screen to real screen - 7 # stops if a keypress is encountered - 8 fn evaluate _in-ah: (addr handle cell), _out-ah: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int { - 9 # stack overflow? # disable when enabling Really-debug-print - 10 check-stack - 11 { - 12 var screen-cell/eax: (addr handle cell) <- copy screen-cell - 13 compare screen-cell, 0 - 14 break-if-= - 15 var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell - 16 compare screen-cell-addr, 0 - 17 break-if-= - 18 # if screen-cell exists, we're probably not in a test - 19 show-stack-state - 20 } - 21 # show intermediate progress on screen if necessary - 22 # treat input at the real keyboard as interrupting - 23 { - 24 compare screen-cell, 0 - 25 break-if-= - 26 var tmp/eax: int <- copy call-number - 27 tmp <- and 0xf # every 16 calls to evaluate - 28 compare tmp, 0 - 29 break-if-!= - 30 var screen-cell/eax: (addr handle cell) <- copy screen-cell - 31 var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell - 32 compare screen-cell-addr, 0 - 33 break-if-= - 34 var screen-obj-ah/eax: (addr handle screen) <- get screen-cell-addr, screen-data - 35 var screen-obj/eax: (addr screen) <- lookup *screen-obj-ah - 36 compare screen-obj, 0 - 37 break-if-= - 38 var y/ecx: int <- render-screen 0/screen, screen-obj, 0x70/xmin, 1/ymin - 39 var key/eax: byte <- read-key 0/keyboard - 40 compare key, 0 - 41 break-if-= - 42 error trace, "key pressed; interrupting..." - 43 } - 44 # errors? skip - 45 { - 46 var error?/eax: boolean <- has-errors? trace - 47 compare error?, 0/false - 48 break-if-= - 49 return - 50 } - 51 var in-ah/esi: (addr handle cell) <- copy _in-ah - 52 #? dump-cell in-ah - 53 #? { - 54 #? var foo/eax: byte <- read-key 0/keyboard - 55 #? compare foo, 0 - 56 #? loop-if-= - 57 #? } - 58 +-- 19 lines: # trace "evaluate " in " in environment " env ----------------------------------------------------------------------------------------------------------------------------- - 77 trace-lower trace - 78 var in/eax: (addr cell) <- lookup *in-ah - 79 { - 80 var nil?/eax: boolean <- nil? in - 81 compare nil?, 0/false - 82 break-if-= - 83 # nil is a literal - 84 trace-text trace, "eval", "nil" - 85 copy-object _in-ah, _out-ah - 86 trace-higher trace - 87 return - 88 } - 89 var in-type/ecx: (addr int) <- get in, type - 90 compare *in-type, 1/number - 91 { - 92 break-if-!= - 93 # numbers are literals - 94 trace-text trace, "eval", "number" - 95 copy-object _in-ah, _out-ah - 96 trace-higher trace - 97 return - 98 } - 99 compare *in-type, 3/stream - 100 { - 101 break-if-!= - 102 # streams are literals - 103 trace-text trace, "eval", "stream" - 104 copy-object _in-ah, _out-ah - 105 trace-higher trace - 106 return - 107 } - 108 compare *in-type, 2/symbol - 109 { - 110 break-if-!= - 111 trace-text trace, "eval", "symbol" - 112 debug-print "a", 7/fg, 0/bg - 113 lookup-symbol in, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell - 114 debug-print "z", 7/fg, 0/bg - 115 trace-higher trace - 116 return - 117 } - 118 compare *in-type, 5/screen - 119 { - 120 break-if-!= - 121 trace-text trace, "eval", "screen" - 122 copy-object _in-ah, _out-ah - 123 trace-higher trace - 124 return - 125 } - 126 compare *in-type, 6/keyboard - 127 { - 128 break-if-!= - 129 trace-text trace, "eval", "keyboard" - 130 copy-object _in-ah, _out-ah - 131 trace-higher trace - 132 return - 133 } - 134 # 'in' is a syntax tree - 135 $evaluate:literal-function: { - 136 # trees starting with "litfn" are literals - 137 var expr/esi: (addr cell) <- copy in - 138 var in/edx: (addr cell) <- copy in - 139 var first-ah/ecx: (addr handle cell) <- get in, left - 140 var first/eax: (addr cell) <- lookup *first-ah - 141 var litfn?/eax: boolean <- litfn? first - 142 compare litfn?, 0/false - 143 break-if-= - 144 trace-text trace, "eval", "literal function" - 145 copy-object _in-ah, _out-ah - 146 trace-higher trace - 147 return - 148 } - 149 $evaluate:literal-macro: { - 150 # trees starting with "litmac" are literals - 151 var expr/esi: (addr cell) <- copy in - 152 var in/edx: (addr cell) <- copy in - 153 var first-ah/ecx: (addr handle cell) <- get in, left - 154 var first/eax: (addr cell) <- lookup *first-ah - 155 var litmac?/eax: boolean <- litmac? first - 156 compare litmac?, 0/false - 157 break-if-= - 158 trace-text trace, "eval", "literal macro" - 159 copy-object _in-ah, _out-ah - 160 trace-higher trace - 161 return - 162 } - 163 $evaluate:anonymous-function: { - 164 # trees starting with "fn" are anonymous functions - 165 var expr/esi: (addr cell) <- copy in - 166 var in/edx: (addr cell) <- copy in - 167 var first-ah/ecx: (addr handle cell) <- get in, left - 168 var first/eax: (addr cell) <- lookup *first-ah - 169 var fn?/eax: boolean <- fn? first - 170 compare fn?, 0/false - 171 break-if-= - 172 # turn (fn ...) into (litfn env ...) - 173 trace-text trace, "eval", "anonymous function" - 174 var rest-ah/eax: (addr handle cell) <- get in, right - 175 var tmp: (handle cell) - 176 var tmp-ah/edi: (addr handle cell) <- address tmp - 177 new-pair tmp-ah, env-h, *rest-ah - 178 var litfn: (handle cell) - 179 var litfn-ah/eax: (addr handle cell) <- address litfn - 180 new-symbol litfn-ah, "litfn" - 181 new-pair _out-ah, *litfn-ah, *tmp-ah - 182 trace-higher trace - 183 return - 184 } - 185 # builtins with "special" evaluation rules - 186 $evaluate:quote: { - 187 # trees starting with single quote create literals - 188 var expr/esi: (addr cell) <- copy in - 189 # if its first elem is not "'", break - 190 var first-ah/ecx: (addr handle cell) <- get in, left - 191 var rest-ah/edx: (addr handle cell) <- get in, right - 192 var first/eax: (addr cell) <- lookup *first-ah - 193 var quote?/eax: boolean <- symbol-equal? first, "'" - 194 compare quote?, 0/false - 195 break-if-= - 196 # - 197 trace-text trace, "eval", "quote" - 198 copy-object rest-ah, _out-ah - 199 trace-higher trace - 200 return - 201 } - 202 $evaluate:backquote: { - 203 # trees starting with single backquote create literals - 204 var expr/esi: (addr cell) <- copy in - 205 # if its first elem is not "'", break - 206 var first-ah/ecx: (addr handle cell) <- get in, left - 207 var rest-ah/edx: (addr handle cell) <- get in, right - 208 var first/eax: (addr cell) <- lookup *first-ah - 209 var backquote?/eax: boolean <- symbol-equal? first, "`" - 210 compare backquote?, 0/false - 211 break-if-= - 212 # - 213 trace-text trace, "eval", "backquote" - 214 debug-print "`(", 7/fg, 0/bg - 215 evaluate-backquote rest-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 216 debug-print ")", 7/fg, 0/bg - 217 trace-higher trace - 218 return - 219 } - 220 $evaluate:define: { - 221 # trees starting with "define" define globals - 222 var expr/esi: (addr cell) <- copy in - 223 # if its first elem is not "define", break - 224 var first-ah/ecx: (addr handle cell) <- get in, left - 225 var rest-ah/edx: (addr handle cell) <- get in, right - 226 var first/eax: (addr cell) <- lookup *first-ah - 227 var define?/eax: boolean <- symbol-equal? first, "define" - 228 compare define?, 0/false - 229 break-if-= - 230 # - 231 trace-text trace, "eval", "define" - 232 trace-text trace, "eval", "evaluating second arg" - 233 var rest/eax: (addr cell) <- lookup *rest-ah - 234 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 235 { - 236 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 237 var first-arg-type/eax: (addr int) <- get first-arg, type - 238 compare *first-arg-type, 2/symbol - 239 break-if-= - 240 error trace, "first arg to define must be a symbol" - 241 trace-higher trace - 242 return - 243 } - 244 rest-ah <- get rest, right - 245 rest <- lookup *rest-ah - 246 var second-arg-ah/edx: (addr handle cell) <- get rest, left - 247 debug-print "P", 4/fg, 0/bg - 248 increment call-number - 249 evaluate second-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 250 debug-print "Q", 4/fg, 0/bg - 251 # errors? skip - 252 { - 253 var error?/eax: boolean <- has-errors? trace - 254 compare error?, 0/false - 255 break-if-= - 256 trace-higher trace - 257 return - 258 } - 259 trace-text trace, "eval", "saving global binding" - 260 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 261 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data - 262 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah - 263 var tmp-string: (handle array byte) - 264 var tmp-ah/edx: (addr handle array byte) <- address tmp-string - 265 rewind-stream first-arg-data - 266 stream-to-array first-arg-data, tmp-ah - 267 var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah - 268 var out-ah/edi: (addr handle cell) <- copy _out-ah - 269 assign-or-create-global globals, first-arg-data-string, *out-ah, trace - 270 trace-higher trace - 271 return - 272 } - 273 $evaluate:set: { - 274 # trees starting with "set" mutate bindings - 275 var expr/esi: (addr cell) <- copy in - 276 # if its first elem is not "set", break - 277 var first-ah/ecx: (addr handle cell) <- get in, left - 278 var rest-ah/edx: (addr handle cell) <- get in, right - 279 var first/eax: (addr cell) <- lookup *first-ah - 280 var set?/eax: boolean <- symbol-equal? first, "set" - 281 compare set?, 0/false - 282 break-if-= - 283 # - 284 trace-text trace, "eval", "set" - 285 trace-text trace, "eval", "evaluating second arg" - 286 var rest/eax: (addr cell) <- lookup *rest-ah - 287 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 288 { - 289 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 290 var first-arg-type/eax: (addr int) <- get first-arg, type - 291 compare *first-arg-type, 2/symbol - 292 break-if-= - 293 error trace, "first arg to set must be a symbol" - 294 trace-higher trace - 295 return - 296 } - 297 rest-ah <- get rest, right - 298 rest <- lookup *rest-ah - 299 var second-arg-ah/edx: (addr handle cell) <- get rest, left - 300 debug-print "P", 4/fg, 0/bg - 301 increment call-number - 302 evaluate second-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 303 debug-print "Q", 4/fg, 0/bg - 304 # errors? skip - 305 { - 306 var error?/eax: boolean <- has-errors? trace - 307 compare error?, 0/false - 308 break-if-= - 309 trace-higher trace - 310 return - 311 } - 312 trace-text trace, "eval", "mutating binding" - 313 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 314 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data - 315 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah - 316 mutate-binding first-arg-data, _out-ah, env-h, globals, trace - 317 trace-higher trace - 318 return - 319 } - 320 $evaluate:and: { - 321 var expr/esi: (addr cell) <- copy in - 322 # if its first elem is not "and", break - 323 var first-ah/ecx: (addr handle cell) <- get in, left - 324 var rest-ah/edx: (addr handle cell) <- get in, right - 325 var first/eax: (addr cell) <- lookup *first-ah - 326 var and?/eax: boolean <- symbol-equal? first, "and" - 327 compare and?, 0/false - 328 break-if-= - 329 # - 330 trace-text trace, "eval", "and" - 331 trace-text trace, "eval", "evaluating first arg" - 332 var rest/eax: (addr cell) <- lookup *rest-ah - 333 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 334 debug-print "R2", 4/fg, 0/bg - 335 increment call-number - 336 evaluate first-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 337 debug-print "S2", 4/fg, 0/bg - 338 # errors? skip - 339 { - 340 var error?/eax: boolean <- has-errors? trace - 341 compare error?, 0/false - 342 break-if-= - 343 trace-higher trace - 344 return - 345 } - 346 # if first arg is nil, short-circuit - 347 var out-ah/eax: (addr handle cell) <- copy _out-ah - 348 var out/eax: (addr cell) <- lookup *out-ah - 349 var nil?/eax: boolean <- nil? out - 350 compare nil?, 0/false - 351 { - 352 break-if-= - 353 trace-higher trace - 354 return - 355 } - 356 var rest/eax: (addr cell) <- lookup *rest-ah - 357 rest-ah <- get rest, right - 358 rest <- lookup *rest-ah - 359 var second-ah/eax: (addr handle cell) <- get rest, left - 360 debug-print "T2", 4/fg, 0/bg - 361 increment call-number - 362 evaluate second-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 363 debug-print "U2", 4/fg, 0/bg - 364 trace-higher trace - 365 return - 366 } - 367 $evaluate:or: { - 368 var expr/esi: (addr cell) <- copy in - 369 # if its first elem is not "or", break - 370 var first-ah/ecx: (addr handle cell) <- get in, left - 371 var rest-ah/edx: (addr handle cell) <- get in, right - 372 var first/eax: (addr cell) <- lookup *first-ah - 373 var or?/eax: boolean <- symbol-equal? first, "or" - 374 compare or?, 0/false - 375 break-if-= - 376 # - 377 trace-text trace, "eval", "or" - 378 trace-text trace, "eval", "evaluating first arg" - 379 var rest/eax: (addr cell) <- lookup *rest-ah - 380 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 381 debug-print "R2", 4/fg, 0/bg - 382 increment call-number - 383 evaluate first-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 384 debug-print "S2", 4/fg, 0/bg - 385 # errors? skip - 386 { - 387 var error?/eax: boolean <- has-errors? trace - 388 compare error?, 0/false - 389 break-if-= - 390 trace-higher trace - 391 return - 392 } - 393 # if first arg is not nil, short-circuit - 394 var out-ah/eax: (addr handle cell) <- copy _out-ah - 395 var out/eax: (addr cell) <- lookup *out-ah - 396 var nil?/eax: boolean <- nil? out - 397 compare nil?, 0/false - 398 { - 399 break-if-!= - 400 trace-higher trace - 401 return - 402 } - 403 var rest/eax: (addr cell) <- lookup *rest-ah - 404 rest-ah <- get rest, right - 405 rest <- lookup *rest-ah - 406 var second-ah/eax: (addr handle cell) <- get rest, left - 407 debug-print "T2", 4/fg, 0/bg - 408 increment call-number - 409 evaluate second-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 410 debug-print "U2", 4/fg, 0/bg - 411 # errors? skip - 412 { - 413 var error?/eax: boolean <- has-errors? trace - 414 compare error?, 0/false - 415 break-if-= - 416 trace-higher trace - 417 return - 418 } - 419 trace-higher trace - 420 return - 421 } - 422 $evaluate:if: { - 423 # trees starting with "if" are conditionals - 424 var expr/esi: (addr cell) <- copy in - 425 # if its first elem is not "if", break - 426 var first-ah/ecx: (addr handle cell) <- get in, left - 427 var rest-ah/edx: (addr handle cell) <- get in, right - 428 var first/eax: (addr cell) <- lookup *first-ah - 429 var if?/eax: boolean <- symbol-equal? first, "if" - 430 compare if?, 0/false - 431 break-if-= - 432 # - 433 trace-text trace, "eval", "if" - 434 trace-text trace, "eval", "evaluating first arg" - 435 var rest/eax: (addr cell) <- lookup *rest-ah - 436 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 437 var guard-h: (handle cell) - 438 var guard-ah/esi: (addr handle cell) <- address guard-h - 439 debug-print "R", 4/fg, 0/bg - 440 increment call-number - 441 evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 442 debug-print "S", 4/fg, 0/bg - 443 # errors? skip - 444 { - 445 var error?/eax: boolean <- has-errors? trace - 446 compare error?, 0/false - 447 break-if-= - 448 trace-higher trace - 449 return - 450 } - 451 rest-ah <- get rest, right - 452 rest <- lookup *rest-ah - 453 var branch-ah/edi: (addr handle cell) <- get rest, left - 454 var guard-a/eax: (addr cell) <- lookup *guard-ah - 455 var skip-to-third-arg?/eax: boolean <- nil? guard-a - 456 compare skip-to-third-arg?, 0/false - 457 { - 458 break-if-= - 459 trace-text trace, "eval", "skipping to third arg" - 460 var rest/eax: (addr cell) <- lookup *rest-ah - 461 rest-ah <- get rest, right - 462 rest <- lookup *rest-ah - 463 branch-ah <- get rest, left - 464 } - 465 debug-print "T", 4/fg, 0/bg - 466 increment call-number - 467 evaluate branch-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 468 debug-print "U", 4/fg, 0/bg - 469 trace-higher trace - 470 return - 471 } - 472 $evaluate:while: { - 473 # trees starting with "while" are loops - 474 var expr/esi: (addr cell) <- copy in - 475 # if its first elem is not "while", break - 476 var first-ah/ecx: (addr handle cell) <- get in, left - 477 var rest-ah/edx: (addr handle cell) <- get in, right - 478 var first/eax: (addr cell) <- lookup *first-ah - 479 var first-type/ecx: (addr int) <- get first, type - 480 compare *first-type, 2/symbol - 481 break-if-!= - 482 var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data - 483 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 484 var while?/eax: boolean <- stream-data-equal? sym-data, "while" - 485 compare while?, 0/false - 486 break-if-= - 487 # - 488 trace-text trace, "eval", "while" - 489 var rest/eax: (addr cell) <- lookup *rest-ah - 490 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 491 rest-ah <- get rest, right - 492 var guard-h: (handle cell) - 493 var guard-ah/esi: (addr handle cell) <- address guard-h - 494 $evaluate:while:loop-execution: { - 495 { - 496 var error?/eax: boolean <- has-errors? trace - 497 compare error?, 0/false - 498 break-if-!= $evaluate:while:loop-execution - 499 } - 500 trace-text trace, "eval", "loop termination check" - 501 debug-print "V", 4/fg, 0/bg - 502 increment call-number - 503 evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 504 debug-print "W", 4/fg, 0/bg - 505 # errors? skip - 506 { - 507 var error?/eax: boolean <- has-errors? trace - 508 compare error?, 0/false - 509 break-if-= - 510 trace-higher trace - 511 return - 512 } - 513 var guard-a/eax: (addr cell) <- lookup *guard-ah - 514 var done?/eax: boolean <- nil? guard-a - 515 compare done?, 0/false - 516 break-if-!= - 517 evaluate-exprs rest-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 518 # errors? skip - 519 { - 520 var error?/eax: boolean <- has-errors? trace - 521 compare error?, 0/false - 522 break-if-= - 523 trace-higher trace - 524 return - 525 } - 526 loop - 527 } - 528 trace-text trace, "eval", "loop terminated" - 529 trace-higher trace - 530 return - 531 } - 532 +-- 15 lines: # trace "evaluate function call elements in " in -------------------------------------------------------------------------------------------------------------------------- - 547 trace-lower trace - 548 var evaluated-list-storage: (handle cell) - 549 var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage - 550 var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah - 551 var curr/ecx: (addr cell) <- copy in - 552 $evaluate-list:loop: { - 553 allocate-pair curr-out-ah - 554 var nil?/eax: boolean <- nil? curr - 555 compare nil?, 0/false - 556 break-if-!= - 557 # eval left - 558 var curr-out/eax: (addr cell) <- lookup *curr-out-ah - 559 var left-out-ah/edi: (addr handle cell) <- get curr-out, left - 560 var left-ah/esi: (addr handle cell) <- get curr, left - 561 debug-print "A", 4/fg, 0/bg - 562 increment call-number - 563 evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number + 5 # side-effects if not in a test (inner-screen-var != 0): + 6 # prints intermediate states of the inner screen to outer screen + 7 # (which may not be the real screen if we're using double-buffering) + 8 # stops if a keypress is encountered + 9 # Inner screen is what Lisp programs modify. Outer screen is shows the program + 10 # and its inner screen to the environment. + 11 fn evaluate _in-ah: (addr handle cell), _out-ah: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell), definitions-created: (addr stream int), call-number: (addr int) { + 12 # stack overflow? # disable when enabling Really-debug-print + 13 check-stack + 14 { + 15 var running-tests?/eax: boolean <- running-tests? + 16 compare running-tests?, 0/false + 17 break-if-!= + 18 show-stack-state + 19 } + 20 # show intermediate progress on screen if necessary + 21 # treat input at the real keyboard as interrupting + 22 { + 23 compare inner-screen-var, 0 + 24 break-if-= + 25 var call-number/eax: (addr int) <- copy call-number + 26 compare call-number, 0 + 27 break-if-= + 28 increment *call-number + 29 var tmp/eax: int <- copy *call-number + 30 tmp <- and 0xf/responsiveness=16 # every 16 calls to evaluate + 31 compare tmp, 0 + 32 break-if-!= + 33 var inner-screen-var/eax: (addr handle cell) <- copy inner-screen-var + 34 var inner-screen-var-addr/eax: (addr cell) <- lookup *inner-screen-var + 35 compare inner-screen-var-addr, 0 + 36 break-if-= + 37 var screen-obj-ah/eax: (addr handle screen) <- get inner-screen-var-addr, screen-data + 38 var screen-obj/eax: (addr screen) <- lookup *screen-obj-ah + 39 compare screen-obj, 0 + 40 break-if-= + 41 render-screen 0/screen, screen-obj, 0x58/xmin, 2/ymin + 42 var key/eax: byte <- read-key 0/keyboard + 43 compare key, 0 + 44 break-if-= + 45 error trace, "key pressed; interrupting..." + 46 } + 47 # errors? skip + 48 { + 49 var error?/eax: boolean <- has-errors? trace + 50 compare error?, 0/false + 51 break-if-= + 52 return + 53 } + 54 var in-ah/esi: (addr handle cell) <- copy _in-ah + 55 #? dump-cell in-ah + 56 #? { + 57 #? var foo/eax: byte <- read-key 0/keyboard + 58 #? compare foo, 0 + 59 #? loop-if-= + 60 #? } + 61 +-- 19 lines: # trace "evaluate " in " in environment " env ----------------------------------------------------------------------------------------------------------------------------- + 80 trace-lower trace + 81 var in/eax: (addr cell) <- lookup *in-ah + 82 { + 83 var nil?/eax: boolean <- nil? in + 84 compare nil?, 0/false + 85 break-if-= + 86 # nil is a literal + 87 trace-text trace, "eval", "nil" + 88 copy-object _in-ah, _out-ah + 89 trace-higher trace + 90 return + 91 } + 92 var in-type/ecx: (addr int) <- get in, type + 93 compare *in-type, 1/number + 94 { + 95 break-if-!= + 96 # numbers are literals + 97 trace-text trace, "eval", "number" + 98 copy-object _in-ah, _out-ah + 99 trace-higher trace + 100 return + 101 } + 102 compare *in-type, 3/stream + 103 { + 104 break-if-!= + 105 # streams are literals + 106 trace-text trace, "eval", "stream" + 107 copy-object _in-ah, _out-ah + 108 trace-higher trace + 109 return + 110 } + 111 compare *in-type, 2/symbol + 112 { + 113 break-if-!= + 114 trace-text trace, "eval", "symbol" + 115 debug-print "a", 7/fg, 0/bg + 116 lookup-symbol in, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var + 117 debug-print "z", 7/fg, 0/bg + 118 trace-higher trace + 119 return + 120 } + 121 compare *in-type, 5/screen + 122 { + 123 break-if-!= + 124 trace-text trace, "eval", "screen" + 125 copy-object _in-ah, _out-ah + 126 trace-higher trace + 127 return + 128 } + 129 compare *in-type, 6/keyboard + 130 { + 131 break-if-!= + 132 trace-text trace, "eval", "keyboard" + 133 copy-object _in-ah, _out-ah + 134 trace-higher trace + 135 return + 136 } + 137 # 'in' is a syntax tree + 138 $evaluate:literal-function: { + 139 # trees starting with "litfn" are literals + 140 var expr/esi: (addr cell) <- copy in + 141 var in/edx: (addr cell) <- copy in + 142 var first-ah/ecx: (addr handle cell) <- get in, left + 143 var first/eax: (addr cell) <- lookup *first-ah + 144 var litfn?/eax: boolean <- litfn? first + 145 compare litfn?, 0/false + 146 break-if-= + 147 trace-text trace, "eval", "literal function" + 148 copy-object _in-ah, _out-ah + 149 trace-higher trace + 150 return + 151 } + 152 $evaluate:literal-macro: { + 153 # trees starting with "litmac" are literals + 154 var expr/esi: (addr cell) <- copy in + 155 var in/edx: (addr cell) <- copy in + 156 var first-ah/ecx: (addr handle cell) <- get in, left + 157 var first/eax: (addr cell) <- lookup *first-ah + 158 var litmac?/eax: boolean <- litmac? first + 159 compare litmac?, 0/false + 160 break-if-= + 161 trace-text trace, "eval", "literal macro" + 162 copy-object _in-ah, _out-ah + 163 trace-higher trace + 164 return + 165 } + 166 $evaluate:anonymous-function: { + 167 # trees starting with "fn" are anonymous functions + 168 var expr/esi: (addr cell) <- copy in + 169 var in/edx: (addr cell) <- copy in + 170 var first-ah/ecx: (addr handle cell) <- get in, left + 171 var first/eax: (addr cell) <- lookup *first-ah + 172 var fn?/eax: boolean <- fn? first + 173 compare fn?, 0/false + 174 break-if-= + 175 # turn (fn ...) into (litfn env ...) + 176 trace-text trace, "eval", "anonymous function" + 177 var rest-ah/eax: (addr handle cell) <- get in, right + 178 var tmp: (handle cell) + 179 var tmp-ah/edi: (addr handle cell) <- address tmp + 180 new-pair tmp-ah, env-h, *rest-ah + 181 var litfn: (handle cell) + 182 var litfn-ah/eax: (addr handle cell) <- address litfn + 183 new-symbol litfn-ah, "litfn" + 184 new-pair _out-ah, *litfn-ah, *tmp-ah + 185 trace-higher trace + 186 return + 187 } + 188 # builtins with "special" evaluation rules + 189 $evaluate:quote: { + 190 # trees starting with single quote create literals + 191 var expr/esi: (addr cell) <- copy in + 192 # if its first elem is not "'", break + 193 var first-ah/ecx: (addr handle cell) <- get in, left + 194 var rest-ah/edx: (addr handle cell) <- get in, right + 195 var first/eax: (addr cell) <- lookup *first-ah + 196 var quote?/eax: boolean <- symbol-equal? first, "'" + 197 compare quote?, 0/false + 198 break-if-= + 199 # + 200 trace-text trace, "eval", "quote" + 201 copy-object rest-ah, _out-ah + 202 trace-higher trace + 203 return + 204 } + 205 $evaluate:backquote: { + 206 # trees starting with single backquote create literals + 207 var expr/esi: (addr cell) <- copy in + 208 # if its first elem is not "'", break + 209 var first-ah/ecx: (addr handle cell) <- get in, left + 210 var rest-ah/edx: (addr handle cell) <- get in, right + 211 var first/eax: (addr cell) <- lookup *first-ah + 212 var backquote?/eax: boolean <- symbol-equal? first, "`" + 213 compare backquote?, 0/false + 214 break-if-= + 215 # + 216 trace-text trace, "eval", "backquote" + 217 debug-print "`(", 7/fg, 0/bg + 218 evaluate-backquote rest-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 219 debug-print ")", 7/fg, 0/bg + 220 trace-higher trace + 221 return + 222 } + 223 $evaluate:define: { + 224 # trees starting with "define" define globals + 225 var expr/esi: (addr cell) <- copy in + 226 # if its first elem is not "define", break + 227 var first-ah/ecx: (addr handle cell) <- get in, left + 228 var rest-ah/edx: (addr handle cell) <- get in, right + 229 var first/eax: (addr cell) <- lookup *first-ah + 230 var define?/eax: boolean <- symbol-equal? first, "define" + 231 compare define?, 0/false + 232 break-if-= + 233 # + 234 trace-text trace, "eval", "define" + 235 trace-text trace, "eval", "evaluating second arg" + 236 var rest/eax: (addr cell) <- lookup *rest-ah + 237 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 238 { + 239 var first-arg/eax: (addr cell) <- lookup *first-arg-ah + 240 var first-arg-type/eax: (addr int) <- get first-arg, type + 241 compare *first-arg-type, 2/symbol + 242 break-if-= + 243 error trace, "first arg to define must be a symbol" + 244 trace-higher trace + 245 return + 246 } + 247 rest-ah <- get rest, right + 248 rest <- lookup *rest-ah + 249 var second-arg-ah/edx: (addr handle cell) <- get rest, left + 250 debug-print "P", 4/fg, 0/bg + 251 evaluate second-arg-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 252 debug-print "Q", 4/fg, 0/bg + 253 # errors? skip + 254 { + 255 var error?/eax: boolean <- has-errors? trace + 256 compare error?, 0/false + 257 break-if-= + 258 trace-higher trace + 259 return + 260 } + 261 trace-text trace, "eval", "saving global binding" + 262 var first-arg/eax: (addr cell) <- lookup *first-arg-ah + 263 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data + 264 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah + 265 var tmp-string: (handle array byte) + 266 var tmp-ah/edx: (addr handle array byte) <- address tmp-string + 267 rewind-stream first-arg-data + 268 stream-to-array first-arg-data, tmp-ah + 269 var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah + 270 var out-ah/edi: (addr handle cell) <- copy _out-ah + 271 var defined-index: int + 272 var defined-index-addr/ecx: (addr int) <- address defined-index + 273 assign-or-create-global globals, first-arg-data-string, *out-ah, defined-index-addr, trace + 274 { + 275 compare definitions-created, 0 + 276 break-if-= + 277 write-to-stream definitions-created, defined-index-addr + 278 } + 279 trace-higher trace + 280 return + 281 } + 282 $evaluate:set: { + 283 # trees starting with "set" mutate bindings + 284 var expr/esi: (addr cell) <- copy in + 285 # if its first elem is not "set", break + 286 var first-ah/ecx: (addr handle cell) <- get in, left + 287 var rest-ah/edx: (addr handle cell) <- get in, right + 288 var first/eax: (addr cell) <- lookup *first-ah + 289 var set?/eax: boolean <- symbol-equal? first, "set" + 290 compare set?, 0/false + 291 break-if-= + 292 # + 293 trace-text trace, "eval", "set" + 294 trace-text trace, "eval", "evaluating second arg" + 295 var rest/eax: (addr cell) <- lookup *rest-ah + 296 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 297 { + 298 var first-arg/eax: (addr cell) <- lookup *first-arg-ah + 299 var first-arg-type/eax: (addr int) <- get first-arg, type + 300 compare *first-arg-type, 2/symbol + 301 break-if-= + 302 error trace, "first arg to set must be a symbol" + 303 trace-higher trace + 304 return + 305 } + 306 rest-ah <- get rest, right + 307 rest <- lookup *rest-ah + 308 var second-arg-ah/edx: (addr handle cell) <- get rest, left + 309 debug-print "P", 4/fg, 0/bg + 310 evaluate second-arg-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 311 debug-print "Q", 4/fg, 0/bg + 312 # errors? skip + 313 { + 314 var error?/eax: boolean <- has-errors? trace + 315 compare error?, 0/false + 316 break-if-= + 317 trace-higher trace + 318 return + 319 } + 320 trace-text trace, "eval", "mutating binding" + 321 var first-arg/eax: (addr cell) <- lookup *first-arg-ah + 322 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data + 323 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah + 324 mutate-binding first-arg-data, _out-ah, env-h, globals, trace + 325 trace-higher trace + 326 return + 327 } + 328 $evaluate:and: { + 329 var expr/esi: (addr cell) <- copy in + 330 # if its first elem is not "and", break + 331 var first-ah/ecx: (addr handle cell) <- get in, left + 332 var rest-ah/edx: (addr handle cell) <- get in, right + 333 var first/eax: (addr cell) <- lookup *first-ah + 334 var and?/eax: boolean <- symbol-equal? first, "and" + 335 compare and?, 0/false + 336 break-if-= + 337 # + 338 trace-text trace, "eval", "and" + 339 trace-text trace, "eval", "evaluating first arg" + 340 var rest/eax: (addr cell) <- lookup *rest-ah + 341 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 342 debug-print "R2", 4/fg, 0/bg + 343 evaluate first-arg-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 344 debug-print "S2", 4/fg, 0/bg + 345 # errors? skip + 346 { + 347 var error?/eax: boolean <- has-errors? trace + 348 compare error?, 0/false + 349 break-if-= + 350 trace-higher trace + 351 return + 352 } + 353 # if first arg is nil, short-circuit + 354 var out-ah/eax: (addr handle cell) <- copy _out-ah + 355 var out/eax: (addr cell) <- lookup *out-ah + 356 var nil?/eax: boolean <- nil? out + 357 compare nil?, 0/false + 358 { + 359 break-if-= + 360 trace-higher trace + 361 return + 362 } + 363 var rest/eax: (addr cell) <- lookup *rest-ah + 364 rest-ah <- get rest, right + 365 rest <- lookup *rest-ah + 366 var second-ah/eax: (addr handle cell) <- get rest, left + 367 debug-print "T2", 4/fg, 0/bg + 368 evaluate second-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 369 debug-print "U2", 4/fg, 0/bg + 370 trace-higher trace + 371 return + 372 } + 373 $evaluate:or: { + 374 var expr/esi: (addr cell) <- copy in + 375 # if its first elem is not "or", break + 376 var first-ah/ecx: (addr handle cell) <- get in, left + 377 var rest-ah/edx: (addr handle cell) <- get in, right + 378 var first/eax: (addr cell) <- lookup *first-ah + 379 var or?/eax: boolean <- symbol-equal? first, "or" + 380 compare or?, 0/false + 381 break-if-= + 382 # + 383 trace-text trace, "eval", "or" + 384 trace-text trace, "eval", "evaluating first arg" + 385 var rest/eax: (addr cell) <- lookup *rest-ah + 386 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 387 debug-print "R2", 4/fg, 0/bg + 388 evaluate first-arg-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 389 debug-print "S2", 4/fg, 0/bg + 390 # errors? skip + 391 { + 392 var error?/eax: boolean <- has-errors? trace + 393 compare error?, 0/false + 394 break-if-= + 395 trace-higher trace + 396 return + 397 } + 398 # if first arg is not nil, short-circuit + 399 var out-ah/eax: (addr handle cell) <- copy _out-ah + 400 var out/eax: (addr cell) <- lookup *out-ah + 401 var nil?/eax: boolean <- nil? out + 402 compare nil?, 0/false + 403 { + 404 break-if-!= + 405 trace-higher trace + 406 return + 407 } + 408 var rest/eax: (addr cell) <- lookup *rest-ah + 409 rest-ah <- get rest, right + 410 rest <- lookup *rest-ah + 411 var second-ah/eax: (addr handle cell) <- get rest, left + 412 debug-print "T2", 4/fg, 0/bg + 413 evaluate second-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 414 debug-print "U2", 4/fg, 0/bg + 415 # errors? skip + 416 { + 417 var error?/eax: boolean <- has-errors? trace + 418 compare error?, 0/false + 419 break-if-= + 420 trace-higher trace + 421 return + 422 } + 423 trace-higher trace + 424 return + 425 } + 426 $evaluate:if: { + 427 # trees starting with "if" are conditionals + 428 var expr/esi: (addr cell) <- copy in + 429 # if its first elem is not "if", break + 430 var first-ah/ecx: (addr handle cell) <- get in, left + 431 var rest-ah/edx: (addr handle cell) <- get in, right + 432 var first/eax: (addr cell) <- lookup *first-ah + 433 var if?/eax: boolean <- symbol-equal? first, "if" + 434 compare if?, 0/false + 435 break-if-= + 436 # + 437 trace-text trace, "eval", "if" + 438 trace-text trace, "eval", "evaluating first arg" + 439 var rest/eax: (addr cell) <- lookup *rest-ah + 440 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 441 var guard-h: (handle cell) + 442 var guard-ah/esi: (addr handle cell) <- address guard-h + 443 debug-print "R", 4/fg, 0/bg + 444 evaluate first-arg-ah, guard-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 445 debug-print "S", 4/fg, 0/bg + 446 # errors? skip + 447 { + 448 var error?/eax: boolean <- has-errors? trace + 449 compare error?, 0/false + 450 break-if-= + 451 trace-higher trace + 452 return + 453 } + 454 rest-ah <- get rest, right + 455 rest <- lookup *rest-ah + 456 var branch-ah/edi: (addr handle cell) <- get rest, left + 457 var guard-a/eax: (addr cell) <- lookup *guard-ah + 458 var skip-to-third-arg?/eax: boolean <- nil? guard-a + 459 compare skip-to-third-arg?, 0/false + 460 { + 461 break-if-= + 462 trace-text trace, "eval", "skipping to third arg" + 463 var rest/eax: (addr cell) <- lookup *rest-ah + 464 rest-ah <- get rest, right + 465 rest <- lookup *rest-ah + 466 branch-ah <- get rest, left + 467 } + 468 debug-print "T", 4/fg, 0/bg + 469 evaluate branch-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 470 debug-print "U", 4/fg, 0/bg + 471 trace-higher trace + 472 return + 473 } + 474 $evaluate:while: { + 475 # trees starting with "while" are loops + 476 var expr/esi: (addr cell) <- copy in + 477 # if its first elem is not "while", break + 478 var first-ah/ecx: (addr handle cell) <- get in, left + 479 var rest-ah/edx: (addr handle cell) <- get in, right + 480 var first/eax: (addr cell) <- lookup *first-ah + 481 var first-type/ecx: (addr int) <- get first, type + 482 compare *first-type, 2/symbol + 483 break-if-!= + 484 var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data + 485 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah + 486 var while?/eax: boolean <- stream-data-equal? sym-data, "while" + 487 compare while?, 0/false + 488 break-if-= + 489 # + 490 trace-text trace, "eval", "while" + 491 var rest/eax: (addr cell) <- lookup *rest-ah + 492 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 493 rest-ah <- get rest, right + 494 var guard-h: (handle cell) + 495 var guard-ah/esi: (addr handle cell) <- address guard-h + 496 $evaluate:while:loop-execution: { + 497 { + 498 var error?/eax: boolean <- has-errors? trace + 499 compare error?, 0/false + 500 break-if-!= $evaluate:while:loop-execution + 501 } + 502 trace-text trace, "eval", "loop termination check" + 503 debug-print "V", 4/fg, 0/bg + 504 evaluate first-arg-ah, guard-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 505 debug-print "W", 4/fg, 0/bg + 506 # errors? skip + 507 { + 508 var error?/eax: boolean <- has-errors? trace + 509 compare error?, 0/false + 510 break-if-= + 511 trace-higher trace + 512 return + 513 } + 514 var guard-a/eax: (addr cell) <- lookup *guard-ah + 515 var done?/eax: boolean <- nil? guard-a + 516 compare done?, 0/false + 517 break-if-!= + 518 evaluate-exprs rest-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 519 # errors? skip + 520 { + 521 var error?/eax: boolean <- has-errors? trace + 522 compare error?, 0/false + 523 break-if-= + 524 trace-higher trace + 525 return + 526 } + 527 loop + 528 } + 529 trace-text trace, "eval", "loop terminated" + 530 trace-higher trace + 531 return + 532 } + 533 +-- 15 lines: # trace "evaluate function call elements in " in -------------------------------------------------------------------------------------------------------------------------- + 548 trace-lower trace + 549 var evaluated-list-storage: (handle cell) + 550 var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage + 551 var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah + 552 var curr/ecx: (addr cell) <- copy in + 553 $evaluate-list:loop: { + 554 allocate-pair curr-out-ah + 555 var nil?/eax: boolean <- nil? curr + 556 compare nil?, 0/false + 557 break-if-!= + 558 # eval left + 559 var curr-out/eax: (addr cell) <- lookup *curr-out-ah + 560 var left-out-ah/edi: (addr handle cell) <- get curr-out, left + 561 var left-ah/esi: (addr handle cell) <- get curr, left + 562 debug-print "A", 4/fg, 0/bg + 563 evaluate left-ah, left-out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number 564 debug-print "B", 4/fg, 0/bg 565 # errors? skip 566 { @@ -618,14 +618,14 @@ if ('onhashchange' in window) { 583 var function-ah/ecx: (addr handle cell) <- get evaluated-list, left 584 var args-ah/edx: (addr handle cell) <- get evaluated-list, right 585 debug-print "C", 4/fg, 0/bg - 586 apply function-ah, args-ah, _out-ah, globals, trace, screen-cell, keyboard-cell, call-number + 586 apply function-ah, args-ah, _out-ah, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number 587 debug-print "Y", 4/fg, 0/bg 588 trace-higher trace 589 +-- 15 lines: # trace "=> " _out-ah ----------------------------------------------------------------------------------------------------------------------------------------------------- 604 debug-print "Z", 4/fg, 0/bg 605 } 606 - 607 fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int { + 607 fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell), definitions-created: (addr stream int), call-number: (addr int) { 608 var f-ah/eax: (addr handle cell) <- copy _f-ah 609 var _f/eax: (addr cell) <- lookup *f-ah 610 var f/esi: (addr cell) <- copy _f @@ -634,7 +634,7 @@ if ('onhashchange' in window) { 613 var f-type/eax: (addr int) <- get f, type 614 compare *f-type, 4/primitive-function 615 break-if-!= - 616 apply-primitive f, args-ah, out, globals, trace + 616 apply-primitive f, args-ah, out, globals, trace 617 return 618 } 619 # if it's not a primitive function it must be an anonymous function @@ -646,8 +646,8 @@ if ('onhashchange' in window) { 643 break-if-!= 644 var first-ah/eax: (addr handle cell) <- get f, left 645 var first/eax: (addr cell) <- lookup *first-ah - 646 var litfn?/eax: boolean <- litfn? first - 647 compare litfn?, 0/false + 646 var litfn?/eax: boolean <- litfn? first + 647 compare litfn?, 0/false 648 break-if-= 649 var rest-ah/esi: (addr handle cell) <- get f, right 650 var rest/eax: (addr cell) <- lookup *rest-ah @@ -657,7 +657,7 @@ if ('onhashchange' in window) { 654 var params-ah/ecx: (addr handle cell) <- get rest, left 655 var body-ah/eax: (addr handle cell) <- get rest, right 656 debug-print "D", 7/fg, 0/bg - 657 apply-function params-ah, args-ah, body-ah, out, *callee-env-ah, globals, trace, screen-cell, keyboard-cell, call-number + 657 apply-function params-ah, args-ah, body-ah, out, *callee-env-ah, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number 658 debug-print "Y", 7/fg, 0/bg 659 trace-higher trace 660 return @@ -665,11 +665,11 @@ if ('onhashchange' in window) { 662 error trace, "unknown function" 663 } 664 - 665 fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), body-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int { + 665 fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), body-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell), definitions-created: (addr stream int), call-number: (addr int) { 666 # push bindings for params to env 667 var new-env-h: (handle cell) 668 var new-env-ah/esi: (addr handle cell) <- address new-env-h - 669 push-bindings params-ah, args-ah, env-h, new-env-ah, trace + 669 push-bindings params-ah, args-ah, env-h, new-env-ah, trace 670 # errors? skip 671 { 672 var error?/eax: boolean <- has-errors? trace @@ -678,10 +678,10 @@ if ('onhashchange' in window) { 675 return 676 } 677 # - 678 evaluate-exprs body-ah, out, new-env-h, globals, trace, screen-cell, keyboard-cell, call-number + 678 evaluate-exprs body-ah, out, new-env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number 679 } 680 - 681 fn evaluate-exprs _exprs-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int { + 681 fn evaluate-exprs _exprs-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell), definitions-created: (addr stream int), call-number: (addr int) { 682 # eval all exprs, writing result to `out` each time 683 var exprs-ah/ecx: (addr handle cell) <- copy _exprs-ah 684 $evaluate-exprs:loop: { @@ -696,1168 +696,1165 @@ if ('onhashchange' in window) { 693 { 694 var curr-ah/eax: (addr handle cell) <- get exprs, left 695 debug-print "E", 7/fg, 0/bg - 696 increment call-number - 697 evaluate curr-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 698 debug-print "X", 7/fg, 0/bg - 699 # errors? skip - 700 { - 701 var error?/eax: boolean <- has-errors? trace - 702 compare error?, 0/false - 703 break-if-= - 704 return - 705 } - 706 } - 707 # - 708 exprs-ah <- get exprs, right - 709 loop - 710 } - 711 # `out` contains result of evaluating final expression - 712 } - 713 - 714 # Bind params to corresponding args and add the bindings to old-env. Return - 715 # the result in env-ah. - 716 # - 717 # We never modify old-env, but we point to it. This way other parts of the - 718 # interpreter can continue using old-env, and everything works harmoniously - 719 # even though no cells are copied around. - 720 # - 721 # env should always be a DAG (ignoring internals of values). It doesn't have - 722 # to be a tree (some values may be shared), but there are also no cycles. - 723 # - 724 # Learn more: https://en.wikipedia.org/wiki/Persistent_data_structure - 725 fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), old-env-h: (handle cell), env-ah: (addr handle cell), trace: (addr trace) { - 726 var params-ah/edx: (addr handle cell) <- copy _params-ah - 727 var args-ah/ebx: (addr handle cell) <- copy _args-ah - 728 var _params/eax: (addr cell) <- lookup *params-ah - 729 var params/esi: (addr cell) <- copy _params - 730 { - 731 var params-nil?/eax: boolean <- nil? params - 732 compare params-nil?, 0/false - 733 break-if-= - 734 # nil is a literal - 735 trace-text trace, "eval", "done with push-bindings" - 736 copy-handle old-env-h, env-ah - 737 return - 738 } - 739 # Params can only be symbols or pairs. Args can be anything. - 740 +-- 22 lines: # trace "pushing bindings from " params " to " args ----------------------------------------------------------------------------------------------------------------------- - 762 trace-lower trace - 763 var params-type/eax: (addr int) <- get params, type - 764 compare *params-type, 2/symbol - 765 { - 766 break-if-!= - 767 trace-text trace, "eval", "symbol; binding to all remaining args" - 768 # create a new binding - 769 var new-binding-storage: (handle cell) - 770 var new-binding-ah/eax: (addr handle cell) <- address new-binding-storage - 771 new-pair new-binding-ah, *params-ah, *args-ah - 772 # push it to env - 773 new-pair env-ah, *new-binding-ah, old-env-h - 774 trace-higher trace - 775 return - 776 } - 777 compare *params-type, 0/pair - 778 { - 779 break-if-= - 780 error trace, "cannot bind a non-symbol" - 781 trace-higher trace - 782 return - 783 } - 784 var _args/eax: (addr cell) <- lookup *args-ah - 785 var args/edi: (addr cell) <- copy _args - 786 # params is now a pair, so args must be also - 787 { - 788 var args-nil?/eax: boolean <- nil? args - 789 compare args-nil?, 0/false - 790 break-if-= - 791 error trace, "not enough args to bind" - 792 return - 793 } - 794 var args-type/eax: (addr int) <- get args, type - 795 compare *args-type, 0/pair - 796 { - 797 break-if-= - 798 error trace, "args not in a proper list" - 799 trace-higher trace - 800 return - 801 } - 802 var intermediate-env-storage: (handle cell) - 803 var intermediate-env-ah/edx: (addr handle cell) <- address intermediate-env-storage - 804 var first-param-ah/eax: (addr handle cell) <- get params, left - 805 var first-arg-ah/ecx: (addr handle cell) <- get args, left - 806 push-bindings first-param-ah, first-arg-ah, old-env-h, intermediate-env-ah, trace - 807 # errors? skip - 808 { - 809 var error?/eax: boolean <- has-errors? trace - 810 compare error?, 0/false - 811 break-if-= - 812 trace-higher trace - 813 return - 814 } - 815 var remaining-params-ah/eax: (addr handle cell) <- get params, right - 816 var remaining-args-ah/ecx: (addr handle cell) <- get args, right - 817 push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace - 818 trace-higher trace - 819 } - 820 - 821 fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { - 822 # trace sym - 823 { - 824 var should-trace?/eax: boolean <- should-trace? trace - 825 compare should-trace?, 0/false - 826 break-if-= - 827 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` - 828 var stream/ecx: (addr stream byte) <- address stream-storage - 829 write stream, "look up " - 830 var sym2/eax: (addr cell) <- copy sym - 831 var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data - 832 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 833 rewind-stream sym-data - 834 write-stream stream, sym-data - 835 write stream, " in " - 836 var env-ah/eax: (addr handle cell) <- address env-h - 837 var nested-trace-storage: trace - 838 var nested-trace/edi: (addr trace) <- address nested-trace-storage - 839 initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible - 840 print-cell env-ah, stream, nested-trace - 841 trace trace, "eval", stream - 842 } - 843 trace-lower trace - 844 var _env/eax: (addr cell) <- lookup env-h - 845 var env/ebx: (addr cell) <- copy _env - 846 # if env is not a list, error - 847 { - 848 var env-type/ecx: (addr int) <- get env, type - 849 compare *env-type, 0/pair - 850 break-if-= - 851 error trace, "eval found a non-list environment" - 852 trace-higher trace - 853 return - 854 } - 855 # if env is nil, look up in globals - 856 { - 857 var env-nil?/eax: boolean <- nil? env - 858 compare env-nil?, 0/false - 859 break-if-= - 860 debug-print "b", 7/fg, 0/bg - 861 lookup-symbol-in-globals sym, out, globals, trace, screen-cell, keyboard-cell - 862 debug-print "x", 7/fg, 0/bg - 863 trace-higher trace - 864 +-- 19 lines: # trace "=> " out " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- - 883 debug-print "y", 7/fg, 0/bg - 884 return - 885 } - 886 # check car - 887 var env-head-storage: (handle cell) - 888 var env-head-ah/eax: (addr handle cell) <- address env-head-storage - 889 car env, env-head-ah, trace - 890 var _env-head/eax: (addr cell) <- lookup *env-head-ah - 891 var env-head/ecx: (addr cell) <- copy _env-head - 892 # if car is not a list, abort - 893 { - 894 var env-head-type/eax: (addr int) <- get env-head, type - 895 compare *env-head-type, 0/pair - 896 break-if-= - 897 error trace, "environment is not a list of (key . value) pairs" - 898 trace-higher trace - 899 return - 900 } - 901 # check key - 902 var curr-key-storage: (handle cell) - 903 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage - 904 car env-head, curr-key-ah, trace - 905 var curr-key/eax: (addr cell) <- lookup *curr-key-ah - 906 # if key is not a symbol, abort - 907 { - 908 var curr-key-type/eax: (addr int) <- get curr-key, type - 909 compare *curr-key-type, 2/symbol - 910 break-if-= - 911 error trace, "environment contains a binding for a non-symbol" - 912 trace-higher trace - 913 return - 914 } - 915 # if key matches sym, return val - 916 var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace - 917 compare match?, 0/false - 918 { - 919 break-if-= - 920 cdr env-head, out, trace - 921 +-- 19 lines: # trace "=> " out " (match)" ---------------------------------------------------------------------------------------------------------------------------------------------- - 940 trace-higher trace - 941 return - 942 } - 943 # otherwise recurse - 944 var env-tail-storage: (handle cell) - 945 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage - 946 cdr env, env-tail-ah, trace - 947 lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell, keyboard-cell - 948 trace-higher trace - 949 +-- 19 lines: # trace "=> " out " (recurse)" -------------------------------------------------------------------------------------------------------------------------------------------- - 968 } - 969 - 970 fn test-lookup-symbol-in-env { - 971 # tmp = (a . 3) - 972 var val-storage: (handle cell) - 973 var val-ah/ecx: (addr handle cell) <- address val-storage - 974 new-integer val-ah, 3 - 975 var key-storage: (handle cell) - 976 var key-ah/edx: (addr handle cell) <- address key-storage - 977 new-symbol key-ah, "a" - 978 var env-storage: (handle cell) - 979 var env-ah/ebx: (addr handle cell) <- address env-storage - 980 new-pair env-ah, *key-ah, *val-ah - 981 # env = ((a . 3)) - 982 var nil-storage: (handle cell) - 983 var nil-ah/ecx: (addr handle cell) <- address nil-storage - 984 allocate-pair nil-ah - 985 new-pair env-ah, *env-ah, *nil-ah - 986 # lookup sym(a) in env tmp - 987 var tmp-storage: (handle cell) - 988 var tmp-ah/edx: (addr handle cell) <- address tmp-storage - 989 new-symbol tmp-ah, "a" - 990 var in/eax: (addr cell) <- lookup *tmp-ah - 991 var trace-storage: trace - 992 var trace/edi: (addr trace) <- address trace-storage - 993 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible - 994 lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard - 995 var result/eax: (addr cell) <- lookup *tmp-ah - 996 var result-type/edx: (addr int) <- get result, type - 997 check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0" - 998 var result-value-addr/eax: (addr float) <- get result, number-data - 999 var result-value/eax: int <- convert *result-value-addr -1000 check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1" -1001 } -1002 -1003 fn test-lookup-symbol-in-globals { -1004 var globals-storage: global-table -1005 var globals/edi: (addr global-table) <- address globals-storage -1006 initialize-globals globals -1007 # env = nil -1008 var nil-storage: (handle cell) -1009 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1010 allocate-pair nil-ah -1011 # lookup sym(a), env -1012 var tmp-storage: (handle cell) -1013 var tmp-ah/ebx: (addr handle cell) <- address tmp-storage -1014 new-symbol tmp-ah, "+" -1015 var in/eax: (addr cell) <- lookup *tmp-ah -1016 var trace-storage: trace -1017 var trace/esi: (addr trace) <- address trace-storage -1018 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1019 lookup-symbol in, tmp-ah, *nil-ah, globals, trace, 0/no-screen, 0/no-keyboard -1020 var result/eax: (addr cell) <- lookup *tmp-ah -1021 var result-type/edx: (addr int) <- get result, type -1022 check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0" -1023 var result-value/eax: (addr int) <- get result, index-data -1024 check-ints-equal *result-value, 1/add, "F - test-lookup-symbol-in-globals/1" -1025 } -1026 -1027 fn mutate-binding name: (addr stream byte), val: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace) { -1028 # trace name -1029 { -1030 var should-trace?/eax: boolean <- should-trace? trace -1031 compare should-trace?, 0/false -1032 break-if-= -1033 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` -1034 var stream/ecx: (addr stream byte) <- address stream-storage -1035 write stream, "bind " -1036 rewind-stream name -1037 write-stream stream, name -1038 write stream, " to " -1039 var nested-trace-storage: trace -1040 var nested-trace/edi: (addr trace) <- address nested-trace-storage -1041 initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible -1042 print-cell val, stream, nested-trace -1043 write stream, " in " -1044 var env-ah/eax: (addr handle cell) <- address env-h -1045 clear-trace nested-trace -1046 print-cell env-ah, stream, nested-trace -1047 trace trace, "eval", stream -1048 } -1049 trace-lower trace -1050 var _env/eax: (addr cell) <- lookup env-h -1051 var env/ebx: (addr cell) <- copy _env -1052 # if env is not a list, abort -1053 { -1054 var env-type/ecx: (addr int) <- get env, type -1055 compare *env-type, 0/pair -1056 break-if-= -1057 error trace, "eval found a non-list environment" -1058 trace-higher trace -1059 return -1060 } -1061 # if env is nil, look in globals -1062 { -1063 var env-nil?/eax: boolean <- nil? env -1064 compare env-nil?, 0/false -1065 break-if-= -1066 debug-print "b", 3/fg, 0/bg -1067 mutate-binding-in-globals name, val, globals, trace -1068 debug-print "x", 3/fg, 0/bg -1069 trace-higher trace -1070 +-- 19 lines: # trace "=> " val " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- -1089 debug-print "y", 3/fg, 0/bg -1090 return -1091 } -1092 # check car -1093 var env-head-storage: (handle cell) -1094 var env-head-ah/eax: (addr handle cell) <- address env-head-storage -1095 car env, env-head-ah, trace -1096 var _env-head/eax: (addr cell) <- lookup *env-head-ah -1097 var env-head/ecx: (addr cell) <- copy _env-head -1098 # if car is not a list, abort -1099 { -1100 var env-head-type/eax: (addr int) <- get env-head, type -1101 compare *env-head-type, 0/pair -1102 break-if-= -1103 error trace, "environment is not a list of (key . value) pairs" -1104 trace-higher trace -1105 return -1106 } -1107 # check key -1108 var curr-key-storage: (handle cell) -1109 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage -1110 car env-head, curr-key-ah, trace -1111 var curr-key/eax: (addr cell) <- lookup *curr-key-ah -1112 # if key is not a symbol, abort -1113 { -1114 var curr-key-type/eax: (addr int) <- get curr-key, type -1115 compare *curr-key-type, 2/symbol -1116 break-if-= -1117 error trace, "environment contains a binding for a non-symbol" -1118 trace-higher trace -1119 return -1120 } -1121 # if key matches name, return val -1122 var curr-key-data-ah/eax: (addr handle stream byte) <- get curr-key, text-data -1123 var curr-key-data/eax: (addr stream byte) <- lookup *curr-key-data-ah -1124 var match?/eax: boolean <- streams-data-equal? curr-key-data, name -1125 compare match?, 0/false -1126 { -1127 break-if-= -1128 var dest/eax: (addr handle cell) <- get env-head, right -1129 copy-object val, dest -1130 trace-text trace, "eval", "=> done" -1131 trace-higher trace -1132 return -1133 } -1134 # otherwise recurse -1135 var env-tail-storage: (handle cell) -1136 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage -1137 cdr env, env-tail-ah, trace -1138 mutate-binding name, val, *env-tail-ah, globals, trace -1139 trace-higher trace -1140 } -1141 -1142 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) { -1143 trace-text trace, "eval", "car" -1144 trace-lower trace -1145 var in/eax: (addr cell) <- copy _in -1146 # if in is not a list, abort -1147 { -1148 var in-type/ecx: (addr int) <- get in, type -1149 compare *in-type, 0/pair -1150 break-if-= -1151 error trace, "car on a non-list" -1152 trace-higher trace -1153 return -1154 } -1155 # if in is nil, abort -1156 { -1157 var in-nil?/eax: boolean <- nil? in -1158 compare in-nil?, 0/false -1159 break-if-= -1160 error trace, "car on nil" -1161 trace-higher trace -1162 return -1163 } -1164 var in-left/eax: (addr handle cell) <- get in, left -1165 copy-object in-left, out -1166 trace-higher trace -1167 return -1168 } -1169 -1170 fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) { -1171 trace-text trace, "eval", "cdr" -1172 trace-lower trace -1173 var in/eax: (addr cell) <- copy _in -1174 # if in is not a list, abort -1175 { -1176 var in-type/ecx: (addr int) <- get in, type -1177 compare *in-type, 0/pair -1178 break-if-= -1179 error trace, "car on a non-list" -1180 trace-higher trace -1181 return -1182 } -1183 # if in is nil, abort -1184 { -1185 var in-nil?/eax: boolean <- nil? in -1186 compare in-nil?, 0/false -1187 break-if-= -1188 error trace, "car on nil" -1189 trace-higher trace -1190 return -1191 } -1192 var in-right/eax: (addr handle cell) <- get in, right -1193 copy-object in-right, out -1194 trace-higher trace -1195 return -1196 } -1197 -1198 fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean { -1199 trace-text trace, "eval", "cell-isomorphic?" -1200 trace-lower trace -1201 var a/esi: (addr cell) <- copy _a -1202 var b/edi: (addr cell) <- copy _b -1203 # if types don't match, return false -1204 var a-type-addr/eax: (addr int) <- get a, type -1205 var b-type-addr/ecx: (addr int) <- get b, type -1206 var b-type/ecx: int <- copy *b-type-addr -1207 compare b-type, *a-type-addr -1208 { -1209 break-if-= -1210 trace-higher trace -1211 trace-text trace, "eval", "=> false (type)" -1212 return 0/false -1213 } -1214 # if types are number, compare number-data -1215 # TODO: exactly comparing floats is a bad idea -1216 compare b-type, 1/number -1217 { -1218 break-if-!= -1219 var a-val-addr/eax: (addr float) <- get a, number-data -1220 var b-val-addr/ecx: (addr float) <- get b, number-data -1221 var a-val/xmm0: float <- copy *a-val-addr -1222 compare a-val, *b-val-addr -1223 { -1224 break-if-= -1225 trace-higher trace -1226 trace-text trace, "eval", "=> false (numbers)" -1227 return 0/false -1228 } -1229 trace-higher trace -1230 trace-text trace, "eval", "=> true (numbers)" -1231 return 1/true -1232 } -1233 $cell-isomorphic?:text-data: { -1234 { -1235 compare b-type, 2/symbol -1236 break-if-= -1237 compare b-type, 3/stream -1238 break-if-= -1239 break $cell-isomorphic?:text-data -1240 } -1241 var b-val-ah/eax: (addr handle stream byte) <- get b, text-data -1242 var _b-val/eax: (addr stream byte) <- lookup *b-val-ah -1243 var b-val/ecx: (addr stream byte) <- copy _b-val -1244 var a-val-ah/eax: (addr handle stream byte) <- get a, text-data -1245 var a-val/eax: (addr stream byte) <- lookup *a-val-ah -1246 var tmp-array: (handle array byte) -1247 var tmp-ah/edx: (addr handle array byte) <- address tmp-array -1248 rewind-stream a-val -1249 stream-to-array a-val, tmp-ah -1250 var tmp/eax: (addr array byte) <- lookup *tmp-ah -1251 var match?/eax: boolean <- stream-data-equal? b-val, tmp -1252 trace-higher trace -1253 { -1254 compare match?, 0/false -1255 break-if-= -1256 trace-text trace, "eval", "=> true (symbols)" -1257 } -1258 { -1259 compare match?, 0/false -1260 break-if-!= -1261 trace-text trace, "eval", "=> false (symbols)" -1262 } -1263 return match? -1264 } -1265 # if objects are primitive functions, compare index-data -1266 compare b-type, 4/primitive -1267 { -1268 break-if-!= -1269 var a-val-addr/eax: (addr int) <- get a, index-data -1270 var b-val-addr/ecx: (addr int) <- get b, index-data -1271 var a-val/eax: int <- copy *a-val-addr -1272 compare a-val, *b-val-addr -1273 { -1274 break-if-= -1275 trace-higher trace -1276 trace-text trace, "eval", "=> false (primitives)" -1277 return 0/false -1278 } -1279 trace-higher trace -1280 trace-text trace, "eval", "=> true (primitives)" -1281 return 1/true -1282 } -1283 # if objects are screens, check if they're the same object -1284 compare b-type, 5/screen -1285 { -1286 break-if-!= -1287 var a-val-addr/eax: (addr handle screen) <- get a, screen-data -1288 var b-val-addr/ecx: (addr handle screen) <- get b, screen-data -1289 var result/eax: boolean <- handle-equal? *a-val-addr, *b-val-addr -1290 compare result, 0/false -1291 return result -1292 } -1293 # if objects are keyboards, check if they have the same contents -1294 compare b-type, 6/keyboard -1295 { -1296 break-if-!= -1297 var a-val-addr/ecx: (addr handle gap-buffer) <- get a, keyboard-data -1298 var _a/eax: (addr gap-buffer) <- lookup *a-val-addr -1299 var a/ecx: (addr gap-buffer) <- copy _a -1300 var b-val-addr/eax: (addr handle gap-buffer) <- get b, keyboard-data -1301 var b/eax: (addr gap-buffer) <- lookup *b-val-addr -1302 var result/eax: boolean <- gap-buffers-equal? a, b -1303 return result -1304 } -1305 # if a is nil, b should be nil -1306 { -1307 # (assumes nil? returns 0 or 1) -1308 var _b-nil?/eax: boolean <- nil? b -1309 var b-nil?/ecx: boolean <- copy _b-nil? -1310 var a-nil?/eax: boolean <- nil? a -1311 # a == nil and b == nil => return true -1312 { -1313 compare a-nil?, 0/false -1314 break-if-= -1315 compare b-nil?, 0/false -1316 break-if-= -1317 trace-higher trace -1318 trace-text trace, "eval", "=> true (nils)" -1319 return 1/true -1320 } -1321 # a == nil => return false -1322 { -1323 compare a-nil?, 0/false -1324 break-if-= -1325 trace-higher trace -1326 trace-text trace, "eval", "=> false (b != nil)" -1327 return 0/false -1328 } -1329 # b == nil => return false -1330 { -1331 compare b-nil?, 0/false -1332 break-if-= -1333 trace-higher trace -1334 trace-text trace, "eval", "=> false (a != nil)" -1335 return 0/false -1336 } -1337 } -1338 # a and b are pairs -1339 var a-tmp-storage: (handle cell) -1340 var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage -1341 var b-tmp-storage: (handle cell) -1342 var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage -1343 # if cars aren't equal, return false -1344 car a, a-tmp-ah, trace -1345 car b, b-tmp-ah, trace -1346 { -1347 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah -1348 var a-tmp/ecx: (addr cell) <- copy _a-tmp -1349 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah -1350 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace -1351 compare result, 0/false -1352 break-if-!= -1353 trace-higher trace -1354 trace-text trace, "eval", "=> false (car mismatch)" -1355 return 0/false -1356 } -1357 # recurse on cdrs -1358 cdr a, a-tmp-ah, trace -1359 cdr b, b-tmp-ah, trace -1360 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah -1361 var a-tmp/ecx: (addr cell) <- copy _a-tmp -1362 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah -1363 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace -1364 trace-higher trace -1365 return result -1366 } -1367 -1368 fn fn? _x: (addr cell) -> _/eax: boolean { -1369 var x/esi: (addr cell) <- copy _x -1370 var type/eax: (addr int) <- get x, type -1371 compare *type, 2/symbol -1372 { -1373 break-if-= -1374 return 0/false -1375 } -1376 var contents-ah/eax: (addr handle stream byte) <- get x, text-data -1377 var contents/eax: (addr stream byte) <- lookup *contents-ah -1378 var result/eax: boolean <- stream-data-equal? contents, "fn" -1379 return result -1380 } -1381 -1382 fn litfn? _x: (addr cell) -> _/eax: boolean { -1383 var x/esi: (addr cell) <- copy _x -1384 var type/eax: (addr int) <- get x, type -1385 compare *type, 2/symbol -1386 { -1387 break-if-= -1388 return 0/false -1389 } -1390 var contents-ah/eax: (addr handle stream byte) <- get x, text-data -1391 var contents/eax: (addr stream byte) <- lookup *contents-ah -1392 var result/eax: boolean <- stream-data-equal? contents, "litfn" -1393 return result -1394 } -1395 -1396 fn litmac? _x: (addr cell) -> _/eax: boolean { -1397 var x/esi: (addr cell) <- copy _x -1398 var type/eax: (addr int) <- get x, type -1399 compare *type, 2/symbol -1400 { -1401 break-if-= -1402 return 0/false -1403 } -1404 var contents-ah/eax: (addr handle stream byte) <- get x, text-data -1405 var contents/eax: (addr stream byte) <- lookup *contents-ah -1406 var result/eax: boolean <- stream-data-equal? contents, "litmac" -1407 return result -1408 } -1409 -1410 fn test-evaluate-is-well-behaved { -1411 var t-storage: trace -1412 var t/esi: (addr trace) <- address t-storage -1413 initialize-trace t, 0x100/max-depth, 0x10/capacity, 0/visible # we don't use trace UI -1414 # env = nil -1415 var env-storage: (handle cell) -1416 var env-ah/ecx: (addr handle cell) <- address env-storage -1417 allocate-pair env-ah -1418 # eval sym(a), nil env -1419 var tmp-storage: (handle cell) -1420 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1421 new-symbol tmp-ah, "a" -1422 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard, 0/call-number -1423 # doesn't die -1424 check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved" -1425 } -1426 -1427 fn test-evaluate-number { -1428 # env = nil -1429 var env-storage: (handle cell) -1430 var env-ah/ecx: (addr handle cell) <- address env-storage -1431 allocate-pair env-ah -1432 # tmp = 3 -1433 var tmp-storage: (handle cell) -1434 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1435 new-integer tmp-ah, 3 -1436 var trace-storage: trace -1437 var trace/edi: (addr trace) <- address trace-storage -1438 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1439 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1440 # -1441 var result/eax: (addr cell) <- lookup *tmp-ah -1442 var result-type/edx: (addr int) <- get result, type -1443 check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0" -1444 var result-value-addr/eax: (addr float) <- get result, number-data -1445 var result-value/eax: int <- convert *result-value-addr -1446 check-ints-equal result-value, 3, "F - test-evaluate-number/1" -1447 } -1448 -1449 fn test-evaluate-symbol { -1450 # tmp = (a . 3) -1451 var val-storage: (handle cell) -1452 var val-ah/ecx: (addr handle cell) <- address val-storage -1453 new-integer val-ah, 3 -1454 var key-storage: (handle cell) -1455 var key-ah/edx: (addr handle cell) <- address key-storage -1456 new-symbol key-ah, "a" -1457 var env-storage: (handle cell) -1458 var env-ah/ebx: (addr handle cell) <- address env-storage -1459 new-pair env-ah, *key-ah, *val-ah -1460 # env = ((a . 3)) -1461 var nil-storage: (handle cell) -1462 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1463 allocate-pair nil-ah -1464 new-pair env-ah, *env-ah, *nil-ah -1465 # eval sym(a), env -1466 var tmp-storage: (handle cell) -1467 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1468 new-symbol tmp-ah, "a" -1469 var trace-storage: trace -1470 var trace/edi: (addr trace) <- address trace-storage -1471 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1472 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1473 var result/eax: (addr cell) <- lookup *tmp-ah -1474 var result-type/edx: (addr int) <- get result, type -1475 check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0" -1476 var result-value-addr/eax: (addr float) <- get result, number-data -1477 var result-value/eax: int <- convert *result-value-addr -1478 check-ints-equal result-value, 3, "F - test-evaluate-symbol/1" -1479 } -1480 -1481 fn test-evaluate-quote { -1482 # env = nil -1483 var nil-storage: (handle cell) -1484 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1485 allocate-pair nil-ah -1486 # eval `a, env -1487 var tmp-storage: (handle cell) -1488 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1489 new-symbol tmp-ah, "'" -1490 var tmp2-storage: (handle cell) -1491 var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage -1492 new-symbol tmp2-ah, "a" -1493 new-pair tmp-ah, *tmp-ah, *tmp2-ah -1494 var trace-storage: trace -1495 var trace/edi: (addr trace) <- address trace-storage -1496 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1497 evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1498 var result/eax: (addr cell) <- lookup *tmp-ah -1499 var result-type/edx: (addr int) <- get result, type -1500 check-ints-equal *result-type, 2/symbol, "F - test-evaluate-quote/0" -1501 var sym?/eax: boolean <- symbol-equal? result, "a" -1502 check sym?, "F - test-evaluate-quote/1" -1503 } -1504 -1505 fn test-evaluate-primitive-function { -1506 var globals-storage: global-table -1507 var globals/edi: (addr global-table) <- address globals-storage -1508 initialize-globals globals -1509 var nil-storage: (handle cell) -1510 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1511 allocate-pair nil-ah -1512 var add-storage: (handle cell) -1513 var add-ah/ebx: (addr handle cell) <- address add-storage -1514 new-symbol add-ah, "+" -1515 # eval +, nil env -1516 var tmp-storage: (handle cell) -1517 var tmp-ah/esi: (addr handle cell) <- address tmp-storage -1518 var trace-storage: trace -1519 var trace/edx: (addr trace) <- address trace-storage -1520 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1521 evaluate add-ah, tmp-ah, *nil-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1522 # -1523 var result/eax: (addr cell) <- lookup *tmp-ah -1524 var result-type/edx: (addr int) <- get result, type -1525 check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0" -1526 var result-value/eax: (addr int) <- get result, index-data -1527 check-ints-equal *result-value, 1/add, "F - test-evaluate-primitive-function/1" -1528 } -1529 -1530 fn test-evaluate-primitive-function-call { -1531 var t-storage: trace -1532 var t/edi: (addr trace) <- address t-storage -1533 initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible # we don't use trace UI -1534 # -1535 var nil-storage: (handle cell) -1536 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1537 allocate-pair nil-ah -1538 var one-storage: (handle cell) -1539 var one-ah/edx: (addr handle cell) <- address one-storage -1540 new-integer one-ah, 1 -1541 var add-storage: (handle cell) -1542 var add-ah/ebx: (addr handle cell) <- address add-storage -1543 new-symbol add-ah, "+" -1544 # input is (+ 1 1) -1545 var tmp-storage: (handle cell) -1546 var tmp-ah/esi: (addr handle cell) <- address tmp-storage -1547 new-pair tmp-ah, *one-ah, *nil-ah -1548 new-pair tmp-ah, *one-ah, *tmp-ah -1549 new-pair tmp-ah, *add-ah, *tmp-ah -1550 #? dump-cell tmp-ah -1551 # -1552 var globals-storage: global-table -1553 var globals/edx: (addr global-table) <- address globals-storage -1554 initialize-globals globals -1555 # -1556 evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/call-number -1557 #? dump-trace t -1558 # -1559 var result/eax: (addr cell) <- lookup *tmp-ah -1560 var result-type/edx: (addr int) <- get result, type -1561 check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0" -1562 var result-value-addr/eax: (addr float) <- get result, number-data -1563 var result-value/eax: int <- convert *result-value-addr -1564 check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1" -1565 } -1566 -1567 fn test-evaluate-backquote { -1568 # env = nil -1569 var nil-storage: (handle cell) -1570 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1571 allocate-pair nil-ah -1572 # eval `a, env -1573 var tmp-storage: (handle cell) -1574 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1575 new-symbol tmp-ah, "`" -1576 var tmp2-storage: (handle cell) -1577 var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage -1578 new-symbol tmp2-ah, "a" -1579 new-pair tmp-ah, *tmp-ah, *tmp2-ah -1580 clear-object tmp2-ah -1581 var trace-storage: trace -1582 var trace/edi: (addr trace) <- address trace-storage -1583 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1584 evaluate tmp-ah, tmp2-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1585 var result/eax: (addr cell) <- lookup *tmp2-ah -1586 var result-type/edx: (addr int) <- get result, type -1587 check-ints-equal *result-type, 2/symbol, "F - test-evaluate-backquote/0" -1588 var sym?/eax: boolean <- symbol-equal? result, "a" -1589 check sym?, "F - test-evaluate-backquote/1" -1590 } -1591 -1592 fn evaluate-backquote _in-ah: (addr handle cell), _out-ah: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int { -1593 # stack overflow? # disable when enabling Really-debug-print -1594 #? dump-cell-from-cursor-over-full-screen _in-ah -1595 check-stack -1596 { -1597 var screen-cell/eax: (addr handle cell) <- copy screen-cell -1598 compare screen-cell, 0 -1599 break-if-= -1600 var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell -1601 compare screen-cell-addr, 0 -1602 break-if-= -1603 # if screen-cell exists, we're probably not in a test -1604 show-stack-state -1605 } -1606 # errors? skip -1607 { -1608 var error?/eax: boolean <- has-errors? trace -1609 compare error?, 0/false -1610 break-if-= -1611 return -1612 } -1613 trace-lower trace -1614 var in-ah/esi: (addr handle cell) <- copy _in-ah -1615 var in/eax: (addr cell) <- lookup *in-ah -1616 { -1617 var nil?/eax: boolean <- nil? in -1618 compare nil?, 0/false -1619 break-if-= -1620 # nil is a literal -1621 trace-text trace, "eval", "backquote nil" -1622 copy-object _in-ah, _out-ah -1623 trace-higher trace -1624 return -1625 } -1626 var in-type/ecx: (addr int) <- get in, type -1627 compare *in-type, 0/pair -1628 { -1629 break-if-= -1630 # copy non-pairs directly -1631 # TODO: streams might need to be copied -1632 trace-text trace, "eval", "backquote atom" -1633 copy-object _in-ah, _out-ah -1634 trace-higher trace -1635 return -1636 } -1637 # 'in' is a pair -1638 debug-print "()", 4/fg, 0/bg -1639 var in-ah/esi: (addr handle cell) <- copy _in-ah -1640 var _in/eax: (addr cell) <- lookup *in-ah -1641 var in/ebx: (addr cell) <- copy _in -1642 var in-left-ah/ecx: (addr handle cell) <- get in, left -1643 debug-print "10", 4/fg, 0/bg -1644 # check for unquote -1645 $macroexpand-iter:unquote: { -1646 var in-left/eax: (addr cell) <- lookup *in-left-ah -1647 var unquote?/eax: boolean <- symbol-equal? in-left, "," -1648 compare unquote?, 0/false -1649 break-if-= -1650 trace-text trace, "eval", "unquote" -1651 var rest-ah/eax: (addr handle cell) <- get in, right -1652 increment call-number -1653 debug-print ",", 3/fg, 0/bg -1654 evaluate rest-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1655 debug-print ",)", 3/fg, 0/bg -1656 trace-higher trace -1657 return -1658 } -1659 # check for unquote-splice in in-left -1660 debug-print "11", 4/fg, 0/bg -1661 var out-ah/edi: (addr handle cell) <- copy _out-ah -1662 $macroexpand-iter:unquote-splice: { -1663 #? dump-cell-from-cursor-over-full-screen in-left-ah -1664 var in-left/eax: (addr cell) <- lookup *in-left-ah -1665 { -1666 debug-print "12", 4/fg, 0/bg -1667 { -1668 var in-left-is-nil?/eax: boolean <- nil? in-left -1669 compare in-left-is-nil?, 0/false -1670 } -1671 break-if-!= $macroexpand-iter:unquote-splice -1672 var in-left-type/ecx: (addr int) <- get in-left, type -1673 debug-print "13", 4/fg, 0/bg -1674 compare *in-left-type, 0/pair -1675 break-if-!= $macroexpand-iter:unquote-splice -1676 var in-left-left-ah/eax: (addr handle cell) <- get in-left, left -1677 debug-print "14", 4/fg, 0/bg -1678 var in-left-left/eax: (addr cell) <- lookup *in-left-left-ah -1679 debug-print "15", 4/fg, 0/bg -1680 var in-left-left-type/ecx: (addr int) <- get in-left-left, type -1681 var left-is-unquote-splice?/eax: boolean <- symbol-equal? in-left-left, ",@" -1682 debug-print "16", 4/fg, 0/bg -1683 compare left-is-unquote-splice?, 0/false -1684 } -1685 break-if-= -1686 debug-print "17", 4/fg, 0/bg -1687 trace-text trace, "eval", "unquote-splice" -1688 var in-unquote-payload-ah/eax: (addr handle cell) <- get in-left, right -1689 increment call-number -1690 evaluate in-unquote-payload-ah, out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1691 # errors? skip -1692 { -1693 var error?/eax: boolean <- has-errors? trace -1694 compare error?, 0/false -1695 break-if-= -1696 trace-higher trace -1697 return -1698 } -1699 # while (*out-ah != null) out-ah = cdr(out-ah) -1700 { -1701 var out/eax: (addr cell) <- lookup *out-ah -1702 { -1703 var done?/eax: boolean <- nil? out -1704 compare done?, 0/false -1705 } -1706 break-if-!= -1707 out-ah <- get out, right -1708 loop -1709 } -1710 # append result of in-right -1711 var in-right-ah/ecx: (addr handle cell) <- get in, right -1712 evaluate-backquote in-right-ah, out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1713 trace-higher trace -1714 return -1715 } -1716 debug-print "19", 4/fg, 0/bg -1717 # otherwise continue copying -1718 trace-text trace, "eval", "backquote: copy" -1719 var out-ah/edi: (addr handle cell) <- copy _out-ah -1720 allocate-pair out-ah -1721 debug-print "20", 7/fg, 0/bg -1722 #? dump-cell-from-cursor-over-full-screen out-ah -1723 var out/eax: (addr cell) <- lookup *out-ah -1724 var out-left-ah/edx: (addr handle cell) <- get out, left -1725 debug-print "`(l", 3/fg, 0/bg -1726 evaluate-backquote in-left-ah, out-left-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1727 debug-print "`r)", 3/fg, 0/bg -1728 # errors? skip -1729 { -1730 var error?/eax: boolean <- has-errors? trace -1731 compare error?, 0/false -1732 break-if-= -1733 trace-higher trace -1734 return -1735 } -1736 var in-right-ah/ecx: (addr handle cell) <- get in, right -1737 var out-right-ah/edx: (addr handle cell) <- get out, right -1738 debug-print "`r(", 3/fg, 0/bg -1739 evaluate-backquote in-right-ah, out-right-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1740 debug-print "`r)", 3/fg, 0/bg -1741 trace-higher trace -1742 } -1743 -1744 fn test-evaluate-backquote-list { -1745 var nil-storage: (handle cell) -1746 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1747 allocate-pair nil-ah -1748 var backquote-storage: (handle cell) -1749 var backquote-ah/edx: (addr handle cell) <- address backquote-storage -1750 new-symbol backquote-ah, "`" -1751 # input is `(a b) -1752 var a-storage: (handle cell) -1753 var a-ah/ebx: (addr handle cell) <- address a-storage -1754 new-symbol a-ah, "a" -1755 var b-storage: (handle cell) -1756 var b-ah/esi: (addr handle cell) <- address b-storage -1757 new-symbol b-ah, "b" -1758 var tmp-storage: (handle cell) -1759 var tmp-ah/eax: (addr handle cell) <- address tmp-storage -1760 new-pair tmp-ah, *b-ah, *nil-ah -1761 new-pair tmp-ah, *a-ah, *tmp-ah -1762 new-pair tmp-ah, *backquote-ah, *tmp-ah -1763 # -1764 var trace-storage: trace -1765 var trace/edi: (addr trace) <- address trace-storage -1766 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1767 evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1768 # result is (a b) -1769 var result/eax: (addr cell) <- lookup *tmp-ah -1770 { -1771 var result-type/eax: (addr int) <- get result, type -1772 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list/0" -1773 } -1774 { -1775 var a1-ah/eax: (addr handle cell) <- get result, left -1776 var a1/eax: (addr cell) <- lookup *a1-ah -1777 var check1/eax: boolean <- symbol-equal? a1, "a" -1778 check check1, "F - test-evaluate-backquote-list/1" -1779 } -1780 var rest-ah/eax: (addr handle cell) <- get result, right -1781 var rest/eax: (addr cell) <- lookup *rest-ah -1782 { -1783 var a2-ah/eax: (addr handle cell) <- get rest, left -1784 var a2/eax: (addr cell) <- lookup *a2-ah -1785 var check2/eax: boolean <- symbol-equal? a2, "b" -1786 check check2, "F - test-evaluate-backquote-list/2" -1787 } -1788 var rest-ah/eax: (addr handle cell) <- get rest, right -1789 var rest/eax: (addr cell) <- lookup *rest-ah -1790 var check3/eax: boolean <- nil? rest -1791 check check3, "F - test-evaluate-backquote-list/3" -1792 } -1793 -1794 fn test-evaluate-backquote-list-with-unquote { -1795 var nil-h: (handle cell) -1796 var nil-ah/eax: (addr handle cell) <- address nil-h -1797 allocate-pair nil-ah -1798 var backquote-h: (handle cell) -1799 var backquote-ah/eax: (addr handle cell) <- address backquote-h -1800 new-symbol backquote-ah, "`" -1801 var unquote-h: (handle cell) -1802 var unquote-ah/eax: (addr handle cell) <- address unquote-h -1803 new-symbol unquote-ah, "," -1804 var a-h: (handle cell) -1805 var a-ah/eax: (addr handle cell) <- address a-h -1806 new-symbol a-ah, "a" -1807 var b-h: (handle cell) -1808 var b-ah/eax: (addr handle cell) <- address b-h -1809 new-symbol b-ah, "b" -1810 # env = ((b . 3)) -1811 var val-h: (handle cell) -1812 var val-ah/eax: (addr handle cell) <- address val-h -1813 new-integer val-ah, 3 -1814 var env-h: (handle cell) -1815 var env-ah/eax: (addr handle cell) <- address env-h -1816 new-pair env-ah, b-h, val-h -1817 new-pair env-ah, env-h, nil-h -1818 # input is `(a ,b) -1819 var tmp-h: (handle cell) -1820 var tmp-ah/eax: (addr handle cell) <- address tmp-h -1821 # tmp = cons(unquote, b) -1822 new-pair tmp-ah, unquote-h, b-h -1823 # tmp = cons(tmp, nil) -1824 new-pair tmp-ah, tmp-h, nil-h -1825 # tmp = cons(a, tmp) -1826 new-pair tmp-ah, a-h, tmp-h -1827 # tmp = cons(backquote, tmp) -1828 new-pair tmp-ah, backquote-h, tmp-h -1829 # -1830 var trace-storage: trace -1831 var trace/edi: (addr trace) <- address trace-storage -1832 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1833 evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1834 # result is (a 3) -1835 var result/eax: (addr cell) <- lookup *tmp-ah -1836 { -1837 var result-type/eax: (addr int) <- get result, type -1838 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote/0" -1839 } -1840 { -1841 var a1-ah/eax: (addr handle cell) <- get result, left -1842 var a1/eax: (addr cell) <- lookup *a1-ah -1843 var check1/eax: boolean <- symbol-equal? a1, "a" -1844 check check1, "F - test-evaluate-backquote-list-with-unquote/1" -1845 } -1846 var rest-ah/eax: (addr handle cell) <- get result, right -1847 var rest/eax: (addr cell) <- lookup *rest-ah -1848 { -1849 var a2-ah/eax: (addr handle cell) <- get rest, left -1850 var a2/eax: (addr cell) <- lookup *a2-ah -1851 var a2-value-addr/eax: (addr float) <- get a2, number-data -1852 var a2-value/eax: int <- convert *a2-value-addr -1853 check-ints-equal a2-value, 3, "F - test-evaluate-backquote-list-with-unquote/2" -1854 } -1855 var rest-ah/eax: (addr handle cell) <- get rest, right -1856 var rest/eax: (addr cell) <- lookup *rest-ah -1857 var check3/eax: boolean <- nil? rest -1858 check check3, "F - test-evaluate-backquote-list-with-unquote/3" -1859 } -1860 -1861 fn test-evaluate-backquote-list-with-unquote-splice { -1862 var nil-h: (handle cell) -1863 var nil-ah/eax: (addr handle cell) <- address nil-h -1864 allocate-pair nil-ah -1865 var backquote-h: (handle cell) -1866 var backquote-ah/eax: (addr handle cell) <- address backquote-h -1867 new-symbol backquote-ah, "`" -1868 var unquote-splice-h: (handle cell) -1869 var unquote-splice-ah/eax: (addr handle cell) <- address unquote-splice-h -1870 new-symbol unquote-splice-ah, ",@" -1871 var a-h: (handle cell) -1872 var a-ah/eax: (addr handle cell) <- address a-h -1873 new-symbol a-ah, "a" -1874 var b-h: (handle cell) -1875 var b-ah/eax: (addr handle cell) <- address b-h -1876 new-symbol b-ah, "b" -1877 # env = ((b . (a 3))) -1878 var val-h: (handle cell) -1879 var val-ah/eax: (addr handle cell) <- address val-h -1880 new-integer val-ah, 3 -1881 new-pair val-ah, val-h, nil-h -1882 new-pair val-ah, a-h, val-h -1883 var env-h: (handle cell) -1884 var env-ah/eax: (addr handle cell) <- address env-h -1885 new-pair env-ah, b-h, val-h -1886 new-pair env-ah, env-h, nil-h -1887 # input is `(a ,@b b) -1888 var tmp-h: (handle cell) -1889 var tmp-ah/eax: (addr handle cell) <- address tmp-h -1890 # tmp = cons(b, nil) -1891 new-pair tmp-ah, b-h, nil-h -1892 # tmp2 = cons(unquote-splice, b) -1893 var tmp2-h: (handle cell) -1894 var tmp2-ah/ecx: (addr handle cell) <- address tmp2-h -1895 new-pair tmp2-ah, unquote-splice-h, b-h -1896 # tmp = cons(tmp2, tmp) -1897 new-pair tmp-ah, tmp2-h, tmp-h -1898 # tmp = cons(a, tmp) -1899 new-pair tmp-ah, a-h, tmp-h -1900 # tmp = cons(backquote, tmp) -1901 new-pair tmp-ah, backquote-h, tmp-h -1902 #? dump-cell-from-cursor-over-full-screen tmp-ah -1903 # -1904 var trace-storage: trace -1905 var trace/edi: (addr trace) <- address trace-storage -1906 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1907 evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1908 # result is (a a 3 b) -1909 #? dump-cell-from-cursor-over-full-screen tmp-ah -1910 var result/eax: (addr cell) <- lookup *tmp-ah -1911 { -1912 var result-type/eax: (addr int) <- get result, type -1913 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote-splice/0" -1914 } -1915 { -1916 var a1-ah/eax: (addr handle cell) <- get result, left -1917 var a1/eax: (addr cell) <- lookup *a1-ah -1918 var check1/eax: boolean <- symbol-equal? a1, "a" -1919 check check1, "F - test-evaluate-backquote-list-with-unquote-splice/1" -1920 } -1921 var rest-ah/eax: (addr handle cell) <- get result, right -1922 var rest/eax: (addr cell) <- lookup *rest-ah -1923 { -1924 var a2-ah/eax: (addr handle cell) <- get rest, left -1925 var a2/eax: (addr cell) <- lookup *a2-ah -1926 var check2/eax: boolean <- symbol-equal? a2, "a" -1927 check check2, "F - test-evaluate-backquote-list-with-unquote-splice/2" -1928 } -1929 var rest-ah/eax: (addr handle cell) <- get rest, right -1930 var rest/eax: (addr cell) <- lookup *rest-ah -1931 { -1932 var a3-ah/eax: (addr handle cell) <- get rest, left -1933 var a3/eax: (addr cell) <- lookup *a3-ah -1934 var a3-value-addr/eax: (addr float) <- get a3, number-data -1935 var a3-value/eax: int <- convert *a3-value-addr -1936 check-ints-equal a3-value, 3, "F - test-evaluate-backquote-list-with-unquote-splice/3" -1937 } -1938 var rest-ah/eax: (addr handle cell) <- get rest, right -1939 var rest/eax: (addr cell) <- lookup *rest-ah -1940 { -1941 var a4-ah/eax: (addr handle cell) <- get rest, left -1942 var a4/eax: (addr cell) <- lookup *a4-ah -1943 var check4/eax: boolean <- symbol-equal? a4, "b" -1944 check check4, "F - test-evaluate-backquote-list-with-unquote-splice/4" -1945 } -1946 var rest-ah/eax: (addr handle cell) <- get rest, right -1947 var rest/eax: (addr cell) <- lookup *rest-ah -1948 var check5/eax: boolean <- nil? rest -1949 check check5, "F - test-evaluate-backquote-list-with-unquote-splice/5" -1950 } + 696 evaluate curr-ah, out, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number + 697 debug-print "X", 7/fg, 0/bg + 698 # errors? skip + 699 { + 700 var error?/eax: boolean <- has-errors? trace + 701 compare error?, 0/false + 702 break-if-= + 703 return + 704 } + 705 } + 706 # + 707 exprs-ah <- get exprs, right + 708 loop + 709 } + 710 # `out` contains result of evaluating final expression + 711 } + 712 + 713 # Bind params to corresponding args and add the bindings to old-env. Return + 714 # the result in env-ah. + 715 # + 716 # We never modify old-env, but we point to it. This way other parts of the + 717 # interpreter can continue using old-env, and everything works harmoniously + 718 # even though no cells are copied around. + 719 # + 720 # env should always be a DAG (ignoring internals of values). It doesn't have + 721 # to be a tree (some values may be shared), but there are also no cycles. + 722 # + 723 # Learn more: https://en.wikipedia.org/wiki/Persistent_data_structure + 724 fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), old-env-h: (handle cell), env-ah: (addr handle cell), trace: (addr trace) { + 725 var params-ah/edx: (addr handle cell) <- copy _params-ah + 726 var args-ah/ebx: (addr handle cell) <- copy _args-ah + 727 var _params/eax: (addr cell) <- lookup *params-ah + 728 var params/esi: (addr cell) <- copy _params + 729 { + 730 var params-nil?/eax: boolean <- nil? params + 731 compare params-nil?, 0/false + 732 break-if-= + 733 # nil is a literal + 734 trace-text trace, "eval", "done with push-bindings" + 735 copy-handle old-env-h, env-ah + 736 return + 737 } + 738 # Params can only be symbols or pairs. Args can be anything. + 739 +-- 22 lines: # trace "pushing bindings from " params " to " args ----------------------------------------------------------------------------------------------------------------------- + 761 trace-lower trace + 762 var params-type/eax: (addr int) <- get params, type + 763 compare *params-type, 2/symbol + 764 { + 765 break-if-!= + 766 trace-text trace, "eval", "symbol; binding to all remaining args" + 767 # create a new binding + 768 var new-binding-storage: (handle cell) + 769 var new-binding-ah/eax: (addr handle cell) <- address new-binding-storage + 770 new-pair new-binding-ah, *params-ah, *args-ah + 771 # push it to env + 772 new-pair env-ah, *new-binding-ah, old-env-h + 773 trace-higher trace + 774 return + 775 } + 776 compare *params-type, 0/pair + 777 { + 778 break-if-= + 779 error trace, "cannot bind a non-symbol" + 780 trace-higher trace + 781 return + 782 } + 783 var _args/eax: (addr cell) <- lookup *args-ah + 784 var args/edi: (addr cell) <- copy _args + 785 # params is now a pair, so args must be also + 786 { + 787 var args-nil?/eax: boolean <- nil? args + 788 compare args-nil?, 0/false + 789 break-if-= + 790 error trace, "not enough args to bind" + 791 return + 792 } + 793 var args-type/eax: (addr int) <- get args, type + 794 compare *args-type, 0/pair + 795 { + 796 break-if-= + 797 error trace, "args not in a proper list" + 798 trace-higher trace + 799 return + 800 } + 801 var intermediate-env-storage: (handle cell) + 802 var intermediate-env-ah/edx: (addr handle cell) <- address intermediate-env-storage + 803 var first-param-ah/eax: (addr handle cell) <- get params, left + 804 var first-arg-ah/ecx: (addr handle cell) <- get args, left + 805 push-bindings first-param-ah, first-arg-ah, old-env-h, intermediate-env-ah, trace + 806 # errors? skip + 807 { + 808 var error?/eax: boolean <- has-errors? trace + 809 compare error?, 0/false + 810 break-if-= + 811 trace-higher trace + 812 return + 813 } + 814 var remaining-params-ah/eax: (addr handle cell) <- get params, right + 815 var remaining-args-ah/ecx: (addr handle cell) <- get args, right + 816 push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace + 817 trace-higher trace + 818 } + 819 + 820 fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell) { + 821 # trace sym + 822 { + 823 var should-trace?/eax: boolean <- should-trace? trace + 824 compare should-trace?, 0/false + 825 break-if-= + 826 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` + 827 var stream/ecx: (addr stream byte) <- address stream-storage + 828 write stream, "look up " + 829 var sym2/eax: (addr cell) <- copy sym + 830 var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data + 831 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah + 832 rewind-stream sym-data + 833 write-stream stream, sym-data + 834 write stream, " in " + 835 var env-ah/eax: (addr handle cell) <- address env-h + 836 var nested-trace-storage: trace + 837 var nested-trace/edi: (addr trace) <- address nested-trace-storage + 838 initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible + 839 print-cell env-ah, stream, nested-trace + 840 trace trace, "eval", stream + 841 } + 842 trace-lower trace + 843 var _env/eax: (addr cell) <- lookup env-h + 844 var env/ebx: (addr cell) <- copy _env + 845 # if env is not a list, error + 846 { + 847 var env-type/ecx: (addr int) <- get env, type + 848 compare *env-type, 0/pair + 849 break-if-= + 850 error trace, "eval found a non-list environment" + 851 trace-higher trace + 852 return + 853 } + 854 # if env is nil, look up in globals + 855 { + 856 var env-nil?/eax: boolean <- nil? env + 857 compare env-nil?, 0/false + 858 break-if-= + 859 debug-print "b", 7/fg, 0/bg + 860 lookup-symbol-in-globals sym, out, globals, trace, inner-screen-var, inner-keyboard-var + 861 debug-print "x", 7/fg, 0/bg + 862 trace-higher trace + 863 +-- 19 lines: # trace "=> " out " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- + 882 debug-print "y", 7/fg, 0/bg + 883 return + 884 } + 885 # check car + 886 var env-head-storage: (handle cell) + 887 var env-head-ah/eax: (addr handle cell) <- address env-head-storage + 888 car env, env-head-ah, trace + 889 var _env-head/eax: (addr cell) <- lookup *env-head-ah + 890 var env-head/ecx: (addr cell) <- copy _env-head + 891 # if car is not a list, abort + 892 { + 893 var env-head-type/eax: (addr int) <- get env-head, type + 894 compare *env-head-type, 0/pair + 895 break-if-= + 896 error trace, "environment is not a list of (key . value) pairs" + 897 trace-higher trace + 898 return + 899 } + 900 # check key + 901 var curr-key-storage: (handle cell) + 902 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage + 903 car env-head, curr-key-ah, trace + 904 var curr-key/eax: (addr cell) <- lookup *curr-key-ah + 905 # if key is not a symbol, abort + 906 { + 907 var curr-key-type/eax: (addr int) <- get curr-key, type + 908 compare *curr-key-type, 2/symbol + 909 break-if-= + 910 error trace, "environment contains a binding for a non-symbol" + 911 trace-higher trace + 912 return + 913 } + 914 # if key matches sym, return val + 915 var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace + 916 compare match?, 0/false + 917 { + 918 break-if-= + 919 cdr env-head, out, trace + 920 +-- 19 lines: # trace "=> " out " (match)" ---------------------------------------------------------------------------------------------------------------------------------------------- + 939 trace-higher trace + 940 return + 941 } + 942 # otherwise recurse + 943 var env-tail-storage: (handle cell) + 944 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage + 945 cdr env, env-tail-ah, trace + 946 lookup-symbol sym, out, *env-tail-ah, globals, trace, inner-screen-var, inner-keyboard-var + 947 trace-higher trace + 948 +-- 19 lines: # trace "=> " out " (recurse)" -------------------------------------------------------------------------------------------------------------------------------------------- + 967 } + 968 + 969 fn test-lookup-symbol-in-env { + 970 # tmp = (a . 3) + 971 var val-storage: (handle cell) + 972 var val-ah/ecx: (addr handle cell) <- address val-storage + 973 new-integer val-ah, 3 + 974 var key-storage: (handle cell) + 975 var key-ah/edx: (addr handle cell) <- address key-storage + 976 new-symbol key-ah, "a" + 977 var env-storage: (handle cell) + 978 var env-ah/ebx: (addr handle cell) <- address env-storage + 979 new-pair env-ah, *key-ah, *val-ah + 980 # env = ((a . 3)) + 981 var nil-storage: (handle cell) + 982 var nil-ah/ecx: (addr handle cell) <- address nil-storage + 983 allocate-pair nil-ah + 984 new-pair env-ah, *env-ah, *nil-ah + 985 # lookup sym(a) in env tmp + 986 var tmp-storage: (handle cell) + 987 var tmp-ah/edx: (addr handle cell) <- address tmp-storage + 988 new-symbol tmp-ah, "a" + 989 var in/eax: (addr cell) <- lookup *tmp-ah + 990 var trace-storage: trace + 991 var trace/edi: (addr trace) <- address trace-storage + 992 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible + 993 lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard + 994 var result/eax: (addr cell) <- lookup *tmp-ah + 995 var result-type/edx: (addr int) <- get result, type + 996 check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0" + 997 var result-value-addr/eax: (addr float) <- get result, number-data + 998 var result-value/eax: int <- convert *result-value-addr + 999 check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1" +1000 } +1001 +1002 fn test-lookup-symbol-in-globals { +1003 var globals-storage: global-table +1004 var globals/edi: (addr global-table) <- address globals-storage +1005 initialize-globals globals +1006 # env = nil +1007 var nil-storage: (handle cell) +1008 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1009 allocate-pair nil-ah +1010 # lookup sym(a), env +1011 var tmp-storage: (handle cell) +1012 var tmp-ah/ebx: (addr handle cell) <- address tmp-storage +1013 new-symbol tmp-ah, "+" +1014 var in/eax: (addr cell) <- lookup *tmp-ah +1015 var trace-storage: trace +1016 var trace/esi: (addr trace) <- address trace-storage +1017 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1018 lookup-symbol in, tmp-ah, *nil-ah, globals, trace, 0/no-screen, 0/no-keyboard +1019 var result/eax: (addr cell) <- lookup *tmp-ah +1020 var result-type/edx: (addr int) <- get result, type +1021 check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0" +1022 var result-value/eax: (addr int) <- get result, index-data +1023 check-ints-equal *result-value, 1/add, "F - test-lookup-symbol-in-globals/1" +1024 } +1025 +1026 fn mutate-binding name: (addr stream byte), val: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace) { +1027 # trace name +1028 { +1029 var should-trace?/eax: boolean <- should-trace? trace +1030 compare should-trace?, 0/false +1031 break-if-= +1032 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` +1033 var stream/ecx: (addr stream byte) <- address stream-storage +1034 write stream, "bind " +1035 rewind-stream name +1036 write-stream stream, name +1037 write stream, " to " +1038 var nested-trace-storage: trace +1039 var nested-trace/edi: (addr trace) <- address nested-trace-storage +1040 initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible +1041 print-cell val, stream, nested-trace +1042 write stream, " in " +1043 var env-ah/eax: (addr handle cell) <- address env-h +1044 clear-trace nested-trace +1045 print-cell env-ah, stream, nested-trace +1046 trace trace, "eval", stream +1047 } +1048 trace-lower trace +1049 var _env/eax: (addr cell) <- lookup env-h +1050 var env/ebx: (addr cell) <- copy _env +1051 # if env is not a list, abort +1052 { +1053 var env-type/ecx: (addr int) <- get env, type +1054 compare *env-type, 0/pair +1055 break-if-= +1056 error trace, "eval found a non-list environment" +1057 trace-higher trace +1058 return +1059 } +1060 # if env is nil, look in globals +1061 { +1062 var env-nil?/eax: boolean <- nil? env +1063 compare env-nil?, 0/false +1064 break-if-= +1065 debug-print "b", 3/fg, 0/bg +1066 mutate-binding-in-globals name, val, globals, trace +1067 debug-print "x", 3/fg, 0/bg +1068 trace-higher trace +1069 +-- 19 lines: # trace "=> " val " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- +1088 debug-print "y", 3/fg, 0/bg +1089 return +1090 } +1091 # check car +1092 var env-head-storage: (handle cell) +1093 var env-head-ah/eax: (addr handle cell) <- address env-head-storage +1094 car env, env-head-ah, trace +1095 var _env-head/eax: (addr cell) <- lookup *env-head-ah +1096 var env-head/ecx: (addr cell) <- copy _env-head +1097 # if car is not a list, abort +1098 { +1099 var env-head-type/eax: (addr int) <- get env-head, type +1100 compare *env-head-type, 0/pair +1101 break-if-= +1102 error trace, "environment is not a list of (key . value) pairs" +1103 trace-higher trace +1104 return +1105 } +1106 # check key +1107 var curr-key-storage: (handle cell) +1108 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage +1109 car env-head, curr-key-ah, trace +1110 var curr-key/eax: (addr cell) <- lookup *curr-key-ah +1111 # if key is not a symbol, abort +1112 { +1113 var curr-key-type/eax: (addr int) <- get curr-key, type +1114 compare *curr-key-type, 2/symbol +1115 break-if-= +1116 error trace, "environment contains a binding for a non-symbol" +1117 trace-higher trace +1118 return +1119 } +1120 # if key matches name, return val +1121 var curr-key-data-ah/eax: (addr handle stream byte) <- get curr-key, text-data +1122 var curr-key-data/eax: (addr stream byte) <- lookup *curr-key-data-ah +1123 var match?/eax: boolean <- streams-data-equal? curr-key-data, name +1124 compare match?, 0/false +1125 { +1126 break-if-= +1127 var dest/eax: (addr handle cell) <- get env-head, right +1128 copy-object val, dest +1129 trace-text trace, "eval", "=> done" +1130 trace-higher trace +1131 return +1132 } +1133 # otherwise recurse +1134 var env-tail-storage: (handle cell) +1135 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage +1136 cdr env, env-tail-ah, trace +1137 mutate-binding name, val, *env-tail-ah, globals, trace +1138 trace-higher trace +1139 } +1140 +1141 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) { +1142 trace-text trace, "eval", "car" +1143 trace-lower trace +1144 var in/eax: (addr cell) <- copy _in +1145 # if in is not a list, abort +1146 { +1147 var in-type/ecx: (addr int) <- get in, type +1148 compare *in-type, 0/pair +1149 break-if-= +1150 error trace, "car on a non-list" +1151 trace-higher trace +1152 return +1153 } +1154 # if in is nil, abort +1155 { +1156 var in-nil?/eax: boolean <- nil? in +1157 compare in-nil?, 0/false +1158 break-if-= +1159 error trace, "car on nil" +1160 trace-higher trace +1161 return +1162 } +1163 var in-left/eax: (addr handle cell) <- get in, left +1164 copy-object in-left, out +1165 trace-higher trace +1166 return +1167 } +1168 +1169 fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) { +1170 trace-text trace, "eval", "cdr" +1171 trace-lower trace +1172 var in/eax: (addr cell) <- copy _in +1173 # if in is not a list, abort +1174 { +1175 var in-type/ecx: (addr int) <- get in, type +1176 compare *in-type, 0/pair +1177 break-if-= +1178 error trace, "car on a non-list" +1179 trace-higher trace +1180 return +1181 } +1182 # if in is nil, abort +1183 { +1184 var in-nil?/eax: boolean <- nil? in +1185 compare in-nil?, 0/false +1186 break-if-= +1187 error trace, "car on nil" +1188 trace-higher trace +1189 return +1190 } +1191 var in-right/eax: (addr handle cell) <- get in, right +1192 copy-object in-right, out +1193 trace-higher trace +1194 return +1195 } +1196 +1197 fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean { +1198 trace-text trace, "eval", "cell-isomorphic?" +1199 trace-lower trace +1200 var a/esi: (addr cell) <- copy _a +1201 var b/edi: (addr cell) <- copy _b +1202 # if types don't match, return false +1203 var a-type-addr/eax: (addr int) <- get a, type +1204 var b-type-addr/ecx: (addr int) <- get b, type +1205 var b-type/ecx: int <- copy *b-type-addr +1206 compare b-type, *a-type-addr +1207 { +1208 break-if-= +1209 trace-higher trace +1210 trace-text trace, "eval", "=> false (type)" +1211 return 0/false +1212 } +1213 # if types are number, compare number-data +1214 # TODO: exactly comparing floats is a bad idea +1215 compare b-type, 1/number +1216 { +1217 break-if-!= +1218 var a-val-addr/eax: (addr float) <- get a, number-data +1219 var b-val-addr/ecx: (addr float) <- get b, number-data +1220 var a-val/xmm0: float <- copy *a-val-addr +1221 compare a-val, *b-val-addr +1222 { +1223 break-if-= +1224 trace-higher trace +1225 trace-text trace, "eval", "=> false (numbers)" +1226 return 0/false +1227 } +1228 trace-higher trace +1229 trace-text trace, "eval", "=> true (numbers)" +1230 return 1/true +1231 } +1232 $cell-isomorphic?:text-data: { +1233 { +1234 compare b-type, 2/symbol +1235 break-if-= +1236 compare b-type, 3/stream +1237 break-if-= +1238 break $cell-isomorphic?:text-data +1239 } +1240 var b-val-ah/eax: (addr handle stream byte) <- get b, text-data +1241 var _b-val/eax: (addr stream byte) <- lookup *b-val-ah +1242 var b-val/ecx: (addr stream byte) <- copy _b-val +1243 var a-val-ah/eax: (addr handle stream byte) <- get a, text-data +1244 var a-val/eax: (addr stream byte) <- lookup *a-val-ah +1245 var tmp-array: (handle array byte) +1246 var tmp-ah/edx: (addr handle array byte) <- address tmp-array +1247 rewind-stream a-val +1248 stream-to-array a-val, tmp-ah +1249 var tmp/eax: (addr array byte) <- lookup *tmp-ah +1250 var match?/eax: boolean <- stream-data-equal? b-val, tmp +1251 trace-higher trace +1252 { +1253 compare match?, 0/false +1254 break-if-= +1255 trace-text trace, "eval", "=> true (symbols)" +1256 } +1257 { +1258 compare match?, 0/false +1259 break-if-!= +1260 trace-text trace, "eval", "=> false (symbols)" +1261 } +1262 return match? +1263 } +1264 # if objects are primitive functions, compare index-data +1265 compare b-type, 4/primitive +1266 { +1267 break-if-!= +1268 var a-val-addr/eax: (addr int) <- get a, index-data +1269 var b-val-addr/ecx: (addr int) <- get b, index-data +1270 var a-val/eax: int <- copy *a-val-addr +1271 compare a-val, *b-val-addr +1272 { +1273 break-if-= +1274 trace-higher trace +1275 trace-text trace, "eval", "=> false (primitives)" +1276 return 0/false +1277 } +1278 trace-higher trace +1279 trace-text trace, "eval", "=> true (primitives)" +1280 return 1/true +1281 } +1282 # if objects are screens, check if they're the same object +1283 compare b-type, 5/screen +1284 { +1285 break-if-!= +1286 var a-val-addr/eax: (addr handle screen) <- get a, screen-data +1287 var b-val-addr/ecx: (addr handle screen) <- get b, screen-data +1288 var result/eax: boolean <- handle-equal? *a-val-addr, *b-val-addr +1289 compare result, 0/false +1290 return result +1291 } +1292 # if objects are keyboards, check if they have the same contents +1293 compare b-type, 6/keyboard +1294 { +1295 break-if-!= +1296 var a-val-addr/ecx: (addr handle gap-buffer) <- get a, keyboard-data +1297 var _a/eax: (addr gap-buffer) <- lookup *a-val-addr +1298 var a/ecx: (addr gap-buffer) <- copy _a +1299 var b-val-addr/eax: (addr handle gap-buffer) <- get b, keyboard-data +1300 var b/eax: (addr gap-buffer) <- lookup *b-val-addr +1301 var result/eax: boolean <- gap-buffers-equal? a, b +1302 return result +1303 } +1304 # if a is nil, b should be nil +1305 { +1306 # (assumes nil? returns 0 or 1) +1307 var _b-nil?/eax: boolean <- nil? b +1308 var b-nil?/ecx: boolean <- copy _b-nil? +1309 var a-nil?/eax: boolean <- nil? a +1310 # a == nil and b == nil => return true +1311 { +1312 compare a-nil?, 0/false +1313 break-if-= +1314 compare b-nil?, 0/false +1315 break-if-= +1316 trace-higher trace +1317 trace-text trace, "eval", "=> true (nils)" +1318 return 1/true +1319 } +1320 # a == nil => return false +1321 { +1322 compare a-nil?, 0/false +1323 break-if-= +1324 trace-higher trace +1325 trace-text trace, "eval", "=> false (b != nil)" +1326 return 0/false +1327 } +1328 # b == nil => return false +1329 { +1330 compare b-nil?, 0/false +1331 break-if-= +1332 trace-higher trace +1333 trace-text trace, "eval", "=> false (a != nil)" +1334 return 0/false +1335 } +1336 } +1337 # a and b are pairs +1338 var a-tmp-storage: (handle cell) +1339 var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage +1340 var b-tmp-storage: (handle cell) +1341 var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage +1342 # if cars aren't equal, return false +1343 car a, a-tmp-ah, trace +1344 car b, b-tmp-ah, trace +1345 { +1346 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah +1347 var a-tmp/ecx: (addr cell) <- copy _a-tmp +1348 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah +1349 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace +1350 compare result, 0/false +1351 break-if-!= +1352 trace-higher trace +1353 trace-text trace, "eval", "=> false (car mismatch)" +1354 return 0/false +1355 } +1356 # recurse on cdrs +1357 cdr a, a-tmp-ah, trace +1358 cdr b, b-tmp-ah, trace +1359 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah +1360 var a-tmp/ecx: (addr cell) <- copy _a-tmp +1361 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah +1362 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace +1363 trace-higher trace +1364 return result +1365 } +1366 +1367 fn fn? _x: (addr cell) -> _/eax: boolean { +1368 var x/esi: (addr cell) <- copy _x +1369 var type/eax: (addr int) <- get x, type +1370 compare *type, 2/symbol +1371 { +1372 break-if-= +1373 return 0/false +1374 } +1375 var contents-ah/eax: (addr handle stream byte) <- get x, text-data +1376 var contents/eax: (addr stream byte) <- lookup *contents-ah +1377 var result/eax: boolean <- stream-data-equal? contents, "fn" +1378 return result +1379 } +1380 +1381 fn litfn? _x: (addr cell) -> _/eax: boolean { +1382 var x/esi: (addr cell) <- copy _x +1383 var type/eax: (addr int) <- get x, type +1384 compare *type, 2/symbol +1385 { +1386 break-if-= +1387 return 0/false +1388 } +1389 var contents-ah/eax: (addr handle stream byte) <- get x, text-data +1390 var contents/eax: (addr stream byte) <- lookup *contents-ah +1391 var result/eax: boolean <- stream-data-equal? contents, "litfn" +1392 return result +1393 } +1394 +1395 fn litmac? _x: (addr cell) -> _/eax: boolean { +1396 var x/esi: (addr cell) <- copy _x +1397 var type/eax: (addr int) <- get x, type +1398 compare *type, 2/symbol +1399 { +1400 break-if-= +1401 return 0/false +1402 } +1403 var contents-ah/eax: (addr handle stream byte) <- get x, text-data +1404 var contents/eax: (addr stream byte) <- lookup *contents-ah +1405 var result/eax: boolean <- stream-data-equal? contents, "litmac" +1406 return result +1407 } +1408 +1409 fn test-evaluate-is-well-behaved { +1410 var t-storage: trace +1411 var t/esi: (addr trace) <- address t-storage +1412 initialize-trace t, 0x100/max-depth, 0x10/capacity, 0/visible # we don't use trace UI +1413 # env = nil +1414 var env-storage: (handle cell) +1415 var env-ah/ecx: (addr handle cell) <- address env-storage +1416 allocate-pair env-ah +1417 # eval sym(a), nil env +1418 var tmp-storage: (handle cell) +1419 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1420 new-symbol tmp-ah, "a" +1421 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1422 # doesn't die +1423 check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved" +1424 } +1425 +1426 fn test-evaluate-number { +1427 # env = nil +1428 var env-storage: (handle cell) +1429 var env-ah/ecx: (addr handle cell) <- address env-storage +1430 allocate-pair env-ah +1431 # tmp = 3 +1432 var tmp-storage: (handle cell) +1433 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1434 new-integer tmp-ah, 3 +1435 var trace-storage: trace +1436 var trace/edi: (addr trace) <- address trace-storage +1437 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1438 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1439 # +1440 var result/eax: (addr cell) <- lookup *tmp-ah +1441 var result-type/edx: (addr int) <- get result, type +1442 check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0" +1443 var result-value-addr/eax: (addr float) <- get result, number-data +1444 var result-value/eax: int <- convert *result-value-addr +1445 check-ints-equal result-value, 3, "F - test-evaluate-number/1" +1446 } +1447 +1448 fn test-evaluate-symbol { +1449 # tmp = (a . 3) +1450 var val-storage: (handle cell) +1451 var val-ah/ecx: (addr handle cell) <- address val-storage +1452 new-integer val-ah, 3 +1453 var key-storage: (handle cell) +1454 var key-ah/edx: (addr handle cell) <- address key-storage +1455 new-symbol key-ah, "a" +1456 var env-storage: (handle cell) +1457 var env-ah/ebx: (addr handle cell) <- address env-storage +1458 new-pair env-ah, *key-ah, *val-ah +1459 # env = ((a . 3)) +1460 var nil-storage: (handle cell) +1461 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1462 allocate-pair nil-ah +1463 new-pair env-ah, *env-ah, *nil-ah +1464 # eval sym(a), env +1465 var tmp-storage: (handle cell) +1466 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1467 new-symbol tmp-ah, "a" +1468 var trace-storage: trace +1469 var trace/edi: (addr trace) <- address trace-storage +1470 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1471 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1472 var result/eax: (addr cell) <- lookup *tmp-ah +1473 var result-type/edx: (addr int) <- get result, type +1474 check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0" +1475 var result-value-addr/eax: (addr float) <- get result, number-data +1476 var result-value/eax: int <- convert *result-value-addr +1477 check-ints-equal result-value, 3, "F - test-evaluate-symbol/1" +1478 } +1479 +1480 fn test-evaluate-quote { +1481 # env = nil +1482 var nil-storage: (handle cell) +1483 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1484 allocate-pair nil-ah +1485 # eval `a, env +1486 var tmp-storage: (handle cell) +1487 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1488 new-symbol tmp-ah, "'" +1489 var tmp2-storage: (handle cell) +1490 var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage +1491 new-symbol tmp2-ah, "a" +1492 new-pair tmp-ah, *tmp-ah, *tmp2-ah +1493 var trace-storage: trace +1494 var trace/edi: (addr trace) <- address trace-storage +1495 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1496 evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1497 var result/eax: (addr cell) <- lookup *tmp-ah +1498 var result-type/edx: (addr int) <- get result, type +1499 check-ints-equal *result-type, 2/symbol, "F - test-evaluate-quote/0" +1500 var sym?/eax: boolean <- symbol-equal? result, "a" +1501 check sym?, "F - test-evaluate-quote/1" +1502 } +1503 +1504 fn test-evaluate-primitive-function { +1505 var globals-storage: global-table +1506 var globals/edi: (addr global-table) <- address globals-storage +1507 initialize-globals globals +1508 var nil-storage: (handle cell) +1509 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1510 allocate-pair nil-ah +1511 var add-storage: (handle cell) +1512 var add-ah/ebx: (addr handle cell) <- address add-storage +1513 new-symbol add-ah, "+" +1514 # eval +, nil env +1515 var tmp-storage: (handle cell) +1516 var tmp-ah/esi: (addr handle cell) <- address tmp-storage +1517 var trace-storage: trace +1518 var trace/edx: (addr trace) <- address trace-storage +1519 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1520 evaluate add-ah, tmp-ah, *nil-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1521 # +1522 var result/eax: (addr cell) <- lookup *tmp-ah +1523 var result-type/edx: (addr int) <- get result, type +1524 check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0" +1525 var result-value/eax: (addr int) <- get result, index-data +1526 check-ints-equal *result-value, 1/add, "F - test-evaluate-primitive-function/1" +1527 } +1528 +1529 fn test-evaluate-primitive-function-call { +1530 var t-storage: trace +1531 var t/edi: (addr trace) <- address t-storage +1532 initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible # we don't use trace UI +1533 # +1534 var nil-storage: (handle cell) +1535 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1536 allocate-pair nil-ah +1537 var one-storage: (handle cell) +1538 var one-ah/edx: (addr handle cell) <- address one-storage +1539 new-integer one-ah, 1 +1540 var add-storage: (handle cell) +1541 var add-ah/ebx: (addr handle cell) <- address add-storage +1542 new-symbol add-ah, "+" +1543 # input is (+ 1 1) +1544 var tmp-storage: (handle cell) +1545 var tmp-ah/esi: (addr handle cell) <- address tmp-storage +1546 new-pair tmp-ah, *one-ah, *nil-ah +1547 new-pair tmp-ah, *one-ah, *tmp-ah +1548 new-pair tmp-ah, *add-ah, *tmp-ah +1549 #? dump-cell tmp-ah +1550 # +1551 var globals-storage: global-table +1552 var globals/edx: (addr global-table) <- address globals-storage +1553 initialize-globals globals +1554 # +1555 evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1556 #? dump-trace t +1557 # +1558 var result/eax: (addr cell) <- lookup *tmp-ah +1559 var result-type/edx: (addr int) <- get result, type +1560 check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0" +1561 var result-value-addr/eax: (addr float) <- get result, number-data +1562 var result-value/eax: int <- convert *result-value-addr +1563 check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1" +1564 } +1565 +1566 fn test-evaluate-backquote { +1567 # env = nil +1568 var nil-storage: (handle cell) +1569 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1570 allocate-pair nil-ah +1571 # eval `a, env +1572 var tmp-storage: (handle cell) +1573 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1574 new-symbol tmp-ah, "`" +1575 var tmp2-storage: (handle cell) +1576 var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage +1577 new-symbol tmp2-ah, "a" +1578 new-pair tmp-ah, *tmp-ah, *tmp2-ah +1579 clear-object tmp2-ah +1580 var trace-storage: trace +1581 var trace/edi: (addr trace) <- address trace-storage +1582 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1583 evaluate tmp-ah, tmp2-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1584 var result/eax: (addr cell) <- lookup *tmp2-ah +1585 var result-type/edx: (addr int) <- get result, type +1586 check-ints-equal *result-type, 2/symbol, "F - test-evaluate-backquote/0" +1587 var sym?/eax: boolean <- symbol-equal? result, "a" +1588 check sym?, "F - test-evaluate-backquote/1" +1589 } +1590 +1591 fn evaluate-backquote _in-ah: (addr handle cell), _out-ah: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell), definitions-created: (addr stream int), call-number: (addr int) { +1592 # stack overflow? # disable when enabling Really-debug-print +1593 #? dump-cell-from-cursor-over-full-screen _in-ah +1594 check-stack +1595 { +1596 var inner-screen-var/eax: (addr handle cell) <- copy inner-screen-var +1597 compare inner-screen-var, 0 +1598 break-if-= +1599 var inner-screen-var-addr/eax: (addr cell) <- lookup *inner-screen-var +1600 compare inner-screen-var-addr, 0 +1601 break-if-= +1602 # if inner-screen-var exists, we're probably not in a test +1603 show-stack-state +1604 } +1605 # errors? skip +1606 { +1607 var error?/eax: boolean <- has-errors? trace +1608 compare error?, 0/false +1609 break-if-= +1610 return +1611 } +1612 trace-lower trace +1613 var in-ah/esi: (addr handle cell) <- copy _in-ah +1614 var in/eax: (addr cell) <- lookup *in-ah +1615 { +1616 var nil?/eax: boolean <- nil? in +1617 compare nil?, 0/false +1618 break-if-= +1619 # nil is a literal +1620 trace-text trace, "eval", "backquote nil" +1621 copy-object _in-ah, _out-ah +1622 trace-higher trace +1623 return +1624 } +1625 var in-type/ecx: (addr int) <- get in, type +1626 compare *in-type, 0/pair +1627 { +1628 break-if-= +1629 # copy non-pairs directly +1630 # TODO: streams might need to be copied +1631 trace-text trace, "eval", "backquote atom" +1632 copy-object _in-ah, _out-ah +1633 trace-higher trace +1634 return +1635 } +1636 # 'in' is a pair +1637 debug-print "()", 4/fg, 0/bg +1638 var in-ah/esi: (addr handle cell) <- copy _in-ah +1639 var _in/eax: (addr cell) <- lookup *in-ah +1640 var in/ebx: (addr cell) <- copy _in +1641 var in-left-ah/ecx: (addr handle cell) <- get in, left +1642 debug-print "10", 4/fg, 0/bg +1643 # check for unquote +1644 $macroexpand-iter:unquote: { +1645 var in-left/eax: (addr cell) <- lookup *in-left-ah +1646 var unquote?/eax: boolean <- symbol-equal? in-left, "," +1647 compare unquote?, 0/false +1648 break-if-= +1649 trace-text trace, "eval", "unquote" +1650 var rest-ah/eax: (addr handle cell) <- get in, right +1651 debug-print ",", 3/fg, 0/bg +1652 evaluate rest-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number +1653 debug-print ",)", 3/fg, 0/bg +1654 trace-higher trace +1655 return +1656 } +1657 # check for unquote-splice in in-left +1658 debug-print "11", 4/fg, 0/bg +1659 var out-ah/edi: (addr handle cell) <- copy _out-ah +1660 $macroexpand-iter:unquote-splice: { +1661 #? dump-cell-from-cursor-over-full-screen in-left-ah +1662 var in-left/eax: (addr cell) <- lookup *in-left-ah +1663 { +1664 debug-print "12", 4/fg, 0/bg +1665 { +1666 var in-left-is-nil?/eax: boolean <- nil? in-left +1667 compare in-left-is-nil?, 0/false +1668 } +1669 break-if-!= $macroexpand-iter:unquote-splice +1670 var in-left-type/ecx: (addr int) <- get in-left, type +1671 debug-print "13", 4/fg, 0/bg +1672 compare *in-left-type, 0/pair +1673 break-if-!= $macroexpand-iter:unquote-splice +1674 var in-left-left-ah/eax: (addr handle cell) <- get in-left, left +1675 debug-print "14", 4/fg, 0/bg +1676 var in-left-left/eax: (addr cell) <- lookup *in-left-left-ah +1677 debug-print "15", 4/fg, 0/bg +1678 var in-left-left-type/ecx: (addr int) <- get in-left-left, type +1679 var left-is-unquote-splice?/eax: boolean <- symbol-equal? in-left-left, ",@" +1680 debug-print "16", 4/fg, 0/bg +1681 compare left-is-unquote-splice?, 0/false +1682 } +1683 break-if-= +1684 debug-print "17", 4/fg, 0/bg +1685 trace-text trace, "eval", "unquote-splice" +1686 var in-unquote-payload-ah/eax: (addr handle cell) <- get in-left, right +1687 evaluate in-unquote-payload-ah, out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number +1688 # errors? skip +1689 { +1690 var error?/eax: boolean <- has-errors? trace +1691 compare error?, 0/false +1692 break-if-= +1693 trace-higher trace +1694 return +1695 } +1696 # while (*out-ah != null) out-ah = cdr(out-ah) +1697 { +1698 var out/eax: (addr cell) <- lookup *out-ah +1699 { +1700 var done?/eax: boolean <- nil? out +1701 compare done?, 0/false +1702 } +1703 break-if-!= +1704 out-ah <- get out, right +1705 loop +1706 } +1707 # append result of in-right +1708 var in-right-ah/ecx: (addr handle cell) <- get in, right +1709 evaluate-backquote in-right-ah, out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number +1710 trace-higher trace +1711 return +1712 } +1713 debug-print "19", 4/fg, 0/bg +1714 # otherwise continue copying +1715 trace-text trace, "eval", "backquote: copy" +1716 var out-ah/edi: (addr handle cell) <- copy _out-ah +1717 allocate-pair out-ah +1718 debug-print "20", 7/fg, 0/bg +1719 #? dump-cell-from-cursor-over-full-screen out-ah +1720 var out/eax: (addr cell) <- lookup *out-ah +1721 var out-left-ah/edx: (addr handle cell) <- get out, left +1722 debug-print "`(l", 3/fg, 0/bg +1723 evaluate-backquote in-left-ah, out-left-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number +1724 debug-print "`r)", 3/fg, 0/bg +1725 # errors? skip +1726 { +1727 var error?/eax: boolean <- has-errors? trace +1728 compare error?, 0/false +1729 break-if-= +1730 trace-higher trace +1731 return +1732 } +1733 var in-right-ah/ecx: (addr handle cell) <- get in, right +1734 var out-right-ah/edx: (addr handle cell) <- get out, right +1735 debug-print "`r(", 3/fg, 0/bg +1736 evaluate-backquote in-right-ah, out-right-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number +1737 debug-print "`r)", 3/fg, 0/bg +1738 trace-higher trace +1739 } +1740 +1741 fn test-evaluate-backquote-list { +1742 var nil-storage: (handle cell) +1743 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1744 allocate-pair nil-ah +1745 var backquote-storage: (handle cell) +1746 var backquote-ah/edx: (addr handle cell) <- address backquote-storage +1747 new-symbol backquote-ah, "`" +1748 # input is `(a b) +1749 var a-storage: (handle cell) +1750 var a-ah/ebx: (addr handle cell) <- address a-storage +1751 new-symbol a-ah, "a" +1752 var b-storage: (handle cell) +1753 var b-ah/esi: (addr handle cell) <- address b-storage +1754 new-symbol b-ah, "b" +1755 var tmp-storage: (handle cell) +1756 var tmp-ah/eax: (addr handle cell) <- address tmp-storage +1757 new-pair tmp-ah, *b-ah, *nil-ah +1758 new-pair tmp-ah, *a-ah, *tmp-ah +1759 new-pair tmp-ah, *backquote-ah, *tmp-ah +1760 # +1761 var trace-storage: trace +1762 var trace/edi: (addr trace) <- address trace-storage +1763 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1764 evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1765 # result is (a b) +1766 var result/eax: (addr cell) <- lookup *tmp-ah +1767 { +1768 var result-type/eax: (addr int) <- get result, type +1769 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list/0" +1770 } +1771 { +1772 var a1-ah/eax: (addr handle cell) <- get result, left +1773 var a1/eax: (addr cell) <- lookup *a1-ah +1774 var check1/eax: boolean <- symbol-equal? a1, "a" +1775 check check1, "F - test-evaluate-backquote-list/1" +1776 } +1777 var rest-ah/eax: (addr handle cell) <- get result, right +1778 var rest/eax: (addr cell) <- lookup *rest-ah +1779 { +1780 var a2-ah/eax: (addr handle cell) <- get rest, left +1781 var a2/eax: (addr cell) <- lookup *a2-ah +1782 var check2/eax: boolean <- symbol-equal? a2, "b" +1783 check check2, "F - test-evaluate-backquote-list/2" +1784 } +1785 var rest-ah/eax: (addr handle cell) <- get rest, right +1786 var rest/eax: (addr cell) <- lookup *rest-ah +1787 var check3/eax: boolean <- nil? rest +1788 check check3, "F - test-evaluate-backquote-list/3" +1789 } +1790 +1791 fn test-evaluate-backquote-list-with-unquote { +1792 var nil-h: (handle cell) +1793 var nil-ah/eax: (addr handle cell) <- address nil-h +1794 allocate-pair nil-ah +1795 var backquote-h: (handle cell) +1796 var backquote-ah/eax: (addr handle cell) <- address backquote-h +1797 new-symbol backquote-ah, "`" +1798 var unquote-h: (handle cell) +1799 var unquote-ah/eax: (addr handle cell) <- address unquote-h +1800 new-symbol unquote-ah, "," +1801 var a-h: (handle cell) +1802 var a-ah/eax: (addr handle cell) <- address a-h +1803 new-symbol a-ah, "a" +1804 var b-h: (handle cell) +1805 var b-ah/eax: (addr handle cell) <- address b-h +1806 new-symbol b-ah, "b" +1807 # env = ((b . 3)) +1808 var val-h: (handle cell) +1809 var val-ah/eax: (addr handle cell) <- address val-h +1810 new-integer val-ah, 3 +1811 var env-h: (handle cell) +1812 var env-ah/eax: (addr handle cell) <- address env-h +1813 new-pair env-ah, b-h, val-h +1814 new-pair env-ah, env-h, nil-h +1815 # input is `(a ,b) +1816 var tmp-h: (handle cell) +1817 var tmp-ah/eax: (addr handle cell) <- address tmp-h +1818 # tmp = cons(unquote, b) +1819 new-pair tmp-ah, unquote-h, b-h +1820 # tmp = cons(tmp, nil) +1821 new-pair tmp-ah, tmp-h, nil-h +1822 # tmp = cons(a, tmp) +1823 new-pair tmp-ah, a-h, tmp-h +1824 # tmp = cons(backquote, tmp) +1825 new-pair tmp-ah, backquote-h, tmp-h +1826 # +1827 var trace-storage: trace +1828 var trace/edi: (addr trace) <- address trace-storage +1829 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1830 evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1831 # result is (a 3) +1832 var result/eax: (addr cell) <- lookup *tmp-ah +1833 { +1834 var result-type/eax: (addr int) <- get result, type +1835 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote/0" +1836 } +1837 { +1838 var a1-ah/eax: (addr handle cell) <- get result, left +1839 var a1/eax: (addr cell) <- lookup *a1-ah +1840 var check1/eax: boolean <- symbol-equal? a1, "a" +1841 check check1, "F - test-evaluate-backquote-list-with-unquote/1" +1842 } +1843 var rest-ah/eax: (addr handle cell) <- get result, right +1844 var rest/eax: (addr cell) <- lookup *rest-ah +1845 { +1846 var a2-ah/eax: (addr handle cell) <- get rest, left +1847 var a2/eax: (addr cell) <- lookup *a2-ah +1848 var a2-value-addr/eax: (addr float) <- get a2, number-data +1849 var a2-value/eax: int <- convert *a2-value-addr +1850 check-ints-equal a2-value, 3, "F - test-evaluate-backquote-list-with-unquote/2" +1851 } +1852 var rest-ah/eax: (addr handle cell) <- get rest, right +1853 var rest/eax: (addr cell) <- lookup *rest-ah +1854 var check3/eax: boolean <- nil? rest +1855 check check3, "F - test-evaluate-backquote-list-with-unquote/3" +1856 } +1857 +1858 fn test-evaluate-backquote-list-with-unquote-splice { +1859 var nil-h: (handle cell) +1860 var nil-ah/eax: (addr handle cell) <- address nil-h +1861 allocate-pair nil-ah +1862 var backquote-h: (handle cell) +1863 var backquote-ah/eax: (addr handle cell) <- address backquote-h +1864 new-symbol backquote-ah, "`" +1865 var unquote-splice-h: (handle cell) +1866 var unquote-splice-ah/eax: (addr handle cell) <- address unquote-splice-h +1867 new-symbol unquote-splice-ah, ",@" +1868 var a-h: (handle cell) +1869 var a-ah/eax: (addr handle cell) <- address a-h +1870 new-symbol a-ah, "a" +1871 var b-h: (handle cell) +1872 var b-ah/eax: (addr handle cell) <- address b-h +1873 new-symbol b-ah, "b" +1874 # env = ((b . (a 3))) +1875 var val-h: (handle cell) +1876 var val-ah/eax: (addr handle cell) <- address val-h +1877 new-integer val-ah, 3 +1878 new-pair val-ah, val-h, nil-h +1879 new-pair val-ah, a-h, val-h +1880 var env-h: (handle cell) +1881 var env-ah/eax: (addr handle cell) <- address env-h +1882 new-pair env-ah, b-h, val-h +1883 new-pair env-ah, env-h, nil-h +1884 # input is `(a ,@b b) +1885 var tmp-h: (handle cell) +1886 var tmp-ah/eax: (addr handle cell) <- address tmp-h +1887 # tmp = cons(b, nil) +1888 new-pair tmp-ah, b-h, nil-h +1889 # tmp2 = cons(unquote-splice, b) +1890 var tmp2-h: (handle cell) +1891 var tmp2-ah/ecx: (addr handle cell) <- address tmp2-h +1892 new-pair tmp2-ah, unquote-splice-h, b-h +1893 # tmp = cons(tmp2, tmp) +1894 new-pair tmp-ah, tmp2-h, tmp-h +1895 # tmp = cons(a, tmp) +1896 new-pair tmp-ah, a-h, tmp-h +1897 # tmp = cons(backquote, tmp) +1898 new-pair tmp-ah, backquote-h, tmp-h +1899 #? dump-cell-from-cursor-over-full-screen tmp-ah +1900 # +1901 var trace-storage: trace +1902 var trace/edi: (addr trace) <- address trace-storage +1903 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +1904 evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number +1905 # result is (a a 3 b) +1906 #? dump-cell-from-cursor-over-full-screen tmp-ah +1907 var result/eax: (addr cell) <- lookup *tmp-ah +1908 { +1909 var result-type/eax: (addr int) <- get result, type +1910 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote-splice/0" +1911 } +1912 { +1913 var a1-ah/eax: (addr handle cell) <- get result, left +1914 var a1/eax: (addr cell) <- lookup *a1-ah +1915 var check1/eax: boolean <- symbol-equal? a1, "a" +1916 check check1, "F - test-evaluate-backquote-list-with-unquote-splice/1" +1917 } +1918 var rest-ah/eax: (addr handle cell) <- get result, right +1919 var rest/eax: (addr cell) <- lookup *rest-ah +1920 { +1921 var a2-ah/eax: (addr handle cell) <- get rest, left +1922 var a2/eax: (addr cell) <- lookup *a2-ah +1923 var check2/eax: boolean <- symbol-equal? a2, "a" +1924 check check2, "F - test-evaluate-backquote-list-with-unquote-splice/2" +1925 } +1926 var rest-ah/eax: (addr handle cell) <- get rest, right +1927 var rest/eax: (addr cell) <- lookup *rest-ah +1928 { +1929 var a3-ah/eax: (addr handle cell) <- get rest, left +1930 var a3/eax: (addr cell) <- lookup *a3-ah +1931 var a3-value-addr/eax: (addr float) <- get a3, number-data +1932 var a3-value/eax: int <- convert *a3-value-addr +1933 check-ints-equal a3-value, 3, "F - test-evaluate-backquote-list-with-unquote-splice/3" +1934 } +1935 var rest-ah/eax: (addr handle cell) <- get rest, right +1936 var rest/eax: (addr cell) <- lookup *rest-ah +1937 { +1938 var a4-ah/eax: (addr handle cell) <- get rest, left +1939 var a4/eax: (addr cell) <- lookup *a4-ah +1940 var check4/eax: boolean <- symbol-equal? a4, "b" +1941 check check4, "F - test-evaluate-backquote-list-with-unquote-splice/4" +1942 } +1943 var rest-ah/eax: (addr handle cell) <- get rest, right +1944 var rest/eax: (addr cell) <- lookup *rest-ah +1945 var check5/eax: boolean <- nil? rest +1946 check check5, "F - test-evaluate-backquote-list-with-unquote-splice/5" +1947 } diff --git a/html/shell/gap-buffer.mu.html b/html/shell/gap-buffer.mu.html index 265a4cc6..f22c381f 100644 --- a/html/shell/gap-buffer.mu.html +++ b/html/shell/gap-buffer.mu.html @@ -16,6 +16,7 @@ a { color:inherit; } * { font-size:12pt; font-size: 1em; } .LineNr { } .Delimiter { color: #c000c0; } +.muRegEdx { color: #878700; } .muRegEbx { color: #8787af; } .muRegEsi { color: #87d787; } .muRegEdi { color: #87ffd7; } @@ -27,7 +28,6 @@ a { color:inherit; } .muComment { color: #005faf; } .muRegEax { color: #875f00; } .muRegEcx { color: #af875f; } -.muRegEdx { color: #878700; } --> @@ -105,7 +105,7 @@ if ('onhashchange' in window) { 40 return result 41 } 42 - 43 fn gap-buffer-capacity _gap: (addr gap-buffer) -> _/ecx: int { + 43 fn gap-buffer-capacity _gap: (addr gap-buffer) -> _/edx: int { 44 var gap/esi: (addr gap-buffer) <- copy _gap 45 var left/eax: (addr grapheme-stack) <- get gap, left 46 var left-data-ah/eax: (addr handle array grapheme) <- get left, data @@ -115,17 +115,17 @@ if ('onhashchange' in window) { 50 } 51 52 # just for tests - 53 fn initialize-gap-buffer-with self: (addr gap-buffer), s: (addr array byte) { + 53 fn initialize-gap-buffer-with self: (addr gap-buffer), keys: (addr array byte) { 54 initialize-gap-buffer self, 0x40/capacity - 55 var stream-storage: (stream byte 0x40/capacity) - 56 var stream/ecx: (addr stream byte) <- address stream-storage - 57 write stream, s + 55 var input-stream-storage: (stream byte 0x40/capacity) + 56 var input-stream/ecx: (addr stream byte) <- address input-stream-storage + 57 write input-stream, keys 58 { - 59 var done?/eax: boolean <- stream-empty? stream + 59 var done?/eax: boolean <- stream-empty? input-stream 60 compare done?, 0/false 61 break-if-!= - 62 var g/eax: grapheme <- read-grapheme stream - 63 add-grapheme-at-gap self, g + 62 var g/eax: grapheme <- read-grapheme input-stream + 63 add-grapheme-at-gap self, g 64 loop 65 } 66 } @@ -140,7 +140,7 @@ if ('onhashchange' in window) { 75 compare key, 0/null 76 break-if-= 77 var g/eax: grapheme <- copy key - 78 edit-gap-buffer self, g + 78 edit-gap-buffer self, g 79 loop 80 } 81 } @@ -228,7 +228,7 @@ if ('onhashchange' in window) { 163 var _g: gap-buffer 164 var g/esi: (addr gap-buffer) <- address _g 165 initialize-gap-buffer-with g, "abc" - 166 gap-to-start g + 166 gap-to-start g 167 # 168 var out-storage: (stream byte 0x10) 169 var out/eax: (addr stream byte) <- address out-storage @@ -251,7 +251,7 @@ if ('onhashchange' in window) { 186 var _g: gap-buffer 187 var g/esi: (addr gap-buffer) <- address _g 188 initialize-gap-buffer-with g, " abc" - 189 gap-to-start g + 189 gap-to-start g 190 # 191 var out-storage: (stream byte 0x10) 192 var out/eax: (addr stream byte) <- address out-storage @@ -274,7 +274,7 @@ if ('onhashchange' in window) { 209 var _g: gap-buffer 210 var g/esi: (addr gap-buffer) <- address _g 211 initialize-gap-buffer-with g, "a bc d" - 212 gap-to-start g + 212 gap-to-start g 213 # 214 var out-storage: (stream byte 0x10) 215 var out/eax: (addr stream byte) <- address out-storage @@ -286,7 +286,7 @@ if ('onhashchange' in window) { 221 var _g: gap-buffer 222 var g/esi: (addr gap-buffer) <- address _g 223 initialize-gap-buffer-with g, "a bc d" - 224 var dummy/eax: grapheme <- gap-left g + 224 var dummy/eax: grapheme <- gap-left g 225 # gap is at final word 226 var out-storage: (stream byte 0x10) 227 var out/eax: (addr stream byte) <- address out-storage @@ -298,7 +298,7 @@ if ('onhashchange' in window) { 233 var _g: gap-buffer 234 var g/esi: (addr gap-buffer) <- address _g 235 initialize-gap-buffer-with g, "abc " - 236 var dummy/eax: grapheme <- gap-left g + 236 var dummy/eax: grapheme <- gap-left g 237 # gap is at final word 238 var out-storage: (stream byte 0x10) 239 var out/eax: (addr stream byte) <- address out-storage @@ -451,1068 +451,1090 @@ if ('onhashchange' in window) { 386 fn render-gap-buffer-wrapping-right-then-down screen: (addr screen), _gap: (addr gap-buffer), xmin: int, ymin: int, xmax: int, ymax: int, render-cursor?: boolean, color: int, background-color: int -> _/eax: int, _/ecx: int { 387 var gap/esi: (addr gap-buffer) <- copy _gap 388 var left/edx: (addr grapheme-stack) <- get gap, left - 389 var highlight-matching-open-paren?/ebx: boolean <- copy 0/false + 389 var highlight-matching-open-paren?/ebx: boolean <- copy 0/false 390 var matching-open-paren-depth/edi: int <- copy 0 - 391 highlight-matching-open-paren?, matching-open-paren-depth <- highlight-matching-open-paren? gap, render-cursor? + 391 highlight-matching-open-paren?, matching-open-paren-depth <- highlight-matching-open-paren? gap, render-cursor? 392 var x2/eax: int <- copy 0 393 var y2/ecx: int <- copy 0 - 394 x2, y2 <- render-stack-from-bottom-wrapping-right-then-down screen, left, xmin, ymin, xmax, ymax, xmin, ymin, highlight-matching-open-paren?, matching-open-paren-depth, color, background-color + 394 x2, y2 <- render-stack-from-bottom-wrapping-right-then-down screen, left, xmin, ymin, xmax, ymax, xmin, ymin, highlight-matching-open-paren?, matching-open-paren-depth, color, background-color 395 var right/edx: (addr grapheme-stack) <- get gap, right 396 x2, y2 <- render-stack-from-top-wrapping-right-then-down screen, right, xmin, ymin, xmax, ymax, x2, y2, render-cursor?, color, background-color 397 # decide whether we still need to print a cursor - 398 var bg/ebx: int <- copy background-color - 399 compare render-cursor?, 0/false - 400 { - 401 break-if-= - 402 # if the right side is empty, grapheme stack didn't print the cursor - 403 var empty?/eax: boolean <- grapheme-stack-empty? right - 404 compare empty?, 0/false - 405 break-if-= - 406 bg <- copy 7/cursor - 407 } - 408 # print a grapheme either way so that cursor position doesn't affect printed width - 409 var space/edx: grapheme <- copy 0x20 - 410 x2, y2 <- render-grapheme screen, space, xmin, ymin, xmax, ymax, x2, y2, color, bg - 411 return x2, y2 - 412 } - 413 - 414 fn render-gap-buffer screen: (addr screen), gap: (addr gap-buffer), x: int, y: int, render-cursor?: boolean, color: int, background-color: int -> _/eax: int { - 415 var _width/eax: int <- copy 0 - 416 var _height/ecx: int <- copy 0 - 417 _width, _height <- screen-size screen - 418 var width/edx: int <- copy _width - 419 var height/ebx: int <- copy _height - 420 var x2/eax: int <- copy 0 - 421 var y2/ecx: int <- copy 0 - 422 x2, y2 <- render-gap-buffer-wrapping-right-then-down screen, gap, x, y, width, height, render-cursor?, color, background-color - 423 return x2 # y2? yolo - 424 } - 425 - 426 fn gap-buffer-length _gap: (addr gap-buffer) -> _/eax: int { - 427 var gap/esi: (addr gap-buffer) <- copy _gap - 428 var left/eax: (addr grapheme-stack) <- get gap, left - 429 var tmp/eax: (addr int) <- get left, top - 430 var left-length/ecx: int <- copy *tmp - 431 var right/esi: (addr grapheme-stack) <- get gap, right - 432 tmp <- get right, top - 433 var result/eax: int <- copy *tmp - 434 result <- add left-length - 435 return result - 436 } - 437 - 438 fn add-grapheme-at-gap _self: (addr gap-buffer), g: grapheme { - 439 var self/esi: (addr gap-buffer) <- copy _self - 440 var left/eax: (addr grapheme-stack) <- get self, left - 441 push-grapheme-stack left, g - 442 } - 443 - 444 fn add-code-point-at-gap self: (addr gap-buffer), c: code-point { - 445 var g/eax: grapheme <- copy c - 446 add-grapheme-at-gap self, g - 447 } - 448 - 449 fn gap-to-start self: (addr gap-buffer) { - 450 { - 451 var curr/eax: grapheme <- gap-left self - 452 compare curr, -1 - 453 loop-if-!= - 454 } - 455 } - 456 - 457 fn gap-to-end self: (addr gap-buffer) { - 458 { - 459 var curr/eax: grapheme <- gap-right self - 460 compare curr, -1 - 461 loop-if-!= - 462 } - 463 } - 464 - 465 fn gap-at-start? _self: (addr gap-buffer) -> _/eax: boolean { - 466 var self/esi: (addr gap-buffer) <- copy _self - 467 var left/eax: (addr grapheme-stack) <- get self, left - 468 var result/eax: boolean <- grapheme-stack-empty? left - 469 return result - 470 } - 471 - 472 fn gap-at-end? _self: (addr gap-buffer) -> _/eax: boolean { - 473 var self/esi: (addr gap-buffer) <- copy _self - 474 var right/eax: (addr grapheme-stack) <- get self, right - 475 var result/eax: boolean <- grapheme-stack-empty? right - 476 return result - 477 } - 478 - 479 fn gap-right _self: (addr gap-buffer) -> _/eax: grapheme { - 480 var self/esi: (addr gap-buffer) <- copy _self - 481 var g/eax: grapheme <- copy 0 - 482 var right/ecx: (addr grapheme-stack) <- get self, right - 483 g <- pop-grapheme-stack right - 484 compare g, -1 - 485 { - 486 break-if-= - 487 var left/ecx: (addr grapheme-stack) <- get self, left - 488 push-grapheme-stack left, g - 489 } - 490 return g - 491 } - 492 - 493 fn gap-left _self: (addr gap-buffer) -> _/eax: grapheme { - 494 var self/esi: (addr gap-buffer) <- copy _self - 495 var g/eax: grapheme <- copy 0 - 496 { - 497 var left/ecx: (addr grapheme-stack) <- get self, left - 498 g <- pop-grapheme-stack left - 499 } - 500 compare g, -1 - 501 { - 502 break-if-= - 503 var right/ecx: (addr grapheme-stack) <- get self, right - 504 push-grapheme-stack right, g - 505 } - 506 return g - 507 } - 508 - 509 fn index-of-gap _self: (addr gap-buffer) -> _/eax: int { - 510 var self/eax: (addr gap-buffer) <- copy _self - 511 var left/eax: (addr grapheme-stack) <- get self, left - 512 var top-addr/eax: (addr int) <- get left, top - 513 var result/eax: int <- copy *top-addr - 514 return result - 515 } - 516 - 517 fn first-grapheme-in-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { - 518 var self/esi: (addr gap-buffer) <- copy _self - 519 # try to read from left - 520 var left/eax: (addr grapheme-stack) <- get self, left - 521 var top-addr/ecx: (addr int) <- get left, top - 522 compare *top-addr, 0 - 523 { - 524 break-if-<= - 525 var data-ah/eax: (addr handle array grapheme) <- get left, data - 526 var data/eax: (addr array grapheme) <- lookup *data-ah - 527 var result-addr/eax: (addr grapheme) <- index data, 0 - 528 return *result-addr - 529 } - 530 # try to read from right - 531 var right/eax: (addr grapheme-stack) <- get self, right - 532 top-addr <- get right, top - 533 compare *top-addr, 0 - 534 { - 535 break-if-<= - 536 var data-ah/eax: (addr handle array grapheme) <- get right, data - 537 var data/eax: (addr array grapheme) <- lookup *data-ah - 538 var top/ecx: int <- copy *top-addr - 539 top <- decrement - 540 var result-addr/eax: (addr grapheme) <- index data, top - 541 return *result-addr - 542 } - 543 # give up - 544 return -1 - 545 } - 546 - 547 fn grapheme-before-cursor-in-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { - 548 var self/esi: (addr gap-buffer) <- copy _self - 549 # try to read from left - 550 var left/ecx: (addr grapheme-stack) <- get self, left - 551 var top-addr/edx: (addr int) <- get left, top - 552 compare *top-addr, 0 - 553 { - 554 break-if-<= - 555 var result/eax: grapheme <- pop-grapheme-stack left - 556 push-grapheme-stack left, result - 557 return result - 558 } - 559 # give up - 560 return -1 - 561 } - 562 - 563 fn delete-before-gap _self: (addr gap-buffer) { - 564 var self/eax: (addr gap-buffer) <- copy _self - 565 var left/eax: (addr grapheme-stack) <- get self, left - 566 var dummy/eax: grapheme <- pop-grapheme-stack left - 567 } - 568 - 569 fn pop-after-gap _self: (addr gap-buffer) -> _/eax: grapheme { - 570 var self/eax: (addr gap-buffer) <- copy _self - 571 var right/eax: (addr grapheme-stack) <- get self, right - 572 var result/eax: grapheme <- pop-grapheme-stack right - 573 return result - 574 } - 575 - 576 fn gap-buffer-equal? _self: (addr gap-buffer), s: (addr array byte) -> _/eax: boolean { - 577 var self/esi: (addr gap-buffer) <- copy _self - 578 # complication: graphemes may be multiple bytes - 579 # so don't rely on length - 580 # instead turn the expected result into a stream and arrange to read from it in order - 581 var stream-storage: (stream byte 0x10/capacity) - 582 var expected-stream/ecx: (addr stream byte) <- address stream-storage - 583 write expected-stream, s - 584 # compare left - 585 var left/edx: (addr grapheme-stack) <- get self, left - 586 var result/eax: boolean <- prefix-match? left, expected-stream - 587 compare result, 0/false - 588 { - 589 break-if-!= - 590 return result - 591 } - 592 # compare right - 593 var right/edx: (addr grapheme-stack) <- get self, right - 594 result <- suffix-match? right, expected-stream - 595 compare result, 0/false - 596 { - 597 break-if-!= - 598 return result - 599 } - 600 # ensure there's nothing left over - 601 result <- stream-empty? expected-stream - 602 return result - 603 } - 604 - 605 fn test-gap-buffer-equal-from-end { - 606 var _g: gap-buffer - 607 var g/esi: (addr gap-buffer) <- address _g - 608 initialize-gap-buffer g, 0x10 - 609 # - 610 add-code-point-at-gap g, 0x61/a - 611 add-code-point-at-gap g, 0x61/a - 612 add-code-point-at-gap g, 0x61/a - 613 # gap is at end (right is empty) - 614 var result/eax: boolean <- gap-buffer-equal? g, "aaa" - 615 check result, "F - test-gap-buffer-equal-from-end" - 616 } - 617 - 618 fn test-gap-buffer-equal-from-middle { - 619 var _g: gap-buffer - 620 var g/esi: (addr gap-buffer) <- address _g - 621 initialize-gap-buffer g, 0x10 - 622 # - 623 add-code-point-at-gap g, 0x61/a - 624 add-code-point-at-gap g, 0x61/a - 625 add-code-point-at-gap g, 0x61/a - 626 var dummy/eax: grapheme <- gap-left g - 627 # gap is in the middle - 628 var result/eax: boolean <- gap-buffer-equal? g, "aaa" - 629 check result, "F - test-gap-buffer-equal-from-middle" - 630 } - 631 - 632 fn test-gap-buffer-equal-from-start { - 633 var _g: gap-buffer - 634 var g/esi: (addr gap-buffer) <- address _g - 635 initialize-gap-buffer g, 0x10 - 636 # - 637 add-code-point-at-gap g, 0x61/a - 638 add-code-point-at-gap g, 0x61/a - 639 add-code-point-at-gap g, 0x61/a - 640 var dummy/eax: grapheme <- gap-left g - 641 dummy <- gap-left g - 642 dummy <- gap-left g - 643 # gap is at the start - 644 var result/eax: boolean <- gap-buffer-equal? g, "aaa" - 645 check result, "F - test-gap-buffer-equal-from-start" - 646 } - 647 - 648 fn test-gap-buffer-equal-fails { - 649 # g = "aaa" - 650 var _g: gap-buffer - 651 var g/esi: (addr gap-buffer) <- address _g - 652 initialize-gap-buffer g, 0x10 - 653 add-code-point-at-gap g, 0x61/a - 654 add-code-point-at-gap g, 0x61/a - 655 add-code-point-at-gap g, 0x61/a - 656 # - 657 var result/eax: boolean <- gap-buffer-equal? g, "aa" - 658 check-not result, "F - test-gap-buffer-equal-fails" - 659 } - 660 - 661 fn gap-buffers-equal? self: (addr gap-buffer), g: (addr gap-buffer) -> _/eax: boolean { - 662 var tmp/eax: int <- gap-buffer-length self - 663 var len/ecx: int <- copy tmp - 664 var leng/eax: int <- gap-buffer-length g - 665 compare len, leng - 666 { - 667 break-if-= - 668 return 0/false - 669 } - 670 var i/edx: int <- copy 0 - 671 { - 672 compare i, len - 673 break-if->= - 674 { - 675 var tmp/eax: grapheme <- gap-index self, i - 676 var curr/ecx: grapheme <- copy tmp - 677 var currg/eax: grapheme <- gap-index g, i - 678 compare curr, currg - 679 break-if-= - 680 return 0/false - 681 } - 682 i <- increment - 683 loop - 684 } - 685 return 1/true - 686 } - 687 - 688 fn gap-index _self: (addr gap-buffer), _n: int -> _/eax: grapheme { - 689 var self/esi: (addr gap-buffer) <- copy _self - 690 var n/ebx: int <- copy _n - 691 # if n < left->length, index into left - 692 var left/edi: (addr grapheme-stack) <- get self, left - 693 var left-len-a/edx: (addr int) <- get left, top - 694 compare n, *left-len-a - 695 { - 696 break-if->= - 697 var data-ah/eax: (addr handle array grapheme) <- get left, data - 698 var data/eax: (addr array grapheme) <- lookup *data-ah - 699 var result/eax: (addr grapheme) <- index data, n - 700 return *result - 701 } - 702 # shrink n - 703 n <- subtract *left-len-a - 704 # if n < right->length, index into right - 705 var right/edi: (addr grapheme-stack) <- get self, right - 706 var right-len-a/edx: (addr int) <- get right, top - 707 compare n, *right-len-a - 708 { - 709 break-if->= - 710 var data-ah/eax: (addr handle array grapheme) <- get right, data - 711 var data/eax: (addr array grapheme) <- lookup *data-ah - 712 # idx = right->len - n - 1 - 713 var idx/ebx: int <- copy n - 714 idx <- subtract *right-len-a - 715 idx <- negate - 716 idx <- subtract 1 - 717 var result/eax: (addr grapheme) <- index data, idx - 718 return *result - 719 } - 720 # error - 721 abort "gap-index: out of bounds" - 722 return 0 - 723 } - 724 - 725 fn test-gap-buffers-equal? { - 726 var _a: gap-buffer - 727 var a/esi: (addr gap-buffer) <- address _a - 728 initialize-gap-buffer-with a, "abc" - 729 var _b: gap-buffer - 730 var b/edi: (addr gap-buffer) <- address _b - 731 initialize-gap-buffer-with b, "abc" - 732 var _c: gap-buffer - 733 var c/ebx: (addr gap-buffer) <- address _c - 734 initialize-gap-buffer-with c, "ab" - 735 var _d: gap-buffer - 736 var d/edx: (addr gap-buffer) <- address _d - 737 initialize-gap-buffer-with d, "abd" - 738 # - 739 var result/eax: boolean <- gap-buffers-equal? a, a - 740 check result, "F - test-gap-buffers-equal? - reflexive" - 741 result <- gap-buffers-equal? a, b - 742 check result, "F - test-gap-buffers-equal? - equal" - 743 # length not equal - 744 result <- gap-buffers-equal? a, c - 745 check-not result, "F - test-gap-buffers-equal? - not equal" - 746 # contents not equal - 747 result <- gap-buffers-equal? a, d - 748 check-not result, "F - test-gap-buffers-equal? - not equal 2" - 749 result <- gap-buffers-equal? d, a - 750 check-not result, "F - test-gap-buffers-equal? - not equal 3" - 751 } - 752 - 753 fn test-gap-buffer-index { - 754 var gap-storage: gap-buffer - 755 var gap/esi: (addr gap-buffer) <- address gap-storage - 756 initialize-gap-buffer-with gap, "abc" - 757 # gap is at end, all contents are in left - 758 var g/eax: grapheme <- gap-index gap, 0 - 759 var x/ecx: int <- copy g - 760 check-ints-equal x, 0x61/a, "F - test-gap-index/left-1" - 761 var g/eax: grapheme <- gap-index gap, 1 + 398 var fg/edi: int <- copy color + 399 var bg/ebx: int <- copy background-color + 400 compare render-cursor?, 0/false + 401 { + 402 break-if-= + 403 # if the right side is empty, grapheme stack didn't print the cursor + 404 var empty?/eax: boolean <- grapheme-stack-empty? right + 405 compare empty?, 0/false + 406 break-if-= + 407 # swap foreground and background + 408 fg <- copy background-color + 409 bg <- copy color + 410 } + 411 # print a grapheme either way so that cursor position doesn't affect printed width + 412 var space/edx: grapheme <- copy 0x20 + 413 x2, y2 <- render-grapheme screen, space, xmin, ymin, xmax, ymax, x2, y2, fg, bg + 414 return x2, y2 + 415 } + 416 + 417 fn render-gap-buffer screen: (addr screen), gap: (addr gap-buffer), x: int, y: int, render-cursor?: boolean, color: int, background-color: int -> _/eax: int { + 418 var _width/eax: int <- copy 0 + 419 var _height/ecx: int <- copy 0 + 420 _width, _height <- screen-size screen + 421 var width/edx: int <- copy _width + 422 var height/ebx: int <- copy _height + 423 var x2/eax: int <- copy 0 + 424 var y2/ecx: int <- copy 0 + 425 x2, y2 <- render-gap-buffer-wrapping-right-then-down screen, gap, x, y, width, height, render-cursor?, color, background-color + 426 return x2 # y2? yolo + 427 } + 428 + 429 fn gap-buffer-length _gap: (addr gap-buffer) -> _/eax: int { + 430 var gap/esi: (addr gap-buffer) <- copy _gap + 431 var left/eax: (addr grapheme-stack) <- get gap, left + 432 var tmp/eax: (addr int) <- get left, top + 433 var left-length/ecx: int <- copy *tmp + 434 var right/esi: (addr grapheme-stack) <- get gap, right + 435 tmp <- get right, top + 436 var result/eax: int <- copy *tmp + 437 result <- add left-length + 438 return result + 439 } + 440 + 441 fn add-grapheme-at-gap _self: (addr gap-buffer), g: grapheme { + 442 var self/esi: (addr gap-buffer) <- copy _self + 443 var left/eax: (addr grapheme-stack) <- get self, left + 444 push-grapheme-stack left, g + 445 } + 446 + 447 fn add-code-point-at-gap self: (addr gap-buffer), c: code-point { + 448 var g/eax: grapheme <- copy c + 449 add-grapheme-at-gap self, g + 450 } + 451 + 452 fn gap-to-start self: (addr gap-buffer) { + 453 { + 454 var curr/eax: grapheme <- gap-left self + 455 compare curr, -1 + 456 loop-if-!= + 457 } + 458 } + 459 + 460 fn gap-to-end self: (addr gap-buffer) { + 461 { + 462 var curr/eax: grapheme <- gap-right self + 463 compare curr, -1 + 464 loop-if-!= + 465 } + 466 } + 467 + 468 fn gap-at-start? _self: (addr gap-buffer) -> _/eax: boolean { + 469 var self/esi: (addr gap-buffer) <- copy _self + 470 var left/eax: (addr grapheme-stack) <- get self, left + 471 var result/eax: boolean <- grapheme-stack-empty? left + 472 return result + 473 } + 474 + 475 fn gap-at-end? _self: (addr gap-buffer) -> _/eax: boolean { + 476 var self/esi: (addr gap-buffer) <- copy _self + 477 var right/eax: (addr grapheme-stack) <- get self, right + 478 var result/eax: boolean <- grapheme-stack-empty? right + 479 return result + 480 } + 481 + 482 fn gap-right _self: (addr gap-buffer) -> _/eax: grapheme { + 483 var self/esi: (addr gap-buffer) <- copy _self + 484 var g/eax: grapheme <- copy 0 + 485 var right/ecx: (addr grapheme-stack) <- get self, right + 486 g <- pop-grapheme-stack right + 487 compare g, -1 + 488 { + 489 break-if-= + 490 var left/ecx: (addr grapheme-stack) <- get self, left + 491 push-grapheme-stack left, g + 492 } + 493 return g + 494 } + 495 + 496 fn gap-left _self: (addr gap-buffer) -> _/eax: grapheme { + 497 var self/esi: (addr gap-buffer) <- copy _self + 498 var g/eax: grapheme <- copy 0 + 499 { + 500 var left/ecx: (addr grapheme-stack) <- get self, left + 501 g <- pop-grapheme-stack left + 502 } + 503 compare g, -1 + 504 { + 505 break-if-= + 506 var right/ecx: (addr grapheme-stack) <- get self, right + 507 push-grapheme-stack right, g + 508 } + 509 return g + 510 } + 511 + 512 fn index-of-gap _self: (addr gap-buffer) -> _/eax: int { + 513 var self/eax: (addr gap-buffer) <- copy _self + 514 var left/eax: (addr grapheme-stack) <- get self, left + 515 var top-addr/eax: (addr int) <- get left, top + 516 var result/eax: int <- copy *top-addr + 517 return result + 518 } + 519 + 520 fn first-grapheme-in-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { + 521 var self/esi: (addr gap-buffer) <- copy _self + 522 # try to read from left + 523 var left/eax: (addr grapheme-stack) <- get self, left + 524 var top-addr/ecx: (addr int) <- get left, top + 525 compare *top-addr, 0 + 526 { + 527 break-if-<= + 528 var data-ah/eax: (addr handle array grapheme) <- get left, data + 529 var data/eax: (addr array grapheme) <- lookup *data-ah + 530 var result-addr/eax: (addr grapheme) <- index data, 0 + 531 return *result-addr + 532 } + 533 # try to read from right + 534 var right/eax: (addr grapheme-stack) <- get self, right + 535 top-addr <- get right, top + 536 compare *top-addr, 0 + 537 { + 538 break-if-<= + 539 var data-ah/eax: (addr handle array grapheme) <- get right, data + 540 var data/eax: (addr array grapheme) <- lookup *data-ah + 541 var top/ecx: int <- copy *top-addr + 542 top <- decrement + 543 var result-addr/eax: (addr grapheme) <- index data, top + 544 return *result-addr + 545 } + 546 # give up + 547 return -1 + 548 } + 549 + 550 fn grapheme-before-cursor-in-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { + 551 var self/esi: (addr gap-buffer) <- copy _self + 552 # try to read from left + 553 var left/ecx: (addr grapheme-stack) <- get self, left + 554 var top-addr/edx: (addr int) <- get left, top + 555 compare *top-addr, 0 + 556 { + 557 break-if-<= + 558 var result/eax: grapheme <- pop-grapheme-stack left + 559 push-grapheme-stack left, result + 560 return result + 561 } + 562 # give up + 563 return -1 + 564 } + 565 + 566 fn delete-before-gap _self: (addr gap-buffer) { + 567 var self/eax: (addr gap-buffer) <- copy _self + 568 var left/eax: (addr grapheme-stack) <- get self, left + 569 var dummy/eax: grapheme <- pop-grapheme-stack left + 570 } + 571 + 572 fn pop-after-gap _self: (addr gap-buffer) -> _/eax: grapheme { + 573 var self/eax: (addr gap-buffer) <- copy _self + 574 var right/eax: (addr grapheme-stack) <- get self, right + 575 var result/eax: grapheme <- pop-grapheme-stack right + 576 return result + 577 } + 578 + 579 fn gap-buffer-equal? _self: (addr gap-buffer), s: (addr array byte) -> _/eax: boolean { + 580 var self/esi: (addr gap-buffer) <- copy _self + 581 # complication: graphemes may be multiple bytes + 582 # so don't rely on length + 583 # instead turn the expected result into a stream and arrange to read from it in order + 584 var stream-storage: (stream byte 0x10/capacity) + 585 var expected-stream/ecx: (addr stream byte) <- address stream-storage + 586 write expected-stream, s + 587 # compare left + 588 var left/edx: (addr grapheme-stack) <- get self, left + 589 var result/eax: boolean <- prefix-match? left, expected-stream + 590 compare result, 0/false + 591 { + 592 break-if-!= + 593 return result + 594 } + 595 # compare right + 596 var right/edx: (addr grapheme-stack) <- get self, right + 597 result <- suffix-match? right, expected-stream + 598 compare result, 0/false + 599 { + 600 break-if-!= + 601 return result + 602 } + 603 # ensure there's nothing left over + 604 result <- stream-empty? expected-stream + 605 return result + 606 } + 607 + 608 fn test-gap-buffer-equal-from-end { + 609 var _g: gap-buffer + 610 var g/esi: (addr gap-buffer) <- address _g + 611 initialize-gap-buffer g, 0x10 + 612 # + 613 add-code-point-at-gap g, 0x61/a + 614 add-code-point-at-gap g, 0x61/a + 615 add-code-point-at-gap g, 0x61/a + 616 # gap is at end (right is empty) + 617 var result/eax: boolean <- gap-buffer-equal? g, "aaa" + 618 check result, "F - test-gap-buffer-equal-from-end" + 619 } + 620 + 621 fn test-gap-buffer-equal-from-middle { + 622 var _g: gap-buffer + 623 var g/esi: (addr gap-buffer) <- address _g + 624 initialize-gap-buffer g, 0x10 + 625 # + 626 add-code-point-at-gap g, 0x61/a + 627 add-code-point-at-gap g, 0x61/a + 628 add-code-point-at-gap g, 0x61/a + 629 var dummy/eax: grapheme <- gap-left g + 630 # gap is in the middle + 631 var result/eax: boolean <- gap-buffer-equal? g, "aaa" + 632 check result, "F - test-gap-buffer-equal-from-middle" + 633 } + 634 + 635 fn test-gap-buffer-equal-from-start { + 636 var _g: gap-buffer + 637 var g/esi: (addr gap-buffer) <- address _g + 638 initialize-gap-buffer g, 0x10 + 639 # + 640 add-code-point-at-gap g, 0x61/a + 641 add-code-point-at-gap g, 0x61/a + 642 add-code-point-at-gap g, 0x61/a + 643 var dummy/eax: grapheme <- gap-left g + 644 dummy <- gap-left g + 645 dummy <- gap-left g + 646 # gap is at the start + 647 var result/eax: boolean <- gap-buffer-equal? g, "aaa" + 648 check result, "F - test-gap-buffer-equal-from-start" + 649 } + 650 + 651 fn test-gap-buffer-equal-fails { + 652 # g = "aaa" + 653 var _g: gap-buffer + 654 var g/esi: (addr gap-buffer) <- address _g + 655 initialize-gap-buffer g, 0x10 + 656 add-code-point-at-gap g, 0x61/a + 657 add-code-point-at-gap g, 0x61/a + 658 add-code-point-at-gap g, 0x61/a + 659 # + 660 var result/eax: boolean <- gap-buffer-equal? g, "aa" + 661 check-not result, "F - test-gap-buffer-equal-fails" + 662 } + 663 + 664 fn gap-buffers-equal? self: (addr gap-buffer), g: (addr gap-buffer) -> _/eax: boolean { + 665 var tmp/eax: int <- gap-buffer-length self + 666 var len/ecx: int <- copy tmp + 667 var leng/eax: int <- gap-buffer-length g + 668 compare len, leng + 669 { + 670 break-if-= + 671 return 0/false + 672 } + 673 var i/edx: int <- copy 0 + 674 { + 675 compare i, len + 676 break-if->= + 677 { + 678 var tmp/eax: grapheme <- gap-index self, i + 679 var curr/ecx: grapheme <- copy tmp + 680 var currg/eax: grapheme <- gap-index g, i + 681 compare curr, currg + 682 break-if-= + 683 return 0/false + 684 } + 685 i <- increment + 686 loop + 687 } + 688 return 1/true + 689 } + 690 + 691 fn gap-index _self: (addr gap-buffer), _n: int -> _/eax: grapheme { + 692 var self/esi: (addr gap-buffer) <- copy _self + 693 var n/ebx: int <- copy _n + 694 # if n < left->length, index into left + 695 var left/edi: (addr grapheme-stack) <- get self, left + 696 var left-len-a/edx: (addr int) <- get left, top + 697 compare n, *left-len-a + 698 { + 699 break-if->= + 700 var data-ah/eax: (addr handle array grapheme) <- get left, data + 701 var data/eax: (addr array grapheme) <- lookup *data-ah + 702 var result/eax: (addr grapheme) <- index data, n + 703 return *result + 704 } + 705 # shrink n + 706 n <- subtract *left-len-a + 707 # if n < right->length, index into right + 708 var right/edi: (addr grapheme-stack) <- get self, right + 709 var right-len-a/edx: (addr int) <- get right, top + 710 compare n, *right-len-a + 711 { + 712 break-if->= + 713 var data-ah/eax: (addr handle array grapheme) <- get right, data + 714 var data/eax: (addr array grapheme) <- lookup *data-ah + 715 # idx = right->len - n - 1 + 716 var idx/ebx: int <- copy n + 717 idx <- subtract *right-len-a + 718 idx <- negate + 719 idx <- subtract 1 + 720 var result/eax: (addr grapheme) <- index data, idx + 721 return *result + 722 } + 723 # error + 724 abort "gap-index: out of bounds" + 725 return 0 + 726 } + 727 + 728 fn test-gap-buffers-equal? { + 729 var _a: gap-buffer + 730 var a/esi: (addr gap-buffer) <- address _a + 731 initialize-gap-buffer-with a, "abc" + 732 var _b: gap-buffer + 733 var b/edi: (addr gap-buffer) <- address _b + 734 initialize-gap-buffer-with b, "abc" + 735 var _c: gap-buffer + 736 var c/ebx: (addr gap-buffer) <- address _c + 737 initialize-gap-buffer-with c, "ab" + 738 var _d: gap-buffer + 739 var d/edx: (addr gap-buffer) <- address _d + 740 initialize-gap-buffer-with d, "abd" + 741 # + 742 var result/eax: boolean <- gap-buffers-equal? a, a + 743 check result, "F - test-gap-buffers-equal? - reflexive" + 744 result <- gap-buffers-equal? a, b + 745 check result, "F - test-gap-buffers-equal? - equal" + 746 # length not equal + 747 result <- gap-buffers-equal? a, c + 748 check-not result, "F - test-gap-buffers-equal? - not equal" + 749 # contents not equal + 750 result <- gap-buffers-equal? a, d + 751 check-not result, "F - test-gap-buffers-equal? - not equal 2" + 752 result <- gap-buffers-equal? d, a + 753 check-not result, "F - test-gap-buffers-equal? - not equal 3" + 754 } + 755 + 756 fn test-gap-buffer-index { + 757 var gap-storage: gap-buffer + 758 var gap/esi: (addr gap-buffer) <- address gap-storage + 759 initialize-gap-buffer-with gap, "abc" + 760 # gap is at end, all contents are in left + 761 var g/eax: grapheme <- gap-index gap, 0 762 var x/ecx: int <- copy g - 763 check-ints-equal x, 0x62/b, "F - test-gap-index/left-2" - 764 var g/eax: grapheme <- gap-index gap, 2 + 763 check-ints-equal x, 0x61/a, "F - test-gap-index/left-1" + 764 var g/eax: grapheme <- gap-index gap, 1 765 var x/ecx: int <- copy g - 766 check-ints-equal x, 0x63/c, "F - test-gap-index/left-3" - 767 # now check when everything is to the right - 768 gap-to-start gap - 769 rewind-gap-buffer gap - 770 var g/eax: grapheme <- gap-index gap, 0 - 771 var x/ecx: int <- copy g - 772 check-ints-equal x, 0x61/a, "F - test-gap-index/right-1" - 773 var g/eax: grapheme <- gap-index gap, 1 + 766 check-ints-equal x, 0x62/b, "F - test-gap-index/left-2" + 767 var g/eax: grapheme <- gap-index gap, 2 + 768 var x/ecx: int <- copy g + 769 check-ints-equal x, 0x63/c, "F - test-gap-index/left-3" + 770 # now check when everything is to the right + 771 gap-to-start gap + 772 rewind-gap-buffer gap + 773 var g/eax: grapheme <- gap-index gap, 0 774 var x/ecx: int <- copy g - 775 check-ints-equal x, 0x62/b, "F - test-gap-index/right-2" - 776 var g/eax: grapheme <- gap-index gap, 2 + 775 check-ints-equal x, 0x61/a, "F - test-gap-index/right-1" + 776 var g/eax: grapheme <- gap-index gap, 1 777 var x/ecx: int <- copy g - 778 check-ints-equal x, 0x63/c, "F - test-gap-index/right-3" - 779 } - 780 - 781 fn copy-gap-buffer _src-ah: (addr handle gap-buffer), _dest-ah: (addr handle gap-buffer) { - 782 # obtain src-a, dest-a - 783 var src-ah/eax: (addr handle gap-buffer) <- copy _src-ah - 784 var _src-a/eax: (addr gap-buffer) <- lookup *src-ah - 785 var src-a/esi: (addr gap-buffer) <- copy _src-a - 786 var dest-ah/eax: (addr handle gap-buffer) <- copy _dest-ah - 787 var _dest-a/eax: (addr gap-buffer) <- lookup *dest-ah - 788 var dest-a/edi: (addr gap-buffer) <- copy _dest-a - 789 # copy left grapheme-stack - 790 var src/ecx: (addr grapheme-stack) <- get src-a, left - 791 var dest/edx: (addr grapheme-stack) <- get dest-a, left - 792 copy-grapheme-stack src, dest - 793 # copy right grapheme-stack - 794 src <- get src-a, right - 795 dest <- get dest-a, right - 796 copy-grapheme-stack src, dest - 797 } - 798 - 799 fn gap-buffer-is-decimal-integer? _self: (addr gap-buffer) -> _/eax: boolean { - 800 var self/esi: (addr gap-buffer) <- copy _self - 801 var curr/ecx: (addr grapheme-stack) <- get self, left - 802 var result/eax: boolean <- grapheme-stack-is-decimal-integer? curr - 803 { - 804 compare result, 0/false - 805 break-if-= - 806 curr <- get self, right - 807 result <- grapheme-stack-is-decimal-integer? curr - 808 } - 809 return result - 810 } - 811 - 812 fn test-render-gap-buffer-without-cursor { - 813 # setup - 814 var gap-storage: gap-buffer - 815 var gap/esi: (addr gap-buffer) <- address gap-storage - 816 initialize-gap-buffer-with gap, "abc" - 817 # setup: screen - 818 var screen-on-stack: screen - 819 var screen/edi: (addr screen) <- address screen-on-stack - 820 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 821 # - 822 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 0/no-cursor, 3/fg, 0xc5/bg=blue-bg - 823 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-without-cursor" - 824 check-ints-equal x, 4, "F - test-render-gap-buffer-without-cursor: result" - 825 # abc - 826 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-render-gap-buffer-without-cursor: bg" - 827 } - 828 - 829 fn test-render-gap-buffer-with-cursor-at-end { - 830 # setup - 831 var gap-storage: gap-buffer - 832 var gap/esi: (addr gap-buffer) <- address gap-storage - 833 initialize-gap-buffer-with gap, "abc" - 834 gap-to-end gap - 835 # setup: screen - 836 var screen-on-stack: screen - 837 var screen/edi: (addr screen) <- address screen-on-stack - 838 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 839 # - 840 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg - 841 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-at-end" - 842 # we've drawn one extra grapheme for the cursor - 843 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-at-end: result" - 844 # abc - 845 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " |", "F - test-render-gap-buffer-with-cursor-at-end: bg" - 846 } - 847 - 848 fn test-render-gap-buffer-with-cursor-in-middle { - 849 # setup - 850 var gap-storage: gap-buffer - 851 var gap/esi: (addr gap-buffer) <- address gap-storage - 852 initialize-gap-buffer-with gap, "abc" - 853 gap-to-end gap - 854 var dummy/eax: grapheme <- gap-left gap - 855 # setup: screen - 856 var screen-on-stack: screen - 857 var screen/edi: (addr screen) <- address screen-on-stack - 858 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 859 # - 860 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg - 861 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-in-middle" - 862 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-in-middle: result" - 863 # abc - 864 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-render-gap-buffer-with-cursor-in-middle: bg" - 865 } - 866 - 867 fn test-render-gap-buffer-with-cursor-at-start { - 868 var gap-storage: gap-buffer - 869 var gap/esi: (addr gap-buffer) <- address gap-storage - 870 initialize-gap-buffer-with gap, "abc" - 871 gap-to-start gap - 872 # setup: screen - 873 var screen-on-stack: screen - 874 var screen/edi: (addr screen) <- address screen-on-stack - 875 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 876 # - 877 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg - 878 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-at-start" - 879 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-at-start: result" - 880 # abc - 881 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "| ", "F - test-render-gap-buffer-with-cursor-at-start: bg" - 882 } - 883 - 884 fn test-render-gap-buffer-highlight-matching-close-paren { - 885 var gap-storage: gap-buffer - 886 var gap/esi: (addr gap-buffer) <- address gap-storage - 887 initialize-gap-buffer-with gap, "(a)" - 888 gap-to-start gap - 889 # setup: screen - 890 var screen-on-stack: screen - 891 var screen/edi: (addr screen) <- address screen-on-stack - 892 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 893 # - 894 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg - 895 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-close-paren" - 896 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-close-paren: result" - 897 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "| ", "F - test-render-gap-buffer-highlight-matching-close-paren: cursor" - 898 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, " ) ", "F - test-render-gap-buffer-highlight-matching-close-paren: matching paren" - 899 } - 900 - 901 fn test-render-gap-buffer-highlight-matching-open-paren { - 902 var gap-storage: gap-buffer - 903 var gap/esi: (addr gap-buffer) <- address gap-storage - 904 initialize-gap-buffer-with gap, "(a)" - 905 gap-to-end gap - 906 var dummy/eax: grapheme <- gap-left gap - 907 # setup: screen - 908 var screen-on-stack: screen - 909 var screen/edi: (addr screen) <- address screen-on-stack - 910 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 911 # - 912 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg - 913 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-open-paren" - 914 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-open-paren: result" - 915 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-render-gap-buffer-highlight-matching-open-paren: cursor" - 916 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, "( ", "F - test-render-gap-buffer-highlight-matching-open-paren: matching paren" - 917 } - 918 - 919 fn test-render-gap-buffer-highlight-matching-open-paren-of-end { - 920 var gap-storage: gap-buffer - 921 var gap/esi: (addr gap-buffer) <- address gap-storage - 922 initialize-gap-buffer-with gap, "(a)" - 923 gap-to-end gap - 924 # setup: screen - 925 var screen-on-stack: screen - 926 var screen/edi: (addr screen) <- address screen-on-stack - 927 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 928 # - 929 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg - 930 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end" - 931 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: result" - 932 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " |", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: cursor" - 933 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, "( ", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: matching paren" - 934 } - 935 - 936 # should I highlight a matching open paren? And if so, at what depth from top of left? - 937 # basically there are two cases to disambiguate here: - 938 # Usually the cursor is at top of right. Highlight first '(' at depth 0 from top of left. - 939 # If right is empty, match the ')' _before_ cursor. Highlight first '(' at depth _1_ from top of left. - 940 fn highlight-matching-open-paren? _gap: (addr gap-buffer), render-cursor?: boolean -> _/ebx: boolean, _/edi: int { - 941 # if not rendering cursor, return - 942 compare render-cursor?, 0/false - 943 { - 944 break-if-!= - 945 return 0/false, 0 - 946 } - 947 var gap/esi: (addr gap-buffer) <- copy _gap - 948 var stack/edi: (addr grapheme-stack) <- get gap, right - 949 var top-addr/eax: (addr int) <- get stack, top - 950 var top-index/ecx: int <- copy *top-addr - 951 compare top-index, 0 - 952 { - 953 break-if-> - 954 # if cursor at end, return (char before cursor == ')', 1) - 955 stack <- get gap, left - 956 top-addr <- get stack, top - 957 top-index <- copy *top-addr - 958 compare top-index, 0 - 959 { - 960 break-if-> - 961 return 0/false, 0 - 962 } - 963 top-index <- decrement - 964 var data-ah/eax: (addr handle array grapheme) <- get stack, data - 965 var data/eax: (addr array grapheme) <- lookup *data-ah - 966 var g/eax: (addr grapheme) <- index data, top-index - 967 compare *g, 0x29/close-paren - 968 { - 969 break-if-= - 970 return 0/false, 0 - 971 } - 972 return 1/true, 1 - 973 } - 974 # cursor is not at end; return (char at cursor == ')') - 975 top-index <- decrement - 976 var data-ah/eax: (addr handle array grapheme) <- get stack, data - 977 var data/eax: (addr array grapheme) <- lookup *data-ah - 978 var g/eax: (addr grapheme) <- index data, top-index - 979 compare *g, 0x29/close-paren - 980 { - 981 break-if-= - 982 return 0/false, 0 - 983 } - 984 return 1/true, 0 - 985 } - 986 - 987 fn test-highlight-matching-open-paren { - 988 var gap-storage: gap-buffer - 989 var gap/esi: (addr gap-buffer) <- address gap-storage - 990 initialize-gap-buffer-with gap, "(a)" - 991 gap-to-end gap - 992 var highlight-matching-open-paren?/ebx: boolean <- copy 0/false - 993 var open-paren-depth/edi: int <- copy 0 - 994 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 0/no-cursor - 995 check-not highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: no cursor" - 996 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor - 997 check highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: at end immediately after ')'" - 998 check-ints-equal open-paren-depth, 1, "F - test-highlight-matching-open-paren: depth at end immediately after ')'" - 999 var dummy/eax: grapheme <- gap-left gap -1000 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor -1001 check highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: on ')'" -1002 dummy <- gap-left gap -1003 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor -1004 check-not highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: not on ')'" -1005 } -1006 -1007 ## some primitives for scanning through a gap buffer -1008 # don't modify the gap buffer while scanning -1009 # this includes moving the cursor around -1010 -1011 # restart scan without affecting gap-buffer contents -1012 fn rewind-gap-buffer _self: (addr gap-buffer) { -1013 var self/esi: (addr gap-buffer) <- copy _self -1014 var dest/eax: (addr int) <- get self, left-read-index -1015 copy-to *dest, 0 -1016 dest <- get self, right-read-index -1017 copy-to *dest, 0 -1018 } -1019 -1020 fn gap-buffer-scan-done? _self: (addr gap-buffer) -> _/eax: boolean { -1021 var self/esi: (addr gap-buffer) <- copy _self -1022 # more in left? -1023 var left/eax: (addr grapheme-stack) <- get self, left -1024 var left-size/eax: int <- grapheme-stack-length left -1025 var left-read-index/ecx: (addr int) <- get self, left-read-index -1026 compare *left-read-index, left-size -1027 { -1028 break-if->= -1029 return 0/false -1030 } -1031 # more in right? -1032 var right/eax: (addr grapheme-stack) <- get self, right -1033 var right-size/eax: int <- grapheme-stack-length right -1034 var right-read-index/ecx: (addr int) <- get self, right-read-index -1035 compare *right-read-index, right-size -1036 { -1037 break-if->= -1038 return 0/false -1039 } -1040 # -1041 return 1/true -1042 } -1043 -1044 fn peek-from-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { -1045 var self/esi: (addr gap-buffer) <- copy _self -1046 # more in left? -1047 var left/ecx: (addr grapheme-stack) <- get self, left -1048 var left-size/eax: int <- grapheme-stack-length left -1049 var left-read-index-a/edx: (addr int) <- get self, left-read-index -1050 compare *left-read-index-a, left-size -1051 { -1052 break-if->= -1053 var left-data-ah/eax: (addr handle array grapheme) <- get left, data -1054 var left-data/eax: (addr array grapheme) <- lookup *left-data-ah -1055 var left-read-index/ecx: int <- copy *left-read-index-a -1056 var result/eax: (addr grapheme) <- index left-data, left-read-index -1057 return *result -1058 } -1059 # more in right? -1060 var right/ecx: (addr grapheme-stack) <- get self, right -1061 var _right-size/eax: int <- grapheme-stack-length right -1062 var right-size/ebx: int <- copy _right-size -1063 var right-read-index-a/edx: (addr int) <- get self, right-read-index -1064 compare *right-read-index-a, right-size -1065 { -1066 break-if->= -1067 # read the right from reverse -1068 var right-data-ah/eax: (addr handle array grapheme) <- get right, data -1069 var right-data/eax: (addr array grapheme) <- lookup *right-data-ah -1070 var right-read-index/ebx: int <- copy right-size -1071 right-read-index <- subtract *right-read-index-a -1072 right-read-index <- subtract 1 -1073 var result/eax: (addr grapheme) <- index right-data, right-read-index -1074 return *result -1075 } -1076 # if we get here there's nothing left -1077 return 0/nul -1078 } -1079 -1080 fn read-from-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { -1081 var self/esi: (addr gap-buffer) <- copy _self -1082 # more in left? -1083 var left/ecx: (addr grapheme-stack) <- get self, left -1084 var left-size/eax: int <- grapheme-stack-length left -1085 var left-read-index-a/edx: (addr int) <- get self, left-read-index -1086 compare *left-read-index-a, left-size -1087 { -1088 break-if->= -1089 var left-data-ah/eax: (addr handle array grapheme) <- get left, data -1090 var left-data/eax: (addr array grapheme) <- lookup *left-data-ah -1091 var left-read-index/ecx: int <- copy *left-read-index-a -1092 var result/eax: (addr grapheme) <- index left-data, left-read-index -1093 increment *left-read-index-a -1094 return *result -1095 } -1096 # more in right? -1097 var right/ecx: (addr grapheme-stack) <- get self, right -1098 var _right-size/eax: int <- grapheme-stack-length right -1099 var right-size/ebx: int <- copy _right-size -1100 var right-read-index-a/edx: (addr int) <- get self, right-read-index -1101 compare *right-read-index-a, right-size -1102 { -1103 break-if->= -1104 # read the right from reverse -1105 var right-data-ah/eax: (addr handle array grapheme) <- get right, data -1106 var right-data/eax: (addr array grapheme) <- lookup *right-data-ah -1107 var right-read-index/ebx: int <- copy right-size -1108 right-read-index <- subtract *right-read-index-a -1109 right-read-index <- subtract 1 -1110 var result/eax: (addr grapheme) <- index right-data, right-read-index -1111 increment *right-read-index-a -1112 return *result -1113 } -1114 # if we get here there's nothing left -1115 return 0/nul -1116 } -1117 -1118 fn test-read-from-gap-buffer { -1119 var gap-storage: gap-buffer -1120 var gap/esi: (addr gap-buffer) <- address gap-storage -1121 initialize-gap-buffer-with gap, "abc" -1122 # gap is at end, all contents are in left -1123 var done?/eax: boolean <- gap-buffer-scan-done? gap -1124 check-not done?, "F - test-read-from-gap-buffer/left-1/done" -1125 var g/eax: grapheme <- read-from-gap-buffer gap -1126 var x/ecx: int <- copy g -1127 check-ints-equal x, 0x61/a, "F - test-read-from-gap-buffer/left-1" -1128 var done?/eax: boolean <- gap-buffer-scan-done? gap -1129 check-not done?, "F - test-read-from-gap-buffer/left-2/done" -1130 var g/eax: grapheme <- read-from-gap-buffer gap -1131 var x/ecx: int <- copy g -1132 check-ints-equal x, 0x62/b, "F - test-read-from-gap-buffer/left-2" -1133 var done?/eax: boolean <- gap-buffer-scan-done? gap -1134 check-not done?, "F - test-read-from-gap-buffer/left-3/done" -1135 var g/eax: grapheme <- read-from-gap-buffer gap -1136 var x/ecx: int <- copy g -1137 check-ints-equal x, 0x63/c, "F - test-read-from-gap-buffer/left-3" -1138 var done?/eax: boolean <- gap-buffer-scan-done? gap -1139 check done?, "F - test-read-from-gap-buffer/left-4/done" -1140 var g/eax: grapheme <- read-from-gap-buffer gap -1141 var x/ecx: int <- copy g -1142 check-ints-equal x, 0/nul, "F - test-read-from-gap-buffer/left-4" -1143 # now check when everything is to the right -1144 gap-to-start gap -1145 rewind-gap-buffer gap -1146 var done?/eax: boolean <- gap-buffer-scan-done? gap -1147 check-not done?, "F - test-read-from-gap-buffer/right-1/done" -1148 var g/eax: grapheme <- read-from-gap-buffer gap -1149 var x/ecx: int <- copy g -1150 check-ints-equal x, 0x61/a, "F - test-read-from-gap-buffer/right-1" -1151 var done?/eax: boolean <- gap-buffer-scan-done? gap -1152 check-not done?, "F - test-read-from-gap-buffer/right-2/done" -1153 var g/eax: grapheme <- read-from-gap-buffer gap -1154 var x/ecx: int <- copy g -1155 check-ints-equal x, 0x62/b, "F - test-read-from-gap-buffer/right-2" -1156 var done?/eax: boolean <- gap-buffer-scan-done? gap -1157 check-not done?, "F - test-read-from-gap-buffer/right-3/done" -1158 var g/eax: grapheme <- read-from-gap-buffer gap -1159 var x/ecx: int <- copy g -1160 check-ints-equal x, 0x63/c, "F - test-read-from-gap-buffer/right-3" -1161 var done?/eax: boolean <- gap-buffer-scan-done? gap -1162 check done?, "F - test-read-from-gap-buffer/right-4/done" -1163 var g/eax: grapheme <- read-from-gap-buffer gap -1164 var x/ecx: int <- copy g -1165 check-ints-equal x, 0/nul, "F - test-read-from-gap-buffer/right-4" -1166 } -1167 -1168 fn skip-whitespace-from-gap-buffer self: (addr gap-buffer) { -1169 var done?/eax: boolean <- gap-buffer-scan-done? self -1170 compare done?, 0/false -1171 break-if-!= -1172 var g/eax: grapheme <- peek-from-gap-buffer self -1173 { -1174 compare g, 0x20/space -1175 break-if-= -1176 compare g, 0xa/newline -1177 break-if-= -1178 return -1179 } -1180 g <- read-from-gap-buffer self -1181 loop -1182 } -1183 -1184 fn edit-gap-buffer self: (addr gap-buffer), key: grapheme { -1185 var g/edx: grapheme <- copy key -1186 { -1187 compare g, 8/backspace -1188 break-if-!= -1189 delete-before-gap self -1190 return -1191 } -1192 { -1193 compare g, 0x80/left-arrow -1194 break-if-!= -1195 var dummy/eax: grapheme <- gap-left self -1196 return -1197 } -1198 { -1199 compare g, 0x83/right-arrow -1200 break-if-!= -1201 var dummy/eax: grapheme <- gap-right self -1202 return -1203 } -1204 { -1205 compare g, 6/ctrl-f -1206 break-if-!= -1207 gap-to-start-of-next-word self -1208 return -1209 } -1210 { -1211 compare g, 2/ctrl-b -1212 break-if-!= -1213 gap-to-end-of-previous-word self -1214 return -1215 } -1216 { -1217 compare g, 1/ctrl-a -1218 break-if-!= -1219 gap-to-previous-start-of-line self -1220 return -1221 } -1222 { -1223 compare g, 5/ctrl-e -1224 break-if-!= -1225 gap-to-next-end-of-line self -1226 return -1227 } -1228 { -1229 compare g, 0x81/down-arrow -1230 break-if-!= -1231 gap-down self -1232 return -1233 } -1234 { -1235 compare g, 0x82/up-arrow -1236 break-if-!= -1237 gap-up self -1238 return -1239 } -1240 { -1241 compare g, 0x15/ctrl-u -1242 break-if-!= -1243 clear-gap-buffer self -1244 return -1245 } -1246 { -1247 compare g, 9/tab -1248 break-if-!= -1249 # tab = 2 spaces -1250 add-code-point-at-gap self, 0x20/space -1251 add-code-point-at-gap self, 0x20/space -1252 return -1253 } -1254 # default: insert character -1255 add-grapheme-at-gap self, g -1256 } -1257 -1258 fn gap-to-start-of-next-word self: (addr gap-buffer) { -1259 var curr/eax: grapheme <- copy 0 -1260 # skip to next space -1261 { -1262 curr <- gap-right self -1263 compare curr, -1 -1264 break-if-= -1265 compare curr, 0x20/space -1266 break-if-= -1267 compare curr, 0xa/newline -1268 break-if-= -1269 loop -1270 } -1271 # skip past spaces -1272 { -1273 curr <- gap-right self -1274 compare curr, -1 -1275 break-if-= -1276 compare curr, 0x20/space -1277 loop-if-= -1278 compare curr, 0xa/space -1279 loop-if-= -1280 curr <- gap-left self -1281 break -1282 } -1283 } -1284 -1285 fn gap-to-end-of-previous-word self: (addr gap-buffer) { -1286 var curr/eax: grapheme <- copy 0 -1287 # skip to previous space -1288 { -1289 curr <- gap-left self -1290 compare curr, -1 -1291 break-if-= -1292 compare curr, 0x20/space -1293 break-if-= -1294 compare curr, 0xa/newline -1295 break-if-= -1296 loop -1297 } -1298 # skip past all spaces but one -1299 { -1300 curr <- gap-left self -1301 compare curr, -1 -1302 break-if-= -1303 compare curr, 0x20/space -1304 loop-if-= -1305 compare curr, 0xa/space -1306 loop-if-= -1307 curr <- gap-right self -1308 break -1309 } -1310 } -1311 -1312 fn gap-to-previous-start-of-line self: (addr gap-buffer) { -1313 # skip past immediate newline -1314 var dummy/eax: grapheme <- gap-left self -1315 # skip to previous newline -1316 { -1317 dummy <- gap-left self -1318 { -1319 compare dummy, -1 -1320 break-if-!= -1321 return -1322 } -1323 { -1324 compare dummy, 0xa/newline -1325 break-if-!= -1326 dummy <- gap-right self -1327 return -1328 } -1329 loop -1330 } -1331 } -1332 -1333 fn gap-to-next-end-of-line self: (addr gap-buffer) { -1334 # skip past immediate newline -1335 var dummy/eax: grapheme <- gap-right self -1336 # skip to next newline -1337 { -1338 dummy <- gap-right self -1339 { -1340 compare dummy, -1 -1341 break-if-!= -1342 return -1343 } -1344 { -1345 compare dummy, 0xa/newline -1346 break-if-!= -1347 dummy <- gap-left self -1348 return -1349 } -1350 loop -1351 } -1352 } -1353 -1354 fn gap-up self: (addr gap-buffer) { -1355 # compute column -1356 var col/edx: int <- count-columns-to-start-of-line self -1357 # -1358 gap-to-previous-start-of-line self -1359 # skip ahead by up to col on previous line -1360 var i/ecx: int <- copy 0 -1361 { -1362 compare i, col -1363 break-if->= -1364 var curr/eax: grapheme <- gap-right self -1365 { -1366 compare curr, -1 -1367 break-if-!= -1368 return -1369 } -1370 compare curr, 0xa/newline -1371 { -1372 break-if-!= -1373 curr <- gap-left self -1374 return -1375 } -1376 i <- increment -1377 loop -1378 } -1379 } -1380 -1381 fn gap-down self: (addr gap-buffer) { -1382 # compute column -1383 var col/edx: int <- count-columns-to-start-of-line self -1384 # skip to start of next line -1385 gap-to-end-of-line self -1386 var dummy/eax: grapheme <- gap-right self -1387 # skip ahead by up to col on previous line -1388 var i/ecx: int <- copy 0 -1389 { -1390 compare i, col -1391 break-if->= -1392 var curr/eax: grapheme <- gap-right self + 778 check-ints-equal x, 0x62/b, "F - test-gap-index/right-2" + 779 var g/eax: grapheme <- gap-index gap, 2 + 780 var x/ecx: int <- copy g + 781 check-ints-equal x, 0x63/c, "F - test-gap-index/right-3" + 782 } + 783 + 784 fn copy-gap-buffer _src-ah: (addr handle gap-buffer), _dest-ah: (addr handle gap-buffer) { + 785 # obtain src-a, dest-a + 786 var src-ah/eax: (addr handle gap-buffer) <- copy _src-ah + 787 var _src-a/eax: (addr gap-buffer) <- lookup *src-ah + 788 var src-a/esi: (addr gap-buffer) <- copy _src-a + 789 var dest-ah/eax: (addr handle gap-buffer) <- copy _dest-ah + 790 var _dest-a/eax: (addr gap-buffer) <- lookup *dest-ah + 791 var dest-a/edi: (addr gap-buffer) <- copy _dest-a + 792 # copy left grapheme-stack + 793 var src/ecx: (addr grapheme-stack) <- get src-a, left + 794 var dest/edx: (addr grapheme-stack) <- get dest-a, left + 795 copy-grapheme-stack src, dest + 796 # copy right grapheme-stack + 797 src <- get src-a, right + 798 dest <- get dest-a, right + 799 copy-grapheme-stack src, dest + 800 } + 801 + 802 fn gap-buffer-is-decimal-integer? _self: (addr gap-buffer) -> _/eax: boolean { + 803 var self/esi: (addr gap-buffer) <- copy _self + 804 var curr/ecx: (addr grapheme-stack) <- get self, left + 805 var result/eax: boolean <- grapheme-stack-is-decimal-integer? curr + 806 { + 807 compare result, 0/false + 808 break-if-= + 809 curr <- get self, right + 810 result <- grapheme-stack-is-decimal-integer? curr + 811 } + 812 return result + 813 } + 814 + 815 fn test-render-gap-buffer-without-cursor { + 816 # setup + 817 var gap-storage: gap-buffer + 818 var gap/esi: (addr gap-buffer) <- address gap-storage + 819 initialize-gap-buffer-with gap, "abc" + 820 # setup: screen + 821 var screen-on-stack: screen + 822 var screen/edi: (addr screen) <- address screen-on-stack + 823 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 824 # + 825 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 0/no-cursor, 3/fg, 0xc5/bg=blue-bg + 826 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-without-cursor" + 827 check-ints-equal x, 4, "F - test-render-gap-buffer-without-cursor: result" + 828 # abc + 829 check-background-color-in-screen-row screen, 3/bg=reverse, 0/y, " ", "F - test-render-gap-buffer-without-cursor: bg" + 830 } + 831 + 832 fn test-render-gap-buffer-with-cursor-at-end { + 833 # setup + 834 var gap-storage: gap-buffer + 835 var gap/esi: (addr gap-buffer) <- address gap-storage + 836 initialize-gap-buffer-with gap, "abc" + 837 gap-to-end gap + 838 # setup: screen + 839 var screen-on-stack: screen + 840 var screen/edi: (addr screen) <- address screen-on-stack + 841 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 842 # + 843 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg + 844 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-at-end" + 845 # we've drawn one extra grapheme for the cursor + 846 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-at-end: result" + 847 # abc + 848 check-background-color-in-screen-row screen, 3/bg=reverse, 0/y, " |", "F - test-render-gap-buffer-with-cursor-at-end: bg" + 849 } + 850 + 851 fn test-render-gap-buffer-with-cursor-in-middle { + 852 # setup + 853 var gap-storage: gap-buffer + 854 var gap/esi: (addr gap-buffer) <- address gap-storage + 855 initialize-gap-buffer-with gap, "abc" + 856 gap-to-end gap + 857 var dummy/eax: grapheme <- gap-left gap + 858 # setup: screen + 859 var screen-on-stack: screen + 860 var screen/edi: (addr screen) <- address screen-on-stack + 861 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 862 # + 863 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg + 864 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-in-middle" + 865 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-in-middle: result" + 866 # abc + 867 check-background-color-in-screen-row screen, 3/bg=reverse, 0/y, " | ", "F - test-render-gap-buffer-with-cursor-in-middle: bg" + 868 } + 869 + 870 fn test-render-gap-buffer-with-cursor-at-start { + 871 var gap-storage: gap-buffer + 872 var gap/esi: (addr gap-buffer) <- address gap-storage + 873 initialize-gap-buffer-with gap, "abc" + 874 gap-to-start gap + 875 # setup: screen + 876 var screen-on-stack: screen + 877 var screen/edi: (addr screen) <- address screen-on-stack + 878 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 879 # + 880 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg + 881 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-at-start" + 882 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-at-start: result" + 883 # abc + 884 check-background-color-in-screen-row screen, 3/bg=reverse, 0/y, "| ", "F - test-render-gap-buffer-with-cursor-at-start: bg" + 885 } + 886 + 887 fn test-render-gap-buffer-highlight-matching-close-paren { + 888 var gap-storage: gap-buffer + 889 var gap/esi: (addr gap-buffer) <- address gap-storage + 890 initialize-gap-buffer-with gap, "(a)" + 891 gap-to-start gap + 892 # setup: screen + 893 var screen-on-stack: screen + 894 var screen/edi: (addr screen) <- address screen-on-stack + 895 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 896 # + 897 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg + 898 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-close-paren" + 899 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-close-paren: result" + 900 check-background-color-in-screen-row screen, 3/bg=reverse, 0/y, "| ", "F - test-render-gap-buffer-highlight-matching-close-paren: cursor" + 901 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, " ) ", "F - test-render-gap-buffer-highlight-matching-close-paren: matching paren" + 902 } + 903 + 904 fn test-render-gap-buffer-highlight-matching-open-paren { + 905 var gap-storage: gap-buffer + 906 var gap/esi: (addr gap-buffer) <- address gap-storage + 907 initialize-gap-buffer-with gap, "(a)" + 908 gap-to-end gap + 909 var dummy/eax: grapheme <- gap-left gap + 910 # setup: screen + 911 var screen-on-stack: screen + 912 var screen/edi: (addr screen) <- address screen-on-stack + 913 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 914 # + 915 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg + 916 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-open-paren" + 917 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-open-paren: result" + 918 check-background-color-in-screen-row screen, 3/bg=reverse, 0/y, " | ", "F - test-render-gap-buffer-highlight-matching-open-paren: cursor" + 919 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, "( ", "F - test-render-gap-buffer-highlight-matching-open-paren: matching paren" + 920 } + 921 + 922 fn test-render-gap-buffer-highlight-matching-open-paren-of-end { + 923 var gap-storage: gap-buffer + 924 var gap/esi: (addr gap-buffer) <- address gap-storage + 925 initialize-gap-buffer-with gap, "(a)" + 926 gap-to-end gap + 927 # setup: screen + 928 var screen-on-stack: screen + 929 var screen/edi: (addr screen) <- address screen-on-stack + 930 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 931 # + 932 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg + 933 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end" + 934 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: result" + 935 check-background-color-in-screen-row screen, 3/bg=reverse, 0/y, " |", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: cursor" + 936 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, "( ", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: matching paren" + 937 } + 938 + 939 # should I highlight a matching open paren? And if so, at what depth from top of left? + 940 # basically there are two cases to disambiguate here: + 941 # Usually the cursor is at top of right. Highlight first '(' at depth 0 from top of left. + 942 # If right is empty, match the ')' _before_ cursor. Highlight first '(' at depth _1_ from top of left. + 943 fn highlight-matching-open-paren? _gap: (addr gap-buffer), render-cursor?: boolean -> _/ebx: boolean, _/edi: int { + 944 # if not rendering cursor, return + 945 compare render-cursor?, 0/false + 946 { + 947 break-if-!= + 948 return 0/false, 0 + 949 } + 950 var gap/esi: (addr gap-buffer) <- copy _gap + 951 var stack/edi: (addr grapheme-stack) <- get gap, right + 952 var top-addr/eax: (addr int) <- get stack, top + 953 var top-index/ecx: int <- copy *top-addr + 954 compare top-index, 0 + 955 { + 956 break-if-> + 957 # if cursor at end, return (char before cursor == ')', 1) + 958 stack <- get gap, left + 959 top-addr <- get stack, top + 960 top-index <- copy *top-addr + 961 compare top-index, 0 + 962 { + 963 break-if-> + 964 return 0/false, 0 + 965 } + 966 top-index <- decrement + 967 var data-ah/eax: (addr handle array grapheme) <- get stack, data + 968 var data/eax: (addr array grapheme) <- lookup *data-ah + 969 var g/eax: (addr grapheme) <- index data, top-index + 970 compare *g, 0x29/close-paren + 971 { + 972 break-if-= + 973 return 0/false, 0 + 974 } + 975 return 1/true, 1 + 976 } + 977 # cursor is not at end; return (char at cursor == ')') + 978 top-index <- decrement + 979 var data-ah/eax: (addr handle array grapheme) <- get stack, data + 980 var data/eax: (addr array grapheme) <- lookup *data-ah + 981 var g/eax: (addr grapheme) <- index data, top-index + 982 compare *g, 0x29/close-paren + 983 { + 984 break-if-= + 985 return 0/false, 0 + 986 } + 987 return 1/true, 0 + 988 } + 989 + 990 fn test-highlight-matching-open-paren { + 991 var gap-storage: gap-buffer + 992 var gap/esi: (addr gap-buffer) <- address gap-storage + 993 initialize-gap-buffer-with gap, "(a)" + 994 gap-to-end gap + 995 var highlight-matching-open-paren?/ebx: boolean <- copy 0/false + 996 var open-paren-depth/edi: int <- copy 0 + 997 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 0/no-cursor + 998 check-not highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: no cursor" + 999 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor +1000 check highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: at end immediately after ')'" +1001 check-ints-equal open-paren-depth, 1, "F - test-highlight-matching-open-paren: depth at end immediately after ')'" +1002 var dummy/eax: grapheme <- gap-left gap +1003 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor +1004 check highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: on ')'" +1005 dummy <- gap-left gap +1006 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor +1007 check-not highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: not on ')'" +1008 } +1009 +1010 ## some primitives for scanning through a gap buffer +1011 # don't modify the gap buffer while scanning +1012 # this includes moving the cursor around +1013 +1014 # restart scan without affecting gap-buffer contents +1015 fn rewind-gap-buffer _self: (addr gap-buffer) { +1016 var self/esi: (addr gap-buffer) <- copy _self +1017 var dest/eax: (addr int) <- get self, left-read-index +1018 copy-to *dest, 0 +1019 dest <- get self, right-read-index +1020 copy-to *dest, 0 +1021 } +1022 +1023 fn gap-buffer-scan-done? _self: (addr gap-buffer) -> _/eax: boolean { +1024 var self/esi: (addr gap-buffer) <- copy _self +1025 # more in left? +1026 var left/eax: (addr grapheme-stack) <- get self, left +1027 var left-size/eax: int <- grapheme-stack-length left +1028 var left-read-index/ecx: (addr int) <- get self, left-read-index +1029 compare *left-read-index, left-size +1030 { +1031 break-if->= +1032 return 0/false +1033 } +1034 # more in right? +1035 var right/eax: (addr grapheme-stack) <- get self, right +1036 var right-size/eax: int <- grapheme-stack-length right +1037 var right-read-index/ecx: (addr int) <- get self, right-read-index +1038 compare *right-read-index, right-size +1039 { +1040 break-if->= +1041 return 0/false +1042 } +1043 # +1044 return 1/true +1045 } +1046 +1047 fn peek-from-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { +1048 var self/esi: (addr gap-buffer) <- copy _self +1049 # more in left? +1050 var left/ecx: (addr grapheme-stack) <- get self, left +1051 var left-size/eax: int <- grapheme-stack-length left +1052 var left-read-index-a/edx: (addr int) <- get self, left-read-index +1053 compare *left-read-index-a, left-size +1054 { +1055 break-if->= +1056 var left-data-ah/eax: (addr handle array grapheme) <- get left, data +1057 var left-data/eax: (addr array grapheme) <- lookup *left-data-ah +1058 var left-read-index/ecx: int <- copy *left-read-index-a +1059 var result/eax: (addr grapheme) <- index left-data, left-read-index +1060 return *result +1061 } +1062 # more in right? +1063 var right/ecx: (addr grapheme-stack) <- get self, right +1064 var _right-size/eax: int <- grapheme-stack-length right +1065 var right-size/ebx: int <- copy _right-size +1066 var right-read-index-a/edx: (addr int) <- get self, right-read-index +1067 compare *right-read-index-a, right-size +1068 { +1069 break-if->= +1070 # read the right from reverse +1071 var right-data-ah/eax: (addr handle array grapheme) <- get right, data +1072 var right-data/eax: (addr array grapheme) <- lookup *right-data-ah +1073 var right-read-index/ebx: int <- copy right-size +1074 right-read-index <- subtract *right-read-index-a +1075 right-read-index <- subtract 1 +1076 var result/eax: (addr grapheme) <- index right-data, right-read-index +1077 return *result +1078 } +1079 # if we get here there's nothing left +1080 return 0/nul +1081 } +1082 +1083 fn read-from-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { +1084 var self/esi: (addr gap-buffer) <- copy _self +1085 # more in left? +1086 var left/ecx: (addr grapheme-stack) <- get self, left +1087 var left-size/eax: int <- grapheme-stack-length left +1088 var left-read-index-a/edx: (addr int) <- get self, left-read-index +1089 compare *left-read-index-a, left-size +1090 { +1091 break-if->= +1092 var left-data-ah/eax: (addr handle array grapheme) <- get left, data +1093 var left-data/eax: (addr array grapheme) <- lookup *left-data-ah +1094 var left-read-index/ecx: int <- copy *left-read-index-a +1095 var result/eax: (addr grapheme) <- index left-data, left-read-index +1096 increment *left-read-index-a +1097 return *result +1098 } +1099 # more in right? +1100 var right/ecx: (addr grapheme-stack) <- get self, right +1101 var _right-size/eax: int <- grapheme-stack-length right +1102 var right-size/ebx: int <- copy _right-size +1103 var right-read-index-a/edx: (addr int) <- get self, right-read-index +1104 compare *right-read-index-a, right-size +1105 { +1106 break-if->= +1107 # read the right from reverse +1108 var right-data-ah/eax: (addr handle array grapheme) <- get right, data +1109 var right-data/eax: (addr array grapheme) <- lookup *right-data-ah +1110 var right-read-index/ebx: int <- copy right-size +1111 right-read-index <- subtract *right-read-index-a +1112 right-read-index <- subtract 1 +1113 var result/eax: (addr grapheme) <- index right-data, right-read-index +1114 increment *right-read-index-a +1115 return *result +1116 } +1117 # if we get here there's nothing left +1118 return 0/nul +1119 } +1120 +1121 fn put-back-from-gap-buffer _self: (addr gap-buffer) { +1122 var self/esi: (addr gap-buffer) <- copy _self +1123 # more in right? +1124 var right/eax: (addr grapheme-stack) <- get self, right +1125 var right-size/eax: int <- grapheme-stack-length right +1126 var right-read-index-a/eax: (addr int) <- get self, right-read-index +1127 compare *right-read-index-a, 0 +1128 { +1129 break-if-<= +1130 decrement *right-read-index-a +1131 return +1132 } +1133 # more in left? +1134 var left/eax: (addr grapheme-stack) <- get self, left +1135 var left-size/eax: int <- grapheme-stack-length left +1136 var left-read-index-a/eax: (addr int) <- get self, left-read-index +1137 decrement *left-read-index-a +1138 } +1139 +1140 fn test-read-from-gap-buffer { +1141 var gap-storage: gap-buffer +1142 var gap/esi: (addr gap-buffer) <- address gap-storage +1143 initialize-gap-buffer-with gap, "abc" +1144 # gap is at end, all contents are in left +1145 var done?/eax: boolean <- gap-buffer-scan-done? gap +1146 check-not done?, "F - test-read-from-gap-buffer/left-1/done" +1147 var g/eax: grapheme <- read-from-gap-buffer gap +1148 var x/ecx: int <- copy g +1149 check-ints-equal x, 0x61/a, "F - test-read-from-gap-buffer/left-1" +1150 var done?/eax: boolean <- gap-buffer-scan-done? gap +1151 check-not done?, "F - test-read-from-gap-buffer/left-2/done" +1152 var g/eax: grapheme <- read-from-gap-buffer gap +1153 var x/ecx: int <- copy g +1154 check-ints-equal x, 0x62/b, "F - test-read-from-gap-buffer/left-2" +1155 var done?/eax: boolean <- gap-buffer-scan-done? gap +1156 check-not done?, "F - test-read-from-gap-buffer/left-3/done" +1157 var g/eax: grapheme <- read-from-gap-buffer gap +1158 var x/ecx: int <- copy g +1159 check-ints-equal x, 0x63/c, "F - test-read-from-gap-buffer/left-3" +1160 var done?/eax: boolean <- gap-buffer-scan-done? gap +1161 check done?, "F - test-read-from-gap-buffer/left-4/done" +1162 var g/eax: grapheme <- read-from-gap-buffer gap +1163 var x/ecx: int <- copy g +1164 check-ints-equal x, 0/nul, "F - test-read-from-gap-buffer/left-4" +1165 # now check when everything is to the right +1166 gap-to-start gap +1167 rewind-gap-buffer gap +1168 var done?/eax: boolean <- gap-buffer-scan-done? gap +1169 check-not done?, "F - test-read-from-gap-buffer/right-1/done" +1170 var g/eax: grapheme <- read-from-gap-buffer gap +1171 var x/ecx: int <- copy g +1172 check-ints-equal x, 0x61/a, "F - test-read-from-gap-buffer/right-1" +1173 var done?/eax: boolean <- gap-buffer-scan-done? gap +1174 check-not done?, "F - test-read-from-gap-buffer/right-2/done" +1175 var g/eax: grapheme <- read-from-gap-buffer gap +1176 var x/ecx: int <- copy g +1177 check-ints-equal x, 0x62/b, "F - test-read-from-gap-buffer/right-2" +1178 var done?/eax: boolean <- gap-buffer-scan-done? gap +1179 check-not done?, "F - test-read-from-gap-buffer/right-3/done" +1180 var g/eax: grapheme <- read-from-gap-buffer gap +1181 var x/ecx: int <- copy g +1182 check-ints-equal x, 0x63/c, "F - test-read-from-gap-buffer/right-3" +1183 var done?/eax: boolean <- gap-buffer-scan-done? gap +1184 check done?, "F - test-read-from-gap-buffer/right-4/done" +1185 var g/eax: grapheme <- read-from-gap-buffer gap +1186 var x/ecx: int <- copy g +1187 check-ints-equal x, 0/nul, "F - test-read-from-gap-buffer/right-4" +1188 } +1189 +1190 fn skip-whitespace-from-gap-buffer self: (addr gap-buffer) { +1191 var done?/eax: boolean <- gap-buffer-scan-done? self +1192 compare done?, 0/false +1193 break-if-!= +1194 var g/eax: grapheme <- peek-from-gap-buffer self +1195 { +1196 compare g, 0x20/space +1197 break-if-= +1198 compare g, 0xa/newline +1199 break-if-= +1200 return +1201 } +1202 g <- read-from-gap-buffer self +1203 loop +1204 } +1205 +1206 fn edit-gap-buffer self: (addr gap-buffer), key: grapheme { +1207 var g/edx: grapheme <- copy key +1208 { +1209 compare g, 8/backspace +1210 break-if-!= +1211 delete-before-gap self +1212 return +1213 } +1214 { +1215 compare g, 0x80/left-arrow +1216 break-if-!= +1217 var dummy/eax: grapheme <- gap-left self +1218 return +1219 } +1220 { +1221 compare g, 0x83/right-arrow +1222 break-if-!= +1223 var dummy/eax: grapheme <- gap-right self +1224 return +1225 } +1226 { +1227 compare g, 6/ctrl-f +1228 break-if-!= +1229 gap-to-start-of-next-word self +1230 return +1231 } +1232 { +1233 compare g, 2/ctrl-b +1234 break-if-!= +1235 gap-to-end-of-previous-word self +1236 return +1237 } +1238 { +1239 compare g, 1/ctrl-a +1240 break-if-!= +1241 gap-to-previous-start-of-line self +1242 return +1243 } +1244 { +1245 compare g, 5/ctrl-e +1246 break-if-!= +1247 gap-to-next-end-of-line self +1248 return +1249 } +1250 { +1251 compare g, 0x81/down-arrow +1252 break-if-!= +1253 gap-down self +1254 return +1255 } +1256 { +1257 compare g, 0x82/up-arrow +1258 break-if-!= +1259 gap-up self +1260 return +1261 } +1262 { +1263 compare g, 0x15/ctrl-u +1264 break-if-!= +1265 clear-gap-buffer self +1266 return +1267 } +1268 { +1269 compare g, 9/tab +1270 break-if-!= +1271 # tab = 2 spaces +1272 add-code-point-at-gap self, 0x20/space +1273 add-code-point-at-gap self, 0x20/space +1274 return +1275 } +1276 # default: insert character +1277 add-grapheme-at-gap self, g +1278 } +1279 +1280 fn gap-to-start-of-next-word self: (addr gap-buffer) { +1281 var curr/eax: grapheme <- copy 0 +1282 # skip to next space +1283 { +1284 curr <- gap-right self +1285 compare curr, -1 +1286 break-if-= +1287 compare curr, 0x20/space +1288 break-if-= +1289 compare curr, 0xa/newline +1290 break-if-= +1291 loop +1292 } +1293 # skip past spaces +1294 { +1295 curr <- gap-right self +1296 compare curr, -1 +1297 break-if-= +1298 compare curr, 0x20/space +1299 loop-if-= +1300 compare curr, 0xa/space +1301 loop-if-= +1302 curr <- gap-left self +1303 break +1304 } +1305 } +1306 +1307 fn gap-to-end-of-previous-word self: (addr gap-buffer) { +1308 var curr/eax: grapheme <- copy 0 +1309 # skip to previous space +1310 { +1311 curr <- gap-left self +1312 compare curr, -1 +1313 break-if-= +1314 compare curr, 0x20/space +1315 break-if-= +1316 compare curr, 0xa/newline +1317 break-if-= +1318 loop +1319 } +1320 # skip past all spaces but one +1321 { +1322 curr <- gap-left self +1323 compare curr, -1 +1324 break-if-= +1325 compare curr, 0x20/space +1326 loop-if-= +1327 compare curr, 0xa/space +1328 loop-if-= +1329 curr <- gap-right self +1330 break +1331 } +1332 } +1333 +1334 fn gap-to-previous-start-of-line self: (addr gap-buffer) { +1335 # skip past immediate newline +1336 var dummy/eax: grapheme <- gap-left self +1337 # skip to previous newline +1338 { +1339 dummy <- gap-left self +1340 { +1341 compare dummy, -1 +1342 break-if-!= +1343 return +1344 } +1345 { +1346 compare dummy, 0xa/newline +1347 break-if-!= +1348 dummy <- gap-right self +1349 return +1350 } +1351 loop +1352 } +1353 } +1354 +1355 fn gap-to-next-end-of-line self: (addr gap-buffer) { +1356 # skip past immediate newline +1357 var dummy/eax: grapheme <- gap-right self +1358 # skip to next newline +1359 { +1360 dummy <- gap-right self +1361 { +1362 compare dummy, -1 +1363 break-if-!= +1364 return +1365 } +1366 { +1367 compare dummy, 0xa/newline +1368 break-if-!= +1369 dummy <- gap-left self +1370 return +1371 } +1372 loop +1373 } +1374 } +1375 +1376 fn gap-up self: (addr gap-buffer) { +1377 # compute column +1378 var col/edx: int <- count-columns-to-start-of-line self +1379 # +1380 gap-to-previous-start-of-line self +1381 # skip ahead by up to col on previous line +1382 var i/ecx: int <- copy 0 +1383 { +1384 compare i, col +1385 break-if->= +1386 var curr/eax: grapheme <- gap-right self +1387 { +1388 compare curr, -1 +1389 break-if-!= +1390 return +1391 } +1392 compare curr, 0xa/newline 1393 { -1394 compare curr, -1 -1395 break-if-!= +1394 break-if-!= +1395 curr <- gap-left self 1396 return 1397 } -1398 compare curr, 0xa/newline -1399 { -1400 break-if-!= -1401 curr <- gap-left self -1402 return -1403 } -1404 i <- increment -1405 loop -1406 } -1407 } -1408 -1409 fn count-columns-to-start-of-line self: (addr gap-buffer) -> _/edx: int { -1410 var count/edx: int <- copy 0 -1411 var dummy/eax: grapheme <- copy 0 -1412 # skip to previous newline -1413 { -1414 dummy <- gap-left self +1398 i <- increment +1399 loop +1400 } +1401 } +1402 +1403 fn gap-down self: (addr gap-buffer) { +1404 # compute column +1405 var col/edx: int <- count-columns-to-start-of-line self +1406 # skip to start of next line +1407 gap-to-end-of-line self +1408 var dummy/eax: grapheme <- gap-right self +1409 # skip ahead by up to col on previous line +1410 var i/ecx: int <- copy 0 +1411 { +1412 compare i, col +1413 break-if->= +1414 var curr/eax: grapheme <- gap-right self 1415 { -1416 compare dummy, -1 +1416 compare curr, -1 1417 break-if-!= -1418 return count +1418 return 1419 } -1420 { -1421 compare dummy, 0xa/newline +1420 compare curr, 0xa/newline +1421 { 1422 break-if-!= -1423 dummy <- gap-right self -1424 return count +1423 curr <- gap-left self +1424 return 1425 } -1426 count <- increment +1426 i <- increment 1427 loop 1428 } -1429 return count -1430 } -1431 -1432 fn gap-to-end-of-line self: (addr gap-buffer) { +1429 } +1430 +1431 fn count-columns-to-start-of-line self: (addr gap-buffer) -> _/edx: int { +1432 var count/edx: int <- copy 0 1433 var dummy/eax: grapheme <- copy 0 -1434 # skip to next newline +1434 # skip to previous newline 1435 { -1436 dummy <- gap-right self +1436 dummy <- gap-left self 1437 { 1438 compare dummy, -1 1439 break-if-!= -1440 return +1440 return count 1441 } 1442 { 1443 compare dummy, 0xa/newline 1444 break-if-!= -1445 dummy <- gap-left self -1446 return +1445 dummy <- gap-right self +1446 return count 1447 } -1448 loop -1449 } -1450 } +1448 count <- increment +1449 loop +1450 } +1451 return count +1452 } +1453 +1454 fn gap-to-end-of-line self: (addr gap-buffer) { +1455 var dummy/eax: grapheme <- copy 0 +1456 # skip to next newline +1457 { +1458 dummy <- gap-right self +1459 { +1460 compare dummy, -1 +1461 break-if-!= +1462 return +1463 } +1464 { +1465 compare dummy, 0xa/newline +1466 break-if-!= +1467 dummy <- gap-left self +1468 return +1469 } +1470 loop +1471 } +1472 } diff --git a/html/shell/global.mu.html b/html/shell/global.mu.html index e1472c81..01cdd2cc 100644 --- a/html/shell/global.mu.html +++ b/html/shell/global.mu.html @@ -14,20 +14,19 @@ pre { white-space: pre-wrap; font-family: monospace; color: #000000; background- body { font-size:12pt; font-family: monospace; color: #000000; background-color: #a8a8a8; } a { color:inherit; } * { font-size:12pt; font-size: 1em; } +.PreProc { color: #c000c0; } +.muRegEcx { color: #af875f; } .LineNr { } -.Delimiter { color: #c000c0; } -.muFunction { color: #af5f00; text-decoration: underline; } -.muRegEbx { color: #8787af; } -.muRegEsi { color: #87d787; } .muRegEdi { color: #87ffd7; } +.muRegEbx { color: #8787af; } +.muRegEdx { color: #878700; } .Constant { color: #008787; } -.Special { color: #ff6060; } -.PreProc { color: #c000c0; } -.CommentedCode { color: #8a8a8a; } -.muComment { color: #005faf; } +.muRegEsi { color: #87d787; } .muRegEax { color: #875f00; } -.muRegEcx { color: #af875f; } -.muRegEdx { color: #878700; } +.Delimiter { color: #c000c0; } +.muFunction { color: #af5f00; text-decoration: underline; } +.muComment { color: #005faf; } +.Special { color: #ff6060; } --> @@ -73,31 +72,31 @@ if ('onhashchange' in window) { 8 name: (handle array byte) 9 input: (handle gap-buffer) 10 value: (handle cell) - 11 } - 12 - 13 fn initialize-globals _self: (addr global-table) { - 14 var self/esi: (addr global-table) <- copy _self - 15 compare self, 0 - 16 { - 17 break-if-!= - 18 abort "initialize globals" - 19 return - 20 } - 21 var data-ah/eax: (addr handle array global) <- get self, data - 22 populate data-ah, 0x40 - 23 initialize-primitives self - 24 } - 25 - 26 fn load-globals in: (addr handle cell), self: (addr global-table) { - 27 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading globals:", 3/fg, 0/bg - 28 var remaining-ah/esi: (addr handle cell) <- copy in - 29 { - 30 var _remaining/eax: (addr cell) <- lookup *remaining-ah - 31 var remaining/ebx: (addr cell) <- copy _remaining - 32 var done?/eax: boolean <- nil? remaining - 33 compare done?, 0/false - 34 break-if-!= - 35 #? draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "b", 2/fg 0/bg + 11 trace: (handle trace) + 12 } + 13 + 14 fn initialize-globals _self: (addr global-table) { + 15 var self/esi: (addr global-table) <- copy _self + 16 compare self, 0 + 17 { + 18 break-if-!= + 19 abort "initialize globals" + 20 return + 21 } + 22 var data-ah/eax: (addr handle array global) <- get self, data + 23 populate data-ah, 0x80 + 24 initialize-primitives self + 25 } + 26 + 27 fn load-globals in: (addr handle cell), self: (addr global-table) { + 28 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading globals:", 3/fg, 0/bg + 29 var remaining-ah/esi: (addr handle cell) <- copy in + 30 { + 31 var _remaining/eax: (addr cell) <- lookup *remaining-ah + 32 var remaining/ebx: (addr cell) <- copy _remaining + 33 var done?/eax: boolean <- nil? remaining + 34 compare done?, 0/false + 35 break-if-!= 36 var curr-ah/eax: (addr handle cell) <- get remaining, left 37 var _curr/eax: (addr cell) <- lookup *curr-ah 38 var curr/ecx: (addr cell) <- copy _curr @@ -120,538 +119,529 @@ if ('onhashchange' in window) { 55 allocate value-gap-buffer-ah 56 var value-gap-buffer/eax: (addr gap-buffer) <- lookup *value-gap-buffer-ah 57 initialize-gap-buffer value-gap-buffer, 0x1000/4KB - 58 #? draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "w", 2/fg 0/bg - 59 load-gap-buffer-from-stream value-gap-buffer, value-data - 60 #? draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "x", 2/fg 0/bg - 61 read-evaluate-and-move-to-globals value-gap-buffer-ah, self, name-data - 62 #? draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "y", 2/fg 0/bg - 63 loop - 64 } - 65 move-cursor-to-left-margin-of-next-line 0/screen - 66 #? abort "zz" - 67 } - 68 - 69 fn write-globals out: (addr stream byte), _self: (addr global-table) { - 70 var self/esi: (addr global-table) <- copy _self - 71 compare self, 0 - 72 { - 73 break-if-!= - 74 abort "write globals" - 75 return - 76 } - 77 write out, " (globals . (\n" - 78 var data-ah/eax: (addr handle array global) <- get self, data - 79 var data/eax: (addr array global) <- lookup *data-ah - 80 var final-index/edx: (addr int) <- get self, final-index - 81 var curr-index/ecx: int <- copy 1/skip-0 - 82 { - 83 compare curr-index, *final-index - 84 break-if-> - 85 var curr-offset/ebx: (offset global) <- compute-offset data, curr-index - 86 var curr/ebx: (addr global) <- index data, curr-offset - 87 var curr-value-ah/edx: (addr handle cell) <- get curr, value - 88 var curr-value/eax: (addr cell) <- lookup *curr-value-ah - 89 var curr-type/eax: (addr int) <- get curr-value, type - 90 { - 91 compare *curr-type, 4/primitive-function + 58 load-gap-buffer-from-stream value-gap-buffer, value-data + 59 load-lexical-scope value-gap-buffer-ah, self + 60 loop + 61 } + 62 move-cursor-to-left-margin-of-next-line 0/screen + 63 } + 64 + 65 fn write-globals out: (addr stream byte), _self: (addr global-table) { + 66 var self/esi: (addr global-table) <- copy _self + 67 compare self, 0 + 68 { + 69 break-if-!= + 70 abort "write globals" + 71 return + 72 } + 73 write out, " (globals . (\n" + 74 var data-ah/eax: (addr handle array global) <- get self, data + 75 var data/eax: (addr array global) <- lookup *data-ah + 76 var final-index/edx: (addr int) <- get self, final-index + 77 var curr-index/ecx: int <- copy 1/skip-0 + 78 { + 79 compare curr-index, *final-index + 80 break-if-> + 81 var curr-offset/ebx: (offset global) <- compute-offset data, curr-index + 82 var curr/ebx: (addr global) <- index data, curr-offset + 83 var curr-value-ah/edx: (addr handle cell) <- get curr, value + 84 var curr-value/eax: (addr cell) <- lookup *curr-value-ah + 85 var curr-type/eax: (addr int) <- get curr-value, type + 86 { + 87 compare *curr-type, 4/primitive-function + 88 break-if-= + 89 compare *curr-type, 5/screen + 90 break-if-= + 91 compare *curr-type, 6/keyboard 92 break-if-= - 93 compare *curr-type, 5/screen + 93 compare *curr-type, 3/stream # not implemented yet 94 break-if-= - 95 compare *curr-type, 6/keyboard - 96 break-if-= - 97 compare *curr-type, 3/stream # not implemented yet - 98 break-if-= - 99 write out, " (" -100 var curr-name-ah/eax: (addr handle array byte) <- get curr, name -101 var curr-name/eax: (addr array byte) <- lookup *curr-name-ah -102 write out, curr-name -103 write out, " . [" -104 var curr-input-ah/eax: (addr handle gap-buffer) <- get curr, input -105 var curr-input/eax: (addr gap-buffer) <- lookup *curr-input-ah -106 append-gap-buffer curr-input, out -107 write out, "])\n" -108 } -109 curr-index <- increment -110 loop -111 } -112 write out, " ))\n" -113 } -114 -115 # globals layout: 1 char padding, 41 code, 1 padding, 41 code, 1 padding = 85 chars -116 fn render-globals screen: (addr screen), _self: (addr global-table), show-cursor?: boolean { -117 clear-rect screen, 0/xmin, 0/ymin, 0x55/xmax, 0x2f/ymax=screen-height-without-menu, 0xdc/bg=green-bg -118 var self/esi: (addr global-table) <- copy _self -119 compare self, 0 -120 { -121 break-if-!= -122 abort "render globals" -123 return -124 } -125 var data-ah/eax: (addr handle array global) <- get self, data -126 var data/eax: (addr array global) <- lookup *data-ah -127 var curr-index/edx: int <- copy 1 -128 { -129 var curr-offset/ebx: (offset global) <- compute-offset data, curr-index -130 var curr/ebx: (addr global) <- index data, curr-offset -131 var continue?/eax: boolean <- primitive-global? curr -132 compare continue?, 0/false -133 break-if-= -134 curr-index <- increment -135 loop -136 } -137 var lowest-index/edi: int <- copy curr-index -138 var cursor-index/edx: (addr int) <- get self, cursor-index -139 var curr-index/edx: int <- copy *cursor-index -140 var y1: int -141 copy-to y1, 1/padding-top -142 var y2: int -143 copy-to y2, 1/padding-top -144 $render-globals:loop: { -145 compare curr-index, lowest-index -146 break-if-< -147 { -148 compare y1, 0x2f/ymax -149 break-if-< -150 compare y2, 0x2f/ymax -151 break-if-< -152 break $render-globals:loop -153 } -154 { -155 var show-cursor?/edi: boolean <- copy show-cursor? -156 { -157 compare show-cursor?, 0/false -158 break-if-= -159 var cursor-index/eax: (addr int) <- get self, cursor-index -160 compare *cursor-index, curr-index -161 break-if-= -162 show-cursor? <- copy 0/false -163 } -164 var curr-offset/edx: (offset global) <- compute-offset data, curr-index -165 var curr/edx: (addr global) <- index data, curr-offset -166 var curr-input-ah/edx: (addr handle gap-buffer) <- get curr, input -167 var _curr-input/eax: (addr gap-buffer) <- lookup *curr-input-ah -168 var curr-input/ebx: (addr gap-buffer) <- copy _curr-input -169 compare curr-input, 0 -170 break-if-= -171 $render-globals:render-global: { -172 var x/eax: int <- copy 0 -173 var y/ecx: int <- copy y1 -174 compare y, y2 -175 { -176 break-if->= -177 x, y <- render-gap-buffer-wrapping-right-then-down screen, curr-input, 1/padding-left, y1, 0x2a/xmax, 0x2f/ymax, show-cursor?, 7/fg=definition, 0xc5/bg=blue-bg -178 y <- add 2 -179 copy-to y1, y -180 break $render-globals:render-global -181 } -182 x, y <- render-gap-buffer-wrapping-right-then-down screen, curr-input, 0x2b/xmin, y2, 0x54/xmax, 0x2f/ymax, show-cursor?, 7/fg=definition, 0xc5/bg=blue-bg -183 y <- add 2 -184 copy-to y2, y -185 } -186 } -187 curr-index <- decrement -188 loop -189 } -190 # render primitives on top -191 render-primitives screen, 1/xmin=padding-left, 0x55/xmax, 0x2f/ymax -192 } -193 -194 fn render-globals-menu screen: (addr screen), _self: (addr global-table) { -195 var _width/eax: int <- copy 0 -196 var height/ecx: int <- copy 0 -197 _width, height <- screen-size screen -198 var width/edx: int <- copy _width -199 var y/ecx: int <- copy height -200 y <- decrement -201 var height/ebx: int <- copy y -202 height <- increment -203 clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg -204 set-cursor-position screen, 0/x, y -205 draw-text-rightward-from-cursor screen, " ^r ", width, 0/fg, 0x5c/bg=menu-highlight -206 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0xc5/bg=blue-bg -207 draw-text-rightward-from-cursor screen, " ^s ", width, 0/fg, 0x5c/bg=menu-highlight -208 draw-text-rightward-from-cursor screen, " run sandbox ", width, 7/fg, 0xc5/bg=blue-bg -209 draw-text-rightward-from-cursor screen, " ^g ", width, 0/fg, 0x5c/bg=menu-highlight -210 draw-text-rightward-from-cursor screen, " go to ", width, 7/fg, 0xc5/bg=blue-bg -211 draw-text-rightward-from-cursor screen, " ^a ", width, 0/fg, 0x5c/bg=menu-highlight -212 draw-text-rightward-from-cursor screen, " << ", width, 7/fg, 0xc5/bg=blue-bg -213 draw-text-rightward-from-cursor screen, " ^b ", width, 0/fg, 0x5c/bg=menu-highlight -214 draw-text-rightward-from-cursor screen, " <word ", width, 7/fg, 0xc5/bg=blue-bg -215 draw-text-rightward-from-cursor screen, " ^f ", width, 0/fg, 0x5c/bg=menu-highlight -216 draw-text-rightward-from-cursor screen, " word> ", width, 7/fg, 0xc5/bg=blue-bg -217 draw-text-rightward-from-cursor screen, " ^e ", width, 0/fg, 0x5c/bg=menu-highlight -218 draw-text-rightward-from-cursor screen, " >> ", width, 7/fg, 0xc5/bg=blue-bg -219 } -220 -221 fn edit-globals _self: (addr global-table), key: grapheme { -222 var self/esi: (addr global-table) <- copy _self -223 # ctrl-s -224 { -225 compare key, 0x13/ctrl-s -226 break-if-!= -227 # -228 refresh-cursor-definition self -229 return -230 } -231 var cursor-index-addr/ecx: (addr int) <- get self, cursor-index -232 var cursor-index/ecx: int <- copy *cursor-index-addr -233 var data-ah/eax: (addr handle array global) <- get self, data -234 var data/eax: (addr array global) <- lookup *data-ah -235 var cursor-offset/ecx: (offset global) <- compute-offset data, cursor-index -236 var curr-global/eax: (addr global) <- index data, cursor-offset -237 var curr-editor-ah/eax: (addr handle gap-buffer) <- get curr-global, input -238 var curr-editor/eax: (addr gap-buffer) <- lookup *curr-editor-ah -239 edit-gap-buffer curr-editor, key -240 } -241 -242 fn refresh-cursor-definition _self: (addr global-table) { -243 var self/esi: (addr global-table) <- copy _self -244 var cursor-index/edx: (addr int) <- get self, cursor-index -245 refresh-definition self, *cursor-index -246 } -247 -248 fn refresh-definition _self: (addr global-table), _index: int { -249 var self/esi: (addr global-table) <- copy _self -250 var data-ah/eax: (addr handle array global) <- get self, data -251 var data/eax: (addr array global) <- lookup *data-ah -252 var index/ecx: int <- copy _index -253 var offset/ecx: (offset global) <- compute-offset data, index -254 var curr-global/ecx: (addr global) <- index data, offset -255 var curr-input-ah/eax: (addr handle gap-buffer) <- get curr-global, input -256 var curr-input/eax: (addr gap-buffer) <- lookup *curr-input-ah -257 var read-result-h: (handle cell) -258 var read-result-ah/edx: (addr handle cell) <- address read-result-h -259 var trace-storage: trace -260 var trace/ebx: (addr trace) <- address trace-storage -261 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -262 read-cell curr-input, read-result-ah, trace -263 macroexpand read-result-ah, self, trace -264 var nil-h: (handle cell) -265 { -266 var nil-ah/eax: (addr handle cell) <- address nil-h -267 allocate-pair nil-ah -268 } -269 var curr-value-ah/eax: (addr handle cell) <- get curr-global, value -270 debug-print "GL", 4/fg, 0/bg -271 evaluate read-result-ah, curr-value-ah, nil-h, self, trace, 0/no-screen-cell, 0/no-keyboard-cell, 1/call-number -272 debug-print "GZ", 4/fg, 0/bg -273 } -274 -275 fn assign-or-create-global _self: (addr global-table), name: (addr array byte), value: (handle cell), trace: (addr trace) { -276 var self/esi: (addr global-table) <- copy _self -277 compare self, 0 -278 { -279 break-if-!= -280 abort "assign global" -281 return -282 } -283 var curr-index/ecx: int <- find-symbol-name-in-globals self, name -284 { -285 compare curr-index, -1/not-found -286 break-if-!= -287 var final-index-addr/eax: (addr int) <- get self, final-index -288 increment *final-index-addr -289 curr-index <- copy *final-index-addr -290 var cursor-index-addr/eax: (addr int) <- get self, cursor-index -291 copy-to *cursor-index-addr, curr-index -292 } -293 var data-ah/eax: (addr handle array global) <- get self, data -294 var data/eax: (addr array global) <- lookup *data-ah -295 var curr-offset/esi: (offset global) <- compute-offset data, curr-index -296 var curr/esi: (addr global) <- index data, curr-offset -297 var curr-name-ah/eax: (addr handle array byte) <- get curr, name -298 copy-array-object name, curr-name-ah -299 var curr-value-ah/eax: (addr handle cell) <- get curr, value -300 copy-handle value, curr-value-ah -301 } -302 -303 fn lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { -304 var sym/eax: (addr cell) <- copy _sym -305 var sym-name-ah/eax: (addr handle stream byte) <- get sym, text-data -306 var _sym-name/eax: (addr stream byte) <- lookup *sym-name-ah -307 var sym-name/edx: (addr stream byte) <- copy _sym-name -308 var globals/esi: (addr global-table) <- copy _globals -309 { -310 compare globals, 0 -311 break-if-= -312 var curr-index/ecx: int <- find-symbol-in-globals globals, sym-name -313 compare curr-index, -1/not-found -314 break-if-= -315 var global-data-ah/eax: (addr handle array global) <- get globals, data -316 var global-data/eax: (addr array global) <- lookup *global-data-ah -317 var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index -318 var curr/ebx: (addr global) <- index global-data, curr-offset -319 var curr-value/eax: (addr handle cell) <- get curr, value -320 copy-object curr-value, out -321 return -322 } -323 # if sym is "screen" and screen-cell exists, return it -324 { -325 var sym-is-screen?/eax: boolean <- stream-data-equal? sym-name, "screen" -326 compare sym-is-screen?, 0/false -327 break-if-= -328 compare screen-cell, 0 -329 break-if-= -330 copy-object screen-cell, out -331 return -332 } -333 # if sym is "keyboard" and keyboard-cell exists, return it -334 { -335 var sym-is-keyboard?/eax: boolean <- stream-data-equal? sym-name, "keyboard" -336 compare sym-is-keyboard?, 0/false + 95 write out, " (" + 96 var curr-name-ah/eax: (addr handle array byte) <- get curr, name + 97 var curr-name/eax: (addr array byte) <- lookup *curr-name-ah + 98 write out, curr-name + 99 write out, " . [" +100 var curr-input-ah/eax: (addr handle gap-buffer) <- get curr, input +101 var curr-input/eax: (addr gap-buffer) <- lookup *curr-input-ah +102 { +103 compare curr-input, 0 +104 break-if-!= +105 abort "null gap buffer" +106 } +107 append-gap-buffer curr-input, out +108 write out, "])\n" +109 } +110 curr-index <- increment +111 loop +112 } +113 write out, " ))\n" +114 } +115 +116 # globals layout: 1 char padding, 41 code, 1 padding, 41 code, 1 padding = 85 chars +117 fn render-globals screen: (addr screen), _self: (addr global-table), show-cursor?: boolean { +118 clear-rect screen, 0/xmin, 0/ymin, 0x55/xmax, 0x2f/ymax=screen-height-without-menu, 0xdc/bg=green-bg +119 var self/esi: (addr global-table) <- copy _self +120 compare self, 0 +121 { +122 break-if-!= +123 abort "render globals" +124 return +125 } +126 var data-ah/eax: (addr handle array global) <- get self, data +127 var data/eax: (addr array global) <- lookup *data-ah +128 var curr-index/edx: int <- copy 1 +129 { +130 var curr-offset/ebx: (offset global) <- compute-offset data, curr-index +131 var curr/ebx: (addr global) <- index data, curr-offset +132 var continue?/eax: boolean <- primitive-global? curr +133 compare continue?, 0/false +134 break-if-= +135 curr-index <- increment +136 loop +137 } +138 var lowest-index/edi: int <- copy curr-index +139 var cursor-index/edx: (addr int) <- get self, cursor-index +140 var curr-index/edx: int <- copy *cursor-index +141 var y1: int +142 copy-to y1, 1/padding-top +143 var y2: int +144 copy-to y2, 1/padding-top +145 $render-globals:loop: { +146 compare curr-index, lowest-index +147 break-if-< +148 { +149 compare y1, 0x2f/ymax +150 break-if-< +151 compare y2, 0x2f/ymax +152 break-if-< +153 break $render-globals:loop +154 } +155 { +156 var cursor-in-current-line?: boolean +157 { +158 compare show-cursor?, 0/false +159 break-if-= +160 var cursor-index/eax: (addr int) <- get self, cursor-index +161 compare *cursor-index, curr-index +162 break-if-!= +163 copy-to cursor-in-current-line?, 1/true +164 } +165 var curr-offset/edx: (offset global) <- compute-offset data, curr-index +166 var curr/edx: (addr global) <- index data, curr-offset +167 var curr-input-ah/eax: (addr handle gap-buffer) <- get curr, input +168 var _curr-input/eax: (addr gap-buffer) <- lookup *curr-input-ah +169 var curr-input/ebx: (addr gap-buffer) <- copy _curr-input +170 compare curr-input, 0 +171 break-if-= +172 var curr-trace-ah/eax: (addr handle trace) <- get curr, trace +173 var _curr-trace/eax: (addr trace) <- lookup *curr-trace-ah +174 var curr-trace/edx: (addr trace) <- copy _curr-trace +175 $render-globals:render-global: { +176 var x/eax: int <- copy 0 +177 var y/ecx: int <- copy y1 +178 compare y, y2 +179 { +180 break-if->= +181 x, y <- render-gap-buffer-wrapping-right-then-down screen, curr-input, 1/padding-left, y1, 0x2a/xmax, 0x2f/ymax, cursor-in-current-line?, 7/fg=definition, 0xc5/bg=blue-bg +182 y <- increment +183 y <- render-trace screen, curr-trace, 1/padding-left, y, 0x2a/xmax, 0x2f/ymax, 0/no-cursor +184 y <- increment +185 copy-to y1, y +186 break $render-globals:render-global +187 } +188 x, y <- render-gap-buffer-wrapping-right-then-down screen, curr-input, 0x2b/xmin, y2, 0x54/xmax, 0x2f/ymax, cursor-in-current-line?, 7/fg=definition, 0xc5/bg=blue-bg +189 y <- increment +190 y <- render-trace screen, curr-trace, 0x2b/xmin, y, 0x54/xmax, 0x2f/ymax, 0/no-cursor +191 y <- increment +192 copy-to y2, y +193 } +194 } +195 curr-index <- decrement +196 loop +197 } +198 # render primitives on top +199 render-primitives screen, 1/xmin=padding-left, 0x55/xmax, 0x2f/ymax +200 } +201 +202 fn render-globals-menu screen: (addr screen), _self: (addr global-table) { +203 var _width/eax: int <- copy 0 +204 var height/ecx: int <- copy 0 +205 _width, height <- screen-size screen +206 var width/edx: int <- copy _width +207 var y/ecx: int <- copy height +208 y <- decrement +209 var height/ebx: int <- copy y +210 height <- increment +211 clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg +212 set-cursor-position screen, 0/x, y +213 draw-text-rightward-from-cursor screen, " ^r ", width, 0/fg, 0x5c/bg=menu-highlight +214 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0xc5/bg=blue-bg +215 draw-text-rightward-from-cursor screen, " ^s ", width, 0/fg, 0x5c/bg=menu-highlight +216 draw-text-rightward-from-cursor screen, " run sandbox ", width, 7/fg, 0xc5/bg=blue-bg +217 draw-text-rightward-from-cursor screen, " ^g ", width, 0/fg, 0x5c/bg=menu-highlight +218 draw-text-rightward-from-cursor screen, " go to ", width, 7/fg, 0xc5/bg=blue-bg +219 draw-text-rightward-from-cursor screen, " ^a ", width, 0/fg, 0x5c/bg=menu-highlight +220 draw-text-rightward-from-cursor screen, " << ", width, 7/fg, 0xc5/bg=blue-bg +221 draw-text-rightward-from-cursor screen, " ^b ", width, 0/fg, 0x5c/bg=menu-highlight +222 draw-text-rightward-from-cursor screen, " <word ", width, 7/fg, 0xc5/bg=blue-bg +223 draw-text-rightward-from-cursor screen, " ^f ", width, 0/fg, 0x5c/bg=menu-highlight +224 draw-text-rightward-from-cursor screen, " word> ", width, 7/fg, 0xc5/bg=blue-bg +225 draw-text-rightward-from-cursor screen, " ^e ", width, 0/fg, 0x5c/bg=menu-highlight +226 draw-text-rightward-from-cursor screen, " >> ", width, 7/fg, 0xc5/bg=blue-bg +227 } +228 +229 fn edit-globals _self: (addr global-table), key: grapheme { +230 var self/esi: (addr global-table) <- copy _self +231 # ctrl-s +232 { +233 compare key, 0x13/ctrl-s +234 break-if-!= +235 # +236 refresh-cursor-definition self +237 return +238 } +239 var cursor-index-addr/ecx: (addr int) <- get self, cursor-index +240 var cursor-index/ecx: int <- copy *cursor-index-addr +241 var data-ah/eax: (addr handle array global) <- get self, data +242 var data/eax: (addr array global) <- lookup *data-ah +243 var cursor-offset/ecx: (offset global) <- compute-offset data, cursor-index +244 var curr-global/eax: (addr global) <- index data, cursor-offset +245 var curr-editor-ah/eax: (addr handle gap-buffer) <- get curr-global, input +246 var curr-editor/eax: (addr gap-buffer) <- lookup *curr-editor-ah +247 edit-gap-buffer curr-editor, key +248 } +249 +250 fn create-empty-global _self: (addr global-table), name-stream: (addr stream byte), capacity: int { +251 var self/esi: (addr global-table) <- copy _self +252 var final-index-addr/ecx: (addr int) <- get self, final-index +253 increment *final-index-addr +254 var curr-index/ecx: int <- copy *final-index-addr +255 var cursor-index-addr/eax: (addr int) <- get self, cursor-index +256 copy-to *cursor-index-addr, curr-index +257 var data-ah/eax: (addr handle array global) <- get self, data +258 var data/eax: (addr array global) <- lookup *data-ah +259 var curr-offset/ecx: (offset global) <- compute-offset data, curr-index +260 var curr/esi: (addr global) <- index data, curr-offset +261 var curr-name-ah/eax: (addr handle array byte) <- get curr, name +262 stream-to-array name-stream, curr-name-ah +263 var curr-input-ah/eax: (addr handle gap-buffer) <- get curr, input +264 allocate curr-input-ah +265 var curr-input/eax: (addr gap-buffer) <- lookup *curr-input-ah +266 initialize-gap-buffer curr-input, capacity +267 var trace-ah/eax: (addr handle trace) <- get curr, trace +268 allocate trace-ah +269 var trace/eax: (addr trace) <- lookup *trace-ah +270 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +271 } +272 +273 fn refresh-cursor-definition _self: (addr global-table) { +274 var self/esi: (addr global-table) <- copy _self +275 var cursor-index/edx: (addr int) <- get self, cursor-index +276 refresh-definition self, *cursor-index +277 } +278 +279 fn refresh-definition _self: (addr global-table), _index: int { +280 var self/esi: (addr global-table) <- copy _self +281 var data-ah/eax: (addr handle array global) <- get self, data +282 var data/eax: (addr array global) <- lookup *data-ah +283 var index/ebx: int <- copy _index +284 var offset/ebx: (offset global) <- compute-offset data, index +285 var curr-global/ebx: (addr global) <- index data, offset +286 var curr-input-ah/edx: (addr handle gap-buffer) <- get curr-global, input +287 var curr-trace-ah/eax: (addr handle trace) <- get curr-global, trace +288 var curr-trace/eax: (addr trace) <- lookup *curr-trace-ah +289 clear-trace curr-trace +290 var curr-value-ah/edi: (addr handle cell) <- get curr-global, value +291 var definitions-created-storage: (stream int 0x10) +292 var definitions-created/ecx: (addr stream int) <- address definitions-created-storage +293 read-and-evaluate-and-save-gap-buffer-to-globals curr-input-ah, curr-value-ah, self, definitions-created, curr-trace, 0/no-screen, 0/no-keyboard +294 } +295 +296 fn assign-or-create-global _self: (addr global-table), name: (addr array byte), value: (handle cell), index-updated: (addr int), trace: (addr trace) { +297 var self/esi: (addr global-table) <- copy _self +298 compare self, 0 +299 { +300 break-if-!= +301 abort "assign global" +302 } +303 var curr-index/ecx: int <- find-symbol-name-in-globals self, name +304 { +305 compare curr-index, -1/not-found +306 break-if-!= +307 var final-index-addr/eax: (addr int) <- get self, final-index +308 increment *final-index-addr +309 curr-index <- copy *final-index-addr +310 var cursor-index-addr/eax: (addr int) <- get self, cursor-index +311 copy-to *cursor-index-addr, curr-index +312 } +313 var data-ah/eax: (addr handle array global) <- get self, data +314 var data/eax: (addr array global) <- lookup *data-ah +315 var curr-offset/esi: (offset global) <- compute-offset data, curr-index +316 var curr/esi: (addr global) <- index data, curr-offset +317 var curr-name-ah/eax: (addr handle array byte) <- get curr, name +318 copy-array-object name, curr-name-ah +319 var curr-value-ah/eax: (addr handle cell) <- get curr, value +320 copy-handle value, curr-value-ah +321 var index-updated/edi: (addr int) <- copy index-updated +322 copy-to *index-updated, curr-index +323 var trace-ah/eax: (addr handle trace) <- get curr, trace +324 allocate trace-ah +325 var trace/eax: (addr trace) <- lookup *trace-ah +326 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +327 } +328 +329 fn lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell) { +330 var sym/eax: (addr cell) <- copy _sym +331 var sym-name-ah/eax: (addr handle stream byte) <- get sym, text-data +332 var _sym-name/eax: (addr stream byte) <- lookup *sym-name-ah +333 var sym-name/edx: (addr stream byte) <- copy _sym-name +334 var globals/esi: (addr global-table) <- copy _globals +335 { +336 compare globals, 0 337 break-if-= -338 compare keyboard-cell, 0 -339 break-if-= -340 copy-object keyboard-cell, out -341 return -342 } -343 # otherwise error "unbound symbol: ", sym -344 var stream-storage: (stream byte 0x40) -345 var stream/ecx: (addr stream byte) <- address stream-storage -346 write stream, "unbound symbol: " -347 rewind-stream sym-name -348 write-stream stream, sym-name -349 error-stream trace, stream -350 } -351 -352 fn maybe-lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) { -353 var sym/eax: (addr cell) <- copy _sym -354 var sym-name-ah/eax: (addr handle stream byte) <- get sym, text-data -355 var _sym-name/eax: (addr stream byte) <- lookup *sym-name-ah -356 var sym-name/edx: (addr stream byte) <- copy _sym-name -357 var globals/esi: (addr global-table) <- copy _globals -358 { -359 compare globals, 0 -360 break-if-= -361 var curr-index/ecx: int <- find-symbol-in-globals globals, sym-name -362 compare curr-index, -1/not-found +338 var curr-index/ecx: int <- find-symbol-in-globals globals, sym-name +339 compare curr-index, -1/not-found +340 break-if-= +341 var global-data-ah/eax: (addr handle array global) <- get globals, data +342 var global-data/eax: (addr array global) <- lookup *global-data-ah +343 var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index +344 var curr/ebx: (addr global) <- index global-data, curr-offset +345 var curr-value/eax: (addr handle cell) <- get curr, value +346 copy-object curr-value, out +347 return +348 } +349 # if sym is "screen" and inner-screen-var exists, return it +350 { +351 var sym-is-screen?/eax: boolean <- stream-data-equal? sym-name, "screen" +352 compare sym-is-screen?, 0/false +353 break-if-= +354 compare inner-screen-var, 0 +355 break-if-= +356 copy-object inner-screen-var, out +357 return +358 } +359 # if sym is "keyboard" and inner-keyboard-var exists, return it +360 { +361 var sym-is-keyboard?/eax: boolean <- stream-data-equal? sym-name, "keyboard" +362 compare sym-is-keyboard?, 0/false 363 break-if-= -364 var global-data-ah/eax: (addr handle array global) <- get globals, data -365 var global-data/eax: (addr array global) <- lookup *global-data-ah -366 var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index -367 var curr/ebx: (addr global) <- index global-data, curr-offset -368 var curr-value/eax: (addr handle cell) <- get curr, value -369 copy-object curr-value, out -370 return -371 } -372 } -373 -374 # return the index in globals containing 'sym' -375 # or -1 if not found -376 fn find-symbol-in-globals _globals: (addr global-table), sym-name: (addr stream byte) -> _/ecx: int { -377 var globals/esi: (addr global-table) <- copy _globals -378 compare globals, 0 -379 { -380 break-if-!= -381 return -1/not-found -382 } -383 var global-data-ah/eax: (addr handle array global) <- get globals, data -384 var global-data/eax: (addr array global) <- lookup *global-data-ah -385 var final-index/ecx: (addr int) <- get globals, final-index -386 var curr-index/ecx: int <- copy *final-index -387 { -388 compare curr-index, 0 -389 break-if-< -390 var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index -391 var curr/ebx: (addr global) <- index global-data, curr-offset -392 var curr-name-ah/eax: (addr handle array byte) <- get curr, name -393 var curr-name/eax: (addr array byte) <- lookup *curr-name-ah -394 var found?/eax: boolean <- stream-data-equal? sym-name, curr-name -395 compare found?, 0/false -396 { -397 break-if-= -398 return curr-index -399 } -400 curr-index <- decrement -401 loop -402 } -403 return -1/not-found -404 } -405 -406 # return the index in globals containing 'sym' -407 # or -1 if not found -408 fn find-symbol-name-in-globals _globals: (addr global-table), sym-name: (addr array byte) -> _/ecx: int { -409 var globals/esi: (addr global-table) <- copy _globals -410 compare globals, 0 -411 { -412 break-if-!= -413 return -1/not-found -414 } -415 var global-data-ah/eax: (addr handle array global) <- get globals, data -416 var global-data/eax: (addr array global) <- lookup *global-data-ah -417 var final-index/ecx: (addr int) <- get globals, final-index -418 var curr-index/ecx: int <- copy *final-index -419 { -420 compare curr-index, 0 -421 break-if-< -422 var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index -423 var curr/ebx: (addr global) <- index global-data, curr-offset -424 var curr-name-ah/eax: (addr handle array byte) <- get curr, name -425 var curr-name/eax: (addr array byte) <- lookup *curr-name-ah -426 var found?/eax: boolean <- string-equal? sym-name, curr-name -427 compare found?, 0/false -428 { -429 break-if-= -430 return curr-index -431 } -432 curr-index <- decrement -433 loop -434 } -435 return -1/not-found -436 } -437 -438 fn mutate-binding-in-globals name: (addr stream byte), val: (addr handle cell), _globals: (addr global-table), trace: (addr trace) { -439 var globals/esi: (addr global-table) <- copy _globals -440 { -441 compare globals, 0 -442 break-if-= -443 var curr-index/ecx: int <- find-symbol-in-globals globals, name -444 compare curr-index, -1/not-found -445 break-if-= -446 var global-data-ah/eax: (addr handle array global) <- get globals, data -447 var global-data/eax: (addr array global) <- lookup *global-data-ah +364 compare inner-keyboard-var, 0 +365 break-if-= +366 copy-object inner-keyboard-var, out +367 return +368 } +369 # otherwise error "unbound symbol: ", sym +370 var stream-storage: (stream byte 0x40) +371 var stream/ecx: (addr stream byte) <- address stream-storage +372 write stream, "unbound symbol: " +373 rewind-stream sym-name +374 write-stream stream, sym-name +375 error-stream trace, stream +376 } +377 +378 fn maybe-lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) { +379 var sym/eax: (addr cell) <- copy _sym +380 var sym-name-ah/eax: (addr handle stream byte) <- get sym, text-data +381 var _sym-name/eax: (addr stream byte) <- lookup *sym-name-ah +382 var sym-name/edx: (addr stream byte) <- copy _sym-name +383 var globals/esi: (addr global-table) <- copy _globals +384 { +385 compare globals, 0 +386 break-if-= +387 var curr-index/ecx: int <- find-symbol-in-globals globals, sym-name +388 compare curr-index, -1/not-found +389 break-if-= +390 var global-data-ah/eax: (addr handle array global) <- get globals, data +391 var global-data/eax: (addr array global) <- lookup *global-data-ah +392 var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index +393 var curr/ebx: (addr global) <- index global-data, curr-offset +394 var curr-value/eax: (addr handle cell) <- get curr, value +395 copy-object curr-value, out +396 return +397 } +398 } +399 +400 # return the index in globals containing 'sym' +401 # or -1 if not found +402 fn find-symbol-in-globals _globals: (addr global-table), sym-name: (addr stream byte) -> _/ecx: int { +403 var globals/esi: (addr global-table) <- copy _globals +404 compare globals, 0 +405 { +406 break-if-!= +407 return -1/not-found +408 } +409 var global-data-ah/eax: (addr handle array global) <- get globals, data +410 var global-data/eax: (addr array global) <- lookup *global-data-ah +411 var final-index/ecx: (addr int) <- get globals, final-index +412 var curr-index/ecx: int <- copy *final-index +413 { +414 compare curr-index, 0 +415 break-if-< +416 var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index +417 var curr/ebx: (addr global) <- index global-data, curr-offset +418 var curr-name-ah/eax: (addr handle array byte) <- get curr, name +419 var curr-name/eax: (addr array byte) <- lookup *curr-name-ah +420 var found?/eax: boolean <- stream-data-equal? sym-name, curr-name +421 compare found?, 0/false +422 { +423 break-if-= +424 return curr-index +425 } +426 curr-index <- decrement +427 loop +428 } +429 return -1/not-found +430 } +431 +432 # return the index in globals containing 'sym' +433 # or -1 if not found +434 fn find-symbol-name-in-globals _globals: (addr global-table), sym-name: (addr array byte) -> _/ecx: int { +435 var globals/esi: (addr global-table) <- copy _globals +436 compare globals, 0 +437 { +438 break-if-!= +439 return -1/not-found +440 } +441 var global-data-ah/eax: (addr handle array global) <- get globals, data +442 var global-data/eax: (addr array global) <- lookup *global-data-ah +443 var final-index/ecx: (addr int) <- get globals, final-index +444 var curr-index/ecx: int <- copy *final-index +445 { +446 compare curr-index, 0 +447 break-if-< 448 var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index 449 var curr/ebx: (addr global) <- index global-data, curr-offset -450 var dest/eax: (addr handle cell) <- get curr, value -451 copy-object val, dest -452 return -453 } -454 # otherwise error "unbound symbol: ", sym -455 var stream-storage: (stream byte 0x40) -456 var stream/ecx: (addr stream byte) <- address stream-storage -457 write stream, "unbound symbol: " -458 rewind-stream name -459 write-stream stream, name -460 error-stream trace, stream -461 } -462 -463 # Accepts an input s-expression, naively checks if it is a definition, and if -464 # so saves the gap-buffer to the appropriate global, spinning up a new empty -465 # one to replace it with. -466 fn maybe-stash-gap-buffer-to-global _globals: (addr global-table), _definition-ah: (addr handle cell), gap: (addr handle gap-buffer) { -467 # if 'definition' is not a pair, return -468 var definition-ah/eax: (addr handle cell) <- copy _definition-ah -469 var _definition/eax: (addr cell) <- lookup *definition-ah -470 var definition/esi: (addr cell) <- copy _definition -471 var definition-type/eax: (addr int) <- get definition, type -472 compare *definition-type, 0/pair -473 { -474 break-if-= -475 return -476 } -477 # if definition->left is neither "define" nor "set", return -478 var left-ah/eax: (addr handle cell) <- get definition, left -479 var _left/eax: (addr cell) <- lookup *left-ah -480 var left/ecx: (addr cell) <- copy _left -481 { -482 var def?/eax: boolean <- symbol-equal? left, "define" -483 compare def?, 0/false -484 break-if-!= -485 var set?/eax: boolean <- symbol-equal? left, "set" -486 compare set?, 0/false -487 break-if-!= -488 return -489 } -490 # locate the global for definition->right->left -491 var right-ah/eax: (addr handle cell) <- get definition, right -492 var right/eax: (addr cell) <- lookup *right-ah -493 var defined-symbol-ah/eax: (addr handle cell) <- get right, left -494 var defined-symbol/eax: (addr cell) <- lookup *defined-symbol-ah -495 var defined-symbol-name-ah/eax: (addr handle stream byte) <- get defined-symbol, text-data -496 var defined-symbol-name/eax: (addr stream byte) <- lookup *defined-symbol-name-ah -497 var index/ecx: int <- find-symbol-in-globals _globals, defined-symbol-name -498 { -499 compare index, -1/not-found -500 break-if-!= -501 return -502 } -503 # stash 'gap' to it -504 var globals/eax: (addr global-table) <- copy _globals -505 compare globals, 0 -506 { -507 break-if-!= -508 abort "stash to globals" -509 return -510 } -511 var global-data-ah/eax: (addr handle array global) <- get globals, data -512 var global-data/eax: (addr array global) <- lookup *global-data-ah -513 var offset/ebx: (offset global) <- compute-offset global-data, index -514 var dest-global/eax: (addr global) <- index global-data, offset -515 var dest-ah/eax: (addr handle gap-buffer) <- get dest-global, input -516 copy-object gap, dest-ah -517 # initialize a new gap-buffer in 'gap' -518 var dest/eax: (addr gap-buffer) <- lookup *dest-ah -519 var capacity/ecx: int <- gap-buffer-capacity dest -520 var gap2/eax: (addr handle gap-buffer) <- copy gap -521 allocate gap2 -522 var gap-addr/eax: (addr gap-buffer) <- lookup *gap2 -523 initialize-gap-buffer gap-addr, capacity -524 } -525 -526 # Accepts an input s-expression, naively checks if it is a definition, and if -527 # so saves the gap-buffer to the appropriate global. -528 fn move-gap-buffer-to-global _globals: (addr global-table), _definition-ah: (addr handle cell), gap: (addr handle gap-buffer) { -529 # if 'definition' is not a pair, return -530 var definition-ah/eax: (addr handle cell) <- copy _definition-ah -531 var _definition/eax: (addr cell) <- lookup *definition-ah -532 var definition/esi: (addr cell) <- copy _definition -533 var definition-type/eax: (addr int) <- get definition, type -534 compare *definition-type, 0/pair -535 { -536 break-if-= -537 return -538 } -539 # if definition->left is neither "define" nor "set", return -540 var left-ah/eax: (addr handle cell) <- get definition, left -541 var _left/eax: (addr cell) <- lookup *left-ah -542 var left/ecx: (addr cell) <- copy _left -543 { -544 var def?/eax: boolean <- symbol-equal? left, "define" -545 compare def?, 0/false -546 break-if-!= -547 var set?/eax: boolean <- symbol-equal? left, "set" -548 compare set?, 0/false -549 break-if-!= -550 return -551 } -552 # locate the global for definition->right->left -553 var right-ah/eax: (addr handle cell) <- get definition, right -554 var right/eax: (addr cell) <- lookup *right-ah -555 var defined-symbol-ah/eax: (addr handle cell) <- get right, left -556 var defined-symbol/eax: (addr cell) <- lookup *defined-symbol-ah -557 var defined-symbol-name-ah/eax: (addr handle stream byte) <- get defined-symbol, text-data -558 var defined-symbol-name/eax: (addr stream byte) <- lookup *defined-symbol-name-ah -559 var index/ecx: int <- find-symbol-in-globals _globals, defined-symbol-name -560 { -561 compare index, -1/not-found -562 break-if-!= -563 return -564 } -565 # move 'gap' to it -566 var globals/eax: (addr global-table) <- copy _globals -567 compare globals, 0 -568 { -569 break-if-!= -570 abort "move to globals" -571 return -572 } -573 var global-data-ah/eax: (addr handle array global) <- get globals, data -574 var global-data/eax: (addr array global) <- lookup *global-data-ah -575 var offset/ebx: (offset global) <- compute-offset global-data, index -576 var dest-global/eax: (addr global) <- index global-data, offset -577 var dest-ah/eax: (addr handle gap-buffer) <- get dest-global, input -578 copy-object gap, dest-ah -579 } -580 -581 fn set-global-cursor-index _globals: (addr global-table), name-gap: (addr gap-buffer) { -582 var globals/esi: (addr global-table) <- copy _globals -583 var name-storage: (stream byte 0x40) -584 var name/ecx: (addr stream byte) <- address name-storage -585 emit-gap-buffer name-gap, name -586 var index/ecx: int <- find-symbol-in-globals globals, name -587 var dest/edi: (addr int) <- get globals, cursor-index -588 copy-to *dest, index -589 } +450 var curr-name-ah/eax: (addr handle array byte) <- get curr, name +451 var curr-name/eax: (addr array byte) <- lookup *curr-name-ah +452 var found?/eax: boolean <- string-equal? sym-name, curr-name +453 compare found?, 0/false +454 { +455 break-if-= +456 return curr-index +457 } +458 curr-index <- decrement +459 loop +460 } +461 return -1/not-found +462 } +463 +464 fn mutate-binding-in-globals name: (addr stream byte), val: (addr handle cell), _globals: (addr global-table), trace: (addr trace) { +465 var globals/esi: (addr global-table) <- copy _globals +466 { +467 compare globals, 0 +468 break-if-= +469 var curr-index/ecx: int <- find-symbol-in-globals globals, name +470 compare curr-index, -1/not-found +471 break-if-= +472 var global-data-ah/eax: (addr handle array global) <- get globals, data +473 var global-data/eax: (addr array global) <- lookup *global-data-ah +474 var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index +475 var curr/ebx: (addr global) <- index global-data, curr-offset +476 var dest/eax: (addr handle cell) <- get curr, value +477 copy-object val, dest +478 return +479 } +480 # otherwise error "unbound symbol: ", sym +481 var stream-storage: (stream byte 0x40) +482 var stream/ecx: (addr stream byte) <- address stream-storage +483 write stream, "unbound symbol: " +484 rewind-stream name +485 write-stream stream, name +486 error-stream trace, stream +487 } +488 +489 fn stash-gap-buffer-to-globals _globals: (addr global-table), definitions: (addr stream int), gap: (addr handle gap-buffer) { +490 var globals/eax: (addr global-table) <- copy _globals +491 compare globals, 0 +492 { +493 break-if-!= +494 return +495 } +496 var global-data-ah/eax: (addr handle array global) <- get globals, data +497 var global-data/eax: (addr array global) <- lookup *global-data-ah +498 rewind-stream definitions +499 { +500 { +501 var done?/eax: boolean <- stream-empty? definitions +502 compare done?, 0/false +503 } +504 break-if-!= +505 var index: int +506 var index-addr/ecx: (addr int) <- address index +507 read-from-stream definitions, index-addr +508 var index/ecx: int <- copy *index-addr +509 var offset/ebx: (offset global) <- compute-offset global-data, index +510 var dest-global/eax: (addr global) <- index global-data, offset +511 var dest-ah/eax: (addr handle gap-buffer) <- get dest-global, input +512 copy-object gap, dest-ah +513 loop +514 } +515 } +516 +517 fn is-definition? _expr: (addr cell) -> _/eax: boolean { +518 var expr/eax: (addr cell) <- copy _expr +519 # if expr->left is neither "define" nor "set", return +520 var left-ah/eax: (addr handle cell) <- get expr, left +521 var _left/eax: (addr cell) <- lookup *left-ah +522 var left/ecx: (addr cell) <- copy _left +523 { +524 var def?/eax: boolean <- symbol-equal? left, "define" +525 compare def?, 0/false +526 break-if-= +527 return 1/true +528 } +529 { +530 var set?/eax: boolean <- symbol-equal? left, "set" +531 compare set?, 0/false +532 break-if-= +533 return 1/true +534 } +535 return 0/false +536 } +537 +538 # load all bindings in a single lexical scope, aka gap buffer of the environment, aka file of the file system +539 fn load-lexical-scope in-ah: (addr handle gap-buffer), _globals: (addr global-table) { +540 var globals/esi: (addr global-table) <- copy _globals +541 var definitions-created-storage: (stream int 0x10) +542 var definitions-created/ebx: (addr stream int) <- address definitions-created-storage +543 var trace-h: (handle trace) +544 var trace-ah/edx: (addr handle trace) <- address trace-h +545 allocate trace-ah +546 var trace/eax: (addr trace) <- lookup *trace-ah +547 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +548 var dummy-result-h: (handle cell) +549 var dummy-result-ah/ecx: (addr handle cell) <- address dummy-result-h +550 read-and-evaluate-and-save-gap-buffer-to-globals in-ah, dummy-result-ah, globals, definitions-created, trace, 0/no-inner-screen-var, 0/no-inner-keyboard-var +551 # +552 # save trace to all needed globals as well +553 rewind-stream definitions-created +554 var globals-data-ah/eax: (addr handle array global) <- get globals, data +555 var _globals-data/eax: (addr array global) <- lookup *globals-data-ah +556 var globals-data/edi: (addr array global) <- copy _globals-data +557 { +558 var no-definitions?/eax: boolean <- stream-empty? definitions-created +559 compare no-definitions?, 0/false +560 break-if-!= +561 var curr-index: int +562 var curr-index-a/eax: (addr int) <- address curr-index +563 read-from-stream definitions-created, curr-index-a +564 var curr-offset/eax: (offset global) <- compute-offset globals-data, curr-index +565 var curr-global/ecx: (addr global) <- index globals-data, curr-offset +566 var curr-trace-ah/eax: (addr handle trace) <- get curr-global, trace +567 copy-object trace-ah, curr-trace-ah +568 loop +569 } +570 } +571 +572 fn set-global-cursor-index _globals: (addr global-table), name-gap: (addr gap-buffer) { +573 var globals/esi: (addr global-table) <- copy _globals +574 var name-storage: (stream byte 0x40) +575 var name/ecx: (addr stream byte) <- address name-storage +576 emit-gap-buffer name-gap, name +577 var index/ecx: int <- find-symbol-in-globals globals, name +578 var dest/edi: (addr int) <- get globals, cursor-index +579 copy-to *dest, index +580 } diff --git a/html/shell/grapheme-stack.mu.html b/html/shell/grapheme-stack.mu.html index 139f2f4b..4e5905fb 100644 --- a/html/shell/grapheme-stack.mu.html +++ b/html/shell/grapheme-stack.mu.html @@ -16,6 +16,7 @@ a { color:inherit; } * { font-size:12pt; font-size: 1em; } .LineNr { } .Delimiter { color: #c000c0; } +.muRegEdx { color: #878700; } .muRegEbx { color: #8787af; } .muRegEsi { color: #87d787; } .muRegEdi { color: #87ffd7; } @@ -27,7 +28,6 @@ a { color:inherit; } .muComment { color: #005faf; } .muRegEax { color: #875f00; } .muRegEcx { color: #af875f; } -.muRegEdx { color: #878700; } --> @@ -149,9 +149,9 @@ if ('onhashchange' in window) { 84 # dump stack to screen from bottom to top 85 # hardcoded colors: 86 # matching paren - 87 fn render-stack-from-bottom-wrapping-right-then-down screen: (addr screen), _self: (addr grapheme-stack), xmin: int, ymin: int, xmax: int, ymax: int, _x: int, _y: int, highlight-matching-open-paren?: boolean, open-paren-depth: int, color: int, background-color: int -> _/eax: int, _/ecx: int { + 87 fn render-stack-from-bottom-wrapping-right-then-down screen: (addr screen), _self: (addr grapheme-stack), xmin: int, ymin: int, xmax: int, ymax: int, _x: int, _y: int, highlight-matching-open-paren?: boolean, open-paren-depth: int, color: int, background-color: int -> _/eax: int, _/ecx: int { 88 var self/esi: (addr grapheme-stack) <- copy _self - 89 var matching-open-paren-index/edx: int <- get-matching-open-paren-index self, highlight-matching-open-paren?, open-paren-depth + 89 var matching-open-paren-index/edx: int <- get-matching-open-paren-index self, highlight-matching-open-paren?, open-paren-depth 90 var data-ah/edi: (addr handle array grapheme) <- get self, data 91 var _data/eax: (addr array grapheme) <- lookup *data-ah 92 var data/edi: (addr array grapheme) <- copy _data @@ -183,15 +183,15 @@ if ('onhashchange' in window) { 118 } 119 120 # helper for small words -121 fn render-stack-from-bottom screen: (addr screen), self: (addr grapheme-stack), x: int, y: int, highlight-matching-open-paren?: boolean, open-paren-depth: int -> _/eax: int { +121 fn render-stack-from-bottom screen: (addr screen), self: (addr grapheme-stack), x: int, y: int, highlight-matching-open-paren?: boolean, open-paren-depth: int -> _/eax: int { 122 var _width/eax: int <- copy 0 123 var _height/ecx: int <- copy 0 -124 _width, _height <- screen-size screen +124 _width, _height <- screen-size screen 125 var width/edx: int <- copy _width 126 var height/ebx: int <- copy _height 127 var x2/eax: int <- copy 0 128 var y2/ecx: int <- copy 0 -129 x2, y2 <- render-stack-from-bottom-wrapping-right-then-down screen, self, x, y, width, height, x, y, highlight-matching-open-paren?, open-paren-depth, 3/fg=cyan, 0xc5/bg=blue-bg +129 x2, y2 <- render-stack-from-bottom-wrapping-right-then-down screen, self, x, y, width, height, x, y, highlight-matching-open-paren?, open-paren-depth, 3/fg=cyan, 0xc5/bg=blue-bg 130 return x2 # y2? yolo 131 } 132 @@ -218,7 +218,7 @@ if ('onhashchange' in window) { 153 compare i, 0 154 break-if-< 155 var g/esi: (addr grapheme) <- index data, i -156 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, color, 7/bg=cursor +156 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, background-color, color 157 i <- decrement 158 } 159 # remaining iterations @@ -249,7 +249,7 @@ if ('onhashchange' in window) { 184 fn render-stack-from-top screen: (addr screen), self: (addr grapheme-stack), x: int, y: int, render-cursor?: boolean -> _/eax: int { 185 var _width/eax: int <- copy 0 186 var _height/ecx: int <- copy 0 -187 _width, _height <- screen-size screen +187 _width, _height <- screen-size screen 188 var width/edx: int <- copy _width 189 var height/ebx: int <- copy _height 190 var x2/eax: int <- copy 0 @@ -272,22 +272,22 @@ if ('onhashchange' in window) { 207 # setup: screen 208 var screen-on-stack: screen 209 var screen/esi: (addr screen) <- address screen-on-stack -210 initialize-screen screen, 5, 4, 0/no-pixel-graphics +210 initialize-screen screen, 5, 4, 0/no-pixel-graphics 211 # 212 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 0/y, 0/no-highlight-matching-open-paren, 0/open-paren-depth 213 check-screen-row screen, 0/y, "abc ", "F - test-render-grapheme-stack from bottom" 214 check-ints-equal x, 3, "F - test-render-grapheme-stack from bottom: result" -215 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-render-grapheme-stack from bottom: bg" +215 check-background-color-in-screen-row screen, 3/bg=reverse, 0/y, " ", "F - test-render-grapheme-stack from bottom: bg" 216 # 217 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 1/y, 0/cursor=false 218 check-screen-row screen, 1/y, "cba ", "F - test-render-grapheme-stack from top without cursor" 219 check-ints-equal x, 3, "F - test-render-grapheme-stack from top without cursor: result" -220 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-render-grapheme-stack from top without cursor: bg" +220 check-background-color-in-screen-row screen, 3/bg=reverse, 1/y, " ", "F - test-render-grapheme-stack from top without cursor: bg" 221 # 222 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 2/y, 1/cursor=true 223 check-screen-row screen, 2/y, "cba ", "F - test-render-grapheme-stack from top with cursor" 224 check-ints-equal x, 3, "F - test-render-grapheme-stack from top with cursor: result" -225 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "| ", "F - test-render-grapheme-stack from top with cursor: bg" +225 check-background-color-in-screen-row screen, 3/bg=reverse, 2/y, "| ", "F - test-render-grapheme-stack from top with cursor: bg" 226 } 227 228 fn test-render-grapheme-stack-while-highlighting-matching-close-paren { @@ -304,12 +304,12 @@ if ('onhashchange' in window) { 239 # setup: screen 240 var screen-on-stack: screen 241 var screen/esi: (addr screen) <- address screen-on-stack -242 initialize-screen screen, 5, 4, 0/no-pixel-graphics +242 initialize-screen screen, 5, 4, 0/no-pixel-graphics 243 # 244 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 2/y, 1/cursor=true 245 check-screen-row screen, 2/y, "(b) ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren" -246 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "| ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren: cursor" -247 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ) ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren: matching paren" +246 check-background-color-in-screen-row screen, 3/bg=reverse, 2/y, "| ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren: cursor" +247 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ) ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren: matching paren" 248 } 249 250 fn test-render-grapheme-stack-while-highlighting-matching-close-paren-2 { @@ -338,12 +338,12 @@ if ('onhashchange' in window) { 273 # setup: screen 274 var screen-on-stack: screen 275 var screen/esi: (addr screen) <- address screen-on-stack -276 initialize-screen screen, 5, 4, 0/no-pixel-graphics +276 initialize-screen screen, 5, 4, 0/no-pixel-graphics 277 # 278 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 2/y, 1/cursor=true 279 check-screen-row screen, 2/y, "(a (b)) c ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren-2" -280 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "| ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren-2: cursor" -281 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ) ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren-2: matching paren" +280 check-background-color-in-screen-row screen, 3/bg=reverse, 2/y, "| ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren-2: cursor" +281 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ) ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren-2: matching paren" 282 } 283 284 fn test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end { @@ -360,11 +360,11 @@ if ('onhashchange' in window) { 295 # setup: screen 296 var screen-on-stack: screen 297 var screen/esi: (addr screen) <- address screen-on-stack -298 initialize-screen screen, 5, 4, 0/no-pixel-graphics +298 initialize-screen screen, 5, 4, 0/no-pixel-graphics 299 # 300 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 2/y, 1/highlight-matching-open-paren, 1/open-paren-depth 301 check-screen-row screen, 2/y, "(b) ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end" -302 check-screen-row-in-color screen, 0xf/fg=white, 2/y, "( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end: matching paren" +302 check-screen-row-in-color screen, 0xf/fg=white, 2/y, "( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end: matching paren" 303 } 304 305 fn test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end-2 { @@ -387,11 +387,11 @@ if ('onhashchange' in window) { 322 # setup: screen 323 var screen-on-stack: screen 324 var screen/esi: (addr screen) <- address screen-on-stack -325 initialize-screen screen, 5, 4, 0/no-pixel-graphics +325 initialize-screen screen, 5, 4, 0/no-pixel-graphics 326 # 327 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 2/y, 1/highlight-matching-open-paren, 1/open-paren-depth 328 check-screen-row screen, 2/y, "a((b)) ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end-2" -329 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end-2: matching paren" +329 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end-2: matching paren" 330 } 331 332 fn test-render-grapheme-stack-while-highlighting-matching-open-paren { @@ -406,11 +406,11 @@ if ('onhashchange' in window) { 341 # setup: screen 342 var screen-on-stack: screen 343 var screen/esi: (addr screen) <- address screen-on-stack -344 initialize-screen screen, 5, 4, 0/no-pixel-graphics +344 initialize-screen screen, 5, 4, 0/no-pixel-graphics 345 # 346 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 2/y, 1/highlight-matching-open-paren, 0/open-paren-depth 347 check-screen-row screen, 2/y, "(b ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren" -348 check-screen-row-in-color screen, 0xf/fg=white, 2/y, "( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren: matching paren" +348 check-screen-row-in-color screen, 0xf/fg=white, 2/y, "( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren: matching paren" 349 } 350 351 fn test-render-grapheme-stack-while-highlighting-matching-open-paren-2 { @@ -431,11 +431,11 @@ if ('onhashchange' in window) { 366 # setup: screen 367 var screen-on-stack: screen 368 var screen/esi: (addr screen) <- address screen-on-stack -369 initialize-screen screen, 5, 4, 0/no-pixel-graphics +369 initialize-screen screen, 5, 4, 0/no-pixel-graphics 370 # 371 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 2/y, 1/highlight-matching-open-paren, 0/open-paren-depth 372 check-screen-row screen, 2/y, "a((b) ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-2" -373 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-2: matching paren" +373 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-2: matching paren" 374 } 375 376 # return the index of the matching close-paren of the grapheme at cursor (top of stack) diff --git a/html/shell/macroexpand.mu.html b/html/shell/macroexpand.mu.html index 6aa63bf1..6abe8101 100644 --- a/html/shell/macroexpand.mu.html +++ b/html/shell/macroexpand.mu.html @@ -16,7 +16,8 @@ a { color:inherit; } * { font-size:12pt; font-size: 1em; } .LineNr { } .Delimiter { color: #c000c0; } -.CommentedCode { color: #8a8a8a; } +.muFunction { color: #af5f00; text-decoration: underline; } +.muRegEdx { color: #878700; } .muRegEbx { color: #8787af; } .muRegEsi { color: #87d787; } .muRegEdi { color: #87ffd7; } @@ -24,12 +25,11 @@ a { color:inherit; } .Special { color: #ff6060; } .PreProc { color: #c000c0; } .Folded { color: #080808; background-color: #949494; } -.muFunction { color: #af5f00; text-decoration: underline; } +.CommentedCode { color: #8a8a8a; } .muTest { color: #5f8700; } .muComment { color: #005faf; } .muRegEax { color: #875f00; } .muRegEcx { color: #af875f; } -.muRegEdx { color: #878700; } --> @@ -111,8 +111,8 @@ if ('onhashchange' in window) { 86 var rest-ah/ecx: (addr handle cell) <- get expr, right 87 var first/eax: (addr cell) <- lookup *first-ah 88 { - 89 var litfn?/eax: boolean <- litfn? first - 90 compare litfn?, 0/false + 89 var litfn?/eax: boolean <- litfn? first + 90 compare litfn?, 0/false 91 break-if-= 92 # litfn is a literal 93 trace-text trace, "mac", "literal function" @@ -120,8 +120,8 @@ if ('onhashchange' in window) { 95 return 0/false 96 } 97 { - 98 var litmac?/eax: boolean <- litmac? first - 99 compare litmac?, 0/false + 98 var litmac?/eax: boolean <- litmac? first + 99 compare litmac?, 0/false 100 break-if-= 101 # litmac is a literal 102 trace-text trace, "mac", "literal macro" @@ -131,8 +131,8 @@ if ('onhashchange' in window) { 106 var result/edi: boolean <- copy 0/false 107 # for each builtin, expand only what will later be evaluated 108 $macroexpand-iter:anonymous-function: { -109 var fn?/eax: boolean <- fn? first -110 compare fn?, 0/false +109 var fn?/eax: boolean <- fn? first +110 compare fn?, 0/false 111 break-if-= 112 # fn: expand every expression in the body 113 trace-text trace, "mac", "anonymous function" @@ -230,7 +230,7 @@ if ('onhashchange' in window) { 247 { 248 var definition-h: (handle cell) 249 var definition-ah/edx: (addr handle cell) <- address definition-h -250 maybe-lookup-symbol-in-globals first, definition-ah, globals, trace +250 maybe-lookup-symbol-in-globals first, definition-ah, globals, trace 251 var definition/eax: (addr cell) <- lookup *definition-ah 252 compare definition, 0 253 break-if-= @@ -244,7 +244,7 @@ if ('onhashchange' in window) { 261 { 262 var definition-car-ah/eax: (addr handle cell) <- get definition, left 263 var definition-car/eax: (addr cell) <- lookup *definition-car-ah -264 var macro?/eax: boolean <- litmac? definition-car +264 var macro?/eax: boolean <- litmac? definition-car 265 compare macro?, 0/false 266 } 267 break-if-= @@ -252,7 +252,7 @@ if ('onhashchange' in window) { 269 var macro-definition-ah/eax: (addr handle cell) <- get definition, right 270 # TODO: check car(macro-definition) is litfn 271 #? turn-on-debug-print -272 apply macro-definition-ah, rest-ah, expr-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number +272 apply macro-definition-ah, rest-ah, expr-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number 273 trace-higher trace 274 +-- 15 lines: # trace "1=> " _expr-ah --------------------------------------------------------------------------------------------------------------------------------------------------- 289 return 1/true @@ -301,29 +301,29 @@ if ('onhashchange' in window) { 346 } 347 var cdr-ah/ecx: (addr handle cell) <- get expr, right 348 var car-ah/ebx: (addr handle cell) <- get expr, left -349 var car/eax: (addr cell) <- lookup *car-ah +349 var car/eax: (addr cell) <- lookup *car-ah 350 # if car is unquote or unquote-splice, check if cadr is unquote or 351 # unquote-splice. 352 $look-for-double-unquote:check: { 353 # if car is not an unquote, break 354 { 355 { -356 var unquote?/eax: boolean <- symbol-equal? car, "," +356 var unquote?/eax: boolean <- symbol-equal? car, "," 357 compare unquote?, 0/false 358 } 359 break-if-!= -360 var unquote-splice?/eax: boolean <- symbol-equal? car, ",@" +360 var unquote-splice?/eax: boolean <- symbol-equal? car, ",@" 361 compare unquote-splice?, 0/false 362 break-if-!= 363 break $look-for-double-unquote:check 364 } 365 # if cdr is not a pair, break -366 var cdr/eax: (addr cell) <- lookup *cdr-ah -367 var cdr-type/ecx: (addr int) <- get cdr, type +366 var cdr/eax: (addr cell) <- lookup *cdr-ah +367 var cdr-type/ecx: (addr int) <- get cdr, type 368 compare *cdr-type, 0/pair 369 break-if-!= 370 # if cadr is not an unquote, break -371 var cadr-ah/eax: (addr handle cell) <- get cdr, left +371 var cadr-ah/eax: (addr handle cell) <- get cdr, left 372 var cadr/eax: (addr cell) <- lookup *cadr-ah 373 { 374 { @@ -352,12 +352,12 @@ if ('onhashchange' in window) { 397 fn test-macroexpand { 398 var globals-storage: global-table 399 var globals/edx: (addr global-table) <- address globals-storage -400 initialize-globals globals +400 initialize-globals globals 401 # new macro: m 402 var sandbox-storage: sandbox 403 var sandbox/esi: (addr sandbox) <- address sandbox-storage 404 initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))" -405 edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-tweak-screen +405 edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk 406 # invoke macro 407 initialize-sandbox-with sandbox, "(m 3 4)" 408 var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data @@ -384,19 +384,19 @@ if ('onhashchange' in window) { 429 #? dump-cell-from-cursor-over-full-screen expected-ah 430 var expected/eax: (addr cell) <- lookup *expected-ah 431 # -432 var assertion/eax: boolean <- cell-isomorphic? result, expected, trace +432 var assertion/eax: boolean <- cell-isomorphic? result, expected, trace 433 check assertion, "F - test-macroexpand" 434 } 435 436 fn test-macroexpand-inside-anonymous-fn { 437 var globals-storage: global-table 438 var globals/edx: (addr global-table) <- address globals-storage -439 initialize-globals globals +439 initialize-globals globals 440 # new macro: m 441 var sandbox-storage: sandbox 442 var sandbox/esi: (addr sandbox) <- address sandbox-storage 443 initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))" -444 edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-tweak-screen +444 edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk 445 # invoke macro 446 initialize-sandbox-with sandbox, "(fn() (m 3 4))" 447 var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data @@ -422,19 +422,19 @@ if ('onhashchange' in window) { 467 read-cell expected-gap, expected-ah, trace 468 var expected/eax: (addr cell) <- lookup *expected-ah 469 # -470 var assertion/eax: boolean <- cell-isomorphic? result, expected, trace +470 var assertion/eax: boolean <- cell-isomorphic? result, expected, trace 471 check assertion, "F - test-macroexpand-inside-anonymous-fn" 472 } 473 474 fn test-macroexpand-inside-fn-call { 475 var globals-storage: global-table 476 var globals/edx: (addr global-table) <- address globals-storage -477 initialize-globals globals +477 initialize-globals globals 478 # new macro: m 479 var sandbox-storage: sandbox 480 var sandbox/esi: (addr sandbox) <- address sandbox-storage 481 initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))" -482 edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-tweak-screen +482 edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk 483 # invoke macro 484 initialize-sandbox-with sandbox, "((fn() (m 3 4)))" 485 var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data @@ -461,14 +461,14 @@ if ('onhashchange' in window) { 506 #? dump-cell-from-cursor-over-full-screen expected-ah 507 var expected/eax: (addr cell) <- lookup *expected-ah 508 # -509 var assertion/eax: boolean <- cell-isomorphic? result, expected, trace +509 var assertion/eax: boolean <- cell-isomorphic? result, expected, trace 510 check assertion, "F - test-macroexpand-inside-fn-call" 511 } 512 513 fn test-macroexpand-repeatedly-with-backquoted-arg { 514 var globals-storage: global-table 515 var globals/edx: (addr global-table) <- address globals-storage -516 initialize-globals globals +516 initialize-globals globals 517 # macroexpand an expression with a backquote but no macro 518 var sandbox-storage: sandbox 519 var sandbox/esi: (addr sandbox) <- address sandbox-storage @@ -498,12 +498,12 @@ if ('onhashchange' in window) { 543 fn pending-test-macroexpand-inside-backquote-unquote { 544 var globals-storage: global-table 545 var globals/edx: (addr global-table) <- address globals-storage -546 initialize-globals globals +546 initialize-globals globals 547 # new macro: m 548 var sandbox-storage: sandbox 549 var sandbox/esi: (addr sandbox) <- address sandbox-storage 550 initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))" -551 edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-tweak-screen +551 edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk 552 # invoke macro 553 initialize-sandbox-with sandbox, "`(print [result is ] ,(m 3 4)))" 554 var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data @@ -529,19 +529,19 @@ if ('onhashchange' in window) { 574 read-cell expected-gap, expected-ah, trace 575 var expected/eax: (addr cell) <- lookup *expected-ah 576 # -577 var assertion/eax: boolean <- cell-isomorphic? result, expected, trace +577 var assertion/eax: boolean <- cell-isomorphic? result, expected, trace 578 check assertion, "F - test-macroexpand-inside-backquote-unquote" 579 } 580 581 fn pending-test-macroexpand-inside-nested-backquote-unquote { 582 var globals-storage: global-table 583 var globals/edx: (addr global-table) <- address globals-storage -584 initialize-globals globals +584 initialize-globals globals 585 # new macro: m 586 var sandbox-storage: sandbox 587 var sandbox/esi: (addr sandbox) <- address sandbox-storage 588 initialize-sandbox-with sandbox, "(define m (litmac litfn () (a b) `(+ ,a ,b)))" -589 edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-tweak-screen +589 edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk 590 # invoke macro 591 initialize-sandbox-with sandbox, "`(a ,(m 3 4) `(b ,(m 3 4) ,,(m 3 4)))" 592 var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data @@ -568,7 +568,7 @@ if ('onhashchange' in window) { 613 dump-cell-from-cursor-over-full-screen expected-ah 614 var expected/eax: (addr cell) <- lookup *expected-ah 615 # -616 var assertion/eax: boolean <- cell-isomorphic? result, expected, trace +616 var assertion/eax: boolean <- cell-isomorphic? result, expected, trace 617 check assertion, "F - test-macroexpand-inside-nested-backquote-unquote" 618 } 619 diff --git a/html/shell/main.mu.html b/html/shell/main.mu.html index 581fe0cf..d1b6b559 100644 --- a/html/shell/main.mu.html +++ b/html/shell/main.mu.html @@ -59,22 +59,22 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/main/shell/main.mu 
  1 # Experimental Mu shell
- 2 # A Lisp with indent-sensitivity and infix.
+ 2 # Currently based on Lisp.
  3 
  4 fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) {
- 5   var env-storage: environment
- 6   var env/esi: (addr environment) <- address env-storage
- 7   initialize-environment env
- 8   load-state env, data-disk
+ 5   var env-storage: environment
+ 6   var env/esi: (addr environment) <- address env-storage
+ 7   initialize-environment env, 0x20/fake-screen-width, 8/fake-screen-height
+ 8   load-state env, data-disk
  9   $main:loop: {
-10     render-environment screen, env
+10     render-environment screen, env
 11     # no way to quit right now; just reboot
 12     {
 13       var key/eax: byte <- read-key keyboard
 14       compare key, 0
 15       loop-if-=
 16       var key/eax: grapheme <- copy key
-17       edit-environment env, key, data-disk
+17       edit-environment env, key, data-disk
 18     }
 19     loop
 20   }
diff --git a/html/shell/parse.mu.html b/html/shell/parse.mu.html
index f59031b4..e61f4c23 100644
--- a/html/shell/parse.mu.html
+++ b/html/shell/parse.mu.html
@@ -15,16 +15,16 @@ body { font-size:12pt; font-family: monospace; color: #000000; background-color:
 a { color:inherit; }
 * { font-size:12pt; font-size: 1em; }
 .PreProc { color: #c000c0; }
-.muRegEdx { color: #878700; }
+.muRegEcx { color: #af875f; }
 .LineNr { }
 .muRegEdi { color: #87ffd7; }
-.muRegEsi { color: #87d787; }
 .muComment { color: #005faf; }
 .Constant { color: #008787; }
+.muRegEdx { color: #878700; }
 .muRegEax { color: #875f00; }
-.muRegEcx { color: #af875f; }
 .Delimiter { color: #c000c0; }
 .muFunction { color: #af5f00; text-decoration: underline; }
+.muRegEsi { color: #87d787; }
 .Special { color: #ff6060; }
 -->
 
@@ -106,8 +106,8 @@ if ('onhashchange' in window) {
  43   read-from-stream tokens, curr-token
  44   $parse-sexpression:type-check: {
  45     # single quote -> parse as list with a special car
- 46     var quote-token?/eax: boolean <- quote-token? curr-token
- 47     compare quote-token?, 0/false
+ 46     var quote-token?/eax: boolean <- quote-token? curr-token
+ 47     compare quote-token?, 0/false
  48     {
  49       break-if-=
  50       var out/edi: (addr handle cell) <- copy _out
@@ -123,8 +123,8 @@ if ('onhashchange' in window) {
  60       return close-paren?, dot?
  61     }
  62     # backquote quote -> parse as list with a special car
- 63     var backquote-token?/eax: boolean <- backquote-token? curr-token
- 64     compare backquote-token?, 0/false
+ 63     var backquote-token?/eax: boolean <- backquote-token? curr-token
+ 64     compare backquote-token?, 0/false
  65     {
  66       break-if-=
  67       var out/edi: (addr handle cell) <- copy _out
@@ -140,8 +140,8 @@ if ('onhashchange' in window) {
  77       return close-paren?, dot?
  78     }
  79     # unquote -> parse as list with a special car
- 80     var unquote-token?/eax: boolean <- unquote-token? curr-token
- 81     compare unquote-token?, 0/false
+ 80     var unquote-token?/eax: boolean <- unquote-token? curr-token
+ 81     compare unquote-token?, 0/false
  82     {
  83       break-if-=
  84       var out/edi: (addr handle cell) <- copy _out
@@ -157,8 +157,8 @@ if ('onhashchange' in window) {
  94       return close-paren?, dot?
  95     }
  96     # unquote-splice -> parse as list with a special car
- 97     var unquote-splice-token?/eax: boolean <- unquote-splice-token? curr-token
- 98     compare unquote-splice-token?, 0/false
+ 97     var unquote-splice-token?/eax: boolean <- unquote-splice-token? curr-token
+ 98     compare unquote-splice-token?, 0/false
  99     {
 100       break-if-=
 101       var out/edi: (addr handle cell) <- copy _out
@@ -174,7 +174,7 @@ if ('onhashchange' in window) {
 111       return close-paren?, dot?
 112     }
 113     # dot -> return
-114     var dot?/eax: boolean <- dot-token? curr-token
+114     var dot?/eax: boolean <- dot-token? curr-token
 115     compare dot?, 0/false
 116     {
 117       break-if-=
@@ -182,15 +182,15 @@ if ('onhashchange' in window) {
 119       return 0/false, 1/true
 120     }
 121     # not bracket -> parse atom
-122     var bracket-token?/eax: boolean <- bracket-token? curr-token
-123     compare bracket-token?, 0/false
+122     var bracket-token?/eax: boolean <- bracket-token? curr-token
+123     compare bracket-token?, 0/false
 124     {
 125       break-if-!=
 126       parse-atom curr-token, _out, trace
 127       break $parse-sexpression:type-check
 128     }
 129     # open paren -> parse list
-130     var open-paren?/eax: boolean <- open-paren-token? curr-token
+130     var open-paren?/eax: boolean <- open-paren-token? curr-token
 131     compare open-paren?, 0/false
 132     {
 133       break-if-=
@@ -240,7 +240,7 @@ if ('onhashchange' in window) {
 177       break $parse-sexpression:type-check
 178     }
 179     # close paren -> return
-180     var close-paren?/eax: boolean <- close-paren-token? curr-token
+180     var close-paren?/eax: boolean <- close-paren-token? curr-token
 181     compare close-paren?, 0/false
 182     {
 183       break-if-=
@@ -269,8 +269,8 @@ if ('onhashchange' in window) {
 206   var curr-token-data/esi: (addr stream byte) <- copy _curr-token-data
 207   trace trace, "parse", curr-token-data
 208   # number
-209   var number-token?/eax: boolean <- number-token? curr-token
-210   compare number-token?, 0/false
+209   var number-token?/eax: boolean <- number-token? curr-token
+210   compare number-token?, 0/false
 211   {
 212     break-if-=
 213     rewind-stream curr-token-data
@@ -301,13 +301,13 @@ if ('onhashchange' in window) {
 238   }
 239   # default: copy either to a symbol or a stream
 240   # stream token -> literal
-241   var stream-token?/eax: boolean <- stream-token? curr-token
-242   compare stream-token?, 0/false
+241   var stream-token?/eax: boolean <- stream-token? curr-token
+242   compare stream-token?, 0/false
 243   {
 244     break-if-=
 245     allocate-stream _out
 246   }
-247   compare stream-token?, 0/false
+247   compare stream-token?, 0/false
 248   {
 249     break-if-!=
 250     allocate-symbol _out
diff --git a/html/shell/primitives.mu.html b/html/shell/primitives.mu.html
index b050cfba..851a30c5 100644
--- a/html/shell/primitives.mu.html
+++ b/html/shell/primitives.mu.html
@@ -16,18 +16,19 @@ a { color:inherit; }
 * { font-size:12pt; font-size: 1em; }
 .LineNr { }
 .Delimiter { color: #c000c0; }
-.muFunction { color: #af5f00; text-decoration: underline; }
+.CommentedCode { color: #8a8a8a; }
+.muRegEdx { color: #878700; }
 .muRegEbx { color: #8787af; }
 .muRegEsi { color: #87d787; }
 .muRegEdi { color: #87ffd7; }
 .Constant { color: #008787; }
 .Special { color: #ff6060; }
 .PreProc { color: #c000c0; }
-.CommentedCode { color: #8a8a8a; }
+.muFunction { color: #af5f00; text-decoration: underline; }
+.muTest { color: #5f8700; }
 .muComment { color: #005faf; }
 .muRegEax { color: #875f00; }
 .muRegEcx { color: #af875f; }
-.muRegEdx { color: #878700; }
 -->
 
 
@@ -66,1603 +67,2110 @@ if ('onhashchange' in window) {
    1 fn initialize-primitives _self: (addr global-table) {
    2   var self/esi: (addr global-table) <- copy _self
    3   # for numbers
-   4   append-primitive self, "+"
-   5   append-primitive self, "-"
-   6   append-primitive self, "*"
-   7   append-primitive self, "/"
-   8   append-primitive self, "sqrt"
-   9   append-primitive self, "abs"
-  10   append-primitive self, "sgn"
-  11   append-primitive self, "<"
-  12   append-primitive self, ">"
-  13   append-primitive self, "<="
-  14   append-primitive self, ">="
-  15   # generic
-  16   append-primitive self, "="
-  17   append-primitive self, "no"
-  18   append-primitive self, "not"
-  19   append-primitive self, "dbg"
-  20   # for pairs
-  21   append-primitive self, "car"
-  22   append-primitive self, "cdr"
-  23   append-primitive self, "cons"
-  24   # for screens
-  25   append-primitive self, "print"
-  26   append-primitive self, "clear"
-  27   append-primitive self, "lines"
-  28   append-primitive self, "columns"
-  29   append-primitive self, "up"
-  30   append-primitive self, "down"
-  31   append-primitive self, "left"
-  32   append-primitive self, "right"
-  33   append-primitive self, "cr"
-  34   append-primitive self, "pixel"
-  35   append-primitive self, "width"
-  36   append-primitive self, "height"
-  37   # for keyboards
-  38   append-primitive self, "key"
-  39   # for streams
-  40   append-primitive self, "stream"
-  41   append-primitive self, "write"
-  42   # misc
-  43   append-primitive self, "abort"
-  44   # keep sync'd with render-primitives
-  45 }
-  46 
-  47 fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
-  48   var y/ecx: int <- copy ymax
-  49   y <- subtract 0x10
-  50   clear-rect screen, xmin, y, xmax, ymax, 0xdc/bg=green-bg
-  51   y <- increment
-  52   var tmpx/eax: int <- copy xmin
-  53   tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  54   y <- increment
-  55   var tmpx/eax: int <- copy xmin
-  56   tmpx <- draw-text-rightward screen, "  print", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  57   tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  58   y <- increment
-  59   var tmpx/eax: int <- copy xmin
-  60   tmpx <- draw-text-rightward screen, "  lines columns", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  61   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  62   y <- increment
-  63   var tmpx/eax: int <- copy xmin
-  64   tmpx <- draw-text-rightward screen, "  up down left right", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  65   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  66   y <- increment
-  67   var tmpx/eax: int <- copy xmin
-  68   tmpx <- draw-text-rightward screen, "  cr", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  69   tmpx <- draw-text-rightward screen, ": screen   ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  70   tmpx <- draw-text-rightward screen, "# move cursor down and to left margin", tmpx, xmax, y, 0x38/fg=trace, 0xdc/bg=green-bg
-  71   y <- increment
-  72   var tmpx/eax: int <- copy xmin
-  73   tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  74   y <- increment
-  75   var tmpx/eax: int <- copy xmin
-  76   tmpx <- draw-text-rightward screen, "  width height", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  77   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  78   y <- increment
-  79   var tmpx/eax: int <- copy xmin
-  80   tmpx <- draw-text-rightward screen, "  pixel", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  81   tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  82   y <- increment
-  83   var tmpx/eax: int <- copy xmin
-  84   tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  85   y <- increment
-  86   var tmpx/eax: int <- copy xmin
-  87   tmpx <- draw-text-rightward screen, "  clear", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  88   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  89   y <- increment
-  90   var tmpx/eax: int <- copy xmin
-  91   tmpx <- draw-text-rightward screen, "  key", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  92   tmpx <- draw-text-rightward screen, ": () -> grapheme?", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  93   y <- increment
-  94   var tmpx/eax: int <- copy xmin
-  95   tmpx <- draw-text-rightward screen, "streams", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
-  96   y <- increment
-  97   var tmpx/eax: int <- copy xmin
-  98   tmpx <- draw-text-rightward screen, "  stream", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  99   tmpx <- draw-text-rightward screen, ": () -> stream ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 100   y <- increment
- 101   var tmpx/eax: int <- copy xmin
- 102   tmpx <- draw-text-rightward screen, "  write", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 103   tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 104   y <- increment
- 105   var tmpx/eax: int <- copy xmin
- 106   tmpx <- draw-text-rightward screen, "fn def set if while = no(t) car cdr cons  ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 107   tmpx <- draw-text-rightward screen, "num: ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 108   tmpx <- draw-text-rightward screen, "+ - * / sqrt abs sgn < > <= >=   ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 109 }
- 110 
- 111 fn primitive-global? _x: (addr global) -> _/eax: boolean {
- 112   var x/eax: (addr global) <- copy _x
- 113   var value-ah/eax: (addr handle cell) <- get x, value
- 114   var value/eax: (addr cell) <- lookup *value-ah
- 115   compare value, 0/null
- 116   {
- 117     break-if-!=
- 118     return 0/false
- 119   }
- 120   var value-type/eax: (addr int) <- get value, type
- 121   compare *value-type, 4/primitive
- 122   {
- 123     break-if-=
- 124     return 0/false
- 125   }
- 126   return 1/true
- 127 }
- 128 
- 129 fn append-primitive _self: (addr global-table), name: (addr array byte) {
- 130   var self/esi: (addr global-table) <- copy _self
- 131   compare self, 0
- 132   {
- 133     break-if-!=
- 134     abort "append primitive"
- 135     return
- 136   }
- 137   var final-index-addr/ecx: (addr int) <- get self, final-index
- 138   increment *final-index-addr
- 139   var curr-index/ecx: int <- copy *final-index-addr
- 140   var data-ah/eax: (addr handle array global) <- get self, data
- 141   var data/eax: (addr array global) <- lookup *data-ah
- 142   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
- 143   var curr/esi: (addr global) <- index data, curr-offset
- 144   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 145   copy-array-object name, curr-name-ah
- 146   var curr-value-ah/eax: (addr handle cell) <- get curr, value
- 147   new-primitive-function curr-value-ah, curr-index
- 148 }
- 149 
- 150 # a little strange; goes from value to name and selects primitive based on name
- 151 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
- 152   var f/esi: (addr cell) <- copy _f
- 153   var f-index-a/ecx: (addr int) <- get f, index-data
- 154   var f-index/ecx: int <- copy *f-index-a
- 155   var globals/eax: (addr global-table) <- copy _globals
- 156   compare globals, 0
- 157   {
- 158     break-if-!=
- 159     abort "apply primitive"
- 160     return
- 161   }
- 162   var global-data-ah/eax: (addr handle array global) <- get globals, data
- 163   var global-data/eax: (addr array global) <- lookup *global-data-ah
- 164   var f-offset/ecx: (offset global) <- compute-offset global-data, f-index
- 165   var f-value/ecx: (addr global) <- index global-data, f-offset
- 166   var f-name-ah/ecx: (addr handle array byte) <- get f-value, name
- 167   var f-name/eax: (addr array byte) <- lookup *f-name-ah
- 168   {
- 169     var add?/eax: boolean <- string-equal? f-name, "+"
- 170     compare add?, 0/false
- 171     break-if-=
- 172     apply-add args-ah, out, trace
- 173     return
- 174   }
- 175   {
- 176     var subtract?/eax: boolean <- string-equal? f-name, "-"
- 177     compare subtract?, 0/false
- 178     break-if-=
- 179     apply-subtract args-ah, out, trace
- 180     return
- 181   }
- 182   {
- 183     var multiply?/eax: boolean <- string-equal? f-name, "*"
- 184     compare multiply?, 0/false
- 185     break-if-=
- 186     apply-multiply args-ah, out, trace
- 187     return
- 188   }
- 189   {
- 190     var divide?/eax: boolean <- string-equal? f-name, "/"
- 191     compare divide?, 0/false
- 192     break-if-=
- 193     apply-divide args-ah, out, trace
- 194     return
- 195   }
- 196   {
- 197     var square-root?/eax: boolean <- string-equal? f-name, "sqrt"
- 198     compare square-root?, 0/false
- 199     break-if-=
- 200     apply-square-root args-ah, out, trace
- 201     return
- 202   }
+   4   append-primitive self, "+"
+   5   append-primitive self, "-"
+   6   append-primitive self, "*"
+   7   append-primitive self, "/"
+   8   append-primitive self, "%"
+   9   append-primitive self, "sqrt"
+  10   append-primitive self, "abs"
+  11   append-primitive self, "sgn"
+  12   append-primitive self, "<"
+  13   append-primitive self, ">"
+  14   append-primitive self, "<="
+  15   append-primitive self, ">="
+  16   # generic
+  17   append-primitive self, "="
+  18   append-primitive self, "no"
+  19   append-primitive self, "not"
+  20   append-primitive self, "dbg"
+  21   # for pairs
+  22   append-primitive self, "car"
+  23   append-primitive self, "cdr"
+  24   append-primitive self, "cons"
+  25   # for screens
+  26   append-primitive self, "print"
+  27   append-primitive self, "clear"
+  28   append-primitive self, "lines"
+  29   append-primitive self, "columns"
+  30   append-primitive self, "up"
+  31   append-primitive self, "down"
+  32   append-primitive self, "left"
+  33   append-primitive self, "right"
+  34   append-primitive self, "cr"
+  35   append-primitive self, "pixel"
+  36   append-primitive self, "width"
+  37   append-primitive self, "height"
+  38   # for keyboards
+  39   append-primitive self, "key"
+  40   # for streams
+  41   append-primitive self, "stream"
+  42   append-primitive self, "write"
+  43   # misc
+  44   append-primitive self, "abort"
+  45   # keep sync'd with render-primitives
+  46 }
+  47 
+  48 fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
+  49   var y/ecx: int <- copy ymax
+  50   y <- subtract 0x10
+  51   clear-rect screen, xmin, y, xmax, ymax, 0xdc/bg=green-bg
+  52   y <- increment
+  53   var tmpx/eax: int <- copy xmin
+  54   tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  55   y <- increment
+  56   var tmpx/eax: int <- copy xmin
+  57   tmpx <- draw-text-rightward screen, "  print", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  58   tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  59   y <- increment
+  60   var tmpx/eax: int <- copy xmin
+  61   tmpx <- draw-text-rightward screen, "  lines columns", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  62   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  63   y <- increment
+  64   var tmpx/eax: int <- copy xmin
+  65   tmpx <- draw-text-rightward screen, "  up down left right", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  66   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  67   y <- increment
+  68   var tmpx/eax: int <- copy xmin
+  69   tmpx <- draw-text-rightward screen, "  cr", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  70   tmpx <- draw-text-rightward screen, ": screen   ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  71   tmpx <- draw-text-rightward screen, "# move cursor down and to left margin", tmpx, xmax, y, 0x38/fg=trace, 0xdc/bg=green-bg
+  72   y <- increment
+  73   var tmpx/eax: int <- copy xmin
+  74   tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  75   y <- increment
+  76   var tmpx/eax: int <- copy xmin
+  77   tmpx <- draw-text-rightward screen, "  width height", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  78   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  79   y <- increment
+  80   var tmpx/eax: int <- copy xmin
+  81   tmpx <- draw-text-rightward screen, "  pixel", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  82   tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  83   y <- increment
+  84   var tmpx/eax: int <- copy xmin
+  85   tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  86   y <- increment
+  87   var tmpx/eax: int <- copy xmin
+  88   tmpx <- draw-text-rightward screen, "  clear", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  89   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  90   y <- increment
+  91   var tmpx/eax: int <- copy xmin
+  92   tmpx <- draw-text-rightward screen, "  key", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  93   tmpx <- draw-text-rightward screen, ": () -> grapheme?", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  94   y <- increment
+  95   var tmpx/eax: int <- copy xmin
+  96   tmpx <- draw-text-rightward screen, "streams", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+  97   y <- increment
+  98   var tmpx/eax: int <- copy xmin
+  99   tmpx <- draw-text-rightward screen, "  stream", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 100   tmpx <- draw-text-rightward screen, ": () -> stream ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 101   y <- increment
+ 102   var tmpx/eax: int <- copy xmin
+ 103   tmpx <- draw-text-rightward screen, "  write", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 104   tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 105   y <- increment
+ 106   var tmpx/eax: int <- copy xmin
+ 107   tmpx <- draw-text-rightward screen, "fn set if while cons car cdr no not and or = ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 108   # numbers
+ 109   tmpx <- draw-text-rightward screen, "< > <= >= + - * / % sqrt abs sgn", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 110 }
+ 111 
+ 112 fn primitive-global? _x: (addr global) -> _/eax: boolean {
+ 113   var x/eax: (addr global) <- copy _x
+ 114   var value-ah/eax: (addr handle cell) <- get x, value
+ 115   var value/eax: (addr cell) <- lookup *value-ah
+ 116   compare value, 0/null
+ 117   {
+ 118     break-if-!=
+ 119     return 0/false
+ 120   }
+ 121   var value-type/eax: (addr int) <- get value, type
+ 122   compare *value-type, 4/primitive
+ 123   {
+ 124     break-if-=
+ 125     return 0/false
+ 126   }
+ 127   return 1/true
+ 128 }
+ 129 
+ 130 fn append-primitive _self: (addr global-table), name: (addr array byte) {
+ 131   var self/esi: (addr global-table) <- copy _self
+ 132   compare self, 0
+ 133   {
+ 134     break-if-!=
+ 135     abort "append primitive"
+ 136     return
+ 137   }
+ 138   var final-index-addr/ecx: (addr int) <- get self, final-index
+ 139   increment *final-index-addr
+ 140   var curr-index/ecx: int <- copy *final-index-addr
+ 141   var data-ah/eax: (addr handle array global) <- get self, data
+ 142   var data/eax: (addr array global) <- lookup *data-ah
+ 143   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
+ 144   var curr/esi: (addr global) <- index data, curr-offset
+ 145   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
+ 146   copy-array-object name, curr-name-ah
+ 147   var curr-value-ah/eax: (addr handle cell) <- get curr, value
+ 148   new-primitive-function curr-value-ah, curr-index
+ 149 }
+ 150 
+ 151 # a little strange; goes from value to name and selects primitive based on name
+ 152 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
+ 153   var f/esi: (addr cell) <- copy _f
+ 154   var f-index-a/ecx: (addr int) <- get f, index-data
+ 155   var f-index/ecx: int <- copy *f-index-a
+ 156   var globals/eax: (addr global-table) <- copy _globals
+ 157   compare globals, 0
+ 158   {
+ 159     break-if-!=
+ 160     abort "apply primitive"
+ 161     return
+ 162   }
+ 163   var global-data-ah/eax: (addr handle array global) <- get globals, data
+ 164   var global-data/eax: (addr array global) <- lookup *global-data-ah
+ 165   var f-offset/ecx: (offset global) <- compute-offset global-data, f-index
+ 166   var f-value/ecx: (addr global) <- index global-data, f-offset
+ 167   var f-name-ah/ecx: (addr handle array byte) <- get f-value, name
+ 168   var f-name/eax: (addr array byte) <- lookup *f-name-ah
+ 169   {
+ 170     var add?/eax: boolean <- string-equal? f-name, "+"
+ 171     compare add?, 0/false
+ 172     break-if-=
+ 173     apply-add args-ah, out, trace
+ 174     return
+ 175   }
+ 176   {
+ 177     var subtract?/eax: boolean <- string-equal? f-name, "-"
+ 178     compare subtract?, 0/false
+ 179     break-if-=
+ 180     apply-subtract args-ah, out, trace
+ 181     return
+ 182   }
+ 183   {
+ 184     var multiply?/eax: boolean <- string-equal? f-name, "*"
+ 185     compare multiply?, 0/false
+ 186     break-if-=
+ 187     apply-multiply args-ah, out, trace
+ 188     return
+ 189   }
+ 190   {
+ 191     var divide?/eax: boolean <- string-equal? f-name, "/"
+ 192     compare divide?, 0/false
+ 193     break-if-=
+ 194     apply-divide args-ah, out, trace
+ 195     return
+ 196   }
+ 197   # '%' is the remainder operator, because modulo isn't really meaningful for
+ 198   # non-integers
+ 199   #
+ 200   # I considered calling this operator 'rem', but I want to follow Arc in
+ 201   # using 'rem' for filtering out elements from lists.
+ 202   #   https://arclanguage.github.io/ref/list.html#rem
  203   {
- 204     var abs?/eax: boolean <- string-equal? f-name, "abs"
- 205     compare abs?, 0/false
+ 204     var remainder?/eax: boolean <- string-equal? f-name, "%"
+ 205     compare remainder?, 0/false
  206     break-if-=
- 207     apply-abs args-ah, out, trace
+ 207     apply-remainder args-ah, out, trace
  208     return
  209   }
  210   {
- 211     var sgn?/eax: boolean <- string-equal? f-name, "sgn"
- 212     compare sgn?, 0/false
+ 211     var square-root?/eax: boolean <- string-equal? f-name, "sqrt"
+ 212     compare square-root?, 0/false
  213     break-if-=
- 214     apply-sgn args-ah, out, trace
+ 214     apply-square-root args-ah, out, trace
  215     return
  216   }
  217   {
- 218     var car?/eax: boolean <- string-equal? f-name, "car"
- 219     compare car?, 0/false
+ 218     var abs?/eax: boolean <- string-equal? f-name, "abs"
+ 219     compare abs?, 0/false
  220     break-if-=
- 221     apply-car args-ah, out, trace
+ 221     apply-abs args-ah, out, trace
  222     return
  223   }
  224   {
- 225     var cdr?/eax: boolean <- string-equal? f-name, "cdr"
- 226     compare cdr?, 0/false
+ 225     var sgn?/eax: boolean <- string-equal? f-name, "sgn"
+ 226     compare sgn?, 0/false
  227     break-if-=
- 228     apply-cdr args-ah, out, trace
+ 228     apply-sgn args-ah, out, trace
  229     return
  230   }
  231   {
- 232     var cons?/eax: boolean <- string-equal? f-name, "cons"
- 233     compare cons?, 0/false
+ 232     var car?/eax: boolean <- string-equal? f-name, "car"
+ 233     compare car?, 0/false
  234     break-if-=
- 235     apply-cons args-ah, out, trace
+ 235     apply-car args-ah, out, trace
  236     return
  237   }
  238   {
- 239     var structurally-equal?/eax: boolean <- string-equal? f-name, "="
- 240     compare structurally-equal?, 0/false
+ 239     var cdr?/eax: boolean <- string-equal? f-name, "cdr"
+ 240     compare cdr?, 0/false
  241     break-if-=
- 242     apply-structurally-equal args-ah, out, trace
+ 242     apply-cdr args-ah, out, trace
  243     return
  244   }
  245   {
- 246     var not?/eax: boolean <- string-equal? f-name, "no"
- 247     compare not?, 0/false
+ 246     var cons?/eax: boolean <- string-equal? f-name, "cons"
+ 247     compare cons?, 0/false
  248     break-if-=
- 249     apply-not args-ah, out, trace
+ 249     apply-cons args-ah, out, trace
  250     return
  251   }
  252   {
- 253     var not?/eax: boolean <- string-equal? f-name, "not"
- 254     compare not?, 0/false
+ 253     var structurally-equal?/eax: boolean <- string-equal? f-name, "="
+ 254     compare structurally-equal?, 0/false
  255     break-if-=
- 256     apply-not args-ah, out, trace
+ 256     apply-structurally-equal args-ah, out, trace
  257     return
  258   }
  259   {
- 260     var debug?/eax: boolean <- string-equal? f-name, "dbg"
- 261     compare debug?, 0/false
+ 260     var not?/eax: boolean <- string-equal? f-name, "no"
+ 261     compare not?, 0/false
  262     break-if-=
- 263     apply-debug args-ah, out, trace
+ 263     apply-not args-ah, out, trace
  264     return
  265   }
  266   {
- 267     var lesser?/eax: boolean <- string-equal? f-name, "<"
- 268     compare lesser?, 0/false
+ 267     var not?/eax: boolean <- string-equal? f-name, "not"
+ 268     compare not?, 0/false
  269     break-if-=
- 270     apply-< args-ah, out, trace
+ 270     apply-not args-ah, out, trace
  271     return
  272   }
  273   {
- 274     var greater?/eax: boolean <- string-equal? f-name, ">"
- 275     compare greater?, 0/false
+ 274     var debug?/eax: boolean <- string-equal? f-name, "dbg"
+ 275     compare debug?, 0/false
  276     break-if-=
- 277     apply-> args-ah, out, trace
+ 277     apply-debug args-ah, out, trace
  278     return
  279   }
  280   {
- 281     var lesser-or-equal?/eax: boolean <- string-equal? f-name, "<="
- 282     compare lesser-or-equal?, 0/false
+ 281     var lesser?/eax: boolean <- string-equal? f-name, "<"
+ 282     compare lesser?, 0/false
  283     break-if-=
- 284     apply-<= args-ah, out, trace
+ 284     apply-< args-ah, out, trace
  285     return
  286   }
  287   {
- 288     var greater-or-equal?/eax: boolean <- string-equal? f-name, ">="
- 289     compare greater-or-equal?, 0/false
+ 288     var greater?/eax: boolean <- string-equal? f-name, ">"
+ 289     compare greater?, 0/false
  290     break-if-=
- 291     apply->= args-ah, out, trace
+ 291     apply-> args-ah, out, trace
  292     return
  293   }
  294   {
- 295     var print?/eax: boolean <- string-equal? f-name, "print"
- 296     compare print?, 0/false
+ 295     var lesser-or-equal?/eax: boolean <- string-equal? f-name, "<="
+ 296     compare lesser-or-equal?, 0/false
  297     break-if-=
- 298     apply-print args-ah, out, trace
+ 298     apply-<= args-ah, out, trace
  299     return
  300   }
  301   {
- 302     var clear?/eax: boolean <- string-equal? f-name, "clear"
- 303     compare clear?, 0/false
+ 302     var greater-or-equal?/eax: boolean <- string-equal? f-name, ">="
+ 303     compare greater-or-equal?, 0/false
  304     break-if-=
- 305     apply-clear args-ah, out, trace
+ 305     apply->= args-ah, out, trace
  306     return
  307   }
  308   {
- 309     var lines?/eax: boolean <- string-equal? f-name, "lines"
- 310     compare lines?, 0/false
+ 309     var print?/eax: boolean <- string-equal? f-name, "print"
+ 310     compare print?, 0/false
  311     break-if-=
- 312     apply-lines args-ah, out, trace
+ 312     apply-print args-ah, out, trace
  313     return
  314   }
  315   {
- 316     var columns?/eax: boolean <- string-equal? f-name, "columns"
- 317     compare columns?, 0/false
+ 316     var clear?/eax: boolean <- string-equal? f-name, "clear"
+ 317     compare clear?, 0/false
  318     break-if-=
- 319     apply-columns args-ah, out, trace
+ 319     apply-clear args-ah, out, trace
  320     return
  321   }
  322   {
- 323     var up?/eax: boolean <- string-equal? f-name, "up"
- 324     compare up?, 0/false
+ 323     var lines?/eax: boolean <- string-equal? f-name, "lines"
+ 324     compare lines?, 0/false
  325     break-if-=
- 326     apply-up args-ah, out, trace
+ 326     apply-lines args-ah, out, trace
  327     return
  328   }
  329   {
- 330     var down?/eax: boolean <- string-equal? f-name, "down"
- 331     compare down?, 0/false
+ 330     var columns?/eax: boolean <- string-equal? f-name, "columns"
+ 331     compare columns?, 0/false
  332     break-if-=
- 333     apply-down args-ah, out, trace
+ 333     apply-columns args-ah, out, trace
  334     return
  335   }
  336   {
- 337     var left?/eax: boolean <- string-equal? f-name, "left"
- 338     compare left?, 0/false
+ 337     var up?/eax: boolean <- string-equal? f-name, "up"
+ 338     compare up?, 0/false
  339     break-if-=
- 340     apply-left args-ah, out, trace
+ 340     apply-up args-ah, out, trace
  341     return
  342   }
  343   {
- 344     var right?/eax: boolean <- string-equal? f-name, "right"
- 345     compare right?, 0/false
+ 344     var down?/eax: boolean <- string-equal? f-name, "down"
+ 345     compare down?, 0/false
  346     break-if-=
- 347     apply-right args-ah, out, trace
+ 347     apply-down args-ah, out, trace
  348     return
  349   }
  350   {
- 351     var cr?/eax: boolean <- string-equal? f-name, "cr"
- 352     compare cr?, 0/false
+ 351     var left?/eax: boolean <- string-equal? f-name, "left"
+ 352     compare left?, 0/false
  353     break-if-=
- 354     apply-cr args-ah, out, trace
+ 354     apply-left args-ah, out, trace
  355     return
  356   }
  357   {
- 358     var pixel?/eax: boolean <- string-equal? f-name, "pixel"
- 359     compare pixel?, 0/false
+ 358     var right?/eax: boolean <- string-equal? f-name, "right"
+ 359     compare right?, 0/false
  360     break-if-=
- 361     apply-pixel args-ah, out, trace
+ 361     apply-right args-ah, out, trace
  362     return
  363   }
  364   {
- 365     var width?/eax: boolean <- string-equal? f-name, "width"
- 366     compare width?, 0/false
+ 365     var cr?/eax: boolean <- string-equal? f-name, "cr"
+ 366     compare cr?, 0/false
  367     break-if-=
- 368     apply-width args-ah, out, trace
+ 368     apply-cr args-ah, out, trace
  369     return
  370   }
  371   {
- 372     var height?/eax: boolean <- string-equal? f-name, "height"
- 373     compare height?, 0/false
+ 372     var pixel?/eax: boolean <- string-equal? f-name, "pixel"
+ 373     compare pixel?, 0/false
  374     break-if-=
- 375     apply-height args-ah, out, trace
+ 375     apply-pixel args-ah, out, trace
  376     return
  377   }
  378   {
- 379     var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
- 380     compare wait-for-key?, 0/false
+ 379     var width?/eax: boolean <- string-equal? f-name, "width"
+ 380     compare width?, 0/false
  381     break-if-=
- 382     apply-wait-for-key args-ah, out, trace
+ 382     apply-width args-ah, out, trace
  383     return
  384   }
  385   {
- 386     var stream?/eax: boolean <- string-equal? f-name, "stream"
- 387     compare stream?, 0/false
+ 386     var height?/eax: boolean <- string-equal? f-name, "height"
+ 387     compare height?, 0/false
  388     break-if-=
- 389     apply-stream args-ah, out, trace
+ 389     apply-height args-ah, out, trace
  390     return
  391   }
  392   {
- 393     var write?/eax: boolean <- string-equal? f-name, "write"
- 394     compare write?, 0/false
+ 393     var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
+ 394     compare wait-for-key?, 0/false
  395     break-if-=
- 396     apply-write args-ah, out, trace
+ 396     apply-wait-for-key args-ah, out, trace
  397     return
  398   }
  399   {
- 400     var abort?/eax: boolean <- string-equal? f-name, "abort"
- 401     compare abort?, 0/false
+ 400     var stream?/eax: boolean <- string-equal? f-name, "stream"
+ 401     compare stream?, 0/false
  402     break-if-=
- 403     apply-abort args-ah, out, trace
+ 403     apply-stream args-ah, out, trace
  404     return
  405   }
- 406   abort "unknown primitive function"
- 407 }
- 408 
- 409 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 410   trace-text trace, "eval", "apply +"
- 411   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 412   var _args/eax: (addr cell) <- lookup *args-ah
- 413   var args/esi: (addr cell) <- copy _args
- 414   # TODO: check that args is a pair
- 415   var empty-args?/eax: boolean <- nil? args
- 416   compare empty-args?, 0/false
- 417   {
- 418     break-if-=
- 419     error trace, "+ needs 2 args but got 0"
- 420     return
- 421   }
- 422   # args->left->value
- 423   var first-ah/eax: (addr handle cell) <- get args, left
- 424   var first/eax: (addr cell) <- lookup *first-ah
- 425   var first-type/ecx: (addr int) <- get first, type
- 426   compare *first-type, 1/number
- 427   {
- 428     break-if-=
- 429     error trace, "first arg for + is not a number"
- 430     return
- 431   }
- 432   var first-value/ecx: (addr float) <- get first, number-data
- 433   # args->right->left->value
- 434   var right-ah/eax: (addr handle cell) <- get args, right
- 435 #?   dump-cell right-ah
- 436 #?   abort "aaa"
- 437   var right/eax: (addr cell) <- lookup *right-ah
- 438   # TODO: check that right is a pair
- 439   var second-ah/eax: (addr handle cell) <- get right, left
- 440   var second/eax: (addr cell) <- lookup *second-ah
- 441   var second-type/edx: (addr int) <- get second, type
- 442   compare *second-type, 1/number
- 443   {
- 444     break-if-=
- 445     error trace, "second arg for + is not a number"
- 446     return
- 447   }
- 448   var second-value/edx: (addr float) <- get second, number-data
- 449   # add
- 450   var result/xmm0: float <- copy *first-value
- 451   result <- add *second-value
- 452   new-float out, result
- 453 }
- 454 
- 455 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 456   trace-text trace, "eval", "apply -"
- 457   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 458   var _args/eax: (addr cell) <- lookup *args-ah
- 459   var args/esi: (addr cell) <- copy _args
- 460   # TODO: check that args is a pair
- 461   var empty-args?/eax: boolean <- nil? args
- 462   compare empty-args?, 0/false
+ 406   {
+ 407     var write?/eax: boolean <- string-equal? f-name, "write"
+ 408     compare write?, 0/false
+ 409     break-if-=
+ 410     apply-write args-ah, out, trace
+ 411     return
+ 412   }
+ 413   {
+ 414     var abort?/eax: boolean <- string-equal? f-name, "abort"
+ 415     compare abort?, 0/false
+ 416     break-if-=
+ 417     apply-abort args-ah, out, trace
+ 418     return
+ 419   }
+ 420   abort "unknown primitive function"
+ 421 }
+ 422 
+ 423 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 424   trace-text trace, "eval", "apply +"
+ 425   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 426   var _args/eax: (addr cell) <- lookup *args-ah
+ 427   var args/esi: (addr cell) <- copy _args
+ 428   {
+ 429     var args-type/ecx: (addr int) <- get args, type
+ 430     compare *args-type, 0/pair
+ 431     break-if-=
+ 432     error trace, "args to + are not a list"
+ 433     return
+ 434   }
+ 435   var empty-args?/eax: boolean <- nil? args
+ 436   compare empty-args?, 0/false
+ 437   {
+ 438     break-if-=
+ 439     error trace, "+ needs 2 args but got 0"
+ 440     return
+ 441   }
+ 442   # args->left->value
+ 443   var first-ah/eax: (addr handle cell) <- get args, left
+ 444   var first/eax: (addr cell) <- lookup *first-ah
+ 445   var first-type/ecx: (addr int) <- get first, type
+ 446   compare *first-type, 1/number
+ 447   {
+ 448     break-if-=
+ 449     error trace, "first arg for + is not a number"
+ 450     return
+ 451   }
+ 452   var first-value/ecx: (addr float) <- get first, number-data
+ 453   # args->right->left->value
+ 454   var right-ah/eax: (addr handle cell) <- get args, right
+ 455   var right/eax: (addr cell) <- lookup *right-ah
+ 456   {
+ 457     var right-type/ecx: (addr int) <- get right, type
+ 458     compare *right-type, 0/pair
+ 459     break-if-=
+ 460     error trace, "+ encountered non-pair"
+ 461     return
+ 462   }
  463   {
- 464     break-if-=
- 465     error trace, "- needs 2 args but got 0"
- 466     return
- 467   }
- 468   # args->left->value
- 469   var first-ah/eax: (addr handle cell) <- get args, left
- 470   var first/eax: (addr cell) <- lookup *first-ah
- 471   var first-type/ecx: (addr int) <- get first, type
- 472   compare *first-type, 1/number
- 473   {
- 474     break-if-=
- 475     error trace, "first arg for - is not a number"
- 476     return
- 477   }
- 478   var first-value/ecx: (addr float) <- get first, number-data
- 479   # args->right->left->value
- 480   var right-ah/eax: (addr handle cell) <- get args, right
- 481   var right/eax: (addr cell) <- lookup *right-ah
- 482   # TODO: check that right is a pair
- 483   var second-ah/eax: (addr handle cell) <- get right, left
- 484   var second/eax: (addr cell) <- lookup *second-ah
- 485   var second-type/edx: (addr int) <- get second, type
- 486   compare *second-type, 1/number
- 487   {
- 488     break-if-=
- 489     error trace, "second arg for - is not a number"
- 490     return
- 491   }
- 492   var second-value/edx: (addr float) <- get second, number-data
- 493   # subtract
- 494   var result/xmm0: float <- copy *first-value
- 495   result <- subtract *second-value
- 496   new-float out, result
- 497 }
- 498 
- 499 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 500   trace-text trace, "eval", "apply *"
- 501   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 502   var _args/eax: (addr cell) <- lookup *args-ah
- 503   var args/esi: (addr cell) <- copy _args
- 504   # TODO: check that args is a pair
- 505   var empty-args?/eax: boolean <- nil? args
- 506   compare empty-args?, 0/false
- 507   {
- 508     break-if-=
- 509     error trace, "* needs 2 args but got 0"
- 510     return
- 511   }
- 512   # args->left->value
- 513   var first-ah/eax: (addr handle cell) <- get args, left
- 514   var first/eax: (addr cell) <- lookup *first-ah
- 515   var first-type/ecx: (addr int) <- get first, type
- 516   compare *first-type, 1/number
- 517   {
- 518     break-if-=
- 519     error trace, "first arg for * is not a number"
- 520     return
- 521   }
- 522   var first-value/ecx: (addr float) <- get first, number-data
- 523   # args->right->left->value
- 524   var right-ah/eax: (addr handle cell) <- get args, right
- 525   var right/eax: (addr cell) <- lookup *right-ah
- 526   # TODO: check that right is a pair
- 527   var second-ah/eax: (addr handle cell) <- get right, left
- 528   var second/eax: (addr cell) <- lookup *second-ah
- 529   var second-type/edx: (addr int) <- get second, type
- 530   compare *second-type, 1/number
- 531   {
- 532     break-if-=
- 533     error trace, "second arg for * is not a number"
- 534     return
- 535   }
- 536   var second-value/edx: (addr float) <- get second, number-data
- 537   # multiply
- 538   var result/xmm0: float <- copy *first-value
- 539   result <- multiply *second-value
- 540   new-float out, result
- 541 }
- 542 
- 543 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 544   trace-text trace, "eval", "apply /"
- 545   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 546   var _args/eax: (addr cell) <- lookup *args-ah
- 547   var args/esi: (addr cell) <- copy _args
- 548   # TODO: check that args is a pair
- 549   var empty-args?/eax: boolean <- nil? args
- 550   compare empty-args?, 0/false
- 551   {
- 552     break-if-=
- 553     error trace, "/ needs 2 args but got 0"
- 554     return
- 555   }
- 556   # args->left->value
- 557   var first-ah/eax: (addr handle cell) <- get args, left
- 558   var first/eax: (addr cell) <- lookup *first-ah
- 559   var first-type/ecx: (addr int) <- get first, type
- 560   compare *first-type, 1/number
- 561   {
- 562     break-if-=
- 563     error trace, "first arg for / is not a number"
- 564     return
- 565   }
- 566   var first-value/ecx: (addr float) <- get first, number-data
- 567   # args->right->left->value
- 568   var right-ah/eax: (addr handle cell) <- get args, right
- 569   var right/eax: (addr cell) <- lookup *right-ah
- 570   # TODO: check that right is a pair
- 571   var second-ah/eax: (addr handle cell) <- get right, left
- 572   var second/eax: (addr cell) <- lookup *second-ah
- 573   var second-type/edx: (addr int) <- get second, type
- 574   compare *second-type, 1/number
- 575   {
- 576     break-if-=
- 577     error trace, "second arg for / is not a number"
- 578     return
- 579   }
- 580   var second-value/edx: (addr float) <- get second, number-data
- 581   # divide
- 582   var result/xmm0: float <- copy *first-value
- 583   result <- divide *second-value
- 584   new-float out, result
- 585 }
- 586 
- 587 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 588   trace-text trace, "eval", "apply sqrt"
- 589   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 590   var _args/eax: (addr cell) <- lookup *args-ah
- 591   var args/esi: (addr cell) <- copy _args
- 592   # TODO: check that args is a pair
- 593   var empty-args?/eax: boolean <- nil? args
- 594   compare empty-args?, 0/false
- 595   {
- 596     break-if-=
- 597     error trace, "sqrt needs 1 arg but got 0"
- 598     return
- 599   }
- 600   # args->left->value
- 601   var first-ah/eax: (addr handle cell) <- get args, left
- 602   var first/eax: (addr cell) <- lookup *first-ah
- 603   var first-type/ecx: (addr int) <- get first, type
- 604   compare *first-type, 1/number
- 605   {
- 606     break-if-=
- 607     error trace, "arg for sqrt is not a number"
- 608     return
- 609   }
- 610   var first-value/ecx: (addr float) <- get first, number-data
- 611   # square-root
- 612   var result/xmm0: float <- square-root *first-value
- 613   new-float out, result
- 614 }
- 615 
- 616 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 617   trace-text trace, "eval", "apply abs"
- 618   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 619   var _args/eax: (addr cell) <- lookup *args-ah
- 620   var args/esi: (addr cell) <- copy _args
- 621   # TODO: check that args is a pair
- 622   var empty-args?/eax: boolean <- nil? args
- 623   compare empty-args?, 0/false
- 624   {
- 625     break-if-=
- 626     error trace, "abs needs 1 arg but got 0"
- 627     return
- 628   }
- 629   # args->left->value
- 630   var first-ah/eax: (addr handle cell) <- get args, left
- 631   var first/eax: (addr cell) <- lookup *first-ah
- 632   var first-type/ecx: (addr int) <- get first, type
- 633   compare *first-type, 1/number
- 634   {
- 635     break-if-=
- 636     error trace, "arg for abs is not a number"
- 637     return
- 638   }
- 639   var first-value/ecx: (addr float) <- get first, number-data
- 640   #
- 641   var result/xmm0: float <- copy *first-value
- 642   var zero: float
- 643   compare result, zero
- 644   {
- 645     break-if-float>=
- 646     var neg1/eax: int <- copy -1
- 647     var neg1-f/xmm1: float <- convert neg1
- 648     result <- multiply neg1-f
- 649   }
- 650   new-float out, result
- 651 }
- 652 
- 653 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 654   trace-text trace, "eval", "apply sgn"
- 655   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 656   var _args/eax: (addr cell) <- lookup *args-ah
- 657   var args/esi: (addr cell) <- copy _args
- 658   # TODO: check that args is a pair
- 659   var empty-args?/eax: boolean <- nil? args
- 660   compare empty-args?, 0/false
- 661   {
- 662     break-if-=
- 663     error trace, "sgn needs 1 arg but got 0"
- 664     return
- 665   }
- 666   # args->left->value
- 667   var first-ah/eax: (addr handle cell) <- get args, left
- 668   var first/eax: (addr cell) <- lookup *first-ah
- 669   var first-type/ecx: (addr int) <- get first, type
- 670   compare *first-type, 1/number
- 671   {
- 672     break-if-=
- 673     error trace, "arg for sgn is not a number"
- 674     return
- 675   }
- 676   var first-value/ecx: (addr float) <- get first, number-data
- 677   #
- 678   var result/xmm0: float <- copy *first-value
- 679   var zero: float
- 680   $apply-sgn:core: {
- 681     compare result, zero
- 682     break-if-=
- 683     {
- 684       break-if-float>
- 685       var neg1/eax: int <- copy -1
- 686       result <- convert neg1
- 687       break $apply-sgn:core
- 688     }
- 689     {
- 690       break-if-float<
- 691       var one/eax: int <- copy 1
- 692       result <- convert one
- 693       break $apply-sgn:core
- 694     }
- 695   }
- 696   new-float out, result
- 697 }
- 698 
- 699 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 700   trace-text trace, "eval", "apply car"
- 701   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 702   var _args/eax: (addr cell) <- lookup *args-ah
- 703   var args/esi: (addr cell) <- copy _args
- 704   # TODO: check that args is a pair
- 705   var empty-args?/eax: boolean <- nil? args
- 706   compare empty-args?, 0/false
- 707   {
- 708     break-if-=
- 709     error trace, "car needs 1 arg but got 0"
- 710     return
- 711   }
- 712   # args->left
- 713   var first-ah/eax: (addr handle cell) <- get args, left
- 714   var first/eax: (addr cell) <- lookup *first-ah
- 715   var first-type/ecx: (addr int) <- get first, type
- 716   compare *first-type, 0/pair
- 717   {
- 718     break-if-=
- 719     error trace, "arg for car is not a pair"
- 720     return
- 721   }
- 722   # car
- 723   var result/eax: (addr handle cell) <- get first, left
- 724   copy-object result, out
- 725 }
- 726 
- 727 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 728   trace-text trace, "eval", "apply cdr"
- 729   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 730   var _args/eax: (addr cell) <- lookup *args-ah
- 731   var args/esi: (addr cell) <- copy _args
- 732   # TODO: check that args is a pair
- 733   var empty-args?/eax: boolean <- nil? args
- 734   compare empty-args?, 0/false
- 735   {
- 736     break-if-=
- 737     error trace, "cdr needs 1 arg but got 0"
- 738     return
- 739   }
- 740   # args->left
- 741   var first-ah/eax: (addr handle cell) <- get args, left
- 742   var first/eax: (addr cell) <- lookup *first-ah
- 743   var first-type/ecx: (addr int) <- get first, type
- 744   compare *first-type, 0/pair
- 745   {
- 746     break-if-=
- 747     error trace, "arg for cdr is not a pair"
- 748     return
- 749   }
- 750   # cdr
- 751   var result/eax: (addr handle cell) <- get first, right
- 752   copy-object result, out
- 753 }
- 754 
- 755 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 756   trace-text trace, "eval", "apply cons"
- 757   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 758   var _args/eax: (addr cell) <- lookup *args-ah
- 759   var args/esi: (addr cell) <- copy _args
- 760   # TODO: check that args is a pair
- 761   var empty-args?/eax: boolean <- nil? args
- 762   compare empty-args?, 0/false
- 763   {
- 764     break-if-=
- 765     error trace, "cons needs 2 args but got 0"
- 766     return
- 767   }
- 768   # args->left
- 769   var first-ah/ecx: (addr handle cell) <- get args, left
- 770   # args->right->left
- 771   var right-ah/eax: (addr handle cell) <- get args, right
- 772   var right/eax: (addr cell) <- lookup *right-ah
- 773   # TODO: check that right is a pair
- 774   var second-ah/eax: (addr handle cell) <- get right, left
- 775   # cons
- 776   new-pair out, *first-ah, *second-ah
- 777 }
- 778 
- 779 fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 780   trace-text trace, "eval", "apply '='"
- 781   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 782   var _args/eax: (addr cell) <- lookup *args-ah
- 783   var args/esi: (addr cell) <- copy _args
- 784   # TODO: check that args is a pair
+ 464     var nil?/eax: boolean <- nil? right
+ 465     compare nil?, 0/false
+ 466     break-if-=
+ 467     error trace, "+ needs 2 args but got 1"
+ 468     return
+ 469   }
+ 470   var second-ah/eax: (addr handle cell) <- get right, left
+ 471   var second/eax: (addr cell) <- lookup *second-ah
+ 472   var second-type/edx: (addr int) <- get second, type
+ 473   compare *second-type, 1/number
+ 474   {
+ 475     break-if-=
+ 476     error trace, "second arg for + is not a number"
+ 477     return
+ 478   }
+ 479   var second-value/edx: (addr float) <- get second, number-data
+ 480   # add
+ 481   var result/xmm0: float <- copy *first-value
+ 482   result <- add *second-value
+ 483   new-float out, result
+ 484 }
+ 485 
+ 486 fn test-evaluate-missing-arg-in-add {
+ 487   var t-storage: trace
+ 488   var t/edi: (addr trace) <- address t-storage
+ 489   initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible  # we don't use trace UI
+ 490   #
+ 491   var nil-storage: (handle cell)
+ 492   var nil-ah/ecx: (addr handle cell) <- address nil-storage
+ 493   allocate-pair nil-ah
+ 494   var one-storage: (handle cell)
+ 495   var one-ah/edx: (addr handle cell) <- address one-storage
+ 496   new-integer one-ah, 1
+ 497   var add-storage: (handle cell)
+ 498   var add-ah/ebx: (addr handle cell) <- address add-storage
+ 499   new-symbol add-ah, "+"
+ 500   # input is (+ 1)
+ 501   var tmp-storage: (handle cell)
+ 502   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
+ 503   new-pair tmp-ah, *one-ah, *nil-ah
+ 504   new-pair tmp-ah, *add-ah, *tmp-ah
+ 505 #?   dump-cell tmp-ah
+ 506   #
+ 507   var globals-storage: global-table
+ 508   var globals/edx: (addr global-table) <- address globals-storage
+ 509   initialize-globals globals
+ 510   #
+ 511   evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
+ 512   # no crash
+ 513 }
+ 514 
+ 515 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 516   trace-text trace, "eval", "apply -"
+ 517   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 518   var _args/eax: (addr cell) <- lookup *args-ah
+ 519   var args/esi: (addr cell) <- copy _args
+ 520   {
+ 521     var args-type/ecx: (addr int) <- get args, type
+ 522     compare *args-type, 0/pair
+ 523     break-if-=
+ 524     error trace, "args to - are not a list"
+ 525     return
+ 526   }
+ 527   var empty-args?/eax: boolean <- nil? args
+ 528   compare empty-args?, 0/false
+ 529   {
+ 530     break-if-=
+ 531     error trace, "- needs 2 args but got 0"
+ 532     return
+ 533   }
+ 534   # args->left->value
+ 535   var first-ah/eax: (addr handle cell) <- get args, left
+ 536   var first/eax: (addr cell) <- lookup *first-ah
+ 537   var first-type/ecx: (addr int) <- get first, type
+ 538   compare *first-type, 1/number
+ 539   {
+ 540     break-if-=
+ 541     error trace, "first arg for - is not a number"
+ 542     return
+ 543   }
+ 544   var first-value/ecx: (addr float) <- get first, number-data
+ 545   # args->right->left->value
+ 546   var right-ah/eax: (addr handle cell) <- get args, right
+ 547   var right/eax: (addr cell) <- lookup *right-ah
+ 548   {
+ 549     var right-type/ecx: (addr int) <- get right, type
+ 550     compare *right-type, 0/pair
+ 551     break-if-=
+ 552     error trace, "- encountered non-pair"
+ 553     return
+ 554   }
+ 555   {
+ 556     var nil?/eax: boolean <- nil? right
+ 557     compare nil?, 0/false
+ 558     break-if-=
+ 559     error trace, "- needs 2 args but got 1"
+ 560     return
+ 561   }
+ 562   var second-ah/eax: (addr handle cell) <- get right, left
+ 563   var second/eax: (addr cell) <- lookup *second-ah
+ 564   var second-type/edx: (addr int) <- get second, type
+ 565   compare *second-type, 1/number
+ 566   {
+ 567     break-if-=
+ 568     error trace, "second arg for - is not a number"
+ 569     return
+ 570   }
+ 571   var second-value/edx: (addr float) <- get second, number-data
+ 572   # subtract
+ 573   var result/xmm0: float <- copy *first-value
+ 574   result <- subtract *second-value
+ 575   new-float out, result
+ 576 }
+ 577 
+ 578 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 579   trace-text trace, "eval", "apply *"
+ 580   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 581   var _args/eax: (addr cell) <- lookup *args-ah
+ 582   var args/esi: (addr cell) <- copy _args
+ 583   {
+ 584     var args-type/ecx: (addr int) <- get args, type
+ 585     compare *args-type, 0/pair
+ 586     break-if-=
+ 587     error trace, "args to * are not a list"
+ 588     return
+ 589   }
+ 590   var empty-args?/eax: boolean <- nil? args
+ 591   compare empty-args?, 0/false
+ 592   {
+ 593     break-if-=
+ 594     error trace, "* needs 2 args but got 0"
+ 595     return
+ 596   }
+ 597   # args->left->value
+ 598   var first-ah/eax: (addr handle cell) <- get args, left
+ 599   var first/eax: (addr cell) <- lookup *first-ah
+ 600   var first-type/ecx: (addr int) <- get first, type
+ 601   compare *first-type, 1/number
+ 602   {
+ 603     break-if-=
+ 604     error trace, "first arg for * is not a number"
+ 605     return
+ 606   }
+ 607   var first-value/ecx: (addr float) <- get first, number-data
+ 608   # args->right->left->value
+ 609   var right-ah/eax: (addr handle cell) <- get args, right
+ 610   var right/eax: (addr cell) <- lookup *right-ah
+ 611   {
+ 612     var right-type/ecx: (addr int) <- get right, type
+ 613     compare *right-type, 0/pair
+ 614     break-if-=
+ 615     error trace, "* encountered non-pair"
+ 616     return
+ 617   }
+ 618   {
+ 619     var nil?/eax: boolean <- nil? right
+ 620     compare nil?, 0/false
+ 621     break-if-=
+ 622     error trace, "* needs 2 args but got 1"
+ 623     return
+ 624   }
+ 625   var second-ah/eax: (addr handle cell) <- get right, left
+ 626   var second/eax: (addr cell) <- lookup *second-ah
+ 627   var second-type/edx: (addr int) <- get second, type
+ 628   compare *second-type, 1/number
+ 629   {
+ 630     break-if-=
+ 631     error trace, "second arg for * is not a number"
+ 632     return
+ 633   }
+ 634   var second-value/edx: (addr float) <- get second, number-data
+ 635   # multiply
+ 636   var result/xmm0: float <- copy *first-value
+ 637   result <- multiply *second-value
+ 638   new-float out, result
+ 639 }
+ 640 
+ 641 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 642   trace-text trace, "eval", "apply /"
+ 643   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 644   var _args/eax: (addr cell) <- lookup *args-ah
+ 645   var args/esi: (addr cell) <- copy _args
+ 646   {
+ 647     var args-type/ecx: (addr int) <- get args, type
+ 648     compare *args-type, 0/pair
+ 649     break-if-=
+ 650     error trace, "args to / are not a list"
+ 651     return
+ 652   }
+ 653   var empty-args?/eax: boolean <- nil? args
+ 654   compare empty-args?, 0/false
+ 655   {
+ 656     break-if-=
+ 657     error trace, "/ needs 2 args but got 0"
+ 658     return
+ 659   }
+ 660   # args->left->value
+ 661   var first-ah/eax: (addr handle cell) <- get args, left
+ 662   var first/eax: (addr cell) <- lookup *first-ah
+ 663   var first-type/ecx: (addr int) <- get first, type
+ 664   compare *first-type, 1/number
+ 665   {
+ 666     break-if-=
+ 667     error trace, "first arg for / is not a number"
+ 668     return
+ 669   }
+ 670   var first-value/ecx: (addr float) <- get first, number-data
+ 671   # args->right->left->value
+ 672   var right-ah/eax: (addr handle cell) <- get args, right
+ 673   var right/eax: (addr cell) <- lookup *right-ah
+ 674   {
+ 675     var right-type/ecx: (addr int) <- get right, type
+ 676     compare *right-type, 0/pair
+ 677     break-if-=
+ 678     error trace, "/ encountered non-pair"
+ 679     return
+ 680   }
+ 681   {
+ 682     var nil?/eax: boolean <- nil? right
+ 683     compare nil?, 0/false
+ 684     break-if-=
+ 685     error trace, "/ needs 2 args but got 1"
+ 686     return
+ 687   }
+ 688   var second-ah/eax: (addr handle cell) <- get right, left
+ 689   var second/eax: (addr cell) <- lookup *second-ah
+ 690   var second-type/edx: (addr int) <- get second, type
+ 691   compare *second-type, 1/number
+ 692   {
+ 693     break-if-=
+ 694     error trace, "second arg for / is not a number"
+ 695     return
+ 696   }
+ 697   var second-value/edx: (addr float) <- get second, number-data
+ 698   # divide
+ 699   var result/xmm0: float <- copy *first-value
+ 700   result <- divide *second-value
+ 701   new-float out, result
+ 702 }
+ 703 
+ 704 fn apply-remainder _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 705   trace-text trace, "eval", "apply %"
+ 706   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 707   var _args/eax: (addr cell) <- lookup *args-ah
+ 708   var args/esi: (addr cell) <- copy _args
+ 709   {
+ 710     var args-type/ecx: (addr int) <- get args, type
+ 711     compare *args-type, 0/pair
+ 712     break-if-=
+ 713     error trace, "args to % are not a list"
+ 714     return
+ 715   }
+ 716   var empty-args?/eax: boolean <- nil? args
+ 717   compare empty-args?, 0/false
+ 718   {
+ 719     break-if-=
+ 720     error trace, "% needs 2 args but got 0"
+ 721     return
+ 722   }
+ 723   # args->left->value
+ 724   var first-ah/eax: (addr handle cell) <- get args, left
+ 725   var first/eax: (addr cell) <- lookup *first-ah
+ 726   var first-type/ecx: (addr int) <- get first, type
+ 727   compare *first-type, 1/number
+ 728   {
+ 729     break-if-=
+ 730     error trace, "first arg for % is not a number"
+ 731     return
+ 732   }
+ 733   var first-value/ecx: (addr float) <- get first, number-data
+ 734   # args->right->left->value
+ 735   var right-ah/eax: (addr handle cell) <- get args, right
+ 736   var right/eax: (addr cell) <- lookup *right-ah
+ 737   {
+ 738     var right-type/ecx: (addr int) <- get right, type
+ 739     compare *right-type, 0/pair
+ 740     break-if-=
+ 741     error trace, "% encountered non-pair"
+ 742     return
+ 743   }
+ 744   {
+ 745     var nil?/eax: boolean <- nil? right
+ 746     compare nil?, 0/false
+ 747     break-if-=
+ 748     error trace, "% needs 2 args but got 1"
+ 749     return
+ 750   }
+ 751   var second-ah/eax: (addr handle cell) <- get right, left
+ 752   var second/eax: (addr cell) <- lookup *second-ah
+ 753   var second-type/edx: (addr int) <- get second, type
+ 754   compare *second-type, 1/number
+ 755   {
+ 756     break-if-=
+ 757     error trace, "second arg for % is not a number"
+ 758     return
+ 759   }
+ 760   var second-value/edx: (addr float) <- get second, number-data
+ 761   # divide
+ 762   var quotient/xmm0: float <- copy *first-value
+ 763   quotient <- divide *second-value
+ 764   var quotient-int/eax: int <- truncate quotient
+ 765   quotient <- convert quotient-int
+ 766   var sub-result/xmm1: float <- copy quotient
+ 767   sub-result <- multiply *second-value
+ 768   var result/xmm0: float <- copy *first-value
+ 769   result <- subtract sub-result
+ 770   new-float out, result
+ 771 }
+ 772 
+ 773 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 774   trace-text trace, "eval", "apply sqrt"
+ 775   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 776   var _args/eax: (addr cell) <- lookup *args-ah
+ 777   var args/esi: (addr cell) <- copy _args
+ 778   {
+ 779     var args-type/ecx: (addr int) <- get args, type
+ 780     compare *args-type, 0/pair
+ 781     break-if-=
+ 782     error trace, "args to sqrt are not a list"
+ 783     return
+ 784   }
  785   var empty-args?/eax: boolean <- nil? args
  786   compare empty-args?, 0/false
  787   {
  788     break-if-=
- 789     error trace, "'=' needs 2 args but got 0"
+ 789     error trace, "sqrt needs 1 arg but got 0"
  790     return
  791   }
- 792   # args->left
- 793   var first-ah/ecx: (addr handle cell) <- get args, left
- 794   # args->right->left
- 795   var right-ah/eax: (addr handle cell) <- get args, right
- 796   var right/eax: (addr cell) <- lookup *right-ah
- 797   # TODO: check that right is a pair
- 798   var second-ah/edx: (addr handle cell) <- get right, left
- 799   # compare
- 800   var _first/eax: (addr cell) <- lookup *first-ah
- 801   var first/ecx: (addr cell) <- copy _first
- 802   var second/eax: (addr cell) <- lookup *second-ah
- 803   var match?/eax: boolean <- cell-isomorphic? first, second, trace
- 804   compare match?, 0/false
- 805   {
- 806     break-if-!=
- 807     nil out
- 808     return
- 809   }
- 810   new-integer out, 1/true
- 811 }
- 812 
- 813 fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 814   trace-text trace, "eval", "apply not"
- 815   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 816   var _args/eax: (addr cell) <- lookup *args-ah
- 817   var args/esi: (addr cell) <- copy _args
- 818   # TODO: check that args is a pair
- 819   var empty-args?/eax: boolean <- nil? args
- 820   compare empty-args?, 0/false
- 821   {
- 822     break-if-=
- 823     error trace, "not needs 1 arg but got 0"
- 824     return
- 825   }
- 826   # args->left
- 827   var first-ah/eax: (addr handle cell) <- get args, left
- 828   var first/eax: (addr cell) <- lookup *first-ah
- 829   # not
- 830   var nil?/eax: boolean <- nil? first
- 831   compare nil?, 0/false
+ 792   # args->left->value
+ 793   var first-ah/eax: (addr handle cell) <- get args, left
+ 794   var first/eax: (addr cell) <- lookup *first-ah
+ 795   var first-type/ecx: (addr int) <- get first, type
+ 796   compare *first-type, 1/number
+ 797   {
+ 798     break-if-=
+ 799     error trace, "arg for sqrt is not a number"
+ 800     return
+ 801   }
+ 802   var first-value/ecx: (addr float) <- get first, number-data
+ 803   # square-root
+ 804   var result/xmm0: float <- square-root *first-value
+ 805   new-float out, result
+ 806 }
+ 807 
+ 808 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 809   trace-text trace, "eval", "apply abs"
+ 810   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 811   var _args/eax: (addr cell) <- lookup *args-ah
+ 812   var args/esi: (addr cell) <- copy _args
+ 813   {
+ 814     var args-type/ecx: (addr int) <- get args, type
+ 815     compare *args-type, 0/pair
+ 816     break-if-=
+ 817     error trace, "args to abs are not a list"
+ 818     return
+ 819   }
+ 820   var empty-args?/eax: boolean <- nil? args
+ 821   compare empty-args?, 0/false
+ 822   {
+ 823     break-if-=
+ 824     error trace, "abs needs 1 arg but got 0"
+ 825     return
+ 826   }
+ 827   # args->left->value
+ 828   var first-ah/eax: (addr handle cell) <- get args, left
+ 829   var first/eax: (addr cell) <- lookup *first-ah
+ 830   var first-type/ecx: (addr int) <- get first, type
+ 831   compare *first-type, 1/number
  832   {
- 833     break-if-!=
- 834     nil out
+ 833     break-if-=
+ 834     error trace, "arg for abs is not a number"
  835     return
  836   }
- 837   new-integer out, 1
- 838 }
- 839 
- 840 fn apply-debug _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 841   trace-text trace, "eval", "apply debug"
- 842   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 843   var _args/eax: (addr cell) <- lookup *args-ah
- 844   var args/esi: (addr cell) <- copy _args
- 845   # TODO: check that args is a pair
- 846   var empty-args?/eax: boolean <- nil? args
- 847   compare empty-args?, 0/false
- 848   {
- 849     break-if-=
- 850     error trace, "not needs 1 arg but got 0"
- 851     return
- 852   }
- 853   # dump args->left uglily to screen and wait for a keypress
- 854   var first-ah/eax: (addr handle cell) <- get args, left
- 855   dump-cell-from-cursor-over-full-screen first-ah
+ 837   var first-value/ecx: (addr float) <- get first, number-data
+ 838   #
+ 839   var result/xmm0: float <- copy *first-value
+ 840   var zero: float
+ 841   compare result, zero
+ 842   {
+ 843     break-if-float>=
+ 844     var neg1/eax: int <- copy -1
+ 845     var neg1-f/xmm1: float <- convert neg1
+ 846     result <- multiply neg1-f
+ 847   }
+ 848   new-float out, result
+ 849 }
+ 850 
+ 851 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 852   trace-text trace, "eval", "apply sgn"
+ 853   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 854   var _args/eax: (addr cell) <- lookup *args-ah
+ 855   var args/esi: (addr cell) <- copy _args
  856   {
- 857     var foo/eax: byte <- read-key 0/keyboard
- 858     compare foo, 0
- 859     loop-if-=
- 860   }
- 861   # return nothing
- 862 }
- 863 
- 864 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 865   trace-text trace, "eval", "apply '<'"
- 866   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 867   var _args/eax: (addr cell) <- lookup *args-ah
- 868   var args/esi: (addr cell) <- copy _args
- 869   # TODO: check that args is a pair
- 870   var empty-args?/eax: boolean <- nil? args
- 871   compare empty-args?, 0/false
- 872   {
- 873     break-if-=
- 874     error trace, "'<' needs 2 args but got 0"
- 875     return
- 876   }
- 877   # args->left
- 878   var first-ah/ecx: (addr handle cell) <- get args, left
- 879   # args->right->left
- 880   var right-ah/eax: (addr handle cell) <- get args, right
- 881   var right/eax: (addr cell) <- lookup *right-ah
- 882   # TODO: check that right is a pair
- 883   var second-ah/edx: (addr handle cell) <- get right, left
- 884   # compare
- 885   var _first/eax: (addr cell) <- lookup *first-ah
- 886   var first/ecx: (addr cell) <- copy _first
- 887   var first-type/eax: (addr int) <- get first, type
- 888   compare *first-type, 1/number
- 889   {
- 890     break-if-=
- 891     error trace, "first arg for '<' is not a number"
- 892     return
- 893   }
- 894   var first-value/ecx: (addr float) <- get first, number-data
- 895   var first-float/xmm0: float <- copy *first-value
- 896   var second/eax: (addr cell) <- lookup *second-ah
- 897   var second-type/edx: (addr int) <- get second, type
- 898   compare *second-type, 1/number
- 899   {
- 900     break-if-=
- 901     error trace, "first arg for '<' is not a number"
- 902     return
- 903   }
- 904   var second-value/eax: (addr float) <- get second, number-data
- 905   compare first-float, *second-value
- 906   {
- 907     break-if-float<
- 908     nil out
- 909     return
- 910   }
- 911   new-integer out, 1/true
- 912 }
- 913 
- 914 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 915   trace-text trace, "eval", "apply '>'"
- 916   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 917   var _args/eax: (addr cell) <- lookup *args-ah
- 918   var args/esi: (addr cell) <- copy _args
- 919   # TODO: check that args is a pair
- 920   var empty-args?/eax: boolean <- nil? args
- 921   compare empty-args?, 0/false
- 922   {
- 923     break-if-=
- 924     error trace, "'>' needs 2 args but got 0"
- 925     return
- 926   }
- 927   # args->left
- 928   var first-ah/ecx: (addr handle cell) <- get args, left
- 929   # args->right->left
- 930   var right-ah/eax: (addr handle cell) <- get args, right
- 931   var right/eax: (addr cell) <- lookup *right-ah
- 932   # TODO: check that right is a pair
- 933   var second-ah/edx: (addr handle cell) <- get right, left
- 934   # compare
- 935   var _first/eax: (addr cell) <- lookup *first-ah
- 936   var first/ecx: (addr cell) <- copy _first
- 937   var first-type/eax: (addr int) <- get first, type
- 938   compare *first-type, 1/number
- 939   {
- 940     break-if-=
- 941     error trace, "first arg for '>' is not a number"
- 942     return
- 943   }
- 944   var first-value/ecx: (addr float) <- get first, number-data
- 945   var first-float/xmm0: float <- copy *first-value
- 946   var second/eax: (addr cell) <- lookup *second-ah
- 947   var second-type/edx: (addr int) <- get second, type
- 948   compare *second-type, 1/number
- 949   {
- 950     break-if-=
- 951     error trace, "first arg for '>' is not a number"
- 952     return
- 953   }
- 954   var second-value/eax: (addr float) <- get second, number-data
- 955   compare first-float, *second-value
- 956   {
- 957     break-if-float>
- 958     nil out
- 959     return
- 960   }
- 961   new-integer out, 1/true
- 962 }
- 963 
- 964 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 965   trace-text trace, "eval", "apply '<='"
- 966   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 967   var _args/eax: (addr cell) <- lookup *args-ah
- 968   var args/esi: (addr cell) <- copy _args
- 969   # TODO: check that args is a pair
- 970   var empty-args?/eax: boolean <- nil? args
- 971   compare empty-args?, 0/false
- 972   {
- 973     break-if-=
- 974     error trace, "'<=' needs 2 args but got 0"
- 975     return
- 976   }
- 977   # args->left
- 978   var first-ah/ecx: (addr handle cell) <- get args, left
- 979   # args->right->left
- 980   var right-ah/eax: (addr handle cell) <- get args, right
- 981   var right/eax: (addr cell) <- lookup *right-ah
- 982   # TODO: check that right is a pair
- 983   var second-ah/edx: (addr handle cell) <- get right, left
- 984   # compare
- 985   var _first/eax: (addr cell) <- lookup *first-ah
- 986   var first/ecx: (addr cell) <- copy _first
- 987   var first-type/eax: (addr int) <- get first, type
- 988   compare *first-type, 1/number
- 989   {
- 990     break-if-=
- 991     error trace, "first arg for '<=' is not a number"
- 992     return
- 993   }
- 994   var first-value/ecx: (addr float) <- get first, number-data
- 995   var first-float/xmm0: float <- copy *first-value
- 996   var second/eax: (addr cell) <- lookup *second-ah
- 997   var second-type/edx: (addr int) <- get second, type
- 998   compare *second-type, 1/number
- 999   {
-1000     break-if-=
-1001     error trace, "first arg for '<=' is not a number"
-1002     return
-1003   }
-1004   var second-value/eax: (addr float) <- get second, number-data
-1005   compare first-float, *second-value
-1006   {
-1007     break-if-float<=
-1008     nil out
-1009     return
-1010   }
-1011   new-integer out, 1/true
-1012 }
-1013 
-1014 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1015   trace-text trace, "eval", "apply '>='"
-1016   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1017   var _args/eax: (addr cell) <- lookup *args-ah
-1018   var args/esi: (addr cell) <- copy _args
-1019   # TODO: check that args is a pair
-1020   var empty-args?/eax: boolean <- nil? args
-1021   compare empty-args?, 0/false
-1022   {
-1023     break-if-=
-1024     error trace, "'>=' needs 2 args but got 0"
-1025     return
-1026   }
-1027   # args->left
-1028   var first-ah/ecx: (addr handle cell) <- get args, left
-1029   # args->right->left
-1030   var right-ah/eax: (addr handle cell) <- get args, right
-1031   var right/eax: (addr cell) <- lookup *right-ah
-1032   # TODO: check that right is a pair
-1033   var second-ah/edx: (addr handle cell) <- get right, left
-1034   # compare
-1035   var _first/eax: (addr cell) <- lookup *first-ah
-1036   var first/ecx: (addr cell) <- copy _first
-1037   var first-type/eax: (addr int) <- get first, type
-1038   compare *first-type, 1/number
-1039   {
-1040     break-if-=
-1041     error trace, "first arg for '>=' is not a number"
-1042     return
-1043   }
-1044   var first-value/ecx: (addr float) <- get first, number-data
-1045   var first-float/xmm0: float <- copy *first-value
-1046   var second/eax: (addr cell) <- lookup *second-ah
-1047   var second-type/edx: (addr int) <- get second, type
-1048   compare *second-type, 1/number
-1049   {
-1050     break-if-=
-1051     error trace, "first arg for '>=' is not a number"
-1052     return
-1053   }
-1054   var second-value/eax: (addr float) <- get second, number-data
-1055   compare first-float, *second-value
-1056   {
-1057     break-if-float>=
-1058     nil out
+ 857     var args-type/ecx: (addr int) <- get args, type
+ 858     compare *args-type, 0/pair
+ 859     break-if-=
+ 860     error trace, "args to sgn are not a list"
+ 861     return
+ 862   }
+ 863   var empty-args?/eax: boolean <- nil? args
+ 864   compare empty-args?, 0/false
+ 865   {
+ 866     break-if-=
+ 867     error trace, "sgn needs 1 arg but got 0"
+ 868     return
+ 869   }
+ 870   # args->left->value
+ 871   var first-ah/eax: (addr handle cell) <- get args, left
+ 872   var first/eax: (addr cell) <- lookup *first-ah
+ 873   var first-type/ecx: (addr int) <- get first, type
+ 874   compare *first-type, 1/number
+ 875   {
+ 876     break-if-=
+ 877     error trace, "arg for sgn is not a number"
+ 878     return
+ 879   }
+ 880   var first-value/ecx: (addr float) <- get first, number-data
+ 881   #
+ 882   var result/xmm0: float <- copy *first-value
+ 883   var zero: float
+ 884   $apply-sgn:core: {
+ 885     compare result, zero
+ 886     break-if-=
+ 887     {
+ 888       break-if-float>
+ 889       var neg1/eax: int <- copy -1
+ 890       result <- convert neg1
+ 891       break $apply-sgn:core
+ 892     }
+ 893     {
+ 894       break-if-float<
+ 895       var one/eax: int <- copy 1
+ 896       result <- convert one
+ 897       break $apply-sgn:core
+ 898     }
+ 899   }
+ 900   new-float out, result
+ 901 }
+ 902 
+ 903 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 904   trace-text trace, "eval", "apply car"
+ 905   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 906   var _args/eax: (addr cell) <- lookup *args-ah
+ 907   var args/esi: (addr cell) <- copy _args
+ 908   {
+ 909     var args-type/ecx: (addr int) <- get args, type
+ 910     compare *args-type, 0/pair
+ 911     break-if-=
+ 912     error trace, "args to car are not a list"
+ 913     return
+ 914   }
+ 915   var empty-args?/eax: boolean <- nil? args
+ 916   compare empty-args?, 0/false
+ 917   {
+ 918     break-if-=
+ 919     error trace, "car needs 1 arg but got 0"
+ 920     return
+ 921   }
+ 922   # args->left
+ 923   var first-ah/edx: (addr handle cell) <- get args, left
+ 924   var first/eax: (addr cell) <- lookup *first-ah
+ 925   var first-type/ecx: (addr int) <- get first, type
+ 926   compare *first-type, 0/pair
+ 927   {
+ 928     break-if-=
+ 929     error trace, "arg for car is not a pair"
+ 930     return
+ 931   }
+ 932   # nil? return nil
+ 933   {
+ 934     var nil?/eax: boolean <- nil? first
+ 935     compare nil?, 0/false
+ 936     break-if-=
+ 937     copy-object first-ah, out
+ 938     return
+ 939   }
+ 940   # car
+ 941   var result/eax: (addr handle cell) <- get first, left
+ 942   copy-object result, out
+ 943 }
+ 944 
+ 945 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 946   trace-text trace, "eval", "apply cdr"
+ 947   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 948   var _args/eax: (addr cell) <- lookup *args-ah
+ 949   var args/esi: (addr cell) <- copy _args
+ 950   {
+ 951     var args-type/ecx: (addr int) <- get args, type
+ 952     compare *args-type, 0/pair
+ 953     break-if-=
+ 954     error trace, "args to cdr are not a list"
+ 955     return
+ 956   }
+ 957   var empty-args?/eax: boolean <- nil? args
+ 958   compare empty-args?, 0/false
+ 959   {
+ 960     break-if-=
+ 961     error trace, "cdr needs 1 arg but got 0"
+ 962     return
+ 963   }
+ 964   # args->left
+ 965   var first-ah/edx: (addr handle cell) <- get args, left
+ 966   var first/eax: (addr cell) <- lookup *first-ah
+ 967   var first-type/ecx: (addr int) <- get first, type
+ 968   compare *first-type, 0/pair
+ 969   {
+ 970     break-if-=
+ 971     error trace, "arg for cdr is not a pair"
+ 972     return
+ 973   }
+ 974   # nil? return nil
+ 975   {
+ 976     var nil?/eax: boolean <- nil? first
+ 977     compare nil?, 0/false
+ 978     break-if-=
+ 979     copy-object first-ah, out
+ 980     return
+ 981   }
+ 982   # cdr
+ 983   var result/eax: (addr handle cell) <- get first, right
+ 984   copy-object result, out
+ 985 }
+ 986 
+ 987 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 988   trace-text trace, "eval", "apply cons"
+ 989   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 990   var _args/eax: (addr cell) <- lookup *args-ah
+ 991   var args/esi: (addr cell) <- copy _args
+ 992   {
+ 993     var args-type/ecx: (addr int) <- get args, type
+ 994     compare *args-type, 0/pair
+ 995     break-if-=
+ 996     error trace, "args to 'cons' are not a list"
+ 997     return
+ 998   }
+ 999   var empty-args?/eax: boolean <- nil? args
+1000   compare empty-args?, 0/false
+1001   {
+1002     break-if-=
+1003     error trace, "cons needs 2 args but got 0"
+1004     return
+1005   }
+1006   # args->left
+1007   var first-ah/ecx: (addr handle cell) <- get args, left
+1008   # args->right->left
+1009   var right-ah/eax: (addr handle cell) <- get args, right
+1010   var right/eax: (addr cell) <- lookup *right-ah
+1011   {
+1012     var right-type/ecx: (addr int) <- get right, type
+1013     compare *right-type, 0/pair
+1014     break-if-=
+1015     error trace, "'cons' encountered non-pair"
+1016     return
+1017   }
+1018   {
+1019     var nil?/eax: boolean <- nil? right
+1020     compare nil?, 0/false
+1021     break-if-=
+1022     error trace, "'cons' needs 2 args but got 1"
+1023     return
+1024   }
+1025   var second-ah/eax: (addr handle cell) <- get right, left
+1026   # cons
+1027   new-pair out, *first-ah, *second-ah
+1028 }
+1029 
+1030 fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1031   trace-text trace, "eval", "apply '='"
+1032   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1033   var _args/eax: (addr cell) <- lookup *args-ah
+1034   var args/esi: (addr cell) <- copy _args
+1035   {
+1036     var args-type/ecx: (addr int) <- get args, type
+1037     compare *args-type, 0/pair
+1038     break-if-=
+1039     error trace, "args to '=' are not a list"
+1040     return
+1041   }
+1042   var empty-args?/eax: boolean <- nil? args
+1043   compare empty-args?, 0/false
+1044   {
+1045     break-if-=
+1046     error trace, "'=' needs 2 args but got 0"
+1047     return
+1048   }
+1049   # args->left
+1050   var first-ah/ecx: (addr handle cell) <- get args, left
+1051   # args->right->left
+1052   var right-ah/eax: (addr handle cell) <- get args, right
+1053   var right/eax: (addr cell) <- lookup *right-ah
+1054   {
+1055     var right-type/ecx: (addr int) <- get right, type
+1056     compare *right-type, 0/pair
+1057     break-if-=
+1058     error trace, "'=' encountered non-pair"
 1059     return
 1060   }
-1061   new-integer out, 1/true
-1062 }
-1063 
-1064 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1065   trace-text trace, "eval", "apply print"
-1066   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1067   var _args/eax: (addr cell) <- lookup *args-ah
-1068   var args/esi: (addr cell) <- copy _args
-1069   # TODO: check that args is a pair
-1070   var empty-args?/eax: boolean <- nil? args
-1071   compare empty-args?, 0/false
-1072   {
-1073     break-if-=
-1074     error trace, "print needs 2 args but got 0"
-1075     return
-1076   }
-1077   # screen = args->left
-1078   var first-ah/eax: (addr handle cell) <- get args, left
-1079   var first/eax: (addr cell) <- lookup *first-ah
-1080   var first-type/ecx: (addr int) <- get first, type
-1081   compare *first-type, 5/screen
-1082   {
-1083     break-if-=
-1084     error trace, "first arg for 'print' is not a screen"
-1085     return
-1086   }
-1087   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1088   var _screen/eax: (addr screen) <- lookup *screen-ah
-1089   var screen/ecx: (addr screen) <- copy _screen
-1090   # args->right->left
-1091   var right-ah/eax: (addr handle cell) <- get args, right
-1092   var right/eax: (addr cell) <- lookup *right-ah
-1093   # TODO: check that right is a pair
-1094   var second-ah/eax: (addr handle cell) <- get right, left
-1095   var stream-storage: (stream byte 0x100)
-1096   var stream/edi: (addr stream byte) <- address stream-storage
-1097   print-cell second-ah, stream, trace
-1098   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
-1099   # return what was printed
-1100   copy-object second-ah, out
-1101 }
-1102 
-1103 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1104   trace-text trace, "eval", "apply clear"
-1105   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1106   var _args/eax: (addr cell) <- lookup *args-ah
-1107   var args/esi: (addr cell) <- copy _args
-1108   # TODO: check that args is a pair
-1109   var empty-args?/eax: boolean <- nil? args
-1110   compare empty-args?, 0/false
-1111   {
-1112     break-if-=
-1113     error trace, "'clear' needs 1 arg but got 0"
-1114     return
-1115   }
-1116   # screen = args->left
-1117   var first-ah/eax: (addr handle cell) <- get args, left
-1118   var first/eax: (addr cell) <- lookup *first-ah
-1119   var first-type/ecx: (addr int) <- get first, type
-1120   compare *first-type, 5/screen
+1061   {
+1062     var nil?/eax: boolean <- nil? right
+1063     compare nil?, 0/false
+1064     break-if-=
+1065     error trace, "'=' needs 2 args but got 1"
+1066     return
+1067   }
+1068   var second-ah/edx: (addr handle cell) <- get right, left
+1069   # compare
+1070   var _first/eax: (addr cell) <- lookup *first-ah
+1071   var first/ecx: (addr cell) <- copy _first
+1072   var second/eax: (addr cell) <- lookup *second-ah
+1073   var match?/eax: boolean <- cell-isomorphic? first, second, trace
+1074   compare match?, 0/false
+1075   {
+1076     break-if-!=
+1077     nil out
+1078     return
+1079   }
+1080   new-integer out, 1/true
+1081 }
+1082 
+1083 fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1084   trace-text trace, "eval", "apply 'not'"
+1085   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1086   var _args/eax: (addr cell) <- lookup *args-ah
+1087   var args/esi: (addr cell) <- copy _args
+1088   {
+1089     var args-type/ecx: (addr int) <- get args, type
+1090     compare *args-type, 0/pair
+1091     break-if-=
+1092     error trace, "args to 'not' are not a list"
+1093     return
+1094   }
+1095   var empty-args?/eax: boolean <- nil? args
+1096   compare empty-args?, 0/false
+1097   {
+1098     break-if-=
+1099     error trace, "'not' needs 1 arg but got 0"
+1100     return
+1101   }
+1102   # args->left
+1103   var first-ah/eax: (addr handle cell) <- get args, left
+1104   var first/eax: (addr cell) <- lookup *first-ah
+1105   # not
+1106   var nil?/eax: boolean <- nil? first
+1107   compare nil?, 0/false
+1108   {
+1109     break-if-!=
+1110     nil out
+1111     return
+1112   }
+1113   new-integer out, 1
+1114 }
+1115 
+1116 fn apply-debug _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1117   trace-text trace, "eval", "apply 'debug'"
+1118   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1119   var _args/eax: (addr cell) <- lookup *args-ah
+1120   var args/esi: (addr cell) <- copy _args
 1121   {
-1122     break-if-=
-1123     error trace, "first arg for 'clear' is not a screen"
-1124     return
-1125   }
-1126   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1127   var _screen/eax: (addr screen) <- lookup *screen-ah
-1128   var screen/ecx: (addr screen) <- copy _screen
-1129   #
-1130   clear-screen screen
-1131 }
-1132 
-1133 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1134   trace-text trace, "eval", "apply up"
-1135   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1136   var _args/eax: (addr cell) <- lookup *args-ah
-1137   var args/esi: (addr cell) <- copy _args
-1138   # TODO: check that args is a pair
-1139   var empty-args?/eax: boolean <- nil? args
-1140   compare empty-args?, 0/false
-1141   {
-1142     break-if-=
-1143     error trace, "'up' needs 1 arg but got 0"
-1144     return
-1145   }
-1146   # screen = args->left
-1147   var first-ah/eax: (addr handle cell) <- get args, left
-1148   var first/eax: (addr cell) <- lookup *first-ah
-1149   var first-type/ecx: (addr int) <- get first, type
-1150   compare *first-type, 5/screen
+1122     var args-type/ecx: (addr int) <- get args, type
+1123     compare *args-type, 0/pair
+1124     break-if-=
+1125     error trace, "args to 'debug' are not a list"
+1126     return
+1127   }
+1128   var empty-args?/eax: boolean <- nil? args
+1129   compare empty-args?, 0/false
+1130   {
+1131     break-if-=
+1132     error trace, "'debug' needs 1 arg but got 0"
+1133     return
+1134   }
+1135   # dump args->left uglily to screen and wait for a keypress
+1136   var first-ah/eax: (addr handle cell) <- get args, left
+1137   dump-cell-from-cursor-over-full-screen first-ah
+1138   {
+1139     var foo/eax: byte <- read-key 0/keyboard
+1140     compare foo, 0
+1141     loop-if-=
+1142   }
+1143   # return nothing
+1144 }
+1145 
+1146 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1147   trace-text trace, "eval", "apply '<'"
+1148   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1149   var _args/eax: (addr cell) <- lookup *args-ah
+1150   var args/esi: (addr cell) <- copy _args
 1151   {
-1152     break-if-=
-1153     error trace, "first arg for 'up' is not a screen"
-1154     return
-1155   }
-1156   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1157   var _screen/eax: (addr screen) <- lookup *screen-ah
-1158   var screen/ecx: (addr screen) <- copy _screen
-1159   #
-1160   move-cursor-up screen
-1161 }
-1162 
-1163 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1164   trace-text trace, "eval", "apply 'down'"
-1165   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1166   var _args/eax: (addr cell) <- lookup *args-ah
-1167   var args/esi: (addr cell) <- copy _args
-1168   # TODO: check that args is a pair
-1169   var empty-args?/eax: boolean <- nil? args
-1170   compare empty-args?, 0/false
-1171   {
-1172     break-if-=
-1173     error trace, "'down' needs 1 arg but got 0"
-1174     return
-1175   }
-1176   # screen = args->left
-1177   var first-ah/eax: (addr handle cell) <- get args, left
-1178   var first/eax: (addr cell) <- lookup *first-ah
-1179   var first-type/ecx: (addr int) <- get first, type
-1180   compare *first-type, 5/screen
-1181   {
-1182     break-if-=
-1183     error trace, "first arg for 'down' is not a screen"
-1184     return
-1185   }
-1186   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1187   var _screen/eax: (addr screen) <- lookup *screen-ah
-1188   var screen/ecx: (addr screen) <- copy _screen
-1189   #
-1190   move-cursor-down screen
-1191 }
-1192 
-1193 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1194   trace-text trace, "eval", "apply 'left'"
-1195   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1196   var _args/eax: (addr cell) <- lookup *args-ah
-1197   var args/esi: (addr cell) <- copy _args
-1198   # TODO: check that args is a pair
-1199   var empty-args?/eax: boolean <- nil? args
-1200   compare empty-args?, 0/false
-1201   {
-1202     break-if-=
-1203     error trace, "'left' needs 1 arg but got 0"
-1204     return
-1205   }
-1206   # screen = args->left
-1207   var first-ah/eax: (addr handle cell) <- get args, left
-1208   var first/eax: (addr cell) <- lookup *first-ah
-1209   var first-type/ecx: (addr int) <- get first, type
-1210   compare *first-type, 5/screen
-1211   {
-1212     break-if-=
-1213     error trace, "first arg for 'left' is not a screen"
-1214     return
-1215   }
-1216   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1217   var _screen/eax: (addr screen) <- lookup *screen-ah
-1218   var screen/ecx: (addr screen) <- copy _screen
-1219   #
-1220   move-cursor-left screen
-1221 }
-1222 
-1223 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1224   trace-text trace, "eval", "apply 'right'"
-1225   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1226   var _args/eax: (addr cell) <- lookup *args-ah
-1227   var args/esi: (addr cell) <- copy _args
-1228   # TODO: check that args is a pair
-1229   var empty-args?/eax: boolean <- nil? args
-1230   compare empty-args?, 0/false
-1231   {
-1232     break-if-=
-1233     error trace, "'right' needs 1 arg but got 0"
-1234     return
-1235   }
-1236   # screen = args->left
-1237   var first-ah/eax: (addr handle cell) <- get args, left
-1238   var first/eax: (addr cell) <- lookup *first-ah
-1239   var first-type/ecx: (addr int) <- get first, type
-1240   compare *first-type, 5/screen
-1241   {
+1152     var args-type/ecx: (addr int) <- get args, type
+1153     compare *args-type, 0/pair
+1154     break-if-=
+1155     error trace, "args to '<' are not a list"
+1156     return
+1157   }
+1158   var empty-args?/eax: boolean <- nil? args
+1159   compare empty-args?, 0/false
+1160   {
+1161     break-if-=
+1162     error trace, "'<' needs 2 args but got 0"
+1163     return
+1164   }
+1165   # args->left
+1166   var first-ah/ecx: (addr handle cell) <- get args, left
+1167   # args->right->left
+1168   var right-ah/eax: (addr handle cell) <- get args, right
+1169   var right/eax: (addr cell) <- lookup *right-ah
+1170   {
+1171     var right-type/ecx: (addr int) <- get right, type
+1172     compare *right-type, 0/pair
+1173     break-if-=
+1174     error trace, "'<' encountered non-pair"
+1175     return
+1176   }
+1177   {
+1178     var nil?/eax: boolean <- nil? right
+1179     compare nil?, 0/false
+1180     break-if-=
+1181     error trace, "'<' needs 2 args but got 1"
+1182     return
+1183   }
+1184   var second-ah/edx: (addr handle cell) <- get right, left
+1185   # compare
+1186   var _first/eax: (addr cell) <- lookup *first-ah
+1187   var first/ecx: (addr cell) <- copy _first
+1188   var first-type/eax: (addr int) <- get first, type
+1189   compare *first-type, 1/number
+1190   {
+1191     break-if-=
+1192     error trace, "first arg for '<' is not a number"
+1193     return
+1194   }
+1195   var first-value/ecx: (addr float) <- get first, number-data
+1196   var first-float/xmm0: float <- copy *first-value
+1197   var second/eax: (addr cell) <- lookup *second-ah
+1198   var second-type/edx: (addr int) <- get second, type
+1199   compare *second-type, 1/number
+1200   {
+1201     break-if-=
+1202     error trace, "second arg for '<' is not a number"
+1203     return
+1204   }
+1205   var second-value/eax: (addr float) <- get second, number-data
+1206   compare first-float, *second-value
+1207   {
+1208     break-if-float<
+1209     nil out
+1210     return
+1211   }
+1212   new-integer out, 1/true
+1213 }
+1214 
+1215 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1216   trace-text trace, "eval", "apply '>'"
+1217   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1218   var _args/eax: (addr cell) <- lookup *args-ah
+1219   var args/esi: (addr cell) <- copy _args
+1220   {
+1221     var args-type/ecx: (addr int) <- get args, type
+1222     compare *args-type, 0/pair
+1223     break-if-=
+1224     error trace, "args to '>' are not a list"
+1225     return
+1226   }
+1227   var empty-args?/eax: boolean <- nil? args
+1228   compare empty-args?, 0/false
+1229   {
+1230     break-if-=
+1231     error trace, "'>' needs 2 args but got 0"
+1232     return
+1233   }
+1234   # args->left
+1235   var first-ah/ecx: (addr handle cell) <- get args, left
+1236   # args->right->left
+1237   var right-ah/eax: (addr handle cell) <- get args, right
+1238   var right/eax: (addr cell) <- lookup *right-ah
+1239   {
+1240     var right-type/ecx: (addr int) <- get right, type
+1241     compare *right-type, 0/pair
 1242     break-if-=
-1243     error trace, "first arg for 'right' is not a screen"
+1243     error trace, "'>' encountered non-pair"
 1244     return
 1245   }
-1246   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1247   var _screen/eax: (addr screen) <- lookup *screen-ah
-1248   var screen/ecx: (addr screen) <- copy _screen
-1249   #
-1250   move-cursor-right screen
-1251 }
-1252 
-1253 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1254   trace-text trace, "eval", "apply 'cr'"
-1255   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1256   var _args/eax: (addr cell) <- lookup *args-ah
-1257   var args/esi: (addr cell) <- copy _args
-1258   # TODO: check that args is a pair
-1259   var empty-args?/eax: boolean <- nil? args
-1260   compare empty-args?, 0/false
-1261   {
-1262     break-if-=
-1263     error trace, "'cr' needs 1 arg but got 0"
-1264     return
-1265   }
-1266   # screen = args->left
-1267   var first-ah/eax: (addr handle cell) <- get args, left
-1268   var first/eax: (addr cell) <- lookup *first-ah
-1269   var first-type/ecx: (addr int) <- get first, type
-1270   compare *first-type, 5/screen
-1271   {
-1272     break-if-=
-1273     error trace, "first arg for 'cr' is not a screen"
-1274     return
-1275   }
-1276   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1277   var _screen/eax: (addr screen) <- lookup *screen-ah
-1278   var screen/ecx: (addr screen) <- copy _screen
-1279   #
-1280   move-cursor-to-left-margin-of-next-line screen
-1281 }
-1282 
-1283 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1284   trace-text trace, "eval", "apply pixel"
-1285   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1286   var _args/eax: (addr cell) <- lookup *args-ah
-1287   var args/esi: (addr cell) <- copy _args
-1288   # TODO: check that args is a pair
-1289   var empty-args?/eax: boolean <- nil? args
-1290   compare empty-args?, 0/false
-1291   {
+1246   {
+1247     var nil?/eax: boolean <- nil? right
+1248     compare nil?, 0/false
+1249     break-if-=
+1250     error trace, "'>' needs 2 args but got 1"
+1251     return
+1252   }
+1253   var second-ah/edx: (addr handle cell) <- get right, left
+1254   # compare
+1255   var _first/eax: (addr cell) <- lookup *first-ah
+1256   var first/ecx: (addr cell) <- copy _first
+1257   var first-type/eax: (addr int) <- get first, type
+1258   compare *first-type, 1/number
+1259   {
+1260     break-if-=
+1261     error trace, "first arg for '>' is not a number"
+1262     return
+1263   }
+1264   var first-value/ecx: (addr float) <- get first, number-data
+1265   var first-float/xmm0: float <- copy *first-value
+1266   var second/eax: (addr cell) <- lookup *second-ah
+1267   var second-type/edx: (addr int) <- get second, type
+1268   compare *second-type, 1/number
+1269   {
+1270     break-if-=
+1271     error trace, "second arg for '>' is not a number"
+1272     return
+1273   }
+1274   var second-value/eax: (addr float) <- get second, number-data
+1275   compare first-float, *second-value
+1276   {
+1277     break-if-float>
+1278     nil out
+1279     return
+1280   }
+1281   new-integer out, 1/true
+1282 }
+1283 
+1284 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1285   trace-text trace, "eval", "apply '<='"
+1286   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1287   var _args/eax: (addr cell) <- lookup *args-ah
+1288   var args/esi: (addr cell) <- copy _args
+1289   {
+1290     var args-type/ecx: (addr int) <- get args, type
+1291     compare *args-type, 0/pair
 1292     break-if-=
-1293     error trace, "pixel needs 4 args but got 0"
+1293     error trace, "args to '<=' are not a list"
 1294     return
 1295   }
-1296   # screen = args->left
-1297   var first-ah/eax: (addr handle cell) <- get args, left
-1298   var first/eax: (addr cell) <- lookup *first-ah
-1299   var first-type/ecx: (addr int) <- get first, type
-1300   compare *first-type, 5/screen
-1301   {
-1302     break-if-=
-1303     error trace, "first arg for 'pixel' is not a screen"
-1304     return
-1305   }
-1306   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1307   var _screen/eax: (addr screen) <- lookup *screen-ah
-1308   var screen/edi: (addr screen) <- copy _screen
-1309   # x = args->right->left->value
-1310   var rest-ah/eax: (addr handle cell) <- get args, right
-1311   var _rest/eax: (addr cell) <- lookup *rest-ah
-1312   var rest/esi: (addr cell) <- copy _rest
-1313   # TODO: check that rest is a pair
-1314   var second-ah/eax: (addr handle cell) <- get rest, left
-1315   var second/eax: (addr cell) <- lookup *second-ah
-1316   var second-type/ecx: (addr int) <- get second, type
-1317   compare *second-type, 1/number
-1318   {
-1319     break-if-=
-1320     error trace, "second arg for 'pixel' is not an int (x coordinate)"
-1321     return
-1322   }
-1323   var second-value/eax: (addr float) <- get second, number-data
-1324   var x/edx: int <- convert *second-value
-1325   # y = rest->right->left->value
-1326   var rest-ah/eax: (addr handle cell) <- get rest, right
-1327   var _rest/eax: (addr cell) <- lookup *rest-ah
-1328   rest <- copy _rest
-1329   # TODO: check that rest is a pair
-1330   var third-ah/eax: (addr handle cell) <- get rest, left
-1331   var third/eax: (addr cell) <- lookup *third-ah
-1332   var third-type/ecx: (addr int) <- get third, type
-1333   compare *third-type, 1/number
-1334   {
-1335     break-if-=
-1336     error trace, "third arg for 'pixel' is not an int (y coordinate)"
-1337     return
-1338   }
-1339   var third-value/eax: (addr float) <- get third, number-data
-1340   var y/ebx: int <- convert *third-value
-1341   # color = rest->right->left->value
-1342   var rest-ah/eax: (addr handle cell) <- get rest, right
-1343   var _rest/eax: (addr cell) <- lookup *rest-ah
-1344   rest <- copy _rest
-1345   # TODO: check that rest is a pair
-1346   var fourth-ah/eax: (addr handle cell) <- get rest, left
-1347   var fourth/eax: (addr cell) <- lookup *fourth-ah
-1348   var fourth-type/ecx: (addr int) <- get fourth, type
-1349   compare *fourth-type, 1/number
-1350   {
-1351     break-if-=
-1352     error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)"
-1353     return
-1354   }
-1355   var fourth-value/eax: (addr float) <- get fourth, number-data
-1356   var color/eax: int <- convert *fourth-value
-1357   pixel screen, x, y, color
-1358   # return nothing
-1359 }
-1360 
-1361 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1362   trace-text trace, "eval", "apply key"
-1363   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1364   var _args/eax: (addr cell) <- lookup *args-ah
-1365   var args/esi: (addr cell) <- copy _args
-1366   # TODO: check that args is a pair
-1367   var empty-args?/eax: boolean <- nil? args
-1368   compare empty-args?, 0/false
-1369   {
-1370     break-if-=
-1371     error trace, "key needs 1 arg but got 0"
-1372     return
-1373   }
-1374   # keyboard = args->left
-1375   var first-ah/eax: (addr handle cell) <- get args, left
-1376   var first/eax: (addr cell) <- lookup *first-ah
-1377   var first-type/ecx: (addr int) <- get first, type
-1378   compare *first-type, 6/keyboard
-1379   {
+1296   var empty-args?/eax: boolean <- nil? args
+1297   compare empty-args?, 0/false
+1298   {
+1299     break-if-=
+1300     error trace, "'<=' needs 2 args but got 0"
+1301     return
+1302   }
+1303   # args->left
+1304   var first-ah/ecx: (addr handle cell) <- get args, left
+1305   # args->right->left
+1306   var right-ah/eax: (addr handle cell) <- get args, right
+1307   var right/eax: (addr cell) <- lookup *right-ah
+1308   {
+1309     var right-type/ecx: (addr int) <- get right, type
+1310     compare *right-type, 0/pair
+1311     break-if-=
+1312     error trace, "'<=' encountered non-pair"
+1313     return
+1314   }
+1315   {
+1316     var nil?/eax: boolean <- nil? right
+1317     compare nil?, 0/false
+1318     break-if-=
+1319     error trace, "'<=' needs 2 args but got 1"
+1320     return
+1321   }
+1322   var second-ah/edx: (addr handle cell) <- get right, left
+1323   # compare
+1324   var _first/eax: (addr cell) <- lookup *first-ah
+1325   var first/ecx: (addr cell) <- copy _first
+1326   var first-type/eax: (addr int) <- get first, type
+1327   compare *first-type, 1/number
+1328   {
+1329     break-if-=
+1330     error trace, "first arg for '<=' is not a number"
+1331     return
+1332   }
+1333   var first-value/ecx: (addr float) <- get first, number-data
+1334   var first-float/xmm0: float <- copy *first-value
+1335   var second/eax: (addr cell) <- lookup *second-ah
+1336   var second-type/edx: (addr int) <- get second, type
+1337   compare *second-type, 1/number
+1338   {
+1339     break-if-=
+1340     error trace, "second arg for '<=' is not a number"
+1341     return
+1342   }
+1343   var second-value/eax: (addr float) <- get second, number-data
+1344   compare first-float, *second-value
+1345   {
+1346     break-if-float<=
+1347     nil out
+1348     return
+1349   }
+1350   new-integer out, 1/true
+1351 }
+1352 
+1353 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1354   trace-text trace, "eval", "apply '>='"
+1355   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1356   var _args/eax: (addr cell) <- lookup *args-ah
+1357   var args/esi: (addr cell) <- copy _args
+1358   {
+1359     var args-type/ecx: (addr int) <- get args, type
+1360     compare *args-type, 0/pair
+1361     break-if-=
+1362     error trace, "args to '>=' are not a list"
+1363     return
+1364   }
+1365   var empty-args?/eax: boolean <- nil? args
+1366   compare empty-args?, 0/false
+1367   {
+1368     break-if-=
+1369     error trace, "'>=' needs 2 args but got 0"
+1370     return
+1371   }
+1372   # args->left
+1373   var first-ah/ecx: (addr handle cell) <- get args, left
+1374   # args->right->left
+1375   var right-ah/eax: (addr handle cell) <- get args, right
+1376   var right/eax: (addr cell) <- lookup *right-ah
+1377   {
+1378     var right-type/ecx: (addr int) <- get right, type
+1379     compare *right-type, 0/pair
 1380     break-if-=
-1381     error trace, "first arg for 'key' is not a keyboard"
+1381     error trace, "'>=' encountered non-pair"
 1382     return
 1383   }
-1384   var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
-1385   var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
-1386   var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
-1387   var result/eax: int <- wait-for-key keyboard
-1388   # return key typed
-1389   new-integer out, result
-1390 }
-1391 
-1392 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
-1393   # if keyboard is 0, use real keyboard
-1394   {
-1395     compare keyboard, 0/real-keyboard
-1396     break-if-!=
-1397     var key/eax: byte <- read-key 0/real-keyboard
-1398     var result/eax: int <- copy key
-1399     return result
-1400   }
-1401   # otherwise read from fake keyboard
-1402   var g/eax: grapheme <- read-from-gap-buffer keyboard
-1403   var result/eax: int <- copy g
-1404   return result
-1405 }
-1406 
-1407 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1408   trace-text trace, "eval", "apply stream"
-1409   allocate-stream out
-1410 }
-1411 
-1412 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1413   trace-text trace, "eval", "apply write"
-1414   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1415   var _args/eax: (addr cell) <- lookup *args-ah
-1416   var args/esi: (addr cell) <- copy _args
-1417   # TODO: check that args is a pair
-1418   var empty-args?/eax: boolean <- nil? args
-1419   compare empty-args?, 0/false
-1420   {
-1421     break-if-=
-1422     error trace, "write needs 2 args but got 0"
-1423     return
-1424   }
-1425   # stream = args->left
-1426   var first-ah/edx: (addr handle cell) <- get args, left
-1427   var first/eax: (addr cell) <- lookup *first-ah
-1428   var first-type/ecx: (addr int) <- get first, type
-1429   compare *first-type, 3/stream
-1430   {
-1431     break-if-=
-1432     error trace, "first arg for 'write' is not a stream"
-1433     return
-1434   }
-1435   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
-1436   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
-1437   var stream-data/ebx: (addr stream byte) <- copy _stream-data
-1438   # args->right->left
-1439   var right-ah/eax: (addr handle cell) <- get args, right
-1440   var right/eax: (addr cell) <- lookup *right-ah
-1441   # TODO: check that right is a pair
-1442   var second-ah/eax: (addr handle cell) <- get right, left
-1443   var second/eax: (addr cell) <- lookup *second-ah
-1444   var second-type/ecx: (addr int) <- get second, type
-1445   compare *second-type, 1/number
+1384   {
+1385     var nil?/eax: boolean <- nil? right
+1386     compare nil?, 0/false
+1387     break-if-=
+1388     error trace, "'>=' needs 2 args but got 1"
+1389     return
+1390   }
+1391   var second-ah/edx: (addr handle cell) <- get right, left
+1392   # compare
+1393   var _first/eax: (addr cell) <- lookup *first-ah
+1394   var first/ecx: (addr cell) <- copy _first
+1395   var first-type/eax: (addr int) <- get first, type
+1396   compare *first-type, 1/number
+1397   {
+1398     break-if-=
+1399     error trace, "first arg for '>=' is not a number"
+1400     return
+1401   }
+1402   var first-value/ecx: (addr float) <- get first, number-data
+1403   var first-float/xmm0: float <- copy *first-value
+1404   var second/eax: (addr cell) <- lookup *second-ah
+1405   var second-type/edx: (addr int) <- get second, type
+1406   compare *second-type, 1/number
+1407   {
+1408     break-if-=
+1409     error trace, "second arg for '>=' is not a number"
+1410     return
+1411   }
+1412   var second-value/eax: (addr float) <- get second, number-data
+1413   compare first-float, *second-value
+1414   {
+1415     break-if-float>=
+1416     nil out
+1417     return
+1418   }
+1419   new-integer out, 1/true
+1420 }
+1421 
+1422 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1423   trace-text trace, "eval", "apply 'print'"
+1424   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1425   var _args/eax: (addr cell) <- lookup *args-ah
+1426   var args/esi: (addr cell) <- copy _args
+1427   {
+1428     var args-type/ecx: (addr int) <- get args, type
+1429     compare *args-type, 0/pair
+1430     break-if-=
+1431     error trace, "args to 'print' are not a list"
+1432     return
+1433   }
+1434   var empty-args?/eax: boolean <- nil? args
+1435   compare empty-args?, 0/false
+1436   {
+1437     break-if-=
+1438     error trace, "'print' needs 2 args but got 0"
+1439     return
+1440   }
+1441   # screen = args->left
+1442   var first-ah/eax: (addr handle cell) <- get args, left
+1443   var first/eax: (addr cell) <- lookup *first-ah
+1444   var first-type/ecx: (addr int) <- get first, type
+1445   compare *first-type, 5/screen
 1446   {
 1447     break-if-=
-1448     error trace, "second arg for stream is not a number/grapheme"
+1448     error trace, "first arg for 'print' is not a screen"
 1449     return
 1450   }
-1451   var second-value/eax: (addr float) <- get second, number-data
-1452   var x-float/xmm0: float <- copy *second-value
-1453   var x/eax: int <- convert x-float
-1454   var x-grapheme/eax: grapheme <- copy x
-1455   write-grapheme stream-data, x-grapheme
-1456   # return the stream
-1457   copy-object first-ah, out
-1458 }
-1459 
-1460 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1461   trace-text trace, "eval", "apply lines"
-1462   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1463   var _args/eax: (addr cell) <- lookup *args-ah
-1464   var args/esi: (addr cell) <- copy _args
-1465   # TODO: check that args is a pair
-1466   var empty-args?/eax: boolean <- nil? args
-1467   compare empty-args?, 0/false
-1468   {
-1469     break-if-=
-1470     error trace, "lines needs 1 arg but got 0"
-1471     return
-1472   }
-1473   # screen = args->left
-1474   var first-ah/eax: (addr handle cell) <- get args, left
-1475   var first/eax: (addr cell) <- lookup *first-ah
-1476   var first-type/ecx: (addr int) <- get first, type
-1477   compare *first-type, 5/screen
-1478   {
-1479     break-if-=
-1480     error trace, "first arg for 'lines' is not a screen"
-1481     return
-1482   }
-1483   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1484   var _screen/eax: (addr screen) <- lookup *screen-ah
-1485   var screen/edx: (addr screen) <- copy _screen
-1486   # compute dimensions
-1487   var dummy/eax: int <- copy 0
-1488   var height/ecx: int <- copy 0
-1489   dummy, height <- screen-size screen
-1490   var result/xmm0: float <- convert height
-1491   new-float out, result
-1492 }
-1493 
-1494 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1495   abort "aa"
-1496 }
-1497 
-1498 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1499   trace-text trace, "eval", "apply columns"
-1500   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1501   var _args/eax: (addr cell) <- lookup *args-ah
-1502   var args/esi: (addr cell) <- copy _args
-1503   # TODO: check that args is a pair
-1504   var empty-args?/eax: boolean <- nil? args
-1505   compare empty-args?, 0/false
-1506   {
-1507     break-if-=
-1508     error trace, "columns needs 1 arg but got 0"
-1509     return
-1510   }
-1511   # screen = args->left
-1512   var first-ah/eax: (addr handle cell) <- get args, left
-1513   var first/eax: (addr cell) <- lookup *first-ah
-1514   var first-type/ecx: (addr int) <- get first, type
-1515   compare *first-type, 5/screen
-1516   {
-1517     break-if-=
-1518     error trace, "first arg for 'columns' is not a screen"
-1519     return
-1520   }
-1521   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1522   var _screen/eax: (addr screen) <- lookup *screen-ah
-1523   var screen/edx: (addr screen) <- copy _screen
-1524   # compute dimensions
-1525   var width/eax: int <- copy 0
-1526   var dummy/ecx: int <- copy 0
-1527   width, dummy <- screen-size screen
-1528   var result/xmm0: float <- convert width
-1529   new-float out, result
-1530 }
-1531 
-1532 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1533   trace-text trace, "eval", "apply width"
-1534   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1535   var _args/eax: (addr cell) <- lookup *args-ah
-1536   var args/esi: (addr cell) <- copy _args
-1537   # TODO: check that args is a pair
-1538   var empty-args?/eax: boolean <- nil? args
-1539   compare empty-args?, 0/false
+1451   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1452   var _screen/eax: (addr screen) <- lookup *screen-ah
+1453   var screen/ecx: (addr screen) <- copy _screen
+1454   # args->right->left
+1455   var right-ah/eax: (addr handle cell) <- get args, right
+1456   var right/eax: (addr cell) <- lookup *right-ah
+1457   {
+1458     var right-type/ecx: (addr int) <- get right, type
+1459     compare *right-type, 0/pair
+1460     break-if-=
+1461     error trace, "'print' encountered non-pair"
+1462     return
+1463   }
+1464   {
+1465     var nil?/eax: boolean <- nil? right
+1466     compare nil?, 0/false
+1467     break-if-=
+1468     error trace, "'print' needs 2 args but got 1"
+1469     return
+1470   }
+1471   var second-ah/eax: (addr handle cell) <- get right, left
+1472   var stream-storage: (stream byte 0x100)
+1473   var stream/edi: (addr stream byte) <- address stream-storage
+1474   print-cell second-ah, stream, trace
+1475   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
+1476   # return what was printed
+1477   copy-object second-ah, out
+1478 }
+1479 
+1480 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1481   trace-text trace, "eval", "apply 'clear'"
+1482   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1483   var _args/eax: (addr cell) <- lookup *args-ah
+1484   var args/esi: (addr cell) <- copy _args
+1485   {
+1486     var args-type/ecx: (addr int) <- get args, type
+1487     compare *args-type, 0/pair
+1488     break-if-=
+1489     error trace, "args to 'clear' are not a list"
+1490     return
+1491   }
+1492   var empty-args?/eax: boolean <- nil? args
+1493   compare empty-args?, 0/false
+1494   {
+1495     break-if-=
+1496     error trace, "'clear' needs 1 arg but got 0"
+1497     return
+1498   }
+1499   # screen = args->left
+1500   var first-ah/eax: (addr handle cell) <- get args, left
+1501   var first/eax: (addr cell) <- lookup *first-ah
+1502   var first-type/ecx: (addr int) <- get first, type
+1503   compare *first-type, 5/screen
+1504   {
+1505     break-if-=
+1506     error trace, "first arg for 'clear' is not a screen"
+1507     return
+1508   }
+1509   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1510   var _screen/eax: (addr screen) <- lookup *screen-ah
+1511   var screen/ecx: (addr screen) <- copy _screen
+1512   #
+1513   clear-screen screen
+1514 }
+1515 
+1516 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1517   trace-text trace, "eval", "apply 'up'"
+1518   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1519   var _args/eax: (addr cell) <- lookup *args-ah
+1520   var args/esi: (addr cell) <- copy _args
+1521   {
+1522     var args-type/ecx: (addr int) <- get args, type
+1523     compare *args-type, 0/pair
+1524     break-if-=
+1525     error trace, "args to 'up' are not a list"
+1526     return
+1527   }
+1528   var empty-args?/eax: boolean <- nil? args
+1529   compare empty-args?, 0/false
+1530   {
+1531     break-if-=
+1532     error trace, "'up' needs 1 arg but got 0"
+1533     return
+1534   }
+1535   # screen = args->left
+1536   var first-ah/eax: (addr handle cell) <- get args, left
+1537   var first/eax: (addr cell) <- lookup *first-ah
+1538   var first-type/ecx: (addr int) <- get first, type
+1539   compare *first-type, 5/screen
 1540   {
 1541     break-if-=
-1542     error trace, "width needs 1 arg but got 0"
+1542     error trace, "first arg for 'up' is not a screen"
 1543     return
 1544   }
-1545   # screen = args->left
-1546   var first-ah/eax: (addr handle cell) <- get args, left
-1547   var first/eax: (addr cell) <- lookup *first-ah
-1548   var first-type/ecx: (addr int) <- get first, type
-1549   compare *first-type, 5/screen
-1550   {
-1551     break-if-=
-1552     error trace, "first arg for 'width' is not a screen"
-1553     return
-1554   }
-1555   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1556   var _screen/eax: (addr screen) <- lookup *screen-ah
-1557   var screen/edx: (addr screen) <- copy _screen
-1558   # compute dimensions
-1559   var width/eax: int <- copy 0
-1560   var dummy/ecx: int <- copy 0
-1561   width, dummy <- screen-size screen
-1562   width <- shift-left 3/log2-font-width
-1563   var result/xmm0: float <- convert width
-1564   new-float out, result
-1565 }
-1566 
-1567 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1568   trace-text trace, "eval", "apply height"
-1569   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1570   var _args/eax: (addr cell) <- lookup *args-ah
-1571   var args/esi: (addr cell) <- copy _args
-1572   # TODO: check that args is a pair
-1573   var empty-args?/eax: boolean <- nil? args
-1574   compare empty-args?, 0/false
-1575   {
-1576     break-if-=
-1577     error trace, "height needs 1 arg but got 0"
-1578     return
-1579   }
-1580   # screen = args->left
-1581   var first-ah/eax: (addr handle cell) <- get args, left
-1582   var first/eax: (addr cell) <- lookup *first-ah
-1583   var first-type/ecx: (addr int) <- get first, type
-1584   compare *first-type, 5/screen
-1585   {
-1586     break-if-=
-1587     error trace, "first arg for 'height' is not a screen"
-1588     return
-1589   }
-1590   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1591   var _screen/eax: (addr screen) <- lookup *screen-ah
-1592   var screen/edx: (addr screen) <- copy _screen
-1593   # compute dimensions
-1594   var dummy/eax: int <- copy 0
-1595   var height/ecx: int <- copy 0
-1596   dummy, height <- screen-size screen
-1597   height <- shift-left 4/log2-font-height
-1598   var result/xmm0: float <- convert height
-1599   new-float out, result
-1600 }
+1545   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1546   var _screen/eax: (addr screen) <- lookup *screen-ah
+1547   var screen/ecx: (addr screen) <- copy _screen
+1548   #
+1549   move-cursor-up screen
+1550 }
+1551 
+1552 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1553   trace-text trace, "eval", "apply 'down'"
+1554   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1555   var _args/eax: (addr cell) <- lookup *args-ah
+1556   var args/esi: (addr cell) <- copy _args
+1557   {
+1558     var args-type/ecx: (addr int) <- get args, type
+1559     compare *args-type, 0/pair
+1560     break-if-=
+1561     error trace, "args to 'down' are not a list"
+1562     return
+1563   }
+1564   var empty-args?/eax: boolean <- nil? args
+1565   compare empty-args?, 0/false
+1566   {
+1567     break-if-=
+1568     error trace, "'down' needs 1 arg but got 0"
+1569     return
+1570   }
+1571   # screen = args->left
+1572   var first-ah/eax: (addr handle cell) <- get args, left
+1573   var first/eax: (addr cell) <- lookup *first-ah
+1574   var first-type/ecx: (addr int) <- get first, type
+1575   compare *first-type, 5/screen
+1576   {
+1577     break-if-=
+1578     error trace, "first arg for 'down' is not a screen"
+1579     return
+1580   }
+1581   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1582   var _screen/eax: (addr screen) <- lookup *screen-ah
+1583   var screen/ecx: (addr screen) <- copy _screen
+1584   #
+1585   move-cursor-down screen
+1586 }
+1587 
+1588 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1589   trace-text trace, "eval", "apply 'left'"
+1590   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1591   var _args/eax: (addr cell) <- lookup *args-ah
+1592   var args/esi: (addr cell) <- copy _args
+1593   {
+1594     var args-type/ecx: (addr int) <- get args, type
+1595     compare *args-type, 0/pair
+1596     break-if-=
+1597     error trace, "args to 'left' are not a list"
+1598     return
+1599   }
+1600   var empty-args?/eax: boolean <- nil? args
+1601   compare empty-args?, 0/false
+1602   {
+1603     break-if-=
+1604     error trace, "'left' needs 1 arg but got 0"
+1605     return
+1606   }
+1607   # screen = args->left
+1608   var first-ah/eax: (addr handle cell) <- get args, left
+1609   var first/eax: (addr cell) <- lookup *first-ah
+1610   var first-type/ecx: (addr int) <- get first, type
+1611   compare *first-type, 5/screen
+1612   {
+1613     break-if-=
+1614     error trace, "first arg for 'left' is not a screen"
+1615     return
+1616   }
+1617   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1618   var _screen/eax: (addr screen) <- lookup *screen-ah
+1619   var screen/ecx: (addr screen) <- copy _screen
+1620   #
+1621   move-cursor-left screen
+1622 }
+1623 
+1624 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1625   trace-text trace, "eval", "apply 'right'"
+1626   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1627   var _args/eax: (addr cell) <- lookup *args-ah
+1628   var args/esi: (addr cell) <- copy _args
+1629   {
+1630     var args-type/ecx: (addr int) <- get args, type
+1631     compare *args-type, 0/pair
+1632     break-if-=
+1633     error trace, "args to 'right' are not a list"
+1634     return
+1635   }
+1636   var empty-args?/eax: boolean <- nil? args
+1637   compare empty-args?, 0/false
+1638   {
+1639     break-if-=
+1640     error trace, "'right' needs 1 arg but got 0"
+1641     return
+1642   }
+1643   # screen = args->left
+1644   var first-ah/eax: (addr handle cell) <- get args, left
+1645   var first/eax: (addr cell) <- lookup *first-ah
+1646   var first-type/ecx: (addr int) <- get first, type
+1647   compare *first-type, 5/screen
+1648   {
+1649     break-if-=
+1650     error trace, "first arg for 'right' is not a screen"
+1651     return
+1652   }
+1653   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1654   var _screen/eax: (addr screen) <- lookup *screen-ah
+1655   var screen/ecx: (addr screen) <- copy _screen
+1656   #
+1657   move-cursor-right screen
+1658 }
+1659 
+1660 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1661   trace-text trace, "eval", "apply 'cr'"
+1662   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1663   var _args/eax: (addr cell) <- lookup *args-ah
+1664   var args/esi: (addr cell) <- copy _args
+1665   {
+1666     var args-type/ecx: (addr int) <- get args, type
+1667     compare *args-type, 0/pair
+1668     break-if-=
+1669     error trace, "args to 'cr' are not a list"
+1670     return
+1671   }
+1672   var empty-args?/eax: boolean <- nil? args
+1673   compare empty-args?, 0/false
+1674   {
+1675     break-if-=
+1676     error trace, "'cr' needs 1 arg but got 0"
+1677     return
+1678   }
+1679   # screen = args->left
+1680   var first-ah/eax: (addr handle cell) <- get args, left
+1681   var first/eax: (addr cell) <- lookup *first-ah
+1682   var first-type/ecx: (addr int) <- get first, type
+1683   compare *first-type, 5/screen
+1684   {
+1685     break-if-=
+1686     error trace, "first arg for 'cr' is not a screen"
+1687     return
+1688   }
+1689   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1690   var _screen/eax: (addr screen) <- lookup *screen-ah
+1691   var screen/ecx: (addr screen) <- copy _screen
+1692   #
+1693   move-cursor-to-left-margin-of-next-line screen
+1694 }
+1695 
+1696 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1697   trace-text trace, "eval", "apply 'pixel'"
+1698   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1699   var _args/eax: (addr cell) <- lookup *args-ah
+1700   var args/esi: (addr cell) <- copy _args
+1701   {
+1702     var args-type/ecx: (addr int) <- get args, type
+1703     compare *args-type, 0/pair
+1704     break-if-=
+1705     error trace, "args to 'pixel' are not a list"
+1706     return
+1707   }
+1708   var empty-args?/eax: boolean <- nil? args
+1709   compare empty-args?, 0/false
+1710   {
+1711     break-if-=
+1712     error trace, "'pixel' needs 4 args but got 0"
+1713     return
+1714   }
+1715   # screen = args->left
+1716   var first-ah/eax: (addr handle cell) <- get args, left
+1717   var first/eax: (addr cell) <- lookup *first-ah
+1718   var first-type/ecx: (addr int) <- get first, type
+1719   compare *first-type, 5/screen
+1720   {
+1721     break-if-=
+1722     error trace, "first arg for 'pixel' is not a screen"
+1723     return
+1724   }
+1725   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1726   var _screen/eax: (addr screen) <- lookup *screen-ah
+1727   var screen/edi: (addr screen) <- copy _screen
+1728   # x = args->right->left->value
+1729   var rest-ah/eax: (addr handle cell) <- get args, right
+1730   var _rest/eax: (addr cell) <- lookup *rest-ah
+1731   var rest/esi: (addr cell) <- copy _rest
+1732   {
+1733     var rest-type/ecx: (addr int) <- get rest, type
+1734     compare *rest-type, 0/pair
+1735     break-if-=
+1736     error trace, "'pixel' encountered non-pair"
+1737     return
+1738   }
+1739   {
+1740     var rest-nil?/eax: boolean <- nil? rest
+1741     compare rest-nil?, 0/false
+1742     break-if-=
+1743     error trace, "'pixel' needs 4 args but got 1"
+1744     return
+1745   }
+1746   var second-ah/eax: (addr handle cell) <- get rest, left
+1747   var second/eax: (addr cell) <- lookup *second-ah
+1748   var second-type/ecx: (addr int) <- get second, type
+1749   compare *second-type, 1/number
+1750   {
+1751     break-if-=
+1752     error trace, "second arg for 'pixel' is not an int (x coordinate)"
+1753     return
+1754   }
+1755   var second-value/eax: (addr float) <- get second, number-data
+1756   var x/edx: int <- convert *second-value
+1757   # y = rest->right->left->value
+1758   var rest-ah/eax: (addr handle cell) <- get rest, right
+1759   var _rest/eax: (addr cell) <- lookup *rest-ah
+1760   rest <- copy _rest
+1761   {
+1762     var rest-type/ecx: (addr int) <- get rest, type
+1763     compare *rest-type, 0/pair
+1764     break-if-=
+1765     error trace, "'pixel' encountered non-pair"
+1766     return
+1767   }
+1768   {
+1769     var rest-nil?/eax: boolean <- nil? rest
+1770     compare rest-nil?, 0/false
+1771     break-if-=
+1772     error trace, "'pixel' needs 4 args but got 2"
+1773     return
+1774   }
+1775   var third-ah/eax: (addr handle cell) <- get rest, left
+1776   var third/eax: (addr cell) <- lookup *third-ah
+1777   var third-type/ecx: (addr int) <- get third, type
+1778   compare *third-type, 1/number
+1779   {
+1780     break-if-=
+1781     error trace, "third arg for 'pixel' is not an int (y coordinate)"
+1782     return
+1783   }
+1784   var third-value/eax: (addr float) <- get third, number-data
+1785   var y/ebx: int <- convert *third-value
+1786   # color = rest->right->left->value
+1787   var rest-ah/eax: (addr handle cell) <- get rest, right
+1788   var _rest/eax: (addr cell) <- lookup *rest-ah
+1789   rest <- copy _rest
+1790   {
+1791     var rest-type/ecx: (addr int) <- get rest, type
+1792     compare *rest-type, 0/pair
+1793     break-if-=
+1794     error trace, "'pixel' encountered non-pair"
+1795     return
+1796   }
+1797   {
+1798     var rest-nil?/eax: boolean <- nil? rest
+1799     compare rest-nil?, 0/false
+1800     break-if-=
+1801     error trace, "'pixel' needs 4 args but got 3"
+1802     return
+1803   }
+1804   var fourth-ah/eax: (addr handle cell) <- get rest, left
+1805   var fourth/eax: (addr cell) <- lookup *fourth-ah
+1806   var fourth-type/ecx: (addr int) <- get fourth, type
+1807   compare *fourth-type, 1/number
+1808   {
+1809     break-if-=
+1810     error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)"
+1811     return
+1812   }
+1813   var fourth-value/eax: (addr float) <- get fourth, number-data
+1814   var color/eax: int <- convert *fourth-value
+1815   pixel screen, x, y, color
+1816   # return nothing
+1817 }
+1818 
+1819 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1820   trace-text trace, "eval", "apply 'key'"
+1821   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1822   var _args/eax: (addr cell) <- lookup *args-ah
+1823   var args/esi: (addr cell) <- copy _args
+1824   {
+1825     var args-type/ecx: (addr int) <- get args, type
+1826     compare *args-type, 0/pair
+1827     break-if-=
+1828     error trace, "args to 'key' are not a list"
+1829     return
+1830   }
+1831   var empty-args?/eax: boolean <- nil? args
+1832   compare empty-args?, 0/false
+1833   {
+1834     break-if-=
+1835     error trace, "'key' needs 1 arg but got 0"
+1836     return
+1837   }
+1838   # keyboard = args->left
+1839   var first-ah/eax: (addr handle cell) <- get args, left
+1840   var first/eax: (addr cell) <- lookup *first-ah
+1841   var first-type/ecx: (addr int) <- get first, type
+1842   compare *first-type, 6/keyboard
+1843   {
+1844     break-if-=
+1845     error trace, "first arg for 'key' is not a keyboard"
+1846     return
+1847   }
+1848   var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
+1849   var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
+1850   var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
+1851   var result/eax: int <- wait-for-key keyboard
+1852   # return key typed
+1853   new-integer out, result
+1854 }
+1855 
+1856 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
+1857   # if keyboard is 0, use real keyboard
+1858   {
+1859     compare keyboard, 0/real-keyboard
+1860     break-if-!=
+1861     var key/eax: byte <- read-key 0/real-keyboard
+1862     var result/eax: int <- copy key
+1863     return result
+1864   }
+1865   # otherwise read from fake keyboard
+1866   var g/eax: grapheme <- read-from-gap-buffer keyboard
+1867   var result/eax: int <- copy g
+1868   return result
+1869 }
+1870 
+1871 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1872   trace-text trace, "eval", "apply stream"
+1873   allocate-stream out
+1874 }
+1875 
+1876 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1877   trace-text trace, "eval", "apply 'write'"
+1878   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1879   var _args/eax: (addr cell) <- lookup *args-ah
+1880   var args/esi: (addr cell) <- copy _args
+1881   {
+1882     var args-type/ecx: (addr int) <- get args, type
+1883     compare *args-type, 0/pair
+1884     break-if-=
+1885     error trace, "args to 'write' are not a list"
+1886     return
+1887   }
+1888   var empty-args?/eax: boolean <- nil? args
+1889   compare empty-args?, 0/false
+1890   {
+1891     break-if-=
+1892     error trace, "'write' needs 2 args but got 0"
+1893     return
+1894   }
+1895   # stream = args->left
+1896   var first-ah/edx: (addr handle cell) <- get args, left
+1897   var first/eax: (addr cell) <- lookup *first-ah
+1898   var first-type/ecx: (addr int) <- get first, type
+1899   compare *first-type, 3/stream
+1900   {
+1901     break-if-=
+1902     error trace, "first arg for 'write' is not a stream"
+1903     return
+1904   }
+1905   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
+1906   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
+1907   var stream-data/ebx: (addr stream byte) <- copy _stream-data
+1908   # args->right->left
+1909   var right-ah/eax: (addr handle cell) <- get args, right
+1910   var right/eax: (addr cell) <- lookup *right-ah
+1911   {
+1912     var right-type/ecx: (addr int) <- get right, type
+1913     compare *right-type, 0/pair
+1914     break-if-=
+1915     error trace, "'write' encountered non-pair"
+1916     return
+1917   }
+1918   {
+1919     var nil?/eax: boolean <- nil? right
+1920     compare nil?, 0/false
+1921     break-if-=
+1922     error trace, "'write' needs 2 args but got 1"
+1923     return
+1924   }
+1925   var second-ah/eax: (addr handle cell) <- get right, left
+1926   var second/eax: (addr cell) <- lookup *second-ah
+1927   var second-type/ecx: (addr int) <- get second, type
+1928   compare *second-type, 1/number
+1929   {
+1930     break-if-=
+1931     error trace, "second arg for 'write' is not a number/grapheme"
+1932     return
+1933   }
+1934   var second-value/eax: (addr float) <- get second, number-data
+1935   var x-float/xmm0: float <- copy *second-value
+1936   var x/eax: int <- convert x-float
+1937   var x-grapheme/eax: grapheme <- copy x
+1938   write-grapheme stream-data, x-grapheme
+1939   # return the stream
+1940   copy-object first-ah, out
+1941 }
+1942 
+1943 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1944   trace-text trace, "eval", "apply 'lines'"
+1945   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1946   var _args/eax: (addr cell) <- lookup *args-ah
+1947   var args/esi: (addr cell) <- copy _args
+1948   {
+1949     var args-type/ecx: (addr int) <- get args, type
+1950     compare *args-type, 0/pair
+1951     break-if-=
+1952     error trace, "args to 'lines' are not a list"
+1953     return
+1954   }
+1955   var empty-args?/eax: boolean <- nil? args
+1956   compare empty-args?, 0/false
+1957   {
+1958     break-if-=
+1959     error trace, "'lines' needs 1 arg but got 0"
+1960     return
+1961   }
+1962   # screen = args->left
+1963   var first-ah/eax: (addr handle cell) <- get args, left
+1964   var first/eax: (addr cell) <- lookup *first-ah
+1965   var first-type/ecx: (addr int) <- get first, type
+1966   compare *first-type, 5/screen
+1967   {
+1968     break-if-=
+1969     error trace, "first arg for 'lines' is not a screen"
+1970     return
+1971   }
+1972   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1973   var _screen/eax: (addr screen) <- lookup *screen-ah
+1974   var screen/edx: (addr screen) <- copy _screen
+1975   # compute dimensions
+1976   var dummy/eax: int <- copy 0
+1977   var height/ecx: int <- copy 0
+1978   dummy, height <- screen-size screen
+1979   var result/xmm0: float <- convert height
+1980   new-float out, result
+1981 }
+1982 
+1983 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1984   abort "aa"
+1985 }
+1986 
+1987 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1988   trace-text trace, "eval", "apply 'columns'"
+1989   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1990   var _args/eax: (addr cell) <- lookup *args-ah
+1991   var args/esi: (addr cell) <- copy _args
+1992   {
+1993     var args-type/ecx: (addr int) <- get args, type
+1994     compare *args-type, 0/pair
+1995     break-if-=
+1996     error trace, "args to 'columns' are not a list"
+1997     return
+1998   }
+1999   var empty-args?/eax: boolean <- nil? args
+2000   compare empty-args?, 0/false
+2001   {
+2002     break-if-=
+2003     error trace, "'columns' needs 1 arg but got 0"
+2004     return
+2005   }
+2006   # screen = args->left
+2007   var first-ah/eax: (addr handle cell) <- get args, left
+2008   var first/eax: (addr cell) <- lookup *first-ah
+2009   var first-type/ecx: (addr int) <- get first, type
+2010   compare *first-type, 5/screen
+2011   {
+2012     break-if-=
+2013     error trace, "first arg for 'columns' is not a screen"
+2014     return
+2015   }
+2016   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+2017   var _screen/eax: (addr screen) <- lookup *screen-ah
+2018   var screen/edx: (addr screen) <- copy _screen
+2019   # compute dimensions
+2020   var width/eax: int <- copy 0
+2021   var dummy/ecx: int <- copy 0
+2022   width, dummy <- screen-size screen
+2023   var result/xmm0: float <- convert width
+2024   new-float out, result
+2025 }
+2026 
+2027 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+2028   trace-text trace, "eval", "apply 'width'"
+2029   var args-ah/eax: (addr handle cell) <- copy _args-ah
+2030   var _args/eax: (addr cell) <- lookup *args-ah
+2031   var args/esi: (addr cell) <- copy _args
+2032   {
+2033     var args-type/ecx: (addr int) <- get args, type
+2034     compare *args-type, 0/pair
+2035     break-if-=
+2036     error trace, "args to 'width' are not a list"
+2037     return
+2038   }
+2039   var empty-args?/eax: boolean <- nil? args
+2040   compare empty-args?, 0/false
+2041   {
+2042     break-if-=
+2043     error trace, "'width' needs 1 arg but got 0"
+2044     return
+2045   }
+2046   # screen = args->left
+2047   var first-ah/eax: (addr handle cell) <- get args, left
+2048   var first/eax: (addr cell) <- lookup *first-ah
+2049   var first-type/ecx: (addr int) <- get first, type
+2050   compare *first-type, 5/screen
+2051   {
+2052     break-if-=
+2053     error trace, "first arg for 'width' is not a screen"
+2054     return
+2055   }
+2056   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+2057   var _screen/eax: (addr screen) <- lookup *screen-ah
+2058   var screen/edx: (addr screen) <- copy _screen
+2059   # compute dimensions
+2060   var width/eax: int <- copy 0
+2061   var dummy/ecx: int <- copy 0
+2062   width, dummy <- screen-size screen
+2063   width <- shift-left 3/log2-font-width
+2064   var result/xmm0: float <- convert width
+2065   new-float out, result
+2066 }
+2067 
+2068 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+2069   trace-text trace, "eval", "apply 'height'"
+2070   var args-ah/eax: (addr handle cell) <- copy _args-ah
+2071   var _args/eax: (addr cell) <- lookup *args-ah
+2072   var args/esi: (addr cell) <- copy _args
+2073   {
+2074     var args-type/ecx: (addr int) <- get args, type
+2075     compare *args-type, 0/pair
+2076     break-if-=
+2077     error trace, "args to 'height' are not a list"
+2078     return
+2079   }
+2080   var empty-args?/eax: boolean <- nil? args
+2081   compare empty-args?, 0/false
+2082   {
+2083     break-if-=
+2084     error trace, "'height' needs 1 arg but got 0"
+2085     return
+2086   }
+2087   # screen = args->left
+2088   var first-ah/eax: (addr handle cell) <- get args, left
+2089   var first/eax: (addr cell) <- lookup *first-ah
+2090   var first-type/ecx: (addr int) <- get first, type
+2091   compare *first-type, 5/screen
+2092   {
+2093     break-if-=
+2094     error trace, "first arg for 'height' is not a screen"
+2095     return
+2096   }
+2097   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+2098   var _screen/eax: (addr screen) <- lookup *screen-ah
+2099   var screen/edx: (addr screen) <- copy _screen
+2100   # compute dimensions
+2101   var dummy/eax: int <- copy 0
+2102   var height/ecx: int <- copy 0
+2103   dummy, height <- screen-size screen
+2104   height <- shift-left 4/log2-font-height
+2105   var result/xmm0: float <- convert height
+2106   new-float out, result
+2107 }
diff --git a/html/shell/print.mu.html b/html/shell/print.mu.html index 09e963d4..b528a799 100644 --- a/html/shell/print.mu.html +++ b/html/shell/print.mu.html @@ -15,14 +15,14 @@ body { font-size:12pt; font-family: monospace; color: #000000; background-color: a { color:inherit; } * { font-size:12pt; font-size: 1em; } .PreProc { color: #c000c0; } -.muRegEdx { color: #878700; } +.muRegEcx { color: #af875f; } .Special { color: #ff6060; } .LineNr { } -.muRegEsi { color: #87d787; } .muRegEdi { color: #87ffd7; } +.muRegEdx { color: #878700; } .Constant { color: #008787; } +.muRegEsi { color: #87d787; } .muRegEax { color: #875f00; } -.muRegEcx { color: #af875f; } .Delimiter { color: #c000c0; } .muFunction { color: #af5f00; text-decoration: underline; } .muTest { color: #5f8700; } diff --git a/html/shell/read.mu.html b/html/shell/read.mu.html index c25ebb64..e7ce90fd 100644 --- a/html/shell/read.mu.html +++ b/html/shell/read.mu.html @@ -15,11 +15,11 @@ body { font-size:12pt; font-family: monospace; color: #000000; background-color: a { color:inherit; } * { font-size:12pt; font-size: 1em; } .PreProc { color: #c000c0; } +.muRegEcx { color: #af875f; } .Special { color: #ff6060; } .LineNr { } .Constant { color: #008787; } .muRegEax { color: #875f00; } -.muRegEcx { color: #af875f; } .Delimiter { color: #c000c0; } .muFunction { color: #af5f00; text-decoration: underline; } .muComment { color: #005faf; } diff --git a/html/shell/sandbox.mu.html b/html/shell/sandbox.mu.html index d75bd69e..f0760df1 100644 --- a/html/shell/sandbox.mu.html +++ b/html/shell/sandbox.mu.html @@ -16,19 +16,19 @@ a { color:inherit; } * { font-size:12pt; font-size: 1em; } .LineNr { } .Delimiter { color: #c000c0; } -.muFunction { color: #af5f00; text-decoration: underline; } +.CommentedCode { color: #8a8a8a; } +.muRegEdx { color: #878700; } .muRegEbx { color: #8787af; } .muRegEsi { color: #87d787; } .muRegEdi { color: #87ffd7; } .Constant { color: #008787; } .Special { color: #ff6060; } .PreProc { color: #c000c0; } -.CommentedCode { color: #8a8a8a; } +.muFunction { color: #af5f00; text-decoration: underline; } .muTest { color: #5f8700; } .muComment { color: #005faf; } .muRegEax { color: #875f00; } .muRegEcx { color: #af875f; } -.muRegEdx { color: #878700; } --> @@ -75,21 +75,21 @@ if ('onhashchange' in window) { 9 cursor-in-keyboard?: boolean 10 } 11 - 12 fn initialize-sandbox _self: (addr sandbox), fake-screen-and-keyboard?: boolean { + 12 fn initialize-sandbox _self: (addr sandbox), fake-screen-width: int, fake-screen-height: int { 13 var self/esi: (addr sandbox) <- copy _self 14 var data-ah/eax: (addr handle gap-buffer) <- get self, data 15 allocate data-ah 16 var data/eax: (addr gap-buffer) <- lookup *data-ah - 17 initialize-gap-buffer data, 0x1000/4KB + 17 initialize-gap-buffer data, 0x2000/default-gap-buffer-size=8KB 18 # 19 var value-ah/eax: (addr handle stream byte) <- get self, value 20 populate-stream value-ah, 0x1000/4KB 21 # 22 { - 23 compare fake-screen-and-keyboard?, 0/false + 23 compare fake-screen-width, 0 24 break-if-= 25 var screen-ah/eax: (addr handle cell) <- get self, screen-var - 26 new-fake-screen screen-ah, 8/width, 3/height, 1/enable-pixel-graphics + 26 new-fake-screen screen-ah, fake-screen-width, fake-screen-height, 1/enable-pixel-graphics 27 var keyboard-ah/eax: (addr handle cell) <- get self, keyboard-var 28 new-fake-keyboard keyboard-ah, 0x10/keyboard-capacity 29 } @@ -132,7 +132,7 @@ if ('onhashchange' in window) { 66 var data-ah/eax: (addr handle gap-buffer) <- get self, data 67 var data/eax: (addr gap-buffer) <- lookup *data-ah 68 { - 69 var len/eax: int <- gap-buffer-length data + 69 var len/eax: int <- gap-buffer-length data 70 compare len, 0 71 break-if-!= 72 return @@ -145,7 +145,7 @@ if ('onhashchange' in window) { 79 ## 80 81 fn render-sandbox screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int, show-cursor?: boolean { - 82 clear-rect screen, xmin, ymin, xmax, ymax, 0xc5/bg=blue-bg + 82 clear-rect screen, xmin, ymin, xmax, ymax, 0xc5/bg=blue-bg 83 add-to xmin, 1/padding-left 84 add-to ymin, 1/padding-top 85 subtract-from xmax, 1/padding-right @@ -157,7 +157,7 @@ if ('onhashchange' in window) { 91 var x/eax: int <- copy xmin 92 var y/ecx: int <- copy ymin 93 y <- maybe-render-empty-screen screen, self, xmin, y - 94 y <- maybe-render-keyboard screen, self, xmin, y + 94 y <- maybe-render-keyboard screen, self, xmin, y 95 var cursor-in-editor?/ebx: boolean <- copy show-cursor? 96 { 97 compare cursor-in-editor?, 0/false @@ -190,7 +190,7 @@ if ('onhashchange' in window) { 124 var dummy/eax: int <- draw-stream-rightward screen, value, x2, xmax, y, 7/fg=grey, 0xc5/bg=blue-bg 125 } 126 y <- add 2 # padding - 127 y <- maybe-render-screen screen, self, xmin, y + 127 maybe-render-screen screen, self, xmin, y 128 } 129 130 fn render-sandbox-menu screen: (addr screen), _self: (addr sandbox) { @@ -199,7 +199,7 @@ if ('onhashchange' in window) { 133 compare *cursor-in-data?, 0/false 134 { 135 break-if-= - 136 render-sandbox-edit-menu screen, self + 136 render-sandbox-edit-menu screen, self 137 return 138 } 139 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace? @@ -213,7 +213,7 @@ if ('onhashchange' in window) { 147 compare *cursor-in-keyboard?, 0/false 148 { 149 break-if-= - 150 render-keyboard-menu screen + 150 render-keyboard-menu screen 151 return 152 } 153 } @@ -227,11 +227,11 @@ if ('onhashchange' in window) { 161 var x/eax: int <- copy xmin 162 var y/ecx: int <- copy ymin 163 y <- maybe-render-empty-screen screen, self, xmin, y - 164 y <- maybe-render-keyboard screen, self, xmin, y + 164 y <- maybe-render-keyboard screen, self, xmin, y 165 var cursor-in-sandbox?/ebx: (addr boolean) <- get self, cursor-in-data? 166 x, y <- render-gap-buffer-wrapping-right-then-down screen, data, x, y, xmax, ymax, *cursor-in-sandbox?, 3/fg, 0xc5/bg=blue-bg 167 y <- increment - 168 clear-rect screen, xmin, y, xmax, ymax, 0xc5/bg=blue-bg + 168 clear-rect screen, xmin, y, xmax, ymax, 0xc5/bg=blue-bg 169 } 170 171 fn maybe-render-empty-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int { @@ -254,1016 +254,947 @@ if ('onhashchange' in window) { 188 var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah 189 var screen-obj/edx: (addr screen) <- copy _screen-obj 190 var x/eax: int <- draw-text-rightward screen, "screen: ", xmin, 0x99/xmax, y, 0x17/fg, 0xc5/bg=blue-bg - 191 y <- render-empty-screen screen, screen-obj, x, y - 192 return y - 193 } - 194 - 195 fn maybe-render-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int { - 196 var self/esi: (addr sandbox) <- copy _self - 197 var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var - 198 var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah - 199 compare screen-obj-cell, 0 - 200 { - 201 break-if-!= - 202 return ymin - 203 } - 204 var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type - 205 compare *screen-obj-cell-type, 5/screen - 206 { - 207 break-if-= - 208 return ymin # silently give up on rendering the screen - 209 } - 210 var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data - 211 var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah - 212 var screen-obj/edx: (addr screen) <- copy _screen-obj - 213 { - 214 var screen-empty?/eax: boolean <- fake-screen-empty? screen-obj - 215 compare screen-empty?, 0/false - 216 break-if-= - 217 return ymin - 218 } - 219 var x/eax: int <- draw-text-rightward screen, "screen: ", xmin, 0x99/xmax, ymin, 0x17/fg, 0xc5/bg=blue-bg - 220 var y/ecx: int <- copy ymin - 221 y <- render-screen screen, screen-obj, x, y - 222 return y - 223 } - 224 - 225 fn render-empty-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int { - 226 var target-screen/esi: (addr screen) <- copy _target-screen - 227 var screen-y/edi: int <- copy ymin - 228 # screen - 229 var height/edx: (addr int) <- get target-screen, height - 230 var y/ecx: int <- copy 0 - 231 { - 232 compare y, *height - 233 break-if->= - 234 set-cursor-position screen, xmin, screen-y - 235 var width/edx: (addr int) <- get target-screen, width - 236 var x/ebx: int <- copy 0 - 237 { - 238 compare x, *width - 239 break-if->= - 240 draw-code-point-at-cursor screen, 0x20/space, 0x18/fg, 0/bg - 241 move-cursor-right screen - 242 x <- increment - 243 loop - 244 } - 245 y <- increment - 246 screen-y <- increment - 247 loop - 248 } - 249 return screen-y - 250 } - 251 - 252 fn render-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int { - 253 var target-screen/esi: (addr screen) <- copy _target-screen - 254 var screen-y/edi: int <- copy ymin - 255 # text data - 256 { - 257 var height/edx: (addr int) <- get target-screen, height - 258 var y/ecx: int <- copy 0 - 259 { - 260 compare y, *height - 261 break-if->= - 262 set-cursor-position screen, xmin, screen-y - 263 var width/edx: (addr int) <- get target-screen, width - 264 var x/ebx: int <- copy 0 - 265 { - 266 compare x, *width - 267 break-if->= - 268 print-screen-cell-of-fake-screen screen, target-screen, x, y - 269 move-cursor-right screen - 270 x <- increment - 271 loop - 272 } - 273 y <- increment - 274 screen-y <- increment - 275 loop - 276 } - 277 } - 278 # pixel data - 279 { - 280 # screen top left pixels x y width height - 281 var tmp/eax: int <- copy xmin - 282 tmp <- shift-left 3/log2-font-width - 283 var left: int - 284 copy-to left, tmp - 285 tmp <- copy ymin - 286 tmp <- shift-left 4/log2-font-height - 287 var top: int - 288 copy-to top, tmp - 289 var pixels-ah/eax: (addr handle array byte) <- get target-screen, pixels - 290 var _pixels/eax: (addr array byte) <- lookup *pixels-ah - 291 var pixels/edi: (addr array byte) <- copy _pixels - 292 compare pixels, 0 - 293 break-if-= - 294 var y/ebx: int <- copy 0 - 295 var height-addr/edx: (addr int) <- get target-screen, height - 296 var height/edx: int <- copy *height-addr - 297 height <- shift-left 4/log2-font-height - 298 { - 299 compare y, height - 300 break-if->= - 301 var width-addr/edx: (addr int) <- get target-screen, width - 302 var width/edx: int <- copy *width-addr - 303 width <- shift-left 3/log2-font-width - 304 var x/eax: int <- copy 0 - 305 { - 306 compare x, width - 307 break-if->= - 308 { - 309 var idx/ecx: int <- pixel-index target-screen, x, y - 310 var color-addr/ecx: (addr byte) <- index pixels, idx - 311 var color/ecx: byte <- copy-byte *color-addr - 312 var color2/ecx: int <- copy color - 313 compare color2, 0 - 314 break-if-= - 315 var x2/eax: int <- copy x - 316 x2 <- add left - 317 var y2/ebx: int <- copy y - 318 y2 <- add top - 319 pixel screen, x2, y2, color2 - 320 } - 321 x <- increment - 322 loop - 323 } - 324 y <- increment - 325 loop - 326 } - 327 } - 328 return screen-y - 329 } - 330 - 331 fn has-keyboard? _self: (addr sandbox) -> _/eax: boolean { - 332 var self/esi: (addr sandbox) <- copy _self - 333 var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var - 334 var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah - 335 compare keyboard-obj-cell, 0 - 336 { - 337 break-if-!= - 338 return 0/false - 339 } - 340 var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type - 341 compare *keyboard-obj-cell-type, 6/keyboard + 191 x <- copy xmin + 192 x <- add 2 + 193 y <- increment + 194 y <- render-empty-screen screen, screen-obj, x, y + 195 return y + 196 } + 197 + 198 fn maybe-render-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int { + 199 var self/esi: (addr sandbox) <- copy _self + 200 var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var + 201 var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah + 202 compare screen-obj-cell, 0 + 203 { + 204 break-if-!= + 205 return + 206 } + 207 var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type + 208 compare *screen-obj-cell-type, 5/screen + 209 { + 210 break-if-= + 211 return # silently give up on rendering the screen + 212 } + 213 var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data + 214 var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah + 215 var screen-obj/edx: (addr screen) <- copy _screen-obj + 216 { + 217 var screen-empty?/eax: boolean <- fake-screen-empty? screen-obj + 218 compare screen-empty?, 0/false + 219 break-if-= + 220 return + 221 } + 222 var x/eax: int <- draw-text-rightward screen, "screen: ", xmin, 0x99/xmax, ymin, 0x17/fg, 0xc5/bg=blue-bg + 223 x <- copy xmin + 224 x <- add 2 + 225 var y/ecx: int <- copy ymin + 226 y <- increment + 227 render-screen screen, screen-obj, x, y + 228 } + 229 + 230 fn render-empty-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int { + 231 var target-screen/esi: (addr screen) <- copy _target-screen + 232 var screen-y/edi: int <- copy ymin + 233 # screen + 234 var height/edx: (addr int) <- get target-screen, height + 235 var y/ecx: int <- copy 0 + 236 { + 237 compare y, *height + 238 break-if->= + 239 set-cursor-position screen, xmin, screen-y + 240 var width/edx: (addr int) <- get target-screen, width + 241 var x/ebx: int <- copy 0 + 242 { + 243 compare x, *width + 244 break-if->= + 245 draw-code-point-at-cursor screen, 0x20/space, 0x18/fg, 0/bg + 246 move-cursor-right screen + 247 x <- increment + 248 loop + 249 } + 250 y <- increment + 251 screen-y <- increment + 252 loop + 253 } + 254 return screen-y + 255 } + 256 + 257 fn render-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int { + 258 var target-screen/esi: (addr screen) <- copy _target-screen + 259 convert-graphemes-to-pixels target-screen # might overwrite existing pixel data with graphemes + 260 # overlapping the two is not supported + 261 # pixel data + 262 { + 263 # screen top left pixels x y width height + 264 var tmp/eax: int <- copy xmin + 265 tmp <- shift-left 3/log2-font-width + 266 var left: int + 267 copy-to left, tmp + 268 tmp <- copy ymin + 269 tmp <- shift-left 4/log2-font-height + 270 var top: int + 271 copy-to top, tmp + 272 var pixels-ah/eax: (addr handle array byte) <- get target-screen, pixels + 273 var _pixels/eax: (addr array byte) <- lookup *pixels-ah + 274 var pixels/edi: (addr array byte) <- copy _pixels + 275 compare pixels, 0 + 276 break-if-= + 277 var y/ebx: int <- copy 0 + 278 var height-addr/edx: (addr int) <- get target-screen, height + 279 var height/edx: int <- copy *height-addr + 280 height <- shift-left 4/log2-font-height + 281 { + 282 compare y, height + 283 break-if->= + 284 var width-addr/edx: (addr int) <- get target-screen, width + 285 var width/edx: int <- copy *width-addr + 286 width <- shift-left 3/log2-font-width + 287 var x/eax: int <- copy 0 + 288 { + 289 compare x, width + 290 break-if->= + 291 { + 292 var idx/ecx: int <- pixel-index target-screen, x, y + 293 var color-addr/ecx: (addr byte) <- index pixels, idx + 294 var color/ecx: byte <- copy-byte *color-addr + 295 var color2/ecx: int <- copy color + 296 var x2/eax: int <- copy x + 297 x2 <- add left + 298 var y2/ebx: int <- copy y + 299 y2 <- add top + 300 pixel screen, x2, y2, color2 + 301 } + 302 x <- increment + 303 loop + 304 } + 305 y <- increment + 306 loop + 307 } + 308 } + 309 } + 310 + 311 fn has-keyboard? _self: (addr sandbox) -> _/eax: boolean { + 312 var self/esi: (addr sandbox) <- copy _self + 313 var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var + 314 var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah + 315 compare keyboard-obj-cell, 0 + 316 { + 317 break-if-!= + 318 return 0/false + 319 } + 320 var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type + 321 compare *keyboard-obj-cell-type, 6/keyboard + 322 { + 323 break-if-= + 324 return 0/false + 325 } + 326 var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data + 327 var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah + 328 var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj + 329 compare keyboard-obj, 0 + 330 { + 331 break-if-!= + 332 return 0/false + 333 } + 334 return 1/true + 335 } + 336 + 337 fn maybe-render-keyboard screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int { + 338 var self/esi: (addr sandbox) <- copy _self + 339 var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var + 340 var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah + 341 compare keyboard-obj-cell, 0 342 { - 343 break-if-= - 344 return 0/false + 343 break-if-!= + 344 return ymin 345 } - 346 var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data - 347 var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah - 348 var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj - 349 compare keyboard-obj, 0 - 350 { - 351 break-if-!= - 352 return 0/false - 353 } - 354 return 1/true - 355 } - 356 - 357 fn maybe-render-keyboard screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int { - 358 var self/esi: (addr sandbox) <- copy _self - 359 var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var - 360 var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah - 361 compare keyboard-obj-cell, 0 - 362 { - 363 break-if-!= - 364 return ymin - 365 } - 366 var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type - 367 compare *keyboard-obj-cell-type, 6/keyboard - 368 { - 369 break-if-= - 370 return ymin # silently give up on rendering the keyboard - 371 } - 372 var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data - 373 var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah - 374 var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj - 375 var y/ecx: int <- copy ymin - 376 y <- increment # padding - 377 var x/eax: int <- draw-text-rightward screen, "keyboard: ", xmin, 0x99/xmax, y, 0x17/fg, 0xc5/bg=blue-bg - 378 var cursor-in-keyboard?/esi: (addr boolean) <- get self, cursor-in-keyboard? - 379 y <- render-keyboard screen, keyboard-obj, x, y, *cursor-in-keyboard? - 380 y <- increment # padding - 381 return y - 382 } - 383 - 384 fn render-keyboard screen: (addr screen), _keyboard: (addr gap-buffer), xmin: int, ymin: int, render-cursor?: boolean -> _/ecx: int { - 385 var keyboard/esi: (addr gap-buffer) <- copy _keyboard - 386 var width/edx: int <- copy 0x10/keyboard-capacity - 387 var y/edi: int <- copy ymin - 388 # keyboard - 389 var x/eax: int <- copy xmin - 390 var xmax/ecx: int <- copy x - 391 xmax <- add 0x10 - 392 var ymax/edx: int <- copy ymin - 393 ymax <- add 1 - 394 clear-rect screen, x, y, xmax, ymax, 0/bg - 395 x <- render-gap-buffer screen, keyboard, x, y, render-cursor?, 3/fg, 0/bg - 396 y <- increment - 397 return y - 398 } - 399 - 400 fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), x: int, y: int { - 401 var target/ecx: (addr screen) <- copy _target - 402 var data-ah/eax: (addr handle array screen-cell) <- get target, data - 403 var data/eax: (addr array screen-cell) <- lookup *data-ah - 404 var index/ecx: int <- screen-cell-index target, x, y - 405 var offset/ecx: (offset screen-cell) <- compute-offset data, index - 406 var src-cell/esi: (addr screen-cell) <- index data, offset - 407 var src-grapheme/eax: (addr grapheme) <- get src-cell, data - 408 var src-color/ecx: (addr int) <- get src-cell, color - 409 var src-background-color/edx: (addr int) <- get src-cell, background-color - 410 draw-grapheme-at-cursor screen, *src-grapheme, *src-color, *src-background-color - 411 } - 412 - 413 fn render-sandbox-edit-menu screen: (addr screen), _self: (addr sandbox) { - 414 var _width/eax: int <- copy 0 - 415 var height/ecx: int <- copy 0 - 416 _width, height <- screen-size screen - 417 var width/edx: int <- copy _width - 418 var y/ecx: int <- copy height - 419 y <- decrement - 420 var height/ebx: int <- copy y - 421 height <- increment - 422 clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg - 423 set-cursor-position screen, 0/x, y - 424 draw-text-rightward-from-cursor screen, " ^r ", width, 0/fg, 0x5c/bg=menu-highlight - 425 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0xc5/bg=blue-bg - 426 draw-text-rightward-from-cursor screen, " ^s ", width, 0/fg, 0x5c/bg=menu-highlight - 427 draw-text-rightward-from-cursor screen, " run sandbox ", width, 7/fg, 0xc5/bg=blue-bg - 428 draw-text-rightward-from-cursor screen, " ^g ", width, 0/fg, 0x5c/bg=menu-highlight - 429 draw-text-rightward-from-cursor screen, " go to ", width, 7/fg, 0xc5/bg=blue-bg - 430 $render-sandbox-edit-menu:render-ctrl-m: { - 431 var self/eax: (addr sandbox) <- copy _self - 432 var has-trace?/eax: boolean <- has-trace? self - 433 compare has-trace?, 0/false - 434 { - 435 break-if-= - 436 draw-text-rightward-from-cursor screen, " ^m ", width, 0/fg, 0x38/bg=trace - 437 draw-text-rightward-from-cursor screen, " to trace ", width, 7/fg, 0xc5/bg=blue-bg - 438 break $render-sandbox-edit-menu:render-ctrl-m - 439 } - 440 draw-text-rightward-from-cursor screen, " ^m ", width, 0/fg, 3/bg=keyboard - 441 draw-text-rightward-from-cursor screen, " to keyboard ", width, 7/fg, 0xc5/bg=blue-bg - 442 } - 443 draw-text-rightward-from-cursor screen, " ^a ", width, 0/fg, 0x5c/bg=menu-highlight - 444 draw-text-rightward-from-cursor screen, " << ", width, 7/fg, 0xc5/bg=blue-bg - 445 draw-text-rightward-from-cursor screen, " ^b ", width, 0/fg, 0x5c/bg=menu-highlight - 446 draw-text-rightward-from-cursor screen, " <word ", width, 7/fg, 0xc5/bg=blue-bg - 447 draw-text-rightward-from-cursor screen, " ^f ", width, 0/fg, 0x5c/bg=menu-highlight - 448 draw-text-rightward-from-cursor screen, " word> ", width, 7/fg, 0xc5/bg=blue-bg - 449 draw-text-rightward-from-cursor screen, " ^e ", width, 0/fg, 0x5c/bg=menu-highlight - 450 draw-text-rightward-from-cursor screen, " >> ", width, 7/fg, 0xc5/bg=blue-bg + 346 var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type + 347 compare *keyboard-obj-cell-type, 6/keyboard + 348 { + 349 break-if-= + 350 return ymin # silently give up on rendering the keyboard + 351 } + 352 var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data + 353 var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah + 354 var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj + 355 var y/ecx: int <- copy ymin + 356 y <- increment # padding + 357 var x/eax: int <- draw-text-rightward screen, "keyboard: ", xmin, 0x99/xmax, y, 0x17/fg, 0xc5/bg=blue-bg + 358 var cursor-in-keyboard?/esi: (addr boolean) <- get self, cursor-in-keyboard? + 359 y <- render-keyboard screen, keyboard-obj, x, y, *cursor-in-keyboard? + 360 y <- increment # padding + 361 return y + 362 } + 363 + 364 fn render-keyboard screen: (addr screen), _keyboard: (addr gap-buffer), xmin: int, ymin: int, render-cursor?: boolean -> _/ecx: int { + 365 var keyboard/esi: (addr gap-buffer) <- copy _keyboard + 366 var width/edx: int <- copy 0x10/keyboard-capacity + 367 var y/edi: int <- copy ymin + 368 # keyboard + 369 var x/eax: int <- copy xmin + 370 var xmax/ecx: int <- copy x + 371 xmax <- add 0x10 + 372 var ymax/edx: int <- copy ymin + 373 ymax <- add 1 + 374 clear-rect screen, x, y, xmax, ymax, 0/bg + 375 x <- render-gap-buffer screen, keyboard, x, y, render-cursor?, 3/fg, 0/bg + 376 y <- increment + 377 return y + 378 } + 379 + 380 fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), x: int, y: int { + 381 var target/ecx: (addr screen) <- copy _target + 382 var data-ah/eax: (addr handle array screen-cell) <- get target, data + 383 var data/eax: (addr array screen-cell) <- lookup *data-ah + 384 var index/ecx: int <- screen-cell-index target, x, y + 385 var offset/ecx: (offset screen-cell) <- compute-offset data, index + 386 var src-cell/esi: (addr screen-cell) <- index data, offset + 387 var src-grapheme/eax: (addr grapheme) <- get src-cell, data + 388 var src-color/ecx: (addr int) <- get src-cell, color + 389 var src-background-color/edx: (addr int) <- get src-cell, background-color + 390 draw-grapheme-at-cursor screen, *src-grapheme, *src-color, *src-background-color + 391 } + 392 + 393 fn render-sandbox-edit-menu screen: (addr screen), _self: (addr sandbox) { + 394 var _width/eax: int <- copy 0 + 395 var height/ecx: int <- copy 0 + 396 _width, height <- screen-size screen + 397 var width/edx: int <- copy _width + 398 var y/ecx: int <- copy height + 399 y <- decrement + 400 var height/ebx: int <- copy y + 401 height <- increment + 402 clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg + 403 set-cursor-position screen, 0/x, y + 404 draw-text-rightward-from-cursor screen, " ^r ", width, 0/fg, 0x5c/bg=menu-highlight + 405 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0xc5/bg=blue-bg + 406 draw-text-rightward-from-cursor screen, " ^s ", width, 0/fg, 0x5c/bg=menu-highlight + 407 draw-text-rightward-from-cursor screen, " run sandbox ", width, 7/fg, 0xc5/bg=blue-bg + 408 draw-text-rightward-from-cursor screen, " ^g ", width, 0/fg, 0x5c/bg=menu-highlight + 409 draw-text-rightward-from-cursor screen, " go to ", width, 7/fg, 0xc5/bg=blue-bg + 410 $render-sandbox-edit-menu:render-ctrl-m: { + 411 var self/eax: (addr sandbox) <- copy _self + 412 var has-trace?/eax: boolean <- has-trace? self + 413 compare has-trace?, 0/false + 414 { + 415 break-if-= + 416 draw-text-rightward-from-cursor screen, " ^m ", width, 0/fg, 0x38/bg=trace + 417 draw-text-rightward-from-cursor screen, " to trace ", width, 7/fg, 0xc5/bg=blue-bg + 418 break $render-sandbox-edit-menu:render-ctrl-m + 419 } + 420 draw-text-rightward-from-cursor screen, " ^m ", width, 0/fg, 3/bg=keyboard + 421 draw-text-rightward-from-cursor screen, " to keyboard ", width, 7/fg, 0xc5/bg=blue-bg + 422 } + 423 draw-text-rightward-from-cursor screen, " ^a ", width, 0/fg, 0x5c/bg=menu-highlight + 424 draw-text-rightward-from-cursor screen, " << ", width, 7/fg, 0xc5/bg=blue-bg + 425 draw-text-rightward-from-cursor screen, " ^b ", width, 0/fg, 0x5c/bg=menu-highlight + 426 draw-text-rightward-from-cursor screen, " <word ", width, 7/fg, 0xc5/bg=blue-bg + 427 draw-text-rightward-from-cursor screen, " ^f ", width, 0/fg, 0x5c/bg=menu-highlight + 428 draw-text-rightward-from-cursor screen, " word> ", width, 7/fg, 0xc5/bg=blue-bg + 429 draw-text-rightward-from-cursor screen, " ^e ", width, 0/fg, 0x5c/bg=menu-highlight + 430 draw-text-rightward-from-cursor screen, " >> ", width, 7/fg, 0xc5/bg=blue-bg + 431 } + 432 + 433 fn render-keyboard-menu screen: (addr screen) { + 434 var width/eax: int <- copy 0 + 435 var height/ecx: int <- copy 0 + 436 width, height <- screen-size screen + 437 var y/ecx: int <- copy height + 438 y <- decrement + 439 var height/edx: int <- copy y + 440 height <- increment + 441 clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg + 442 set-cursor-position screen, 0/x, y + 443 draw-text-rightward-from-cursor screen, " ^r ", width, 0/fg, 0x5c/bg=menu-highlight + 444 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0xc5/bg=blue-bg + 445 draw-text-rightward-from-cursor screen, " ^s ", width, 0/fg, 0x5c/bg=menu-highlight + 446 draw-text-rightward-from-cursor screen, " run sandbox ", width, 7/fg, 0xc5/bg=blue-bg + 447 draw-text-rightward-from-cursor screen, " ^g ", width, 0/fg, 0x5c/bg=menu-highlight + 448 draw-text-rightward-from-cursor screen, " go to ", width, 7/fg, 0xc5/bg=blue-bg + 449 draw-text-rightward-from-cursor screen, " ^m ", width, 0/fg, 7/bg + 450 draw-text-rightward-from-cursor screen, " to sandbox ", width, 7/fg, 0xc5/bg=blue-bg 451 } 452 - 453 fn render-keyboard-menu screen: (addr screen) { - 454 var width/eax: int <- copy 0 - 455 var height/ecx: int <- copy 0 - 456 width, height <- screen-size screen - 457 var y/ecx: int <- copy height - 458 y <- decrement - 459 var height/edx: int <- copy y - 460 height <- increment - 461 clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg - 462 set-cursor-position screen, 0/x, y - 463 draw-text-rightward-from-cursor screen, " ^r ", width, 0/fg, 0x5c/bg=menu-highlight - 464 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0xc5/bg=blue-bg - 465 draw-text-rightward-from-cursor screen, " ^s ", width, 0/fg, 0x5c/bg=menu-highlight - 466 draw-text-rightward-from-cursor screen, " run sandbox ", width, 7/fg, 0xc5/bg=blue-bg - 467 draw-text-rightward-from-cursor screen, " ^g ", width, 0/fg, 0x5c/bg=menu-highlight - 468 draw-text-rightward-from-cursor screen, " go to ", width, 7/fg, 0xc5/bg=blue-bg - 469 draw-text-rightward-from-cursor screen, " ^m ", width, 0/fg, 7/bg - 470 draw-text-rightward-from-cursor screen, " to sandbox ", width, 7/fg, 0xc5/bg=blue-bg - 471 } - 472 - 473 fn edit-sandbox _self: (addr sandbox), key: grapheme, globals: (addr global-table), data-disk: (addr disk), tweak-real-screen?: boolean { - 474 var self/esi: (addr sandbox) <- copy _self - 475 # ctrl-s - 476 { - 477 compare key, 0x13/ctrl-s - 478 break-if-!= - 479 # if cursor is in trace, skip - 480 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace? - 481 compare *cursor-in-trace?, 0/false - 482 break-if-!= - 483 # minor gotcha here: any bindings created later in this iteration won't be - 484 # persisted until the next call to ctrl-s. - 485 store-state data-disk, self, globals - 486 # - 487 run-sandbox self, globals, tweak-real-screen? - 488 return - 489 } - 490 # ctrl-m - 491 { - 492 compare key, 0xd/ctrl-m - 493 break-if-!= - 494 # if cursor in data, switch to trace or fall through to keyboard - 495 { - 496 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data? - 497 compare *cursor-in-data?, 0/false - 498 break-if-= - 499 var has-trace?/eax: boolean <- has-trace? self - 500 compare has-trace?, 0/false - 501 { - 502 break-if-= - 503 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data? - 504 copy-to *cursor-in-data?, 0/false - 505 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace? - 506 copy-to *cursor-in-trace?, 1/false - 507 return - 508 } - 509 var has-keyboard?/eax: boolean <- has-keyboard? self - 510 compare has-keyboard?, 0/false - 511 { - 512 break-if-= - 513 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data? - 514 copy-to *cursor-in-data?, 0/false - 515 var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard? - 516 copy-to *cursor-in-keyboard?, 1/false - 517 return - 518 } - 519 return - 520 } - 521 # if cursor in trace, switch to keyboard or fall through to data - 522 { - 523 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace? - 524 compare *cursor-in-trace?, 0/false - 525 break-if-= - 526 copy-to *cursor-in-trace?, 0/false - 527 var cursor-target/ecx: (addr boolean) <- get self, cursor-in-keyboard? - 528 var has-keyboard?/eax: boolean <- has-keyboard? self - 529 compare has-keyboard?, 0/false - 530 { - 531 break-if-!= - 532 cursor-target <- get self, cursor-in-data? - 533 } - 534 copy-to *cursor-target, 1/true - 535 return - 536 } - 537 # otherwise if cursor in keyboard, switch to data - 538 { - 539 var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard? - 540 compare *cursor-in-keyboard?, 0/false - 541 break-if-= - 542 copy-to *cursor-in-keyboard?, 0/false - 543 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data? - 544 copy-to *cursor-in-data?, 1/true - 545 return - 546 } - 547 return - 548 } - 549 # if cursor in data, send key to data - 550 { - 551 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data? - 552 compare *cursor-in-data?, 0/false - 553 break-if-= - 554 var data-ah/eax: (addr handle gap-buffer) <- get self, data - 555 var data/eax: (addr gap-buffer) <- lookup *data-ah - 556 edit-gap-buffer data, key - 557 return - 558 } - 559 # if cursor in keyboard, send key to keyboard - 560 { - 561 var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard? - 562 compare *cursor-in-keyboard?, 0/false - 563 break-if-= - 564 var keyboard-cell-ah/eax: (addr handle cell) <- get self, keyboard-var - 565 var keyboard-cell/eax: (addr cell) <- lookup *keyboard-cell-ah - 566 compare keyboard-cell, 0 - 567 { - 568 break-if-!= - 569 return - 570 } - 571 var keyboard-cell-type/ecx: (addr int) <- get keyboard-cell, type - 572 compare *keyboard-cell-type, 6/keyboard - 573 { - 574 break-if-= - 575 return - 576 } - 577 var keyboard-ah/eax: (addr handle gap-buffer) <- get keyboard-cell, keyboard-data - 578 var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah - 579 edit-gap-buffer keyboard, key - 580 return - 581 } - 582 # if cursor in trace, send key to trace - 583 { - 584 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace? - 585 compare *cursor-in-trace?, 0/false - 586 break-if-= - 587 var trace-ah/eax: (addr handle trace) <- get self, trace - 588 var trace/eax: (addr trace) <- lookup *trace-ah - 589 # if expanding the trace, first check if we need to run the sandbox again with a deeper trace - 590 { - 591 compare key, 0xa/newline - 592 break-if-!= - 593 { - 594 var need-rerun?/eax: boolean <- cursor-too-deep? trace - 595 compare need-rerun?, 0/false - 596 } - 597 break-if-= - 598 #? draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "rerun", 7/fg 0/bg - 599 # save trace lines at various cached indices - 600 var save: trace-index-stash - 601 var save-addr/ecx: (addr trace-index-stash) <- address save - 602 save-indices trace, save-addr - 603 # rerun at higher depth - 604 var max-depth-addr/ecx: (addr int) <- get trace, max-depth - 605 increment *max-depth-addr - 606 run-sandbox self, globals, tweak-real-screen? - 607 # recompute cached indices - 608 recompute-all-visible-lines trace - 609 var save-addr/ecx: (addr trace-index-stash) <- address save - 610 restore-indices trace, save-addr - 611 } - 612 edit-trace trace, key - 613 return - 614 } - 615 } - 616 - 617 # hack: tweak-real-screen guards things there are no tests for - 618 fn run-sandbox _self: (addr sandbox), globals: (addr global-table), tweak-real-screen?: boolean { - 619 var self/esi: (addr sandbox) <- copy _self - 620 var data-ah/ecx: (addr handle gap-buffer) <- get self, data - 621 var value-ah/eax: (addr handle stream byte) <- get self, value - 622 var _value/eax: (addr stream byte) <- lookup *value-ah - 623 var value/edx: (addr stream byte) <- copy _value - 624 var trace-ah/eax: (addr handle trace) <- get self, trace - 625 var _trace/eax: (addr trace) <- lookup *trace-ah - 626 var trace/ebx: (addr trace) <- copy _trace - 627 clear-trace trace - 628 { - 629 compare tweak-real-screen?, 0/false - 630 break-if-= - 631 clear-sandbox-output 0/screen, self, 0x56/sandbox-left-margin, 1/y, 0x80/screen-width, 0x2f/screen-height-without-menu - 632 } - 633 var screen-cell/eax: (addr handle cell) <- get self, screen-var - 634 clear-screen-cell screen-cell - 635 var keyboard-cell/esi: (addr handle cell) <- get self, keyboard-var - 636 rewind-keyboard-cell keyboard-cell # don't clear keys from before - 637 { - 638 compare tweak-real-screen?, 0/false - 639 break-if-= - 640 set-cursor-position 0/screen, 0/x, 0/y # for any debug prints during evaluation - 641 } - 642 run data-ah, value, globals, trace, screen-cell, keyboard-cell - 643 } - 644 - 645 fn run _in-ah: (addr handle gap-buffer), out: (addr stream byte), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { - 646 var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah - 647 var in/eax: (addr gap-buffer) <- lookup *in-ah - 648 var read-result-h: (handle cell) - 649 var read-result-ah/esi: (addr handle cell) <- address read-result-h - 650 read-cell in, read-result-ah, trace - 651 var error?/eax: boolean <- has-errors? trace - 652 { - 653 compare error?, 0/false - 654 break-if-= - 655 return - 656 } - 657 macroexpand read-result-ah, globals, trace - 658 var error?/eax: boolean <- has-errors? trace - 659 { - 660 compare error?, 0/false - 661 break-if-= - 662 return - 663 } - 664 var nil-h: (handle cell) - 665 var nil-ah/eax: (addr handle cell) <- address nil-h - 666 allocate-pair nil-ah - 667 var eval-result-h: (handle cell) - 668 var eval-result-ah/edi: (addr handle cell) <- address eval-result-h - 669 #? set-cursor-position 0/screen, 0 0 - 670 #? turn-on-debug-print - 671 debug-print "^", 4/fg, 0/bg - 672 evaluate read-result-ah, eval-result-ah, *nil-ah, globals, trace, screen-cell, keyboard-cell, 1/call-number - 673 debug-print "$", 4/fg, 0/bg - 674 var error?/eax: boolean <- has-errors? trace - 675 { - 676 compare error?, 0/false - 677 break-if-= - 678 return - 679 } - 680 # if there was no error and the read-result starts with "set" or "def", save - 681 # the gap buffer in the modified global, then create a new one for the next - 682 # command. - 683 maybe-stash-gap-buffer-to-global globals, read-result-ah, _in-ah - 684 clear-stream out - 685 print-cell eval-result-ah, out, trace - 686 mark-lines-dirty trace - 687 } - 688 - 689 fn read-evaluate-and-move-to-globals _in-ah: (addr handle gap-buffer), globals: (addr global-table), definition-name: (addr stream byte) { - 690 var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah - 691 var in/eax: (addr gap-buffer) <- lookup *in-ah - 692 var read-result-h: (handle cell) - 693 var read-result-ah/esi: (addr handle cell) <- address read-result-h - 694 var trace-storage: trace - 695 var trace/edx: (addr trace) <- address trace-storage - 696 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible - 697 read-cell in, read-result-ah, trace - 698 macroexpand read-result-ah, globals, trace - 699 var nil-storage: (handle cell) - 700 var nil-ah/eax: (addr handle cell) <- address nil-storage - 701 allocate-pair nil-ah - 702 var eval-result-storage: (handle cell) - 703 var eval-result/edi: (addr handle cell) <- address eval-result-storage - 704 debug-print "^", 4/fg, 0/bg - 705 evaluate read-result-ah, eval-result, *nil-ah, globals, trace, 0/no-screen-cell, 0/no-keyboard-cell, 1/call-number - 706 { - 707 var error?/eax: boolean <- has-errors? trace - 708 compare error?, 0/false - 709 break-if-= - 710 set-cursor-position 0/screen, 0x40/x, 0x18/y - 711 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "error when loading definition for ", 4/fg 0/bg - 712 rewind-stream definition-name - 713 draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, definition-name, 3/fg 0/bg - 714 set-cursor-position 0/screen, 0x40/x, 0x19/y - 715 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "see trace in grey at top-left", 7/fg 0/bg - 716 dump-trace trace # will print from 0, 0 - 717 { - 718 loop - 719 } - 720 } - 721 debug-print "$", 4/fg, 0/bg - 722 move-gap-buffer-to-global globals, read-result-ah, _in-ah - 723 } - 724 - 725 fn test-run-integer { - 726 var sandbox-storage: sandbox - 727 var sandbox/esi: (addr sandbox) <- address sandbox-storage - 728 initialize-sandbox-with sandbox, "1" - 729 # eval - 730 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 731 # setup: screen - 732 var screen-on-stack: screen - 733 var screen/edi: (addr screen) <- address screen-on-stack - 734 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics - 735 # - 736 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 737 # skip one line of padding - 738 check-screen-row screen, 1/y, " 1 ", "F - test-run-integer/0" - 739 check-screen-row screen, 2/y, " ... ", "F - test-run-integer/1" - 740 check-screen-row screen, 3/y, " => 1 ", "F - test-run-integer/2" - 741 } - 742 - 743 fn test-run-error-invalid-integer { - 744 var sandbox-storage: sandbox - 745 var sandbox/esi: (addr sandbox) <- address sandbox-storage - 746 initialize-sandbox-with sandbox, "1a" - 747 # eval - 748 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 749 # setup: screen - 750 var screen-on-stack: screen - 751 var screen/edi: (addr screen) <- address screen-on-stack - 752 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics - 753 # - 754 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 755 # skip one line of padding - 756 check-screen-row screen, 1/y, " 1a ", "F - test-run-error-invalid-integer/0" - 757 check-screen-row screen, 2/y, " ... ", "F - test-run-error-invalid-integer/1" - 758 check-screen-row-in-color screen, 0xc/fg=error, 3/y, " invalid number ", "F - test-run-error-invalid-integer/2" - 759 } - 760 - 761 fn test-run-error-unknown-symbol { - 762 var sandbox-storage: sandbox - 763 var sandbox/esi: (addr sandbox) <- address sandbox-storage - 764 initialize-sandbox-with sandbox, "a" - 765 # eval - 766 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 767 # setup: screen - 768 var screen-on-stack: screen - 769 var screen/edi: (addr screen) <- address screen-on-stack - 770 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics - 771 # - 772 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 773 # skip one line of padding - 774 check-screen-row screen, 1/y, " a ", "F - test-run-error-unknown-symbol/0" - 775 check-screen-row screen, 2/y, " ... ", "F - test-run-error-unknown-symbol/1" - 776 check-screen-row-in-color screen, 0xc/fg=error, 3/y, " unbound symbol: a ", "F - test-run-error-unknown-symbol/2" - 777 } - 778 - 779 fn test-run-with-spaces { - 780 var sandbox-storage: sandbox - 781 var sandbox/esi: (addr sandbox) <- address sandbox-storage - 782 initialize-sandbox-with sandbox, " 1 \n" - 783 # eval - 784 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 785 # setup: screen - 786 var screen-on-stack: screen - 787 var screen/edi: (addr screen) <- address screen-on-stack - 788 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics - 789 # - 790 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 791 # skip one line of padding - 792 check-screen-row screen, 1/y, " 1 ", "F - test-run-with-spaces/0" - 793 check-screen-row screen, 2/y, " ", "F - test-run-with-spaces/1" - 794 check-screen-row screen, 3/y, " ... ", "F - test-run-with-spaces/2" - 795 check-screen-row screen, 4/y, " => 1 ", "F - test-run-with-spaces/3" - 796 } - 797 - 798 fn test-run-quote { - 799 var sandbox-storage: sandbox - 800 var sandbox/esi: (addr sandbox) <- address sandbox-storage - 801 initialize-sandbox-with sandbox, "'a" - 802 # eval - 803 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 804 # setup: screen - 805 var screen-on-stack: screen - 806 var screen/edi: (addr screen) <- address screen-on-stack - 807 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics - 808 # - 809 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 810 # skip one line of padding - 811 check-screen-row screen, 1/y, " 'a ", "F - test-run-quote/0" - 812 check-screen-row screen, 2/y, " ... ", "F - test-run-quote/1" - 813 check-screen-row screen, 3/y, " => a ", "F - test-run-quote/2" - 814 } - 815 - 816 fn test-run-dotted-list { - 817 var sandbox-storage: sandbox - 818 var sandbox/esi: (addr sandbox) <- address sandbox-storage - 819 initialize-sandbox-with sandbox, "'(a . b)" - 820 # eval - 821 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 822 # setup: screen - 823 var screen-on-stack: screen - 824 var screen/edi: (addr screen) <- address screen-on-stack - 825 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics - 826 # - 827 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 828 # skip one line of padding - 829 check-screen-row screen, 1/y, " '(a . b) ", "F - test-run-dotted-list/0" - 830 check-screen-row screen, 2/y, " ... ", "F - test-run-dotted-list/1" - 831 check-screen-row screen, 3/y, " => (a . b) ", "F - test-run-dotted-list/2" - 832 } - 833 - 834 fn test-run-dot-and-list { - 835 var sandbox-storage: sandbox - 836 var sandbox/esi: (addr sandbox) <- address sandbox-storage - 837 initialize-sandbox-with sandbox, "'(a . (b))" - 838 # eval - 839 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 840 # setup: screen - 841 var screen-on-stack: screen - 842 var screen/edi: (addr screen) <- address screen-on-stack - 843 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics - 844 # - 845 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 846 # skip one line of padding - 847 check-screen-row screen, 1/y, " '(a . (b)) ", "F - test-run-dot-and-list/0" - 848 check-screen-row screen, 2/y, " ... ", "F - test-run-dot-and-list/1" - 849 check-screen-row screen, 3/y, " => (a b) ", "F - test-run-dot-and-list/2" - 850 } - 851 - 852 fn test-run-final-dot { - 853 var sandbox-storage: sandbox - 854 var sandbox/esi: (addr sandbox) <- address sandbox-storage - 855 initialize-sandbox-with sandbox, "'(a .)" - 856 # eval - 857 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 858 # setup: screen - 859 var screen-on-stack: screen - 860 var screen/edi: (addr screen) <- address screen-on-stack - 861 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics - 862 # - 863 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 864 # skip one line of padding - 865 check-screen-row screen, 1/y, " '(a .) ", "F - test-run-final-dot/0" - 866 check-screen-row screen, 2/y, " ... ", "F - test-run-final-dot/1" - 867 check-screen-row screen, 3/y, " '. )' makes no sense ", "F - test-run-final-dot/2" - 868 # further errors may occur - 869 } - 870 - 871 fn test-run-double-dot { - 872 var sandbox-storage: sandbox - 873 var sandbox/esi: (addr sandbox) <- address sandbox-storage - 874 initialize-sandbox-with sandbox, "'(a . .)" - 875 # eval - 876 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 877 # setup: screen - 878 var screen-on-stack: screen - 879 var screen/edi: (addr screen) <- address screen-on-stack - 880 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics - 881 # - 882 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 883 # skip one line of padding - 884 check-screen-row screen, 1/y, " '(a . .) ", "F - test-run-double-dot/0" - 885 check-screen-row screen, 2/y, " ... ", "F - test-run-double-dot/1" - 886 check-screen-row screen, 3/y, " '. .' makes no sense ", "F - test-run-double-dot/2" - 887 # further errors may occur - 888 } - 889 - 890 fn test-run-multiple-expressions-after-dot { - 891 var sandbox-storage: sandbox - 892 var sandbox/esi: (addr sandbox) <- address sandbox-storage - 893 initialize-sandbox-with sandbox, "'(a . b c)" - 894 # eval - 895 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 896 # setup: screen - 897 var screen-on-stack: screen - 898 var screen/edi: (addr screen) <- address screen-on-stack - 899 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics - 900 # - 901 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 902 # skip one line of padding - 903 check-screen-row screen, 1/y, " '(a . b c) ", "F - test-run-multiple-expressions-after-dot/0" - 904 check-screen-row screen, 2/y, " ... ", "F - test-run-multiple-expressions-after-dot/1" - 905 check-screen-row screen, 3/y, " cannot have multiple expressions between '.' and ')' ", "F - test-run-multiple-expressions-after-dot/2" - 906 # further errors may occur - 907 } - 908 - 909 fn test-run-stream { - 910 var sandbox-storage: sandbox - 911 var sandbox/esi: (addr sandbox) <- address sandbox-storage - 912 initialize-sandbox-with sandbox, "[a b]" - 913 # eval - 914 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 915 # setup: screen - 916 var screen-on-stack: screen - 917 var screen/edi: (addr screen) <- address screen-on-stack - 918 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics - 919 # - 920 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 921 # skip one line of padding - 922 check-screen-row screen, 1/y, " [a b] ", "F - test-run-stream/0" - 923 check-screen-row screen, 2/y, " ... ", "F - test-run-stream/1" - 924 check-screen-row screen, 3/y, " => [a b] ", "F - test-run-stream/2" - 925 } - 926 - 927 fn test-run-move-cursor-into-trace { - 928 var sandbox-storage: sandbox - 929 var sandbox/esi: (addr sandbox) <- address sandbox-storage - 930 initialize-sandbox-with sandbox, "12" - 931 # eval - 932 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 933 # setup: screen - 934 var screen-on-stack: screen - 935 var screen/edi: (addr screen) <- address screen-on-stack - 936 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics - 937 # - 938 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 939 # skip one line of padding - 940 check-screen-row screen, 1/y, " 12 ", "F - test-run-move-cursor-into-trace/pre-0" - 941 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-move-cursor-into-trace/pre-0/cursor" - 942 check-screen-row screen, 2/y, " ... ", "F - test-run-move-cursor-into-trace/pre-1" - 943 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-move-cursor-into-trace/pre-1/cursor" - 944 check-screen-row screen, 3/y, " => 12 ", "F - test-run-move-cursor-into-trace/pre-2" - 945 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-move-cursor-into-trace/pre-2/cursor" - 946 # move cursor into trace - 947 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 948 # - 949 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 950 # skip one line of padding - 951 check-screen-row screen, 1/y, " 12 ", "F - test-run-move-cursor-into-trace/trace-0" - 952 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-move-cursor-into-trace/trace-0/cursor" - 953 check-screen-row screen, 2/y, " ... ", "F - test-run-move-cursor-into-trace/trace-1" - 954 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||| ", "F - test-run-move-cursor-into-trace/trace-1/cursor" - 955 check-screen-row screen, 3/y, " => 12 ", "F - test-run-move-cursor-into-trace/trace-2" - 956 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-move-cursor-into-trace/trace-2/cursor" - 957 # move cursor into input - 958 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 959 # - 960 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor - 961 # skip one line of padding - 962 check-screen-row screen, 1/y, " 12 ", "F - test-run-move-cursor-into-trace/input-0" - 963 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-move-cursor-into-trace/input-0/cursor" - 964 check-screen-row screen, 2/y, " ... ", "F - test-run-move-cursor-into-trace/input-1" - 965 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-move-cursor-into-trace/input-1/cursor" - 966 check-screen-row screen, 3/y, " => 12 ", "F - test-run-move-cursor-into-trace/input-2" - 967 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-move-cursor-into-trace/input-2/cursor" - 968 } - 969 - 970 fn has-trace? _self: (addr sandbox) -> _/eax: boolean { - 971 var self/esi: (addr sandbox) <- copy _self - 972 var trace-ah/eax: (addr handle trace) <- get self, trace - 973 var _trace/eax: (addr trace) <- lookup *trace-ah - 974 var trace/edx: (addr trace) <- copy _trace - 975 compare trace, 0 - 976 { - 977 break-if-!= - 978 abort "null trace" - 979 } - 980 var first-free/ebx: (addr int) <- get trace, first-free - 981 compare *first-free, 0 - 982 { - 983 break-if-> - 984 return 0/false - 985 } - 986 return 1/true - 987 } - 988 - 989 fn test-run-expand-trace { - 990 var sandbox-storage: sandbox - 991 var sandbox/esi: (addr sandbox) <- address sandbox-storage - 992 initialize-sandbox-with sandbox, "12" - 993 # eval - 994 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen - 995 # setup: screen - 996 var screen-on-stack: screen - 997 var screen/edi: (addr screen) <- address screen-on-stack - 998 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 453 fn edit-sandbox _self: (addr sandbox), key: grapheme, globals: (addr global-table), data-disk: (addr disk) { + 454 var self/esi: (addr sandbox) <- copy _self + 455 # ctrl-s + 456 { + 457 compare key, 0x13/ctrl-s + 458 break-if-!= + 459 # if cursor is in trace, skip + 460 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace? + 461 compare *cursor-in-trace?, 0/false + 462 break-if-!= + 463 # minor gotcha here: any bindings created later in this iteration won't be + 464 # persisted until the next call to ctrl-s. + 465 store-state data-disk, self, globals + 466 # + 467 run-sandbox self, globals + 468 return + 469 } + 470 # ctrl-m + 471 { + 472 compare key, 0xd/ctrl-m + 473 break-if-!= + 474 # if cursor in data, switch to trace or fall through to keyboard + 475 { + 476 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data? + 477 compare *cursor-in-data?, 0/false + 478 break-if-= + 479 var has-trace?/eax: boolean <- has-trace? self + 480 compare has-trace?, 0/false + 481 { + 482 break-if-= + 483 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data? + 484 copy-to *cursor-in-data?, 0/false + 485 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace? + 486 copy-to *cursor-in-trace?, 1/false + 487 return + 488 } + 489 var has-keyboard?/eax: boolean <- has-keyboard? self + 490 compare has-keyboard?, 0/false + 491 { + 492 break-if-= + 493 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data? + 494 copy-to *cursor-in-data?, 0/false + 495 var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard? + 496 copy-to *cursor-in-keyboard?, 1/false + 497 return + 498 } + 499 return + 500 } + 501 # if cursor in trace, switch to keyboard or fall through to data + 502 { + 503 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace? + 504 compare *cursor-in-trace?, 0/false + 505 break-if-= + 506 copy-to *cursor-in-trace?, 0/false + 507 var cursor-target/ecx: (addr boolean) <- get self, cursor-in-keyboard? + 508 var has-keyboard?/eax: boolean <- has-keyboard? self + 509 compare has-keyboard?, 0/false + 510 { + 511 break-if-!= + 512 cursor-target <- get self, cursor-in-data? + 513 } + 514 copy-to *cursor-target, 1/true + 515 return + 516 } + 517 # otherwise if cursor in keyboard, switch to data + 518 { + 519 var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard? + 520 compare *cursor-in-keyboard?, 0/false + 521 break-if-= + 522 copy-to *cursor-in-keyboard?, 0/false + 523 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data? + 524 copy-to *cursor-in-data?, 1/true + 525 return + 526 } + 527 return + 528 } + 529 # if cursor in data, send key to data + 530 { + 531 var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data? + 532 compare *cursor-in-data?, 0/false + 533 break-if-= + 534 var data-ah/eax: (addr handle gap-buffer) <- get self, data + 535 var data/eax: (addr gap-buffer) <- lookup *data-ah + 536 edit-gap-buffer data, key + 537 return + 538 } + 539 # if cursor in keyboard, send key to keyboard + 540 { + 541 var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard? + 542 compare *cursor-in-keyboard?, 0/false + 543 break-if-= + 544 var inner-keyboard-var-ah/eax: (addr handle cell) <- get self, keyboard-var + 545 var inner-keyboard-var/eax: (addr cell) <- lookup *inner-keyboard-var-ah + 546 compare inner-keyboard-var, 0 + 547 { + 548 break-if-!= + 549 return + 550 } + 551 var inner-keyboard-var-type/ecx: (addr int) <- get inner-keyboard-var, type + 552 compare *inner-keyboard-var-type, 6/keyboard + 553 { + 554 break-if-= + 555 return + 556 } + 557 var keyboard-ah/eax: (addr handle gap-buffer) <- get inner-keyboard-var, keyboard-data + 558 var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah + 559 edit-gap-buffer keyboard, key + 560 return + 561 } + 562 # if cursor in trace, send key to trace + 563 { + 564 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace? + 565 compare *cursor-in-trace?, 0/false + 566 break-if-= + 567 var trace-ah/eax: (addr handle trace) <- get self, trace + 568 var trace/eax: (addr trace) <- lookup *trace-ah + 569 # if expanding the trace, first check if we need to run the sandbox again with a deeper trace + 570 { + 571 compare key, 0xa/newline + 572 break-if-!= + 573 { + 574 var need-rerun?/eax: boolean <- cursor-too-deep? trace + 575 compare need-rerun?, 0/false + 576 } + 577 break-if-= + 578 #? draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "rerun", 7/fg 0/bg + 579 # save trace lines at various cached indices + 580 var save: trace-index-stash + 581 var save-addr/ecx: (addr trace-index-stash) <- address save + 582 save-indices trace, save-addr + 583 # rerun at higher depth + 584 var max-depth-addr/ecx: (addr int) <- get trace, max-depth + 585 increment *max-depth-addr + 586 run-sandbox self, globals + 587 # recompute cached indices + 588 recompute-all-visible-lines trace + 589 var save-addr/ecx: (addr trace-index-stash) <- address save + 590 restore-indices trace, save-addr + 591 } + 592 edit-trace trace, key + 593 return + 594 } + 595 } + 596 + 597 fn run-sandbox _self: (addr sandbox), globals: (addr global-table) { + 598 var self/esi: (addr sandbox) <- copy _self + 599 var data-ah/ecx: (addr handle gap-buffer) <- get self, data + 600 var eval-result-h: (handle cell) + 601 var eval-result-ah/edi: (addr handle cell) <- address eval-result-h + 602 var definitions-created-storage: (stream int 0x10) + 603 var definitions-created/edx: (addr stream int) <- address definitions-created-storage + 604 var trace-ah/eax: (addr handle trace) <- get self, trace + 605 var _trace/eax: (addr trace) <- lookup *trace-ah + 606 var trace/ebx: (addr trace) <- copy _trace + 607 clear-trace trace + 608 var tmp/eax: (addr handle cell) <- get self, screen-var + 609 var inner-screen-var: (addr handle cell) + 610 copy-to inner-screen-var, tmp + 611 clear-screen-var inner-screen-var + 612 var inner-keyboard-var/eax: (addr handle cell) <- get self, keyboard-var + 613 rewind-keyboard-var inner-keyboard-var # don't clear keys from before + 614 # + 615 read-and-evaluate-and-save-gap-buffer-to-globals data-ah, eval-result-ah, globals, definitions-created, trace, inner-screen-var, inner-keyboard-var + 616 # if necessary, initialize a new gap-buffer for sandbox + 617 { + 618 compare globals, 0 + 619 break-if-= + 620 rewind-stream definitions-created + 621 var no-definitions?/eax: boolean <- stream-empty? definitions-created + 622 compare no-definitions?, 0/false + 623 break-if-!= + 624 # some definitions were created; clear the gap buffer + 625 var data/eax: (addr gap-buffer) <- lookup *data-ah + 626 var capacity/edx: int <- gap-buffer-capacity data + 627 allocate data-ah + 628 var new-data/eax: (addr gap-buffer) <- lookup *data-ah + 629 initialize-gap-buffer new-data, capacity + 630 } + 631 # print + 632 var value-ah/eax: (addr handle stream byte) <- get self, value + 633 var value/eax: (addr stream byte) <- lookup *value-ah + 634 clear-stream value + 635 print-cell eval-result-ah, value, trace + 636 } + 637 + 638 fn test-run-integer { + 639 var sandbox-storage: sandbox + 640 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 641 initialize-sandbox-with sandbox, "1" + 642 # eval + 643 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 644 # setup: screen + 645 var screen-on-stack: screen + 646 var screen/edi: (addr screen) <- address screen-on-stack + 647 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 648 # + 649 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 650 # skip one line of padding + 651 check-screen-row screen, 1/y, " 1 ", "F - test-run-integer/0" + 652 check-screen-row screen, 2/y, " ... ", "F - test-run-integer/1" + 653 check-screen-row screen, 3/y, " => 1 ", "F - test-run-integer/2" + 654 } + 655 + 656 fn test-run-negative-integer { + 657 var sandbox-storage: sandbox + 658 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 659 initialize-sandbox-with sandbox, "-1" + 660 # eval + 661 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 662 # setup: screen + 663 var screen-on-stack: screen + 664 var screen/edi: (addr screen) <- address screen-on-stack + 665 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 666 # + 667 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 668 # skip one line of padding + 669 check-screen-row screen, 1/y, " -1 ", "F - test-run-negative-integer/0" + 670 check-screen-row screen, 2/y, " ... ", "F - test-run-negative-integer/1" + 671 check-screen-row screen, 3/y, " => -1 ", "F - test-run-negative-integer/2" + 672 } + 673 + 674 fn test-run-error-invalid-integer { + 675 var sandbox-storage: sandbox + 676 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 677 initialize-sandbox-with sandbox, "1a" + 678 # eval + 679 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 680 # setup: screen + 681 var screen-on-stack: screen + 682 var screen/edi: (addr screen) <- address screen-on-stack + 683 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 684 # + 685 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 686 # skip one line of padding + 687 check-screen-row screen, 1/y, " 1a ", "F - test-run-error-invalid-integer/0" + 688 check-screen-row screen, 2/y, " ... ", "F - test-run-error-invalid-integer/1" + 689 check-screen-row-in-color screen, 0xc/fg=error, 3/y, " invalid number ", "F - test-run-error-invalid-integer/2" + 690 } + 691 + 692 fn test-run-error-unknown-symbol { + 693 var sandbox-storage: sandbox + 694 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 695 initialize-sandbox-with sandbox, "a" + 696 # eval + 697 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 698 # setup: screen + 699 var screen-on-stack: screen + 700 var screen/edi: (addr screen) <- address screen-on-stack + 701 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 702 # + 703 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 704 # skip one line of padding + 705 check-screen-row screen, 1/y, " a ", "F - test-run-error-unknown-symbol/0" + 706 check-screen-row screen, 2/y, " ... ", "F - test-run-error-unknown-symbol/1" + 707 check-screen-row-in-color screen, 0xc/fg=error, 3/y, " unbound symbol: a ", "F - test-run-error-unknown-symbol/2" + 708 } + 709 + 710 fn test-run-with-spaces { + 711 var sandbox-storage: sandbox + 712 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 713 initialize-sandbox-with sandbox, " 1 \n" + 714 # eval + 715 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 716 # setup: screen + 717 var screen-on-stack: screen + 718 var screen/edi: (addr screen) <- address screen-on-stack + 719 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 720 # + 721 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 722 # skip one line of padding + 723 check-screen-row screen, 1/y, " 1 ", "F - test-run-with-spaces/0" + 724 check-screen-row screen, 2/y, " ", "F - test-run-with-spaces/1" + 725 check-screen-row screen, 3/y, " ... ", "F - test-run-with-spaces/2" + 726 check-screen-row screen, 4/y, " => 1 ", "F - test-run-with-spaces/3" + 727 } + 728 + 729 fn test-run-quote { + 730 var sandbox-storage: sandbox + 731 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 732 initialize-sandbox-with sandbox, "'a" + 733 # eval + 734 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 735 # setup: screen + 736 var screen-on-stack: screen + 737 var screen/edi: (addr screen) <- address screen-on-stack + 738 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 739 # + 740 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 741 # skip one line of padding + 742 check-screen-row screen, 1/y, " 'a ", "F - test-run-quote/0" + 743 check-screen-row screen, 2/y, " ... ", "F - test-run-quote/1" + 744 check-screen-row screen, 3/y, " => a ", "F - test-run-quote/2" + 745 } + 746 + 747 fn test-run-dotted-list { + 748 var sandbox-storage: sandbox + 749 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 750 initialize-sandbox-with sandbox, "'(a . b)" + 751 # eval + 752 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 753 # setup: screen + 754 var screen-on-stack: screen + 755 var screen/edi: (addr screen) <- address screen-on-stack + 756 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 757 # + 758 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 759 # skip one line of padding + 760 check-screen-row screen, 1/y, " '(a . b) ", "F - test-run-dotted-list/0" + 761 check-screen-row screen, 2/y, " ... ", "F - test-run-dotted-list/1" + 762 check-screen-row screen, 3/y, " => (a . b) ", "F - test-run-dotted-list/2" + 763 } + 764 + 765 fn test-run-dot-and-list { + 766 var sandbox-storage: sandbox + 767 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 768 initialize-sandbox-with sandbox, "'(a . (b))" + 769 # eval + 770 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 771 # setup: screen + 772 var screen-on-stack: screen + 773 var screen/edi: (addr screen) <- address screen-on-stack + 774 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 775 # + 776 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 777 # skip one line of padding + 778 check-screen-row screen, 1/y, " '(a . (b)) ", "F - test-run-dot-and-list/0" + 779 check-screen-row screen, 2/y, " ... ", "F - test-run-dot-and-list/1" + 780 check-screen-row screen, 3/y, " => (a b) ", "F - test-run-dot-and-list/2" + 781 } + 782 + 783 fn test-run-final-dot { + 784 var sandbox-storage: sandbox + 785 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 786 initialize-sandbox-with sandbox, "'(a .)" + 787 # eval + 788 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 789 # setup: screen + 790 var screen-on-stack: screen + 791 var screen/edi: (addr screen) <- address screen-on-stack + 792 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 793 # + 794 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 795 # skip one line of padding + 796 check-screen-row screen, 1/y, " '(a .) ", "F - test-run-final-dot/0" + 797 check-screen-row screen, 2/y, " ... ", "F - test-run-final-dot/1" + 798 check-screen-row screen, 3/y, " '. )' makes no sense ", "F - test-run-final-dot/2" + 799 # further errors may occur + 800 } + 801 + 802 fn test-run-double-dot { + 803 var sandbox-storage: sandbox + 804 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 805 initialize-sandbox-with sandbox, "'(a . .)" + 806 # eval + 807 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 808 # setup: screen + 809 var screen-on-stack: screen + 810 var screen/edi: (addr screen) <- address screen-on-stack + 811 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 812 # + 813 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 814 # skip one line of padding + 815 check-screen-row screen, 1/y, " '(a . .) ", "F - test-run-double-dot/0" + 816 check-screen-row screen, 2/y, " ... ", "F - test-run-double-dot/1" + 817 check-screen-row screen, 3/y, " '. .' makes no sense ", "F - test-run-double-dot/2" + 818 # further errors may occur + 819 } + 820 + 821 fn test-run-multiple-expressions-after-dot { + 822 var sandbox-storage: sandbox + 823 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 824 initialize-sandbox-with sandbox, "'(a . b c)" + 825 # eval + 826 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 827 # setup: screen + 828 var screen-on-stack: screen + 829 var screen/edi: (addr screen) <- address screen-on-stack + 830 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 831 # + 832 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 833 # skip one line of padding + 834 check-screen-row screen, 1/y, " '(a . b c) ", "F - test-run-multiple-expressions-after-dot/0" + 835 check-screen-row screen, 2/y, " ... ", "F - test-run-multiple-expressions-after-dot/1" + 836 check-screen-row screen, 3/y, " cannot have multiple expressions between '.' and ')' ", "F - test-run-multiple-expressions-after-dot/2" + 837 # further errors may occur + 838 } + 839 + 840 fn test-run-stream { + 841 var sandbox-storage: sandbox + 842 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 843 initialize-sandbox-with sandbox, "[a b]" + 844 # eval + 845 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 846 # setup: screen + 847 var screen-on-stack: screen + 848 var screen/edi: (addr screen) <- address screen-on-stack + 849 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 850 # + 851 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 852 # skip one line of padding + 853 check-screen-row screen, 1/y, " [a b] ", "F - test-run-stream/0" + 854 check-screen-row screen, 2/y, " ... ", "F - test-run-stream/1" + 855 check-screen-row screen, 3/y, " => [a b] ", "F - test-run-stream/2" + 856 } + 857 + 858 fn test-run-move-cursor-into-trace { + 859 var sandbox-storage: sandbox + 860 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 861 initialize-sandbox-with sandbox, "12" + 862 # eval + 863 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 864 # setup: screen + 865 var screen-on-stack: screen + 866 var screen/edi: (addr screen) <- address screen-on-stack + 867 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 868 # + 869 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 870 # skip one line of padding + 871 check-screen-row screen, 1/y, " 12 ", "F - test-run-move-cursor-into-trace/pre-0" + 872 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-move-cursor-into-trace/pre-0/cursor" + 873 check-screen-row screen, 2/y, " ... ", "F - test-run-move-cursor-into-trace/pre-1" + 874 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-move-cursor-into-trace/pre-1/cursor" + 875 check-screen-row screen, 3/y, " => 12 ", "F - test-run-move-cursor-into-trace/pre-2" + 876 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-move-cursor-into-trace/pre-2/cursor" + 877 # move cursor into trace + 878 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk + 879 # + 880 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 881 # skip one line of padding + 882 check-screen-row screen, 1/y, " 12 ", "F - test-run-move-cursor-into-trace/trace-0" + 883 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-move-cursor-into-trace/trace-0/cursor" + 884 check-screen-row screen, 2/y, " ... ", "F - test-run-move-cursor-into-trace/trace-1" + 885 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||| ", "F - test-run-move-cursor-into-trace/trace-1/cursor" + 886 check-screen-row screen, 3/y, " => 12 ", "F - test-run-move-cursor-into-trace/trace-2" + 887 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-move-cursor-into-trace/trace-2/cursor" + 888 # move cursor into input + 889 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk + 890 # + 891 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 892 # skip one line of padding + 893 check-screen-row screen, 1/y, " 12 ", "F - test-run-move-cursor-into-trace/input-0" + 894 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-move-cursor-into-trace/input-0/cursor" + 895 check-screen-row screen, 2/y, " ... ", "F - test-run-move-cursor-into-trace/input-1" + 896 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-move-cursor-into-trace/input-1/cursor" + 897 check-screen-row screen, 3/y, " => 12 ", "F - test-run-move-cursor-into-trace/input-2" + 898 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-move-cursor-into-trace/input-2/cursor" + 899 } + 900 + 901 fn has-trace? _self: (addr sandbox) -> _/eax: boolean { + 902 var self/esi: (addr sandbox) <- copy _self + 903 var trace-ah/eax: (addr handle trace) <- get self, trace + 904 var _trace/eax: (addr trace) <- lookup *trace-ah + 905 var trace/edx: (addr trace) <- copy _trace + 906 compare trace, 0 + 907 { + 908 break-if-!= + 909 abort "null trace" + 910 } + 911 var first-free/ebx: (addr int) <- get trace, first-free + 912 compare *first-free, 0 + 913 { + 914 break-if-> + 915 return 0/false + 916 } + 917 return 1/true + 918 } + 919 + 920 fn test-run-expand-trace { + 921 var sandbox-storage: sandbox + 922 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 923 initialize-sandbox-with sandbox, "12" + 924 # eval + 925 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 926 # setup: screen + 927 var screen-on-stack: screen + 928 var screen/edi: (addr screen) <- address screen-on-stack + 929 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 930 # + 931 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 932 # skip one line of padding + 933 check-screen-row screen, 1/y, " 12 ", "F - test-run-expand-trace/pre0-0" + 934 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-expand-trace/pre0-0/cursor" + 935 check-screen-row screen, 2/y, " ... ", "F - test-run-expand-trace/pre0-1" + 936 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-expand-trace/pre0-1/cursor" + 937 check-screen-row screen, 3/y, " => 12 ", "F - test-run-expand-trace/pre0-2" + 938 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-expand-trace/pre0-2/cursor" + 939 # move cursor into trace + 940 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk + 941 # + 942 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 943 # skip one line of padding + 944 check-screen-row screen, 1/y, " 12 ", "F - test-run-expand-trace/pre1-0" + 945 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-expand-trace/pre1-0/cursor" + 946 check-screen-row screen, 2/y, " ... ", "F - test-run-expand-trace/pre1-1" + 947 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||| ", "F - test-run-expand-trace/pre1-1/cursor" + 948 check-screen-row screen, 3/y, " => 12 ", "F - test-run-expand-trace/pre1-2" + 949 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-expand-trace/pre1-2/cursor" + 950 # expand + 951 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk + 952 # + 953 clear-screen screen + 954 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 955 # skip one line of padding + 956 check-screen-row screen, 1/y, " 12 ", "F - test-run-expand-trace/expand-0" + 957 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-expand-trace/expand-0/cursor" + 958 check-screen-row screen, 2/y, " 1 toke", "F - test-run-expand-trace/expand-1" + 959 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||||||", "F - test-run-expand-trace/expand-1/cursor" + 960 check-screen-row screen, 3/y, " ... ", "F - test-run-expand-trace/expand-2" + 961 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-expand-trace/expand-2/cursor" + 962 check-screen-row screen, 4/y, " 1 pars", "F - test-run-expand-trace/expand-2" + 963 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-expand-trace/expand-2/cursor" + 964 } + 965 + 966 fn test-run-can-rerun-when-expanding-trace { + 967 var sandbox-storage: sandbox + 968 var sandbox/esi: (addr sandbox) <- address sandbox-storage + 969 # initialize sandbox with a max-depth of 3 + 970 initialize-sandbox-with sandbox, "12" + 971 # eval + 972 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk + 973 # setup: screen + 974 var screen-on-stack: screen + 975 var screen/edi: (addr screen) <- address screen-on-stack + 976 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics + 977 # + 978 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 979 # skip one line of padding + 980 check-screen-row screen, 1/y, " 12 ", "F - test-run-can-rerun-when-expanding-trace/pre0-0" + 981 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-can-rerun-when-expanding-trace/pre0-0/cursor" + 982 check-screen-row screen, 2/y, " ... ", "F - test-run-can-rerun-when-expanding-trace/pre0-1" + 983 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre0-1/cursor" + 984 check-screen-row screen, 3/y, " => 12 ", "F - test-run-can-rerun-when-expanding-trace/pre0-2" + 985 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre0-2/cursor" + 986 # move cursor into trace + 987 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk + 988 # + 989 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor + 990 # skip one line of padding + 991 check-screen-row screen, 1/y, " 12 ", "F - test-run-can-rerun-when-expanding-trace/pre1-0" + 992 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre1-0/cursor" + 993 check-screen-row screen, 2/y, " ... ", "F - test-run-can-rerun-when-expanding-trace/pre1-1" + 994 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||| ", "F - test-run-can-rerun-when-expanding-trace/pre1-1/cursor" + 995 check-screen-row screen, 3/y, " => 12 ", "F - test-run-can-rerun-when-expanding-trace/pre1-2" + 996 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre1-2/cursor" + 997 # expand + 998 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk 999 # -1000 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1001 # skip one line of padding -1002 check-screen-row screen, 1/y, " 12 ", "F - test-run-expand-trace/pre0-0" -1003 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-expand-trace/pre0-0/cursor" -1004 check-screen-row screen, 2/y, " ... ", "F - test-run-expand-trace/pre0-1" -1005 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-expand-trace/pre0-1/cursor" -1006 check-screen-row screen, 3/y, " => 12 ", "F - test-run-expand-trace/pre0-2" -1007 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-expand-trace/pre0-2/cursor" -1008 # move cursor into trace -1009 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1010 # -1011 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1012 # skip one line of padding -1013 check-screen-row screen, 1/y, " 12 ", "F - test-run-expand-trace/pre1-0" -1014 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-expand-trace/pre1-0/cursor" -1015 check-screen-row screen, 2/y, " ... ", "F - test-run-expand-trace/pre1-1" -1016 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||| ", "F - test-run-expand-trace/pre1-1/cursor" -1017 check-screen-row screen, 3/y, " => 12 ", "F - test-run-expand-trace/pre1-2" -1018 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-expand-trace/pre1-2/cursor" -1019 # expand -1020 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1021 # -1022 clear-screen screen -1023 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1024 # skip one line of padding -1025 check-screen-row screen, 1/y, " 12 ", "F - test-run-expand-trace/expand-0" -1026 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-expand-trace/expand-0/cursor" -1027 check-screen-row screen, 2/y, " 1 toke", "F - test-run-expand-trace/expand-1" -1028 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||||||", "F - test-run-expand-trace/expand-1/cursor" -1029 check-screen-row screen, 3/y, " ... ", "F - test-run-expand-trace/expand-2" -1030 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-expand-trace/expand-2/cursor" -1031 check-screen-row screen, 4/y, " 1 pars", "F - test-run-expand-trace/expand-2" -1032 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-expand-trace/expand-2/cursor" -1033 } -1034 -1035 fn test-run-can-rerun-when-expanding-trace { -1036 var sandbox-storage: sandbox -1037 var sandbox/esi: (addr sandbox) <- address sandbox-storage -1038 # initialize sandbox with a max-depth of 3 -1039 initialize-sandbox-with sandbox, "12" -1040 # eval -1041 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1042 # setup: screen -1043 var screen-on-stack: screen -1044 var screen/edi: (addr screen) <- address screen-on-stack -1045 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics -1046 # -1047 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1048 # skip one line of padding -1049 check-screen-row screen, 1/y, " 12 ", "F - test-run-can-rerun-when-expanding-trace/pre0-0" -1050 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-can-rerun-when-expanding-trace/pre0-0/cursor" -1051 check-screen-row screen, 2/y, " ... ", "F - test-run-can-rerun-when-expanding-trace/pre0-1" -1052 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre0-1/cursor" -1053 check-screen-row screen, 3/y, " => 12 ", "F - test-run-can-rerun-when-expanding-trace/pre0-2" -1054 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre0-2/cursor" -1055 # move cursor into trace -1056 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1057 # -1058 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1059 # skip one line of padding -1060 check-screen-row screen, 1/y, " 12 ", "F - test-run-can-rerun-when-expanding-trace/pre1-0" -1061 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre1-0/cursor" -1062 check-screen-row screen, 2/y, " ... ", "F - test-run-can-rerun-when-expanding-trace/pre1-1" -1063 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||| ", "F - test-run-can-rerun-when-expanding-trace/pre1-1/cursor" -1064 check-screen-row screen, 3/y, " => 12 ", "F - test-run-can-rerun-when-expanding-trace/pre1-2" -1065 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre1-2/cursor" -1066 # expand -1067 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1068 # -1069 clear-screen screen -1070 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1071 # skip one line of padding -1072 check-screen-row screen, 1/y, " 12 ", "F - test-run-can-rerun-when-expanding-trace/pre2-0" -1073 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre2-0/cursor" -1074 check-screen-row screen, 2/y, " 1 toke", "F - test-run-can-rerun-when-expanding-trace/pre2-1" -1075 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||||||", "F - test-run-can-rerun-when-expanding-trace/pre2-1/cursor" -1076 check-screen-row screen, 3/y, " ... ", "F - test-run-can-rerun-when-expanding-trace/pre2-2" -1077 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre2-2/cursor" -1078 check-screen-row screen, 4/y, " 1 pars", "F - test-run-can-rerun-when-expanding-trace/pre2-2" -1079 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre2-2/cursor" -1080 # move cursor down and expand -1081 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1082 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1083 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1084 # -1085 clear-screen screen +1000 clear-screen screen +1001 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1002 # skip one line of padding +1003 check-screen-row screen, 1/y, " 12 ", "F - test-run-can-rerun-when-expanding-trace/pre2-0" +1004 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre2-0/cursor" +1005 check-screen-row screen, 2/y, " 1 toke", "F - test-run-can-rerun-when-expanding-trace/pre2-1" +1006 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||||||", "F - test-run-can-rerun-when-expanding-trace/pre2-1/cursor" +1007 check-screen-row screen, 3/y, " ... ", "F - test-run-can-rerun-when-expanding-trace/pre2-2" +1008 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre2-2/cursor" +1009 check-screen-row screen, 4/y, " 1 pars", "F - test-run-can-rerun-when-expanding-trace/pre2-2" +1010 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-can-rerun-when-expanding-trace/pre2-2/cursor" +1011 # move cursor down and expand +1012 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk +1013 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1014 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk +1015 # +1016 clear-screen screen +1017 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1018 # screen looks same as if trace max-depth was really high +1019 check-screen-row screen, 1/y, " 12 ", "F - test-run-can-rerun-when-expanding-trace/expand-0" +1020 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-can-rerun-when-expanding-trace/expand-0/cursor" +1021 check-screen-row screen, 2/y, " 1 toke", "F - test-run-can-rerun-when-expanding-trace/expand-1" +1022 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-can-rerun-when-expanding-trace/expand-1/cursor" +1023 check-screen-row screen, 3/y, " 2 next", "F - test-run-can-rerun-when-expanding-trace/expand-2" +1024 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ||||||", "F - test-run-can-rerun-when-expanding-trace/expand-2/cursor" +1025 check-screen-row screen, 4/y, " ... ", "F - test-run-can-rerun-when-expanding-trace/expand-3" +1026 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-can-rerun-when-expanding-trace/expand-3/cursor" +1027 check-screen-row screen, 5/y, " 2 => 1", "F - test-run-can-rerun-when-expanding-trace/expand-4" +1028 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-can-rerun-when-expanding-trace/expand-4/cursor" +1029 } +1030 +1031 fn test-run-preserves-trace-view-on-rerun { +1032 var sandbox-storage: sandbox +1033 var sandbox/esi: (addr sandbox) <- address sandbox-storage +1034 # initialize sandbox with a max-depth of 3 +1035 initialize-sandbox-with sandbox, "7" +1036 # eval +1037 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk +1038 # setup: screen +1039 var screen-on-stack: screen +1040 var screen/edi: (addr screen) <- address screen-on-stack +1041 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics +1042 # +1043 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1044 # skip one line of padding +1045 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre0-0" +1046 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-preserves-trace-view-on-rerun/pre0-0/cursor" +1047 check-screen-row screen, 2/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre0-1" +1048 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre0-1/cursor" +1049 check-screen-row screen, 3/y, " => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre0-2" +1050 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre0-2/cursor" +1051 # move cursor into trace +1052 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk +1053 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1054 # +1055 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre1-0" +1056 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre1-0/cursor" +1057 check-screen-row screen, 2/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre1-1" +1058 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||| ", "F - test-run-preserves-trace-view-on-rerun/pre1-1/cursor" +1059 check-screen-row screen, 3/y, " => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre1-2" +1060 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre1-2/cursor" +1061 # expand +1062 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk +1063 clear-screen screen +1064 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1065 # +1066 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre2-0" +1067 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-0/cursor" +1068 check-screen-row screen, 2/y, " 1 tokenize ", "F - test-run-preserves-trace-view-on-rerun/pre2-1" +1069 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " |||||||||| ", "F - test-run-preserves-trace-view-on-rerun/pre2-1/cursor" +1070 check-screen-row screen, 3/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre2-2" +1071 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-2/cursor" +1072 check-screen-row screen, 4/y, " 1 parse ", "F - test-run-preserves-trace-view-on-rerun/pre2-3" +1073 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-3/cursor" +1074 check-screen-row screen, 5/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre2-4" +1075 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-4/cursor" +1076 check-screen-row screen, 6/y, " 1 macroexpand 7 ", "F - test-run-preserves-trace-view-on-rerun/pre2-5" +1077 check-background-color-in-screen-row screen, 7/bg=cursor, 6/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-5/cursor" +1078 check-screen-row screen, 7/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre2-6" +1079 check-background-color-in-screen-row screen, 7/bg=cursor, 7/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-6/cursor" +1080 check-screen-row screen, 8/y, " 1 => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre2-7" +1081 check-background-color-in-screen-row screen, 7/bg=cursor, 8/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-7/cursor" +1082 # move cursor down below the macroexpand line and expand +1083 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk +1084 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1085 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk 1086 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1087 # screen looks same as if trace max-depth was really high -1088 check-screen-row screen, 1/y, " 12 ", "F - test-run-can-rerun-when-expanding-trace/expand-0" -1089 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-can-rerun-when-expanding-trace/expand-0/cursor" -1090 check-screen-row screen, 2/y, " 1 toke", "F - test-run-can-rerun-when-expanding-trace/expand-1" -1091 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-can-rerun-when-expanding-trace/expand-1/cursor" -1092 check-screen-row screen, 3/y, " 2 next", "F - test-run-can-rerun-when-expanding-trace/expand-2" -1093 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ||||||", "F - test-run-can-rerun-when-expanding-trace/expand-2/cursor" -1094 check-screen-row screen, 4/y, " ... ", "F - test-run-can-rerun-when-expanding-trace/expand-3" -1095 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-can-rerun-when-expanding-trace/expand-3/cursor" -1096 check-screen-row screen, 5/y, " 2 => 1", "F - test-run-can-rerun-when-expanding-trace/expand-4" -1097 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-can-rerun-when-expanding-trace/expand-4/cursor" -1098 } -1099 -1100 fn test-run-preserves-trace-view-on-rerun { -1101 var sandbox-storage: sandbox -1102 var sandbox/esi: (addr sandbox) <- address sandbox-storage -1103 # initialize sandbox with a max-depth of 3 -1104 initialize-sandbox-with sandbox, "7" -1105 # eval -1106 edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1107 # setup: screen -1108 var screen-on-stack: screen -1109 var screen/edi: (addr screen) <- address screen-on-stack -1110 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics -1111 # -1112 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1113 # skip one line of padding -1114 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre0-0" -1115 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-run-preserves-trace-view-on-rerun/pre0-0/cursor" -1116 check-screen-row screen, 2/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre0-1" -1117 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre0-1/cursor" -1118 check-screen-row screen, 3/y, " => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre0-2" -1119 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre0-2/cursor" -1120 # move cursor into trace -1121 edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1122 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1123 # -1124 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre1-0" -1125 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre1-0/cursor" -1126 check-screen-row screen, 2/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre1-1" -1127 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||| ", "F - test-run-preserves-trace-view-on-rerun/pre1-1/cursor" -1128 check-screen-row screen, 3/y, " => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre1-2" -1129 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre1-2/cursor" -1130 # expand -1131 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1132 clear-screen screen -1133 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1134 # -1135 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre2-0" -1136 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-0/cursor" -1137 check-screen-row screen, 2/y, " 1 tokenize ", "F - test-run-preserves-trace-view-on-rerun/pre2-1" -1138 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " |||||||||| ", "F - test-run-preserves-trace-view-on-rerun/pre2-1/cursor" -1139 check-screen-row screen, 3/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre2-2" -1140 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-2/cursor" -1141 check-screen-row screen, 4/y, " 1 parse ", "F - test-run-preserves-trace-view-on-rerun/pre2-3" -1142 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-3/cursor" -1143 check-screen-row screen, 5/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre2-4" -1144 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-4/cursor" -1145 check-screen-row screen, 6/y, " 1 macroexpand 7 ", "F - test-run-preserves-trace-view-on-rerun/pre2-5" -1146 check-background-color-in-screen-row screen, 7/bg=cursor, 6/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-5/cursor" -1147 check-screen-row screen, 7/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre2-6" -1148 check-background-color-in-screen-row screen, 7/bg=cursor, 7/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-6/cursor" -1149 check-screen-row screen, 8/y, " 1 => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre2-7" -1150 check-background-color-in-screen-row screen, 7/bg=cursor, 8/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre2-7/cursor" -1151 # move cursor down below the macroexpand line and expand -1152 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1153 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1154 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1155 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1156 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1157 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1158 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1159 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1160 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1161 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1162 # -1163 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre3-0" -1164 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-0/cursor" -1165 check-screen-row screen, 2/y, " 1 tokenize ", "F - test-run-preserves-trace-view-on-rerun/pre3-1" -1166 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-1/cursor" -1167 check-screen-row screen, 3/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre3-2" -1168 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-2/cursor" -1169 check-screen-row screen, 4/y, " 1 parse ", "F - test-run-preserves-trace-view-on-rerun/pre3-3" -1170 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-3/cursor" -1171 check-screen-row screen, 5/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre3-4" -1172 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-4/cursor" -1173 check-screen-row screen, 6/y, " 1 macroexpand 7 ", "F - test-run-preserves-trace-view-on-rerun/pre3-5" -1174 check-background-color-in-screen-row screen, 7/bg=cursor, 6/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-5/cursor" -1175 check-screen-row screen, 7/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre3-6" -1176 check-background-color-in-screen-row screen, 7/bg=cursor, 7/y, " ||| ", "F - test-run-preserves-trace-view-on-rerun/pre3-6/cursor" -1177 check-screen-row screen, 8/y, " 1 => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre3-7" -1178 check-background-color-in-screen-row screen, 7/bg=cursor, 8/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-7/cursor" -1179 # expand -1180 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk, 0/no-tweak-screen -1181 clear-screen screen -1182 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor -1183 # cursor line is expanded -1184 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/expand-0" -1185 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-0/cursor" -1186 check-screen-row screen, 2/y, " 1 tokenize ", "F - test-run-preserves-trace-view-on-rerun/expand-1" -1187 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-1/cursor" -1188 check-screen-row screen, 3/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/expand-2" -1189 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-2/cursor" -1190 check-screen-row screen, 4/y, " 1 parse ", "F - test-run-preserves-trace-view-on-rerun/expand-3" -1191 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-3/cursor" -1192 check-screen-row screen, 5/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/expand-4" -1193 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-4/cursor" -1194 check-screen-row screen, 6/y, " 1 macroexpand 7 ", "F - test-run-preserves-trace-view-on-rerun/expand-5" -1195 check-background-color-in-screen-row screen, 7/bg=cursor, 6/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-5/cursor" -1196 check-screen-row screen, 7/y, " 2 macroexpand-iter 7 ", "F - test-run-preserves-trace-view-on-rerun/expand-6" -1197 check-background-color-in-screen-row screen, 7/bg=cursor, 7/y, " |||||||||||||||||||| ", "F - test-run-preserves-trace-view-on-rerun/expand-6/cursor" -1198 check-screen-row screen, 8/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/expand-7" -1199 check-background-color-in-screen-row screen, 7/bg=cursor, 8/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-7/cursor" -1200 } +1087 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk +1088 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1089 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk +1090 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1091 edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk +1092 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1093 # +1094 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/pre3-0" +1095 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-0/cursor" +1096 check-screen-row screen, 2/y, " 1 tokenize ", "F - test-run-preserves-trace-view-on-rerun/pre3-1" +1097 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-1/cursor" +1098 check-screen-row screen, 3/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre3-2" +1099 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-2/cursor" +1100 check-screen-row screen, 4/y, " 1 parse ", "F - test-run-preserves-trace-view-on-rerun/pre3-3" +1101 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-3/cursor" +1102 check-screen-row screen, 5/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre3-4" +1103 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-4/cursor" +1104 check-screen-row screen, 6/y, " 1 macroexpand 7 ", "F - test-run-preserves-trace-view-on-rerun/pre3-5" +1105 check-background-color-in-screen-row screen, 7/bg=cursor, 6/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-5/cursor" +1106 check-screen-row screen, 7/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/pre3-6" +1107 check-background-color-in-screen-row screen, 7/bg=cursor, 7/y, " ||| ", "F - test-run-preserves-trace-view-on-rerun/pre3-6/cursor" +1108 check-screen-row screen, 8/y, " 1 => 7 ", "F - test-run-preserves-trace-view-on-rerun/pre3-7" +1109 check-background-color-in-screen-row screen, 7/bg=cursor, 8/y, " ", "F - test-run-preserves-trace-view-on-rerun/pre3-7/cursor" +1110 # expand +1111 edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk +1112 clear-screen screen +1113 render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 1/show-cursor +1114 # cursor line is expanded +1115 check-screen-row screen, 1/y, " 7 ", "F - test-run-preserves-trace-view-on-rerun/expand-0" +1116 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-0/cursor" +1117 check-screen-row screen, 2/y, " 1 tokenize ", "F - test-run-preserves-trace-view-on-rerun/expand-1" +1118 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-1/cursor" +1119 check-screen-row screen, 3/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/expand-2" +1120 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-2/cursor" +1121 check-screen-row screen, 4/y, " 1 parse ", "F - test-run-preserves-trace-view-on-rerun/expand-3" +1122 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-3/cursor" +1123 check-screen-row screen, 5/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/expand-4" +1124 check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-4/cursor" +1125 check-screen-row screen, 6/y, " 1 macroexpand 7 ", "F - test-run-preserves-trace-view-on-rerun/expand-5" +1126 check-background-color-in-screen-row screen, 7/bg=cursor, 6/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-5/cursor" +1127 check-screen-row screen, 7/y, " 2 macroexpand-iter 7 ", "F - test-run-preserves-trace-view-on-rerun/expand-6" +1128 check-background-color-in-screen-row screen, 7/bg=cursor, 7/y, " |||||||||||||||||||| ", "F - test-run-preserves-trace-view-on-rerun/expand-6/cursor" +1129 check-screen-row screen, 8/y, " ... ", "F - test-run-preserves-trace-view-on-rerun/expand-7" +1130 check-background-color-in-screen-row screen, 7/bg=cursor, 8/y, " ", "F - test-run-preserves-trace-view-on-rerun/expand-7/cursor" +1131 } diff --git a/html/shell/tokenize.mu.html b/html/shell/tokenize.mu.html index 46eb9a77..39730066 100644 --- a/html/shell/tokenize.mu.html +++ b/html/shell/tokenize.mu.html @@ -16,6 +16,7 @@ a { color:inherit; } * { font-size:12pt; font-size: 1em; } .LineNr { } .Delimiter { color: #c000c0; } +.muRegEdx { color: #878700; } .muRegEbx { color: #8787af; } .muRegEsi { color: #87d787; } .muRegEdi { color: #87ffd7; } @@ -27,7 +28,6 @@ a { color:inherit; } .muComment { color: #005faf; } .muRegEax { color: #875f00; } .muRegEcx { color: #af875f; } -.muRegEdx { color: #878700; } --> @@ -63,990 +63,1133 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/main/shell/tokenize.mu 
-  1 # We reuse the cell data structure for tokenization
-  2 # Token cells are special, though. They have no type, they're always atoms,
-  3 # they always have text-data.
-  4 
-  5 fn tokenize in: (addr gap-buffer), out: (addr stream cell), trace: (addr trace) {
-  6   trace-text trace, "tokenize", "tokenize"
-  7   trace-lower trace
-  8   rewind-gap-buffer in
-  9   var token-storage: cell
- 10   var token/edx: (addr cell) <- address token-storage
- 11   {
- 12     skip-whitespace-from-gap-buffer in
- 13     var done?/eax: boolean <- gap-buffer-scan-done? in
- 14     compare done?, 0/false
- 15     break-if-!=
- 16     #
- 17     next-token in, token, trace
- 18     var error?/eax: boolean <- has-errors? trace
- 19     compare error?, 0/false
- 20     {
- 21       break-if-=
- 22       return
- 23     }
- 24     var skip?/eax: boolean <- comment-token? token
- 25     compare skip?, 0/false
- 26     loop-if-!=
- 27     write-to-stream out, token  # shallow-copy text-data
- 28     loop
- 29   }
- 30   trace-higher trace
- 31 }
- 32 
- 33 fn test-tokenize-quote {
- 34   var in-storage: gap-buffer
- 35   var in/esi: (addr gap-buffer) <- address in-storage
- 36   initialize-gap-buffer-with in, "'(a)"
- 37   #
- 38   var stream-storage: (stream cell 0x10)
- 39   var stream/edi: (addr stream cell) <- address stream-storage
- 40   #
- 41   var trace-storage: trace
- 42   var trace/edx: (addr trace) <- address trace-storage
- 43   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
- 44   tokenize in, stream, trace
- 45   #
- 46   var curr-token-storage: cell
- 47   var curr-token/ebx: (addr cell) <- address curr-token-storage
- 48   read-from-stream stream, curr-token
- 49   var quote?/eax: boolean <- quote-token? curr-token
- 50   check quote?, "F - test-tokenize-quote: quote"
- 51   read-from-stream stream, curr-token
- 52   var open-paren?/eax: boolean <- open-paren-token? curr-token
- 53   check open-paren?, "F - test-tokenize-quote: open paren"
- 54   read-from-stream stream, curr-token  # skip a
- 55   read-from-stream stream, curr-token
- 56   var close-paren?/eax: boolean <- close-paren-token? curr-token
- 57   check close-paren?, "F - test-tokenize-quote: close paren"
- 58 }
- 59 
- 60 fn test-tokenize-backquote {
- 61   var in-storage: gap-buffer
- 62   var in/esi: (addr gap-buffer) <- address in-storage
- 63   initialize-gap-buffer-with in, "`(a)"
- 64   #
- 65   var stream-storage: (stream cell 0x10)
- 66   var stream/edi: (addr stream cell) <- address stream-storage
- 67   #
- 68   var trace-storage: trace
- 69   var trace/edx: (addr trace) <- address trace-storage
- 70   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
- 71   tokenize in, stream, trace
- 72   #
- 73   var curr-token-storage: cell
- 74   var curr-token/ebx: (addr cell) <- address curr-token-storage
- 75   read-from-stream stream, curr-token
- 76   var backquote?/eax: boolean <- backquote-token? curr-token
- 77   check backquote?, "F - test-tokenize-backquote: backquote"
- 78   read-from-stream stream, curr-token
- 79   var open-paren?/eax: boolean <- open-paren-token? curr-token
- 80   check open-paren?, "F - test-tokenize-backquote: open paren"
- 81   read-from-stream stream, curr-token  # skip a
- 82   read-from-stream stream, curr-token
- 83   var close-paren?/eax: boolean <- close-paren-token? curr-token
- 84   check close-paren?, "F - test-tokenize-backquote: close paren"
- 85 }
- 86 
- 87 fn test-tokenize-unquote {
- 88   var in-storage: gap-buffer
- 89   var in/esi: (addr gap-buffer) <- address in-storage
- 90   initialize-gap-buffer-with in, ",(a)"
- 91   #
- 92   var stream-storage: (stream cell 0x10)
- 93   var stream/edi: (addr stream cell) <- address stream-storage
- 94   #
- 95   var trace-storage: trace
- 96   var trace/edx: (addr trace) <- address trace-storage
- 97   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
- 98   tokenize in, stream, trace
- 99   #
-100   var curr-token-storage: cell
-101   var curr-token/ebx: (addr cell) <- address curr-token-storage
-102   read-from-stream stream, curr-token
-103   var unquote?/eax: boolean <- unquote-token? curr-token
-104   check unquote?, "F - test-tokenize-unquote: unquote"
-105   read-from-stream stream, curr-token
-106   var open-paren?/eax: boolean <- open-paren-token? curr-token
-107   check open-paren?, "F - test-tokenize-unquote: open paren"
-108   read-from-stream stream, curr-token  # skip a
-109   read-from-stream stream, curr-token
-110   var close-paren?/eax: boolean <- close-paren-token? curr-token
-111   check close-paren?, "F - test-tokenize-unquote: close paren"
-112 }
-113 
-114 fn test-tokenize-unquote-splice {
-115   var in-storage: gap-buffer
-116   var in/esi: (addr gap-buffer) <- address in-storage
-117   initialize-gap-buffer-with in, ",@a"
-118   #
-119   var stream-storage: (stream cell 0x10)
-120   var stream/edi: (addr stream cell) <- address stream-storage
-121   #
-122   var trace-storage: trace
-123   var trace/edx: (addr trace) <- address trace-storage
-124   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
-125   tokenize in, stream, trace
-126   #
-127   var curr-token-storage: cell
-128   var curr-token/ebx: (addr cell) <- address curr-token-storage
-129   read-from-stream stream, curr-token
-130   var unquote-splice?/eax: boolean <- unquote-splice-token? curr-token
-131   check unquote-splice?, "F - test-tokenize-unquote-splice: unquote-splice"
-132 }
-133 
-134 fn test-tokenize-dotted-list {
-135   var in-storage: gap-buffer
-136   var in/esi: (addr gap-buffer) <- address in-storage
-137   initialize-gap-buffer-with in, "(a . b)"
-138   #
-139   var stream-storage: (stream cell 0x10)
-140   var stream/edi: (addr stream cell) <- address stream-storage
-141   #
-142   var trace-storage: trace
-143   var trace/edx: (addr trace) <- address trace-storage
-144   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
-145   tokenize in, stream, trace
-146   #
-147   var curr-token-storage: cell
-148   var curr-token/ebx: (addr cell) <- address curr-token-storage
-149   read-from-stream stream, curr-token
-150   var open-paren?/eax: boolean <- open-paren-token? curr-token
-151   check open-paren?, "F - test-tokenize-dotted-list: open paren"
-152   read-from-stream stream, curr-token  # skip a
-153   read-from-stream stream, curr-token
-154   var dot?/eax: boolean <- dot-token? curr-token
-155   check dot?, "F - test-tokenize-dotted-list: dot"
-156   read-from-stream stream, curr-token  # skip b
-157   read-from-stream stream, curr-token
-158   var close-paren?/eax: boolean <- close-paren-token? curr-token
-159   check close-paren?, "F - test-tokenize-dotted-list: close paren"
-160 }
-161 
-162 fn test-tokenize-stream-literal {
-163   var in-storage: gap-buffer
-164   var in/esi: (addr gap-buffer) <- address in-storage
-165   initialize-gap-buffer-with in, "[abc def]"
-166   #
-167   var stream-storage: (stream cell 0x10)
-168   var stream/edi: (addr stream cell) <- address stream-storage
-169   #
-170   var trace-storage: trace
-171   var trace/edx: (addr trace) <- address trace-storage
-172   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
-173   tokenize in, stream, trace
-174   #
-175   var curr-token-storage: cell
-176   var curr-token/ebx: (addr cell) <- address curr-token-storage
-177   read-from-stream stream, curr-token
-178   var stream?/eax: boolean <- stream-token? curr-token
-179   check stream?, "F - test-tokenize-stream-literal: type"
-180   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
-181   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
-182   var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def"
-183   check data-equal?, "F - test-tokenize-stream-literal"
-184   var empty?/eax: boolean <- stream-empty? stream
-185   check empty?, "F - test-tokenize-stream-literal: empty?"
-186 }
-187 
-188 fn test-tokenize-stream-literal-in-tree {
-189   var in-storage: gap-buffer
-190   var in/esi: (addr gap-buffer) <- address in-storage
-191   initialize-gap-buffer-with in, "([abc def])"
-192   #
-193   var stream-storage: (stream cell 0x10)
-194   var stream/edi: (addr stream cell) <- address stream-storage
-195   #
-196   var trace-storage: trace
-197   var trace/edx: (addr trace) <- address trace-storage
-198   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
-199   tokenize in, stream, trace
-200   #
-201   var curr-token-storage: cell
-202   var curr-token/ebx: (addr cell) <- address curr-token-storage
-203   read-from-stream stream, curr-token
-204   var bracket?/eax: boolean <- bracket-token? curr-token
-205   check bracket?, "F - test-tokenize-stream-literal-in-tree: open paren"
-206   read-from-stream stream, curr-token
-207   var stream?/eax: boolean <- stream-token? curr-token
-208   check stream?, "F - test-tokenize-stream-literal-in-tree: type"
-209   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
-210   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
-211   var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def"
-212   check data-equal?, "F - test-tokenize-stream-literal-in-tree"
-213   read-from-stream stream, curr-token
-214   var bracket?/eax: boolean <- bracket-token? curr-token
-215   check bracket?, "F - test-tokenize-stream-literal-in-tree: close paren"
-216   var empty?/eax: boolean <- stream-empty? stream
-217   check empty?, "F - test-tokenize-stream-literal-in-tree: empty?"
-218 }
-219 
-220 fn next-token in: (addr gap-buffer), _out-cell: (addr cell), trace: (addr trace) {
-221   trace-text trace, "tokenize", "next-token"
-222   trace-lower trace
-223   var _g/eax: grapheme <- peek-from-gap-buffer in
-224   var g/ecx: grapheme <- copy _g
-225   {
-226     var stream-storage: (stream byte 0x40)
-227     var stream/esi: (addr stream byte) <- address stream-storage
-228     write stream, "next: "
-229     var gval/eax: int <- copy g
-230     write-int32-hex stream, gval
-231     trace trace, "tokenize", stream
-232   }
-233   var out-cell/eax: (addr cell) <- copy _out-cell
-234   {
-235     var out-cell-type/eax: (addr int) <- get out-cell, type
-236     copy-to *out-cell-type, 0/uninitialized
-237   }
-238   var out-ah/edi: (addr handle stream byte) <- get out-cell, text-data
-239   $next-token:allocate: {
-240     # Allocate a large buffer if it's a stream.
-241     # Sometimes a whole function definition will need to fit in it.
-242     compare g, 0x5b/open-square-bracket
-243     {
-244       break-if-!=
-245       populate-stream out-ah, 0x400/max-definition-size=1KB
-246       break $next-token:allocate
-247     }
-248     populate-stream out-ah, 0x40
-249   }
-250   var _out/eax: (addr stream byte) <- lookup *out-ah
-251   var out/edi: (addr stream byte) <- copy _out
-252   clear-stream out
-253   $next-token:case: {
-254     # open square brackets begin streams
-255     {
-256       compare g, 0x5b/open-square-bracket
-257       break-if-!=
-258       var dummy/eax: grapheme <- read-from-gap-buffer in  # skip open bracket
-259       next-stream-token in, out, trace
-260       var out-cell/eax: (addr cell) <- copy _out-cell
-261       # streams set the type
-262       var out-cell-type/eax: (addr int) <- get out-cell, type
-263       copy-to *out-cell-type, 3/stream
-264       break $next-token:case
-265     }
-266     # comment
-267     {
-268       compare g, 0x23/comment
-269       break-if-!=
-270       rest-of-line in, out, trace
-271       break $next-token:case
-272     }
-273     # digit
-274     {
-275       var digit?/eax: boolean <- decimal-digit? g
-276       compare digit?, 0/false
-277       break-if-=
-278       next-number-token in, out, trace
-279       break $next-token:case
-280     }
-281     # other symbol char
-282     {
-283       var symbol?/eax: boolean <- symbol-grapheme? g
-284       compare symbol?, 0/false
-285       break-if-=
-286       next-symbol-token in, out, trace
-287       break $next-token:case
-288     }
-289     # unbalanced close square brackets are errors
-290     {
-291       compare g, 0x5d/close-square-bracket
-292       break-if-!=
-293       error trace, "unbalanced ']'"
-294       return
-295     }
-296     # other brackets are always single-char tokens
-297     {
-298       var bracket?/eax: boolean <- bracket-grapheme? g
-299       compare bracket?, 0/false
-300       break-if-=
-301       var g/eax: grapheme <- read-from-gap-buffer in
-302       next-bracket-token g, out, trace
-303       break $next-token:case
-304     }
-305     # non-symbol operators
-306     {
-307       var operator?/eax: boolean <- operator-grapheme? g
-308       compare operator?, 0/false
-309       break-if-=
-310       next-operator-token in, out, trace
-311       break $next-token:case
-312     }
-313     # quote
-314     {
-315       compare g, 0x27/single-quote
-316       break-if-!=
-317       var g/eax: grapheme <- read-from-gap-buffer in  # consume
-318       write-grapheme out, g
-319       break $next-token:case
-320     }
-321     # backquote
-322     {
-323       compare g, 0x60/backquote
-324       break-if-!=
-325       var g/eax: grapheme <- read-from-gap-buffer in  # consume
-326       write-grapheme out, g
-327       break $next-token:case
-328     }
-329     # unquote
-330     {
-331       compare g, 0x2c/comma
-332       break-if-!=
-333       var g/eax: grapheme <- read-from-gap-buffer in  # consume
-334       write-grapheme out, g
-335       # check for unquote-splice
-336       {
-337         var g2/eax: grapheme <- peek-from-gap-buffer in
-338         compare g2, 0x40/at-sign
-339         break-if-!=
-340         g2 <- read-from-gap-buffer in
-341         write-grapheme out, g2
-342       }
-343       break $next-token:case
-344     }
-345     abort "unknown token type"
-346   }
-347   trace-higher trace
-348   var stream-storage: (stream byte 0x400)  # maximum possible token size (next-stream-token)
-349   var stream/eax: (addr stream byte) <- address stream-storage
-350   write stream, "=> "
-351   rewind-stream out
-352   write-stream stream, out
-353   trace trace, "tokenize", stream
-354 }
-355 
-356 fn next-symbol-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
-357   trace-text trace, "tokenize", "looking for a symbol"
-358   trace-lower trace
-359   $next-symbol-token:loop: {
-360     var done?/eax: boolean <- gap-buffer-scan-done? in
-361     compare done?, 0/false
-362     break-if-!=
-363     var g/eax: grapheme <- peek-from-gap-buffer in
-364     {
-365       var stream-storage: (stream byte 0x40)
-366       var stream/esi: (addr stream byte) <- address stream-storage
-367       write stream, "next: "
-368       var gval/eax: int <- copy g
-369       write-int32-hex stream, gval
-370       trace trace, "tokenize", stream
-371     }
-372     # if non-symbol, return
-373     {
-374       var symbol-grapheme?/eax: boolean <- symbol-grapheme? g
-375       compare symbol-grapheme?, 0/false
-376       break-if-!=
-377       trace-text trace, "tokenize", "stop"
-378       break $next-symbol-token:loop
-379     }
-380     var g/eax: grapheme <- read-from-gap-buffer in
-381     write-grapheme out, g
-382     loop
-383   }
-384   trace-higher trace
-385   var stream-storage: (stream byte 0x40)
-386   var stream/esi: (addr stream byte) <- address stream-storage
-387   write stream, "=> "
-388   rewind-stream out
-389   write-stream stream, out
-390   trace trace, "tokenize", stream
-391 }
-392 
-393 fn next-operator-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
-394   trace-text trace, "tokenize", "looking for a operator"
-395   trace-lower trace
-396   $next-operator-token:loop: {
-397     var done?/eax: boolean <- gap-buffer-scan-done? in
-398     compare done?, 0/false
-399     break-if-!=
-400     var g/eax: grapheme <- peek-from-gap-buffer in
-401     {
-402       var stream-storage: (stream byte 0x40)
-403       var stream/esi: (addr stream byte) <- address stream-storage
-404       write stream, "next: "
-405       var gval/eax: int <- copy g
-406       write-int32-hex stream, gval
-407       trace trace, "tokenize", stream
-408     }
-409     # if non-operator, return
-410     {
-411       var operator-grapheme?/eax: boolean <- operator-grapheme? g
-412       compare operator-grapheme?, 0/false
-413       break-if-!=
-414       trace-text trace, "tokenize", "stop"
-415       break $next-operator-token:loop
-416     }
-417     var g/eax: grapheme <- read-from-gap-buffer in
-418     write-grapheme out, g
-419     loop
-420   }
-421   trace-higher trace
-422   var stream-storage: (stream byte 0x40)
-423   var stream/esi: (addr stream byte) <- address stream-storage
-424   write stream, "=> "
-425   rewind-stream out
-426   write-stream stream, out
-427   trace trace, "tokenize", stream
-428 }
-429 
-430 fn next-number-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
-431   trace-text trace, "tokenize", "looking for a number"
-432   trace-lower trace
-433   $next-number-token:loop: {
-434     var done?/eax: boolean <- gap-buffer-scan-done? in
-435     compare done?, 0/false
-436     break-if-!=
-437     var g/eax: grapheme <- peek-from-gap-buffer in
-438     {
-439       var stream-storage: (stream byte 0x40)
-440       var stream/esi: (addr stream byte) <- address stream-storage
-441       write stream, "next: "
-442       var gval/eax: int <- copy g
-443       write-int32-hex stream, gval
-444       trace trace, "tokenize", stream
-445     }
-446     # if not symbol grapheme, return
-447     {
-448       var symbol-grapheme?/eax: boolean <- symbol-grapheme? g
-449       compare symbol-grapheme?, 0/false
-450       break-if-!=
-451       trace-text trace, "tokenize", "stop"
-452       break $next-number-token:loop
-453     }
-454     # if not digit grapheme, abort
-455     {
-456       var digit?/eax: boolean <- decimal-digit? g
-457       compare digit?, 0/false
-458       break-if-!=
-459       error trace, "invalid number"
-460       return
-461     }
-462     trace-text trace, "tokenize", "append"
-463     var g/eax: grapheme <- read-from-gap-buffer in
-464     write-grapheme out, g
-465     loop
-466   }
-467   trace-higher trace
-468 }
-469 
-470 fn next-stream-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
-471   trace-text trace, "tokenize", "stream"
-472   {
-473     var empty?/eax: boolean <- gap-buffer-scan-done? in
-474     compare empty?, 0/false
-475     {
-476       break-if-=
-477       error trace, "unbalanced '['"
-478       return
-479     }
-480     var g/eax: grapheme <- read-from-gap-buffer in
-481     compare g, 0x5d/close-square-bracket
-482     break-if-=
-483     write-grapheme out, g
-484     loop
-485   }
-486   var stream-storage: (stream byte 0x400)  # max-definition-size
-487   var stream/esi: (addr stream byte) <- address stream-storage
-488   write stream, "=> "
-489   rewind-stream out
-490   write-stream stream, out
-491   trace trace, "tokenize", stream
-492 }
-493 
-494 fn next-bracket-token g: grapheme, out: (addr stream byte), trace: (addr trace) {
-495   trace-text trace, "tokenize", "bracket"
-496   write-grapheme out, g
-497   var stream-storage: (stream byte 0x40)
-498   var stream/esi: (addr stream byte) <- address stream-storage
-499   write stream, "=> "
-500   rewind-stream out
-501   write-stream stream, out
-502   trace trace, "tokenize", stream
-503 }
-504 
-505 fn rest-of-line in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
-506   trace-text trace, "tokenize", "comment"
-507   {
-508     var empty?/eax: boolean <- gap-buffer-scan-done? in
-509     compare empty?, 0/false
-510     {
-511       break-if-=
-512       return
-513     }
-514     var g/eax: grapheme <- read-from-gap-buffer in
-515     compare g, 0xa/newline
-516     break-if-=
-517     write-grapheme out, g
-518     loop
-519   }
-520   var stream-storage: (stream byte 0x80)
-521   var stream/esi: (addr stream byte) <- address stream-storage
-522   write stream, "=> "
-523   rewind-stream out
-524   write-stream stream, out
-525   trace trace, "tokenize", stream
-526 }
-527 
-528 fn symbol-grapheme? g: grapheme -> _/eax: boolean {
-529   ## whitespace
-530   compare g, 9/tab
-531   {
-532     break-if-!=
-533     return 0/false
-534   }
-535   compare g, 0xa/newline
-536   {
-537     break-if-!=
-538     return 0/false
-539   }
-540   compare g, 0x20/space
-541   {
-542     break-if-!=
-543     return 0/false
-544   }
-545   ## quotes
-546   compare g, 0x22/double-quote
-547   {
-548     break-if-!=
-549     return 0/false
-550   }
-551   compare g, 0x60/backquote
-552   {
-553     break-if-!=
-554     return 0/false
-555   }
-556   ## brackets
-557   compare g, 0x28/open-paren
-558   {
-559     break-if-!=
-560     return 0/false
-561   }
-562   compare g, 0x29/close-paren
-563   {
-564     break-if-!=
-565     return 0/false
-566   }
-567   compare g, 0x5b/open-square-bracket
-568   {
-569     break-if-!=
-570     return 0/false
-571   }
-572   compare g, 0x5d/close-square-bracket
-573   {
-574     break-if-!=
-575     return 0/false
-576   }
-577   compare g, 0x7b/open-curly-bracket
-578   {
-579     break-if-!=
-580     return 0/false
-581   }
-582   compare g, 0x7d/close-curly-bracket
-583   {
-584     break-if-!=
-585     return 0/false
-586   }
-587   # - other punctuation
-588   # '!' is a symbol char
-589   compare g, 0x23/hash
-590   {
-591     break-if-!=
-592     return 0/false
-593   }
-594   # '$' is a symbol char
-595   compare g, 0x25/percent
-596   {
-597     break-if-!=
-598     return 0/false
-599   }
-600   compare g, 0x26/ampersand
-601   {
-602     break-if-!=
-603     return 0/false
-604   }
-605   compare g, 0x27/single-quote
-606   {
-607     break-if-!=
-608     return 0/false
-609   }
-610   compare g, 0x60/backquote
-611   {
-612     break-if-!=
-613     return 0/false
-614   }
-615   compare g, 0x2c/comma
-616   {
-617     break-if-!=
-618     return 0/false
-619   }
-620   compare g, 0x40/at-sign
-621   {
-622     break-if-!=
-623     return 0/false
-624   }
-625   compare g, 0x2a/asterisk
-626   {
-627     break-if-!=
-628     return 0/false
-629   }
-630   compare g, 0x2b/plus
-631   {
-632     break-if-!=
-633     return 0/false
-634   }
-635   compare g, 0x2d/dash  # '-' not allowed in symbols
-636   {
-637     break-if-!=
-638     return 0/false
-639   }
-640   compare g, 0x2e/period
-641   {
-642     break-if-!=
-643     return 0/false
-644   }
-645   compare g, 0x2f/slash
-646   {
-647     break-if-!=
-648     return 0/false
-649   }
-650   compare g, 0x3a/colon
-651   {
-652     break-if-!=
-653     return 0/false
-654   }
-655   compare g, 0x3b/semi-colon
-656   {
-657     break-if-!=
-658     return 0/false
-659   }
-660   compare g, 0x3c/less-than
-661   {
-662     break-if-!=
-663     return 0/false
-664   }
-665   compare g, 0x3d/equal
-666   {
-667     break-if-!=
-668     return 0/false
-669   }
-670   compare g, 0x3e/greater-than
-671   {
-672     break-if-!=
-673     return 0/false
-674   }
-675   # '?' is a symbol char
-676   compare g, 0x5c/backslash
-677   {
-678     break-if-!=
-679     return 0/false
-680   }
-681   compare g, 0x5e/caret
-682   {
-683     break-if-!=
-684     return 0/false
-685   }
-686   # '_' is a symbol char
-687   compare g, 0x7c/vertical-line
-688   {
-689     break-if-!=
-690     return 0/false
-691   }
-692   compare g, 0x7e/tilde
-693   {
-694     break-if-!=
-695     return 0/false
-696   }
-697   return 1/true
-698 }
-699 
-700 fn bracket-grapheme? g: grapheme -> _/eax: boolean {
-701   compare g, 0x28/open-paren
-702   {
-703     break-if-!=
-704     return 1/true
-705   }
-706   compare g, 0x29/close-paren
-707   {
-708     break-if-!=
-709     return 1/true
-710   }
-711   compare g, 0x5b/open-square-bracket
-712   {
-713     break-if-!=
-714     return 1/true
-715   }
-716   compare g, 0x5d/close-square-bracket
-717   {
-718     break-if-!=
-719     return 1/true
-720   }
-721   compare g, 0x7b/open-curly-bracket
-722   {
-723     break-if-!=
-724     return 1/true
-725   }
-726   compare g, 0x7d/close-curly-bracket
-727   {
-728     break-if-!=
-729     return 1/true
-730   }
-731   return 0/false
-732 }
-733 
-734 fn operator-grapheme? g: grapheme -> _/eax: boolean {
-735   # '$' is a symbol char
-736   compare g, 0x25/percent
-737   {
-738     break-if-!=
-739     return 1/false
-740   }
-741   compare g, 0x26/ampersand
-742   {
-743     break-if-!=
-744     return 1/true
-745   }
-746   compare g, 0x27/single-quote
-747   {
-748     break-if-!=
-749     return 0/true
-750   }
-751   compare g, 0x60/backquote
-752   {
-753     break-if-!=
-754     return 0/false
-755   }
-756   compare g, 0x2c/comma
-757   {
-758     break-if-!=
-759     return 0/false
-760   }
-761   compare g, 0x40/at-sign
-762   {
-763     break-if-!=
-764     return 0/false
-765   }
-766   compare g, 0x2a/asterisk
-767   {
-768     break-if-!=
-769     return 1/true
-770   }
-771   compare g, 0x2b/plus
-772   {
-773     break-if-!=
-774     return 1/true
-775   }
-776   compare g, 0x2d/dash  # '-' not allowed in symbols
-777   {
-778     break-if-!=
-779     return 1/true
-780   }
-781   compare g, 0x2e/period
-782   {
-783     break-if-!=
-784     return 1/true
-785   }
-786   compare g, 0x2f/slash
-787   {
-788     break-if-!=
-789     return 1/true
-790   }
-791   compare g, 0x3a/colon
-792   {
-793     break-if-!=
-794     return 1/true
-795   }
-796   compare g, 0x3b/semi-colon
-797   {
-798     break-if-!=
-799     return 1/true
-800   }
-801   compare g, 0x3c/less-than
-802   {
-803     break-if-!=
-804     return 1/true
-805   }
-806   compare g, 0x3d/equal
-807   {
-808     break-if-!=
-809     return 1/true
-810   }
-811   compare g, 0x3e/greater-than
-812   {
-813     break-if-!=
-814     return 1/true
-815   }
-816   # '?' is a symbol char
-817   compare g, 0x5c/backslash
-818   {
-819     break-if-!=
-820     return 1/true
-821   }
-822   compare g, 0x5e/caret
-823   {
-824     break-if-!=
-825     return 1/true
-826   }
-827   # '_' is a symbol char
-828   compare g, 0x7c/vertical-line
-829   {
-830     break-if-!=
-831     return 1/true
-832   }
-833   compare g, 0x7e/tilde
-834   {
-835     break-if-!=
-836     return 1/true
-837   }
-838   return 0/false
-839 }
-840 
-841 fn number-token? _in: (addr cell) -> _/eax: boolean {
-842   var in/eax: (addr cell) <- copy _in
-843   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-844   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
-845   rewind-stream in-data
-846   var g/eax: grapheme <- read-grapheme in-data
-847   var result/eax: boolean <- decimal-digit? g
-848   return result
-849 }
-850 
-851 fn bracket-token? _in: (addr cell) -> _/eax: boolean {
-852   var in/eax: (addr cell) <- copy _in
-853   {
-854     var in-type/eax: (addr int) <- get in, type
-855     compare *in-type, 3/stream
-856     break-if-!=
-857     # streams are never paren tokens
-858     return 0/false
-859   }
-860   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-861   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
-862   rewind-stream in-data
-863   var g/eax: grapheme <- read-grapheme in-data
-864   var result/eax: boolean <- bracket-grapheme? g
-865   return result
-866 }
-867 
-868 fn quote-token? _in: (addr cell) -> _/eax: boolean {
-869   var in/eax: (addr cell) <- copy _in
-870   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-871   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
-872   rewind-stream in-data
-873   var result/eax: boolean <- stream-data-equal? in-data, "'"
-874   return result
-875 }
-876 
-877 fn backquote-token? _in: (addr cell) -> _/eax: boolean {
-878   var in/eax: (addr cell) <- copy _in
-879   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-880   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
-881   rewind-stream in-data
-882   var result/eax: boolean <- stream-data-equal? in-data, "`"
-883   return result
-884 }
-885 
-886 fn unquote-token? _in: (addr cell) -> _/eax: boolean {
-887   var in/eax: (addr cell) <- copy _in
-888   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-889   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
-890   rewind-stream in-data
-891   var result/eax: boolean <- stream-data-equal? in-data, ","
-892   return result
-893 }
-894 
-895 fn unquote-splice-token? _in: (addr cell) -> _/eax: boolean {
-896   var in/eax: (addr cell) <- copy _in
-897   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-898   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
-899   rewind-stream in-data
-900   var result/eax: boolean <- stream-data-equal? in-data, ",@"
-901   return result
-902 }
-903 
-904 fn open-paren-token? _in: (addr cell) -> _/eax: boolean {
-905   var in/eax: (addr cell) <- copy _in
-906   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-907   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
-908   var in-data/ecx: (addr stream byte) <- copy _in-data
-909   rewind-stream in-data
-910   var g/eax: grapheme <- read-grapheme in-data
-911   compare g, 0x28/open-paren
-912   {
-913     break-if-!=
-914     var result/eax: boolean <- stream-empty? in-data
-915     return result
-916   }
-917   return 0/false
-918 }
-919 
-920 fn close-paren-token? _in: (addr cell) -> _/eax: boolean {
-921   var in/eax: (addr cell) <- copy _in
-922   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-923   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
-924   var in-data/ecx: (addr stream byte) <- copy _in-data
-925   rewind-stream in-data
-926   var g/eax: grapheme <- read-grapheme in-data
-927   compare g, 0x29/close-paren
-928   {
-929     break-if-!=
-930     var result/eax: boolean <- stream-empty? in-data
-931     return result
-932   }
-933   return 0/false
-934 }
-935 
-936 fn dot-token? _in: (addr cell) -> _/eax: boolean {
-937   var in/eax: (addr cell) <- copy _in
-938   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-939   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
-940   var in-data/ecx: (addr stream byte) <- copy _in-data
-941   rewind-stream in-data
-942   var g/eax: grapheme <- read-grapheme in-data
-943   compare g, 0x2e/dot
-944   {
-945     break-if-!=
-946     var result/eax: boolean <- stream-empty? in-data
-947     return result
-948   }
-949   return 0/false
-950 }
-951 
-952 fn test-dot-token {
-953   var tmp-storage: (handle cell)
-954   var tmp-ah/eax: (addr handle cell) <- address tmp-storage
-955   new-symbol tmp-ah, "."
-956   var tmp/eax: (addr cell) <- lookup *tmp-ah
-957   var result/eax: boolean <- dot-token? tmp
-958   check result, "F - test-dot-token"
-959 }
-960 
-961 fn stream-token? _in: (addr cell) -> _/eax: boolean {
-962   var in/eax: (addr cell) <- copy _in
-963   var in-type/eax: (addr int) <- get in, type
-964   compare *in-type, 3/stream
-965   {
-966     break-if-=
-967     return 0/false
-968   }
-969   return 1/true
-970 }
-971 
-972 fn comment-token? _in: (addr cell) -> _/eax: boolean {
-973   var in/eax: (addr cell) <- copy _in
-974   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
-975   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
-976   rewind-stream in-data
-977   var g/eax: grapheme <- read-grapheme in-data
-978   compare g, 0x23/hash
-979   {
-980     break-if-=
-981     return 0/false
-982   }
-983   return 1/true
-984 }
+   1 # We reuse the cell data structure for tokenization
+   2 # Token cells are special, though. They have no type, they're always atoms,
+   3 # they always have text-data.
+   4 
+   5 fn tokenize in: (addr gap-buffer), out: (addr stream cell), trace: (addr trace) {
+   6   trace-text trace, "tokenize", "tokenize"
+   7   trace-lower trace
+   8   rewind-gap-buffer in
+   9   var token-storage: cell
+  10   var token/edx: (addr cell) <- address token-storage
+  11   {
+  12     skip-whitespace-from-gap-buffer in
+  13     var done?/eax: boolean <- gap-buffer-scan-done? in
+  14     compare done?, 0/false
+  15     break-if-!=
+  16     #
+  17     next-token in, token, trace
+  18     var error?/eax: boolean <- has-errors? trace
+  19     compare error?, 0/false
+  20     {
+  21       break-if-=
+  22       return
+  23     }
+  24     var skip?/eax: boolean <- comment-token? token
+  25     compare skip?, 0/false
+  26     loop-if-!=
+  27     write-to-stream out, token  # shallow-copy text-data
+  28     loop
+  29   }
+  30   trace-higher trace
+  31 }
+  32 
+  33 fn test-tokenize-number {
+  34   var in-storage: gap-buffer
+  35   var in/esi: (addr gap-buffer) <- address in-storage
+  36   initialize-gap-buffer-with in, "123 a"
+  37   #
+  38   var stream-storage: (stream cell 0x10)
+  39   var stream/edi: (addr stream cell) <- address stream-storage
+  40   #
+  41   var trace-storage: trace
+  42   var trace/edx: (addr trace) <- address trace-storage
+  43   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+  44   tokenize in, stream, trace
+  45   #
+  46   var curr-token-storage: cell
+  47   var curr-token/ebx: (addr cell) <- address curr-token-storage
+  48   read-from-stream stream, curr-token
+  49   var number?/eax: boolean <- number-token? curr-token
+  50   check number?, "F - test-tokenize-number"
+  51   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+  52   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+  53   check-stream-equal curr-token-data, "123", "F - test-tokenize-number: value"
+  54 }
+  55 
+  56 fn test-tokenize-negative-number {
+  57   var in-storage: gap-buffer
+  58   var in/esi: (addr gap-buffer) <- address in-storage
+  59   initialize-gap-buffer-with in, "-123 a"
+  60   #
+  61   var stream-storage: (stream cell 0x10)
+  62   var stream/edi: (addr stream cell) <- address stream-storage
+  63   #
+  64   var trace-storage: trace
+  65   var trace/edx: (addr trace) <- address trace-storage
+  66   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+  67   tokenize in, stream, trace
+  68   #
+  69   var curr-token-storage: cell
+  70   var curr-token/ebx: (addr cell) <- address curr-token-storage
+  71   read-from-stream stream, curr-token
+  72   var number?/eax: boolean <- number-token? curr-token
+  73   check number?, "F - test-tokenize-negative-number"
+  74   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+  75   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+  76   check-stream-equal curr-token-data, "-123", "F - test-tokenize-negative-number: value"
+  77 }
+  78 
+  79 fn test-tokenize-number-followed-by-hyphen {
+  80   var in-storage: gap-buffer
+  81   var in/esi: (addr gap-buffer) <- address in-storage
+  82   initialize-gap-buffer-with in, "123-4 a"
+  83   #
+  84   var stream-storage: (stream cell 0x10)
+  85   var stream/edi: (addr stream cell) <- address stream-storage
+  86   #
+  87   var trace-storage: trace
+  88   var trace/edx: (addr trace) <- address trace-storage
+  89   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+  90   tokenize in, stream, trace
+  91   #
+  92   var curr-token-storage: cell
+  93   var curr-token/ebx: (addr cell) <- address curr-token-storage
+  94   read-from-stream stream, curr-token
+  95   var number?/eax: boolean <- number-token? curr-token
+  96   check number?, "F - test-tokenize-number-followed-by-hyphen"
+  97   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+  98   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+  99   check-stream-equal curr-token-data, "123", "F - test-tokenize-number-followed-by-hyphen: value"
+ 100 }
+ 101 
+ 102 fn test-tokenize-quote {
+ 103   var in-storage: gap-buffer
+ 104   var in/esi: (addr gap-buffer) <- address in-storage
+ 105   initialize-gap-buffer-with in, "'(a)"
+ 106   #
+ 107   var stream-storage: (stream cell 0x10)
+ 108   var stream/edi: (addr stream cell) <- address stream-storage
+ 109   #
+ 110   var trace-storage: trace
+ 111   var trace/edx: (addr trace) <- address trace-storage
+ 112   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 113   tokenize in, stream, trace
+ 114   #
+ 115   var curr-token-storage: cell
+ 116   var curr-token/ebx: (addr cell) <- address curr-token-storage
+ 117   read-from-stream stream, curr-token
+ 118   var quote?/eax: boolean <- quote-token? curr-token
+ 119   check quote?, "F - test-tokenize-quote: quote"
+ 120   read-from-stream stream, curr-token
+ 121   var open-paren?/eax: boolean <- open-paren-token? curr-token
+ 122   check open-paren?, "F - test-tokenize-quote: open paren"
+ 123   read-from-stream stream, curr-token  # skip a
+ 124   read-from-stream stream, curr-token
+ 125   var close-paren?/eax: boolean <- close-paren-token? curr-token
+ 126   check close-paren?, "F - test-tokenize-quote: close paren"
+ 127 }
+ 128 
+ 129 fn test-tokenize-backquote {
+ 130   var in-storage: gap-buffer
+ 131   var in/esi: (addr gap-buffer) <- address in-storage
+ 132   initialize-gap-buffer-with in, "`(a)"
+ 133   #
+ 134   var stream-storage: (stream cell 0x10)
+ 135   var stream/edi: (addr stream cell) <- address stream-storage
+ 136   #
+ 137   var trace-storage: trace
+ 138   var trace/edx: (addr trace) <- address trace-storage
+ 139   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 140   tokenize in, stream, trace
+ 141   #
+ 142   var curr-token-storage: cell
+ 143   var curr-token/ebx: (addr cell) <- address curr-token-storage
+ 144   read-from-stream stream, curr-token
+ 145   var backquote?/eax: boolean <- backquote-token? curr-token
+ 146   check backquote?, "F - test-tokenize-backquote: backquote"
+ 147   read-from-stream stream, curr-token
+ 148   var open-paren?/eax: boolean <- open-paren-token? curr-token
+ 149   check open-paren?, "F - test-tokenize-backquote: open paren"
+ 150   read-from-stream stream, curr-token  # skip a
+ 151   read-from-stream stream, curr-token
+ 152   var close-paren?/eax: boolean <- close-paren-token? curr-token
+ 153   check close-paren?, "F - test-tokenize-backquote: close paren"
+ 154 }
+ 155 
+ 156 fn test-tokenize-unquote {
+ 157   var in-storage: gap-buffer
+ 158   var in/esi: (addr gap-buffer) <- address in-storage
+ 159   initialize-gap-buffer-with in, ",(a)"
+ 160   #
+ 161   var stream-storage: (stream cell 0x10)
+ 162   var stream/edi: (addr stream cell) <- address stream-storage
+ 163   #
+ 164   var trace-storage: trace
+ 165   var trace/edx: (addr trace) <- address trace-storage
+ 166   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 167   tokenize in, stream, trace
+ 168   #
+ 169   var curr-token-storage: cell
+ 170   var curr-token/ebx: (addr cell) <- address curr-token-storage
+ 171   read-from-stream stream, curr-token
+ 172   var unquote?/eax: boolean <- unquote-token? curr-token
+ 173   check unquote?, "F - test-tokenize-unquote: unquote"
+ 174   read-from-stream stream, curr-token
+ 175   var open-paren?/eax: boolean <- open-paren-token? curr-token
+ 176   check open-paren?, "F - test-tokenize-unquote: open paren"
+ 177   read-from-stream stream, curr-token  # skip a
+ 178   read-from-stream stream, curr-token
+ 179   var close-paren?/eax: boolean <- close-paren-token? curr-token
+ 180   check close-paren?, "F - test-tokenize-unquote: close paren"
+ 181 }
+ 182 
+ 183 fn test-tokenize-unquote-splice {
+ 184   var in-storage: gap-buffer
+ 185   var in/esi: (addr gap-buffer) <- address in-storage
+ 186   initialize-gap-buffer-with in, ",@a"
+ 187   #
+ 188   var stream-storage: (stream cell 0x10)
+ 189   var stream/edi: (addr stream cell) <- address stream-storage
+ 190   #
+ 191   var trace-storage: trace
+ 192   var trace/edx: (addr trace) <- address trace-storage
+ 193   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 194   tokenize in, stream, trace
+ 195   #
+ 196   var curr-token-storage: cell
+ 197   var curr-token/ebx: (addr cell) <- address curr-token-storage
+ 198   read-from-stream stream, curr-token
+ 199   var unquote-splice?/eax: boolean <- unquote-splice-token? curr-token
+ 200   check unquote-splice?, "F - test-tokenize-unquote-splice: unquote-splice"
+ 201 }
+ 202 
+ 203 fn test-tokenize-dotted-list {
+ 204   var in-storage: gap-buffer
+ 205   var in/esi: (addr gap-buffer) <- address in-storage
+ 206   initialize-gap-buffer-with in, "(a . b)"
+ 207   #
+ 208   var stream-storage: (stream cell 0x10)
+ 209   var stream/edi: (addr stream cell) <- address stream-storage
+ 210   #
+ 211   var trace-storage: trace
+ 212   var trace/edx: (addr trace) <- address trace-storage
+ 213   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 214   tokenize in, stream, trace
+ 215   #
+ 216   var curr-token-storage: cell
+ 217   var curr-token/ebx: (addr cell) <- address curr-token-storage
+ 218   read-from-stream stream, curr-token
+ 219   var open-paren?/eax: boolean <- open-paren-token? curr-token
+ 220   check open-paren?, "F - test-tokenize-dotted-list: open paren"
+ 221   read-from-stream stream, curr-token  # skip a
+ 222   read-from-stream stream, curr-token
+ 223   var dot?/eax: boolean <- dot-token? curr-token
+ 224   check dot?, "F - test-tokenize-dotted-list: dot"
+ 225   read-from-stream stream, curr-token  # skip b
+ 226   read-from-stream stream, curr-token
+ 227   var close-paren?/eax: boolean <- close-paren-token? curr-token
+ 228   check close-paren?, "F - test-tokenize-dotted-list: close paren"
+ 229 }
+ 230 
+ 231 fn test-tokenize-stream-literal {
+ 232   var in-storage: gap-buffer
+ 233   var in/esi: (addr gap-buffer) <- address in-storage
+ 234   initialize-gap-buffer-with in, "[abc def]"
+ 235   #
+ 236   var stream-storage: (stream cell 0x10)
+ 237   var stream/edi: (addr stream cell) <- address stream-storage
+ 238   #
+ 239   var trace-storage: trace
+ 240   var trace/edx: (addr trace) <- address trace-storage
+ 241   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 242   tokenize in, stream, trace
+ 243   #
+ 244   var curr-token-storage: cell
+ 245   var curr-token/ebx: (addr cell) <- address curr-token-storage
+ 246   read-from-stream stream, curr-token
+ 247   var stream?/eax: boolean <- stream-token? curr-token
+ 248   check stream?, "F - test-tokenize-stream-literal: type"
+ 249   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+ 250   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+ 251   var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def"
+ 252   check data-equal?, "F - test-tokenize-stream-literal"
+ 253   var empty?/eax: boolean <- stream-empty? stream
+ 254   check empty?, "F - test-tokenize-stream-literal: empty?"
+ 255 }
+ 256 
+ 257 fn test-tokenize-stream-literal-in-tree {
+ 258   var in-storage: gap-buffer
+ 259   var in/esi: (addr gap-buffer) <- address in-storage
+ 260   initialize-gap-buffer-with in, "([abc def])"
+ 261   #
+ 262   var stream-storage: (stream cell 0x10)
+ 263   var stream/edi: (addr stream cell) <- address stream-storage
+ 264   #
+ 265   var trace-storage: trace
+ 266   var trace/edx: (addr trace) <- address trace-storage
+ 267   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+ 268   tokenize in, stream, trace
+ 269   #
+ 270   var curr-token-storage: cell
+ 271   var curr-token/ebx: (addr cell) <- address curr-token-storage
+ 272   read-from-stream stream, curr-token
+ 273   var bracket?/eax: boolean <- bracket-token? curr-token
+ 274   check bracket?, "F - test-tokenize-stream-literal-in-tree: open paren"
+ 275   read-from-stream stream, curr-token
+ 276   var stream?/eax: boolean <- stream-token? curr-token
+ 277   check stream?, "F - test-tokenize-stream-literal-in-tree: type"
+ 278   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+ 279   var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+ 280   var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def"
+ 281   check data-equal?, "F - test-tokenize-stream-literal-in-tree"
+ 282   read-from-stream stream, curr-token
+ 283   var bracket?/eax: boolean <- bracket-token? curr-token
+ 284   check bracket?, "F - test-tokenize-stream-literal-in-tree: close paren"
+ 285   var empty?/eax: boolean <- stream-empty? stream
+ 286   check empty?, "F - test-tokenize-stream-literal-in-tree: empty?"
+ 287 }
+ 288 
+ 289 fn next-token in: (addr gap-buffer), _out-cell: (addr cell), trace: (addr trace) {
+ 290   trace-text trace, "tokenize", "next-token"
+ 291   trace-lower trace
+ 292   var _g/eax: grapheme <- peek-from-gap-buffer in
+ 293   var g/ecx: grapheme <- copy _g
+ 294   {
+ 295     var should-trace?/eax: boolean <- should-trace? trace
+ 296     compare should-trace?, 0/false
+ 297     break-if-=
+ 298     var stream-storage: (stream byte 0x40)
+ 299     var stream/esi: (addr stream byte) <- address stream-storage
+ 300     write stream, "next: "
+ 301     var gval/eax: int <- copy g
+ 302     write-int32-hex stream, gval
+ 303     trace trace, "tokenize", stream
+ 304   }
+ 305   var out-cell/eax: (addr cell) <- copy _out-cell
+ 306   {
+ 307     var out-cell-type/eax: (addr int) <- get out-cell, type
+ 308     copy-to *out-cell-type, 0/uninitialized
+ 309   }
+ 310   var out-ah/edi: (addr handle stream byte) <- get out-cell, text-data
+ 311   $next-token:allocate: {
+ 312     # Allocate a large buffer if it's a stream.
+ 313     # Sometimes a whole function definition will need to fit in it.
+ 314     compare g, 0x5b/open-square-bracket
+ 315     {
+ 316       break-if-!=
+ 317       populate-stream out-ah, 0x400/max-definition-size=1KB
+ 318       break $next-token:allocate
+ 319     }
+ 320     populate-stream out-ah, 0x40
+ 321   }
+ 322   var _out/eax: (addr stream byte) <- lookup *out-ah
+ 323   var out/edi: (addr stream byte) <- copy _out
+ 324   clear-stream out
+ 325   $next-token:case: {
+ 326     # open square brackets begin streams
+ 327     {
+ 328       compare g, 0x5b/open-square-bracket
+ 329       break-if-!=
+ 330       var dummy/eax: grapheme <- read-from-gap-buffer in  # skip open bracket
+ 331       next-stream-token in, out, trace
+ 332       var out-cell/eax: (addr cell) <- copy _out-cell
+ 333       # streams set the type
+ 334       var out-cell-type/eax: (addr int) <- get out-cell, type
+ 335       copy-to *out-cell-type, 3/stream
+ 336       break $next-token:case
+ 337     }
+ 338     # comment
+ 339     {
+ 340       compare g, 0x23/comment
+ 341       break-if-!=
+ 342       rest-of-line in, out, trace
+ 343       break $next-token:case
+ 344     }
+ 345     # special-case: '-'
+ 346     {
+ 347       compare g, 0x2d/minus
+ 348       break-if-!=
+ 349       var dummy/eax: grapheme <- read-from-gap-buffer in  # skip '-'
+ 350       var g2/eax: grapheme <- peek-from-gap-buffer in
+ 351       put-back-from-gap-buffer in
+ 352       var digit?/eax: boolean <- decimal-digit? g2
+ 353       compare digit?, 0/false
+ 354       break-if-=
+ 355       next-number-token in, out, trace
+ 356       break $next-token:case
+ 357     }
+ 358     # digit
+ 359     {
+ 360       var digit?/eax: boolean <- decimal-digit? g
+ 361       compare digit?, 0/false
+ 362       break-if-=
+ 363       next-number-token in, out, trace
+ 364       break $next-token:case
+ 365     }
+ 366     # other symbol char
+ 367     {
+ 368       var symbol?/eax: boolean <- symbol-grapheme? g
+ 369       compare symbol?, 0/false
+ 370       break-if-=
+ 371       next-symbol-token in, out, trace
+ 372       break $next-token:case
+ 373     }
+ 374     # unbalanced close square brackets are errors
+ 375     {
+ 376       compare g, 0x5d/close-square-bracket
+ 377       break-if-!=
+ 378       error trace, "unbalanced ']'"
+ 379       return
+ 380     }
+ 381     # other brackets are always single-char tokens
+ 382     {
+ 383       var bracket?/eax: boolean <- bracket-grapheme? g
+ 384       compare bracket?, 0/false
+ 385       break-if-=
+ 386       var g/eax: grapheme <- read-from-gap-buffer in
+ 387       next-bracket-token g, out, trace
+ 388       break $next-token:case
+ 389     }
+ 390     # non-symbol operators
+ 391     {
+ 392       var operator?/eax: boolean <- operator-grapheme? g
+ 393       compare operator?, 0/false
+ 394       break-if-=
+ 395       next-operator-token in, out, trace
+ 396       break $next-token:case
+ 397     }
+ 398     # quote
+ 399     {
+ 400       compare g, 0x27/single-quote
+ 401       break-if-!=
+ 402       var g/eax: grapheme <- read-from-gap-buffer in  # consume
+ 403       write-grapheme out, g
+ 404       break $next-token:case
+ 405     }
+ 406     # backquote
+ 407     {
+ 408       compare g, 0x60/backquote
+ 409       break-if-!=
+ 410       var g/eax: grapheme <- read-from-gap-buffer in  # consume
+ 411       write-grapheme out, g
+ 412       break $next-token:case
+ 413     }
+ 414     # unquote
+ 415     {
+ 416       compare g, 0x2c/comma
+ 417       break-if-!=
+ 418       var g/eax: grapheme <- read-from-gap-buffer in  # consume
+ 419       write-grapheme out, g
+ 420       # check for unquote-splice
+ 421       {
+ 422         var g2/eax: grapheme <- peek-from-gap-buffer in
+ 423         compare g2, 0x40/at-sign
+ 424         break-if-!=
+ 425         g2 <- read-from-gap-buffer in
+ 426         write-grapheme out, g2
+ 427       }
+ 428       break $next-token:case
+ 429     }
+ 430     abort "unknown token type"
+ 431   }
+ 432   trace-higher trace
+ 433   {
+ 434     var should-trace?/eax: boolean <- should-trace? trace
+ 435     compare should-trace?, 0/false
+ 436     break-if-=
+ 437     var stream-storage: (stream byte 0x400)  # maximum possible token size (next-stream-token)
+ 438     var stream/eax: (addr stream byte) <- address stream-storage
+ 439     write stream, "=> "
+ 440     rewind-stream out
+ 441     write-stream stream, out
+ 442     trace trace, "tokenize", stream
+ 443   }
+ 444 }
+ 445 
+ 446 fn next-symbol-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
+ 447   trace-text trace, "tokenize", "looking for a symbol"
+ 448   trace-lower trace
+ 449   $next-symbol-token:loop: {
+ 450     var done?/eax: boolean <- gap-buffer-scan-done? in
+ 451     compare done?, 0/false
+ 452     break-if-!=
+ 453     var g/eax: grapheme <- peek-from-gap-buffer in
+ 454     {
+ 455       {
+ 456         var should-trace?/eax: boolean <- should-trace? trace
+ 457         compare should-trace?, 0/false
+ 458       }
+ 459       break-if-=
+ 460       var stream-storage: (stream byte 0x40)
+ 461       var stream/esi: (addr stream byte) <- address stream-storage
+ 462       write stream, "next: "
+ 463       var gval/eax: int <- copy g
+ 464       write-int32-hex stream, gval
+ 465       trace trace, "tokenize", stream
+ 466     }
+ 467     # if non-symbol, return
+ 468     {
+ 469       var symbol-grapheme?/eax: boolean <- symbol-grapheme? g
+ 470       compare symbol-grapheme?, 0/false
+ 471       break-if-!=
+ 472       trace-text trace, "tokenize", "stop"
+ 473       break $next-symbol-token:loop
+ 474     }
+ 475     var g/eax: grapheme <- read-from-gap-buffer in
+ 476     write-grapheme out, g
+ 477     loop
+ 478   }
+ 479   trace-higher trace
+ 480   {
+ 481     var should-trace?/eax: boolean <- should-trace? trace
+ 482     compare should-trace?, 0/false
+ 483     break-if-=
+ 484     var stream-storage: (stream byte 0x40)
+ 485     var stream/esi: (addr stream byte) <- address stream-storage
+ 486     write stream, "=> "
+ 487     rewind-stream out
+ 488     write-stream stream, out
+ 489     trace trace, "tokenize", stream
+ 490   }
+ 491 }
+ 492 
+ 493 fn next-operator-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
+ 494   trace-text trace, "tokenize", "looking for a operator"
+ 495   trace-lower trace
+ 496   $next-operator-token:loop: {
+ 497     var done?/eax: boolean <- gap-buffer-scan-done? in
+ 498     compare done?, 0/false
+ 499     break-if-!=
+ 500     var g/eax: grapheme <- peek-from-gap-buffer in
+ 501     {
+ 502       {
+ 503         var should-trace?/eax: boolean <- should-trace? trace
+ 504         compare should-trace?, 0/false
+ 505       }
+ 506       break-if-=
+ 507       var stream-storage: (stream byte 0x40)
+ 508       var stream/esi: (addr stream byte) <- address stream-storage
+ 509       write stream, "next: "
+ 510       var gval/eax: int <- copy g
+ 511       write-int32-hex stream, gval
+ 512       trace trace, "tokenize", stream
+ 513     }
+ 514     # if non-operator, return
+ 515     {
+ 516       var operator-grapheme?/eax: boolean <- operator-grapheme? g
+ 517       compare operator-grapheme?, 0/false
+ 518       break-if-!=
+ 519       trace-text trace, "tokenize", "stop"
+ 520       break $next-operator-token:loop
+ 521     }
+ 522     var g/eax: grapheme <- read-from-gap-buffer in
+ 523     write-grapheme out, g
+ 524     loop
+ 525   }
+ 526   trace-higher trace
+ 527   {
+ 528     var should-trace?/eax: boolean <- should-trace? trace
+ 529     compare should-trace?, 0/false
+ 530     break-if-=
+ 531     var stream-storage: (stream byte 0x40)
+ 532     var stream/esi: (addr stream byte) <- address stream-storage
+ 533     write stream, "=> "
+ 534     rewind-stream out
+ 535     write-stream stream, out
+ 536     trace trace, "tokenize", stream
+ 537   }
+ 538 }
+ 539 
+ 540 fn next-number-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
+ 541   trace-text trace, "tokenize", "looking for a number"
+ 542   trace-lower trace
+ 543   $next-number-token:check-minus: {
+ 544     var g/eax: grapheme <- peek-from-gap-buffer in
+ 545     compare g, 0x2d/minus
+ 546     g <- read-from-gap-buffer in  # consume
+ 547     write-grapheme out, g
+ 548   }
+ 549   $next-number-token:loop: {
+ 550     var done?/eax: boolean <- gap-buffer-scan-done? in
+ 551     compare done?, 0/false
+ 552     break-if-!=
+ 553     var g/eax: grapheme <- peek-from-gap-buffer in
+ 554     {
+ 555       {
+ 556         var should-trace?/eax: boolean <- should-trace? trace
+ 557         compare should-trace?, 0/false
+ 558       }
+ 559       break-if-=
+ 560       var stream-storage: (stream byte 0x40)
+ 561       var stream/esi: (addr stream byte) <- address stream-storage
+ 562       write stream, "next: "
+ 563       var gval/eax: int <- copy g
+ 564       write-int32-hex stream, gval
+ 565       trace trace, "tokenize", stream
+ 566     }
+ 567     # if not symbol grapheme, return
+ 568     {
+ 569       var symbol-grapheme?/eax: boolean <- symbol-grapheme? g
+ 570       compare symbol-grapheme?, 0/false
+ 571       break-if-!=
+ 572       trace-text trace, "tokenize", "stop"
+ 573       break $next-number-token:loop
+ 574     }
+ 575     # if not digit grapheme, abort
+ 576     {
+ 577       var digit?/eax: boolean <- decimal-digit? g
+ 578       compare digit?, 0/false
+ 579       break-if-!=
+ 580       error trace, "invalid number"
+ 581       return
+ 582     }
+ 583     trace-text trace, "tokenize", "append"
+ 584     var g/eax: grapheme <- read-from-gap-buffer in
+ 585     write-grapheme out, g
+ 586     loop
+ 587   }
+ 588   trace-higher trace
+ 589 }
+ 590 
+ 591 fn next-stream-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
+ 592   trace-text trace, "tokenize", "stream"
+ 593   {
+ 594     var empty?/eax: boolean <- gap-buffer-scan-done? in
+ 595     compare empty?, 0/false
+ 596     {
+ 597       break-if-=
+ 598       error trace, "unbalanced '['"
+ 599       return
+ 600     }
+ 601     var g/eax: grapheme <- read-from-gap-buffer in
+ 602     compare g, 0x5d/close-square-bracket
+ 603     break-if-=
+ 604     write-grapheme out, g
+ 605     loop
+ 606   }
+ 607   {
+ 608     var should-trace?/eax: boolean <- should-trace? trace
+ 609     compare should-trace?, 0/false
+ 610     break-if-=
+ 611     var stream-storage: (stream byte 0x400)  # max-definition-size
+ 612     var stream/esi: (addr stream byte) <- address stream-storage
+ 613     write stream, "=> "
+ 614     rewind-stream out
+ 615     write-stream stream, out
+ 616     trace trace, "tokenize", stream
+ 617   }
+ 618 }
+ 619 
+ 620 fn next-bracket-token g: grapheme, out: (addr stream byte), trace: (addr trace) {
+ 621   trace-text trace, "tokenize", "bracket"
+ 622   write-grapheme out, g
+ 623   {
+ 624     var should-trace?/eax: boolean <- should-trace? trace
+ 625     compare should-trace?, 0/false
+ 626     break-if-=
+ 627     var stream-storage: (stream byte 0x40)
+ 628     var stream/esi: (addr stream byte) <- address stream-storage
+ 629     write stream, "=> "
+ 630     rewind-stream out
+ 631     write-stream stream, out
+ 632     trace trace, "tokenize", stream
+ 633   }
+ 634 }
+ 635 
+ 636 fn rest-of-line in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) {
+ 637   trace-text trace, "tokenize", "comment"
+ 638   {
+ 639     var empty?/eax: boolean <- gap-buffer-scan-done? in
+ 640     compare empty?, 0/false
+ 641     {
+ 642       break-if-=
+ 643       return
+ 644     }
+ 645     var g/eax: grapheme <- read-from-gap-buffer in
+ 646     compare g, 0xa/newline
+ 647     break-if-=
+ 648     write-grapheme out, g
+ 649     loop
+ 650   }
+ 651   {
+ 652     var should-trace?/eax: boolean <- should-trace? trace
+ 653     compare should-trace?, 0/false
+ 654     break-if-=
+ 655     var stream-storage: (stream byte 0x80)
+ 656     var stream/esi: (addr stream byte) <- address stream-storage
+ 657     write stream, "=> "
+ 658     rewind-stream out
+ 659     write-stream stream, out
+ 660     trace trace, "tokenize", stream
+ 661   }
+ 662 }
+ 663 
+ 664 fn symbol-grapheme? g: grapheme -> _/eax: boolean {
+ 665   ## whitespace
+ 666   compare g, 9/tab
+ 667   {
+ 668     break-if-!=
+ 669     return 0/false
+ 670   }
+ 671   compare g, 0xa/newline
+ 672   {
+ 673     break-if-!=
+ 674     return 0/false
+ 675   }
+ 676   compare g, 0x20/space
+ 677   {
+ 678     break-if-!=
+ 679     return 0/false
+ 680   }
+ 681   ## quotes
+ 682   compare g, 0x22/double-quote
+ 683   {
+ 684     break-if-!=
+ 685     return 0/false
+ 686   }
+ 687   compare g, 0x60/backquote
+ 688   {
+ 689     break-if-!=
+ 690     return 0/false
+ 691   }
+ 692   ## brackets
+ 693   compare g, 0x28/open-paren
+ 694   {
+ 695     break-if-!=
+ 696     return 0/false
+ 697   }
+ 698   compare g, 0x29/close-paren
+ 699   {
+ 700     break-if-!=
+ 701     return 0/false
+ 702   }
+ 703   compare g, 0x5b/open-square-bracket
+ 704   {
+ 705     break-if-!=
+ 706     return 0/false
+ 707   }
+ 708   compare g, 0x5d/close-square-bracket
+ 709   {
+ 710     break-if-!=
+ 711     return 0/false
+ 712   }
+ 713   compare g, 0x7b/open-curly-bracket
+ 714   {
+ 715     break-if-!=
+ 716     return 0/false
+ 717   }
+ 718   compare g, 0x7d/close-curly-bracket
+ 719   {
+ 720     break-if-!=
+ 721     return 0/false
+ 722   }
+ 723   # - other punctuation
+ 724   # '!' is a symbol char
+ 725   compare g, 0x23/hash
+ 726   {
+ 727     break-if-!=
+ 728     return 0/false
+ 729   }
+ 730   # '$' is a symbol char
+ 731   compare g, 0x25/percent
+ 732   {
+ 733     break-if-!=
+ 734     return 0/false
+ 735   }
+ 736   compare g, 0x26/ampersand
+ 737   {
+ 738     break-if-!=
+ 739     return 0/false
+ 740   }
+ 741   compare g, 0x27/single-quote
+ 742   {
+ 743     break-if-!=
+ 744     return 0/false
+ 745   }
+ 746   compare g, 0x60/backquote
+ 747   {
+ 748     break-if-!=
+ 749     return 0/false
+ 750   }
+ 751   compare g, 0x2c/comma
+ 752   {
+ 753     break-if-!=
+ 754     return 0/false
+ 755   }
+ 756   compare g, 0x40/at-sign
+ 757   {
+ 758     break-if-!=
+ 759     return 0/false
+ 760   }
+ 761   compare g, 0x2a/asterisk
+ 762   {
+ 763     break-if-!=
+ 764     return 0/false
+ 765   }
+ 766   compare g, 0x2b/plus
+ 767   {
+ 768     break-if-!=
+ 769     return 0/false
+ 770   }
+ 771   compare g, 0x2d/dash  # '-' not allowed in symbols
+ 772   {
+ 773     break-if-!=
+ 774     return 0/false
+ 775   }
+ 776   compare g, 0x2e/period
+ 777   {
+ 778     break-if-!=
+ 779     return 0/false
+ 780   }
+ 781   compare g, 0x2f/slash
+ 782   {
+ 783     break-if-!=
+ 784     return 0/false
+ 785   }
+ 786   compare g, 0x3a/colon
+ 787   {
+ 788     break-if-!=
+ 789     return 0/false
+ 790   }
+ 791   compare g, 0x3b/semi-colon
+ 792   {
+ 793     break-if-!=
+ 794     return 0/false
+ 795   }
+ 796   compare g, 0x3c/less-than
+ 797   {
+ 798     break-if-!=
+ 799     return 0/false
+ 800   }
+ 801   compare g, 0x3d/equal
+ 802   {
+ 803     break-if-!=
+ 804     return 0/false
+ 805   }
+ 806   compare g, 0x3e/greater-than
+ 807   {
+ 808     break-if-!=
+ 809     return 0/false
+ 810   }
+ 811   # '?' is a symbol char
+ 812   compare g, 0x5c/backslash
+ 813   {
+ 814     break-if-!=
+ 815     return 0/false
+ 816   }
+ 817   compare g, 0x5e/caret
+ 818   {
+ 819     break-if-!=
+ 820     return 0/false
+ 821   }
+ 822   # '_' is a symbol char
+ 823   compare g, 0x7c/vertical-line
+ 824   {
+ 825     break-if-!=
+ 826     return 0/false
+ 827   }
+ 828   compare g, 0x7e/tilde
+ 829   {
+ 830     break-if-!=
+ 831     return 0/false
+ 832   }
+ 833   return 1/true
+ 834 }
+ 835 
+ 836 fn bracket-grapheme? g: grapheme -> _/eax: boolean {
+ 837   compare g, 0x28/open-paren
+ 838   {
+ 839     break-if-!=
+ 840     return 1/true
+ 841   }
+ 842   compare g, 0x29/close-paren
+ 843   {
+ 844     break-if-!=
+ 845     return 1/true
+ 846   }
+ 847   compare g, 0x5b/open-square-bracket
+ 848   {
+ 849     break-if-!=
+ 850     return 1/true
+ 851   }
+ 852   compare g, 0x5d/close-square-bracket
+ 853   {
+ 854     break-if-!=
+ 855     return 1/true
+ 856   }
+ 857   compare g, 0x7b/open-curly-bracket
+ 858   {
+ 859     break-if-!=
+ 860     return 1/true
+ 861   }
+ 862   compare g, 0x7d/close-curly-bracket
+ 863   {
+ 864     break-if-!=
+ 865     return 1/true
+ 866   }
+ 867   return 0/false
+ 868 }
+ 869 
+ 870 fn operator-grapheme? g: grapheme -> _/eax: boolean {
+ 871   # '$' is a symbol char
+ 872   compare g, 0x25/percent
+ 873   {
+ 874     break-if-!=
+ 875     return 1/false
+ 876   }
+ 877   compare g, 0x26/ampersand
+ 878   {
+ 879     break-if-!=
+ 880     return 1/true
+ 881   }
+ 882   compare g, 0x27/single-quote
+ 883   {
+ 884     break-if-!=
+ 885     return 0/true
+ 886   }
+ 887   compare g, 0x60/backquote
+ 888   {
+ 889     break-if-!=
+ 890     return 0/false
+ 891   }
+ 892   compare g, 0x2c/comma
+ 893   {
+ 894     break-if-!=
+ 895     return 0/false
+ 896   }
+ 897   compare g, 0x40/at-sign
+ 898   {
+ 899     break-if-!=
+ 900     return 0/false
+ 901   }
+ 902   compare g, 0x2a/asterisk
+ 903   {
+ 904     break-if-!=
+ 905     return 1/true
+ 906   }
+ 907   compare g, 0x2b/plus
+ 908   {
+ 909     break-if-!=
+ 910     return 1/true
+ 911   }
+ 912   compare g, 0x2d/dash  # '-' not allowed in symbols
+ 913   {
+ 914     break-if-!=
+ 915     return 1/true
+ 916   }
+ 917   compare g, 0x2e/period
+ 918   {
+ 919     break-if-!=
+ 920     return 1/true
+ 921   }
+ 922   compare g, 0x2f/slash
+ 923   {
+ 924     break-if-!=
+ 925     return 1/true
+ 926   }
+ 927   compare g, 0x3a/colon
+ 928   {
+ 929     break-if-!=
+ 930     return 1/true
+ 931   }
+ 932   compare g, 0x3b/semi-colon
+ 933   {
+ 934     break-if-!=
+ 935     return 1/true
+ 936   }
+ 937   compare g, 0x3c/less-than
+ 938   {
+ 939     break-if-!=
+ 940     return 1/true
+ 941   }
+ 942   compare g, 0x3d/equal
+ 943   {
+ 944     break-if-!=
+ 945     return 1/true
+ 946   }
+ 947   compare g, 0x3e/greater-than
+ 948   {
+ 949     break-if-!=
+ 950     return 1/true
+ 951   }
+ 952   # '?' is a symbol char
+ 953   compare g, 0x5c/backslash
+ 954   {
+ 955     break-if-!=
+ 956     return 1/true
+ 957   }
+ 958   compare g, 0x5e/caret
+ 959   {
+ 960     break-if-!=
+ 961     return 1/true
+ 962   }
+ 963   # '_' is a symbol char
+ 964   compare g, 0x7c/vertical-line
+ 965   {
+ 966     break-if-!=
+ 967     return 1/true
+ 968   }
+ 969   compare g, 0x7e/tilde
+ 970   {
+ 971     break-if-!=
+ 972     return 1/true
+ 973   }
+ 974   return 0/false
+ 975 }
+ 976 
+ 977 fn number-token? _in: (addr cell) -> _/eax: boolean {
+ 978   var in/eax: (addr cell) <- copy _in
+ 979   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
+ 980   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
+ 981   var in-data/ecx: (addr stream byte) <- copy _in-data
+ 982   rewind-stream in-data
+ 983   var g/eax: grapheme <- read-grapheme in-data
+ 984   # if '-', read another
+ 985   {
+ 986     compare g, 0x2d/minus
+ 987     break-if-!=
+ 988     g <- read-grapheme in-data
+ 989   }
+ 990   var result/eax: boolean <- decimal-digit? g
+ 991   return result
+ 992 }
+ 993 
+ 994 fn bracket-token? _in: (addr cell) -> _/eax: boolean {
+ 995   var in/eax: (addr cell) <- copy _in
+ 996   {
+ 997     var in-type/eax: (addr int) <- get in, type
+ 998     compare *in-type, 3/stream
+ 999     break-if-!=
+1000     # streams are never paren tokens
+1001     return 0/false
+1002   }
+1003   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
+1004   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+1005   rewind-stream in-data
+1006   var g/eax: grapheme <- read-grapheme in-data
+1007   var result/eax: boolean <- bracket-grapheme? g
+1008   return result
+1009 }
+1010 
+1011 fn quote-token? _in: (addr cell) -> _/eax: boolean {
+1012   var in/eax: (addr cell) <- copy _in
+1013   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
+1014   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+1015   rewind-stream in-data
+1016   var result/eax: boolean <- stream-data-equal? in-data, "'"
+1017   return result
+1018 }
+1019 
+1020 fn backquote-token? _in: (addr cell) -> _/eax: boolean {
+1021   var in/eax: (addr cell) <- copy _in
+1022   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
+1023   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+1024   rewind-stream in-data
+1025   var result/eax: boolean <- stream-data-equal? in-data, "`"
+1026   return result
+1027 }
+1028 
+1029 fn unquote-token? _in: (addr cell) -> _/eax: boolean {
+1030   var in/eax: (addr cell) <- copy _in
+1031   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
+1032   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+1033   rewind-stream in-data
+1034   var result/eax: boolean <- stream-data-equal? in-data, ","
+1035   return result
+1036 }
+1037 
+1038 fn unquote-splice-token? _in: (addr cell) -> _/eax: boolean {
+1039   var in/eax: (addr cell) <- copy _in
+1040   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
+1041   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+1042   rewind-stream in-data
+1043   var result/eax: boolean <- stream-data-equal? in-data, ",@"
+1044   return result
+1045 }
+1046 
+1047 fn open-paren-token? _in: (addr cell) -> _/eax: boolean {
+1048   var in/eax: (addr cell) <- copy _in
+1049   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
+1050   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
+1051   var in-data/ecx: (addr stream byte) <- copy _in-data
+1052   rewind-stream in-data
+1053   var g/eax: grapheme <- read-grapheme in-data
+1054   compare g, 0x28/open-paren
+1055   {
+1056     break-if-!=
+1057     var result/eax: boolean <- stream-empty? in-data
+1058     return result
+1059   }
+1060   return 0/false
+1061 }
+1062 
+1063 fn close-paren-token? _in: (addr cell) -> _/eax: boolean {
+1064   var in/eax: (addr cell) <- copy _in
+1065   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
+1066   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
+1067   var in-data/ecx: (addr stream byte) <- copy _in-data
+1068   rewind-stream in-data
+1069   var g/eax: grapheme <- read-grapheme in-data
+1070   compare g, 0x29/close-paren
+1071   {
+1072     break-if-!=
+1073     var result/eax: boolean <- stream-empty? in-data
+1074     return result
+1075   }
+1076   return 0/false
+1077 }
+1078 
+1079 fn dot-token? _in: (addr cell) -> _/eax: boolean {
+1080   var in/eax: (addr cell) <- copy _in
+1081   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
+1082   var _in-data/eax: (addr stream byte) <- lookup *in-data-ah
+1083   var in-data/ecx: (addr stream byte) <- copy _in-data
+1084   rewind-stream in-data
+1085   var g/eax: grapheme <- read-grapheme in-data
+1086   compare g, 0x2e/dot
+1087   {
+1088     break-if-!=
+1089     var result/eax: boolean <- stream-empty? in-data
+1090     return result
+1091   }
+1092   return 0/false
+1093 }
+1094 
+1095 fn test-dot-token {
+1096   var tmp-storage: (handle cell)
+1097   var tmp-ah/eax: (addr handle cell) <- address tmp-storage
+1098   new-symbol tmp-ah, "."
+1099   var tmp/eax: (addr cell) <- lookup *tmp-ah
+1100   var result/eax: boolean <- dot-token? tmp
+1101   check result, "F - test-dot-token"
+1102 }
+1103 
+1104 fn stream-token? _in: (addr cell) -> _/eax: boolean {
+1105   var in/eax: (addr cell) <- copy _in
+1106   var in-type/eax: (addr int) <- get in, type
+1107   compare *in-type, 3/stream
+1108   {
+1109     break-if-=
+1110     return 0/false
+1111   }
+1112   return 1/true
+1113 }
+1114 
+1115 fn comment-token? _in: (addr cell) -> _/eax: boolean {
+1116   var in/eax: (addr cell) <- copy _in
+1117   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
+1118   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
+1119   rewind-stream in-data
+1120   var g/eax: grapheme <- read-grapheme in-data
+1121   compare g, 0x23/hash
+1122   {
+1123     break-if-=
+1124     return 0/false
+1125   }
+1126   return 1/true
+1127 }
diff --git a/html/shell/trace.mu.html b/html/shell/trace.mu.html index 56a78d1f..6151a9de 100644 --- a/html/shell/trace.mu.html +++ b/html/shell/trace.mu.html @@ -17,6 +17,7 @@ a { color:inherit; } .LineNr { } .Delimiter { color: #c000c0; } .CommentedCode { color: #8a8a8a; } +.muRegEdx { color: #878700; } .muRegEbx { color: #8787af; } .muRegEsi { color: #87d787; } .muRegEdi { color: #87ffd7; } @@ -28,7 +29,6 @@ a { color:inherit; } .muComment { color: #005faf; } .muRegEax { color: #875f00; } .muRegEcx { color: #af875f; } -.muRegEdx { color: #878700; } --> @@ -239,7 +239,7 @@ if ('onhashchange' in window) { 173 write message, " - find a smaller sub-computation to test,\n" 174 write message, " - allocate more space to the trace in initialize-sandbox\n" 175 write message, " (shell/sandbox.mu), or\n" - 176 write message, " - move the computation to 'main' and run it using ctrl-r" + 176 write message, " - move the computation to 'main' and run it using ctrl-r" 177 initialize-trace-line 0/depth, "error", message, dest 178 increment *index-addr 179 return @@ -483,10 +483,10 @@ if ('onhashchange' in window) { 417 var i/edx: int <- copy 0 418 var max-addr/ebx: (addr int) <- get self, first-free 419 var max/ebx: int <- copy *max-addr - 420 $dump-trace:loop: { + 420 $dump-trace-with-label:loop: { 421 compare i, max 422 break-if->= - 423 $dump-trace:iter: { + 423 $dump-trace-with-label:iter: { 424 var offset/ebx: (offset trace-line) <- compute-offset trace, i 425 var curr/ebx: (addr trace-line) <- index trace, offset 426 var curr-label-ah/eax: (addr handle array byte) <- get curr, label @@ -554,11 +554,11 @@ if ('onhashchange' in window) { 488 { 489 var width/eax: int <- copy 0 490 var height/ecx: int <- copy 0 - 491 width, height <- screen-size screen + 491 width, height <- screen-size screen 492 compare width, 0x80 493 break-if-< $render-trace:render-depth 494 } - 495 set-cursor-position screen, 0x70/x, y + 495 set-cursor-position screen, 0x70/x, y 496 draw-text-rightward-from-cursor-over-full-screen screen, "trace depth: ", 0x17/fg, 0xc5/bg=blue-bg 497 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, *max-depth, 0x7/fg, 0xc5/bg=blue-bg 498 } @@ -791,13 +791,13 @@ if ('onhashchange' in window) { 725 # setup: screen 726 var screen-on-stack: screen 727 var screen/edi: (addr screen) <- address screen-on-stack - 728 initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics + 728 initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics 729 # 730 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 5/xmax, 4/ymax, 0/no-cursor 731 # 732 check-ints-equal y, 0, "F - test-render-trace-empty/cursor" 733 check-screen-row screen, 0/y, " ", "F - test-render-trace-empty" - 734 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-render-trace-empty/bg" + 734 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-render-trace-empty/bg" 735 } 736 737 fn test-render-trace-empty-2 { @@ -807,13 +807,13 @@ if ('onhashchange' in window) { 741 # setup: screen 742 var screen-on-stack: screen 743 var screen/edi: (addr screen) <- address screen-on-stack - 744 initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics + 744 initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics 745 # 746 var y/ecx: int <- render-trace screen, t, 0/xmin, 2/ymin, 5/xmax, 4/ymax, 0/no-cursor # cursor below top row 747 # 748 check-ints-equal y, 2, "F - test-render-trace-empty-2/cursor" 749 check-screen-row screen, 2/y, " ", "F - test-render-trace-empty-2" - 750 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-render-trace-empty-2/bg" + 750 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-render-trace-empty-2/bg" 751 } 752 753 fn test-render-trace-empty-3 { @@ -823,15 +823,15 @@ if ('onhashchange' in window) { 757 # setup: screen 758 var screen-on-stack: screen 759 var screen/edi: (addr screen) <- address screen-on-stack - 760 initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics + 760 initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics 761 # 762 var y/ecx: int <- render-trace screen, t, 0/xmin, 2/ymin, 5/xmax, 4/ymax, 1/show-cursor # try show cursor 763 # still no cursor to show 764 check-ints-equal y, 2, "F - test-render-trace-empty-3/cursor" 765 check-screen-row screen, 1/y, " ", "F - test-render-trace-empty-3/line-above-cursor" - 766 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-render-trace-empty-3/bg-for-line-above-cursor" + 766 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-render-trace-empty-3/bg-for-line-above-cursor" 767 check-screen-row screen, 2/y, " ", "F - test-render-trace-empty-3" - 768 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-render-trace-empty-3/bg" + 768 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-render-trace-empty-3/bg" 769 } 770 771 fn test-render-trace-collapsed-by-default { @@ -842,7 +842,7 @@ if ('onhashchange' in window) { 776 # setup: screen 777 var screen-on-stack: screen 778 var screen/edi: (addr screen) <- address screen-on-stack - 779 initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics + 779 initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics 780 # 781 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 5/xmax, 4/ymax, 0/no-cursor 782 # @@ -858,7 +858,7 @@ if ('onhashchange' in window) { 792 # setup: screen 793 var screen-on-stack: screen 794 var screen/edi: (addr screen) <- address screen-on-stack - 795 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics + 795 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics 796 # 797 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor 798 # @@ -876,7 +876,7 @@ if ('onhashchange' in window) { 810 # setup: screen 811 var screen-on-stack: screen 812 var screen/edi: (addr screen) <- address screen-on-stack - 813 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics + 813 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics 814 # 815 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor 816 # @@ -895,7 +895,7 @@ if ('onhashchange' in window) { 829 # setup: screen 830 var screen-on-stack: screen 831 var screen/edi: (addr screen) <- address screen-on-stack - 832 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics + 832 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics 833 # 834 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor 835 # @@ -915,7 +915,7 @@ if ('onhashchange' in window) { 849 # setup: screen 850 var screen-on-stack: screen 851 var screen/edi: (addr screen) <- address screen-on-stack - 852 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics + 852 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics 853 # 854 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor 855 # @@ -936,30 +936,30 @@ if ('onhashchange' in window) { 870 # setup: screen 871 var screen-on-stack: screen 872 var screen/edi: (addr screen) <- address screen-on-stack - 873 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics + 873 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics 874 # 875 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor 876 # 877 check-screen-row screen, 0/y, "... ", "F - test-render-trace-cursor-in-single-line/0" - 878 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-render-trace-cursor-in-single-line/0/cursor" + 878 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-render-trace-cursor-in-single-line/0/cursor" 879 check-screen-row screen, 1/y, "error ", "F - test-render-trace-cursor-in-single-line/1" - 880 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-render-trace-cursor-in-single-line/1/cursor" + 880 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-render-trace-cursor-in-single-line/1/cursor" 881 check-screen-row screen, 2/y, "... ", "F - test-render-trace-cursor-in-single-line/2" - 882 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-render-trace-cursor-in-single-line/2/cursor" + 882 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-render-trace-cursor-in-single-line/2/cursor" 883 } 884 885 fn render-trace-menu screen: (addr screen) { 886 var width/eax: int <- copy 0 887 var height/ecx: int <- copy 0 - 888 width, height <- screen-size screen + 888 width, height <- screen-size screen 889 var y/ecx: int <- copy height 890 y <- decrement 891 var height/edx: int <- copy y 892 height <- increment - 893 clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg - 894 set-cursor-position screen, 0/x, y + 893 clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg + 894 set-cursor-position screen, 0/x, y 895 draw-text-rightward-from-cursor screen, " ^r ", width, 0/fg, 0x5c/bg=menu-highlight - 896 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0xc5/bg=blue-bg + 896 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0xc5/bg=blue-bg 897 draw-text-rightward-from-cursor screen, " ^g ", width, 0/fg, 0x5c/bg=menu-highlight 898 draw-text-rightward-from-cursor screen, " go to ", width, 7/fg, 0xc5/bg=blue-bg 899 draw-text-rightward-from-cursor screen, " ^m ", width, 0/fg, 3/bg=keyboard @@ -1242,36 +1242,36 @@ if ('onhashchange' in window) { 1176 # setup: screen 1177 var screen-on-stack: screen 1178 var screen/edi: (addr screen) <- address screen-on-stack -1179 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics +1179 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics 1180 # 1181 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor 1182 # 1183 check-screen-row screen, 0/y, "... ", "F - test-cursor-down-and-up-within-trace/pre-0" -1184 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-cursor-down-and-up-within-trace/pre-0/cursor" +1184 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-cursor-down-and-up-within-trace/pre-0/cursor" 1185 check-screen-row screen, 1/y, "error ", "F - test-cursor-down-and-up-within-trace/pre-1" -1186 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-cursor-down-and-up-within-trace/pre-1/cursor" +1186 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-cursor-down-and-up-within-trace/pre-1/cursor" 1187 check-screen-row screen, 2/y, "... ", "F - test-cursor-down-and-up-within-trace/pre-2" -1188 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-cursor-down-and-up-within-trace/pre-2/cursor" +1188 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-cursor-down-and-up-within-trace/pre-2/cursor" 1189 # cursor down 1190 edit-trace t, 0x6a/j 1191 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor 1192 # 1193 check-screen-row screen, 0/y, "... ", "F - test-cursor-down-and-up-within-trace/down-0" -1194 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-cursor-down-and-up-within-trace/down-0/cursor" +1194 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-cursor-down-and-up-within-trace/down-0/cursor" 1195 check-screen-row screen, 1/y, "error ", "F - test-cursor-down-and-up-within-trace/down-1" -1196 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "||||| ", "F - test-cursor-down-and-up-within-trace/down-1/cursor" +1196 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "||||| ", "F - test-cursor-down-and-up-within-trace/down-1/cursor" 1197 check-screen-row screen, 2/y, "... ", "F - test-cursor-down-and-up-within-trace/down-2" -1198 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-cursor-down-and-up-within-trace/down-2/cursor" +1198 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-cursor-down-and-up-within-trace/down-2/cursor" 1199 # cursor up 1200 edit-trace t, 0x6b/k 1201 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor 1202 # 1203 check-screen-row screen, 0/y, "... ", "F - test-cursor-down-and-up-within-trace/up-0" -1204 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-cursor-down-and-up-within-trace/up-0/cursor" +1204 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-cursor-down-and-up-within-trace/up-0/cursor" 1205 check-screen-row screen, 1/y, "error ", "F - test-cursor-down-and-up-within-trace/up-1" -1206 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-cursor-down-and-up-within-trace/up-1/cursor" +1206 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-cursor-down-and-up-within-trace/up-1/cursor" 1207 check-screen-row screen, 2/y, "... ", "F - test-cursor-down-and-up-within-trace/up-2" -1208 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-cursor-down-and-up-within-trace/up-2/cursor" +1208 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-cursor-down-and-up-within-trace/up-2/cursor" 1209 } 1210 1211 fn test-cursor-down-past-bottom-of-trace { @@ -1285,16 +1285,16 @@ if ('onhashchange' in window) { 1219 # setup: screen 1220 var screen-on-stack: screen 1221 var screen/edi: (addr screen) <- address screen-on-stack -1222 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics +1222 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics 1223 # 1224 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor 1225 # 1226 check-screen-row screen, 0/y, "... ", "F - test-cursor-down-past-bottom-of-trace/pre-0" -1227 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-cursor-down-past-bottom-of-trace/pre-0/cursor" +1227 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-cursor-down-past-bottom-of-trace/pre-0/cursor" 1228 check-screen-row screen, 1/y, "error ", "F - test-cursor-down-past-bottom-of-trace/pre-1" -1229 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-cursor-down-past-bottom-of-trace/pre-1/cursor" +1229 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-cursor-down-past-bottom-of-trace/pre-1/cursor" 1230 check-screen-row screen, 2/y, "... ", "F - test-cursor-down-past-bottom-of-trace/pre-2" -1231 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-cursor-down-past-bottom-of-trace/pre-2/cursor" +1231 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-cursor-down-past-bottom-of-trace/pre-2/cursor" 1232 # cursor down several times 1233 edit-trace t, 0x6a/j 1234 edit-trace t, 0x6a/j @@ -1305,11 +1305,11 @@ if ('onhashchange' in window) { 1239 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor 1240 # cursor clamps at bottom 1241 check-screen-row screen, 0/y, "... ", "F - test-cursor-down-past-bottom-of-trace/down-0" -1242 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-cursor-down-past-bottom-of-trace/down-0/cursor" +1242 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-cursor-down-past-bottom-of-trace/down-0/cursor" 1243 check-screen-row screen, 1/y, "error ", "F - test-cursor-down-past-bottom-of-trace/down-1" -1244 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-cursor-down-past-bottom-of-trace/down-1/cursor" +1244 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-cursor-down-past-bottom-of-trace/down-1/cursor" 1245 check-screen-row screen, 2/y, "... ", "F - test-cursor-down-past-bottom-of-trace/down-2" -1246 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "||| ", "F - test-cursor-down-past-bottom-of-trace/down-2/cursor" +1246 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "||| ", "F - test-cursor-down-past-bottom-of-trace/down-2/cursor" 1247 } 1248 1249 fn test-expand-within-trace { @@ -1322,24 +1322,24 @@ if ('onhashchange' in window) { 1256 # setup: screen 1257 var screen-on-stack: screen 1258 var screen/edi: (addr screen) <- address screen-on-stack -1259 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics +1259 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics 1260 # 1261 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1262 # 1263 check-screen-row screen, 0/y, "... ", "F - test-expand-within-trace/pre-0" -1264 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-expand-within-trace/pre-0/cursor" +1264 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-expand-within-trace/pre-0/cursor" 1265 check-screen-row screen, 1/y, " ", "F - test-expand-within-trace/pre-1" -1266 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-expand-within-trace/pre-1/cursor" +1266 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-expand-within-trace/pre-1/cursor" 1267 # expand 1268 edit-trace t, 0xa/enter 1269 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1270 # 1271 check-screen-row screen, 0/y, "1 line 1 ", "F - test-expand-within-trace/expand-0" -1272 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-expand-within-trace/expand-0/cursor" +1272 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-expand-within-trace/expand-0/cursor" 1273 check-screen-row screen, 1/y, "1 line 2 ", "F - test-expand-within-trace/expand-1" -1274 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-expand-within-trace/expand-1/cursor" +1274 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-expand-within-trace/expand-1/cursor" 1275 check-screen-row screen, 2/y, " ", "F - test-expand-within-trace/expand-2" -1276 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-expand-within-trace/expand-2/cursor" +1276 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-expand-within-trace/expand-2/cursor" 1277 } 1278 1279 fn test-trace-expand-skips-lower-depth { @@ -1353,24 +1353,24 @@ if ('onhashchange' in window) { 1287 # setup: screen 1288 var screen-on-stack: screen 1289 var screen/edi: (addr screen) <- address screen-on-stack -1290 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics +1290 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics 1291 # 1292 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1293 # 1294 check-screen-row screen, 0/y, "... ", "F - test-trace-expand-skips-lower-depth/pre-0" -1295 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-expand-skips-lower-depth/pre-0/cursor" +1295 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-expand-skips-lower-depth/pre-0/cursor" 1296 check-screen-row screen, 1/y, " ", "F - test-trace-expand-skips-lower-depth/pre-1" -1297 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-skips-lower-depth/pre-1/cursor" +1297 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-skips-lower-depth/pre-1/cursor" 1298 # expand 1299 edit-trace t, 0xa/enter 1300 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1301 # 1302 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-expand-skips-lower-depth/expand-0" -1303 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-expand-skips-lower-depth/expand-0/cursor" +1303 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-expand-skips-lower-depth/expand-0/cursor" 1304 check-screen-row screen, 1/y, "... ", "F - test-trace-expand-skips-lower-depth/expand-1" -1305 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-skips-lower-depth/expand-1/cursor" +1305 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-skips-lower-depth/expand-1/cursor" 1306 check-screen-row screen, 2/y, " ", "F - test-trace-expand-skips-lower-depth/expand-2" -1307 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-skips-lower-depth/expand-2/cursor" +1307 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-skips-lower-depth/expand-2/cursor" 1308 } 1309 1310 fn test-trace-expand-continues-past-lower-depth { @@ -1386,25 +1386,25 @@ if ('onhashchange' in window) { 1320 # setup: screen 1321 var screen-on-stack: screen 1322 var screen/edi: (addr screen) <- address screen-on-stack -1323 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics +1323 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics 1324 # 1325 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1326 # 1327 check-screen-row screen, 0/y, "... ", "F - test-trace-expand-continues-past-lower-depth/pre-0" -1328 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-expand-continues-past-lower-depth/pre-0/cursor" +1328 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-expand-continues-past-lower-depth/pre-0/cursor" 1329 check-screen-row screen, 1/y, " ", "F - test-trace-expand-continues-past-lower-depth/pre-1" -1330 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-continues-past-lower-depth/pre-1/cursor" +1330 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-continues-past-lower-depth/pre-1/cursor" 1331 # expand 1332 edit-trace t, 0xa/enter 1333 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1334 # 1335 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-expand-continues-past-lower-depth/expand-0" -1336 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-expand-continues-past-lower-depth/expand-0/cursor" +1336 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-expand-continues-past-lower-depth/expand-0/cursor" 1337 # TODO: might be too wasteful to show every place where lines are hidden 1338 check-screen-row screen, 1/y, "... ", "F - test-trace-expand-continues-past-lower-depth/expand-1" -1339 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-continues-past-lower-depth/expand-1/cursor" +1339 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-continues-past-lower-depth/expand-1/cursor" 1340 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-expand-continues-past-lower-depth/expand-2" -1341 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-continues-past-lower-depth/expand-2/cursor" +1341 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-continues-past-lower-depth/expand-2/cursor" 1342 } 1343 1344 fn test-trace-expand-stops-at-higher-depth { @@ -1425,28 +1425,28 @@ if ('onhashchange' in window) { 1359 # setup: screen 1360 var screen-on-stack: screen 1361 var screen/edi: (addr screen) <- address screen-on-stack -1362 initialize-screen screen, 0x10/width, 8/height, 0/no-pixel-graphics +1362 initialize-screen screen, 0x10/width, 8/height, 0/no-pixel-graphics 1363 # 1364 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor 1365 # 1366 check-screen-row screen, 0/y, "... ", "F - test-trace-expand-stops-at-higher-depth/pre-0" -1367 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-expand-stops-at-higher-depth/pre-0/cursor" +1367 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-expand-stops-at-higher-depth/pre-0/cursor" 1368 check-screen-row screen, 1/y, " ", "F - test-trace-expand-stops-at-higher-depth/pre-1" -1369 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-stops-at-higher-depth/pre-1/cursor" +1369 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-stops-at-higher-depth/pre-1/cursor" 1370 # expand 1371 edit-trace t, 0xa/enter 1372 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor 1373 # 1374 check-screen-row screen, 0/y, "2 line 1.1 ", "F - test-trace-expand-stops-at-higher-depth/expand-0" -1375 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||||| ", "F - test-trace-expand-stops-at-higher-depth/expand-0/cursor" +1375 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||||| ", "F - test-trace-expand-stops-at-higher-depth/expand-0/cursor" 1376 check-screen-row screen, 1/y, "... ", "F - test-trace-expand-stops-at-higher-depth/expand-1" -1377 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-1/cursor" +1377 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-1/cursor" 1378 check-screen-row screen, 2/y, "2 line 1.2 ", "F - test-trace-expand-stops-at-higher-depth/expand-2" -1379 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-2/cursor" +1379 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-2/cursor" 1380 check-screen-row screen, 3/y, "... ", "F - test-trace-expand-stops-at-higher-depth/expand-3" -1381 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-3/cursor" +1381 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-3/cursor" 1382 check-screen-row screen, 4/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-4" -1383 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-4/cursor" +1383 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-4/cursor" 1384 } 1385 1386 fn test-trace-expand-twice { @@ -1462,45 +1462,45 @@ if ('onhashchange' in window) { 1396 # setup: screen 1397 var screen-on-stack: screen 1398 var screen/edi: (addr screen) <- address screen-on-stack -1399 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics +1399 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics 1400 # 1401 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1402 # 1403 check-screen-row screen, 0/y, "... ", "F - test-trace-expand-twice/pre-0" -1404 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-expand-twice/pre-0/cursor" +1404 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-expand-twice/pre-0/cursor" 1405 check-screen-row screen, 1/y, " ", "F - test-trace-expand-twice/pre-1" -1406 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-twice/pre-1/cursor" +1406 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-twice/pre-1/cursor" 1407 # expand 1408 edit-trace t, 0xa/enter 1409 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1410 # 1411 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-expand-twice/expand-0" -1412 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-expand-twice/expand-0/cursor" +1412 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-expand-twice/expand-0/cursor" 1413 check-screen-row screen, 1/y, "... ", "F - test-trace-expand-twice/expand-1" -1414 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-twice/expand-1/cursor" +1414 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-twice/expand-1/cursor" 1415 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-expand-twice/expand-2" -1416 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-twice/expand-2/cursor" +1416 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-twice/expand-2/cursor" 1417 # cursor down 1418 edit-trace t, 0x6a/j 1419 # hack: we need to render here to make this test pass; we're mixing state management with rendering 1420 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1421 # 1422 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-expand-twice/down-0" -1423 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-expand-twice/down-0/cursor" +1423 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-expand-twice/down-0/cursor" 1424 check-screen-row screen, 1/y, "... ", "F - test-trace-expand-twice/down-1" -1425 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "||| ", "F - test-trace-expand-twice/down-1/cursor" +1425 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "||| ", "F - test-trace-expand-twice/down-1/cursor" 1426 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-expand-twice/down-2" -1427 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-twice/down-2/cursor" +1427 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-twice/down-2/cursor" 1428 # expand again 1429 edit-trace t, 0xa/enter 1430 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1431 # 1432 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-expand-twice/expand2-0" -1433 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-expand-twice/expand2-0/cursor" +1433 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-expand-twice/expand2-0/cursor" 1434 check-screen-row screen, 1/y, "2 line 1.1 ", "F - test-trace-expand-twice/expand2-1" -1435 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "|||||||||| ", "F - test-trace-expand-twice/expand2-1/cursor" +1435 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "|||||||||| ", "F - test-trace-expand-twice/expand2-1/cursor" 1436 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-expand-twice/expand2-2" -1437 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-twice/expand2-2/cursor" +1437 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-twice/expand2-2/cursor" 1438 } 1439 1440 fn test-trace-refresh-cursor { @@ -1514,35 +1514,35 @@ if ('onhashchange' in window) { 1448 # setup: screen 1449 var screen-on-stack: screen 1450 var screen/edi: (addr screen) <- address screen-on-stack -1451 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics +1451 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics 1452 # 1453 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1454 # 1455 check-screen-row screen, 0/y, "... ", "F - test-trace-refresh-cursor/pre-0" -1456 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-refresh-cursor/pre-0/cursor" +1456 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-refresh-cursor/pre-0/cursor" 1457 check-screen-row screen, 1/y, " ", "F - test-trace-refresh-cursor/pre-1" -1458 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-refresh-cursor/pre-1/cursor" +1458 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-refresh-cursor/pre-1/cursor" 1459 # expand 1460 edit-trace t, 0xa/enter 1461 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1462 # 1463 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-refresh-cursor/expand-0" -1464 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-refresh-cursor/expand-0/cursor" +1464 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-refresh-cursor/expand-0/cursor" 1465 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-refresh-cursor/expand-1" -1466 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-refresh-cursor/expand-1/cursor" +1466 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-refresh-cursor/expand-1/cursor" 1467 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-refresh-cursor/expand-2" -1468 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-refresh-cursor/expand-2/cursor" +1468 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-refresh-cursor/expand-2/cursor" 1469 # cursor down 1470 edit-trace t, 0x6a/j 1471 edit-trace t, 0x6a/j 1472 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1473 # 1474 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-refresh-cursor/down-0" -1475 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-refresh-cursor/down-0/cursor" +1475 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-refresh-cursor/down-0/cursor" 1476 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-refresh-cursor/down-1" -1477 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-refresh-cursor/down-1/cursor" +1477 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-refresh-cursor/down-1/cursor" 1478 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-refresh-cursor/down-2" -1479 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-refresh-cursor/down-2/cursor" +1479 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-refresh-cursor/down-2/cursor" 1480 # recreate trace 1481 clear-trace t 1482 trace-text t, "l", "line 1" @@ -1551,11 +1551,11 @@ if ('onhashchange' in window) { 1485 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1486 # cursor remains unchanged 1487 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-refresh-cursor/refresh-0" -1488 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-refresh-cursor/refresh-0/cursor" +1488 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-refresh-cursor/refresh-0/cursor" 1489 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-refresh-cursor/refresh-1" -1490 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-refresh-cursor/refresh-1/cursor" +1490 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-refresh-cursor/refresh-1/cursor" 1491 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-refresh-cursor/refresh-2" -1492 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-refresh-cursor/refresh-2/cursor" +1492 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-refresh-cursor/refresh-2/cursor" 1493 } 1494 1495 fn test-trace-preserve-cursor-on-refresh { @@ -1569,35 +1569,35 @@ if ('onhashchange' in window) { 1503 # setup: screen 1504 var screen-on-stack: screen 1505 var screen/edi: (addr screen) <- address screen-on-stack -1506 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics +1506 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics 1507 # 1508 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1509 # 1510 check-screen-row screen, 0/y, "... ", "F - test-trace-preserve-cursor-on-refresh/pre-0" -1511 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-preserve-cursor-on-refresh/pre-0/cursor" +1511 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-preserve-cursor-on-refresh/pre-0/cursor" 1512 check-screen-row screen, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/pre-1" -1513 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/pre-1/cursor" +1513 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/pre-1/cursor" 1514 # expand 1515 edit-trace t, 0xa/enter 1516 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1517 # 1518 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-preserve-cursor-on-refresh/expand-0" -1519 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-preserve-cursor-on-refresh/expand-0/cursor" +1519 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-preserve-cursor-on-refresh/expand-0/cursor" 1520 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-preserve-cursor-on-refresh/expand-1" -1521 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/expand-1/cursor" +1521 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/expand-1/cursor" 1522 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-preserve-cursor-on-refresh/expand-2" -1523 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-preserve-cursor-on-refresh/expand-2/cursor" +1523 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-preserve-cursor-on-refresh/expand-2/cursor" 1524 # cursor down 1525 edit-trace t, 0x6a/j 1526 edit-trace t, 0x6a/j 1527 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1528 # 1529 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-preserve-cursor-on-refresh/down-0" -1530 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-preserve-cursor-on-refresh/down-0/cursor" +1530 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-preserve-cursor-on-refresh/down-0/cursor" 1531 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-preserve-cursor-on-refresh/down-1" -1532 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/down-1/cursor" +1532 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/down-1/cursor" 1533 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-preserve-cursor-on-refresh/down-2" -1534 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-preserve-cursor-on-refresh/down-2/cursor" +1534 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-preserve-cursor-on-refresh/down-2/cursor" 1535 # recreate trace with slightly different lines 1536 clear-trace t 1537 trace-text t, "l", "line 4" @@ -1606,11 +1606,11 @@ if ('onhashchange' in window) { 1540 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1541 # cursor remains unchanged 1542 check-screen-row screen, 0/y, "1 line 4 ", "F - test-trace-preserve-cursor-on-refresh/refresh-0" -1543 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-preserve-cursor-on-refresh/refresh-0/cursor" +1543 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-preserve-cursor-on-refresh/refresh-0/cursor" 1544 check-screen-row screen, 1/y, "1 line 5 ", "F - test-trace-preserve-cursor-on-refresh/refresh-1" -1545 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/refresh-1/cursor" +1545 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/refresh-1/cursor" 1546 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-preserve-cursor-on-refresh/refresh-2" -1547 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-preserve-cursor-on-refresh/refresh-2/cursor" +1547 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-preserve-cursor-on-refresh/refresh-2/cursor" 1548 } 1549 1550 fn test-trace-keep-cursor-visible-on-refresh { @@ -1624,50 +1624,50 @@ if ('onhashchange' in window) { 1558 # setup: screen 1559 var screen-on-stack: screen 1560 var screen/edi: (addr screen) <- address screen-on-stack -1561 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics +1561 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics 1562 # 1563 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1564 # 1565 check-screen-row screen, 0/y, "... ", "F - test-trace-keep-cursor-visible-on-refresh/pre-0" -1566 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-keep-cursor-visible-on-refresh/pre-0/cursor" +1566 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-keep-cursor-visible-on-refresh/pre-0/cursor" 1567 check-screen-row screen, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/pre-1" -1568 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/pre-1/cursor" +1568 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/pre-1/cursor" 1569 # expand 1570 edit-trace t, 0xa/enter 1571 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1572 # 1573 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-keep-cursor-visible-on-refresh/expand-0" -1574 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-keep-cursor-visible-on-refresh/expand-0/cursor" +1574 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-keep-cursor-visible-on-refresh/expand-0/cursor" 1575 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-keep-cursor-visible-on-refresh/expand-1" -1576 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/expand-1/cursor" +1576 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/expand-1/cursor" 1577 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-keep-cursor-visible-on-refresh/expand-2" -1578 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/expand-2/cursor" +1578 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/expand-2/cursor" 1579 # cursor down 1580 edit-trace t, 0x6a/j 1581 edit-trace t, 0x6a/j 1582 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1583 # 1584 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-keep-cursor-visible-on-refresh/down-0" -1585 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/down-0/cursor" +1585 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/down-0/cursor" 1586 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-keep-cursor-visible-on-refresh/down-1" -1587 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/down-1/cursor" +1587 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/down-1/cursor" 1588 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-keep-cursor-visible-on-refresh/down-2" -1589 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-keep-cursor-visible-on-refresh/down-2/cursor" +1589 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-keep-cursor-visible-on-refresh/down-2/cursor" 1590 # recreate trace with entirely different lines 1591 clear-trace t 1592 trace-text t, "l", "line 4" 1593 trace-text t, "l", "line 5" 1594 trace-text t, "l", "line 6" 1595 mark-lines-dirty t -1596 clear-screen screen +1596 clear-screen screen 1597 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1598 # trace collapses, and cursor bumps up 1599 check-screen-row screen, 0/y, "... ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-0" -1600 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-0/cursor" +1600 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-0/cursor" 1601 check-screen-row screen, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-1" -1602 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-1/cursor" +1602 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-1/cursor" 1603 check-screen-row screen, 2/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-2" -1604 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-2/cursor" +1604 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-2/cursor" 1605 } 1606 1607 fn test-trace-collapse-at-top { @@ -1683,35 +1683,35 @@ if ('onhashchange' in window) { 1617 # setup: screen 1618 var screen-on-stack: screen 1619 var screen/edi: (addr screen) <- address screen-on-stack -1620 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics +1620 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics 1621 # 1622 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1623 # 1624 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-at-top/pre-0" -1625 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-at-top/pre-0/cursor" +1625 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-at-top/pre-0/cursor" 1626 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-at-top/pre-1" -1627 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-at-top/pre-1/cursor" +1627 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-at-top/pre-1/cursor" 1628 # expand 1629 edit-trace t, 0xa/enter 1630 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1631 # 1632 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-at-top/expand-0" -1633 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse-at-top/expand-0/cursor" +1633 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse-at-top/expand-0/cursor" 1634 check-screen-row screen, 1/y, "... ", "F - test-trace-collapse-at-top/expand-1" -1635 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-at-top/expand-1/cursor" +1635 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-at-top/expand-1/cursor" 1636 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-at-top/expand-2" -1637 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-at-top/expand-2/cursor" +1637 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-at-top/expand-2/cursor" 1638 # collapse 1639 edit-trace t, 8/backspace 1640 # hack: we need to render here to make this test pass; we're mixing state management with rendering -1641 clear-screen screen +1641 clear-screen screen 1642 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1643 # 1644 check-ints-equal y, 1, "F - test-trace-collapse-at-top/post-0/y" 1645 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-at-top/post-0" -1646 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-at-top/post-0/cursor" +1646 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-at-top/post-0/cursor" 1647 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-at-top/post-1" -1648 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-at-top/post-1/cursor" +1648 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-at-top/post-1/cursor" 1649 } 1650 1651 fn test-trace-collapse { @@ -1724,35 +1724,35 @@ if ('onhashchange' in window) { 1658 # setup: screen 1659 var screen-on-stack: screen 1660 var screen/edi: (addr screen) <- address screen-on-stack -1661 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics +1661 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics 1662 # 1663 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1664 # 1665 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse/pre-0" -1666 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse/pre-0/cursor" +1666 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse/pre-0/cursor" 1667 check-screen-row screen, 1/y, " ", "F - test-trace-collapse/pre-1" -1668 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse/pre-1/cursor" +1668 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse/pre-1/cursor" 1669 # expand 1670 edit-trace t, 0xa/enter 1671 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1672 # 1673 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse/expand-0" -1674 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse/expand-0/cursor" +1674 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse/expand-0/cursor" 1675 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-collapse/expand-1" -1676 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse/expand-1/cursor" +1676 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse/expand-1/cursor" 1677 # cursor down 1678 edit-trace t, 0x6a/j 1679 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1680 # collapse 1681 edit-trace t, 8/backspace -1682 clear-screen screen +1682 clear-screen screen 1683 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1684 # 1685 check-ints-equal y, 1, "F - test-trace-collapse/post-0/y" 1686 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse/post-0" -1687 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse/post-0/cursor" +1687 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse/post-0/cursor" 1688 check-screen-row screen, 1/y, " ", "F - test-trace-collapse/post-1" -1689 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse/post-1/cursor" +1689 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse/post-1/cursor" 1690 } 1691 1692 fn test-trace-collapse-skips-invisible-lines { @@ -1768,24 +1768,24 @@ if ('onhashchange' in window) { 1702 # setup: screen 1703 var screen-on-stack: screen 1704 var screen/edi: (addr screen) <- address screen-on-stack -1705 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics +1705 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics 1706 # 1707 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1708 # 1709 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-skips-invisible-lines/pre-0" -1710 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-skips-invisible-lines/pre-0/cursor" +1710 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-skips-invisible-lines/pre-0/cursor" 1711 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-skips-invisible-lines/pre-1" -1712 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-skips-invisible-lines/pre-1/cursor" +1712 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-skips-invisible-lines/pre-1/cursor" 1713 # expand 1714 edit-trace t, 0xa/enter 1715 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1716 # two visible lines with an invisible line in between 1717 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-skips-invisible-lines/expand-0" -1718 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse-skips-invisible-lines/expand-0/cursor" +1718 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse-skips-invisible-lines/expand-0/cursor" 1719 check-screen-row screen, 1/y, "... ", "F - test-trace-collapse-skips-invisible-lines/expand-1" -1720 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-skips-invisible-lines/expand-1/cursor" +1720 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-skips-invisible-lines/expand-1/cursor" 1721 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-skips-invisible-lines/expand-2" -1722 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-skips-invisible-lines/expand-2/cursor" +1722 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-skips-invisible-lines/expand-2/cursor" 1723 # cursor down to second visible line 1724 edit-trace t, 0x6a/j 1725 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor @@ -1793,16 +1793,16 @@ if ('onhashchange' in window) { 1727 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1728 # collapse 1729 edit-trace t, 8/backspace -1730 clear-screen screen +1730 clear-screen screen 1731 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1732 # 1733 check-ints-equal y, 1, "F - test-trace-collapse-skips-invisible-lines/post-0/y" 1734 var cursor-y/eax: (addr int) <- get t, cursor-y 1735 check-ints-equal *cursor-y, 0, "F - test-trace-collapse-skips-invisible-lines/post-0/cursor-y" 1736 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-skips-invisible-lines/post-0" -1737 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-skips-invisible-lines/post-0/cursor" +1737 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-skips-invisible-lines/post-0/cursor" 1738 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-skips-invisible-lines/post-1" -1739 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-skips-invisible-lines/post-1/cursor" +1739 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-skips-invisible-lines/post-1/cursor" 1740 } 1741 1742 fn test-trace-collapse-two-levels { @@ -1818,24 +1818,24 @@ if ('onhashchange' in window) { 1752 # setup: screen 1753 var screen-on-stack: screen 1754 var screen/edi: (addr screen) <- address screen-on-stack -1755 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics +1755 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics 1756 # 1757 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1758 # 1759 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-two-levels/pre-0" -1760 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-two-levels/pre-0/cursor" +1760 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-two-levels/pre-0/cursor" 1761 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-two-levels/pre-1" -1762 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-two-levels/pre-1/cursor" +1762 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-two-levels/pre-1/cursor" 1763 # expand 1764 edit-trace t, 0xa/enter 1765 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1766 # two visible lines with an invisible line in between 1767 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-two-levels/expand-0" -1768 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse-two-levels/expand-0/cursor" +1768 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse-two-levels/expand-0/cursor" 1769 check-screen-row screen, 1/y, "... ", "F - test-trace-collapse-two-levels/expand-1" -1770 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-two-levels/expand-1/cursor" +1770 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-two-levels/expand-1/cursor" 1771 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-two-levels/expand-2" -1772 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-two-levels/expand-2/cursor" +1772 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-two-levels/expand-2/cursor" 1773 # cursor down to ellipses 1774 edit-trace t, 0x6a/j 1775 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor @@ -1844,26 +1844,26 @@ if ('onhashchange' in window) { 1778 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1779 # two visible lines with an invisible line in between 1780 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-two-levels/expand2-0" -1781 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-collapse-two-levels/expand2-0/cursor" +1781 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-collapse-two-levels/expand2-0/cursor" 1782 check-screen-row screen, 1/y, "2 line 1.1 ", "F - test-trace-collapse-two-levels/expand2-1" -1783 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "|||||||||| ", "F - test-trace-collapse-two-levels/expand2-1/cursor" +1783 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "|||||||||| ", "F - test-trace-collapse-two-levels/expand2-1/cursor" 1784 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-two-levels/expand2-2" -1785 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-two-levels/expand2-2/cursor" +1785 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-two-levels/expand2-2/cursor" 1786 # cursor down to second visible line 1787 edit-trace t, 0x6a/j 1788 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1789 # collapse 1790 edit-trace t, 8/backspace -1791 clear-screen screen +1791 clear-screen screen 1792 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1793 # 1794 check-ints-equal y, 1, "F - test-trace-collapse-two-levels/post-0/y" 1795 var cursor-y/eax: (addr int) <- get t, cursor-y 1796 check-ints-equal *cursor-y, 0, "F - test-trace-collapse-two-levels/post-0/cursor-y" 1797 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-two-levels/post-0" -1798 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-two-levels/post-0/cursor" +1798 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-two-levels/post-0/cursor" 1799 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-two-levels/post-1" -1800 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-two-levels/post-1/cursor" +1800 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-two-levels/post-1/cursor" 1801 } 1802 1803 fn test-trace-collapse-nested-level { @@ -1883,26 +1883,26 @@ if ('onhashchange' in window) { 1817 # setup: screen 1818 var screen-on-stack: screen 1819 var screen/edi: (addr screen) <- address screen-on-stack -1820 initialize-screen screen, 0x10/width, 8/height, 0/no-pixel-graphics +1820 initialize-screen screen, 0x10/width, 8/height, 0/no-pixel-graphics 1821 # 1822 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor 1823 # 1824 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-nested-level/pre-0" -1825 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-nested-level/pre-0/cursor" +1825 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-nested-level/pre-0/cursor" 1826 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-nested-level/pre-1" -1827 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-nested-level/pre-1/cursor" +1827 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-nested-level/pre-1/cursor" 1828 # expand 1829 edit-trace t, 0xa/enter 1830 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor 1831 # two visible lines with an invisible line in between 1832 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-nested-level/expand-0" -1833 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse-nested-level/expand-0/cursor" +1833 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse-nested-level/expand-0/cursor" 1834 check-screen-row screen, 1/y, "... ", "F - test-trace-collapse-nested-level/expand-1" -1835 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-nested-level/expand-1/cursor" +1835 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-nested-level/expand-1/cursor" 1836 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-nested-level/expand-2" -1837 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-nested-level/expand-2/cursor" +1837 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-nested-level/expand-2/cursor" 1838 check-screen-row screen, 3/y, "... ", "F - test-trace-collapse-nested-level/expand-3" -1839 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-collapse-nested-level/expand-3/cursor" +1839 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-collapse-nested-level/expand-3/cursor" 1840 # cursor down to bottom 1841 edit-trace t, 0x6a/j 1842 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor @@ -1915,31 +1915,31 @@ if ('onhashchange' in window) { 1849 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor 1850 # two visible lines with an invisible line in between 1851 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-nested-level/expand2-0" -1852 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-collapse-nested-level/expand2-0/cursor" +1852 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-collapse-nested-level/expand2-0/cursor" 1853 check-screen-row screen, 1/y, "... ", "F - test-trace-collapse-nested-level/expand2-1" -1854 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-nested-level/expand2-1/cursor" +1854 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-nested-level/expand2-1/cursor" 1855 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-nested-level/expand2-2" -1856 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-nested-level/expand2-2/cursor" +1856 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-nested-level/expand2-2/cursor" 1857 check-screen-row screen, 3/y, "2 line 2.1 ", "F - test-trace-collapse-nested-level/expand2-3" -1858 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "|||||||||| ", "F - test-trace-collapse-nested-level/expand2-3/cursor" +1858 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "|||||||||| ", "F - test-trace-collapse-nested-level/expand2-3/cursor" 1859 check-screen-row screen, 4/y, "2 line 2.2 ", "F - test-trace-collapse-nested-level/expand2-4" -1860 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-trace-collapse-nested-level/expand2-4/cursor" +1860 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-trace-collapse-nested-level/expand2-4/cursor" 1861 # collapse 1862 edit-trace t, 8/backspace -1863 clear-screen screen +1863 clear-screen screen 1864 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor 1865 # 1866 check-ints-equal y, 4, "F - test-trace-collapse-nested-level/post-0/y" 1867 var cursor-y/eax: (addr int) <- get t, cursor-y 1868 check-ints-equal *cursor-y, 2, "F - test-trace-collapse-nested-level/post-0/cursor-y" 1869 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-nested-level/post-0" -1870 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-collapse-nested-level/post-0/cursor" +1870 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-collapse-nested-level/post-0/cursor" 1871 check-screen-row screen, 1/y, "... ", "F - test-trace-collapse-nested-level/post-1" -1872 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-nested-level/post-1/cursor" +1872 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-nested-level/post-1/cursor" 1873 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-nested-level/post-2" -1874 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-collapse-nested-level/post-2/cursor" +1874 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-collapse-nested-level/post-2/cursor" 1875 check-screen-row screen, 3/y, "... ", "F - test-trace-collapse-nested-level/post-3" -1876 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-collapse-nested-level/post-3/cursor" +1876 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-collapse-nested-level/post-3/cursor" 1877 } 1878 1879 fn scroll-down _self: (addr trace) { @@ -2057,106 +2057,106 @@ if ('onhashchange' in window) { 1991 # setup: screen 1992 var screen-on-stack: screen 1993 var screen/edi: (addr screen) <- address screen-on-stack -1994 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics +1994 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics 1995 # pre-render 1996 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1997 # 1998 check-screen-row screen, 0/y, "... ", "F - test-trace-scroll/pre-0" -1999 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-scroll/pre-0/cursor" +1999 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-scroll/pre-0/cursor" 2000 check-screen-row screen, 1/y, " ", "F - test-trace-scroll/pre-1" -2001 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/pre-1/cursor" +2001 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/pre-1/cursor" 2002 check-screen-row screen, 2/y, " ", "F - test-trace-scroll/pre-2" -2003 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/pre-2/cursor" +2003 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/pre-2/cursor" 2004 check-screen-row screen, 3/y, " ", "F - test-trace-scroll/pre-3" -2005 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/pre-3/cursor" +2005 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/pre-3/cursor" 2006 # expand 2007 edit-trace t, 0xa/enter -2008 clear-screen screen +2008 clear-screen screen 2009 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 2010 # 2011 check-screen-row screen, 0/y, "1 line 0 ", "F - test-trace-scroll/expand-0" -2012 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/expand-0/cursor" +2012 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/expand-0/cursor" 2013 check-screen-row screen, 1/y, "1 line 1 ", "F - test-trace-scroll/expand-1" -2014 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/expand-1/cursor" +2014 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/expand-1/cursor" 2015 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-scroll/expand-2" -2016 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/expand-2/cursor" +2016 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/expand-2/cursor" 2017 check-screen-row screen, 3/y, "1 line 3 ", "F - test-trace-scroll/expand-3" -2018 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/expand-3/cursor" +2018 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/expand-3/cursor" 2019 # scroll up 2020 # hack: we must have rendered before this point; we're mixing state management with rendering 2021 edit-trace t, 2/ctrl-b -2022 clear-screen screen +2022 clear-screen screen 2023 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 2024 # no change since we're already at the top 2025 check-screen-row screen, 0/y, "1 line 0 ", "F - test-trace-scroll/up0-0" -2026 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/up0-0/cursor" +2026 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/up0-0/cursor" 2027 check-screen-row screen, 1/y, "1 line 1 ", "F - test-trace-scroll/up0-1" -2028 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/up0-1/cursor" +2028 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/up0-1/cursor" 2029 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-scroll/up0-2" -2030 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/up0-2/cursor" +2030 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/up0-2/cursor" 2031 check-screen-row screen, 3/y, "1 line 3 ", "F - test-trace-scroll/up0-3" -2032 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/up0-3/cursor" +2032 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/up0-3/cursor" 2033 # scroll down 2034 edit-trace t, 6/ctrl-f -2035 clear-screen screen +2035 clear-screen screen 2036 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 2037 check-screen-row screen, 0/y, "1 line 4 ", "F - test-trace-scroll/down1-0" -2038 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/down1-0/cursor" +2038 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/down1-0/cursor" 2039 check-screen-row screen, 1/y, "1 line 5 ", "F - test-trace-scroll/down1-1" -2040 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/down1-1/cursor" +2040 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/down1-1/cursor" 2041 check-screen-row screen, 2/y, "1 line 6 ", "F - test-trace-scroll/down1-2" -2042 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/down1-2/cursor" +2042 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/down1-2/cursor" 2043 check-screen-row screen, 3/y, "1 line 7 ", "F - test-trace-scroll/down1-3" -2044 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/down1-3/cursor" +2044 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/down1-3/cursor" 2045 # scroll down 2046 edit-trace t, 6/ctrl-f -2047 clear-screen screen +2047 clear-screen screen 2048 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 2049 check-screen-row screen, 0/y, "1 line 8 ", "F - test-trace-scroll/down2-0" -2050 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/down2-0/cursor" +2050 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/down2-0/cursor" 2051 check-screen-row screen, 1/y, "1 line 9 ", "F - test-trace-scroll/down2-1" -2052 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/down2-1/cursor" +2052 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/down2-1/cursor" 2053 check-screen-row screen, 2/y, " ", "F - test-trace-scroll/down2-2" -2054 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/down2-2/cursor" +2054 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/down2-2/cursor" 2055 check-screen-row screen, 3/y, " ", "F - test-trace-scroll/down2-3" -2056 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/down2-3/cursor" +2056 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/down2-3/cursor" 2057 # scroll down 2058 edit-trace t, 6/ctrl-f -2059 clear-screen screen +2059 clear-screen screen 2060 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 2061 # no change since we're already at the bottom 2062 check-screen-row screen, 0/y, "1 line 8 ", "F - test-trace-scroll/down3-0" -2063 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/down3-0/cursor" +2063 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/down3-0/cursor" 2064 check-screen-row screen, 1/y, "1 line 9 ", "F - test-trace-scroll/down3-1" -2065 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/down3-1/cursor" +2065 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/down3-1/cursor" 2066 check-screen-row screen, 2/y, " ", "F - test-trace-scroll/down3-2" -2067 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/down3-2/cursor" +2067 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/down3-2/cursor" 2068 check-screen-row screen, 3/y, " ", "F - test-trace-scroll/down3-3" -2069 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/down3-3/cursor" +2069 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/down3-3/cursor" 2070 # scroll up 2071 edit-trace t, 2/ctrl-b -2072 clear-screen screen +2072 clear-screen screen 2073 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 2074 check-screen-row screen, 0/y, "1 line 4 ", "F - test-trace-scroll/up1-0" -2075 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/up1-0/cursor" +2075 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/up1-0/cursor" 2076 check-screen-row screen, 1/y, "1 line 5 ", "F - test-trace-scroll/up1-1" -2077 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/up1-1/cursor" +2077 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/up1-1/cursor" 2078 check-screen-row screen, 2/y, "1 line 6 ", "F - test-trace-scroll/up1-2" -2079 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/up1-2/cursor" +2079 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/up1-2/cursor" 2080 check-screen-row screen, 3/y, "1 line 7 ", "F - test-trace-scroll/up1-3" -2081 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/up1-3/cursor" +2081 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/up1-3/cursor" 2082 # scroll up 2083 edit-trace t, 2/ctrl-b -2084 clear-screen screen +2084 clear-screen screen 2085 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 2086 check-screen-row screen, 0/y, "1 line 0 ", "F - test-trace-scroll/up2-0" -2087 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/up2-0/cursor" +2087 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/up2-0/cursor" 2088 check-screen-row screen, 1/y, "1 line 1 ", "F - test-trace-scroll/up2-1" -2089 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/up2-1/cursor" +2089 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/up2-1/cursor" 2090 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-scroll/up2-2" -2091 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/up2-2/cursor" +2091 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/up2-2/cursor" 2092 check-screen-row screen, 3/y, "1 line 3 ", "F - test-trace-scroll/up2-3" -2093 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/up2-3/cursor" +2093 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/up2-3/cursor" 2094 } 2095 2096 # saving and restoring trace indices -- cgit 1.4.1-2-gfad0