From 32f197f74465884b429a2fb3be50cc57681c195c Mon Sep 17 00:00:00 2001 From: Kartik Agaram Date: Sat, 5 Jun 2021 22:16:51 -0700 Subject: [PATCH] . --- html/shell/cell.mu.html | 123 +- html/shell/environment.mu.html | 492 ++++ html/shell/evaluate.mu.html | 3550 ++++++++++++------------ html/shell/gap-buffer.mu.html | 2589 ++++++++++-------- html/shell/global.mu.html | 2683 +++++-------------- html/shell/grapheme-stack.mu.html | 304 +-- html/shell/macroexpand.mu.html | 430 +-- html/shell/main.mu.html | 193 +- html/shell/parse.mu.html | 319 +-- html/shell/primitives.mu.html | 1669 ++++++++++++ html/shell/print.mu.html | 357 +-- html/shell/read.mu.html | 6 +- html/shell/sandbox.mu.html | 2160 ++++++++------- html/shell/tokenize.mu.html | 446 ++-- html/shell/trace.mu.html | 4148 +++++++++++++++-------------- 15 files changed, 10292 insertions(+), 9177 deletions(-) create mode 100644 html/shell/environment.mu.html create mode 100644 html/shell/primitives.mu.html diff --git a/html/shell/cell.mu.html b/html/shell/cell.mu.html index 56a79650..ec5bbc40 100644 --- a/html/shell/cell.mu.html +++ b/html/shell/cell.mu.html @@ -17,7 +17,10 @@ a { color:inherit; } .PreProc { color: #c000c0; } .Special { color: #ff6060; } .LineNr { } +.muRegEsi { color: #87d787; } .Constant { color: #008787; } +.muRegEax { color: #875f00; } +.muRegEcx { color: #af875f; } .Delimiter { color: #c000c0; } .muFunction { color: #af5f00; text-decoration: underline; } .muComment { color: #005faf; } @@ -77,20 +80,20 @@ if ('onhashchange' in window) { 19 } 20 21 fn allocate-symbol _out: (addr handle cell) { - 22 var out/eax: (addr handle cell) <- copy _out + 22 var out/eax: (addr handle cell) <- copy _out 23 allocate out - 24 var out-addr/eax: (addr cell) <- lookup *out - 25 var type/ecx: (addr int) <- get out-addr, type + 24 var out-addr/eax: (addr cell) <- lookup *out + 25 var type/ecx: (addr int) <- get out-addr, type 26 copy-to *type, 2/symbol - 27 var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data + 27 var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data 28 populate-stream dest-ah, 0x40/max-symbol-size 29 } 30 31 fn initialize-symbol _out: (addr handle cell), val: (addr array byte) { - 32 var out/eax: (addr handle cell) <- copy _out - 33 var out-addr/eax: (addr cell) <- lookup *out - 34 var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data - 35 var dest/eax: (addr stream byte) <- lookup *dest-ah + 32 var out/eax: (addr handle cell) <- copy _out + 33 var out-addr/eax: (addr cell) <- lookup *out + 34 var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data + 35 var dest/eax: (addr stream byte) <- lookup *dest-ah 36 write dest, val 37 } 38 @@ -99,42 +102,42 @@ if ('onhashchange' in window) { 41 initialize-symbol out, val 42 } 43 - 44 fn symbol-equal? _in: (addr cell), name: (addr array byte) -> _/eax: boolean { - 45 var in/esi: (addr cell) <- copy _in - 46 var in-type/eax: (addr int) <- get in, type + 44 fn symbol-equal? _in: (addr cell), name: (addr array byte) -> _/eax: boolean { + 45 var in/esi: (addr cell) <- copy _in + 46 var in-type/eax: (addr int) <- get in, type 47 compare *in-type, 2/symbol 48 { 49 break-if-= 50 return 0/false 51 } - 52 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data - 53 var in-data/eax: (addr stream byte) <- lookup *in-data-ah - 54 var result/eax: boolean <- stream-data-equal? in-data, name + 52 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data + 53 var in-data/eax: (addr stream byte) <- lookup *in-data-ah + 54 var result/eax: boolean <- stream-data-equal? in-data, name 55 return result 56 } 57 58 fn allocate-stream _out: (addr handle cell) { - 59 var out/eax: (addr handle cell) <- copy _out + 59 var out/eax: (addr handle cell) <- copy _out 60 allocate out - 61 var out-addr/eax: (addr cell) <- lookup *out - 62 var type/ecx: (addr int) <- get out-addr, type + 61 var out-addr/eax: (addr cell) <- lookup *out + 62 var type/ecx: (addr int) <- get out-addr, type 63 copy-to *type, 3/stream - 64 var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data + 64 var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data 65 populate-stream dest-ah, 0x40/max-stream-size 66 } 67 68 fn allocate-number _out: (addr handle cell) { - 69 var out/eax: (addr handle cell) <- copy _out + 69 var out/eax: (addr handle cell) <- copy _out 70 allocate out - 71 var out-addr/eax: (addr cell) <- lookup *out - 72 var type/ecx: (addr int) <- get out-addr, type + 71 var out-addr/eax: (addr cell) <- lookup *out + 72 var type/ecx: (addr int) <- get out-addr, type 73 copy-to *type, 1/number 74 } 75 76 fn initialize-integer _out: (addr handle cell), n: int { - 77 var out/eax: (addr handle cell) <- copy _out - 78 var out-addr/eax: (addr cell) <- lookup *out - 79 var dest-addr/eax: (addr float) <- get out-addr, number-data + 77 var out/eax: (addr handle cell) <- copy _out + 78 var out-addr/eax: (addr cell) <- lookup *out + 79 var dest-addr/eax: (addr float) <- get out-addr, number-data 80 var src/xmm0: float <- convert n 81 copy-to *dest-addr, src 82 } @@ -145,9 +148,9 @@ if ('onhashchange' in window) { 87 } 88 89 fn initialize-float _out: (addr handle cell), n: float { - 90 var out/eax: (addr handle cell) <- copy _out - 91 var out-addr/eax: (addr cell) <- lookup *out - 92 var dest-ah/eax: (addr float) <- get out-addr, number-data + 90 var out/eax: (addr handle cell) <- copy _out + 91 var out-addr/eax: (addr cell) <- lookup *out + 92 var dest-ah/eax: (addr float) <- get out-addr, number-data 93 var src/xmm0: float <- copy n 94 copy-to *dest-ah, src 95 } @@ -163,9 +166,9 @@ if ('onhashchange' in window) { 105 } 106 107 fn initialize-pair _out: (addr handle cell), left: (handle cell), right: (handle cell) { -108 var out/eax: (addr handle cell) <- copy _out -109 var out-addr/eax: (addr cell) <- lookup *out -110 var dest-ah/ecx: (addr handle cell) <- get out-addr, left +108 var out/eax: (addr handle cell) <- copy _out +109 var out-addr/eax: (addr cell) <- lookup *out +110 var dest-ah/ecx: (addr handle cell) <- get out-addr, left 111 copy-handle left, dest-ah 112 dest-ah <- get out-addr, right 113 copy-handle right, dest-ah @@ -181,18 +184,18 @@ if ('onhashchange' in window) { 123 } 124 125 fn allocate-primitive-function _out: (addr handle cell) { -126 var out/eax: (addr handle cell) <- copy _out +126 var out/eax: (addr handle cell) <- copy _out 127 allocate out -128 var out-addr/eax: (addr cell) <- lookup *out -129 var type/ecx: (addr int) <- get out-addr, type +128 var out-addr/eax: (addr cell) <- lookup *out +129 var type/ecx: (addr int) <- get out-addr, type 130 copy-to *type, 4/primitive-function 131 } 132 133 fn initialize-primitive-function _out: (addr handle cell), n: int { -134 var out/eax: (addr handle cell) <- copy _out -135 var out-addr/eax: (addr cell) <- lookup *out -136 var dest-addr/eax: (addr int) <- get out-addr, index-data -137 var src/ecx: int <- copy n +134 var out/eax: (addr handle cell) <- copy _out +135 var out-addr/eax: (addr cell) <- lookup *out +136 var dest-addr/eax: (addr int) <- get out-addr, index-data +137 var src/ecx: int <- copy n 138 copy-to *dest-addr, src 139 } 140 @@ -202,65 +205,65 @@ if ('onhashchange' in window) { 144 } 145 146 fn allocate-screen _out: (addr handle cell) { -147 var out/eax: (addr handle cell) <- copy _out +147 var out/eax: (addr handle cell) <- copy _out 148 allocate out -149 var out-addr/eax: (addr cell) <- lookup *out -150 var type/ecx: (addr int) <- get out-addr, type +149 var out-addr/eax: (addr cell) <- lookup *out +150 var type/ecx: (addr int) <- get out-addr, type 151 copy-to *type, 5/screen 152 } 153 154 fn new-fake-screen _out: (addr handle cell), width: int, height: int, pixel-graphics?: boolean { -155 var out/eax: (addr handle cell) <- copy _out +155 var out/eax: (addr handle cell) <- copy _out 156 allocate-screen out -157 var out-addr/eax: (addr cell) <- lookup *out -158 var dest-ah/eax: (addr handle screen) <- get out-addr, screen-data +157 var out-addr/eax: (addr cell) <- lookup *out +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 +160 var dest-addr/eax: (addr screen) <- lookup *dest-ah 161 initialize-screen dest-addr, width, height, pixel-graphics? 162 } 163 164 fn clear-screen-cell _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 +165 var self-ah/eax: (addr handle cell) <- copy _self-ah +166 var self/eax: (addr cell) <- lookup *self-ah 167 compare self, 0 168 { 169 break-if-!= 170 return 171 } -172 var screen-ah/eax: (addr handle screen) <- get self, screen-data -173 var screen/eax: (addr screen) <- lookup *screen-ah +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 175 } 176 177 fn allocate-keyboard _out: (addr handle cell) { -178 var out/eax: (addr handle cell) <- copy _out +178 var out/eax: (addr handle cell) <- copy _out 179 allocate out -180 var out-addr/eax: (addr cell) <- lookup *out -181 var type/ecx: (addr int) <- get out-addr, type +180 var out-addr/eax: (addr cell) <- lookup *out +181 var type/ecx: (addr int) <- get out-addr, type 182 copy-to *type, 6/keyboard 183 } 184 185 fn new-fake-keyboard _out: (addr handle cell), capacity: int { -186 var out/eax: (addr handle cell) <- copy _out +186 var out/eax: (addr handle cell) <- copy _out 187 allocate-keyboard out -188 var out-addr/eax: (addr cell) <- lookup *out -189 var dest-ah/eax: (addr handle gap-buffer) <- get out-addr, keyboard-data +188 var out-addr/eax: (addr cell) <- lookup *out +189 var dest-ah/eax: (addr handle gap-buffer) <- get out-addr, keyboard-data 190 allocate dest-ah -191 var dest-addr/eax: (addr gap-buffer) <- lookup *dest-ah +191 var dest-addr/eax: (addr gap-buffer) <- lookup *dest-ah 192 initialize-gap-buffer dest-addr, capacity 193 } 194 195 fn rewind-keyboard-cell _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 +196 var self-ah/eax: (addr handle cell) <- copy _self-ah +197 var self/eax: (addr cell) <- lookup *self-ah 198 compare self, 0 199 { 200 break-if-!= 201 return 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 +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 206 } diff --git a/html/shell/environment.mu.html b/html/shell/environment.mu.html new file mode 100644 index 00000000..7fd41c4d --- /dev/null +++ b/html/shell/environment.mu.html @@ -0,0 +1,492 @@ + + + + +Mu - shell/environment.mu + + + + + + + + + + +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 }
+
+ + + diff --git a/html/shell/evaluate.mu.html b/html/shell/evaluate.mu.html index d4a7d4f6..7e81fa31 100644 --- a/html/shell/evaluate.mu.html +++ b/html/shell/evaluate.mu.html @@ -14,16 +14,22 @@ 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; } -.Folded { color: #080808; background-color: #949494; } -.Special { color: #ff6060; } .LineNr { } -.Constant { color: #008787; } -.CommentedCode { color: #8a8a8a; } .Delimiter { color: #c000c0; } +.CommentedCode { color: #8a8a8a; } +.muRegEbx { color: #8787af; } +.muRegEsi { color: #87d787; } +.muRegEdi { color: #87ffd7; } +.Constant { color: #008787; } +.Special { color: #ff6060; } +.PreProc { color: #c000c0; } .muFunction { color: #af5f00; text-decoration: underline; } +.Folded { color: #080808; background-color: #949494; } .muTest { color: #5f8700; } .muComment { color: #005faf; } +.muRegEax { color: #875f00; } +.muRegEcx { color: #af875f; } +.muRegEdx { color: #878700; } --> @@ -63,1799 +69,1795 @@ 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 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 { - 6 # stack overflow? # disable when enabling Really-debug-print - 7 check-stack - 8 { - 9 var screen-cell/eax: (addr handle cell) <- copy screen-cell - 10 compare screen-cell, 0 - 11 break-if-= - 12 var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell - 13 compare screen-cell-addr, 0 + 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 # if screen-cell exists, we're probably not in a test - 16 show-stack-state - 17 } - 18 # errors? skip - 19 { - 20 var error?/eax: boolean <- has-errors? trace - 21 compare error?, 0/false - 22 break-if-= - 23 return - 24 } - 25 var in-ah/esi: (addr handle cell) <- copy _in-ah - 26 # show intermediate progress on screen if necessary - 27 { - 28 compare screen-cell, 0 - 29 break-if-= - 30 var tmp/eax: int <- copy call-number - 31 tmp <- and 0xf # every 16 calls to evaluate - 32 compare tmp, 0 - 33 break-if-!= - 34 var screen-cell/eax: (addr handle cell) <- copy screen-cell - 35 var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell - 36 compare screen-cell-addr, 0 + 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 screen-obj-ah/eax: (addr handle screen) <- get screen-cell-addr, screen-data - 39 var screen-obj/eax: (addr screen) <- lookup *screen-obj-ah - 40 compare screen-obj, 0 + 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 var y/ecx: int <- render-screen 0/screen, screen-obj, 0x70/xmin, 1/ymin + 42 error trace, "key pressed; interrupting..." 43 } - 44 #? dump-cell in-ah - 45 #? { - 46 #? var foo/eax: byte <- read-key 0/keyboard - 47 #? compare foo, 0 - 48 #? loop-if-= - 49 #? } - 50 +-- 19 lines: # trace "evaluate " in " in environment " env ----------------------------------------------------------------------------------------------------------------------------- - 69 trace-lower trace - 70 var in/eax: (addr cell) <- lookup *in-ah - 71 { - 72 var nil?/eax: boolean <- nil? in - 73 compare nil?, 0/false - 74 break-if-= - 75 # nil is a literal - 76 trace-text trace, "eval", "nil" - 77 copy-object _in-ah, _out-ah - 78 trace-higher trace - 79 return - 80 } - 81 var in-type/ecx: (addr int) <- get in, type - 82 compare *in-type, 1/number - 83 { - 84 break-if-!= - 85 # numbers are literals - 86 trace-text trace, "eval", "number" - 87 copy-object _in-ah, _out-ah - 88 trace-higher trace - 89 return - 90 } - 91 compare *in-type, 3/stream - 92 { - 93 break-if-!= - 94 # streams are literals - 95 trace-text trace, "eval", "stream" - 96 copy-object _in-ah, _out-ah - 97 trace-higher trace - 98 return - 99 } - 100 compare *in-type, 2/symbol - 101 { - 102 break-if-!= - 103 trace-text trace, "eval", "symbol" - 104 debug-print "a", 7/fg, 0/bg - 105 lookup-symbol in, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell - 106 debug-print "z", 7/fg, 0/bg - 107 trace-higher trace - 108 return - 109 } - 110 compare *in-type, 5/screen - 111 { - 112 break-if-!= - 113 trace-text trace, "eval", "screen" - 114 copy-object _in-ah, _out-ah - 115 trace-higher trace + 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, 6/keyboard + 118 compare *in-type, 5/screen 119 { 120 break-if-!= - 121 trace-text trace, "eval", "keyboard" + 121 trace-text trace, "eval", "screen" 122 copy-object _in-ah, _out-ah - 123 trace-higher trace + 123 trace-higher trace 124 return 125 } - 126 # 'in' is a syntax tree - 127 $evaluate:literal-function: { - 128 # trees starting with "litfn" are literals - 129 var expr/esi: (addr cell) <- copy in - 130 var in/edx: (addr cell) <- copy in - 131 var first-ah/ecx: (addr handle cell) <- get in, left - 132 var first/eax: (addr cell) <- lookup *first-ah - 133 var litfn?/eax: boolean <- litfn? first - 134 compare litfn?, 0/false - 135 break-if-= - 136 trace-text trace, "eval", "literal function" - 137 copy-object _in-ah, _out-ah - 138 trace-higher trace - 139 return - 140 } - 141 $evaluate:literal-macro: { - 142 # trees starting with "litmac" are literals - 143 var expr/esi: (addr cell) <- copy in - 144 var in/edx: (addr cell) <- copy in - 145 var first-ah/ecx: (addr handle cell) <- get in, left - 146 var first/eax: (addr cell) <- lookup *first-ah - 147 var litmac?/eax: boolean <- litmac? first - 148 compare litmac?, 0/false - 149 break-if-= - 150 trace-text trace, "eval", "literal macro" - 151 copy-object _in-ah, _out-ah - 152 trace-higher trace - 153 return - 154 } - 155 $evaluate:anonymous-function: { - 156 # trees starting with "fn" are anonymous functions - 157 var expr/esi: (addr cell) <- copy in - 158 var in/edx: (addr cell) <- copy in - 159 var first-ah/ecx: (addr handle cell) <- get in, left - 160 var first/eax: (addr cell) <- lookup *first-ah - 161 var fn?/eax: boolean <- fn? first - 162 compare fn?, 0/false - 163 break-if-= - 164 # turn (fn ...) into (litfn env ...) - 165 trace-text trace, "eval", "anonymous function" - 166 var rest-ah/eax: (addr handle cell) <- get in, right - 167 var tmp: (handle cell) - 168 var tmp-ah/edi: (addr handle cell) <- address tmp - 169 new-pair tmp-ah, env-h, *rest-ah - 170 var litfn: (handle cell) - 171 var litfn-ah/eax: (addr handle cell) <- address litfn - 172 new-symbol litfn-ah, "litfn" - 173 new-pair _out-ah, *litfn-ah, *tmp-ah - 174 trace-higher trace - 175 return - 176 } - 177 # builtins with "special" evaluation rules - 178 $evaluate:quote: { - 179 # trees starting with single quote create literals - 180 var expr/esi: (addr cell) <- copy in - 181 # if its first elem is not "'", break - 182 var first-ah/ecx: (addr handle cell) <- get in, left - 183 var rest-ah/edx: (addr handle cell) <- get in, right - 184 var first/eax: (addr cell) <- lookup *first-ah - 185 var quote?/eax: boolean <- symbol-equal? first, "'" - 186 compare quote?, 0/false - 187 break-if-= - 188 # - 189 trace-text trace, "eval", "quote" - 190 copy-object rest-ah, _out-ah - 191 trace-higher trace - 192 return - 193 } - 194 $evaluate:backquote: { - 195 # trees starting with single backquote create literals - 196 var expr/esi: (addr cell) <- copy in - 197 # if its first elem is not "'", break - 198 var first-ah/ecx: (addr handle cell) <- get in, left - 199 var rest-ah/edx: (addr handle cell) <- get in, right - 200 var first/eax: (addr cell) <- lookup *first-ah - 201 var backquote?/eax: boolean <- symbol-equal? first, "`" - 202 compare backquote?, 0/false - 203 break-if-= - 204 # - 205 trace-text trace, "eval", "backquote" - 206 debug-print "`(", 7/fg, 0/bg - 207 evaluate-backquote rest-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 208 debug-print ")", 7/fg, 0/bg - 209 trace-higher trace - 210 return - 211 } - 212 $evaluate:def: { - 213 # trees starting with "def" define globals - 214 var expr/esi: (addr cell) <- copy in - 215 # if its first elem is not "def", break - 216 var first-ah/ecx: (addr handle cell) <- get in, left - 217 var rest-ah/edx: (addr handle cell) <- get in, right - 218 var first/eax: (addr cell) <- lookup *first-ah - 219 var def?/eax: boolean <- symbol-equal? first, "def" - 220 compare def?, 0/false - 221 break-if-= - 222 # - 223 trace-text trace, "eval", "def" - 224 trace-text trace, "eval", "evaluating second arg" - 225 var rest/eax: (addr cell) <- lookup *rest-ah - 226 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 227 { - 228 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 229 var first-arg-type/eax: (addr int) <- get first-arg, type - 230 compare *first-arg-type, 2/symbol - 231 break-if-= - 232 error trace, "first arg to def must be a symbol" - 233 trace-higher trace - 234 return - 235 } - 236 rest-ah <- get rest, right - 237 rest <- lookup *rest-ah - 238 var second-arg-ah/edx: (addr handle cell) <- get rest, left - 239 debug-print "P", 4/fg, 0/bg - 240 increment call-number - 241 evaluate second-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 242 debug-print "Q", 4/fg, 0/bg - 243 # errors? skip - 244 { - 245 var error?/eax: boolean <- has-errors? trace - 246 compare error?, 0/false - 247 break-if-= - 248 trace-higher trace - 249 return - 250 } - 251 trace-text trace, "eval", "saving global binding" - 252 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 253 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data - 254 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah - 255 var tmp-string: (handle array byte) - 256 var tmp-ah/edx: (addr handle array byte) <- address tmp-string - 257 rewind-stream first-arg-data - 258 stream-to-array first-arg-data, tmp-ah - 259 var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah - 260 var out-ah/edi: (addr handle cell) <- copy _out-ah - 261 assign-or-create-global globals, first-arg-data-string, *out-ah, trace - 262 trace-higher trace - 263 return - 264 } - 265 $evaluate:set: { - 266 # trees starting with "set" mutate bindings - 267 var expr/esi: (addr cell) <- copy in - 268 # if its first elem is not "set", break - 269 var first-ah/ecx: (addr handle cell) <- get in, left - 270 var rest-ah/edx: (addr handle cell) <- get in, right - 271 var first/eax: (addr cell) <- lookup *first-ah - 272 var set?/eax: boolean <- symbol-equal? first, "set" - 273 compare set?, 0/false - 274 break-if-= - 275 # - 276 trace-text trace, "eval", "set" - 277 trace-text trace, "eval", "evaluating second arg" - 278 var rest/eax: (addr cell) <- lookup *rest-ah - 279 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 280 { - 281 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 282 var first-arg-type/eax: (addr int) <- get first-arg, type - 283 compare *first-arg-type, 2/symbol - 284 break-if-= - 285 error trace, "first arg to set must be a symbol" - 286 trace-higher trace - 287 return - 288 } - 289 rest-ah <- get rest, right - 290 rest <- lookup *rest-ah - 291 var second-arg-ah/edx: (addr handle cell) <- get rest, left - 292 debug-print "P", 4/fg, 0/bg - 293 increment call-number - 294 evaluate second-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 295 debug-print "Q", 4/fg, 0/bg - 296 # errors? skip - 297 { - 298 var error?/eax: boolean <- has-errors? trace - 299 compare error?, 0/false - 300 break-if-= - 301 trace-higher trace - 302 return - 303 } - 304 trace-text trace, "eval", "mutating binding" - 305 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 306 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data - 307 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah - 308 mutate-binding first-arg-data, _out-ah, env-h, globals, trace - 309 trace-higher trace - 310 return - 311 } - 312 $evaluate:and: { - 313 var expr/esi: (addr cell) <- copy in - 314 # if its first elem is not "and", break - 315 var first-ah/ecx: (addr handle cell) <- get in, left - 316 var rest-ah/edx: (addr handle cell) <- get in, right - 317 var first/eax: (addr cell) <- lookup *first-ah - 318 var and?/eax: boolean <- symbol-equal? first, "and" - 319 compare and?, 0/false - 320 break-if-= - 321 # - 322 trace-text trace, "eval", "and" - 323 trace-text trace, "eval", "evaluating first arg" - 324 var rest/eax: (addr cell) <- lookup *rest-ah - 325 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 326 debug-print "R2", 4/fg, 0/bg - 327 increment call-number - 328 evaluate first-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 329 debug-print "S2", 4/fg, 0/bg - 330 # errors? skip - 331 { - 332 var error?/eax: boolean <- has-errors? trace - 333 compare error?, 0/false - 334 break-if-= - 335 trace-higher trace - 336 return - 337 } - 338 # if first arg is nil, short-circuit - 339 var out-ah/eax: (addr handle cell) <- copy _out-ah - 340 var out/eax: (addr cell) <- lookup *out-ah - 341 var nil?/eax: boolean <- nil? out - 342 compare nil?, 0/false - 343 { - 344 break-if-= - 345 trace-higher trace - 346 return - 347 } - 348 var rest/eax: (addr cell) <- lookup *rest-ah - 349 rest-ah <- get rest, right - 350 rest <- lookup *rest-ah - 351 var second-ah/eax: (addr handle cell) <- get rest, left - 352 debug-print "T2", 4/fg, 0/bg - 353 increment call-number - 354 evaluate second-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 355 debug-print "U2", 4/fg, 0/bg - 356 trace-higher trace - 357 return - 358 } - 359 $evaluate:or: { - 360 var expr/esi: (addr cell) <- copy in - 361 # if its first elem is not "or", break - 362 var first-ah/ecx: (addr handle cell) <- get in, left - 363 var rest-ah/edx: (addr handle cell) <- get in, right - 364 var first/eax: (addr cell) <- lookup *first-ah - 365 var or?/eax: boolean <- symbol-equal? first, "or" - 366 compare or?, 0/false - 367 break-if-= - 368 # - 369 trace-text trace, "eval", "or" - 370 trace-text trace, "eval", "evaluating first arg" - 371 var rest/eax: (addr cell) <- lookup *rest-ah - 372 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 373 debug-print "R2", 4/fg, 0/bg - 374 increment call-number - 375 evaluate first-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 376 debug-print "S2", 4/fg, 0/bg - 377 # errors? skip - 378 { - 379 var error?/eax: boolean <- has-errors? trace - 380 compare error?, 0/false - 381 break-if-= - 382 trace-higher trace - 383 return - 384 } - 385 # if first arg is not nil, short-circuit - 386 var out-ah/eax: (addr handle cell) <- copy _out-ah - 387 var out/eax: (addr cell) <- lookup *out-ah - 388 var nil?/eax: boolean <- nil? out - 389 compare nil?, 0/false - 390 { - 391 break-if-!= - 392 trace-higher trace - 393 return - 394 } - 395 var rest/eax: (addr cell) <- lookup *rest-ah - 396 rest-ah <- get rest, right - 397 rest <- lookup *rest-ah - 398 var second-ah/eax: (addr handle cell) <- get rest, left - 399 debug-print "T2", 4/fg, 0/bg - 400 increment call-number - 401 evaluate second-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 402 debug-print "U2", 4/fg, 0/bg - 403 # errors? skip - 404 { - 405 var error?/eax: boolean <- has-errors? trace - 406 compare error?, 0/false - 407 break-if-= - 408 trace-higher trace - 409 return - 410 } - 411 trace-higher trace - 412 return - 413 } - 414 $evaluate:if: { - 415 # trees starting with "if" are conditionals - 416 var expr/esi: (addr cell) <- copy in - 417 # if its first elem is not "if", break - 418 var first-ah/ecx: (addr handle cell) <- get in, left - 419 var rest-ah/edx: (addr handle cell) <- get in, right - 420 var first/eax: (addr cell) <- lookup *first-ah - 421 var if?/eax: boolean <- symbol-equal? first, "if" - 422 compare if?, 0/false - 423 break-if-= - 424 # - 425 trace-text trace, "eval", "if" - 426 trace-text trace, "eval", "evaluating first arg" - 427 var rest/eax: (addr cell) <- lookup *rest-ah - 428 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 429 var guard-h: (handle cell) - 430 var guard-ah/esi: (addr handle cell) <- address guard-h - 431 debug-print "R", 4/fg, 0/bg - 432 increment call-number - 433 evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 434 debug-print "S", 4/fg, 0/bg - 435 # errors? skip - 436 { - 437 var error?/eax: boolean <- has-errors? trace - 438 compare error?, 0/false - 439 break-if-= - 440 trace-higher trace - 441 return - 442 } - 443 rest-ah <- get rest, right - 444 rest <- lookup *rest-ah - 445 var branch-ah/edi: (addr handle cell) <- get rest, left - 446 var guard-a/eax: (addr cell) <- lookup *guard-ah - 447 var skip-to-third-arg?/eax: boolean <- nil? guard-a - 448 compare skip-to-third-arg?, 0/false - 449 { - 450 break-if-= - 451 trace-text trace, "eval", "skipping to third arg" - 452 var rest/eax: (addr cell) <- lookup *rest-ah - 453 rest-ah <- get rest, right - 454 rest <- lookup *rest-ah - 455 branch-ah <- get rest, left - 456 } - 457 debug-print "T", 4/fg, 0/bg - 458 increment call-number - 459 evaluate branch-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 460 debug-print "U", 4/fg, 0/bg - 461 trace-higher trace - 462 return - 463 } - 464 $evaluate:while: { - 465 # trees starting with "while" are loops - 466 var expr/esi: (addr cell) <- copy in - 467 # if its first elem is not "while", break - 468 var first-ah/ecx: (addr handle cell) <- get in, left - 469 var rest-ah/edx: (addr handle cell) <- get in, right - 470 var first/eax: (addr cell) <- lookup *first-ah - 471 var first-type/ecx: (addr int) <- get first, type - 472 compare *first-type, 2/symbol - 473 break-if-!= - 474 var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data - 475 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 476 var while?/eax: boolean <- stream-data-equal? sym-data, "while" - 477 compare while?, 0/false - 478 break-if-= - 479 # - 480 trace-text trace, "eval", "while" - 481 var rest/eax: (addr cell) <- lookup *rest-ah - 482 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 483 rest-ah <- get rest, right - 484 var guard-h: (handle cell) - 485 var guard-ah/esi: (addr handle cell) <- address guard-h - 486 $evaluate:while:loop-execution: { - 487 { - 488 var error?/eax: boolean <- has-errors? trace - 489 compare error?, 0/false - 490 break-if-!= $evaluate:while:loop-execution - 491 } - 492 trace-text trace, "eval", "loop termination check" - 493 debug-print "V", 4/fg, 0/bg - 494 increment call-number - 495 evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 496 debug-print "W", 4/fg, 0/bg - 497 # errors? skip - 498 { - 499 var error?/eax: boolean <- has-errors? trace - 500 compare error?, 0/false - 501 break-if-= - 502 trace-higher trace - 503 return - 504 } - 505 var guard-a/eax: (addr cell) <- lookup *guard-ah - 506 var done?/eax: boolean <- nil? guard-a - 507 compare done?, 0/false - 508 break-if-!= - 509 evaluate-exprs rest-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 510 # errors? skip - 511 { - 512 var error?/eax: boolean <- has-errors? trace - 513 compare error?, 0/false - 514 break-if-= - 515 trace-higher trace - 516 return - 517 } - 518 loop - 519 } - 520 trace-text trace, "eval", "loop terminated" - 521 trace-higher trace - 522 return - 523 } - 524 trace-text trace, "eval", "function call" - 525 trace-text trace, "eval", "evaluating list elements" - 526 trace-lower trace - 527 var evaluated-list-storage: (handle cell) - 528 var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage - 529 var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah - 530 var curr/ecx: (addr cell) <- copy in - 531 $evaluate-list:loop: { - 532 allocate-pair curr-out-ah - 533 var nil?/eax: boolean <- nil? curr - 534 compare nil?, 0/false - 535 break-if-!= - 536 # eval left - 537 var curr-out/eax: (addr cell) <- lookup *curr-out-ah - 538 var left-out-ah/edi: (addr handle cell) <- get curr-out, left - 539 var left-ah/esi: (addr handle cell) <- get curr, left - 540 debug-print "A", 4/fg, 0/bg - 541 increment call-number - 542 evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 543 debug-print "B", 4/fg, 0/bg - 544 # errors? skip - 545 { - 546 var error?/eax: boolean <- has-errors? trace - 547 compare error?, 0/false - 548 break-if-= - 549 trace-higher trace - 550 trace-higher trace - 551 return - 552 } - 553 # - 554 curr-out-ah <- get curr-out, right - 555 var right-ah/eax: (addr handle cell) <- get curr, right - 556 var right/eax: (addr cell) <- lookup *right-ah - 557 curr <- copy right - 558 loop - 559 } - 560 trace-higher trace - 561 var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah - 562 var function-ah/ecx: (addr handle cell) <- get evaluated-list, left - 563 var args-ah/edx: (addr handle cell) <- get evaluated-list, right - 564 debug-print "C", 4/fg, 0/bg - 565 apply function-ah, args-ah, _out-ah, globals, trace, screen-cell, keyboard-cell, call-number - 566 debug-print "Y", 4/fg, 0/bg - 567 trace-higher trace - 568 +-- 15 lines: # trace "=> " _out-ah ----------------------------------------------------------------------------------------------------------------------------------------------------- - 583 debug-print "Z", 4/fg, 0/bg - 584 } - 585 - 586 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 { - 587 var f-ah/eax: (addr handle cell) <- copy _f-ah - 588 var _f/eax: (addr cell) <- lookup *f-ah - 589 var f/esi: (addr cell) <- copy _f - 590 # call primitive functions - 591 { - 592 var f-type/eax: (addr int) <- get f, type - 593 compare *f-type, 4/primitive-function - 594 break-if-!= - 595 apply-primitive f, args-ah, out, globals, trace - 596 return - 597 } - 598 # if it's not a primitive function it must be an anonymous function - 599 +-- 19 lines: # trace "apply anonymous function " f " in environment " env -------------------------------------------------------------------------------------------------------------- - 618 trace-lower trace - 619 { - 620 var f-type/ecx: (addr int) <- get f, type - 621 compare *f-type, 0/pair - 622 break-if-!= - 623 var first-ah/eax: (addr handle cell) <- get f, left - 624 var first/eax: (addr cell) <- lookup *first-ah - 625 var litfn?/eax: boolean <- litfn? first - 626 compare litfn?, 0/false - 627 break-if-= - 628 var rest-ah/esi: (addr handle cell) <- get f, right - 629 var rest/eax: (addr cell) <- lookup *rest-ah - 630 var callee-env-ah/edx: (addr handle cell) <- get rest, left - 631 rest-ah <- get rest, right - 632 rest <- lookup *rest-ah - 633 var params-ah/ecx: (addr handle cell) <- get rest, left - 634 var body-ah/eax: (addr handle cell) <- get rest, right - 635 debug-print "D", 7/fg, 0/bg - 636 apply-function params-ah, args-ah, body-ah, out, *callee-env-ah, globals, trace, screen-cell, keyboard-cell, call-number - 637 debug-print "Y", 7/fg, 0/bg - 638 trace-higher trace - 639 return - 640 } - 641 error trace, "unknown function" - 642 } - 643 - 644 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 { - 645 # push bindings for params to env - 646 var new-env-h: (handle cell) - 647 var new-env-ah/esi: (addr handle cell) <- address new-env-h - 648 push-bindings params-ah, args-ah, env-h, new-env-ah, trace - 649 # errors? skip - 650 { - 651 var error?/eax: boolean <- has-errors? trace - 652 compare error?, 0/false - 653 break-if-= - 654 return - 655 } - 656 # - 657 evaluate-exprs body-ah, out, new-env-h, globals, trace, screen-cell, keyboard-cell, call-number - 658 } - 659 - 660 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 { - 661 # eval all exprs, writing result to `out` each time - 662 var exprs-ah/ecx: (addr handle cell) <- copy _exprs-ah - 663 $evaluate-exprs:loop: { - 664 var exprs/eax: (addr cell) <- lookup *exprs-ah - 665 # stop when exprs is nil - 666 { - 667 var exprs-nil?/eax: boolean <- nil? exprs - 668 compare exprs-nil?, 0/false - 669 break-if-!= $evaluate-exprs:loop - 670 } - 671 # evaluate each expression, writing result to `out` - 672 { - 673 var curr-ah/eax: (addr handle cell) <- get exprs, left - 674 debug-print "E", 7/fg, 0/bg - 675 increment call-number - 676 evaluate curr-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 677 debug-print "X", 7/fg, 0/bg - 678 # errors? skip - 679 { - 680 var error?/eax: boolean <- has-errors? trace - 681 compare error?, 0/false - 682 break-if-= - 683 return - 684 } - 685 } - 686 # - 687 exprs-ah <- get exprs, right - 688 loop - 689 } - 690 # `out` contains result of evaluating final expression - 691 } - 692 - 693 # Bind params to corresponding args and add the bindings to old-env. Return - 694 # the result in env-ah. - 695 # - 696 # We never modify old-env, but we point to it. This way other parts of the - 697 # interpreter can continue using old-env, and everything works harmoniously - 698 # even though no cells are copied around. - 699 # - 700 # env should always be a DAG (ignoring internals of values). It doesn't have - 701 # to be a tree (some values may be shared), but there are also no cycles. - 702 # - 703 # Learn more: https://en.wikipedia.org/wiki/Persistent_data_structure - 704 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) { - 705 var params-ah/edx: (addr handle cell) <- copy _params-ah - 706 var args-ah/ebx: (addr handle cell) <- copy _args-ah - 707 var _params/eax: (addr cell) <- lookup *params-ah - 708 var params/esi: (addr cell) <- copy _params - 709 { - 710 var params-nil?/eax: boolean <- nil? params - 711 compare params-nil?, 0/false - 712 break-if-= - 713 # nil is a literal - 714 trace-text trace, "eval", "done with push-bindings" - 715 copy-handle old-env-h, env-ah - 716 return - 717 } - 718 # Params can only be symbols or pairs. Args can be anything. - 719 +-- 22 lines: # trace "pushing bindings from " params " to " args ----------------------------------------------------------------------------------------------------------------------- - 741 trace-lower trace - 742 var params-type/eax: (addr int) <- get params, type - 743 compare *params-type, 2/symbol - 744 { - 745 break-if-!= - 746 trace-text trace, "eval", "symbol; binding to all remaining args" - 747 # create a new binding - 748 var new-binding-storage: (handle cell) - 749 var new-binding-ah/eax: (addr handle cell) <- address new-binding-storage - 750 new-pair new-binding-ah, *params-ah, *args-ah - 751 # push it to env - 752 new-pair env-ah, *new-binding-ah, old-env-h - 753 trace-higher trace - 754 return - 755 } - 756 compare *params-type, 0/pair - 757 { - 758 break-if-= - 759 error trace, "cannot bind a non-symbol" - 760 trace-higher trace - 761 return - 762 } - 763 var _args/eax: (addr cell) <- lookup *args-ah - 764 var args/edi: (addr cell) <- copy _args - 765 # params is now a pair, so args must be also - 766 { - 767 var args-nil?/eax: boolean <- nil? args - 768 compare args-nil?, 0/false - 769 break-if-= - 770 error trace, "not enough args to bind" - 771 return - 772 } - 773 var args-type/eax: (addr int) <- get args, type - 774 compare *args-type, 0/pair - 775 { - 776 break-if-= - 777 error trace, "args not in a proper list" - 778 trace-higher trace - 779 return - 780 } - 781 var intermediate-env-storage: (handle cell) - 782 var intermediate-env-ah/edx: (addr handle cell) <- address intermediate-env-storage - 783 var first-param-ah/eax: (addr handle cell) <- get params, left - 784 var first-arg-ah/ecx: (addr handle cell) <- get args, left - 785 push-bindings first-param-ah, first-arg-ah, old-env-h, intermediate-env-ah, trace - 786 # errors? skip + 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 + 564 debug-print "B", 4/fg, 0/bg + 565 # errors? skip + 566 { + 567 var error?/eax: boolean <- has-errors? trace + 568 compare error?, 0/false + 569 break-if-= + 570 trace-higher trace + 571 trace-higher trace + 572 return + 573 } + 574 # + 575 curr-out-ah <- get curr-out, right + 576 var right-ah/eax: (addr handle cell) <- get curr, right + 577 var right/eax: (addr cell) <- lookup *right-ah + 578 curr <- copy right + 579 loop + 580 } + 581 trace-higher trace + 582 var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah + 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 + 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 { + 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 + 611 # call primitive functions + 612 { + 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 + 617 return + 618 } + 619 # if it's not a primitive function it must be an anonymous function + 620 +-- 19 lines: # trace "apply anonymous function " f " in environment " env -------------------------------------------------------------------------------------------------------------- + 639 trace-lower trace + 640 { + 641 var f-type/ecx: (addr int) <- get f, type + 642 compare *f-type, 0/pair + 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 + 648 break-if-= + 649 var rest-ah/esi: (addr handle cell) <- get f, right + 650 var rest/eax: (addr cell) <- lookup *rest-ah + 651 var callee-env-ah/edx: (addr handle cell) <- get rest, left + 652 rest-ah <- get rest, right + 653 rest <- lookup *rest-ah + 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 + 658 debug-print "Y", 7/fg, 0/bg + 659 trace-higher trace + 660 return + 661 } + 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 { + 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 + 670 # errors? skip + 671 { + 672 var error?/eax: boolean <- has-errors? trace + 673 compare error?, 0/false + 674 break-if-= + 675 return + 676 } + 677 # + 678 evaluate-exprs body-ah, out, new-env-h, globals, trace, screen-cell, keyboard-cell, 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 { + 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: { + 685 var exprs/eax: (addr cell) <- lookup *exprs-ah + 686 # stop when exprs is nil + 687 { + 688 var exprs-nil?/eax: boolean <- nil? exprs + 689 compare exprs-nil?, 0/false + 690 break-if-!= $evaluate-exprs:loop + 691 } + 692 # evaluate each expression, writing result to `out` + 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 error?/eax: boolean <- has-errors? trace - 789 compare error?, 0/false + 788 var args-nil?/eax: boolean <- nil? args + 789 compare args-nil?, 0/false 790 break-if-= - 791 trace-higher trace + 791 error trace, "not enough args to bind" 792 return 793 } - 794 var remaining-params-ah/eax: (addr handle cell) <- get params, right - 795 var remaining-args-ah/ecx: (addr handle cell) <- get args, right - 796 push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace - 797 trace-higher trace - 798 } - 799 - 800 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) { - 801 # trace sym - 802 { - 803 var should-trace?/eax: boolean <- should-trace? trace - 804 compare should-trace?, 0/false - 805 break-if-= - 806 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` - 807 var stream/ecx: (addr stream byte) <- address stream-storage - 808 write stream, "look up " - 809 var sym2/eax: (addr cell) <- copy sym - 810 var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data - 811 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 812 rewind-stream sym-data - 813 write-stream stream, sym-data - 814 write stream, " in " - 815 var env-ah/eax: (addr handle cell) <- address env-h - 816 var nested-trace-storage: trace - 817 var nested-trace/edi: (addr trace) <- address nested-trace-storage - 818 initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible - 819 print-cell env-ah, stream, nested-trace - 820 trace trace, "eval", stream - 821 } - 822 trace-lower trace - 823 var _env/eax: (addr cell) <- lookup env-h - 824 var env/ebx: (addr cell) <- copy _env - 825 # if env is not a list, error - 826 { - 827 var env-type/ecx: (addr int) <- get env, type - 828 compare *env-type, 0/pair - 829 break-if-= - 830 error trace, "eval found a non-list environment" - 831 trace-higher trace - 832 return - 833 } - 834 # if env is nil, look up in globals - 835 { - 836 var env-nil?/eax: boolean <- nil? env - 837 compare env-nil?, 0/false - 838 break-if-= - 839 debug-print "b", 7/fg, 0/bg - 840 lookup-symbol-in-globals sym, out, globals, trace, screen-cell, keyboard-cell - 841 debug-print "x", 7/fg, 0/bg - 842 trace-higher trace - 843 +-- 19 lines: # trace "=> " out " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- - 862 debug-print "y", 7/fg, 0/bg - 863 return - 864 } - 865 # check car - 866 var env-head-storage: (handle cell) - 867 var env-head-ah/eax: (addr handle cell) <- address env-head-storage - 868 { - 869 var nested-trace-storage: trace - 870 var nested-trace/edi: (addr trace) <- address nested-trace-storage - 871 initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible - 872 car env, env-head-ah, nested-trace - 873 } - 874 var _env-head/eax: (addr cell) <- lookup *env-head-ah - 875 var env-head/ecx: (addr cell) <- copy _env-head - 876 # if car is not a list, abort - 877 { - 878 var env-head-type/eax: (addr int) <- get env-head, type - 879 compare *env-head-type, 0/pair - 880 break-if-= - 881 error trace, "environment is not a list of (key . value) pairs" - 882 trace-higher trace - 883 return - 884 } - 885 # check key - 886 var curr-key-storage: (handle cell) - 887 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage - 888 car env-head, curr-key-ah, trace - 889 var curr-key/eax: (addr cell) <- lookup *curr-key-ah - 890 # if key is not a symbol, abort - 891 { - 892 var curr-key-type/eax: (addr int) <- get curr-key, type - 893 compare *curr-key-type, 2/symbol - 894 break-if-= - 895 error trace, "environment contains a binding for a non-symbol" - 896 trace-higher trace - 897 return - 898 } - 899 # if key matches sym, return val - 900 var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace - 901 compare match?, 0/false - 902 { - 903 break-if-= - 904 var nested-trace-storage: trace - 905 var nested-trace/edi: (addr trace) <- address nested-trace-storage - 906 initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible - 907 cdr env-head, out, nested-trace - 908 +-- 17 lines: # trace "=> " out " (match)" ---------------------------------------------------------------------------------------------------------------------------------------------- - 925 trace-higher trace - 926 return - 927 } - 928 # otherwise recurse - 929 var env-tail-storage: (handle cell) - 930 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage - 931 cdr env, env-tail-ah, trace - 932 lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell, keyboard-cell - 933 trace-higher trace - 934 +-- 19 lines: # trace "=> " out " (recurse)" -------------------------------------------------------------------------------------------------------------------------------------------- - 953 } - 954 - 955 fn test-lookup-symbol-in-env { - 956 # tmp = (a . 3) - 957 var val-storage: (handle cell) - 958 var val-ah/ecx: (addr handle cell) <- address val-storage - 959 new-integer val-ah, 3 - 960 var key-storage: (handle cell) - 961 var key-ah/edx: (addr handle cell) <- address key-storage - 962 new-symbol key-ah, "a" - 963 var env-storage: (handle cell) - 964 var env-ah/ebx: (addr handle cell) <- address env-storage - 965 new-pair env-ah, *key-ah, *val-ah - 966 # env = ((a . 3)) - 967 var nil-storage: (handle cell) - 968 var nil-ah/ecx: (addr handle cell) <- address nil-storage - 969 allocate-pair nil-ah - 970 new-pair env-ah, *env-ah, *nil-ah - 971 # lookup sym(a) in env tmp - 972 var tmp-storage: (handle cell) - 973 var tmp-ah/edx: (addr handle cell) <- address tmp-storage - 974 new-symbol tmp-ah, "a" - 975 var in/eax: (addr cell) <- lookup *tmp-ah - 976 var trace-storage: trace - 977 var trace/edi: (addr trace) <- address trace-storage - 978 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible - 979 lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard - 980 var result/eax: (addr cell) <- lookup *tmp-ah - 981 var result-type/edx: (addr int) <- get result, type - 982 check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0" - 983 var result-value-addr/eax: (addr float) <- get result, number-data - 984 var result-value/eax: int <- convert *result-value-addr - 985 check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1" - 986 } - 987 - 988 fn test-lookup-symbol-in-globals { - 989 var globals-storage: global-table - 990 var globals/edi: (addr global-table) <- address globals-storage - 991 initialize-globals globals - 992 # env = nil - 993 var nil-storage: (handle cell) - 994 var nil-ah/ecx: (addr handle cell) <- address nil-storage - 995 allocate-pair nil-ah - 996 # lookup sym(a), env - 997 var tmp-storage: (handle cell) - 998 var tmp-ah/ebx: (addr handle cell) <- address tmp-storage - 999 new-symbol tmp-ah, "+" -1000 var in/eax: (addr cell) <- lookup *tmp-ah -1001 var trace-storage: trace -1002 var trace/esi: (addr trace) <- address trace-storage -1003 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1004 lookup-symbol in, tmp-ah, *nil-ah, globals, trace, 0/no-screen, 0/no-keyboard -1005 var result/eax: (addr cell) <- lookup *tmp-ah -1006 var result-type/edx: (addr int) <- get result, type -1007 check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0" -1008 var result-value/eax: (addr int) <- get result, index-data -1009 check-ints-equal *result-value, 1/add, "F - test-lookup-symbol-in-globals/1" -1010 } -1011 -1012 fn mutate-binding name: (addr stream byte), val: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace) { -1013 # trace name -1014 { -1015 var should-trace?/eax: boolean <- should-trace? trace -1016 compare should-trace?, 0/false -1017 break-if-= -1018 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` -1019 var stream/ecx: (addr stream byte) <- address stream-storage -1020 write stream, "bind " -1021 rewind-stream name -1022 write-stream stream, name -1023 write stream, " to " -1024 var nested-trace-storage: trace -1025 var nested-trace/edi: (addr trace) <- address nested-trace-storage -1026 initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible -1027 print-cell val, stream, nested-trace -1028 write stream, " in " -1029 var env-ah/eax: (addr handle cell) <- address env-h -1030 clear-trace nested-trace -1031 print-cell env-ah, stream, nested-trace -1032 trace trace, "eval", stream -1033 } -1034 trace-lower trace -1035 var _env/eax: (addr cell) <- lookup env-h -1036 var env/ebx: (addr cell) <- copy _env -1037 # if env is not a list, abort -1038 { -1039 var env-type/ecx: (addr int) <- get env, type -1040 compare *env-type, 0/pair -1041 break-if-= -1042 error trace, "eval found a non-list environment" -1043 trace-higher trace -1044 return -1045 } -1046 # if env is nil, look in globals -1047 { -1048 var env-nil?/eax: boolean <- nil? env -1049 compare env-nil?, 0/false -1050 break-if-= -1051 debug-print "b", 3/fg, 0/bg -1052 mutate-binding-in-globals name, val, globals, trace -1053 debug-print "x", 3/fg, 0/bg -1054 trace-higher trace -1055 +-- 19 lines: # trace "=> " val " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- -1074 debug-print "y", 3/fg, 0/bg -1075 return -1076 } -1077 # check car -1078 var env-head-storage: (handle cell) -1079 var env-head-ah/eax: (addr handle cell) <- address env-head-storage -1080 var nested-trace-storage: trace -1081 var nested-trace/edi: (addr trace) <- address nested-trace-storage -1082 initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible -1083 car env, env-head-ah, nested-trace -1084 var _env-head/eax: (addr cell) <- lookup *env-head-ah -1085 var env-head/ecx: (addr cell) <- copy _env-head -1086 # if car is not a list, abort -1087 { -1088 var env-head-type/eax: (addr int) <- get env-head, type -1089 compare *env-head-type, 0/pair -1090 break-if-= -1091 error trace, "environment is not a list of (key . value) pairs" -1092 trace-higher trace -1093 return -1094 } -1095 # check key -1096 var curr-key-storage: (handle cell) -1097 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage -1098 car env-head, curr-key-ah, trace -1099 var curr-key/eax: (addr cell) <- lookup *curr-key-ah -1100 # if key is not a symbol, abort -1101 { -1102 var curr-key-type/eax: (addr int) <- get curr-key, type -1103 compare *curr-key-type, 2/symbol -1104 break-if-= -1105 error trace, "environment contains a binding for a non-symbol" -1106 trace-higher trace -1107 return -1108 } -1109 # if key matches name, return val -1110 var curr-key-data-ah/eax: (addr handle stream byte) <- get curr-key, text-data -1111 var curr-key-data/eax: (addr stream byte) <- lookup *curr-key-data-ah -1112 var match?/eax: boolean <- streams-data-equal? curr-key-data, name -1113 compare match?, 0/false -1114 { -1115 break-if-= -1116 var dest/eax: (addr handle cell) <- get env-head, right -1117 copy-object val, dest -1118 trace-text trace, "eval", "=> done" -1119 trace-higher trace -1120 return -1121 } -1122 # otherwise recurse -1123 var env-tail-storage: (handle cell) -1124 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage -1125 cdr env, env-tail-ah, trace -1126 mutate-binding name, val, *env-tail-ah, globals, trace -1127 trace-higher trace -1128 } -1129 -1130 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) { -1131 trace-text trace, "eval", "car" -1132 trace-lower trace -1133 var in/eax: (addr cell) <- copy _in -1134 # if in is not a list, abort -1135 { -1136 var in-type/ecx: (addr int) <- get in, type -1137 compare *in-type, 0/pair -1138 break-if-= -1139 error trace, "car on a non-list" -1140 trace-higher trace -1141 return -1142 } -1143 # if in is nil, abort -1144 { -1145 var in-nil?/eax: boolean <- nil? in -1146 compare in-nil?, 0/false -1147 break-if-= -1148 error trace, "car on nil" -1149 trace-higher trace -1150 return -1151 } -1152 var in-left/eax: (addr handle cell) <- get in, left -1153 copy-object in-left, out -1154 trace-higher trace -1155 return -1156 } -1157 -1158 fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) { -1159 trace-text trace, "eval", "cdr" -1160 trace-lower trace -1161 var in/eax: (addr cell) <- copy _in -1162 # if in is not a list, abort -1163 { -1164 var in-type/ecx: (addr int) <- get in, type -1165 compare *in-type, 0/pair -1166 break-if-= -1167 error trace, "car on a non-list" -1168 trace-higher trace -1169 return -1170 } -1171 # if in is nil, abort -1172 { -1173 var in-nil?/eax: boolean <- nil? in -1174 compare in-nil?, 0/false -1175 break-if-= -1176 error trace, "car on nil" -1177 trace-higher trace -1178 return -1179 } -1180 var in-right/eax: (addr handle cell) <- get in, right -1181 copy-object in-right, out -1182 trace-higher trace -1183 return -1184 } -1185 -1186 fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean { -1187 trace-text trace, "eval", "cell-isomorphic?" -1188 trace-lower trace -1189 var a/esi: (addr cell) <- copy _a -1190 var b/edi: (addr cell) <- copy _b -1191 # if types don't match, return false -1192 var a-type-addr/eax: (addr int) <- get a, type -1193 var b-type-addr/ecx: (addr int) <- get b, type -1194 var b-type/ecx: int <- copy *b-type-addr -1195 compare b-type, *a-type-addr -1196 { -1197 break-if-= -1198 trace-higher trace -1199 trace-text trace, "eval", "=> false (type)" -1200 return 0/false -1201 } -1202 # if types are number, compare number-data -1203 # TODO: exactly comparing floats is a bad idea -1204 compare b-type, 1/number -1205 { -1206 break-if-!= -1207 var a-val-addr/eax: (addr float) <- get a, number-data -1208 var b-val-addr/ecx: (addr float) <- get b, number-data -1209 var a-val/xmm0: float <- copy *a-val-addr -1210 compare a-val, *b-val-addr -1211 { -1212 break-if-= -1213 trace-higher trace -1214 trace-text trace, "eval", "=> false (numbers)" -1215 return 0/false -1216 } -1217 trace-higher trace -1218 trace-text trace, "eval", "=> true (numbers)" -1219 return 1/true -1220 } -1221 $cell-isomorphic?:text-data: { -1222 { -1223 compare b-type, 2/symbol + 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 compare b-type, 3/stream -1226 break-if-= -1227 break $cell-isomorphic?:text-data +1225 trace-higher trace +1226 trace-text trace, "eval", "=> false (numbers)" +1227 return 0/false 1228 } -1229 var b-val-ah/eax: (addr handle stream byte) <- get b, text-data -1230 var _b-val/eax: (addr stream byte) <- lookup *b-val-ah -1231 var b-val/ecx: (addr stream byte) <- copy _b-val -1232 var a-val-ah/eax: (addr handle stream byte) <- get a, text-data -1233 var a-val/eax: (addr stream byte) <- lookup *a-val-ah -1234 var tmp-array: (handle array byte) -1235 var tmp-ah/edx: (addr handle array byte) <- address tmp-array -1236 rewind-stream a-val -1237 stream-to-array a-val, tmp-ah -1238 var tmp/eax: (addr array byte) <- lookup *tmp-ah -1239 var match?/eax: boolean <- stream-data-equal? b-val, tmp -1240 trace-higher trace -1241 { -1242 compare match?, 0/false -1243 break-if-= -1244 trace-text trace, "eval", "=> true (symbols)" -1245 } -1246 { -1247 compare match?, 0/false -1248 break-if-!= -1249 trace-text trace, "eval", "=> false (symbols)" -1250 } -1251 return match? -1252 } -1253 # if objects are primitive functions, compare index-data -1254 compare b-type, 4/primitive -1255 { -1256 break-if-!= -1257 var a-val-addr/eax: (addr int) <- get a, index-data -1258 var b-val-addr/ecx: (addr int) <- get b, index-data -1259 var a-val/eax: int <- copy *a-val-addr -1260 compare a-val, *b-val-addr -1261 { -1262 break-if-= -1263 trace-higher trace -1264 trace-text trace, "eval", "=> false (primitives)" -1265 return 0/false -1266 } -1267 trace-higher trace -1268 trace-text trace, "eval", "=> true (primitives)" -1269 return 1/true -1270 } -1271 # if objects are screens, check if they're the same object -1272 compare b-type, 5/screen -1273 { -1274 break-if-!= -1275 var a-val-addr/eax: (addr handle screen) <- get a, screen-data -1276 var b-val-addr/ecx: (addr handle screen) <- get b, screen-data -1277 var result/eax: boolean <- handle-equal? *a-val-addr, *b-val-addr -1278 compare result, 0/false -1279 return result -1280 } -1281 # if objects are keyboards, check if they have the same contents -1282 compare b-type, 6/keyboard -1283 { -1284 break-if-!= -1285 var a-val-addr/ecx: (addr handle gap-buffer) <- get a, keyboard-data -1286 var _a/eax: (addr gap-buffer) <- lookup *a-val-addr -1287 var a/ecx: (addr gap-buffer) <- copy _a -1288 var b-val-addr/eax: (addr handle gap-buffer) <- get b, keyboard-data -1289 var b/eax: (addr gap-buffer) <- lookup *b-val-addr -1290 var result/eax: boolean <- gap-buffers-equal? a, b +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 a is nil, b should be nil -1294 { -1295 # (assumes nil? returns 0 or 1) -1296 var _b-nil?/eax: boolean <- nil? b -1297 var b-nil?/ecx: boolean <- copy _b-nil? -1298 var a-nil?/eax: boolean <- nil? a -1299 # a == nil and b == nil => return true -1300 { -1301 compare a-nil?, 0/false -1302 break-if-= -1303 compare b-nil?, 0/false -1304 break-if-= -1305 trace-higher trace -1306 trace-text trace, "eval", "=> true (nils)" -1307 return 1/true -1308 } -1309 # a == nil => return false -1310 { -1311 compare a-nil?, 0/false -1312 break-if-= -1313 trace-higher trace -1314 trace-text trace, "eval", "=> false (b != nil)" -1315 return 0/false -1316 } -1317 # b == nil => return false -1318 { -1319 compare b-nil?, 0/false -1320 break-if-= -1321 trace-higher trace -1322 trace-text trace, "eval", "=> false (a != nil)" -1323 return 0/false -1324 } -1325 } -1326 # a and b are pairs -1327 var a-tmp-storage: (handle cell) -1328 var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage -1329 var b-tmp-storage: (handle cell) -1330 var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage -1331 # if cars aren't equal, return false -1332 car a, a-tmp-ah, trace -1333 car b, b-tmp-ah, trace -1334 { -1335 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah -1336 var a-tmp/ecx: (addr cell) <- copy _a-tmp -1337 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah -1338 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace -1339 compare result, 0/false -1340 break-if-!= -1341 trace-higher trace -1342 trace-text trace, "eval", "=> false (car mismatch)" -1343 return 0/false -1344 } -1345 # recurse on cdrs -1346 cdr a, a-tmp-ah, trace -1347 cdr b, b-tmp-ah, trace -1348 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah -1349 var a-tmp/ecx: (addr cell) <- copy _a-tmp -1350 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah -1351 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace -1352 trace-higher trace -1353 return result -1354 } -1355 -1356 fn fn? _x: (addr cell) -> _/eax: boolean { -1357 var x/esi: (addr cell) <- copy _x -1358 var type/eax: (addr int) <- get x, type -1359 compare *type, 2/symbol -1360 { -1361 break-if-= -1362 return 0/false -1363 } -1364 var contents-ah/eax: (addr handle stream byte) <- get x, text-data -1365 var contents/eax: (addr stream byte) <- lookup *contents-ah -1366 var result/eax: boolean <- stream-data-equal? contents, "fn" -1367 return result -1368 } -1369 -1370 fn litfn? _x: (addr cell) -> _/eax: boolean { -1371 var x/esi: (addr cell) <- copy _x -1372 var type/eax: (addr int) <- get x, type -1373 compare *type, 2/symbol -1374 { -1375 break-if-= -1376 return 0/false -1377 } -1378 var contents-ah/eax: (addr handle stream byte) <- get x, text-data -1379 var contents/eax: (addr stream byte) <- lookup *contents-ah -1380 var result/eax: boolean <- stream-data-equal? contents, "litfn" -1381 return result -1382 } -1383 -1384 fn litmac? _x: (addr cell) -> _/eax: boolean { -1385 var x/esi: (addr cell) <- copy _x -1386 var type/eax: (addr int) <- get x, type -1387 compare *type, 2/symbol -1388 { -1389 break-if-= -1390 return 0/false -1391 } -1392 var contents-ah/eax: (addr handle stream byte) <- get x, text-data -1393 var contents/eax: (addr stream byte) <- lookup *contents-ah -1394 var result/eax: boolean <- stream-data-equal? contents, "litmac" -1395 return result -1396 } -1397 -1398 fn test-evaluate-is-well-behaved { -1399 var t-storage: trace -1400 var t/esi: (addr trace) <- address t-storage -1401 initialize-trace t, 0x100/max-depth, 0x10/capacity, 0/visible # we don't use trace UI -1402 # env = nil -1403 var env-storage: (handle cell) -1404 var env-ah/ecx: (addr handle cell) <- address env-storage -1405 allocate-pair env-ah -1406 # eval sym(a), nil env -1407 var tmp-storage: (handle cell) -1408 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1409 new-symbol tmp-ah, "a" -1410 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard, 0/call-number -1411 # doesn't die -1412 check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved" -1413 } -1414 -1415 fn test-evaluate-number { -1416 # env = nil -1417 var env-storage: (handle cell) -1418 var env-ah/ecx: (addr handle cell) <- address env-storage -1419 allocate-pair env-ah -1420 # tmp = 3 -1421 var tmp-storage: (handle cell) -1422 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1423 new-integer tmp-ah, 3 -1424 var trace-storage: trace -1425 var trace/edi: (addr trace) <- address trace-storage -1426 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1427 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1428 # -1429 var result/eax: (addr cell) <- lookup *tmp-ah -1430 var result-type/edx: (addr int) <- get result, type -1431 check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0" -1432 var result-value-addr/eax: (addr float) <- get result, number-data -1433 var result-value/eax: int <- convert *result-value-addr -1434 check-ints-equal result-value, 3, "F - test-evaluate-number/1" -1435 } -1436 -1437 fn test-evaluate-symbol { -1438 # tmp = (a . 3) -1439 var val-storage: (handle cell) -1440 var val-ah/ecx: (addr handle cell) <- address val-storage -1441 new-integer val-ah, 3 -1442 var key-storage: (handle cell) -1443 var key-ah/edx: (addr handle cell) <- address key-storage -1444 new-symbol key-ah, "a" -1445 var env-storage: (handle cell) -1446 var env-ah/ebx: (addr handle cell) <- address env-storage -1447 new-pair env-ah, *key-ah, *val-ah -1448 # env = ((a . 3)) -1449 var nil-storage: (handle cell) -1450 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1451 allocate-pair nil-ah -1452 new-pair env-ah, *env-ah, *nil-ah -1453 # eval sym(a), env -1454 var tmp-storage: (handle cell) -1455 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1456 new-symbol tmp-ah, "a" -1457 var trace-storage: trace -1458 var trace/edi: (addr trace) <- address trace-storage -1459 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1460 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1461 var result/eax: (addr cell) <- lookup *tmp-ah -1462 var result-type/edx: (addr int) <- get result, type -1463 check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0" -1464 var result-value-addr/eax: (addr float) <- get result, number-data -1465 var result-value/eax: int <- convert *result-value-addr -1466 check-ints-equal result-value, 3, "F - test-evaluate-symbol/1" -1467 } -1468 -1469 fn test-evaluate-quote { -1470 # env = nil -1471 var nil-storage: (handle cell) -1472 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1473 allocate-pair nil-ah -1474 # eval `a, env -1475 var tmp-storage: (handle cell) -1476 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1477 new-symbol tmp-ah, "'" -1478 var tmp2-storage: (handle cell) -1479 var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage -1480 new-symbol tmp2-ah, "a" -1481 new-pair tmp-ah, *tmp-ah, *tmp2-ah -1482 var trace-storage: trace -1483 var trace/edi: (addr trace) <- address trace-storage -1484 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1485 evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1486 var result/eax: (addr cell) <- lookup *tmp-ah -1487 var result-type/edx: (addr int) <- get result, type -1488 check-ints-equal *result-type, 2/symbol, "F - test-evaluate-quote/0" -1489 var sym?/eax: boolean <- symbol-equal? result, "a" -1490 check sym?, "F - test-evaluate-quote/1" -1491 } -1492 -1493 fn test-evaluate-primitive-function { -1494 var globals-storage: global-table -1495 var globals/edi: (addr global-table) <- address globals-storage -1496 initialize-globals globals -1497 var nil-storage: (handle cell) -1498 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1499 allocate-pair nil-ah -1500 var add-storage: (handle cell) -1501 var add-ah/ebx: (addr handle cell) <- address add-storage -1502 new-symbol add-ah, "+" -1503 # eval +, nil env -1504 var tmp-storage: (handle cell) -1505 var tmp-ah/esi: (addr handle cell) <- address tmp-storage -1506 var trace-storage: trace -1507 var trace/edx: (addr trace) <- address trace-storage -1508 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1509 evaluate add-ah, tmp-ah, *nil-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1510 # -1511 var result/eax: (addr cell) <- lookup *tmp-ah -1512 var result-type/edx: (addr int) <- get result, type -1513 check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0" -1514 var result-value/eax: (addr int) <- get result, index-data -1515 check-ints-equal *result-value, 1/add, "F - test-evaluate-primitive-function/1" -1516 } -1517 -1518 fn test-evaluate-primitive-function-call { -1519 var t-storage: trace -1520 var t/edi: (addr trace) <- address t-storage -1521 initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible # we don't use trace UI +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 nil-storage: (handle cell) -1524 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1525 allocate-pair nil-ah -1526 var one-storage: (handle cell) -1527 var one-ah/edx: (addr handle cell) <- address one-storage -1528 new-integer one-ah, 1 -1529 var add-storage: (handle cell) -1530 var add-ah/ebx: (addr handle cell) <- address add-storage -1531 new-symbol add-ah, "+" -1532 # input is (+ 1 1) -1533 var tmp-storage: (handle cell) -1534 var tmp-ah/esi: (addr handle cell) <- address tmp-storage -1535 new-pair tmp-ah, *one-ah, *nil-ah -1536 new-pair tmp-ah, *one-ah, *tmp-ah -1537 new-pair tmp-ah, *add-ah, *tmp-ah -1538 #? dump-cell tmp-ah -1539 # -1540 var globals-storage: global-table -1541 var globals/edx: (addr global-table) <- address globals-storage -1542 initialize-globals globals -1543 # -1544 evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/call-number -1545 #? dump-trace t -1546 # -1547 var result/eax: (addr cell) <- lookup *tmp-ah -1548 var result-type/edx: (addr int) <- get result, type -1549 check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0" -1550 var result-value-addr/eax: (addr float) <- get result, number-data -1551 var result-value/eax: int <- convert *result-value-addr -1552 check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1" -1553 } -1554 -1555 fn test-evaluate-backquote { -1556 # env = nil -1557 var nil-storage: (handle cell) -1558 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1559 allocate-pair nil-ah -1560 # eval `a, env -1561 var tmp-storage: (handle cell) -1562 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1563 new-symbol tmp-ah, "`" -1564 var tmp2-storage: (handle cell) -1565 var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage -1566 new-symbol tmp2-ah, "a" -1567 new-pair tmp-ah, *tmp-ah, *tmp2-ah -1568 clear-object tmp2-ah -1569 var trace-storage: trace -1570 var trace/edi: (addr trace) <- address trace-storage -1571 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1572 evaluate tmp-ah, tmp2-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1573 var result/eax: (addr cell) <- lookup *tmp2-ah -1574 var result-type/edx: (addr int) <- get result, type -1575 check-ints-equal *result-type, 2/symbol, "F - test-evaluate-backquote/0" -1576 var sym?/eax: boolean <- symbol-equal? result, "a" -1577 check sym?, "F - test-evaluate-backquote/1" -1578 } -1579 -1580 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 { -1581 # stack overflow? # disable when enabling Really-debug-print -1582 #? dump-cell-from-cursor-over-full-screen _in-ah -1583 check-stack -1584 { -1585 var screen-cell/eax: (addr handle cell) <- copy screen-cell -1586 compare screen-cell, 0 -1587 break-if-= -1588 var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell -1589 compare screen-cell-addr, 0 -1590 break-if-= -1591 # if screen-cell exists, we're probably not in a test -1592 show-stack-state -1593 } -1594 # errors? skip -1595 { -1596 var error?/eax: boolean <- has-errors? trace -1597 compare error?, 0/false -1598 break-if-= -1599 return -1600 } -1601 trace-lower trace -1602 var in-ah/esi: (addr handle cell) <- copy _in-ah -1603 var in/eax: (addr cell) <- lookup *in-ah -1604 { -1605 var nil?/eax: boolean <- nil? in -1606 compare nil?, 0/false -1607 break-if-= -1608 # nil is a literal -1609 trace-text trace, "eval", "backquote nil" -1610 copy-object _in-ah, _out-ah -1611 trace-higher trace -1612 return -1613 } -1614 var in-type/ecx: (addr int) <- get in, type -1615 compare *in-type, 0/pair +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 break-if-= -1618 # copy non-pairs directly -1619 # TODO: streams might need to be copied -1620 trace-text trace, "eval", "backquote atom" -1621 copy-object _in-ah, _out-ah -1622 trace-higher trace -1623 return -1624 } -1625 # 'in' is a pair -1626 debug-print "()", 4/fg, 0/bg -1627 var in-ah/esi: (addr handle cell) <- copy _in-ah -1628 var _in/eax: (addr cell) <- lookup *in-ah -1629 var in/ebx: (addr cell) <- copy _in -1630 var in-left-ah/ecx: (addr handle cell) <- get in, left -1631 debug-print "10", 4/fg, 0/bg -1632 # check for unquote -1633 $macroexpand-iter:unquote: { -1634 var in-left/eax: (addr cell) <- lookup *in-left-ah -1635 var unquote?/eax: boolean <- symbol-equal? in-left, "," -1636 compare unquote?, 0/false -1637 break-if-= -1638 trace-text trace, "eval", "unquote" -1639 var rest-ah/eax: (addr handle cell) <- get in, right -1640 increment call-number -1641 debug-print ",", 3/fg, 0/bg -1642 evaluate rest-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1643 debug-print ",)", 3/fg, 0/bg -1644 trace-higher trace -1645 return -1646 } -1647 # check for unquote-splice in in-left -1648 debug-print "11", 4/fg, 0/bg -1649 var out-ah/edi: (addr handle cell) <- copy _out-ah -1650 $macroexpand-iter:unquote-splice: { -1651 #? dump-cell-from-cursor-over-full-screen in-left-ah -1652 var in-left/eax: (addr cell) <- lookup *in-left-ah -1653 { -1654 debug-print "12", 4/fg, 0/bg -1655 { -1656 var in-left-is-nil?/eax: boolean <- nil? in-left -1657 compare in-left-is-nil?, 0/false -1658 } -1659 break-if-!= $macroexpand-iter:unquote-splice -1660 var in-left-type/ecx: (addr int) <- get in-left, type -1661 debug-print "13", 4/fg, 0/bg -1662 compare *in-left-type, 0/pair -1663 break-if-!= $macroexpand-iter:unquote-splice -1664 var in-left-left-ah/eax: (addr handle cell) <- get in-left, left -1665 debug-print "14", 4/fg, 0/bg -1666 var in-left-left/eax: (addr cell) <- lookup *in-left-left-ah -1667 debug-print "15", 4/fg, 0/bg -1668 var in-left-left-type/ecx: (addr int) <- get in-left-left, type -1669 var left-is-unquote-splice?/eax: boolean <- symbol-equal? in-left-left, ",@" -1670 debug-print "16", 4/fg, 0/bg -1671 compare left-is-unquote-splice?, 0/false -1672 } -1673 break-if-= -1674 debug-print "17", 4/fg, 0/bg -1675 trace-text trace, "eval", "unquote-splice" -1676 var in-unquote-payload-ah/eax: (addr handle cell) <- get in-left, right -1677 increment call-number -1678 evaluate in-unquote-payload-ah, out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1679 # errors? skip -1680 { -1681 var error?/eax: boolean <- has-errors? trace -1682 compare error?, 0/false -1683 break-if-= -1684 trace-higher trace -1685 return -1686 } -1687 # while (*out-ah != null) out-ah = cdr(out-ah) -1688 { -1689 var out/eax: (addr cell) <- lookup *out-ah -1690 { -1691 var done?/eax: boolean <- nil? out -1692 compare done?, 0/false -1693 } -1694 break-if-!= -1695 out-ah <- get out, right -1696 loop -1697 } -1698 # append result of in-right -1699 var in-right-ah/ecx: (addr handle cell) <- get in, right -1700 evaluate-backquote in-right-ah, out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1701 trace-higher trace -1702 return -1703 } -1704 debug-print "19", 4/fg, 0/bg -1705 # otherwise continue copying -1706 trace-text trace, "eval", "backquote: copy" -1707 var out-ah/edi: (addr handle cell) <- copy _out-ah -1708 allocate-pair out-ah -1709 debug-print "20", 7/fg, 0/bg -1710 #? dump-cell-from-cursor-over-full-screen out-ah -1711 var out/eax: (addr cell) <- lookup *out-ah -1712 var out-left-ah/edx: (addr handle cell) <- get out, left -1713 debug-print "`(l", 3/fg, 0/bg -1714 evaluate-backquote in-left-ah, out-left-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1715 debug-print "`r)", 3/fg, 0/bg -1716 # errors? skip -1717 { -1718 var error?/eax: boolean <- has-errors? trace -1719 compare error?, 0/false -1720 break-if-= -1721 trace-higher trace -1722 return -1723 } -1724 var in-right-ah/ecx: (addr handle cell) <- get in, right -1725 var out-right-ah/edx: (addr handle cell) <- get out, right -1726 debug-print "`r(", 3/fg, 0/bg -1727 evaluate-backquote in-right-ah, out-right-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1728 debug-print "`r)", 3/fg, 0/bg -1729 trace-higher trace -1730 } -1731 -1732 fn test-evaluate-backquote-list { -1733 var nil-storage: (handle cell) -1734 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1735 allocate-pair nil-ah -1736 var backquote-storage: (handle cell) -1737 var backquote-ah/edx: (addr handle cell) <- address backquote-storage -1738 new-symbol backquote-ah, "`" -1739 # input is `(a b) -1740 var a-storage: (handle cell) -1741 var a-ah/ebx: (addr handle cell) <- address a-storage -1742 new-symbol a-ah, "a" -1743 var b-storage: (handle cell) -1744 var b-ah/esi: (addr handle cell) <- address b-storage -1745 new-symbol b-ah, "b" -1746 var tmp-storage: (handle cell) -1747 var tmp-ah/eax: (addr handle cell) <- address tmp-storage -1748 new-pair tmp-ah, *b-ah, *nil-ah -1749 new-pair tmp-ah, *a-ah, *tmp-ah -1750 new-pair tmp-ah, *backquote-ah, *tmp-ah -1751 # -1752 var trace-storage: trace -1753 var trace/edi: (addr trace) <- address trace-storage -1754 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1755 evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1756 # result is (a b) -1757 var result/eax: (addr cell) <- lookup *tmp-ah -1758 { -1759 var result-type/eax: (addr int) <- get result, type -1760 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list/0" -1761 } -1762 { -1763 var a1-ah/eax: (addr handle cell) <- get result, left -1764 var a1/eax: (addr cell) <- lookup *a1-ah -1765 var check1/eax: boolean <- symbol-equal? a1, "a" -1766 check check1, "F - test-evaluate-backquote-list/1" -1767 } -1768 var rest-ah/eax: (addr handle cell) <- get result, right -1769 var rest/eax: (addr cell) <- lookup *rest-ah +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 a2-ah/eax: (addr handle cell) <- get rest, left -1772 var a2/eax: (addr cell) <- lookup *a2-ah -1773 var check2/eax: boolean <- symbol-equal? a2, "b" -1774 check check2, "F - test-evaluate-backquote-list/2" -1775 } -1776 var rest-ah/eax: (addr handle cell) <- get rest, right -1777 var rest/eax: (addr cell) <- lookup *rest-ah -1778 var check3/eax: boolean <- nil? rest -1779 check check3, "F - test-evaluate-backquote-list/3" -1780 } -1781 -1782 fn test-evaluate-backquote-list-with-unquote { -1783 var nil-h: (handle cell) -1784 var nil-ah/eax: (addr handle cell) <- address nil-h -1785 allocate-pair nil-ah -1786 var backquote-h: (handle cell) -1787 var backquote-ah/eax: (addr handle cell) <- address backquote-h -1788 new-symbol backquote-ah, "`" -1789 var unquote-h: (handle cell) -1790 var unquote-ah/eax: (addr handle cell) <- address unquote-h -1791 new-symbol unquote-ah, "," -1792 var a-h: (handle cell) -1793 var a-ah/eax: (addr handle cell) <- address a-h -1794 new-symbol a-ah, "a" -1795 var b-h: (handle cell) -1796 var b-ah/eax: (addr handle cell) <- address b-h -1797 new-symbol b-ah, "b" -1798 # env = ((b . 3)) -1799 var val-h: (handle cell) -1800 var val-ah/eax: (addr handle cell) <- address val-h -1801 new-integer val-ah, 3 -1802 var env-h: (handle cell) -1803 var env-ah/eax: (addr handle cell) <- address env-h -1804 new-pair env-ah, b-h, val-h -1805 new-pair env-ah, env-h, nil-h -1806 # input is `(a ,b) -1807 var tmp-h: (handle cell) -1808 var tmp-ah/eax: (addr handle cell) <- address tmp-h -1809 # tmp = cons(unquote, b) -1810 new-pair tmp-ah, unquote-h, b-h -1811 # tmp = cons(tmp, nil) -1812 new-pair tmp-ah, tmp-h, nil-h -1813 # tmp = cons(a, tmp) -1814 new-pair tmp-ah, a-h, tmp-h -1815 # tmp = cons(backquote, tmp) -1816 new-pair tmp-ah, backquote-h, tmp-h -1817 # -1818 var trace-storage: trace -1819 var trace/edi: (addr trace) <- address trace-storage -1820 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1821 evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1822 # result is (a 3) -1823 var result/eax: (addr cell) <- lookup *tmp-ah -1824 { -1825 var result-type/eax: (addr int) <- get result, type -1826 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote/0" -1827 } -1828 { -1829 var a1-ah/eax: (addr handle cell) <- get result, left -1830 var a1/eax: (addr cell) <- lookup *a1-ah -1831 var check1/eax: boolean <- symbol-equal? a1, "a" -1832 check check1, "F - test-evaluate-backquote-list-with-unquote/1" -1833 } -1834 var rest-ah/eax: (addr handle cell) <- get result, right -1835 var rest/eax: (addr cell) <- lookup *rest-ah +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 a2-ah/eax: (addr handle cell) <- get rest, left -1838 var a2/eax: (addr cell) <- lookup *a2-ah -1839 var a2-value-addr/eax: (addr float) <- get a2, number-data -1840 var a2-value/eax: int <- convert *a2-value-addr -1841 check-ints-equal a2-value, 3, "F - test-evaluate-backquote-list-with-unquote/2" -1842 } -1843 var rest-ah/eax: (addr handle cell) <- get rest, right -1844 var rest/eax: (addr cell) <- lookup *rest-ah -1845 var check3/eax: boolean <- nil? rest -1846 check check3, "F - test-evaluate-backquote-list-with-unquote/3" -1847 } -1848 -1849 fn test-evaluate-backquote-list-with-unquote-splice { -1850 var nil-h: (handle cell) -1851 var nil-ah/eax: (addr handle cell) <- address nil-h -1852 allocate-pair nil-ah -1853 var backquote-h: (handle cell) -1854 var backquote-ah/eax: (addr handle cell) <- address backquote-h -1855 new-symbol backquote-ah, "`" -1856 var unquote-splice-h: (handle cell) -1857 var unquote-splice-ah/eax: (addr handle cell) <- address unquote-splice-h -1858 new-symbol unquote-splice-ah, ",@" -1859 var a-h: (handle cell) -1860 var a-ah/eax: (addr handle cell) <- address a-h -1861 new-symbol a-ah, "a" -1862 var b-h: (handle cell) -1863 var b-ah/eax: (addr handle cell) <- address b-h -1864 new-symbol b-ah, "b" -1865 # env = ((b . (a 3))) -1866 var val-h: (handle cell) -1867 var val-ah/eax: (addr handle cell) <- address val-h -1868 new-integer val-ah, 3 -1869 new-pair val-ah, val-h, nil-h -1870 new-pair val-ah, a-h, val-h -1871 var env-h: (handle cell) -1872 var env-ah/eax: (addr handle cell) <- address env-h -1873 new-pair env-ah, b-h, val-h -1874 new-pair env-ah, env-h, nil-h -1875 # input is `(a ,@b b) -1876 var tmp-h: (handle cell) -1877 var tmp-ah/eax: (addr handle cell) <- address tmp-h -1878 # tmp = cons(b, nil) -1879 new-pair tmp-ah, b-h, nil-h -1880 # tmp2 = cons(unquote-splice, b) -1881 var tmp2-h: (handle cell) -1882 var tmp2-ah/ecx: (addr handle cell) <- address tmp2-h -1883 new-pair tmp2-ah, unquote-splice-h, b-h -1884 # tmp = cons(tmp2, tmp) -1885 new-pair tmp-ah, tmp2-h, tmp-h -1886 # tmp = cons(a, tmp) -1887 new-pair tmp-ah, a-h, tmp-h -1888 # tmp = cons(backquote, tmp) -1889 new-pair tmp-ah, backquote-h, tmp-h -1890 #? dump-cell-from-cursor-over-full-screen tmp-ah -1891 # -1892 var trace-storage: trace -1893 var trace/edi: (addr trace) <- address trace-storage -1894 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible -1895 evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number -1896 # result is (a a 3 b) -1897 #? dump-cell-from-cursor-over-full-screen tmp-ah -1898 var result/eax: (addr cell) <- lookup *tmp-ah -1899 { -1900 var result-type/eax: (addr int) <- get result, type -1901 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote-splice/0" -1902 } -1903 { -1904 var a1-ah/eax: (addr handle cell) <- get result, left -1905 var a1/eax: (addr cell) <- lookup *a1-ah -1906 var check1/eax: boolean <- symbol-equal? a1, "a" -1907 check check1, "F - test-evaluate-backquote-list-with-unquote-splice/1" -1908 } -1909 var rest-ah/eax: (addr handle cell) <- get result, right -1910 var rest/eax: (addr cell) <- lookup *rest-ah +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 a2-ah/eax: (addr handle cell) <- get rest, left -1913 var a2/eax: (addr cell) <- lookup *a2-ah -1914 var check2/eax: boolean <- symbol-equal? a2, "a" -1915 check check2, "F - test-evaluate-backquote-list-with-unquote-splice/2" -1916 } -1917 var rest-ah/eax: (addr handle cell) <- get rest, right -1918 var rest/eax: (addr cell) <- lookup *rest-ah -1919 { -1920 var a3-ah/eax: (addr handle cell) <- get rest, left -1921 var a3/eax: (addr cell) <- lookup *a3-ah -1922 var a3-value-addr/eax: (addr float) <- get a3, number-data -1923 var a3-value/eax: int <- convert *a3-value-addr -1924 check-ints-equal a3-value, 3, "F - test-evaluate-backquote-list-with-unquote-splice/3" -1925 } -1926 var rest-ah/eax: (addr handle cell) <- get rest, right -1927 var rest/eax: (addr cell) <- lookup *rest-ah -1928 { -1929 var a4-ah/eax: (addr handle cell) <- get rest, left -1930 var a4/eax: (addr cell) <- lookup *a4-ah -1931 var check4/eax: boolean <- symbol-equal? a4, "b" -1932 check check4, "F - test-evaluate-backquote-list-with-unquote-splice/4" -1933 } -1934 var rest-ah/eax: (addr handle cell) <- get rest, right -1935 var rest/eax: (addr cell) <- lookup *rest-ah -1936 var check5/eax: boolean <- nil? rest -1937 check check5, "F - test-evaluate-backquote-list-with-unquote-splice/5" -1938 } +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 } diff --git a/html/shell/gap-buffer.mu.html b/html/shell/gap-buffer.mu.html index 63864745..265a4cc6 100644 --- a/html/shell/gap-buffer.mu.html +++ b/html/shell/gap-buffer.mu.html @@ -14,14 +14,20 @@ 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; } -.Special { color: #ff6060; } .LineNr { } -.Constant { color: #008787; } .Delimiter { color: #c000c0; } +.muRegEbx { color: #8787af; } +.muRegEsi { color: #87d787; } +.muRegEdi { color: #87ffd7; } +.Constant { color: #008787; } +.Special { color: #ff6060; } +.PreProc { color: #c000c0; } .muFunction { color: #af5f00; text-decoration: underline; } .muTest { color: #5f8700; } .muComment { color: #005faf; } +.muRegEax { color: #875f00; } +.muRegEcx { color: #af875f; } +.muRegEdx { color: #878700; } --> @@ -68,1182 +74,1445 @@ if ('onhashchange' in window) { 9 } 10 11 fn initialize-gap-buffer _self: (addr gap-buffer), capacity: int { - 12 var self/esi: (addr gap-buffer) <- copy _self - 13 var left/eax: (addr grapheme-stack) <- get self, left + 12 var self/esi: (addr gap-buffer) <- copy _self + 13 var left/eax: (addr grapheme-stack) <- get self, left 14 initialize-grapheme-stack left, capacity - 15 var right/eax: (addr grapheme-stack) <- get self, right + 15 var right/eax: (addr grapheme-stack) <- get self, right 16 initialize-grapheme-stack right, capacity 17 } 18 19 fn clear-gap-buffer _self: (addr gap-buffer) { - 20 var self/esi: (addr gap-buffer) <- copy _self - 21 var left/eax: (addr grapheme-stack) <- get self, left + 20 var self/esi: (addr gap-buffer) <- copy _self + 21 var left/eax: (addr grapheme-stack) <- get self, left 22 clear-grapheme-stack left - 23 var right/eax: (addr grapheme-stack) <- get self, right + 23 var right/eax: (addr grapheme-stack) <- get self, right 24 clear-grapheme-stack right 25 } 26 - 27 fn gap-buffer-capacity _gap: (addr gap-buffer) -> _/ecx: int { - 28 var gap/esi: (addr gap-buffer) <- copy _gap - 29 var left/eax: (addr grapheme-stack) <- get gap, left - 30 var left-data-ah/eax: (addr handle array grapheme) <- get left, data - 31 var left-data/eax: (addr array grapheme) <- lookup *left-data-ah - 32 var result/eax: int <- length left-data - 33 return result - 34 } - 35 - 36 # just for tests - 37 fn initialize-gap-buffer-with self: (addr gap-buffer), s: (addr array byte) { - 38 initialize-gap-buffer self, 0x40/capacity - 39 var stream-storage: (stream byte 0x40/capacity) - 40 var stream/ecx: (addr stream byte) <- address stream-storage - 41 write stream, s - 42 { - 43 var done?/eax: boolean <- stream-empty? stream - 44 compare done?, 0/false - 45 break-if-!= - 46 var g/eax: grapheme <- read-grapheme stream - 47 add-grapheme-at-gap self, g - 48 loop - 49 } + 27 fn gap-buffer-empty? _self: (addr gap-buffer) -> _/eax: boolean { + 28 var self/esi: (addr gap-buffer) <- copy _self + 29 # if !empty?(left) return false + 30 { + 31 var left/eax: (addr grapheme-stack) <- get self, left + 32 var result/eax: boolean <- grapheme-stack-empty? left + 33 compare result, 0/false + 34 break-if-!= + 35 return 0/false + 36 } + 37 # return empty?(right) + 38 var left/eax: (addr grapheme-stack) <- get self, left + 39 var result/eax: boolean <- grapheme-stack-empty? left + 40 return result + 41 } + 42 + 43 fn gap-buffer-capacity _gap: (addr gap-buffer) -> _/ecx: 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 + 47 var left-data/eax: (addr array grapheme) <- lookup *left-data-ah + 48 var result/eax: int <- length left-data + 49 return result 50 } 51 - 52 fn load-gap-buffer-from-stream self: (addr gap-buffer), in: (addr stream byte) { - 53 rewind-stream in - 54 { - 55 var done?/eax: boolean <- stream-empty? in - 56 compare done?, 0/false - 57 break-if-!= - 58 var key/eax: byte <- read-byte in - 59 compare key, 0/null - 60 break-if-= - 61 var g/eax: grapheme <- copy key - 62 edit-gap-buffer self, g - 63 loop - 64 } - 65 } - 66 - 67 fn emit-gap-buffer _self: (addr gap-buffer), out: (addr stream byte) { - 68 var self/esi: (addr gap-buffer) <- copy _self - 69 clear-stream out - 70 var left/eax: (addr grapheme-stack) <- get self, left - 71 emit-stack-from-bottom left, out - 72 var right/eax: (addr grapheme-stack) <- get self, right - 73 emit-stack-from-top right, out - 74 } - 75 - 76 fn append-gap-buffer _self: (addr gap-buffer), out: (addr stream byte) { - 77 var self/esi: (addr gap-buffer) <- copy _self - 78 var left/eax: (addr grapheme-stack) <- get self, left - 79 emit-stack-from-bottom left, out - 80 var right/eax: (addr grapheme-stack) <- get self, right - 81 emit-stack-from-top right, out - 82 } - 83 - 84 # dump stack from bottom to top - 85 fn emit-stack-from-bottom _self: (addr grapheme-stack), out: (addr stream byte) { - 86 var self/esi: (addr grapheme-stack) <- copy _self - 87 var data-ah/edi: (addr handle array grapheme) <- get self, data - 88 var _data/eax: (addr array grapheme) <- lookup *data-ah - 89 var data/edi: (addr array grapheme) <- copy _data - 90 var top-addr/ecx: (addr int) <- get self, top - 91 var i/eax: int <- copy 0 - 92 { - 93 compare i, *top-addr - 94 break-if->= - 95 var g/edx: (addr grapheme) <- index data, i - 96 write-grapheme out, *g - 97 i <- increment - 98 loop - 99 } - 100 } - 101 - 102 # dump stack from top to bottom - 103 fn emit-stack-from-top _self: (addr grapheme-stack), out: (addr stream byte) { - 104 var self/esi: (addr grapheme-stack) <- copy _self - 105 var data-ah/edi: (addr handle array grapheme) <- get self, data - 106 var _data/eax: (addr array grapheme) <- lookup *data-ah - 107 var data/edi: (addr array grapheme) <- copy _data - 108 var top-addr/ecx: (addr int) <- get self, top - 109 var i/eax: int <- copy *top-addr - 110 i <- decrement - 111 { - 112 compare i, 0 - 113 break-if-< - 114 var g/edx: (addr grapheme) <- index data, i - 115 write-grapheme out, *g - 116 i <- decrement - 117 loop - 118 } - 119 } - 120 - 121 # We implicitly render everything editable in a single color, and assume the - 122 # cursor is a single other color. - 123 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 { - 124 var gap/esi: (addr gap-buffer) <- copy _gap - 125 var left/edx: (addr grapheme-stack) <- get gap, left - 126 var highlight-matching-open-paren?/ebx: boolean <- copy 0/false - 127 var matching-open-paren-depth/edi: int <- copy 0 - 128 highlight-matching-open-paren?, matching-open-paren-depth <- highlight-matching-open-paren? gap, render-cursor? - 129 var x2/eax: int <- copy 0 - 130 var y2/ecx: int <- copy 0 - 131 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 - 132 var right/edx: (addr grapheme-stack) <- get gap, right - 133 x2, y2 <- render-stack-from-top-wrapping-right-then-down screen, right, xmin, ymin, xmax, ymax, x2, y2, render-cursor?, color, background-color - 134 # decide whether we still need to print a cursor - 135 var bg/ebx: int <- copy background-color - 136 compare render-cursor?, 0/false - 137 { - 138 break-if-= - 139 # if the right side is empty, grapheme stack didn't print the cursor - 140 var empty?/eax: boolean <- grapheme-stack-empty? right - 141 compare empty?, 0/false - 142 break-if-= - 143 bg <- copy 7/cursor - 144 } - 145 # print a grapheme either way so that cursor position doesn't affect printed width - 146 var space/edx: grapheme <- copy 0x20 - 147 x2, y2 <- render-grapheme screen, space, xmin, ymin, xmax, ymax, x2, y2, color, bg - 148 return x2, y2 + 52 # just for tests + 53 fn initialize-gap-buffer-with self: (addr gap-buffer), s: (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 + 58 { + 59 var done?/eax: boolean <- stream-empty? stream + 60 compare done?, 0/false + 61 break-if-!= + 62 var g/eax: grapheme <- read-grapheme stream + 63 add-grapheme-at-gap self, g + 64 loop + 65 } + 66 } + 67 + 68 fn load-gap-buffer-from-stream self: (addr gap-buffer), in: (addr stream byte) { + 69 rewind-stream in + 70 { + 71 var done?/eax: boolean <- stream-empty? in + 72 compare done?, 0/false + 73 break-if-!= + 74 var key/eax: byte <- read-byte in + 75 compare key, 0/null + 76 break-if-= + 77 var g/eax: grapheme <- copy key + 78 edit-gap-buffer self, g + 79 loop + 80 } + 81 } + 82 + 83 fn emit-gap-buffer self: (addr gap-buffer), out: (addr stream byte) { + 84 clear-stream out + 85 append-gap-buffer self, out + 86 } + 87 + 88 fn append-gap-buffer _self: (addr gap-buffer), out: (addr stream byte) { + 89 var self/esi: (addr gap-buffer) <- copy _self + 90 var left/eax: (addr grapheme-stack) <- get self, left + 91 emit-stack-from-bottom left, out + 92 var right/eax: (addr grapheme-stack) <- get self, right + 93 emit-stack-from-top right, out + 94 } + 95 + 96 # dump stack from bottom to top + 97 fn emit-stack-from-bottom _self: (addr grapheme-stack), out: (addr stream byte) { + 98 var self/esi: (addr grapheme-stack) <- copy _self + 99 var data-ah/edi: (addr handle array grapheme) <- get self, data + 100 var _data/eax: (addr array grapheme) <- lookup *data-ah + 101 var data/edi: (addr array grapheme) <- copy _data + 102 var top-addr/ecx: (addr int) <- get self, top + 103 var i/eax: int <- copy 0 + 104 { + 105 compare i, *top-addr + 106 break-if->= + 107 var g/edx: (addr grapheme) <- index data, i + 108 write-grapheme out, *g + 109 i <- increment + 110 loop + 111 } + 112 } + 113 + 114 # dump stack from top to bottom + 115 fn emit-stack-from-top _self: (addr grapheme-stack), out: (addr stream byte) { + 116 var self/esi: (addr grapheme-stack) <- copy _self + 117 var data-ah/edi: (addr handle array grapheme) <- get self, data + 118 var _data/eax: (addr array grapheme) <- lookup *data-ah + 119 var data/edi: (addr array grapheme) <- copy _data + 120 var top-addr/ecx: (addr int) <- get self, top + 121 var i/eax: int <- copy *top-addr + 122 i <- decrement + 123 { + 124 compare i, 0 + 125 break-if-< + 126 var g/edx: (addr grapheme) <- index data, i + 127 write-grapheme out, *g + 128 i <- decrement + 129 loop + 130 } + 131 } + 132 + 133 fn word-at-gap _self: (addr gap-buffer), out: (addr stream byte) { + 134 var self/esi: (addr gap-buffer) <- copy _self + 135 clear-stream out + 136 { + 137 var g/eax: grapheme <- grapheme-at-gap self + 138 var at-word?/eax: boolean <- is-ascii-word-grapheme? g + 139 compare at-word?, 0/false + 140 break-if-!= + 141 return + 142 } + 143 var left/ecx: (addr grapheme-stack) <- get self, left + 144 var left-index/eax: int <- top-most-word left + 145 emit-stack-from-index left, left-index, out + 146 var right/ecx: (addr grapheme-stack) <- get self, right + 147 var right-index/eax: int <- top-most-word right + 148 emit-stack-to-index right, right-index, out 149 } 150 - 151 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 { - 152 var _width/eax: int <- copy 0 - 153 var _height/ecx: int <- copy 0 - 154 _width, _height <- screen-size screen - 155 var width/edx: int <- copy _width - 156 var height/ebx: int <- copy _height - 157 var x2/eax: int <- copy 0 - 158 var y2/ecx: int <- copy 0 - 159 x2, y2 <- render-gap-buffer-wrapping-right-then-down screen, gap, x, y, width, height, render-cursor?, color, background-color - 160 return x2 # y2? yolo - 161 } - 162 - 163 fn gap-buffer-length _gap: (addr gap-buffer) -> _/eax: int { - 164 var gap/esi: (addr gap-buffer) <- copy _gap - 165 var left/eax: (addr grapheme-stack) <- get gap, left - 166 var tmp/eax: (addr int) <- get left, top - 167 var left-length/ecx: int <- copy *tmp - 168 var right/esi: (addr grapheme-stack) <- get gap, right - 169 tmp <- get right, top - 170 var result/eax: int <- copy *tmp - 171 result <- add left-length - 172 return result - 173 } - 174 - 175 fn add-grapheme-at-gap _self: (addr gap-buffer), g: grapheme { - 176 var self/esi: (addr gap-buffer) <- copy _self - 177 var left/eax: (addr grapheme-stack) <- get self, left - 178 push-grapheme-stack left, g - 179 } - 180 - 181 fn add-code-point-at-gap self: (addr gap-buffer), c: code-point { - 182 var g/eax: grapheme <- copy c - 183 add-grapheme-at-gap self, g - 184 } - 185 - 186 fn gap-to-start self: (addr gap-buffer) { - 187 { - 188 var curr/eax: grapheme <- gap-left self - 189 compare curr, -1 - 190 loop-if-!= - 191 } - 192 } - 193 - 194 fn gap-to-end self: (addr gap-buffer) { - 195 { - 196 var curr/eax: grapheme <- gap-right self - 197 compare curr, -1 - 198 loop-if-!= - 199 } - 200 } - 201 - 202 fn gap-at-start? _self: (addr gap-buffer) -> _/eax: boolean { - 203 var self/esi: (addr gap-buffer) <- copy _self - 204 var left/eax: (addr grapheme-stack) <- get self, left - 205 var result/eax: boolean <- grapheme-stack-empty? left - 206 return result - 207 } - 208 - 209 fn gap-at-end? _self: (addr gap-buffer) -> _/eax: boolean { - 210 var self/esi: (addr gap-buffer) <- copy _self - 211 var right/eax: (addr grapheme-stack) <- get self, right - 212 var result/eax: boolean <- grapheme-stack-empty? right - 213 return result - 214 } - 215 - 216 fn gap-right _self: (addr gap-buffer) -> _/eax: grapheme { - 217 var self/esi: (addr gap-buffer) <- copy _self - 218 var g/eax: grapheme <- copy 0 - 219 var right/ecx: (addr grapheme-stack) <- get self, right - 220 g <- pop-grapheme-stack right - 221 compare g, -1 - 222 { - 223 break-if-= - 224 var left/ecx: (addr grapheme-stack) <- get self, left - 225 push-grapheme-stack left, g - 226 } - 227 return g - 228 } - 229 - 230 fn gap-left _self: (addr gap-buffer) -> _/eax: grapheme { - 231 var self/esi: (addr gap-buffer) <- copy _self - 232 var g/eax: grapheme <- copy 0 - 233 { - 234 var left/ecx: (addr grapheme-stack) <- get self, left - 235 g <- pop-grapheme-stack left - 236 } - 237 compare g, -1 - 238 { - 239 break-if-= - 240 var right/ecx: (addr grapheme-stack) <- get self, right - 241 push-grapheme-stack right, g - 242 } - 243 return g - 244 } - 245 - 246 fn index-of-gap _self: (addr gap-buffer) -> _/eax: int { - 247 var self/eax: (addr gap-buffer) <- copy _self - 248 var left/eax: (addr grapheme-stack) <- get self, left - 249 var top-addr/eax: (addr int) <- get left, top - 250 var result/eax: int <- copy *top-addr - 251 return result - 252 } - 253 - 254 fn first-grapheme-in-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { - 255 var self/esi: (addr gap-buffer) <- copy _self - 256 # try to read from left - 257 var left/eax: (addr grapheme-stack) <- get self, left - 258 var top-addr/ecx: (addr int) <- get left, top - 259 compare *top-addr, 0 - 260 { - 261 break-if-<= - 262 var data-ah/eax: (addr handle array grapheme) <- get left, data - 263 var data/eax: (addr array grapheme) <- lookup *data-ah - 264 var result-addr/eax: (addr grapheme) <- index data, 0 - 265 return *result-addr - 266 } - 267 # try to read from right - 268 var right/eax: (addr grapheme-stack) <- get self, right - 269 top-addr <- get right, top - 270 compare *top-addr, 0 - 271 { - 272 break-if-<= - 273 var data-ah/eax: (addr handle array grapheme) <- get right, data - 274 var data/eax: (addr array grapheme) <- lookup *data-ah - 275 var top/ecx: int <- copy *top-addr - 276 top <- decrement - 277 var result-addr/eax: (addr grapheme) <- index data, top - 278 return *result-addr - 279 } - 280 # give up - 281 return -1 - 282 } - 283 - 284 fn grapheme-before-cursor-in-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { - 285 var self/esi: (addr gap-buffer) <- copy _self - 286 # try to read from left - 287 var left/ecx: (addr grapheme-stack) <- get self, left - 288 var top-addr/edx: (addr int) <- get left, top - 289 compare *top-addr, 0 - 290 { - 291 break-if-<= - 292 var result/eax: grapheme <- pop-grapheme-stack left - 293 push-grapheme-stack left, result - 294 return result - 295 } - 296 # give up - 297 return -1 - 298 } - 299 - 300 fn delete-before-gap _self: (addr gap-buffer) { - 301 var self/eax: (addr gap-buffer) <- copy _self - 302 var left/eax: (addr grapheme-stack) <- get self, left - 303 var dummy/eax: grapheme <- pop-grapheme-stack left - 304 } - 305 - 306 fn pop-after-gap _self: (addr gap-buffer) -> _/eax: grapheme { - 307 var self/eax: (addr gap-buffer) <- copy _self - 308 var right/eax: (addr grapheme-stack) <- get self, right - 309 var result/eax: grapheme <- pop-grapheme-stack right - 310 return result - 311 } - 312 - 313 fn gap-buffer-equal? _self: (addr gap-buffer), s: (addr array byte) -> _/eax: boolean { - 314 var self/esi: (addr gap-buffer) <- copy _self - 315 # complication: graphemes may be multiple bytes - 316 # so don't rely on length - 317 # instead turn the expected result into a stream and arrange to read from it in order - 318 var stream-storage: (stream byte 0x10/capacity) - 319 var expected-stream/ecx: (addr stream byte) <- address stream-storage - 320 write expected-stream, s - 321 # compare left - 322 var left/edx: (addr grapheme-stack) <- get self, left - 323 var result/eax: boolean <- prefix-match? left, expected-stream - 324 compare result, 0/false - 325 { - 326 break-if-!= - 327 return result - 328 } - 329 # compare right - 330 var right/edx: (addr grapheme-stack) <- get self, right - 331 result <- suffix-match? right, expected-stream - 332 compare result, 0/false - 333 { - 334 break-if-!= - 335 return result - 336 } - 337 # ensure there's nothing left over - 338 result <- stream-empty? expected-stream - 339 return result - 340 } - 341 - 342 fn test-gap-buffer-equal-from-end { - 343 var _g: gap-buffer - 344 var g/esi: (addr gap-buffer) <- address _g - 345 initialize-gap-buffer g, 0x10 - 346 # - 347 add-code-point-at-gap g, 0x61/a - 348 add-code-point-at-gap g, 0x61/a - 349 add-code-point-at-gap g, 0x61/a - 350 # gap is at end (right is empty) - 351 var result/eax: boolean <- gap-buffer-equal? g, "aaa" - 352 check result, "F - test-gap-buffer-equal-from-end" - 353 } - 354 - 355 fn test-gap-buffer-equal-from-middle { - 356 var _g: gap-buffer - 357 var g/esi: (addr gap-buffer) <- address _g - 358 initialize-gap-buffer g, 0x10 - 359 # - 360 add-code-point-at-gap g, 0x61/a - 361 add-code-point-at-gap g, 0x61/a - 362 add-code-point-at-gap g, 0x61/a - 363 var dummy/eax: grapheme <- gap-left g - 364 # gap is in the middle - 365 var result/eax: boolean <- gap-buffer-equal? g, "aaa" - 366 check result, "F - test-gap-buffer-equal-from-middle" - 367 } - 368 - 369 fn test-gap-buffer-equal-from-start { - 370 var _g: gap-buffer - 371 var g/esi: (addr gap-buffer) <- address _g - 372 initialize-gap-buffer g, 0x10 - 373 # - 374 add-code-point-at-gap g, 0x61/a - 375 add-code-point-at-gap g, 0x61/a - 376 add-code-point-at-gap g, 0x61/a - 377 var dummy/eax: grapheme <- gap-left g - 378 dummy <- gap-left g - 379 dummy <- gap-left g - 380 # gap is at the start - 381 var result/eax: boolean <- gap-buffer-equal? g, "aaa" - 382 check result, "F - test-gap-buffer-equal-from-start" - 383 } - 384 - 385 fn test-gap-buffer-equal-fails { - 386 # g = "aaa" - 387 var _g: gap-buffer - 388 var g/esi: (addr gap-buffer) <- address _g - 389 initialize-gap-buffer g, 0x10 - 390 add-code-point-at-gap g, 0x61/a - 391 add-code-point-at-gap g, 0x61/a - 392 add-code-point-at-gap g, 0x61/a - 393 # - 394 var result/eax: boolean <- gap-buffer-equal? g, "aa" - 395 check-not result, "F - test-gap-buffer-equal-fails" - 396 } - 397 - 398 fn gap-buffers-equal? self: (addr gap-buffer), g: (addr gap-buffer) -> _/eax: boolean { - 399 var tmp/eax: int <- gap-buffer-length self - 400 var len/ecx: int <- copy tmp - 401 var leng/eax: int <- gap-buffer-length g - 402 compare len, leng - 403 { - 404 break-if-= - 405 return 0/false - 406 } - 407 var i/edx: int <- copy 0 - 408 { - 409 compare i, len - 410 break-if->= - 411 { - 412 var tmp/eax: grapheme <- gap-index self, i - 413 var curr/ecx: grapheme <- copy tmp - 414 var currg/eax: grapheme <- gap-index g, i - 415 compare curr, currg - 416 break-if-= - 417 return 0/false - 418 } - 419 i <- increment - 420 loop - 421 } - 422 return 1/true - 423 } - 424 - 425 fn gap-index _self: (addr gap-buffer), _n: int -> _/eax: grapheme { - 426 var self/esi: (addr gap-buffer) <- copy _self - 427 var n/ebx: int <- copy _n - 428 # if n < left->length, index into left - 429 var left/edi: (addr grapheme-stack) <- get self, left - 430 var left-len-a/edx: (addr int) <- get left, top - 431 compare n, *left-len-a - 432 { - 433 break-if->= - 434 var data-ah/eax: (addr handle array grapheme) <- get left, data - 435 var data/eax: (addr array grapheme) <- lookup *data-ah - 436 var result/eax: (addr grapheme) <- index data, n - 437 return *result - 438 } - 439 # shrink n - 440 n <- subtract *left-len-a - 441 # if n < right->length, index into right - 442 var right/edi: (addr grapheme-stack) <- get self, right - 443 var right-len-a/edx: (addr int) <- get right, top - 444 compare n, *right-len-a - 445 { - 446 break-if->= - 447 var data-ah/eax: (addr handle array grapheme) <- get right, data - 448 var data/eax: (addr array grapheme) <- lookup *data-ah - 449 # idx = right->len - n - 1 - 450 var idx/ebx: int <- copy n - 451 idx <- subtract *right-len-a - 452 idx <- negate - 453 idx <- subtract 1 - 454 var result/eax: (addr grapheme) <- index data, idx - 455 return *result - 456 } - 457 # error - 458 abort "gap-index: out of bounds" - 459 return 0 - 460 } - 461 - 462 fn test-gap-buffers-equal? { - 463 var _a: gap-buffer - 464 var a/esi: (addr gap-buffer) <- address _a - 465 initialize-gap-buffer-with a, "abc" - 466 var _b: gap-buffer - 467 var b/edi: (addr gap-buffer) <- address _b - 468 initialize-gap-buffer-with b, "abc" - 469 var _c: gap-buffer - 470 var c/ebx: (addr gap-buffer) <- address _c - 471 initialize-gap-buffer-with c, "ab" - 472 var _d: gap-buffer - 473 var d/edx: (addr gap-buffer) <- address _d - 474 initialize-gap-buffer-with d, "abd" - 475 # - 476 var result/eax: boolean <- gap-buffers-equal? a, a - 477 check result, "F - test-gap-buffers-equal? - reflexive" - 478 result <- gap-buffers-equal? a, b - 479 check result, "F - test-gap-buffers-equal? - equal" - 480 # length not equal - 481 result <- gap-buffers-equal? a, c - 482 check-not result, "F - test-gap-buffers-equal? - not equal" - 483 # contents not equal - 484 result <- gap-buffers-equal? a, d - 485 check-not result, "F - test-gap-buffers-equal? - not equal 2" - 486 result <- gap-buffers-equal? d, a - 487 check-not result, "F - test-gap-buffers-equal? - not equal 3" - 488 } - 489 - 490 fn test-gap-buffer-index { - 491 var gap-storage: gap-buffer - 492 var gap/esi: (addr gap-buffer) <- address gap-storage - 493 initialize-gap-buffer-with gap, "abc" - 494 # gap is at end, all contents are in left - 495 var g/eax: grapheme <- gap-index gap, 0 - 496 var x/ecx: int <- copy g - 497 check-ints-equal x, 0x61/a, "F - test-gap-index/left-1" - 498 var g/eax: grapheme <- gap-index gap, 1 - 499 var x/ecx: int <- copy g - 500 check-ints-equal x, 0x62/b, "F - test-gap-index/left-2" - 501 var g/eax: grapheme <- gap-index gap, 2 - 502 var x/ecx: int <- copy g - 503 check-ints-equal x, 0x63/c, "F - test-gap-index/left-3" - 504 # now check when everything is to the right - 505 gap-to-start gap - 506 rewind-gap-buffer gap - 507 var g/eax: grapheme <- gap-index gap, 0 - 508 var x/ecx: int <- copy g - 509 check-ints-equal x, 0x61/a, "F - test-gap-index/right-1" - 510 var g/eax: grapheme <- gap-index gap, 1 - 511 var x/ecx: int <- copy g - 512 check-ints-equal x, 0x62/b, "F - test-gap-index/right-2" - 513 var g/eax: grapheme <- gap-index gap, 2 - 514 var x/ecx: int <- copy g - 515 check-ints-equal x, 0x63/c, "F - test-gap-index/right-3" - 516 } - 517 - 518 fn copy-gap-buffer _src-ah: (addr handle gap-buffer), _dest-ah: (addr handle gap-buffer) { - 519 # obtain src-a, dest-a - 520 var src-ah/eax: (addr handle gap-buffer) <- copy _src-ah - 521 var _src-a/eax: (addr gap-buffer) <- lookup *src-ah - 522 var src-a/esi: (addr gap-buffer) <- copy _src-a - 523 var dest-ah/eax: (addr handle gap-buffer) <- copy _dest-ah - 524 var _dest-a/eax: (addr gap-buffer) <- lookup *dest-ah - 525 var dest-a/edi: (addr gap-buffer) <- copy _dest-a - 526 # copy left grapheme-stack - 527 var src/ecx: (addr grapheme-stack) <- get src-a, left - 528 var dest/edx: (addr grapheme-stack) <- get dest-a, left - 529 copy-grapheme-stack src, dest - 530 # copy right grapheme-stack - 531 src <- get src-a, right - 532 dest <- get dest-a, right - 533 copy-grapheme-stack src, dest - 534 } - 535 - 536 fn gap-buffer-is-decimal-integer? _self: (addr gap-buffer) -> _/eax: boolean { - 537 var self/esi: (addr gap-buffer) <- copy _self - 538 var curr/ecx: (addr grapheme-stack) <- get self, left - 539 var result/eax: boolean <- grapheme-stack-is-decimal-integer? curr - 540 { - 541 compare result, 0/false - 542 break-if-= - 543 curr <- get self, right - 544 result <- grapheme-stack-is-decimal-integer? curr - 545 } - 546 return result - 547 } - 548 - 549 fn test-render-gap-buffer-without-cursor { - 550 # setup - 551 var gap-storage: gap-buffer - 552 var gap/esi: (addr gap-buffer) <- address gap-storage - 553 initialize-gap-buffer-with gap, "abc" - 554 # setup: screen - 555 var screen-on-stack: screen - 556 var screen/edi: (addr screen) <- address screen-on-stack - 557 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 558 # - 559 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 0/no-cursor, 3/fg, 0xc5/bg=blue-bg - 560 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-without-cursor" - 561 check-ints-equal x, 4, "F - test-render-gap-buffer-without-cursor: result" - 562 # abc - 563 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-render-gap-buffer-without-cursor: bg" - 564 } - 565 - 566 fn test-render-gap-buffer-with-cursor-at-end { - 567 # setup - 568 var gap-storage: gap-buffer - 569 var gap/esi: (addr gap-buffer) <- address gap-storage - 570 initialize-gap-buffer-with gap, "abc" - 571 gap-to-end gap - 572 # setup: screen - 573 var screen-on-stack: screen - 574 var screen/edi: (addr screen) <- address screen-on-stack - 575 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 576 # - 577 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg - 578 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-at-end" - 579 # we've drawn one extra grapheme for the cursor - 580 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-at-end: result" - 581 # abc - 582 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " |", "F - test-render-gap-buffer-with-cursor-at-end: bg" - 583 } - 584 - 585 fn test-render-gap-buffer-with-cursor-in-middle { - 586 # setup - 587 var gap-storage: gap-buffer - 588 var gap/esi: (addr gap-buffer) <- address gap-storage - 589 initialize-gap-buffer-with gap, "abc" - 590 gap-to-end gap - 591 var dummy/eax: grapheme <- gap-left gap - 592 # setup: screen - 593 var screen-on-stack: screen - 594 var screen/edi: (addr screen) <- address screen-on-stack - 595 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 596 # - 597 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg - 598 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-in-middle" - 599 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-in-middle: result" - 600 # abc - 601 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-render-gap-buffer-with-cursor-in-middle: bg" - 602 } - 603 - 604 fn test-render-gap-buffer-with-cursor-at-start { - 605 var gap-storage: gap-buffer - 606 var gap/esi: (addr gap-buffer) <- address gap-storage - 607 initialize-gap-buffer-with gap, "abc" - 608 gap-to-start gap - 609 # setup: screen - 610 var screen-on-stack: screen - 611 var screen/edi: (addr screen) <- address screen-on-stack - 612 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 613 # - 614 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg - 615 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-at-start" - 616 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-at-start: result" - 617 # abc - 618 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "| ", "F - test-render-gap-buffer-with-cursor-at-start: bg" - 619 } - 620 - 621 fn test-render-gap-buffer-highlight-matching-close-paren { - 622 var gap-storage: gap-buffer - 623 var gap/esi: (addr gap-buffer) <- address gap-storage - 624 initialize-gap-buffer-with gap, "(a)" - 625 gap-to-start gap - 626 # setup: screen - 627 var screen-on-stack: screen - 628 var screen/edi: (addr screen) <- address screen-on-stack - 629 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 630 # - 631 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg - 632 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-close-paren" - 633 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-close-paren: result" - 634 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "| ", "F - test-render-gap-buffer-highlight-matching-close-paren: cursor" - 635 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, " ) ", "F - test-render-gap-buffer-highlight-matching-close-paren: matching paren" - 636 } - 637 - 638 fn test-render-gap-buffer-highlight-matching-open-paren { - 639 var gap-storage: gap-buffer - 640 var gap/esi: (addr gap-buffer) <- address gap-storage - 641 initialize-gap-buffer-with gap, "(a)" - 642 gap-to-end gap - 643 var dummy/eax: grapheme <- gap-left gap - 644 # setup: screen - 645 var screen-on-stack: screen - 646 var screen/edi: (addr screen) <- address screen-on-stack - 647 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 648 # - 649 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg - 650 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-open-paren" - 651 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-open-paren: result" - 652 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-render-gap-buffer-highlight-matching-open-paren: cursor" - 653 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, "( ", "F - test-render-gap-buffer-highlight-matching-open-paren: matching paren" - 654 } - 655 - 656 fn test-render-gap-buffer-highlight-matching-open-paren-of-end { - 657 var gap-storage: gap-buffer - 658 var gap/esi: (addr gap-buffer) <- address gap-storage - 659 initialize-gap-buffer-with gap, "(a)" - 660 gap-to-end gap - 661 # setup: screen - 662 var screen-on-stack: screen - 663 var screen/edi: (addr screen) <- address screen-on-stack - 664 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 665 # - 666 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg - 667 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end" - 668 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: result" - 669 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " |", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: cursor" - 670 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, "( ", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: matching paren" - 671 } - 672 - 673 # should I highlight a matching open paren? And if so, at what depth from top of left? - 674 # basically there are two cases to disambiguate here: - 675 # Usually the cursor is at top of right. Highlight first '(' at depth 0 from top of left. - 676 # If right is empty, match the ')' _before_ cursor. Highlight first '(' at depth _1_ from top of left. - 677 fn highlight-matching-open-paren? _gap: (addr gap-buffer), render-cursor?: boolean -> _/ebx: boolean, _/edi: int { - 678 # if not rendering cursor, return - 679 compare render-cursor?, 0/false - 680 { - 681 break-if-!= - 682 return 0/false, 0 - 683 } - 684 var gap/esi: (addr gap-buffer) <- copy _gap - 685 var stack/edi: (addr grapheme-stack) <- get gap, right - 686 var top-addr/eax: (addr int) <- get stack, top - 687 var top-index/ecx: int <- copy *top-addr - 688 compare top-index, 0 - 689 { - 690 break-if-> - 691 # if cursor at end, return (char before cursor == ')', 1) - 692 stack <- get gap, left - 693 top-addr <- get stack, top - 694 top-index <- copy *top-addr - 695 compare top-index, 0 - 696 { - 697 break-if-> - 698 return 0/false, 0 - 699 } - 700 top-index <- decrement - 701 var data-ah/eax: (addr handle array grapheme) <- get stack, data - 702 var data/eax: (addr array grapheme) <- lookup *data-ah - 703 var g/eax: (addr grapheme) <- index data, top-index - 704 compare *g, 0x29/close-paren - 705 { - 706 break-if-= - 707 return 0/false, 0 - 708 } - 709 return 1/true, 1 - 710 } - 711 # cursor is not at end; return (char at cursor == ')') - 712 top-index <- decrement - 713 var data-ah/eax: (addr handle array grapheme) <- get stack, data - 714 var data/eax: (addr array grapheme) <- lookup *data-ah - 715 var g/eax: (addr grapheme) <- index data, top-index - 716 compare *g, 0x29/close-paren - 717 { - 718 break-if-= - 719 return 0/false, 0 - 720 } - 721 return 1/true, 0 - 722 } - 723 - 724 fn test-highlight-matching-open-paren { - 725 var gap-storage: gap-buffer - 726 var gap/esi: (addr gap-buffer) <- address gap-storage - 727 initialize-gap-buffer-with gap, "(a)" - 728 gap-to-end gap - 729 var highlight-matching-open-paren?/ebx: boolean <- copy 0/false - 730 var open-paren-depth/edi: int <- copy 0 - 731 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 0/no-cursor - 732 check-not highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: no cursor" - 733 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor - 734 check highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: at end immediately after ')'" - 735 check-ints-equal open-paren-depth, 1, "F - test-highlight-matching-open-paren: depth at end immediately after ')'" - 736 var dummy/eax: grapheme <- gap-left gap - 737 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor - 738 check highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: on ')'" - 739 dummy <- gap-left gap - 740 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor - 741 check-not highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: not on ')'" - 742 } - 743 - 744 ## some primitives for scanning through a gap buffer - 745 # don't modify the gap buffer while scanning - 746 # this includes moving the cursor around - 747 - 748 # restart scan without affecting gap-buffer contents - 749 fn rewind-gap-buffer _self: (addr gap-buffer) { - 750 var self/esi: (addr gap-buffer) <- copy _self - 751 var dest/eax: (addr int) <- get self, left-read-index - 752 copy-to *dest, 0 - 753 dest <- get self, right-read-index - 754 copy-to *dest, 0 - 755 } - 756 - 757 fn gap-buffer-scan-done? _self: (addr gap-buffer) -> _/eax: boolean { - 758 var self/esi: (addr gap-buffer) <- copy _self - 759 # more in left? - 760 var left/eax: (addr grapheme-stack) <- get self, left - 761 var left-size/eax: int <- grapheme-stack-length left - 762 var left-read-index/ecx: (addr int) <- get self, left-read-index - 763 compare *left-read-index, left-size - 764 { - 765 break-if->= - 766 return 0/false - 767 } - 768 # more in right? - 769 var right/eax: (addr grapheme-stack) <- get self, right - 770 var right-size/eax: int <- grapheme-stack-length right - 771 var right-read-index/ecx: (addr int) <- get self, right-read-index - 772 compare *right-read-index, right-size - 773 { - 774 break-if->= - 775 return 0/false - 776 } - 777 # - 778 return 1/true + 151 fn test-word-at-gap-single-word-with-gap-at-end { + 152 var _g: gap-buffer + 153 var g/esi: (addr gap-buffer) <- address _g + 154 initialize-gap-buffer-with g, "abc" + 155 # gap is at end (right is empty) + 156 var out-storage: (stream byte 0x10) + 157 var out/eax: (addr stream byte) <- address out-storage + 158 word-at-gap g, out + 159 check-stream-equal out, "abc", "F - test-word-at-gap-single-word-with-gap-at-end" + 160 } + 161 + 162 fn test-word-at-gap-single-word-with-gap-at-start { + 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 + 167 # + 168 var out-storage: (stream byte 0x10) + 169 var out/eax: (addr stream byte) <- address out-storage + 170 word-at-gap g, out + 171 check-stream-equal out, "abc", "F - test-word-at-gap-single-word-with-gap-at-start" + 172 } + 173 + 174 fn test-word-at-gap-multiple-words-with-gap-at-non-word-grapheme-at-end { + 175 var _g: gap-buffer + 176 var g/esi: (addr gap-buffer) <- address _g + 177 initialize-gap-buffer-with g, "abc " + 178 # gap is at end (right is empty) + 179 var out-storage: (stream byte 0x10) + 180 var out/eax: (addr stream byte) <- address out-storage + 181 word-at-gap g, out + 182 check-stream-equal out, "", "F - test-word-at-gap-multiple-words-with-gap-at-non-word-grapheme-at-end" + 183 } + 184 + 185 fn test-word-at-gap-multiple-words-with-gap-at-non-word-grapheme-at-start { + 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 + 190 # + 191 var out-storage: (stream byte 0x10) + 192 var out/eax: (addr stream byte) <- address out-storage + 193 word-at-gap g, out + 194 check-stream-equal out, "", "F - test-word-at-gap-multiple-words-with-gap-at-non-word-grapheme-at-start" + 195 } + 196 + 197 fn test-word-at-gap-multiple-words-with-gap-at-end { + 198 var _g: gap-buffer + 199 var g/esi: (addr gap-buffer) <- address _g + 200 initialize-gap-buffer-with g, "a bc d" + 201 # gap is at end (right is empty) + 202 var out-storage: (stream byte 0x10) + 203 var out/eax: (addr stream byte) <- address out-storage + 204 word-at-gap g, out + 205 check-stream-equal out, "d", "F - test-word-at-gap-multiple-words-with-gap-at-end" + 206 } + 207 + 208 fn test-word-at-gap-multiple-words-with-gap-at-initial-word { + 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 + 213 # + 214 var out-storage: (stream byte 0x10) + 215 var out/eax: (addr stream byte) <- address out-storage + 216 word-at-gap g, out + 217 check-stream-equal out, "a", "F - test-word-at-gap-multiple-words-with-gap-at-initial-word" + 218 } + 219 + 220 fn test-word-at-gap-multiple-words-with-gap-at-final-word { + 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 + 225 # gap is at final word + 226 var out-storage: (stream byte 0x10) + 227 var out/eax: (addr stream byte) <- address out-storage + 228 word-at-gap g, out + 229 check-stream-equal out, "d", "F - test-word-at-gap-multiple-words-with-gap-at-final-word" + 230 } + 231 + 232 fn test-word-at-gap-multiple-words-with-gap-at-final-non-word { + 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 + 237 # gap is at final word + 238 var out-storage: (stream byte 0x10) + 239 var out/eax: (addr stream byte) <- address out-storage + 240 word-at-gap g, out + 241 check-stream-equal out, "", "F - test-word-at-gap-multiple-words-with-gap-at-final-non-word" + 242 } + 243 + 244 fn grapheme-at-gap _self: (addr gap-buffer) -> _/eax: grapheme { + 245 # send top of right most of the time + 246 var self/esi: (addr gap-buffer) <- copy _self + 247 var right/edi: (addr grapheme-stack) <- get self, right + 248 var data-ah/eax: (addr handle array grapheme) <- get right, data + 249 var data/eax: (addr array grapheme) <- lookup *data-ah + 250 var top-addr/ecx: (addr int) <- get right, top + 251 { + 252 compare *top-addr, 0 + 253 break-if-<= + 254 var top/ecx: int <- copy *top-addr + 255 top <- decrement + 256 var result/eax: (addr grapheme) <- index data, top + 257 return *result + 258 } + 259 # send top of left only if right is empty + 260 var left/edi: (addr grapheme-stack) <- get self, left + 261 var data-ah/eax: (addr handle array grapheme) <- get left, data + 262 var data/eax: (addr array grapheme) <- lookup *data-ah + 263 var top-addr/ecx: (addr int) <- get left, top + 264 { + 265 compare *top-addr, 0 + 266 break-if-<= + 267 var top/ecx: int <- copy *top-addr + 268 top <- decrement + 269 var result/eax: (addr grapheme) <- index data, top + 270 return *result + 271 } + 272 # send null if everything is empty + 273 return 0 + 274 } + 275 + 276 fn top-most-word _self: (addr grapheme-stack) -> _/eax: int { + 277 var self/esi: (addr grapheme-stack) <- copy _self + 278 var data-ah/edi: (addr handle array grapheme) <- get self, data + 279 var _data/eax: (addr array grapheme) <- lookup *data-ah + 280 var data/edi: (addr array grapheme) <- copy _data + 281 var top-addr/ecx: (addr int) <- get self, top + 282 var i/ebx: int <- copy *top-addr + 283 i <- decrement + 284 { + 285 compare i, 0 + 286 break-if-< + 287 var g/edx: (addr grapheme) <- index data, i + 288 var is-word?/eax: boolean <- is-ascii-word-grapheme? *g + 289 compare is-word?, 0/false + 290 break-if-= + 291 i <- decrement + 292 loop + 293 } + 294 i <- increment + 295 return i + 296 } + 297 + 298 fn emit-stack-from-index _self: (addr grapheme-stack), start: int, out: (addr stream byte) { + 299 var self/esi: (addr grapheme-stack) <- copy _self + 300 var data-ah/edi: (addr handle array grapheme) <- get self, data + 301 var _data/eax: (addr array grapheme) <- lookup *data-ah + 302 var data/edi: (addr array grapheme) <- copy _data + 303 var top-addr/ecx: (addr int) <- get self, top + 304 var i/eax: int <- copy start + 305 { + 306 compare i, *top-addr + 307 break-if->= + 308 var g/edx: (addr grapheme) <- index data, i + 309 write-grapheme out, *g + 310 i <- increment + 311 loop + 312 } + 313 } + 314 + 315 fn emit-stack-to-index _self: (addr grapheme-stack), end: int, out: (addr stream byte) { + 316 var self/esi: (addr grapheme-stack) <- copy _self + 317 var data-ah/edi: (addr handle array grapheme) <- get self, data + 318 var _data/eax: (addr array grapheme) <- lookup *data-ah + 319 var data/edi: (addr array grapheme) <- copy _data + 320 var top-addr/ecx: (addr int) <- get self, top + 321 var i/eax: int <- copy *top-addr + 322 i <- decrement + 323 { + 324 compare i, 0 + 325 break-if-< + 326 compare i, end + 327 break-if-< + 328 var g/edx: (addr grapheme) <- index data, i + 329 write-grapheme out, *g + 330 i <- decrement + 331 loop + 332 } + 333 } + 334 + 335 fn is-ascii-word-grapheme? g: grapheme -> _/eax: boolean { + 336 compare g, 0x21/! + 337 { + 338 break-if-!= + 339 return 1/true + 340 } + 341 compare g, 0x30/0 + 342 { + 343 break-if->= + 344 return 0/false + 345 } + 346 compare g, 0x39/9 + 347 { + 348 break-if-> + 349 return 1/true + 350 } + 351 compare g, 0x3f/? + 352 { + 353 break-if-!= + 354 return 1/true + 355 } + 356 compare g, 0x41/A + 357 { + 358 break-if->= + 359 return 0/false + 360 } + 361 compare g, 0x5a/Z + 362 { + 363 break-if-> + 364 return 1/true + 365 } + 366 compare g, 0x5f/_ + 367 { + 368 break-if-!= + 369 return 1/true + 370 } + 371 compare g, 0x61/a + 372 { + 373 break-if->= + 374 return 0/false + 375 } + 376 compare g, 0x7a/z + 377 { + 378 break-if-> + 379 return 1/true + 380 } + 381 return 0/false + 382 } + 383 + 384 # We implicitly render everything editable in a single color, and assume the + 385 # cursor is a single other color. + 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 + 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? + 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 + 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 + 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 + 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 + 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 + 777 var x/ecx: int <- copy g + 778 check-ints-equal x, 0x63/c, "F - test-gap-index/right-3" 779 } 780 - 781 fn peek-from-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { - 782 var self/esi: (addr gap-buffer) <- copy _self - 783 # more in left? - 784 var left/ecx: (addr grapheme-stack) <- get self, left - 785 var left-size/eax: int <- grapheme-stack-length left - 786 var left-read-index-a/edx: (addr int) <- get self, left-read-index - 787 compare *left-read-index-a, left-size - 788 { - 789 break-if->= - 790 var left-data-ah/eax: (addr handle array grapheme) <- get left, data - 791 var left-data/eax: (addr array grapheme) <- lookup *left-data-ah - 792 var left-read-index/ecx: int <- copy *left-read-index-a - 793 var result/eax: (addr grapheme) <- index left-data, left-read-index - 794 return *result - 795 } - 796 # more in right? - 797 var right/ecx: (addr grapheme-stack) <- get self, right - 798 var _right-size/eax: int <- grapheme-stack-length right - 799 var right-size/ebx: int <- copy _right-size - 800 var right-read-index-a/edx: (addr int) <- get self, right-read-index - 801 compare *right-read-index-a, right-size - 802 { - 803 break-if->= - 804 # read the right from reverse - 805 var right-data-ah/eax: (addr handle array grapheme) <- get right, data - 806 var right-data/eax: (addr array grapheme) <- lookup *right-data-ah - 807 var right-read-index/ebx: int <- copy right-size - 808 right-read-index <- subtract *right-read-index-a - 809 right-read-index <- subtract 1 - 810 var result/eax: (addr grapheme) <- index right-data, right-read-index - 811 return *result - 812 } - 813 # if we get here there's nothing left - 814 return 0/nul - 815 } - 816 - 817 fn read-from-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { - 818 var self/esi: (addr gap-buffer) <- copy _self - 819 # more in left? - 820 var left/ecx: (addr grapheme-stack) <- get self, left - 821 var left-size/eax: int <- grapheme-stack-length left - 822 var left-read-index-a/edx: (addr int) <- get self, left-read-index - 823 compare *left-read-index-a, left-size - 824 { - 825 break-if->= - 826 var left-data-ah/eax: (addr handle array grapheme) <- get left, data - 827 var left-data/eax: (addr array grapheme) <- lookup *left-data-ah - 828 var left-read-index/ecx: int <- copy *left-read-index-a - 829 var result/eax: (addr grapheme) <- index left-data, left-read-index - 830 increment *left-read-index-a - 831 return *result - 832 } - 833 # more in right? - 834 var right/ecx: (addr grapheme-stack) <- get self, right - 835 var _right-size/eax: int <- grapheme-stack-length right - 836 var right-size/ebx: int <- copy _right-size - 837 var right-read-index-a/edx: (addr int) <- get self, right-read-index - 838 compare *right-read-index-a, right-size - 839 { - 840 break-if->= - 841 # read the right from reverse - 842 var right-data-ah/eax: (addr handle array grapheme) <- get right, data - 843 var right-data/eax: (addr array grapheme) <- lookup *right-data-ah - 844 var right-read-index/ebx: int <- copy right-size - 845 right-read-index <- subtract *right-read-index-a - 846 right-read-index <- subtract 1 - 847 var result/eax: (addr grapheme) <- index right-data, right-read-index - 848 increment *right-read-index-a - 849 return *result - 850 } - 851 # if we get here there's nothing left - 852 return 0/nul - 853 } - 854 - 855 fn test-read-from-gap-buffer { - 856 var gap-storage: gap-buffer - 857 var gap/esi: (addr gap-buffer) <- address gap-storage - 858 initialize-gap-buffer-with gap, "abc" - 859 # gap is at end, all contents are in left - 860 var done?/eax: boolean <- gap-buffer-scan-done? gap - 861 check-not done?, "F - test-read-from-gap-buffer/left-1/done" - 862 var g/eax: grapheme <- read-from-gap-buffer gap - 863 var x/ecx: int <- copy g - 864 check-ints-equal x, 0x61/a, "F - test-read-from-gap-buffer/left-1" - 865 var done?/eax: boolean <- gap-buffer-scan-done? gap - 866 check-not done?, "F - test-read-from-gap-buffer/left-2/done" - 867 var g/eax: grapheme <- read-from-gap-buffer gap - 868 var x/ecx: int <- copy g - 869 check-ints-equal x, 0x62/b, "F - test-read-from-gap-buffer/left-2" - 870 var done?/eax: boolean <- gap-buffer-scan-done? gap - 871 check-not done?, "F - test-read-from-gap-buffer/left-3/done" - 872 var g/eax: grapheme <- read-from-gap-buffer gap - 873 var x/ecx: int <- copy g - 874 check-ints-equal x, 0x63/c, "F - test-read-from-gap-buffer/left-3" - 875 var done?/eax: boolean <- gap-buffer-scan-done? gap - 876 check done?, "F - test-read-from-gap-buffer/left-4/done" - 877 var g/eax: grapheme <- read-from-gap-buffer gap - 878 var x/ecx: int <- copy g - 879 check-ints-equal x, 0/nul, "F - test-read-from-gap-buffer/left-4" - 880 # now check when everything is to the right - 881 gap-to-start gap - 882 rewind-gap-buffer gap - 883 var done?/eax: boolean <- gap-buffer-scan-done? gap - 884 check-not done?, "F - test-read-from-gap-buffer/right-1/done" - 885 var g/eax: grapheme <- read-from-gap-buffer gap - 886 var x/ecx: int <- copy g - 887 check-ints-equal x, 0x61/a, "F - test-read-from-gap-buffer/right-1" - 888 var done?/eax: boolean <- gap-buffer-scan-done? gap - 889 check-not done?, "F - test-read-from-gap-buffer/right-2/done" - 890 var g/eax: grapheme <- read-from-gap-buffer gap - 891 var x/ecx: int <- copy g - 892 check-ints-equal x, 0x62/b, "F - test-read-from-gap-buffer/right-2" - 893 var done?/eax: boolean <- gap-buffer-scan-done? gap - 894 check-not done?, "F - test-read-from-gap-buffer/right-3/done" - 895 var g/eax: grapheme <- read-from-gap-buffer gap - 896 var x/ecx: int <- copy g - 897 check-ints-equal x, 0x63/c, "F - test-read-from-gap-buffer/right-3" - 898 var done?/eax: boolean <- gap-buffer-scan-done? gap - 899 check done?, "F - test-read-from-gap-buffer/right-4/done" - 900 var g/eax: grapheme <- read-from-gap-buffer gap - 901 var x/ecx: int <- copy g - 902 check-ints-equal x, 0/nul, "F - test-read-from-gap-buffer/right-4" - 903 } - 904 - 905 fn skip-whitespace-from-gap-buffer self: (addr gap-buffer) { - 906 var done?/eax: boolean <- gap-buffer-scan-done? self - 907 compare done?, 0/false - 908 break-if-!= - 909 var g/eax: grapheme <- peek-from-gap-buffer self - 910 { - 911 compare g, 0x20/space - 912 break-if-= - 913 compare g, 0xa/newline - 914 break-if-= - 915 return - 916 } - 917 g <- read-from-gap-buffer self - 918 loop - 919 } - 920 - 921 fn edit-gap-buffer self: (addr gap-buffer), key: grapheme { - 922 var g/edx: grapheme <- copy key - 923 { - 924 compare g, 8/backspace - 925 break-if-!= - 926 delete-before-gap self - 927 return - 928 } - 929 { - 930 compare g, 0x80/left-arrow - 931 break-if-!= - 932 var dummy/eax: grapheme <- gap-left self - 933 return - 934 } - 935 { - 936 compare g, 0x83/right-arrow - 937 break-if-!= - 938 var dummy/eax: grapheme <- gap-right self - 939 return - 940 } - 941 { - 942 compare g, 6/ctrl-f - 943 break-if-!= - 944 gap-to-start-of-next-word self - 945 return + 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 { - 948 compare g, 2/ctrl-b - 949 break-if-!= - 950 gap-to-end-of-previous-word self - 951 return - 952 } - 953 { - 954 compare g, 1/ctrl-a - 955 break-if-!= - 956 gap-to-previous-start-of-line self - 957 return - 958 } - 959 { - 960 compare g, 5/ctrl-e - 961 break-if-!= - 962 gap-to-next-end-of-line self - 963 return - 964 } - 965 { - 966 compare g, 0x81/down-arrow - 967 break-if-!= - 968 gap-down self - 969 return - 970 } - 971 { - 972 compare g, 0x82/up-arrow - 973 break-if-!= - 974 gap-up self - 975 return - 976 } - 977 { - 978 compare g, 0x15/ctrl-u - 979 break-if-!= - 980 clear-gap-buffer self - 981 return - 982 } - 983 { - 984 compare g, 9/tab - 985 break-if-!= - 986 # tab = 2 spaces - 987 add-code-point-at-gap self, 0x20/space - 988 add-code-point-at-gap self, 0x20/space - 989 return - 990 } - 991 # default: insert character - 992 add-grapheme-at-gap self, g - 993 } - 994 - 995 fn gap-to-start-of-next-word self: (addr gap-buffer) { - 996 var curr/eax: grapheme <- copy 0 - 997 # skip to next space - 998 { - 999 curr <- gap-right self -1000 compare curr, -1 -1001 break-if-= -1002 compare curr, 0x20/space -1003 break-if-= -1004 compare curr, 0xa/newline -1005 break-if-= -1006 loop -1007 } -1008 # skip past spaces -1009 { -1010 curr <- gap-right self -1011 compare curr, -1 -1012 break-if-= -1013 compare curr, 0x20/space -1014 loop-if-= -1015 compare curr, 0xa/space -1016 loop-if-= -1017 curr <- gap-left self -1018 break -1019 } -1020 } -1021 -1022 fn gap-to-end-of-previous-word self: (addr gap-buffer) { -1023 var curr/eax: grapheme <- copy 0 -1024 # skip to previous space -1025 { -1026 curr <- gap-left self -1027 compare curr, -1 -1028 break-if-= -1029 compare curr, 0x20/space -1030 break-if-= -1031 compare curr, 0xa/newline -1032 break-if-= -1033 loop -1034 } -1035 # skip past all spaces but one + 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 curr <- gap-left self -1038 compare curr, -1 -1039 break-if-= -1040 compare curr, 0x20/space -1041 loop-if-= -1042 compare curr, 0xa/space -1043 loop-if-= -1044 curr <- gap-right self -1045 break -1046 } -1047 } -1048 -1049 fn gap-to-previous-start-of-line self: (addr gap-buffer) { -1050 # skip past immediate newline -1051 var dummy/eax: grapheme <- gap-left self -1052 # skip to previous newline -1053 { -1054 dummy <- gap-left self -1055 { -1056 compare dummy, -1 -1057 break-if-!= -1058 return -1059 } -1060 { -1061 compare dummy, 0xa/newline -1062 break-if-!= -1063 dummy <- gap-right self -1064 return -1065 } -1066 loop -1067 } -1068 } -1069 -1070 fn gap-to-next-end-of-line self: (addr gap-buffer) { -1071 # skip past immediate newline -1072 var dummy/eax: grapheme <- gap-right self -1073 # skip to next newline -1074 { -1075 dummy <- gap-right self -1076 { -1077 compare dummy, -1 -1078 break-if-!= -1079 return -1080 } -1081 { -1082 compare dummy, 0xa/newline -1083 break-if-!= -1084 dummy <- gap-left self -1085 return -1086 } -1087 loop -1088 } -1089 } -1090 -1091 fn gap-up self: (addr gap-buffer) { -1092 # compute column -1093 var col/edx: int <- count-columns-to-start-of-line self -1094 # -1095 gap-to-previous-start-of-line self -1096 # skip ahead by up to col on previous line -1097 var i/ecx: int <- copy 0 -1098 { -1099 compare i, col -1100 break-if->= -1101 var curr/eax: grapheme <- gap-right self -1102 { -1103 compare curr, -1 -1104 break-if-!= -1105 return -1106 } -1107 compare curr, 0xa/newline -1108 { -1109 break-if-!= -1110 curr <- gap-left self -1111 return -1112 } -1113 i <- increment -1114 loop -1115 } +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 gap-down self: (addr gap-buffer) { -1119 # compute column -1120 var col/edx: int <- count-columns-to-start-of-line self -1121 # skip to start of next line -1122 gap-to-end-of-line self -1123 var dummy/eax: grapheme <- gap-right self -1124 # skip ahead by up to col on previous line -1125 var i/ecx: int <- copy 0 -1126 { -1127 compare i, col -1128 break-if->= -1129 var curr/eax: grapheme <- gap-right self -1130 { -1131 compare curr, -1 -1132 break-if-!= -1133 return -1134 } -1135 compare curr, 0xa/newline -1136 { -1137 break-if-!= -1138 curr <- gap-left self -1139 return -1140 } -1141 i <- increment -1142 loop -1143 } -1144 } -1145 -1146 fn count-columns-to-start-of-line self: (addr gap-buffer) -> _/edx: int { -1147 var count/edx: int <- copy 0 -1148 var dummy/eax: grapheme <- copy 0 -1149 # skip to previous newline -1150 { -1151 dummy <- gap-left self -1152 { -1153 compare dummy, -1 -1154 break-if-!= -1155 return count -1156 } -1157 { -1158 compare dummy, 0xa/newline -1159 break-if-!= -1160 dummy <- gap-right self -1161 return count -1162 } -1163 count <- increment -1164 loop -1165 } -1166 return count -1167 } -1168 -1169 fn gap-to-end-of-line self: (addr gap-buffer) { -1170 var dummy/eax: grapheme <- copy 0 -1171 # skip to next newline -1172 { -1173 dummy <- gap-right self -1174 { -1175 compare dummy, -1 -1176 break-if-!= -1177 return -1178 } -1179 { -1180 compare dummy, 0xa/newline -1181 break-if-!= -1182 dummy <- gap-left self -1183 return -1184 } -1185 loop -1186 } -1187 } +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 +1393 { +1394 compare curr, -1 +1395 break-if-!= +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 +1415 { +1416 compare dummy, -1 +1417 break-if-!= +1418 return count +1419 } +1420 { +1421 compare dummy, 0xa/newline +1422 break-if-!= +1423 dummy <- gap-right self +1424 return count +1425 } +1426 count <- increment +1427 loop +1428 } +1429 return count +1430 } +1431 +1432 fn gap-to-end-of-line self: (addr gap-buffer) { +1433 var dummy/eax: grapheme <- copy 0 +1434 # skip to next newline +1435 { +1436 dummy <- gap-right self +1437 { +1438 compare dummy, -1 +1439 break-if-!= +1440 return +1441 } +1442 { +1443 compare dummy, 0xa/newline +1444 break-if-!= +1445 dummy <- gap-left self +1446 return +1447 } +1448 loop +1449 } +1450 } diff --git a/html/shell/global.mu.html b/html/shell/global.mu.html index ba1551ce..e1472c81 100644 --- a/html/shell/global.mu.html +++ b/html/shell/global.mu.html @@ -14,14 +14,20 @@ 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; } .LineNr { } -.CommentedCode { color: #8a8a8a; } -.Constant { color: #008787; } -.muComment { color: #005faf; } .Delimiter { color: #c000c0; } .muFunction { color: #af5f00; text-decoration: underline; } +.muRegEbx { color: #8787af; } +.muRegEsi { color: #87d787; } +.muRegEdi { color: #87ffd7; } +.Constant { color: #008787; } .Special { color: #ff6060; } +.PreProc { color: #c000c0; } +.CommentedCode { color: #8a8a8a; } +.muComment { color: #005faf; } +.muRegEax { color: #875f00; } +.muRegEcx { color: #af875f; } +.muRegEdx { color: #878700; } --> @@ -57,2086 +63,595 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/main/shell/global.mu 
-   1 type global {
-   2   name: (handle array byte)
-   3   input: (handle gap-buffer)
-   4   value: (handle cell)
-   5 }
-   6 
-   7 type global-table {
-   8   data: (handle array global)
-   9   final-index: int
-  10 }
-  11 
-  12 fn initialize-globals _self: (addr global-table) {
-  13   var self/esi: (addr global-table) <- copy _self
-  14   compare self, 0
-  15   {
-  16     break-if-!=
-  17     abort "initialize globals"
-  18     return
-  19   }
-  20   var data-ah/eax: (addr handle array global) <- get self, data
-  21   populate data-ah, 0x40
-  22   # for numbers
-  23   append-primitive self, "+"
-  24   append-primitive self, "-"
-  25   append-primitive self, "*"
-  26   append-primitive self, "/"
-  27   append-primitive self, "sqrt"
-  28   append-primitive self, "abs"
-  29   append-primitive self, "sgn"
-  30   append-primitive self, "<"
-  31   append-primitive self, ">"
-  32   append-primitive self, "<="
-  33   append-primitive self, ">="
-  34   # generic
-  35   append-primitive self, "="
-  36   append-primitive self, "no"
-  37   append-primitive self, "not"
-  38   append-primitive self, "dbg"
-  39   # for pairs
-  40   append-primitive self, "car"
-  41   append-primitive self, "cdr"
-  42   append-primitive self, "cons"
-  43   # for screens
-  44   append-primitive self, "print"
-  45   append-primitive self, "clear"
-  46   append-primitive self, "lines"
-  47   append-primitive self, "columns"
-  48   append-primitive self, "up"
-  49   append-primitive self, "down"
-  50   append-primitive self, "left"
-  51   append-primitive self, "right"
-  52   append-primitive self, "cr"
-  53   append-primitive self, "pixel"
-  54   append-primitive self, "width"
-  55   append-primitive self, "height"
-  56   # for keyboards
-  57   append-primitive self, "key"
-  58   # for streams
-  59   append-primitive self, "stream"
-  60   append-primitive self, "write"
-  61   # misc
-  62   append-primitive self, "abort"
-  63   # keep sync'd with render-primitives
-  64 }
-  65 
-  66 fn load-globals in: (addr handle cell), self: (addr global-table) {
-  67   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading globals:", 3/fg, 0/bg
-  68   var remaining-ah/esi: (addr handle cell) <- copy in
-  69   {
-  70     var _remaining/eax: (addr cell) <- lookup *remaining-ah
-  71     var remaining/ebx: (addr cell) <- copy _remaining
-  72     var done?/eax: boolean <- nil? remaining
-  73     compare done?, 0/false
-  74     break-if-!=
-  75 #?     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "b", 2/fg 0/bg
-  76     var curr-ah/eax: (addr handle cell) <- get remaining, left
-  77     var _curr/eax: (addr cell) <- lookup *curr-ah
-  78     var curr/ecx: (addr cell) <- copy _curr
-  79     remaining-ah <- get remaining, right
-  80     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " ", 2/fg 0/bg
-  81     var name-ah/eax: (addr handle cell) <- get curr, left
-  82     var name/eax: (addr cell) <- lookup *name-ah
-  83     var name-data-ah/eax: (addr handle stream byte) <- get name, text-data
-  84     var _name-data/eax: (addr stream byte) <- lookup *name-data-ah
-  85     var name-data/edx: (addr stream byte) <- copy _name-data
-  86     rewind-stream name-data
-  87     draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, name-data, 3/fg, 0/bg
-  88     var value-ah/eax: (addr handle cell) <- get curr, right
-  89     var value/eax: (addr cell) <- lookup *value-ah
-  90     var value-data-ah/eax: (addr handle stream byte) <- get value, text-data
-  91     var _value-data/eax: (addr stream byte) <- lookup *value-data-ah
-  92     var value-data/ecx: (addr stream byte) <- copy _value-data
-  93     var value-gap-buffer-storage: (handle gap-buffer)
-  94     var value-gap-buffer-ah/edi: (addr handle gap-buffer) <- address value-gap-buffer-storage
-  95     allocate value-gap-buffer-ah
-  96     var value-gap-buffer/eax: (addr gap-buffer) <- lookup *value-gap-buffer-ah
-  97     initialize-gap-buffer value-gap-buffer, 0x1000/4KB
-  98 #?     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "w", 2/fg 0/bg
-  99     load-gap-buffer-from-stream value-gap-buffer, value-data
- 100 #?     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "x", 2/fg 0/bg
- 101     read-evaluate-and-move-to-globals value-gap-buffer-ah, self, name-data
- 102 #?     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "y", 2/fg 0/bg
- 103     loop
- 104   }
- 105   move-cursor-to-left-margin-of-next-line 0/screen
- 106 #?   abort "zz"
- 107 }
- 108 
- 109 fn write-globals out: (addr stream byte), _self: (addr global-table) {
- 110   var self/esi: (addr global-table) <- copy _self
- 111   compare self, 0
- 112   {
- 113     break-if-!=
- 114     abort "write globals"
- 115     return
- 116   }
- 117   write out, "  (globals . (\n"
- 118   var data-ah/eax: (addr handle array global) <- get self, data
- 119   var data/eax: (addr array global) <- lookup *data-ah
- 120   var final-index/edx: (addr int) <- get self, final-index
- 121   var curr-index/ecx: int <- copy 1/skip-0
- 122   {
- 123     compare curr-index, *final-index
- 124     break-if->
- 125     var curr-offset/ebx: (offset global) <- compute-offset data, curr-index
- 126     var curr/ebx: (addr global) <- index data, curr-offset
- 127     var curr-value-ah/edx: (addr handle cell) <- get curr, value
- 128     var curr-value/eax: (addr cell) <- lookup *curr-value-ah
- 129     var curr-type/eax: (addr int) <- get curr-value, type
- 130     {
- 131       compare *curr-type, 4/primitive-function
- 132       break-if-=
- 133       compare *curr-type, 5/screen
- 134       break-if-=
- 135       compare *curr-type, 6/keyboard
- 136       break-if-=
- 137       compare *curr-type, 3/stream  # not implemented yet
- 138       break-if-=
- 139       write out, "    ("
- 140       var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 141       var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
- 142       write out, curr-name
- 143       write out, " . ["
- 144       var curr-input-ah/eax: (addr handle gap-buffer) <- get curr, input
- 145       var curr-input/eax: (addr gap-buffer) <- lookup *curr-input-ah
- 146       append-gap-buffer curr-input, out
- 147       write out, "])\n"
- 148     }
- 149     curr-index <- increment
- 150     loop
- 151   }
- 152   write out, "  ))\n"
- 153 }
- 154 
- 155 # globals layout: 1 char padding, 41 code, 1 padding, 41 code, 1 padding =  85 chars
- 156 fn render-globals screen: (addr screen), _self: (addr global-table) {
- 157   clear-rect screen, 0/xmin, 0/ymin, 0x55/xmax, 0x2f/ymax=screen-height-without-menu, 0xdc/bg=green-bg
- 158   var self/esi: (addr global-table) <- copy _self
- 159   compare self, 0
- 160   {
- 161     break-if-!=
- 162     abort "render globals"
- 163     return
- 164   }
- 165   # render primitives
- 166   render-primitives screen, 1/xmin=padding-left, 0x55/xmax, 0x2f/ymax
- 167   var data-ah/eax: (addr handle array global) <- get self, data
- 168   var data/eax: (addr array global) <- lookup *data-ah
- 169   var curr-index/edx: int <- copy 1
- 170   {
- 171     var curr-offset/ebx: (offset global) <- compute-offset data, curr-index
- 172     var curr/ebx: (addr global) <- index data, curr-offset
- 173     var continue?/eax: boolean <- primitive-global? curr
- 174     compare continue?, 0/false
- 175     break-if-=
- 176     curr-index <- increment
- 177     loop
- 178   }
- 179   var lowest-index/edi: int <- copy curr-index
- 180   var final-index/edx: (addr int) <- get self, final-index
- 181   var curr-index/edx: int <- copy *final-index
- 182   var y1: int
- 183   copy-to y1, 1/padding-top
- 184   var y2: int
- 185   copy-to y2, 1/padding-top
- 186   $render-globals:loop: {
- 187     compare curr-index, lowest-index
- 188     break-if-<
- 189     {
- 190       compare y1, 0x2f/ymax
- 191       break-if-<
- 192       compare y2, 0x2f/ymax
- 193       break-if-<
- 194       break $render-globals:loop
- 195     }
- 196     {
- 197       var curr-offset/edx: (offset global) <- compute-offset data, curr-index
- 198       var curr/edx: (addr global) <- index data, curr-offset
- 199       var curr-input-ah/edx: (addr handle gap-buffer) <- get curr, input
- 200       var _curr-input/eax: (addr gap-buffer) <- lookup *curr-input-ah
- 201       var curr-input/ebx: (addr gap-buffer) <- copy _curr-input
- 202       compare curr-input, 0
- 203       break-if-=
- 204       $render-globals:render-global: {
- 205         var x/eax: int <- copy 0
- 206         var y/ecx: int <- copy y1
- 207         compare y, y2
- 208         {
- 209           break-if->=
- 210           x, y <- render-gap-buffer-wrapping-right-then-down screen, curr-input, 1/padding-left, y1, 0x2a/xmax, 0x2f/ymax, 0/no-cursor, 7/fg=definition, 0xc5/bg=blue-bg
- 211           y <- add 2
- 212           copy-to y1, y
- 213           break $render-globals:render-global
- 214         }
- 215         x, y <- render-gap-buffer-wrapping-right-then-down screen, curr-input, 0x2b/xmin, y2, 0x54/xmax, 0x2f/ymax, 0/no-cursor, 7/fg=definition, 0xc5/bg=blue-bg
- 216         y <- add 2
- 217         copy-to y2, y
- 218       }
- 219     }
- 220     curr-index <- decrement
- 221     loop
- 222   }
- 223 }
- 224 
- 225 fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
- 226   var y/ecx: int <- copy ymax
- 227   y <- subtract 0xf
- 228   var tmpx/eax: int <- copy xmin
- 229   tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 230   y <- increment
- 231   var tmpx/eax: int <- copy xmin
- 232   tmpx <- draw-text-rightward screen, "  print", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 233   tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 234   y <- increment
- 235   var tmpx/eax: int <- copy xmin
- 236   tmpx <- draw-text-rightward screen, "  lines columns", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 237   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 238   y <- increment
- 239   var tmpx/eax: int <- copy xmin
- 240   tmpx <- draw-text-rightward screen, "  up down left right", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 241   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 242   y <- increment
- 243   var tmpx/eax: int <- copy xmin
- 244   tmpx <- draw-text-rightward screen, "  cr", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 245   tmpx <- draw-text-rightward screen, ": screen   ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 246   tmpx <- draw-text-rightward screen, "# move cursor down and to left margin", tmpx, xmax, y, 0x38/fg=trace, 0xdc/bg=green-bg
- 247   y <- increment
- 248   var tmpx/eax: int <- copy xmin
- 249   tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 250   y <- increment
- 251   var tmpx/eax: int <- copy xmin
- 252   tmpx <- draw-text-rightward screen, "  width height", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 253   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 254   y <- increment
- 255   var tmpx/eax: int <- copy xmin
- 256   tmpx <- draw-text-rightward screen, "  pixel", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 257   tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 258   y <- increment
- 259   var tmpx/eax: int <- copy xmin
- 260   tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 261   y <- increment
- 262   var tmpx/eax: int <- copy xmin
- 263   tmpx <- draw-text-rightward screen, "  clear", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 264   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 265   y <- increment
- 266   var tmpx/eax: int <- copy xmin
- 267   tmpx <- draw-text-rightward screen, "  key", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 268   tmpx <- draw-text-rightward screen, ": () -> grapheme?", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 269   y <- increment
- 270   var tmpx/eax: int <- copy xmin
- 271   tmpx <- draw-text-rightward screen, "streams", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 272   y <- increment
- 273   var tmpx/eax: int <- copy xmin
- 274   tmpx <- draw-text-rightward screen, "  stream", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 275   tmpx <- draw-text-rightward screen, ": () -> stream ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 276   y <- increment
- 277   var tmpx/eax: int <- copy xmin
- 278   tmpx <- draw-text-rightward screen, "  write", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 279   tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 280   y <- increment
- 281   var tmpx/eax: int <- copy xmin
- 282   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
- 283   tmpx <- draw-text-rightward screen, "num: ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
- 284   tmpx <- draw-text-rightward screen, "+ - * / sqrt abs sgn < > <= >=   ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
- 285 }
- 286 
- 287 fn primitive-global? _x: (addr global) -> _/eax: boolean {
- 288   var x/eax: (addr global) <- copy _x
- 289   var value-ah/eax: (addr handle cell) <- get x, value
- 290   var value/eax: (addr cell) <- lookup *value-ah
- 291   compare value, 0/null
- 292   {
- 293     break-if-!=
- 294     return 0/false
- 295   }
- 296   var value-type/eax: (addr int) <- get value, type
- 297   compare *value-type, 4/primitive
- 298   {
- 299     break-if-=
- 300     return 0/false
- 301   }
- 302   return 1/true
- 303 }
- 304 
- 305 fn append-primitive _self: (addr global-table), name: (addr array byte) {
- 306   var self/esi: (addr global-table) <- copy _self
- 307   compare self, 0
- 308   {
- 309     break-if-!=
- 310     abort "append primitive"
- 311     return
- 312   }
- 313   var final-index-addr/ecx: (addr int) <- get self, final-index
- 314   increment *final-index-addr
- 315   var curr-index/ecx: int <- copy *final-index-addr
- 316   var data-ah/eax: (addr handle array global) <- get self, data
- 317   var data/eax: (addr array global) <- lookup *data-ah
- 318   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
- 319   var curr/esi: (addr global) <- index data, curr-offset
- 320   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 321   copy-array-object name, curr-name-ah
- 322   var curr-value-ah/eax: (addr handle cell) <- get curr, value
- 323   new-primitive-function curr-value-ah, curr-index
- 324 }
- 325 
- 326 fn assign-or-create-global _self: (addr global-table), name: (addr array byte), value: (handle cell), trace: (addr trace) {
- 327   var self/esi: (addr global-table) <- copy _self
- 328   compare self, 0
- 329   {
- 330     break-if-!=
- 331     abort "assign global"
- 332     return
- 333   }
- 334   var curr-index/ecx: int <- find-symbol-name-in-globals self, name
- 335   {
- 336     compare curr-index, -1/not-found
- 337     break-if-!=
- 338     var final-index-addr/eax: (addr int) <- get self, final-index
- 339     increment *final-index-addr
- 340     curr-index <- copy *final-index-addr
- 341   }
- 342   var data-ah/eax: (addr handle array global) <- get self, data
- 343   var data/eax: (addr array global) <- lookup *data-ah
- 344   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
- 345   var curr/esi: (addr global) <- index data, curr-offset
- 346   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 347   copy-array-object name, curr-name-ah
- 348   var curr-value-ah/eax: (addr handle cell) <- get curr, value
- 349   copy-handle value, curr-value-ah
- 350 }
- 351 
- 352 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) {
- 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
- 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   # if sym is "screen" and screen-cell exists, return it
- 373   {
- 374     var sym-is-screen?/eax: boolean <- stream-data-equal? sym-name, "screen"
- 375     compare sym-is-screen?, 0/false
- 376     break-if-=
- 377     compare screen-cell, 0
- 378     break-if-=
- 379     copy-object screen-cell, out
- 380     return
- 381   }
- 382   # if sym is "keyboard" and keyboard-cell exists, return it
- 383   {
- 384     var sym-is-keyboard?/eax: boolean <- stream-data-equal? sym-name, "keyboard"
- 385     compare sym-is-keyboard?, 0/false
- 386     break-if-=
- 387     compare keyboard-cell, 0
- 388     break-if-=
- 389     copy-object keyboard-cell, out
- 390     return
- 391   }
- 392   # otherwise error "unbound symbol: ", sym
- 393   var stream-storage: (stream byte 0x40)
- 394   var stream/ecx: (addr stream byte) <- address stream-storage
- 395   write stream, "unbound symbol: "
- 396   rewind-stream sym-name
- 397   write-stream stream, sym-name
- 398   error-stream trace, stream
- 399 }
- 400 
- 401 fn maybe-lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
- 402   var sym/eax: (addr cell) <- copy _sym
- 403   var sym-name-ah/eax: (addr handle stream byte) <- get sym, text-data
- 404   var _sym-name/eax: (addr stream byte) <- lookup *sym-name-ah
- 405   var sym-name/edx: (addr stream byte) <- copy _sym-name
- 406   var globals/esi: (addr global-table) <- copy _globals
- 407   {
- 408     compare globals, 0
- 409     break-if-=
- 410     var curr-index/ecx: int <- find-symbol-in-globals globals, sym-name
- 411     compare curr-index, -1/not-found
- 412     break-if-=
- 413     var global-data-ah/eax: (addr handle array global) <- get globals, data
- 414     var global-data/eax: (addr array global) <- lookup *global-data-ah
- 415     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
- 416     var curr/ebx: (addr global) <- index global-data, curr-offset
- 417     var curr-value/eax: (addr handle cell) <- get curr, value
- 418     copy-object curr-value, out
- 419     return
- 420   }
- 421 }
- 422 
- 423 # return the index in globals containing 'sym'
- 424 # or -1 if not found
- 425 fn find-symbol-in-globals _globals: (addr global-table), sym-name: (addr stream byte) -> _/ecx: int {
- 426   var globals/esi: (addr global-table) <- copy _globals
- 427   compare globals, 0
- 428   {
- 429     break-if-!=
- 430     return -1/not-found
- 431   }
- 432   var global-data-ah/eax: (addr handle array global) <- get globals, data
- 433   var global-data/eax: (addr array global) <- lookup *global-data-ah
- 434   var final-index/ecx: (addr int) <- get globals, final-index
- 435   var curr-index/ecx: int <- copy *final-index
- 436   {
- 437     compare curr-index, 0
- 438     break-if-<
- 439     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
- 440     var curr/ebx: (addr global) <- index global-data, curr-offset
- 441     var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 442     var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
- 443     var found?/eax: boolean <- stream-data-equal? sym-name, curr-name
- 444     compare found?, 0/false
- 445     {
- 446       break-if-=
- 447       return curr-index
- 448     }
- 449     curr-index <- decrement
- 450     loop
- 451   }
- 452   return -1/not-found
- 453 }
- 454 
- 455 # return the index in globals containing 'sym'
- 456 # or -1 if not found
- 457 fn find-symbol-name-in-globals _globals: (addr global-table), sym-name: (addr array byte) -> _/ecx: int {
- 458   var globals/esi: (addr global-table) <- copy _globals
- 459   compare globals, 0
- 460   {
- 461     break-if-!=
- 462     return -1/not-found
- 463   }
- 464   var global-data-ah/eax: (addr handle array global) <- get globals, data
- 465   var global-data/eax: (addr array global) <- lookup *global-data-ah
- 466   var final-index/ecx: (addr int) <- get globals, final-index
- 467   var curr-index/ecx: int <- copy *final-index
- 468   {
- 469     compare curr-index, 0
- 470     break-if-<
- 471     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
- 472     var curr/ebx: (addr global) <- index global-data, curr-offset
- 473     var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 474     var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
- 475     var found?/eax: boolean <- string-equal? sym-name, curr-name
- 476     compare found?, 0/false
- 477     {
- 478       break-if-=
- 479       return curr-index
- 480     }
- 481     curr-index <- decrement
- 482     loop
- 483   }
- 484   return -1/not-found
- 485 }
- 486 
- 487 fn mutate-binding-in-globals name: (addr stream byte), val: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
- 488   var globals/esi: (addr global-table) <- copy _globals
- 489   {
- 490     compare globals, 0
- 491     break-if-=
- 492     var curr-index/ecx: int <- find-symbol-in-globals globals, name
- 493     compare curr-index, -1/not-found
- 494     break-if-=
- 495     var global-data-ah/eax: (addr handle array global) <- get globals, data
- 496     var global-data/eax: (addr array global) <- lookup *global-data-ah
- 497     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
- 498     var curr/ebx: (addr global) <- index global-data, curr-offset
- 499     var dest/eax: (addr handle cell) <- get curr, value
- 500     copy-object val, dest
- 501     return
- 502   }
- 503   # otherwise error "unbound symbol: ", sym
- 504   var stream-storage: (stream byte 0x40)
- 505   var stream/ecx: (addr stream byte) <- address stream-storage
- 506   write stream, "unbound symbol: "
- 507   rewind-stream name
- 508   write-stream stream, name
- 509   error-stream trace, stream
- 510 }
- 511 
- 512 # a little strange; goes from value to name and selects primitive based on name
- 513 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
- 514   var f/esi: (addr cell) <- copy _f
- 515   var f-index-a/ecx: (addr int) <- get f, index-data
- 516   var f-index/ecx: int <- copy *f-index-a
- 517   var globals/eax: (addr global-table) <- copy _globals
- 518   compare globals, 0
- 519   {
- 520     break-if-!=
- 521     abort "apply primitive"
- 522     return
- 523   }
- 524   var global-data-ah/eax: (addr handle array global) <- get globals, data
- 525   var global-data/eax: (addr array global) <- lookup *global-data-ah
- 526   var f-offset/ecx: (offset global) <- compute-offset global-data, f-index
- 527   var f-value/ecx: (addr global) <- index global-data, f-offset
- 528   var f-name-ah/ecx: (addr handle array byte) <- get f-value, name
- 529   var f-name/eax: (addr array byte) <- lookup *f-name-ah
- 530   {
- 531     var add?/eax: boolean <- string-equal? f-name, "+"
- 532     compare add?, 0/false
- 533     break-if-=
- 534     apply-add args-ah, out, trace
- 535     return
- 536   }
- 537   {
- 538     var subtract?/eax: boolean <- string-equal? f-name, "-"
- 539     compare subtract?, 0/false
- 540     break-if-=
- 541     apply-subtract args-ah, out, trace
- 542     return
- 543   }
- 544   {
- 545     var multiply?/eax: boolean <- string-equal? f-name, "*"
- 546     compare multiply?, 0/false
- 547     break-if-=
- 548     apply-multiply args-ah, out, trace
- 549     return
- 550   }
- 551   {
- 552     var divide?/eax: boolean <- string-equal? f-name, "/"
- 553     compare divide?, 0/false
- 554     break-if-=
- 555     apply-divide args-ah, out, trace
- 556     return
- 557   }
- 558   {
- 559     var square-root?/eax: boolean <- string-equal? f-name, "sqrt"
- 560     compare square-root?, 0/false
- 561     break-if-=
- 562     apply-square-root args-ah, out, trace
- 563     return
- 564   }
- 565   {
- 566     var abs?/eax: boolean <- string-equal? f-name, "abs"
- 567     compare abs?, 0/false
- 568     break-if-=
- 569     apply-abs args-ah, out, trace
- 570     return
- 571   }
- 572   {
- 573     var sgn?/eax: boolean <- string-equal? f-name, "sgn"
- 574     compare sgn?, 0/false
- 575     break-if-=
- 576     apply-sgn args-ah, out, trace
- 577     return
- 578   }
- 579   {
- 580     var car?/eax: boolean <- string-equal? f-name, "car"
- 581     compare car?, 0/false
- 582     break-if-=
- 583     apply-car args-ah, out, trace
- 584     return
- 585   }
- 586   {
- 587     var cdr?/eax: boolean <- string-equal? f-name, "cdr"
- 588     compare cdr?, 0/false
- 589     break-if-=
- 590     apply-cdr args-ah, out, trace
- 591     return
- 592   }
- 593   {
- 594     var cons?/eax: boolean <- string-equal? f-name, "cons"
- 595     compare cons?, 0/false
- 596     break-if-=
- 597     apply-cons args-ah, out, trace
- 598     return
- 599   }
- 600   {
- 601     var structurally-equal?/eax: boolean <- string-equal? f-name, "="
- 602     compare structurally-equal?, 0/false
- 603     break-if-=
- 604     apply-structurally-equal args-ah, out, trace
- 605     return
- 606   }
- 607   {
- 608     var not?/eax: boolean <- string-equal? f-name, "no"
- 609     compare not?, 0/false
- 610     break-if-=
- 611     apply-not args-ah, out, trace
- 612     return
- 613   }
- 614   {
- 615     var not?/eax: boolean <- string-equal? f-name, "not"
- 616     compare not?, 0/false
- 617     break-if-=
- 618     apply-not args-ah, out, trace
- 619     return
- 620   }
- 621   {
- 622     var debug?/eax: boolean <- string-equal? f-name, "dbg"
- 623     compare debug?, 0/false
- 624     break-if-=
- 625     apply-debug args-ah, out, trace
- 626     return
- 627   }
- 628   {
- 629     var lesser?/eax: boolean <- string-equal? f-name, "<"
- 630     compare lesser?, 0/false
- 631     break-if-=
- 632     apply-< args-ah, out, trace
- 633     return
- 634   }
- 635   {
- 636     var greater?/eax: boolean <- string-equal? f-name, ">"
- 637     compare greater?, 0/false
- 638     break-if-=
- 639     apply-> args-ah, out, trace
- 640     return
- 641   }
- 642   {
- 643     var lesser-or-equal?/eax: boolean <- string-equal? f-name, "<="
- 644     compare lesser-or-equal?, 0/false
- 645     break-if-=
- 646     apply-<= args-ah, out, trace
- 647     return
- 648   }
- 649   {
- 650     var greater-or-equal?/eax: boolean <- string-equal? f-name, ">="
- 651     compare greater-or-equal?, 0/false
- 652     break-if-=
- 653     apply->= args-ah, out, trace
- 654     return
- 655   }
- 656   {
- 657     var print?/eax: boolean <- string-equal? f-name, "print"
- 658     compare print?, 0/false
- 659     break-if-=
- 660     apply-print args-ah, out, trace
- 661     return
- 662   }
- 663   {
- 664     var clear?/eax: boolean <- string-equal? f-name, "clear"
- 665     compare clear?, 0/false
- 666     break-if-=
- 667     apply-clear args-ah, out, trace
- 668     return
- 669   }
- 670   {
- 671     var lines?/eax: boolean <- string-equal? f-name, "lines"
- 672     compare lines?, 0/false
- 673     break-if-=
- 674     apply-lines args-ah, out, trace
- 675     return
- 676   }
- 677   {
- 678     var columns?/eax: boolean <- string-equal? f-name, "columns"
- 679     compare columns?, 0/false
- 680     break-if-=
- 681     apply-columns args-ah, out, trace
- 682     return
- 683   }
- 684   {
- 685     var up?/eax: boolean <- string-equal? f-name, "up"
- 686     compare up?, 0/false
- 687     break-if-=
- 688     apply-up args-ah, out, trace
- 689     return
- 690   }
- 691   {
- 692     var down?/eax: boolean <- string-equal? f-name, "down"
- 693     compare down?, 0/false
- 694     break-if-=
- 695     apply-down args-ah, out, trace
- 696     return
- 697   }
- 698   {
- 699     var left?/eax: boolean <- string-equal? f-name, "left"
- 700     compare left?, 0/false
- 701     break-if-=
- 702     apply-left args-ah, out, trace
- 703     return
- 704   }
- 705   {
- 706     var right?/eax: boolean <- string-equal? f-name, "right"
- 707     compare right?, 0/false
- 708     break-if-=
- 709     apply-right args-ah, out, trace
- 710     return
- 711   }
- 712   {
- 713     var cr?/eax: boolean <- string-equal? f-name, "cr"
- 714     compare cr?, 0/false
- 715     break-if-=
- 716     apply-cr args-ah, out, trace
- 717     return
- 718   }
- 719   {
- 720     var pixel?/eax: boolean <- string-equal? f-name, "pixel"
- 721     compare pixel?, 0/false
- 722     break-if-=
- 723     apply-pixel args-ah, out, trace
- 724     return
- 725   }
- 726   {
- 727     var width?/eax: boolean <- string-equal? f-name, "width"
- 728     compare width?, 0/false
- 729     break-if-=
- 730     apply-width args-ah, out, trace
- 731     return
- 732   }
- 733   {
- 734     var height?/eax: boolean <- string-equal? f-name, "height"
- 735     compare height?, 0/false
- 736     break-if-=
- 737     apply-height args-ah, out, trace
- 738     return
- 739   }
- 740   {
- 741     var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
- 742     compare wait-for-key?, 0/false
- 743     break-if-=
- 744     apply-wait-for-key args-ah, out, trace
- 745     return
- 746   }
- 747   {
- 748     var stream?/eax: boolean <- string-equal? f-name, "stream"
- 749     compare stream?, 0/false
- 750     break-if-=
- 751     apply-stream args-ah, out, trace
- 752     return
- 753   }
- 754   {
- 755     var write?/eax: boolean <- string-equal? f-name, "write"
- 756     compare write?, 0/false
- 757     break-if-=
- 758     apply-write args-ah, out, trace
- 759     return
- 760   }
- 761   {
- 762     var abort?/eax: boolean <- string-equal? f-name, "abort"
- 763     compare abort?, 0/false
- 764     break-if-=
- 765     apply-abort args-ah, out, trace
- 766     return
- 767   }
- 768   abort "unknown primitive function"
- 769 }
- 770 
- 771 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 772   trace-text trace, "eval", "apply +"
- 773   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 774   var _args/eax: (addr cell) <- lookup *args-ah
- 775   var args/esi: (addr cell) <- copy _args
- 776   # TODO: check that args is a pair
- 777   var empty-args?/eax: boolean <- nil? args
- 778   compare empty-args?, 0/false
- 779   {
- 780     break-if-=
- 781     error trace, "+ needs 2 args but got 0"
- 782     return
- 783   }
- 784   # args->left->value
- 785   var first-ah/eax: (addr handle cell) <- get args, left
- 786   var first/eax: (addr cell) <- lookup *first-ah
- 787   var first-type/ecx: (addr int) <- get first, type
- 788   compare *first-type, 1/number
- 789   {
- 790     break-if-=
- 791     error trace, "first arg for + is not a number"
- 792     return
- 793   }
- 794   var first-value/ecx: (addr float) <- get first, number-data
- 795   # args->right->left->value
- 796   var right-ah/eax: (addr handle cell) <- get args, right
- 797 #?   dump-cell right-ah
- 798 #?   abort "aaa"
- 799   var right/eax: (addr cell) <- lookup *right-ah
- 800   # TODO: check that right is a pair
- 801   var second-ah/eax: (addr handle cell) <- get right, left
- 802   var second/eax: (addr cell) <- lookup *second-ah
- 803   var second-type/edx: (addr int) <- get second, type
- 804   compare *second-type, 1/number
- 805   {
- 806     break-if-=
- 807     error trace, "second arg for + is not a number"
- 808     return
- 809   }
- 810   var second-value/edx: (addr float) <- get second, number-data
- 811   # add
- 812   var result/xmm0: float <- copy *first-value
- 813   result <- add *second-value
- 814   new-float out, result
- 815 }
- 816 
- 817 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 818   trace-text trace, "eval", "apply -"
- 819   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 820   var _args/eax: (addr cell) <- lookup *args-ah
- 821   var args/esi: (addr cell) <- copy _args
- 822   # TODO: check that args is a pair
- 823   var empty-args?/eax: boolean <- nil? args
- 824   compare empty-args?, 0/false
- 825   {
- 826     break-if-=
- 827     error trace, "- needs 2 args but got 0"
- 828     return
- 829   }
- 830   # args->left->value
- 831   var first-ah/eax: (addr handle cell) <- get args, left
- 832   var first/eax: (addr cell) <- lookup *first-ah
- 833   var first-type/ecx: (addr int) <- get first, type
- 834   compare *first-type, 1/number
- 835   {
- 836     break-if-=
- 837     error trace, "first arg for - is not a number"
- 838     return
- 839   }
- 840   var first-value/ecx: (addr float) <- get first, number-data
- 841   # args->right->left->value
- 842   var right-ah/eax: (addr handle cell) <- get args, right
- 843   var right/eax: (addr cell) <- lookup *right-ah
- 844   # TODO: check that right is a pair
- 845   var second-ah/eax: (addr handle cell) <- get right, left
- 846   var second/eax: (addr cell) <- lookup *second-ah
- 847   var second-type/edx: (addr int) <- get second, type
- 848   compare *second-type, 1/number
- 849   {
- 850     break-if-=
- 851     error trace, "second arg for - is not a number"
- 852     return
- 853   }
- 854   var second-value/edx: (addr float) <- get second, number-data
- 855   # subtract
- 856   var result/xmm0: float <- copy *first-value
- 857   result <- subtract *second-value
- 858   new-float out, result
- 859 }
- 860 
- 861 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 862   trace-text trace, "eval", "apply *"
- 863   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 864   var _args/eax: (addr cell) <- lookup *args-ah
- 865   var args/esi: (addr cell) <- copy _args
- 866   # TODO: check that args is a pair
- 867   var empty-args?/eax: boolean <- nil? args
- 868   compare empty-args?, 0/false
- 869   {
- 870     break-if-=
- 871     error trace, "* needs 2 args but got 0"
- 872     return
- 873   }
- 874   # args->left->value
- 875   var first-ah/eax: (addr handle cell) <- get args, left
- 876   var first/eax: (addr cell) <- lookup *first-ah
- 877   var first-type/ecx: (addr int) <- get first, type
- 878   compare *first-type, 1/number
- 879   {
- 880     break-if-=
- 881     error trace, "first arg for * is not a number"
- 882     return
- 883   }
- 884   var first-value/ecx: (addr float) <- get first, number-data
- 885   # args->right->left->value
- 886   var right-ah/eax: (addr handle cell) <- get args, right
- 887   var right/eax: (addr cell) <- lookup *right-ah
- 888   # TODO: check that right is a pair
- 889   var second-ah/eax: (addr handle cell) <- get right, left
- 890   var second/eax: (addr cell) <- lookup *second-ah
- 891   var second-type/edx: (addr int) <- get second, type
- 892   compare *second-type, 1/number
- 893   {
- 894     break-if-=
- 895     error trace, "second arg for * is not a number"
- 896     return
- 897   }
- 898   var second-value/edx: (addr float) <- get second, number-data
- 899   # multiply
- 900   var result/xmm0: float <- copy *first-value
- 901   result <- multiply *second-value
- 902   new-float out, result
- 903 }
- 904 
- 905 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 906   trace-text trace, "eval", "apply /"
- 907   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 908   var _args/eax: (addr cell) <- lookup *args-ah
- 909   var args/esi: (addr cell) <- copy _args
- 910   # TODO: check that args is a pair
- 911   var empty-args?/eax: boolean <- nil? args
- 912   compare empty-args?, 0/false
- 913   {
- 914     break-if-=
- 915     error trace, "/ needs 2 args but got 0"
- 916     return
- 917   }
- 918   # args->left->value
- 919   var first-ah/eax: (addr handle cell) <- get args, left
- 920   var first/eax: (addr cell) <- lookup *first-ah
- 921   var first-type/ecx: (addr int) <- get first, type
- 922   compare *first-type, 1/number
- 923   {
- 924     break-if-=
- 925     error trace, "first arg for / is not a number"
- 926     return
- 927   }
- 928   var first-value/ecx: (addr float) <- get first, number-data
- 929   # args->right->left->value
- 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/eax: (addr handle cell) <- get right, left
- 934   var second/eax: (addr cell) <- lookup *second-ah
- 935   var second-type/edx: (addr int) <- get second, type
- 936   compare *second-type, 1/number
- 937   {
- 938     break-if-=
- 939     error trace, "second arg for / is not a number"
- 940     return
- 941   }
- 942   var second-value/edx: (addr float) <- get second, number-data
- 943   # divide
- 944   var result/xmm0: float <- copy *first-value
- 945   result <- divide *second-value
- 946   new-float out, result
- 947 }
- 948 
- 949 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 950   trace-text trace, "eval", "apply sqrt"
- 951   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 952   var _args/eax: (addr cell) <- lookup *args-ah
- 953   var args/esi: (addr cell) <- copy _args
- 954   # TODO: check that args is a pair
- 955   var empty-args?/eax: boolean <- nil? args
- 956   compare empty-args?, 0/false
- 957   {
- 958     break-if-=
- 959     error trace, "sqrt needs 1 arg but got 0"
- 960     return
- 961   }
- 962   # args->left->value
- 963   var first-ah/eax: (addr handle cell) <- get args, left
- 964   var first/eax: (addr cell) <- lookup *first-ah
- 965   var first-type/ecx: (addr int) <- get first, type
- 966   compare *first-type, 1/number
- 967   {
- 968     break-if-=
- 969     error trace, "arg for sqrt is not a number"
- 970     return
- 971   }
- 972   var first-value/ecx: (addr float) <- get first, number-data
- 973   # square-root
- 974   var result/xmm0: float <- square-root *first-value
- 975   new-float out, result
- 976 }
- 977 
- 978 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 979   trace-text trace, "eval", "apply abs"
- 980   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 981   var _args/eax: (addr cell) <- lookup *args-ah
- 982   var args/esi: (addr cell) <- copy _args
- 983   # TODO: check that args is a pair
- 984   var empty-args?/eax: boolean <- nil? args
- 985   compare empty-args?, 0/false
- 986   {
- 987     break-if-=
- 988     error trace, "abs needs 1 arg but got 0"
- 989     return
- 990   }
- 991   # args->left->value
- 992   var first-ah/eax: (addr handle cell) <- get args, left
- 993   var first/eax: (addr cell) <- lookup *first-ah
- 994   var first-type/ecx: (addr int) <- get first, type
- 995   compare *first-type, 1/number
- 996   {
- 997     break-if-=
- 998     error trace, "arg for abs is not a number"
- 999     return
-1000   }
-1001   var first-value/ecx: (addr float) <- get first, number-data
-1002   #
-1003   var result/xmm0: float <- copy *first-value
-1004   var zero: float
-1005   compare result, zero
-1006   {
-1007     break-if-float>=
-1008     var neg1/eax: int <- copy -1
-1009     var neg1-f/xmm1: float <- convert neg1
-1010     result <- multiply neg1-f
-1011   }
-1012   new-float out, result
-1013 }
-1014 
-1015 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1016   trace-text trace, "eval", "apply sgn"
-1017   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1018   var _args/eax: (addr cell) <- lookup *args-ah
-1019   var args/esi: (addr cell) <- copy _args
-1020   # TODO: check that args is a pair
-1021   var empty-args?/eax: boolean <- nil? args
-1022   compare empty-args?, 0/false
-1023   {
-1024     break-if-=
-1025     error trace, "sgn needs 1 arg but got 0"
-1026     return
-1027   }
-1028   # args->left->value
-1029   var first-ah/eax: (addr handle cell) <- get args, left
-1030   var first/eax: (addr cell) <- lookup *first-ah
-1031   var first-type/ecx: (addr int) <- get first, type
-1032   compare *first-type, 1/number
-1033   {
-1034     break-if-=
-1035     error trace, "arg for sgn is not a number"
-1036     return
-1037   }
-1038   var first-value/ecx: (addr float) <- get first, number-data
-1039   #
-1040   var result/xmm0: float <- copy *first-value
-1041   var zero: float
-1042   $apply-sgn:core: {
-1043     compare result, zero
-1044     break-if-=
-1045     {
-1046       break-if-float>
-1047       var neg1/eax: int <- copy -1
-1048       result <- convert neg1
-1049       break $apply-sgn:core
-1050     }
-1051     {
-1052       break-if-float<
-1053       var one/eax: int <- copy 1
-1054       result <- convert one
-1055       break $apply-sgn:core
-1056     }
-1057   }
-1058   new-float out, result
-1059 }
-1060 
-1061 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1062   trace-text trace, "eval", "apply car"
-1063   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1064   var _args/eax: (addr cell) <- lookup *args-ah
-1065   var args/esi: (addr cell) <- copy _args
-1066   # TODO: check that args is a pair
-1067   var empty-args?/eax: boolean <- nil? args
-1068   compare empty-args?, 0/false
-1069   {
-1070     break-if-=
-1071     error trace, "car needs 1 arg but got 0"
-1072     return
-1073   }
-1074   # args->left
-1075   var first-ah/eax: (addr handle cell) <- get args, left
-1076   var first/eax: (addr cell) <- lookup *first-ah
-1077   var first-type/ecx: (addr int) <- get first, type
-1078   compare *first-type, 0/pair
-1079   {
-1080     break-if-=
-1081     error trace, "arg for car is not a pair"
-1082     return
-1083   }
-1084   # car
-1085   var result/eax: (addr handle cell) <- get first, left
-1086   copy-object result, out
-1087 }
-1088 
-1089 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1090   trace-text trace, "eval", "apply cdr"
-1091   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1092   var _args/eax: (addr cell) <- lookup *args-ah
-1093   var args/esi: (addr cell) <- copy _args
-1094   # TODO: check that args is a pair
-1095   var empty-args?/eax: boolean <- nil? args
-1096   compare empty-args?, 0/false
-1097   {
-1098     break-if-=
-1099     error trace, "cdr 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   var first-type/ecx: (addr int) <- get first, type
-1106   compare *first-type, 0/pair
-1107   {
-1108     break-if-=
-1109     error trace, "arg for cdr is not a pair"
-1110     return
-1111   }
-1112   # cdr
-1113   var result/eax: (addr handle cell) <- get first, right
-1114   copy-object result, out
-1115 }
-1116 
-1117 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1118   trace-text trace, "eval", "apply cons"
-1119   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1120   var _args/eax: (addr cell) <- lookup *args-ah
-1121   var args/esi: (addr cell) <- copy _args
-1122   # TODO: check that args is a pair
-1123   var empty-args?/eax: boolean <- nil? args
-1124   compare empty-args?, 0/false
-1125   {
-1126     break-if-=
-1127     error trace, "cons needs 2 args but got 0"
-1128     return
-1129   }
-1130   # args->left
-1131   var first-ah/ecx: (addr handle cell) <- get args, left
-1132   # args->right->left
-1133   var right-ah/eax: (addr handle cell) <- get args, right
-1134   var right/eax: (addr cell) <- lookup *right-ah
-1135   # TODO: check that right is a pair
-1136   var second-ah/eax: (addr handle cell) <- get right, left
-1137   # cons
-1138   new-pair out, *first-ah, *second-ah
-1139 }
-1140 
-1141 fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1142   trace-text trace, "eval", "apply '='"
-1143   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1144   var _args/eax: (addr cell) <- lookup *args-ah
-1145   var args/esi: (addr cell) <- copy _args
-1146   # TODO: check that args is a pair
-1147   var empty-args?/eax: boolean <- nil? args
-1148   compare empty-args?, 0/false
-1149   {
-1150     break-if-=
-1151     error trace, "'=' needs 2 args but got 0"
-1152     return
-1153   }
-1154   # args->left
-1155   var first-ah/ecx: (addr handle cell) <- get args, left
-1156   # args->right->left
-1157   var right-ah/eax: (addr handle cell) <- get args, right
-1158   var right/eax: (addr cell) <- lookup *right-ah
-1159   # TODO: check that right is a pair
-1160   var second-ah/edx: (addr handle cell) <- get right, left
-1161   # compare
-1162   var _first/eax: (addr cell) <- lookup *first-ah
-1163   var first/ecx: (addr cell) <- copy _first
-1164   var second/eax: (addr cell) <- lookup *second-ah
-1165   var match?/eax: boolean <- cell-isomorphic? first, second, trace
-1166   compare match?, 0/false
-1167   {
-1168     break-if-!=
-1169     nil out
-1170     return
-1171   }
-1172   new-integer out, 1/true
-1173 }
-1174 
-1175 fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1176   trace-text trace, "eval", "apply not"
-1177   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1178   var _args/eax: (addr cell) <- lookup *args-ah
-1179   var args/esi: (addr cell) <- copy _args
-1180   # TODO: check that args is a pair
-1181   var empty-args?/eax: boolean <- nil? args
-1182   compare empty-args?, 0/false
-1183   {
-1184     break-if-=
-1185     error trace, "not needs 1 arg but got 0"
-1186     return
-1187   }
-1188   # args->left
-1189   var first-ah/eax: (addr handle cell) <- get args, left
-1190   var first/eax: (addr cell) <- lookup *first-ah
-1191   # not
-1192   var nil?/eax: boolean <- nil? first
-1193   compare nil?, 0/false
-1194   {
-1195     break-if-!=
-1196     nil out
-1197     return
-1198   }
-1199   new-integer out, 1
-1200 }
-1201 
-1202 fn apply-debug _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1203   trace-text trace, "eval", "apply debug"
-1204   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1205   var _args/eax: (addr cell) <- lookup *args-ah
-1206   var args/esi: (addr cell) <- copy _args
-1207   # TODO: check that args is a pair
-1208   var empty-args?/eax: boolean <- nil? args
-1209   compare empty-args?, 0/false
-1210   {
-1211     break-if-=
-1212     error trace, "not needs 1 arg but got 0"
-1213     return
-1214   }
-1215   # dump args->left uglily to screen and wait for a keypress
-1216   var first-ah/eax: (addr handle cell) <- get args, left
-1217   dump-cell-from-cursor-over-full-screen first-ah
-1218   {
-1219     var foo/eax: byte <- read-key 0/keyboard
-1220     compare foo, 0
-1221     loop-if-=
-1222   }
-1223   # return nothing
-1224 }
-1225 
-1226 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1227   trace-text trace, "eval", "apply '<'"
-1228   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1229   var _args/eax: (addr cell) <- lookup *args-ah
-1230   var args/esi: (addr cell) <- copy _args
-1231   # TODO: check that args is a pair
-1232   var empty-args?/eax: boolean <- nil? args
-1233   compare empty-args?, 0/false
-1234   {
-1235     break-if-=
-1236     error trace, "'<' needs 2 args but got 0"
-1237     return
-1238   }
-1239   # args->left
-1240   var first-ah/ecx: (addr handle cell) <- get args, left
-1241   # args->right->left
-1242   var right-ah/eax: (addr handle cell) <- get args, right
-1243   var right/eax: (addr cell) <- lookup *right-ah
-1244   # TODO: check that right is a pair
-1245   var second-ah/edx: (addr handle cell) <- get right, left
-1246   # compare
-1247   var _first/eax: (addr cell) <- lookup *first-ah
-1248   var first/ecx: (addr cell) <- copy _first
-1249   var first-type/eax: (addr int) <- get first, type
-1250   compare *first-type, 1/number
-1251   {
-1252     break-if-=
-1253     error trace, "first arg for '<' is not a number"
-1254     return
-1255   }
-1256   var first-value/ecx: (addr float) <- get first, number-data
-1257   var first-float/xmm0: float <- copy *first-value
-1258   var second/eax: (addr cell) <- lookup *second-ah
-1259   var second-type/edx: (addr int) <- get second, type
-1260   compare *second-type, 1/number
-1261   {
-1262     break-if-=
-1263     error trace, "first arg for '<' is not a number"
-1264     return
-1265   }
-1266   var second-value/eax: (addr float) <- get second, number-data
-1267   compare first-float, *second-value
-1268   {
-1269     break-if-float<
-1270     nil out
-1271     return
-1272   }
-1273   new-integer out, 1/true
-1274 }
-1275 
-1276 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1277   trace-text trace, "eval", "apply '>'"
-1278   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1279   var _args/eax: (addr cell) <- lookup *args-ah
-1280   var args/esi: (addr cell) <- copy _args
-1281   # TODO: check that args is a pair
-1282   var empty-args?/eax: boolean <- nil? args
-1283   compare empty-args?, 0/false
-1284   {
-1285     break-if-=
-1286     error trace, "'>' needs 2 args but got 0"
-1287     return
-1288   }
-1289   # args->left
-1290   var first-ah/ecx: (addr handle cell) <- get args, left
-1291   # args->right->left
-1292   var right-ah/eax: (addr handle cell) <- get args, right
-1293   var right/eax: (addr cell) <- lookup *right-ah
-1294   # TODO: check that right is a pair
-1295   var second-ah/edx: (addr handle cell) <- get right, left
-1296   # compare
-1297   var _first/eax: (addr cell) <- lookup *first-ah
-1298   var first/ecx: (addr cell) <- copy _first
-1299   var first-type/eax: (addr int) <- get first, type
-1300   compare *first-type, 1/number
-1301   {
-1302     break-if-=
-1303     error trace, "first arg for '>' is not a number"
-1304     return
-1305   }
-1306   var first-value/ecx: (addr float) <- get first, number-data
-1307   var first-float/xmm0: float <- copy *first-value
-1308   var second/eax: (addr cell) <- lookup *second-ah
-1309   var second-type/edx: (addr int) <- get second, type
-1310   compare *second-type, 1/number
-1311   {
-1312     break-if-=
-1313     error trace, "first arg for '>' is not a number"
-1314     return
-1315   }
-1316   var second-value/eax: (addr float) <- get second, number-data
-1317   compare first-float, *second-value
-1318   {
-1319     break-if-float>
-1320     nil out
-1321     return
-1322   }
-1323   new-integer out, 1/true
-1324 }
-1325 
-1326 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1327   trace-text trace, "eval", "apply '<='"
-1328   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1329   var _args/eax: (addr cell) <- lookup *args-ah
-1330   var args/esi: (addr cell) <- copy _args
-1331   # TODO: check that args is a pair
-1332   var empty-args?/eax: boolean <- nil? args
-1333   compare empty-args?, 0/false
-1334   {
-1335     break-if-=
-1336     error trace, "'<=' needs 2 args but got 0"
-1337     return
-1338   }
-1339   # args->left
-1340   var first-ah/ecx: (addr handle cell) <- get args, left
-1341   # args->right->left
-1342   var right-ah/eax: (addr handle cell) <- get args, right
-1343   var right/eax: (addr cell) <- lookup *right-ah
-1344   # TODO: check that right is a pair
-1345   var second-ah/edx: (addr handle cell) <- get right, left
-1346   # compare
-1347   var _first/eax: (addr cell) <- lookup *first-ah
-1348   var first/ecx: (addr cell) <- copy _first
-1349   var first-type/eax: (addr int) <- get first, type
-1350   compare *first-type, 1/number
-1351   {
-1352     break-if-=
-1353     error trace, "first arg for '<=' is not a number"
-1354     return
-1355   }
-1356   var first-value/ecx: (addr float) <- get first, number-data
-1357   var first-float/xmm0: float <- copy *first-value
-1358   var second/eax: (addr cell) <- lookup *second-ah
-1359   var second-type/edx: (addr int) <- get second, type
-1360   compare *second-type, 1/number
-1361   {
-1362     break-if-=
-1363     error trace, "first arg for '<=' is not a number"
-1364     return
-1365   }
-1366   var second-value/eax: (addr float) <- get second, number-data
-1367   compare first-float, *second-value
-1368   {
-1369     break-if-float<=
-1370     nil out
-1371     return
-1372   }
-1373   new-integer out, 1/true
-1374 }
-1375 
-1376 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1377   trace-text trace, "eval", "apply '>='"
-1378   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1379   var _args/eax: (addr cell) <- lookup *args-ah
-1380   var args/esi: (addr cell) <- copy _args
-1381   # TODO: check that args is a pair
-1382   var empty-args?/eax: boolean <- nil? args
-1383   compare empty-args?, 0/false
-1384   {
-1385     break-if-=
-1386     error trace, "'>=' needs 2 args but got 0"
-1387     return
-1388   }
-1389   # args->left
-1390   var first-ah/ecx: (addr handle cell) <- get args, left
-1391   # args->right->left
-1392   var right-ah/eax: (addr handle cell) <- get args, right
-1393   var right/eax: (addr cell) <- lookup *right-ah
-1394   # TODO: check that right is a pair
-1395   var second-ah/edx: (addr handle cell) <- get right, left
-1396   # compare
-1397   var _first/eax: (addr cell) <- lookup *first-ah
-1398   var first/ecx: (addr cell) <- copy _first
-1399   var first-type/eax: (addr int) <- get first, type
-1400   compare *first-type, 1/number
-1401   {
-1402     break-if-=
-1403     error trace, "first arg for '>=' is not a number"
-1404     return
-1405   }
-1406   var first-value/ecx: (addr float) <- get first, number-data
-1407   var first-float/xmm0: float <- copy *first-value
-1408   var second/eax: (addr cell) <- lookup *second-ah
-1409   var second-type/edx: (addr int) <- get second, type
-1410   compare *second-type, 1/number
-1411   {
-1412     break-if-=
-1413     error trace, "first arg for '>=' is not a number"
-1414     return
-1415   }
-1416   var second-value/eax: (addr float) <- get second, number-data
-1417   compare first-float, *second-value
-1418   {
-1419     break-if-float>=
-1420     nil out
-1421     return
-1422   }
-1423   new-integer out, 1/true
-1424 }
-1425 
-1426 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1427   trace-text trace, "eval", "apply print"
-1428   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1429   var _args/eax: (addr cell) <- lookup *args-ah
-1430   var args/esi: (addr cell) <- copy _args
-1431   # TODO: check that args is a pair
-1432   var empty-args?/eax: boolean <- nil? args
-1433   compare empty-args?, 0/false
-1434   {
-1435     break-if-=
-1436     error trace, "print needs 2 args but got 0"
-1437     return
-1438   }
-1439   # screen = args->left
-1440   var first-ah/eax: (addr handle cell) <- get args, left
-1441   var first/eax: (addr cell) <- lookup *first-ah
-1442   var first-type/ecx: (addr int) <- get first, type
-1443   compare *first-type, 5/screen
-1444   {
-1445     break-if-=
-1446     error trace, "first arg for 'print' is not a screen"
-1447     return
-1448   }
-1449   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1450   var _screen/eax: (addr screen) <- lookup *screen-ah
-1451   var screen/ecx: (addr screen) <- copy _screen
-1452   # args->right->left
-1453   var right-ah/eax: (addr handle cell) <- get args, right
-1454   var right/eax: (addr cell) <- lookup *right-ah
-1455   # TODO: check that right is a pair
-1456   var second-ah/eax: (addr handle cell) <- get right, left
-1457   var stream-storage: (stream byte 0x100)
-1458   var stream/edi: (addr stream byte) <- address stream-storage
-1459   print-cell second-ah, stream, trace
-1460   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
-1461   # return what was printed
-1462   copy-object second-ah, out
-1463 }
-1464 
-1465 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1466   trace-text trace, "eval", "apply clear"
-1467   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1468   var _args/eax: (addr cell) <- lookup *args-ah
-1469   var args/esi: (addr cell) <- copy _args
-1470   # TODO: check that args is a pair
-1471   var empty-args?/eax: boolean <- nil? args
-1472   compare empty-args?, 0/false
-1473   {
-1474     break-if-=
-1475     error trace, "'clear' needs 1 arg but got 0"
-1476     return
-1477   }
-1478   # screen = args->left
-1479   var first-ah/eax: (addr handle cell) <- get args, left
-1480   var first/eax: (addr cell) <- lookup *first-ah
-1481   var first-type/ecx: (addr int) <- get first, type
-1482   compare *first-type, 5/screen
-1483   {
-1484     break-if-=
-1485     error trace, "first arg for 'clear' is not a screen"
-1486     return
-1487   }
-1488   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1489   var _screen/eax: (addr screen) <- lookup *screen-ah
-1490   var screen/ecx: (addr screen) <- copy _screen
-1491   #
-1492   clear-screen screen
-1493 }
-1494 
-1495 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1496   trace-text trace, "eval", "apply up"
-1497   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1498   var _args/eax: (addr cell) <- lookup *args-ah
-1499   var args/esi: (addr cell) <- copy _args
-1500   # TODO: check that args is a pair
-1501   var empty-args?/eax: boolean <- nil? args
-1502   compare empty-args?, 0/false
-1503   {
-1504     break-if-=
-1505     error trace, "'up' needs 1 arg but got 0"
-1506     return
-1507   }
-1508   # screen = args->left
-1509   var first-ah/eax: (addr handle cell) <- get args, left
-1510   var first/eax: (addr cell) <- lookup *first-ah
-1511   var first-type/ecx: (addr int) <- get first, type
-1512   compare *first-type, 5/screen
-1513   {
-1514     break-if-=
-1515     error trace, "first arg for 'up' is not a screen"
-1516     return
-1517   }
-1518   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1519   var _screen/eax: (addr screen) <- lookup *screen-ah
-1520   var screen/ecx: (addr screen) <- copy _screen
-1521   #
-1522   move-cursor-up screen
-1523 }
-1524 
-1525 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1526   trace-text trace, "eval", "apply 'down'"
-1527   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1528   var _args/eax: (addr cell) <- lookup *args-ah
-1529   var args/esi: (addr cell) <- copy _args
-1530   # TODO: check that args is a pair
-1531   var empty-args?/eax: boolean <- nil? args
-1532   compare empty-args?, 0/false
-1533   {
-1534     break-if-=
-1535     error trace, "'down' needs 1 arg but got 0"
-1536     return
-1537   }
-1538   # screen = args->left
-1539   var first-ah/eax: (addr handle cell) <- get args, left
-1540   var first/eax: (addr cell) <- lookup *first-ah
-1541   var first-type/ecx: (addr int) <- get first, type
-1542   compare *first-type, 5/screen
-1543   {
-1544     break-if-=
-1545     error trace, "first arg for 'down' is not a screen"
-1546     return
-1547   }
-1548   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1549   var _screen/eax: (addr screen) <- lookup *screen-ah
-1550   var screen/ecx: (addr screen) <- copy _screen
-1551   #
-1552   move-cursor-down screen
-1553 }
-1554 
-1555 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1556   trace-text trace, "eval", "apply 'left'"
-1557   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1558   var _args/eax: (addr cell) <- lookup *args-ah
-1559   var args/esi: (addr cell) <- copy _args
-1560   # TODO: check that args is a pair
-1561   var empty-args?/eax: boolean <- nil? args
-1562   compare empty-args?, 0/false
-1563   {
-1564     break-if-=
-1565     error trace, "'left' needs 1 arg but got 0"
-1566     return
-1567   }
-1568   # screen = args->left
-1569   var first-ah/eax: (addr handle cell) <- get args, left
-1570   var first/eax: (addr cell) <- lookup *first-ah
-1571   var first-type/ecx: (addr int) <- get first, type
-1572   compare *first-type, 5/screen
-1573   {
-1574     break-if-=
-1575     error trace, "first arg for 'left' is not a screen"
-1576     return
-1577   }
-1578   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1579   var _screen/eax: (addr screen) <- lookup *screen-ah
-1580   var screen/ecx: (addr screen) <- copy _screen
-1581   #
-1582   move-cursor-left screen
-1583 }
-1584 
-1585 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1586   trace-text trace, "eval", "apply 'right'"
-1587   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1588   var _args/eax: (addr cell) <- lookup *args-ah
-1589   var args/esi: (addr cell) <- copy _args
-1590   # TODO: check that args is a pair
-1591   var empty-args?/eax: boolean <- nil? args
-1592   compare empty-args?, 0/false
-1593   {
-1594     break-if-=
-1595     error trace, "'right' needs 1 arg but got 0"
-1596     return
-1597   }
-1598   # screen = args->left
-1599   var first-ah/eax: (addr handle cell) <- get args, left
-1600   var first/eax: (addr cell) <- lookup *first-ah
-1601   var first-type/ecx: (addr int) <- get first, type
-1602   compare *first-type, 5/screen
-1603   {
-1604     break-if-=
-1605     error trace, "first arg for 'right' is not a screen"
-1606     return
-1607   }
-1608   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1609   var _screen/eax: (addr screen) <- lookup *screen-ah
-1610   var screen/ecx: (addr screen) <- copy _screen
-1611   #
-1612   move-cursor-right screen
-1613 }
-1614 
-1615 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1616   trace-text trace, "eval", "apply 'cr'"
-1617   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1618   var _args/eax: (addr cell) <- lookup *args-ah
-1619   var args/esi: (addr cell) <- copy _args
-1620   # TODO: check that args is a pair
-1621   var empty-args?/eax: boolean <- nil? args
-1622   compare empty-args?, 0/false
-1623   {
-1624     break-if-=
-1625     error trace, "'cr' needs 1 arg but got 0"
-1626     return
-1627   }
-1628   # screen = args->left
-1629   var first-ah/eax: (addr handle cell) <- get args, left
-1630   var first/eax: (addr cell) <- lookup *first-ah
-1631   var first-type/ecx: (addr int) <- get first, type
-1632   compare *first-type, 5/screen
-1633   {
-1634     break-if-=
-1635     error trace, "first arg for 'cr' is not a screen"
-1636     return
-1637   }
-1638   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1639   var _screen/eax: (addr screen) <- lookup *screen-ah
-1640   var screen/ecx: (addr screen) <- copy _screen
-1641   #
-1642   move-cursor-to-left-margin-of-next-line screen
-1643 }
-1644 
-1645 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1646   trace-text trace, "eval", "apply pixel"
-1647   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1648   var _args/eax: (addr cell) <- lookup *args-ah
-1649   var args/esi: (addr cell) <- copy _args
-1650   # TODO: check that args is a pair
-1651   var empty-args?/eax: boolean <- nil? args
-1652   compare empty-args?, 0/false
-1653   {
-1654     break-if-=
-1655     error trace, "pixel needs 4 args but got 0"
-1656     return
-1657   }
-1658   # screen = args->left
-1659   var first-ah/eax: (addr handle cell) <- get args, left
-1660   var first/eax: (addr cell) <- lookup *first-ah
-1661   var first-type/ecx: (addr int) <- get first, type
-1662   compare *first-type, 5/screen
-1663   {
-1664     break-if-=
-1665     error trace, "first arg for 'pixel' is not a screen"
-1666     return
-1667   }
-1668   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1669   var _screen/eax: (addr screen) <- lookup *screen-ah
-1670   var screen/edi: (addr screen) <- copy _screen
-1671   # x = args->right->left->value
-1672   var rest-ah/eax: (addr handle cell) <- get args, right
-1673   var _rest/eax: (addr cell) <- lookup *rest-ah
-1674   var rest/esi: (addr cell) <- copy _rest
-1675   # TODO: check that rest is a pair
-1676   var second-ah/eax: (addr handle cell) <- get rest, left
-1677   var second/eax: (addr cell) <- lookup *second-ah
-1678   var second-type/ecx: (addr int) <- get second, type
-1679   compare *second-type, 1/number
-1680   {
-1681     break-if-=
-1682     error trace, "second arg for 'pixel' is not an int (x coordinate)"
-1683     return
-1684   }
-1685   var second-value/eax: (addr float) <- get second, number-data
-1686   var x/edx: int <- convert *second-value
-1687   # y = rest->right->left->value
-1688   var rest-ah/eax: (addr handle cell) <- get rest, right
-1689   var _rest/eax: (addr cell) <- lookup *rest-ah
-1690   rest <- copy _rest
-1691   # TODO: check that rest is a pair
-1692   var third-ah/eax: (addr handle cell) <- get rest, left
-1693   var third/eax: (addr cell) <- lookup *third-ah
-1694   var third-type/ecx: (addr int) <- get third, type
-1695   compare *third-type, 1/number
-1696   {
-1697     break-if-=
-1698     error trace, "third arg for 'pixel' is not an int (y coordinate)"
-1699     return
-1700   }
-1701   var third-value/eax: (addr float) <- get third, number-data
-1702   var y/ebx: int <- convert *third-value
-1703   # color = rest->right->left->value
-1704   var rest-ah/eax: (addr handle cell) <- get rest, right
-1705   var _rest/eax: (addr cell) <- lookup *rest-ah
-1706   rest <- copy _rest
-1707   # TODO: check that rest is a pair
-1708   var fourth-ah/eax: (addr handle cell) <- get rest, left
-1709   var fourth/eax: (addr cell) <- lookup *fourth-ah
-1710   var fourth-type/ecx: (addr int) <- get fourth, type
-1711   compare *fourth-type, 1/number
-1712   {
-1713     break-if-=
-1714     error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)"
-1715     return
-1716   }
-1717   var fourth-value/eax: (addr float) <- get fourth, number-data
-1718   var color/eax: int <- convert *fourth-value
-1719   pixel screen, x, y, color
-1720   # return nothing
-1721 }
-1722 
-1723 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1724   trace-text trace, "eval", "apply key"
-1725   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1726   var _args/eax: (addr cell) <- lookup *args-ah
-1727   var args/esi: (addr cell) <- copy _args
-1728   # TODO: check that args is a pair
-1729   var empty-args?/eax: boolean <- nil? args
-1730   compare empty-args?, 0/false
-1731   {
-1732     break-if-=
-1733     error trace, "key needs 1 arg but got 0"
-1734     return
-1735   }
-1736   # keyboard = args->left
-1737   var first-ah/eax: (addr handle cell) <- get args, left
-1738   var first/eax: (addr cell) <- lookup *first-ah
-1739   var first-type/ecx: (addr int) <- get first, type
-1740   compare *first-type, 6/keyboard
-1741   {
-1742     break-if-=
-1743     error trace, "first arg for 'key' is not a keyboard"
-1744     return
-1745   }
-1746   var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
-1747   var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
-1748   var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
-1749   var result/eax: int <- wait-for-key keyboard
-1750   # return key typed
-1751   new-integer out, result
-1752 }
-1753 
-1754 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
-1755   # if keyboard is 0, use real keyboard
-1756   {
-1757     compare keyboard, 0/real-keyboard
-1758     break-if-!=
-1759     var key/eax: byte <- read-key 0/real-keyboard
-1760     var result/eax: int <- copy key
-1761     return result
-1762   }
-1763   # otherwise read from fake keyboard
-1764   var g/eax: grapheme <- read-from-gap-buffer keyboard
-1765   var result/eax: int <- copy g
-1766   return result
-1767 }
-1768 
-1769 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1770   trace-text trace, "eval", "apply stream"
-1771   allocate-stream out
-1772 }
-1773 
-1774 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1775   trace-text trace, "eval", "apply write"
-1776   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1777   var _args/eax: (addr cell) <- lookup *args-ah
-1778   var args/esi: (addr cell) <- copy _args
-1779   # TODO: check that args is a pair
-1780   var empty-args?/eax: boolean <- nil? args
-1781   compare empty-args?, 0/false
-1782   {
-1783     break-if-=
-1784     error trace, "write needs 2 args but got 0"
-1785     return
-1786   }
-1787   # stream = args->left
-1788   var first-ah/edx: (addr handle cell) <- get args, left
-1789   var first/eax: (addr cell) <- lookup *first-ah
-1790   var first-type/ecx: (addr int) <- get first, type
-1791   compare *first-type, 3/stream
-1792   {
-1793     break-if-=
-1794     error trace, "first arg for 'write' is not a stream"
-1795     return
-1796   }
-1797   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
-1798   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
-1799   var stream-data/ebx: (addr stream byte) <- copy _stream-data
-1800   # args->right->left
-1801   var right-ah/eax: (addr handle cell) <- get args, right
-1802   var right/eax: (addr cell) <- lookup *right-ah
-1803   # TODO: check that right is a pair
-1804   var second-ah/eax: (addr handle cell) <- get right, left
-1805   var second/eax: (addr cell) <- lookup *second-ah
-1806   var second-type/ecx: (addr int) <- get second, type
-1807   compare *second-type, 1/number
-1808   {
-1809     break-if-=
-1810     error trace, "second arg for stream is not a number/grapheme"
-1811     return
-1812   }
-1813   var second-value/eax: (addr float) <- get second, number-data
-1814   var x-float/xmm0: float <- copy *second-value
-1815   var x/eax: int <- convert x-float
-1816   var x-grapheme/eax: grapheme <- copy x
-1817   write-grapheme stream-data, x-grapheme
-1818   # return the stream
-1819   copy-object first-ah, out
-1820 }
-1821 
-1822 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1823   trace-text trace, "eval", "apply lines"
-1824   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1825   var _args/eax: (addr cell) <- lookup *args-ah
-1826   var args/esi: (addr cell) <- copy _args
-1827   # TODO: check that args is a pair
-1828   var empty-args?/eax: boolean <- nil? args
-1829   compare empty-args?, 0/false
-1830   {
-1831     break-if-=
-1832     error trace, "lines needs 1 arg but got 0"
-1833     return
-1834   }
-1835   # screen = args->left
-1836   var first-ah/eax: (addr handle cell) <- get args, left
-1837   var first/eax: (addr cell) <- lookup *first-ah
-1838   var first-type/ecx: (addr int) <- get first, type
-1839   compare *first-type, 5/screen
-1840   {
-1841     break-if-=
-1842     error trace, "first arg for 'lines' is not a screen"
-1843     return
-1844   }
-1845   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1846   var _screen/eax: (addr screen) <- lookup *screen-ah
-1847   var screen/edx: (addr screen) <- copy _screen
-1848   # compute dimensions
-1849   var dummy/eax: int <- copy 0
-1850   var height/ecx: int <- copy 0
-1851   dummy, height <- screen-size screen
-1852   var result/xmm0: float <- convert height
-1853   new-float out, result
-1854 }
-1855 
-1856 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1857   abort "aa"
-1858 }
-1859 
-1860 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1861   trace-text trace, "eval", "apply columns"
-1862   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1863   var _args/eax: (addr cell) <- lookup *args-ah
-1864   var args/esi: (addr cell) <- copy _args
-1865   # TODO: check that args is a pair
-1866   var empty-args?/eax: boolean <- nil? args
-1867   compare empty-args?, 0/false
-1868   {
-1869     break-if-=
-1870     error trace, "columns needs 1 arg but got 0"
-1871     return
-1872   }
-1873   # screen = args->left
-1874   var first-ah/eax: (addr handle cell) <- get args, left
-1875   var first/eax: (addr cell) <- lookup *first-ah
-1876   var first-type/ecx: (addr int) <- get first, type
-1877   compare *first-type, 5/screen
-1878   {
-1879     break-if-=
-1880     error trace, "first arg for 'columns' is not a screen"
-1881     return
-1882   }
-1883   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1884   var _screen/eax: (addr screen) <- lookup *screen-ah
-1885   var screen/edx: (addr screen) <- copy _screen
-1886   # compute dimensions
-1887   var width/eax: int <- copy 0
-1888   var dummy/ecx: int <- copy 0
-1889   width, dummy <- screen-size screen
-1890   var result/xmm0: float <- convert width
-1891   new-float out, result
-1892 }
-1893 
-1894 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1895   trace-text trace, "eval", "apply width"
-1896   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1897   var _args/eax: (addr cell) <- lookup *args-ah
-1898   var args/esi: (addr cell) <- copy _args
-1899   # TODO: check that args is a pair
-1900   var empty-args?/eax: boolean <- nil? args
-1901   compare empty-args?, 0/false
-1902   {
-1903     break-if-=
-1904     error trace, "width needs 1 arg but got 0"
-1905     return
-1906   }
-1907   # screen = args->left
-1908   var first-ah/eax: (addr handle cell) <- get args, left
-1909   var first/eax: (addr cell) <- lookup *first-ah
-1910   var first-type/ecx: (addr int) <- get first, type
-1911   compare *first-type, 5/screen
-1912   {
-1913     break-if-=
-1914     error trace, "first arg for 'width' is not a screen"
-1915     return
-1916   }
-1917   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1918   var _screen/eax: (addr screen) <- lookup *screen-ah
-1919   var screen/edx: (addr screen) <- copy _screen
-1920   # compute dimensions
-1921   var width/eax: int <- copy 0
-1922   var dummy/ecx: int <- copy 0
-1923   width, dummy <- screen-size screen
-1924   width <- shift-left 3/log2-font-width
-1925   var result/xmm0: float <- convert width
-1926   new-float out, result
-1927 }
-1928 
-1929 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1930   trace-text trace, "eval", "apply height"
-1931   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1932   var _args/eax: (addr cell) <- lookup *args-ah
-1933   var args/esi: (addr cell) <- copy _args
-1934   # TODO: check that args is a pair
-1935   var empty-args?/eax: boolean <- nil? args
-1936   compare empty-args?, 0/false
-1937   {
-1938     break-if-=
-1939     error trace, "height needs 1 arg but got 0"
-1940     return
-1941   }
-1942   # screen = args->left
-1943   var first-ah/eax: (addr handle cell) <- get args, left
-1944   var first/eax: (addr cell) <- lookup *first-ah
-1945   var first-type/ecx: (addr int) <- get first, type
-1946   compare *first-type, 5/screen
-1947   {
-1948     break-if-=
-1949     error trace, "first arg for 'height' is not a screen"
-1950     return
-1951   }
-1952   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1953   var _screen/eax: (addr screen) <- lookup *screen-ah
-1954   var screen/edx: (addr screen) <- copy _screen
-1955   # compute dimensions
-1956   var dummy/eax: int <- copy 0
-1957   var height/ecx: int <- copy 0
-1958   dummy, height <- screen-size screen
-1959   height <- shift-left 4/log2-font-height
-1960   var result/xmm0: float <- convert height
-1961   new-float out, result
-1962 }
-1963 
-1964 # Accepts an input s-expression, naively checks if it is a definition, and if
-1965 # so saves the gap-buffer to the appropriate global, spinning up a new empty
-1966 # one to replace it with.
-1967 fn maybe-stash-gap-buffer-to-global _globals: (addr global-table), _definition-ah: (addr handle cell), gap: (addr handle gap-buffer) {
-1968   # if 'definition' is not a pair, return
-1969   var definition-ah/eax: (addr handle cell) <- copy _definition-ah
-1970   var _definition/eax: (addr cell) <- lookup *definition-ah
-1971   var definition/esi: (addr cell) <- copy _definition
-1972   var definition-type/eax: (addr int) <- get definition, type
-1973   compare *definition-type, 0/pair
-1974   {
-1975     break-if-=
-1976     return
-1977   }
-1978   # if definition->left is neither "def" nor "set", return
-1979   var left-ah/eax: (addr handle cell) <- get definition, left
-1980   var _left/eax: (addr cell) <- lookup *left-ah
-1981   var left/ecx: (addr cell) <- copy _left
-1982   {
-1983     var def?/eax: boolean <- symbol-equal? left, "def"
-1984     compare def?, 0/false
-1985     break-if-!=
-1986     var set?/eax: boolean <- symbol-equal? left, "set"
-1987     compare set?, 0/false
-1988     break-if-!=
-1989     return
-1990   }
-1991   # locate the global for definition->right->left
-1992   var right-ah/eax: (addr handle cell) <- get definition, right
-1993   var right/eax: (addr cell) <- lookup *right-ah
-1994   var defined-symbol-ah/eax: (addr handle cell) <- get right, left
-1995   var defined-symbol/eax: (addr cell) <- lookup *defined-symbol-ah
-1996   var defined-symbol-name-ah/eax: (addr handle stream byte) <- get defined-symbol, text-data
-1997   var defined-symbol-name/eax: (addr stream byte) <- lookup *defined-symbol-name-ah
-1998   var index/ecx: int <- find-symbol-in-globals _globals, defined-symbol-name
-1999   {
-2000     compare index, -1/not-found
-2001     break-if-!=
-2002     return
-2003   }
-2004   # stash 'gap' to it
-2005   var globals/eax: (addr global-table) <- copy _globals
-2006   compare globals, 0
-2007   {
-2008     break-if-!=
-2009     abort "stash to globals"
-2010     return
-2011   }
-2012   var global-data-ah/eax: (addr handle array global) <- get globals, data
-2013   var global-data/eax: (addr array global) <- lookup *global-data-ah
-2014   var offset/ebx: (offset global) <- compute-offset global-data, index
-2015   var dest-global/eax: (addr global) <- index global-data, offset
-2016   var dest-ah/eax: (addr handle gap-buffer) <- get dest-global, input
-2017   copy-object gap, dest-ah
-2018   # initialize a new gap-buffer in 'gap'
-2019   var dest/eax: (addr gap-buffer) <- lookup *dest-ah
-2020   var capacity/ecx: int <- gap-buffer-capacity dest
-2021   var gap2/eax: (addr handle gap-buffer) <- copy gap
-2022   allocate gap2
-2023   var gap-addr/eax: (addr gap-buffer) <- lookup *gap2
-2024   initialize-gap-buffer gap-addr, capacity
-2025 }
-2026 
-2027 # Accepts an input s-expression, naively checks if it is a definition, and if
-2028 # so saves the gap-buffer to the appropriate global.
-2029 fn move-gap-buffer-to-global _globals: (addr global-table), _definition-ah: (addr handle cell), gap: (addr handle gap-buffer) {
-2030   # if 'definition' is not a pair, return
-2031   var definition-ah/eax: (addr handle cell) <- copy _definition-ah
-2032   var _definition/eax: (addr cell) <- lookup *definition-ah
-2033   var definition/esi: (addr cell) <- copy _definition
-2034   var definition-type/eax: (addr int) <- get definition, type
-2035   compare *definition-type, 0/pair
-2036   {
-2037     break-if-=
-2038     return
-2039   }
-2040   # if definition->left is neither "def" nor "set", return
-2041   var left-ah/eax: (addr handle cell) <- get definition, left
-2042   var _left/eax: (addr cell) <- lookup *left-ah
-2043   var left/ecx: (addr cell) <- copy _left
-2044   {
-2045     var def?/eax: boolean <- symbol-equal? left, "def"
-2046     compare def?, 0/false
-2047     break-if-!=
-2048     var set?/eax: boolean <- symbol-equal? left, "set"
-2049     compare set?, 0/false
-2050     break-if-!=
-2051     return
-2052   }
-2053   # locate the global for definition->right->left
-2054   var right-ah/eax: (addr handle cell) <- get definition, right
-2055   var right/eax: (addr cell) <- lookup *right-ah
-2056   var defined-symbol-ah/eax: (addr handle cell) <- get right, left
-2057   var defined-symbol/eax: (addr cell) <- lookup *defined-symbol-ah
-2058   var defined-symbol-name-ah/eax: (addr handle stream byte) <- get defined-symbol, text-data
-2059   var defined-symbol-name/eax: (addr stream byte) <- lookup *defined-symbol-name-ah
-2060   var index/ecx: int <- find-symbol-in-globals _globals, defined-symbol-name
-2061   {
-2062     compare index, -1/not-found
-2063     break-if-!=
-2064     return
-2065   }
-2066   # move 'gap' to it
-2067   var globals/eax: (addr global-table) <- copy _globals
-2068   compare globals, 0
-2069   {
-2070     break-if-!=
-2071     abort "move to globals"
-2072     return
-2073   }
-2074   var global-data-ah/eax: (addr handle array global) <- get globals, data
-2075   var global-data/eax: (addr array global) <- lookup *global-data-ah
-2076   var offset/ebx: (offset global) <- compute-offset global-data, index
-2077   var dest-global/eax: (addr global) <- index global-data, offset
-2078   var dest-ah/eax: (addr handle gap-buffer) <- get dest-global, input
-2079   copy-object gap, dest-ah
-2080 }
+  1 type global-table {
+  2   data: (handle array global)
+  3   final-index: int
+  4   cursor-index: int
+  5 }
+  6 
+  7 type global {
+  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
+ 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
+ 39     remaining-ah <- get remaining, right
+ 40     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " ", 2/fg 0/bg
+ 41     var name-ah/eax: (addr handle cell) <- get curr, left
+ 42     var name/eax: (addr cell) <- lookup *name-ah
+ 43     var name-data-ah/eax: (addr handle stream byte) <- get name, text-data
+ 44     var _name-data/eax: (addr stream byte) <- lookup *name-data-ah
+ 45     var name-data/edx: (addr stream byte) <- copy _name-data
+ 46     rewind-stream name-data
+ 47     draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, name-data, 3/fg, 0/bg
+ 48     var value-ah/eax: (addr handle cell) <- get curr, right
+ 49     var value/eax: (addr cell) <- lookup *value-ah
+ 50     var value-data-ah/eax: (addr handle stream byte) <- get value, text-data
+ 51     var _value-data/eax: (addr stream byte) <- lookup *value-data-ah
+ 52     var value-data/ecx: (addr stream byte) <- copy _value-data
+ 53     var value-gap-buffer-storage: (handle gap-buffer)
+ 54     var value-gap-buffer-ah/edi: (addr handle gap-buffer) <- address value-gap-buffer-storage
+ 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
+ 92       break-if-=
+ 93       compare *curr-type, 5/screen
+ 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
+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
+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
+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 }
diff --git a/html/shell/grapheme-stack.mu.html b/html/shell/grapheme-stack.mu.html index d5da89b7..139f2f4b 100644 --- a/html/shell/grapheme-stack.mu.html +++ b/html/shell/grapheme-stack.mu.html @@ -14,14 +14,20 @@ 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; } -.Special { color: #ff6060; } .LineNr { } -.Constant { color: #008787; } .Delimiter { color: #c000c0; } +.muRegEbx { color: #8787af; } +.muRegEsi { color: #87d787; } +.muRegEdi { color: #87ffd7; } +.Constant { color: #008787; } +.Special { color: #ff6060; } +.PreProc { color: #c000c0; } .muFunction { color: #af5f00; text-decoration: underline; } .muTest { color: #5f8700; } .muComment { color: #005faf; } +.muRegEax { color: #875f00; } +.muRegEcx { color: #af875f; } +.muRegEdx { color: #878700; } --> @@ -65,22 +71,22 @@ if ('onhashchange' in window) { 6 } 7 8 fn initialize-grapheme-stack _self: (addr grapheme-stack), n: int { - 9 var self/esi: (addr grapheme-stack) <- copy _self - 10 var d/edi: (addr handle array grapheme) <- get self, data + 9 var self/esi: (addr grapheme-stack) <- copy _self + 10 var d/edi: (addr handle array grapheme) <- get self, data 11 populate d, n - 12 var top/eax: (addr int) <- get self, top + 12 var top/eax: (addr int) <- get self, top 13 copy-to *top, 0 14 } 15 16 fn clear-grapheme-stack _self: (addr grapheme-stack) { - 17 var self/esi: (addr grapheme-stack) <- copy _self - 18 var top/eax: (addr int) <- get self, top + 17 var self/esi: (addr grapheme-stack) <- copy _self + 18 var top/eax: (addr int) <- get self, top 19 copy-to *top, 0 20 } 21 - 22 fn grapheme-stack-empty? _self: (addr grapheme-stack) -> _/eax: boolean { - 23 var self/esi: (addr grapheme-stack) <- copy _self - 24 var top/eax: (addr int) <- get self, top + 22 fn grapheme-stack-empty? _self: (addr grapheme-stack) -> _/eax: boolean { + 23 var self/esi: (addr grapheme-stack) <- copy _self + 24 var top/eax: (addr int) <- get self, top 25 compare *top, 0 26 { 27 break-if-!= @@ -89,51 +95,51 @@ if ('onhashchange' in window) { 30 return 0/false 31 } 32 - 33 fn grapheme-stack-length _self: (addr grapheme-stack) -> _/eax: int { - 34 var self/esi: (addr grapheme-stack) <- copy _self - 35 var top/eax: (addr int) <- get self, top + 33 fn grapheme-stack-length _self: (addr grapheme-stack) -> _/eax: int { + 34 var self/esi: (addr grapheme-stack) <- copy _self + 35 var top/eax: (addr int) <- get self, top 36 return *top 37 } 38 39 fn push-grapheme-stack _self: (addr grapheme-stack), _val: grapheme { - 40 var self/esi: (addr grapheme-stack) <- copy _self - 41 var top-addr/ecx: (addr int) <- get self, top - 42 var data-ah/edx: (addr handle array grapheme) <- get self, data - 43 var data/eax: (addr array grapheme) <- lookup *data-ah - 44 var top/edx: int <- copy *top-addr - 45 var dest-addr/edx: (addr grapheme) <- index data, top - 46 var val/eax: grapheme <- copy _val + 40 var self/esi: (addr grapheme-stack) <- copy _self + 41 var top-addr/ecx: (addr int) <- get self, top + 42 var data-ah/edx: (addr handle array grapheme) <- get self, data + 43 var data/eax: (addr array grapheme) <- lookup *data-ah + 44 var top/edx: int <- copy *top-addr + 45 var dest-addr/edx: (addr grapheme) <- index data, top + 46 var val/eax: grapheme <- copy _val 47 copy-to *dest-addr, val 48 add-to *top-addr, 1 49 } 50 - 51 fn pop-grapheme-stack _self: (addr grapheme-stack) -> _/eax: grapheme { - 52 var self/esi: (addr grapheme-stack) <- copy _self - 53 var top-addr/ecx: (addr int) <- get self, top + 51 fn pop-grapheme-stack _self: (addr grapheme-stack) -> _/eax: grapheme { + 52 var self/esi: (addr grapheme-stack) <- copy _self + 53 var top-addr/ecx: (addr int) <- get self, top 54 { 55 compare *top-addr, 0 56 break-if-> 57 return -1 58 } 59 subtract-from *top-addr, 1 - 60 var data-ah/edx: (addr handle array grapheme) <- get self, data - 61 var data/eax: (addr array grapheme) <- lookup *data-ah - 62 var top/edx: int <- copy *top-addr - 63 var result-addr/eax: (addr grapheme) <- index data, top + 60 var data-ah/edx: (addr handle array grapheme) <- get self, data + 61 var data/eax: (addr array grapheme) <- lookup *data-ah + 62 var top/edx: int <- copy *top-addr + 63 var result-addr/eax: (addr grapheme) <- index data, top 64 return *result-addr 65 } 66 67 fn copy-grapheme-stack _src: (addr grapheme-stack), dest: (addr grapheme-stack) { - 68 var src/esi: (addr grapheme-stack) <- copy _src - 69 var data-ah/edi: (addr handle array grapheme) <- get src, data - 70 var _data/eax: (addr array grapheme) <- lookup *data-ah - 71 var data/edi: (addr array grapheme) <- copy _data - 72 var top-addr/ecx: (addr int) <- get src, top - 73 var i/eax: int <- copy 0 + 68 var src/esi: (addr grapheme-stack) <- copy _src + 69 var data-ah/edi: (addr handle array grapheme) <- get src, data + 70 var _data/eax: (addr array grapheme) <- lookup *data-ah + 71 var data/edi: (addr array grapheme) <- copy _data + 72 var top-addr/ecx: (addr int) <- get src, top + 73 var i/eax: int <- copy 0 74 { 75 compare i, *top-addr 76 break-if->= - 77 var g/edx: (addr grapheme) <- index data, i + 77 var g/edx: (addr grapheme) <- index data, i 78 push-grapheme-stack dest, *g 79 i <- increment 80 loop @@ -143,24 +149,24 @@ 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 { - 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 - 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 - 93 var x/eax: int <- copy _x - 94 var y/ecx: int <- copy _y - 95 var top-addr/esi: (addr int) <- get self, top - 96 var i/ebx: int <- copy 0 + 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 + 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 + 93 var x/eax: int <- copy _x + 94 var y/ecx: int <- copy _y + 95 var top-addr/esi: (addr int) <- get self, top + 96 var i/ebx: int <- copy 0 97 { 98 compare i, *top-addr 99 break-if->= 100 { -101 var g/esi: (addr grapheme) <- index data, i +101 var g/esi: (addr grapheme) <- index data, i 102 var fg: int 103 { -104 var tmp/eax: int <- copy color +104 var tmp/eax: int <- copy color 105 copy-to fg, tmp 106 } 107 { @@ -177,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 { -122 var _width/eax: int <- copy 0 -123 var _height/ecx: int <- copy 0 +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 -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 +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 130 return x2 # y2? yolo 131 } 132 @@ -194,16 +200,16 @@ if ('onhashchange' in window) { 135 # hard-coded colors: 136 # matching paren 137 # cursor -138 fn render-stack-from-top-wrapping-right-then-down screen: (addr screen), _self: (addr grapheme-stack), xmin: int, ymin: int, xmax: int, ymax: int, _x: int, _y: int, render-cursor?: boolean, color: int, background-color: int -> _/eax: int, _/ecx: int { -139 var self/esi: (addr grapheme-stack) <- copy _self -140 var matching-close-paren-index/edx: int <- get-matching-close-paren-index self, render-cursor? -141 var data-ah/eax: (addr handle array grapheme) <- get self, data -142 var _data/eax: (addr array grapheme) <- lookup *data-ah -143 var data/edi: (addr array grapheme) <- copy _data -144 var x/eax: int <- copy _x -145 var y/ecx: int <- copy _y -146 var top-addr/ebx: (addr int) <- get self, top -147 var i/ebx: int <- copy *top-addr +138 fn render-stack-from-top-wrapping-right-then-down screen: (addr screen), _self: (addr grapheme-stack), xmin: int, ymin: int, xmax: int, ymax: int, _x: int, _y: int, render-cursor?: boolean, color: int, background-color: int -> _/eax: int, _/ecx: int { +139 var self/esi: (addr grapheme-stack) <- copy _self +140 var matching-close-paren-index/edx: int <- get-matching-close-paren-index self, render-cursor? +141 var data-ah/eax: (addr handle array grapheme) <- get self, data +142 var _data/eax: (addr array grapheme) <- lookup *data-ah +143 var data/edi: (addr array grapheme) <- copy _data +144 var x/eax: int <- copy _x +145 var y/ecx: int <- copy _y +146 var top-addr/ebx: (addr int) <- get self, top +147 var i/ebx: int <- copy *top-addr 148 i <- decrement 149 # if render-cursor?, peel off first iteration 150 { @@ -211,7 +217,7 @@ if ('onhashchange' in window) { 152 break-if-= 153 compare i, 0 154 break-if-< -155 var g/esi: (addr grapheme) <- index data, i +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 157 i <- decrement 158 } @@ -222,7 +228,7 @@ if ('onhashchange' in window) { 163 # highlight matching paren if needed 164 var fg: int 165 { -166 var tmp/eax: int <- copy color +166 var tmp/eax: int <- copy color 167 copy-to fg, tmp 168 } 169 compare i, matching-close-paren-index @@ -231,7 +237,7 @@ if ('onhashchange' in window) { 172 copy-to fg, 0xf/highlight 173 } 174 # -175 var g/esi: (addr grapheme) <- index data, i +175 var g/esi: (addr grapheme) <- index data, i 176 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, fg, background-color 177 i <- decrement 178 loop @@ -240,14 +246,14 @@ if ('onhashchange' in window) { 181 } 182 183 # helper for small words -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 +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 -188 var width/edx: int <- copy _width -189 var height/ebx: int <- copy _height -190 var x2/eax: int <- copy 0 -191 var y2/ecx: int <- copy 0 +188 var width/edx: int <- copy _width +189 var height/ebx: int <- copy _height +190 var x2/eax: int <- copy 0 +191 var y2/ecx: int <- copy 0 192 x2, y2 <- render-stack-from-top-wrapping-right-then-down screen, self, x, y, width, height, x, y, render-cursor?, 3/fg=cyan, 0xc5/bg=blue-bg 193 return x2 # y2? yolo 194 } @@ -255,9 +261,9 @@ if ('onhashchange' in window) { 196 fn test-render-grapheme-stack { 197 # setup: gs = "abc" 198 var gs-storage: grapheme-stack -199 var gs/edi: (addr grapheme-stack) <- address gs-storage +199 var gs/edi: (addr grapheme-stack) <- address gs-storage 200 initialize-grapheme-stack gs, 5 -201 var g/eax: grapheme <- copy 0x61/a +201 var g/eax: grapheme <- copy 0x61/a 202 push-grapheme-stack gs, g 203 g <- copy 0x62/b 204 push-grapheme-stack gs, g @@ -265,20 +271,20 @@ if ('onhashchange' in window) { 206 push-grapheme-stack gs, g 207 # setup: screen 208 var screen-on-stack: screen -209 var screen/esi: (addr screen) <- address screen-on-stack +209 var screen/esi: (addr screen) <- address screen-on-stack 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 +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" 216 # -217 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 1/y, 0/cursor=false +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" 221 # -222 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 2/y, 1/cursor=true +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" @@ -287,9 +293,9 @@ if ('onhashchange' in window) { 228 fn test-render-grapheme-stack-while-highlighting-matching-close-paren { 229 # setup: gs = "(b)" 230 var gs-storage: grapheme-stack -231 var gs/edi: (addr grapheme-stack) <- address gs-storage +231 var gs/edi: (addr grapheme-stack) <- address gs-storage 232 initialize-grapheme-stack gs, 5 -233 var g/eax: grapheme <- copy 0x29/close-paren +233 var g/eax: grapheme <- copy 0x29/close-paren 234 push-grapheme-stack gs, g 235 g <- copy 0x62/b 236 push-grapheme-stack gs, g @@ -297,10 +303,10 @@ if ('onhashchange' in window) { 238 push-grapheme-stack gs, g 239 # setup: screen 240 var screen-on-stack: screen -241 var screen/esi: (addr screen) <- address screen-on-stack +241 var screen/esi: (addr screen) <- address screen-on-stack 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 +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" @@ -309,9 +315,9 @@ if ('onhashchange' in window) { 250 fn test-render-grapheme-stack-while-highlighting-matching-close-paren-2 { 251 # setup: gs = "(a (b)) c" 252 var gs-storage: grapheme-stack -253 var gs/edi: (addr grapheme-stack) <- address gs-storage +253 var gs/edi: (addr grapheme-stack) <- address gs-storage 254 initialize-grapheme-stack gs, 0x10 -255 var g/eax: grapheme <- copy 0x63/c +255 var g/eax: grapheme <- copy 0x63/c 256 push-grapheme-stack gs, g 257 g <- copy 0x20/space 258 push-grapheme-stack gs, g @@ -331,10 +337,10 @@ if ('onhashchange' in window) { 272 push-grapheme-stack gs, g 273 # setup: screen 274 var screen-on-stack: screen -275 var screen/esi: (addr screen) <- address screen-on-stack +275 var screen/esi: (addr screen) <- address screen-on-stack 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 +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" @@ -343,9 +349,9 @@ if ('onhashchange' in window) { 284 fn test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end { 285 # setup: gs = "(b)" 286 var gs-storage: grapheme-stack -287 var gs/edi: (addr grapheme-stack) <- address gs-storage +287 var gs/edi: (addr grapheme-stack) <- address gs-storage 288 initialize-grapheme-stack gs, 5 -289 var g/eax: grapheme <- copy 0x28/open-paren +289 var g/eax: grapheme <- copy 0x28/open-paren 290 push-grapheme-stack gs, g 291 g <- copy 0x62/b 292 push-grapheme-stack gs, g @@ -353,10 +359,10 @@ if ('onhashchange' in window) { 294 push-grapheme-stack gs, g 295 # setup: screen 296 var screen-on-stack: screen -297 var screen/esi: (addr screen) <- address screen-on-stack +297 var screen/esi: (addr screen) <- address screen-on-stack 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 +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" 303 } @@ -364,9 +370,9 @@ if ('onhashchange' in window) { 305 fn test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end-2 { 306 # setup: gs = "a((b))" 307 var gs-storage: grapheme-stack -308 var gs/edi: (addr grapheme-stack) <- address gs-storage +308 var gs/edi: (addr grapheme-stack) <- address gs-storage 309 initialize-grapheme-stack gs, 0x10 -310 var g/eax: grapheme <- copy 0x61/a +310 var g/eax: grapheme <- copy 0x61/a 311 push-grapheme-stack gs, g 312 g <- copy 0x28/open-paren 313 push-grapheme-stack gs, g @@ -380,10 +386,10 @@ if ('onhashchange' in window) { 321 push-grapheme-stack gs, g 322 # setup: screen 323 var screen-on-stack: screen -324 var screen/esi: (addr screen) <- address screen-on-stack +324 var screen/esi: (addr screen) <- address screen-on-stack 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 +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" 330 } @@ -391,18 +397,18 @@ if ('onhashchange' in window) { 332 fn test-render-grapheme-stack-while-highlighting-matching-open-paren { 333 # setup: gs = "(b" 334 var gs-storage: grapheme-stack -335 var gs/edi: (addr grapheme-stack) <- address gs-storage +335 var gs/edi: (addr grapheme-stack) <- address gs-storage 336 initialize-grapheme-stack gs, 5 -337 var g/eax: grapheme <- copy 0x28/open-paren +337 var g/eax: grapheme <- copy 0x28/open-paren 338 push-grapheme-stack gs, g 339 g <- copy 0x62/b 340 push-grapheme-stack gs, g 341 # setup: screen 342 var screen-on-stack: screen -343 var screen/esi: (addr screen) <- address screen-on-stack +343 var screen/esi: (addr screen) <- address screen-on-stack 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 +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" 349 } @@ -410,9 +416,9 @@ if ('onhashchange' in window) { 351 fn test-render-grapheme-stack-while-highlighting-matching-open-paren-2 { 352 # setup: gs = "a((b)" 353 var gs-storage: grapheme-stack -354 var gs/edi: (addr grapheme-stack) <- address gs-storage +354 var gs/edi: (addr grapheme-stack) <- address gs-storage 355 initialize-grapheme-stack gs, 0x10 -356 var g/eax: grapheme <- copy 0x61/a +356 var g/eax: grapheme <- copy 0x61/a 357 push-grapheme-stack gs, g 358 g <- copy 0x28/open-paren 359 push-grapheme-stack gs, g @@ -424,28 +430,28 @@ if ('onhashchange' in window) { 365 push-grapheme-stack gs, g 366 # setup: screen 367 var screen-on-stack: screen -368 var screen/esi: (addr screen) <- address screen-on-stack +368 var screen/esi: (addr screen) <- address screen-on-stack 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 +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" 374 } 375 376 # return the index of the matching close-paren of the grapheme at cursor (top of stack) 377 # or top index if there's no matching close-paren -378 fn get-matching-close-paren-index _self: (addr grapheme-stack), render-cursor?: boolean -> _/edx: int { -379 var self/esi: (addr grapheme-stack) <- copy _self -380 var top-addr/edx: (addr int) <- get self, top +378 fn get-matching-close-paren-index _self: (addr grapheme-stack), render-cursor?: boolean -> _/edx: int { +379 var self/esi: (addr grapheme-stack) <- copy _self +380 var top-addr/edx: (addr int) <- get self, top 381 # if not rendering cursor, return 382 compare render-cursor?, 0/false 383 { 384 break-if-!= 385 return *top-addr 386 } -387 var data-ah/eax: (addr handle array grapheme) <- get self, data -388 var data/eax: (addr array grapheme) <- lookup *data-ah -389 var i/ecx: int <- copy *top-addr +387 var data-ah/eax: (addr handle array grapheme) <- get self, data +388 var data/eax: (addr array grapheme) <- lookup *data-ah +389 var i/ecx: int <- copy *top-addr 390 # if stack is empty, return 391 compare i, 0 392 { @@ -454,19 +460,19 @@ if ('onhashchange' in window) { 395 } 396 # if cursor is not '(' return 397 i <- decrement -398 var g/esi: (addr grapheme) <- index data, i +398 var g/esi: (addr grapheme) <- index data, i 399 compare *g, 0x28/open-paren 400 { 401 break-if-= 402 return *top-addr 403 } 404 # otherwise scan to matching paren -405 var paren-count/ebx: int <- copy 1 +405 var paren-count/ebx: int <- copy 1 406 i <- decrement 407 { 408 compare i, 0 409 break-if-< -410 var g/esi: (addr grapheme) <- index data, i +410 var g/esi: (addr grapheme) <- index data, i 411 compare *g, 0x28/open-paren 412 { 413 break-if-!= @@ -490,18 +496,18 @@ if ('onhashchange' in window) { 431 432 # return the index of the first open-paren at the given depth 433 # or top index if there's no matching close-paren -434 fn get-matching-open-paren-index _self: (addr grapheme-stack), control: boolean, depth: int -> _/edx: int { -435 var self/esi: (addr grapheme-stack) <- copy _self -436 var top-addr/edx: (addr int) <- get self, top +434 fn get-matching-open-paren-index _self: (addr grapheme-stack), control: boolean, depth: int -> _/edx: int { +435 var self/esi: (addr grapheme-stack) <- copy _self +436 var top-addr/edx: (addr int) <- get self, top 437 # if not rendering cursor, return 438 compare control, 0/false 439 { 440 break-if-!= 441 return *top-addr 442 } -443 var data-ah/eax: (addr handle array grapheme) <- get self, data -444 var data/eax: (addr array grapheme) <- lookup *data-ah -445 var i/ecx: int <- copy *top-addr +443 var data-ah/eax: (addr handle array grapheme) <- get self, data +444 var data/eax: (addr array grapheme) <- lookup *data-ah +445 var i/ecx: int <- copy *top-addr 446 # if stack is empty, return 447 compare i, 0 448 { @@ -509,12 +515,12 @@ if ('onhashchange' in window) { 450 return *top-addr 451 } 452 # scan to matching open paren -453 var paren-count/ebx: int <- copy 0 +453 var paren-count/ebx: int <- copy 0 454 i <- decrement 455 { 456 compare i, 0 457 break-if-< -458 var g/esi: (addr grapheme) <- index data, i +458 var g/esi: (addr grapheme) <- index data, i 459 compare *g, 0x29/close-paren 460 { 461 break-if-!= @@ -538,20 +544,20 @@ if ('onhashchange' in window) { 479 480 # compare from bottom 481 # beware: modifies 'stream', which must be disposed of after a false result -482 fn prefix-match? _self: (addr grapheme-stack), s: (addr stream byte) -> _/eax: boolean { -483 var self/esi: (addr grapheme-stack) <- copy _self -484 var data-ah/edi: (addr handle array grapheme) <- get self, data -485 var _data/eax: (addr array grapheme) <- lookup *data-ah -486 var data/edi: (addr array grapheme) <- copy _data -487 var top-addr/ecx: (addr int) <- get self, top -488 var i/ebx: int <- copy 0 +482 fn prefix-match? _self: (addr grapheme-stack), s: (addr stream byte) -> _/eax: boolean { +483 var self/esi: (addr grapheme-stack) <- copy _self +484 var data-ah/edi: (addr handle array grapheme) <- get self, data +485 var _data/eax: (addr array grapheme) <- lookup *data-ah +486 var data/edi: (addr array grapheme) <- copy _data +487 var top-addr/ecx: (addr int) <- get self, top +488 var i/ebx: int <- copy 0 489 { 490 compare i, *top-addr 491 break-if->= 492 # if curr != expected, return false 493 { -494 var curr-a/edx: (addr grapheme) <- index data, i -495 var expected/eax: grapheme <- read-grapheme s +494 var curr-a/edx: (addr grapheme) <- index data, i +495 var expected/eax: grapheme <- read-grapheme s 496 { 497 compare expected, *curr-a 498 break-if-= @@ -566,20 +572,20 @@ if ('onhashchange' in window) { 507 508 # compare from bottom 509 # beware: modifies 'stream', which must be disposed of after a false result -510 fn suffix-match? _self: (addr grapheme-stack), s: (addr stream byte) -> _/eax: boolean { -511 var self/esi: (addr grapheme-stack) <- copy _self -512 var data-ah/edi: (addr handle array grapheme) <- get self, data -513 var _data/eax: (addr array grapheme) <- lookup *data-ah -514 var data/edi: (addr array grapheme) <- copy _data -515 var top-addr/eax: (addr int) <- get self, top -516 var i/ebx: int <- copy *top-addr +510 fn suffix-match? _self: (addr grapheme-stack), s: (addr stream byte) -> _/eax: boolean { +511 var self/esi: (addr grapheme-stack) <- copy _self +512 var data-ah/edi: (addr handle array grapheme) <- get self, data +513 var _data/eax: (addr array grapheme) <- lookup *data-ah +514 var data/edi: (addr array grapheme) <- copy _data +515 var top-addr/eax: (addr int) <- get self, top +516 var i/ebx: int <- copy *top-addr 517 i <- decrement 518 { 519 compare i, 0 520 break-if-< 521 { -522 var curr-a/edx: (addr grapheme) <- index data, i -523 var expected/eax: grapheme <- read-grapheme s +522 var curr-a/edx: (addr grapheme) <- index data, i +523 var expected/eax: grapheme <- read-grapheme s 524 # if curr != expected, return false 525 { 526 compare expected, *curr-a @@ -593,18 +599,18 @@ if ('onhashchange' in window) { 534 return 1 # true 535 } 536 -537 fn grapheme-stack-is-decimal-integer? _self: (addr grapheme-stack) -> _/eax: boolean { -538 var self/esi: (addr grapheme-stack) <- copy _self -539 var data-ah/eax: (addr handle array grapheme) <- get self, data -540 var _data/eax: (addr array grapheme) <- lookup *data-ah -541 var data/edx: (addr array grapheme) <- copy _data -542 var top-addr/ecx: (addr int) <- get self, top -543 var i/ebx: int <- copy 0 -544 var result/eax: boolean <- copy 1/true +537 fn grapheme-stack-is-decimal-integer? _self: (addr grapheme-stack) -> _/eax: boolean { +538 var self/esi: (addr grapheme-stack) <- copy _self +539 var data-ah/eax: (addr handle array grapheme) <- get self, data +540 var _data/eax: (addr array grapheme) <- lookup *data-ah +541 var data/edx: (addr array grapheme) <- copy _data +542 var top-addr/ecx: (addr int) <- get self, top +543 var i/ebx: int <- copy 0 +544 var result/eax: boolean <- copy 1/true 545 $grapheme-stack-is-integer?:loop: { 546 compare i, *top-addr 547 break-if->= -548 var g/edx: (addr grapheme) <- index data, i +548 var g/edx: (addr grapheme) <- index data, i 549 result <- decimal-digit? *g 550 compare result, 0/false 551 break-if-= diff --git a/html/shell/macroexpand.mu.html b/html/shell/macroexpand.mu.html index bdd65450..6aa63bf1 100644 --- a/html/shell/macroexpand.mu.html +++ b/html/shell/macroexpand.mu.html @@ -14,16 +14,22 @@ 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; } -.Special { color: #ff6060; } .LineNr { } -.CommentedCode { color: #8a8a8a; } -.Constant { color: #008787; } -.muComment { color: #005faf; } .Delimiter { color: #c000c0; } +.CommentedCode { color: #8a8a8a; } +.muRegEbx { color: #8787af; } +.muRegEsi { color: #87d787; } +.muRegEdi { color: #87ffd7; } +.Constant { color: #008787; } +.Special { color: #ff6060; } +.PreProc { color: #c000c0; } +.Folded { color: #080808; background-color: #949494; } .muFunction { color: #af5f00; text-decoration: underline; } .muTest { color: #5f8700; } -.Folded { color: #080808; background-color: #949494; } +.muComment { color: #005faf; } +.muRegEax { color: #875f00; } +.muRegEcx { color: #af875f; } +.muRegEdx { color: #878700; } --> @@ -59,160 +65,160 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/main/shell/macroexpand.mu 
-  1 fn macroexpand expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) {
+  1 fn macroexpand expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) {
   2 +-- 15 lines: # trace "macroexpand " expr-ah --------------------------------------------------------------------------------------------------------------------------------------------
- 17   trace-lower trace
+ 17   trace-lower trace
  18   # loop until convergence
  19   {
- 20     var error?/eax: boolean <- has-errors? trace
+ 20     var error?/eax: boolean <- has-errors? trace
  21     compare error?, 0/false
  22     break-if-!=
- 23     var expanded?/eax: boolean <- macroexpand-iter expr-ah, globals, trace
+ 23     var expanded?/eax: boolean <- macroexpand-iter expr-ah, globals, trace
  24     compare expanded?, 0/false
  25     loop-if-!=
  26   }
- 27   trace-higher trace
+ 27   trace-higher trace
  28 +-- 15 lines: # trace "=> " expr-ah -----------------------------------------------------------------------------------------------------------------------------------------------------
  43 }
  44 
  45 # return true if we found any macros
- 46 fn macroexpand-iter _expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) -> _/eax: boolean {
- 47   var expr-ah/esi: (addr handle cell) <- copy _expr-ah
+ 46 fn macroexpand-iter _expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) -> _/eax: boolean {
+ 47   var expr-ah/esi: (addr handle cell) <- copy _expr-ah
  48 +-- 15 lines: # trace "macroexpand-iter " expr ------------------------------------------------------------------------------------------------------------------------------------------
- 63   trace-lower trace
+ 63   trace-lower trace
  64   # if expr is a non-pair, return
- 65   var expr/eax: (addr cell) <- lookup *expr-ah
+ 65   var expr/eax: (addr cell) <- lookup *expr-ah
  66   {
- 67     var nil?/eax: boolean <- nil? expr
+ 67     var nil?/eax: boolean <- nil? expr
  68     compare nil?, 0/false
  69     break-if-=
  70     # nil is a literal
- 71     trace-text trace, "mac", "nil"
- 72     trace-higher trace
+ 71     trace-text trace, "mac", "nil"
+ 72     trace-higher trace
  73     return 0/false
  74   }
  75   {
- 76     var expr-type/eax: (addr int) <- get expr, type
+ 76     var expr-type/eax: (addr int) <- get expr, type
  77     compare *expr-type, 0/pair
  78     break-if-=
  79     # non-pairs are literals
- 80     trace-text trace, "mac", "non-pair"
- 81     trace-higher trace
+ 80     trace-text trace, "mac", "non-pair"
+ 81     trace-higher trace
  82     return 0/false
  83   }
  84   # if expr is a literal pair, return
- 85   var first-ah/ebx: (addr handle cell) <- get expr, left
- 86   var rest-ah/ecx: (addr handle cell) <- get expr, right
- 87   var first/eax: (addr cell) <- lookup *first-ah
+ 85   var first-ah/ebx: (addr handle cell) <- get expr, left
+ 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"
- 94     trace-higher trace
+ 93     trace-text trace, "mac", "literal function"
+ 94     trace-higher trace
  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"
-103     trace-higher trace
+102     trace-text trace, "mac", "literal macro"
+103     trace-higher trace
 104     return 0/false
 105   }
-106   var result/edi: boolean <- copy 0/false
+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"
+113     trace-text trace, "mac", "anonymous function"
 114     # skip parameters
-115     var rest/eax: (addr cell) <- lookup *rest-ah
+115     var rest/eax: (addr cell) <- lookup *rest-ah
 116     {
 117       rest-ah <- get rest, right
 118       rest <- lookup *rest-ah
 119       {
-120         var done?/eax: boolean <- nil? rest
+120         var done?/eax: boolean <- nil? rest
 121         compare done?, 0/false
 122       }
 123       break-if-!=
-124       var curr-ah/eax: (addr handle cell) <- get rest, left
-125       var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace
+124       var curr-ah/eax: (addr handle cell) <- get rest, left
+125       var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace
 126       result <- or macro-found?
 127       {
-128         var error?/eax: boolean <- has-errors? trace
+128         var error?/eax: boolean <- has-errors? trace
 129         compare error?, 0/false
 130         break-if-=
-131         trace-higher trace
+131         trace-higher trace
 132         return result
 133       }
 134       loop
 135     }
-136     trace-higher trace
+136     trace-higher trace
 137 +-- 15 lines: # trace "fn=> " _expr-ah --------------------------------------------------------------------------------------------------------------------------------------------------
 152     return result
 153   }
 154   # builtins with "special" evaluation rules
 155   $macroexpand-iter:quote: {
 156     # trees starting with single quote create literals
-157     var quote?/eax: boolean <- symbol-equal? first, "'"
+157     var quote?/eax: boolean <- symbol-equal? first, "'"
 158     compare quote?, 0/false
 159     break-if-=
 160     #
-161     trace-text trace, "mac", "quote"
-162     trace-higher trace
+161     trace-text trace, "mac", "quote"
+162     trace-higher trace
 163     return 0/false
 164   }
 165   $macroexpand-iter:backquote: {
 166     # nested backquote not supported for now
-167     var backquote?/eax: boolean <- symbol-equal? first, "`"
+167     var backquote?/eax: boolean <- symbol-equal? first, "`"
 168     compare backquote?, 0/false
 169     break-if-=
 170     #
 171 #?     set-cursor-position 0/screen, 0x40/x 0x10/y
 172 #?     dump-cell-from-cursor-over-full-screen rest-ah
-173     var double-unquote-found?/eax: boolean <- look-for-double-unquote rest-ah
+173     var double-unquote-found?/eax: boolean <- look-for-double-unquote rest-ah
 174     compare double-unquote-found?, 0/false
 175     {
 176       break-if-=
-177       error trace, "double unquote not supported yet"
+177       error trace, "double unquote not supported yet"
 178     }
-179     trace-higher trace
+179     trace-higher trace
 180     return 0/false
 181   }
-182   $macroexpand-iter:def: {
-183     # trees starting with "def" define globals
-184     var def?/eax: boolean <- symbol-equal? first, "def"
-185     compare def?, 0/false
+182   $macroexpand-iter:define: {
+183     # trees starting with "define" define globals
+184     var define?/eax: boolean <- symbol-equal? first, "define"
+185     compare define?, 0/false
 186     break-if-=
 187     #
-188     trace-text trace, "mac", "def"
-189     var rest/eax: (addr cell) <- lookup *rest-ah
+188     trace-text trace, "mac", "define"
+189     var rest/eax: (addr cell) <- lookup *rest-ah
 190     rest-ah <- get rest, right  # skip name
 191     rest <- lookup *rest-ah
-192     var val-ah/edx: (addr handle cell) <- get rest, left
-193     var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
-194     trace-higher trace
-195 +-- 15 lines: # trace "def=> " _expr-ah -------------------------------------------------------------------------------------------------------------------------------------------------
+192     var val-ah/edx: (addr handle cell) <- get rest, left
+193     var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
+194     trace-higher trace
+195 +-- 15 lines: # trace "define=> " _expr-ah ----------------------------------------------------------------------------------------------------------------------------------------------
 210     return macro-found?
 211   }
 212   $macroexpand-iter:set: {
 213     # trees starting with "set" mutate bindings
-214     var set?/eax: boolean <- symbol-equal? first, "set"
+214     var set?/eax: boolean <- symbol-equal? first, "set"
 215     compare set?, 0/false
 216     break-if-=
 217     #
-218     trace-text trace, "mac", "set"
-219     var rest/eax: (addr cell) <- lookup *rest-ah
+218     trace-text trace, "mac", "set"
+219     var rest/eax: (addr cell) <- lookup *rest-ah
 220     rest-ah <- get rest, right  # skip name
 221     rest <- lookup *rest-ah
-222     var val-ah/edx: (addr handle cell) <- get rest, left
-223     var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
-224     trace-higher trace
+222     var val-ah/edx: (addr handle cell) <- get rest, left
+223     var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
+224     trace-higher trace
 225 +-- 15 lines: # trace "set=> " _expr-ah -------------------------------------------------------------------------------------------------------------------------------------------------
 240     return macro-found?
 241   }
@@ -223,48 +229,48 @@ if ('onhashchange' in window) {
 246   # if car(expr) is a symbol defined as a macro, expand it
 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
-251     var definition/eax: (addr cell) <- lookup *definition-ah
+249     var definition-ah/edx: (addr handle cell) <- address definition-h
+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-=
 254     # definition found
 255     {
-256       var definition-type/eax: (addr int) <- get definition, type
+256       var definition-type/eax: (addr int) <- get definition, type
 257       compare *definition-type, 0/pair
 258     }
 259     break-if-!=
 260     # definition is a pair
 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
+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
 265       compare macro?, 0/false
 266     }
 267     break-if-=
 268     # definition is a macro
-269     var macro-definition-ah/eax: (addr handle cell) <- get definition, right
+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
-273     trace-higher trace
+272     apply macro-definition-ah, rest-ah, expr-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number
+273     trace-higher trace
 274 +-- 15 lines: # trace "1=> " _expr-ah ---------------------------------------------------------------------------------------------------------------------------------------------------
 289     return 1/true
 290   }
 291   # no macro found; process any macros within args
-292   trace-text trace, "mac", "recursing into function definition"
-293   var curr-ah/ebx: (addr handle cell) <- copy first-ah
+292   trace-text trace, "mac", "recursing into function definition"
+293   var curr-ah/ebx: (addr handle cell) <- copy first-ah
 294   $macroexpand-iter:loop: {
 295 #?     clear-screen 0/screen
 296 #?     dump-trace trace
-297     var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace
+297     var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace
 298     result <- or macro-found?
-299     var error?/eax: boolean <- has-errors? trace
+299     var error?/eax: boolean <- has-errors? trace
 300     compare error?, 0/false
 301     break-if-!=
-302     var rest/eax: (addr cell) <- lookup *rest-ah
+302     var rest/eax: (addr cell) <- lookup *rest-ah
 303     {
-304       var nil?/eax: boolean <- nil? rest
+304       var nil?/eax: boolean <- nil? rest
 305       compare nil?, 0/false
 306     }
 307     break-if-!=
@@ -272,60 +278,60 @@ if ('onhashchange' in window) {
 309     rest-ah <- get rest, right
 310     loop
 311   }
-312   trace-higher trace
+312   trace-higher trace
 313 +-- 15 lines: # trace "=> " _expr-ah ----------------------------------------------------------------------------------------------------------------------------------------------------
 328   return result
 329 }
 330 
-331 fn look-for-double-unquote _expr-ah: (addr handle cell) -> _/eax: boolean {
+331 fn look-for-double-unquote _expr-ah: (addr handle cell) -> _/eax: boolean {
 332   # if expr is a non-pair, return false
-333   var expr-ah/eax: (addr handle cell) <- copy _expr-ah
-334   var expr/eax: (addr cell) <- lookup *expr-ah
+333   var expr-ah/eax: (addr handle cell) <- copy _expr-ah
+334   var expr/eax: (addr cell) <- lookup *expr-ah
 335   {
-336     var nil?/eax: boolean <- nil? expr
+336     var nil?/eax: boolean <- nil? expr
 337     compare nil?, 0/false
 338     break-if-=
 339     return 0/false
 340   }
 341   {
-342     var expr-type/eax: (addr int) <- get expr, type
+342     var expr-type/eax: (addr int) <- get expr, type
 343     compare *expr-type, 0/pair
 344     break-if-=
 345     return 0/false
 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
+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
 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
-372     var cadr/eax: (addr cell) <- lookup *cadr-ah
+371     var cadr-ah/eax: (addr handle cell) <- get cdr, left
+372     var cadr/eax: (addr cell) <- lookup *cadr-ah
 373     {
 374       {
-375         var unquote?/eax: boolean <- symbol-equal? cadr, ","
+375         var unquote?/eax: boolean <- symbol-equal? cadr, ","
 376         compare unquote?, 0/false
 377       }
 378       break-if-!=
-379       var unquote-splice?/eax: boolean <- symbol-equal? cadr, ",@"
+379       var unquote-splice?/eax: boolean <- symbol-equal? cadr, ",@"
 380       compare unquote-splice?, 0/false
 381       break-if-!=
 382       break $look-for-double-unquote:check
@@ -333,7 +339,7 @@ if ('onhashchange' in window) {
 384     # error
 385     return 1/true
 386   }
-387   var result/eax: boolean <- look-for-double-unquote car-ah
+387   var result/eax: boolean <- look-for-double-unquote car-ah
 388   compare result, 0/false
 389   {
 390     break-if-=
@@ -344,145 +350,145 @@ if ('onhashchange' in window) {
 395 }
 396 
 397 fn test-macroexpand {
-398   var globals-storage: global-table
-399   var globals/edx: (addr global-table) <- address globals-storage
-400   initialize-globals globals
+398   var globals-storage: global-table
+399   var globals/edx: (addr global-table) <- address globals-storage
+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, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
-405   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+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
 406   # invoke macro
 407   initialize-sandbox-with sandbox, "(m 3 4)"
-408   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-409   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
+408   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
+409   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
 410   var result-h: (handle cell)
-411   var result-ah/ebx: (addr handle cell) <- address result-h
+411   var result-ah/ebx: (addr handle cell) <- address result-h
 412   var trace-storage: trace
-413   var trace/ecx: (addr trace) <- address trace-storage
-414   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+413   var trace/ecx: (addr trace) <- address trace-storage
+414   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 415   read-cell gap, result-ah, trace
-416   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
-417   var error?/eax: boolean <- has-errors? trace
+416   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
+417   var error?/eax: boolean <- has-errors? trace
 418   check-not error?, "F - test-macroexpand/error"
 419 #?   dump-cell-from-cursor-over-full-screen result-ah
-420   var _result/eax: (addr cell) <- lookup *result-ah
-421   var result/edi: (addr cell) <- copy _result
+420   var _result/eax: (addr cell) <- lookup *result-ah
+421   var result/edi: (addr cell) <- copy _result
 422   # expected
 423   initialize-sandbox-with sandbox, "(+ 3 4)"
-424   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
-425   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
+424   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
+425   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
 426   var expected-h: (handle cell)
-427   var expected-ah/edx: (addr handle cell) <- address expected-h
+427   var expected-ah/edx: (addr handle cell) <- address expected-h
 428   read-cell expected-gap, expected-ah, trace
 429 #?   dump-cell-from-cursor-over-full-screen expected-ah
-430   var expected/eax: (addr cell) <- lookup *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
+437   var globals-storage: global-table
+438   var globals/edx: (addr global-table) <- address globals-storage
+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, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
-444   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+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
 445   # invoke macro
 446   initialize-sandbox-with sandbox, "(fn() (m 3 4))"
-447   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-448   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
+447   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
+448   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
 449   var result-h: (handle cell)
-450   var result-ah/ebx: (addr handle cell) <- address result-h
+450   var result-ah/ebx: (addr handle cell) <- address result-h
 451   var trace-storage: trace
-452   var trace/ecx: (addr trace) <- address trace-storage
-453   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+452   var trace/ecx: (addr trace) <- address trace-storage
+453   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 454   read-cell gap, result-ah, trace
-455   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
-456   var error?/eax: boolean <- has-errors? trace
+455   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
+456   var error?/eax: boolean <- has-errors? trace
 457   check-not error?, "F - test-macroexpand-inside-anonymous-fn/error"
 458 #?   dump-cell-from-cursor-over-full-screen result-ah
-459   var _result/eax: (addr cell) <- lookup *result-ah
-460   var result/edi: (addr cell) <- copy _result
+459   var _result/eax: (addr cell) <- lookup *result-ah
+460   var result/edi: (addr cell) <- copy _result
 461   # expected
 462   initialize-sandbox-with sandbox, "(fn() (+ 3 4))"
-463   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
-464   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
+463   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
+464   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
 465   var expected-h: (handle cell)
-466   var expected-ah/edx: (addr handle cell) <- address expected-h
+466   var expected-ah/edx: (addr handle cell) <- address expected-h
 467   read-cell expected-gap, expected-ah, trace
-468   var expected/eax: (addr cell) <- lookup *expected-ah
+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
+475   var globals-storage: global-table
+476   var globals/edx: (addr global-table) <- address globals-storage
+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, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
-482   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+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
 483   # invoke macro
 484   initialize-sandbox-with sandbox, "((fn() (m 3 4)))"
-485   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-486   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
+485   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
+486   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
 487   var result-h: (handle cell)
-488   var result-ah/ebx: (addr handle cell) <- address result-h
+488   var result-ah/ebx: (addr handle cell) <- address result-h
 489   var trace-storage: trace
-490   var trace/ecx: (addr trace) <- address trace-storage
-491   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+490   var trace/ecx: (addr trace) <- address trace-storage
+491   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 492   read-cell gap, result-ah, trace
-493   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
-494   var error?/eax: boolean <- has-errors? trace
+493   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
+494   var error?/eax: boolean <- has-errors? trace
 495   check-not error?, "F - test-macroexpand-inside-fn-call/error"
 496 #?   dump-cell-from-cursor-over-full-screen result-ah
-497   var _result/eax: (addr cell) <- lookup *result-ah
-498   var result/edi: (addr cell) <- copy _result
+497   var _result/eax: (addr cell) <- lookup *result-ah
+498   var result/edi: (addr cell) <- copy _result
 499   # expected
 500   initialize-sandbox-with sandbox, "((fn() (+ 3 4)))"
-501   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
-502   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
+501   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
+502   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
 503   var expected-h: (handle cell)
-504   var expected-ah/edx: (addr handle cell) <- address expected-h
+504   var expected-ah/edx: (addr handle cell) <- address expected-h
 505   read-cell expected-gap, expected-ah, trace
 506 #?   dump-cell-from-cursor-over-full-screen expected-ah
-507   var expected/eax: (addr cell) <- lookup *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
+514   var globals-storage: global-table
+515   var globals/edx: (addr global-table) <- address globals-storage
+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
+519   var sandbox/esi: (addr sandbox) <- address sandbox-storage
 520   initialize-sandbox-with sandbox, "(cons 1 `(3))"
-521   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-522   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
+521   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
+522   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
 523   var result-h: (handle cell)
-524   var result-ah/ebx: (addr handle cell) <- address result-h
+524   var result-ah/ebx: (addr handle cell) <- address result-h
 525   var trace-storage: trace
-526   var trace/ecx: (addr trace) <- address trace-storage
-527   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+526   var trace/ecx: (addr trace) <- address trace-storage
+527   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 528   read-cell gap, result-ah, trace
-529   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
-530   var error?/eax: boolean <- has-errors? trace
+529   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
+530   var error?/eax: boolean <- has-errors? trace
 531   check-not error?, "F - test-macroexpand-repeatedly-with-backquoted-arg"
 532   {
 533     compare error?, 0/false
 534     break-if-=
 535     # we need space to display traces, so just stop rendering future tests on failure here
-536     dump-trace trace
+536     dump-trace trace
 537     {
 538       loop
 539     }
@@ -490,79 +496,79 @@ if ('onhashchange' in window) {
 541 }
 542 
 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
+544   var globals-storage: global-table
+545   var globals/edx: (addr global-table) <- address globals-storage
+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, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
-551   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+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
 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
-555   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
+554   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
+555   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
 556   var result-h: (handle cell)
-557   var result-ah/ebx: (addr handle cell) <- address result-h
+557   var result-ah/ebx: (addr handle cell) <- address result-h
 558   var trace-storage: trace
-559   var trace/ecx: (addr trace) <- address trace-storage
-560   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+559   var trace/ecx: (addr trace) <- address trace-storage
+560   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 561   read-cell gap, result-ah, trace
-562   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
-563   var error?/eax: boolean <- has-errors? trace
+562   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
+563   var error?/eax: boolean <- has-errors? trace
 564   check-not error?, "F - test-macroexpand-inside-backquote-unquote/error"
 565 #?   dump-cell-from-cursor-over-full-screen result-ah
-566   var _result/eax: (addr cell) <- lookup *result-ah
-567   var result/edi: (addr cell) <- copy _result
+566   var _result/eax: (addr cell) <- lookup *result-ah
+567   var result/edi: (addr cell) <- copy _result
 568   # expected
 569   initialize-sandbox-with sandbox, "`(print [result is ] ,(+ 3 4)))"
-570   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
-571   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
+570   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
+571   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
 572   var expected-h: (handle cell)
-573   var expected-ah/edx: (addr handle cell) <- address expected-h
+573   var expected-ah/edx: (addr handle cell) <- address expected-h
 574   read-cell expected-gap, expected-ah, trace
-575   var expected/eax: (addr cell) <- lookup *expected-ah
+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
+582   var globals-storage: global-table
+583   var globals/edx: (addr global-table) <- address globals-storage
+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, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
-589   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+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
 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
-593   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
+592   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
+593   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
 594   var result-h: (handle cell)
-595   var result-ah/ebx: (addr handle cell) <- address result-h
+595   var result-ah/ebx: (addr handle cell) <- address result-h
 596   var trace-storage: trace
-597   var trace/ecx: (addr trace) <- address trace-storage
-598   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+597   var trace/ecx: (addr trace) <- address trace-storage
+598   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 599   read-cell gap, result-ah, trace
-600   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
-601   var error?/eax: boolean <- has-errors? trace
+600   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, trace
+601   var error?/eax: boolean <- has-errors? trace
 602   check-not error?, "F - test-macroexpand-inside-nested-backquote-unquote/error"
 603   dump-cell-from-cursor-over-full-screen result-ah
-604   var _result/eax: (addr cell) <- lookup *result-ah
-605   var result/edi: (addr cell) <- copy _result
+604   var _result/eax: (addr cell) <- lookup *result-ah
+605   var result/edi: (addr cell) <- copy _result
 606   # expected
 607   initialize-sandbox-with sandbox, "`(a ,(+ 3 4) `(b ,(m 3 4) ,,(+ 3 4)))"
-608   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
-609   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
+608   var expected-gap-ah/edx: (addr handle gap-buffer) <- get sandbox, data
+609   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
 610   var expected-h: (handle cell)
-611   var expected-ah/edx: (addr handle cell) <- address expected-h
+611   var expected-ah/edx: (addr handle cell) <- address expected-h
 612   read-cell expected-gap, expected-ah, trace
 613   dump-cell-from-cursor-over-full-screen expected-ah
-614   var expected/eax: (addr cell) <- lookup *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 f4ff8f02..581fe0cf 100644
--- a/html/shell/main.mu.html
+++ b/html/shell/main.mu.html
@@ -18,7 +18,8 @@ a { color:inherit; }
 .Special { color: #ff6060; }
 .LineNr { }
 .Constant { color: #008787; }
-.CommentedCode { color: #8a8a8a; }
+.muRegEsi { color: #87d787; }
+.muRegEax { color: #875f00; }
 .Delimiter { color: #c000c0; }
 .muFunction { color: #af5f00; text-decoration: underline; }
 .muComment { color: #005faf; }
@@ -57,175 +58,27 @@ 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.
-  3 
-  4 fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) {
-  5   var globals-storage: global-table
-  6   var globals/edi: (addr global-table) <- address globals-storage
-  7   initialize-globals globals
-  8   var sandbox-storage: sandbox
-  9   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 10   initialize-sandbox sandbox, 1/with-screen
- 11   load-state data-disk, sandbox, globals
- 12   $main:loop: {
- 13     # globals layout: 1 char padding, 41 code, 1 padding, 41 code, 1 padding =  85
- 14     # sandbox layout: 1 padding, 41 code, 1 padding                          =  43
- 15     #                                                                  total = 128 chars
- 16     render-globals screen, globals
- 17     render-sandbox screen, sandbox, 0x55/sandbox-left-margin, 0/sandbox-top-margin, 0x80/screen-width, 0x2f/screen-height-without-menu
- 18     {
- 19       var key/eax: byte <- read-key keyboard
- 20       compare key, 0
- 21       loop-if-=
- 22       # ctrl-r
- 23       {
- 24         compare key, 0x12/ctrl-r
- 25         break-if-!=
- 26         var tmp/eax: (addr handle cell) <- copy 0
- 27         var nil: (handle cell)
- 28         tmp <- address nil
- 29         allocate-pair tmp
- 30         # (main 0/real-screen 0/real-keyboard)
- 31         # We're using the fact that 'screen' and 'keyboard' in this function are always 0.
- 32         var real-keyboard: (handle cell)
- 33         tmp <- address real-keyboard
- 34         allocate-keyboard tmp
- 35         # args = cons(real-keyboard, nil)
- 36         var args: (handle cell)
- 37         tmp <- address args
- 38         new-pair tmp, real-keyboard, nil
- 39         #
- 40         var real-screen: (handle cell)
- 41         tmp <- address real-screen
- 42         allocate-screen tmp
- 43         #  args = cons(real-screen, args)
- 44         tmp <- address args
- 45         new-pair tmp, real-screen, *tmp
- 46         #
- 47         var main: (handle cell)
- 48         tmp <- address main
- 49         new-symbol tmp, "main"
- 50         # args = cons(main, args)
- 51         tmp <- address args
- 52         new-pair tmp, main, *tmp
- 53         # clear real screen
- 54         clear-screen screen
- 55         set-cursor-position screen, 0, 0
- 56         # run
- 57         var out: (handle cell)
- 58         var out-ah/ecx: (addr handle cell) <- address out
- 59         var trace-storage: trace
- 60         var trace/ebx: (addr trace) <- address trace-storage
- 61         initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
- 62         evaluate tmp, out-ah, nil, globals, trace, 0/no-fake-screen, 0/no-fake-keyboard, 0/call-number
- 63         {
- 64           var tmp/eax: byte <- read-key keyboard
- 65           compare tmp, 0
- 66           loop-if-=
- 67         }
- 68         #
- 69         loop $main:loop
- 70       }
- 71       # no way to quit right now; just reboot
- 72       edit-sandbox sandbox, key, globals, data-disk, screen, 1/tweak-real-screen
- 73     }
- 74     loop
- 75   }
- 76 }
- 77 
- 78 # Gotcha: some saved state may not load.
- 79 fn load-state data-disk: (addr disk), _sandbox: (addr sandbox), globals: (addr global-table) {
- 80   var sandbox/eax: (addr sandbox) <- copy _sandbox
- 81   var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
- 82   var _data/eax: (addr gap-buffer) <- lookup *data-ah
- 83   var data/esi: (addr gap-buffer) <- copy _data
- 84   # data-disk -> stream
- 85   var s-storage: (stream byte 0x1000)  # space for 8/sectors
- 86   var s/ebx: (addr stream byte) <- address s-storage
- 87   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sectors from data disk", 3/fg, 0/bg
- 88   move-cursor-to-left-margin-of-next-line 0/screen
- 89   load-sectors data-disk, 0/lba, 8/sectors, s
- 90 #?   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg, 0xc5/bg=blue-bg
- 91   # stream -> gap-buffer
- 92   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "parsing", 3/fg, 0/bg
- 93   move-cursor-to-left-margin-of-next-line 0/screen
- 94   load-gap-buffer-from-stream data, s
- 95   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "  into gap buffer", 3/fg, 0/bg
- 96   move-cursor-to-left-margin-of-next-line 0/screen
- 97   clear-stream s
- 98   # read: gap-buffer -> cell
- 99   var initial-root-storage: (handle cell)
-100   var initial-root/ecx: (addr handle cell) <- address initial-root-storage
-101   var trace-storage: trace
-102   var trace/edi: (addr trace) <- address trace-storage
-103   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
-104   read-cell data, initial-root, trace
-105   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "  into s-expressions", 3/fg, 0/bg
-106   move-cursor-to-left-margin-of-next-line 0/screen
-107   clear-gap-buffer data
-108   #
-109   {
-110     var initial-root-addr/eax: (addr cell) <- lookup *initial-root
-111     compare initial-root-addr, 0
-112     break-if-!=
-113     return
-114   }
-115   # load globals from assoc(initial-root, 'globals)
-116   var globals-literal-storage: (handle cell)
-117   var globals-literal-ah/eax: (addr handle cell) <- address globals-literal-storage
-118   new-symbol globals-literal-ah, "globals"
-119   var globals-literal/eax: (addr cell) <- lookup *globals-literal-ah
-120   var globals-cell-storage: (handle cell)
-121   var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage
-122   clear-trace trace
-123   lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
-124   var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah
-125   {
-126     compare globals-cell, 0
-127     break-if-=
-128     load-globals globals-cell-ah, globals
-129   }
-130   # sandbox = assoc(initial-root, 'sandbox)
-131   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sandbox", 3/fg, 0/bg
-132   var sandbox-literal-storage: (handle cell)
-133   var sandbox-literal-ah/eax: (addr handle cell) <- address sandbox-literal-storage
-134   new-symbol sandbox-literal-ah, "sandbox"
-135   var sandbox-literal/eax: (addr cell) <- lookup *sandbox-literal-ah
-136   var sandbox-cell-storage: (handle cell)
-137   var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage
-138   clear-trace trace
-139   lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
-140   var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah
-141   {
-142     compare sandbox-cell, 0
-143     break-if-=
-144     # print: cell -> stream
-145     clear-trace trace
-146     print-cell sandbox-cell-ah, s, trace
-147     # stream -> gap-buffer
-148     load-gap-buffer-from-stream data, s
-149   }
-150 }
-151 
-152 # Save state as an alist of alists:
-153 #   ((globals . ((a . (fn ...))
-154 #                ...))
-155 #    (sandbox . ...))
-156 fn store-state data-disk: (addr disk), sandbox: (addr sandbox), globals: (addr global-table) {
-157   compare data-disk, 0/no-disk
-158   {
-159     break-if-!=
-160     return
-161   }
-162   var stream-storage: (stream byte 0x1000)  # space enough for 8/sectors
-163   var stream/edi: (addr stream byte) <- address stream-storage
-164   write stream, "(\n"
-165   write-globals stream, globals
-166   write-sandbox stream, sandbox
-167   write stream, ")\n"
-168   store-sectors data-disk, 0/lba, 8/sectors, stream
-169 }
+ 1 # Experimental Mu shell
+ 2 # A Lisp with indent-sensitivity and infix.
+ 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
+ 9   $main:loop: {
+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
+18     }
+19     loop
+20   }
+21 }
 

 
 
diff --git a/html/shell/parse.mu.html b/html/shell/parse.mu.html
index d4f045c9..f59031b4 100644
--- a/html/shell/parse.mu.html
+++ b/html/shell/parse.mu.html
@@ -15,9 +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; }
 .LineNr { }
-.Constant { color: #008787; }
+.muRegEdi { color: #87ffd7; }
+.muRegEsi { color: #87d787; }
 .muComment { color: #005faf; }
+.Constant { color: #008787; }
+.muRegEax { color: #875f00; }
+.muRegEcx { color: #af875f; }
 .Delimiter { color: #c000c0; }
 .muFunction { color: #af5f00; text-decoration: underline; }
 .Special { color: #ff6060; }
@@ -58,126 +63,126 @@ if ('onhashchange' in window) {
 
   1 fn parse-input tokens: (addr stream cell), out: (addr handle cell), trace: (addr trace) {
   2   rewind-stream tokens
-  3   var empty?/eax: boolean <- stream-empty? tokens
+  3   var empty?/eax: boolean <- stream-empty? tokens
   4   compare empty?, 0/false
   5   {
   6     break-if-=
-  7     error trace, "nothing to parse"
+  7     error trace, "nothing to parse"
   8     return
   9   }
- 10   var close-paren?/eax: boolean <- copy 0/false
- 11   var dummy?/ecx: boolean <- copy 0/false
+ 10   var close-paren?/eax: boolean <- copy 0/false
+ 11   var dummy?/ecx: boolean <- copy 0/false
  12   close-paren?, dummy? <- parse-sexpression tokens, out, trace
  13   {
  14     compare close-paren?, 0/false
  15     break-if-=
- 16     error trace, "')' is not a valid expression"
+ 16     error trace, "')' is not a valid expression"
  17     return
  18   }
  19   {
- 20     var empty?/eax: boolean <- stream-empty? tokens
+ 20     var empty?/eax: boolean <- stream-empty? tokens
  21     compare empty?, 0/false
  22     break-if-!=
- 23     error trace, "unexpected tokens at end; only type in a single expression at a time"
+ 23     error trace, "unexpected tokens at end; only type in a single expression at a time"
  24   }
  25 }
  26 
  27 # return values:
  28 #   unmatched close-paren encountered?
  29 #   dot encountered? (only used internally by recursive calls)
- 30 fn parse-sexpression tokens: (addr stream cell), _out: (addr handle cell), trace: (addr trace) -> _/eax: boolean, _/ecx: boolean {
- 31   trace-text trace, "parse", "parse"
- 32   trace-lower trace
+ 30 fn parse-sexpression tokens: (addr stream cell), _out: (addr handle cell), trace: (addr trace) -> _/eax: boolean, _/ecx: boolean {
+ 31   trace-text trace, "parse", "parse"
+ 32   trace-lower trace
  33   var curr-token-storage: cell
- 34   var curr-token/ecx: (addr cell) <- address curr-token-storage
- 35   var empty?/eax: boolean <- stream-empty? tokens
+ 34   var curr-token/ecx: (addr cell) <- address curr-token-storage
+ 35   var empty?/eax: boolean <- stream-empty? tokens
  36   compare empty?, 0/false
  37   {
  38     break-if-=
- 39     error trace, "end of stream; never found a balancing ')'"
- 40     trace-higher trace
+ 39     error trace, "end of stream; never found a balancing ')'"
+ 40     trace-higher trace
  41     return 1/true, 0/false
  42   }
  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
+ 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
+ 50       var out/edi: (addr handle cell) <- copy _out
  51       allocate-pair out
- 52       var out-addr/eax: (addr cell) <- lookup *out
- 53       var left-ah/edx: (addr handle cell) <- get out-addr, left
+ 52       var out-addr/eax: (addr cell) <- lookup *out
+ 53       var left-ah/edx: (addr handle cell) <- get out-addr, left
  54       new-symbol left-ah, "'"
- 55       var right-ah/edx: (addr handle cell) <- get out-addr, right
- 56       var close-paren?/eax: boolean <- copy 0/false
- 57       var dot?/ecx: boolean <- copy 0/false
+ 55       var right-ah/edx: (addr handle cell) <- get out-addr, right
+ 56       var close-paren?/eax: boolean <- copy 0/false
+ 57       var dot?/ecx: boolean <- copy 0/false
  58       close-paren?, dot? <- parse-sexpression tokens, right-ah, trace
- 59       trace-higher trace
+ 59       trace-higher trace
  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
+ 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
+ 67       var out/edi: (addr handle cell) <- copy _out
  68       allocate-pair out
- 69       var out-addr/eax: (addr cell) <- lookup *out
- 70       var left-ah/edx: (addr handle cell) <- get out-addr, left
+ 69       var out-addr/eax: (addr cell) <- lookup *out
+ 70       var left-ah/edx: (addr handle cell) <- get out-addr, left
  71       new-symbol left-ah, "`"
- 72       var right-ah/edx: (addr handle cell) <- get out-addr, right
- 73       var close-paren?/eax: boolean <- copy 0/false
- 74       var dot?/ecx: boolean <- copy 0/false
+ 72       var right-ah/edx: (addr handle cell) <- get out-addr, right
+ 73       var close-paren?/eax: boolean <- copy 0/false
+ 74       var dot?/ecx: boolean <- copy 0/false
  75       close-paren?, dot? <- parse-sexpression tokens, right-ah, trace
- 76       trace-higher trace
+ 76       trace-higher trace
  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
+ 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
+ 84       var out/edi: (addr handle cell) <- copy _out
  85       allocate-pair out
- 86       var out-addr/eax: (addr cell) <- lookup *out
- 87       var left-ah/edx: (addr handle cell) <- get out-addr, left
+ 86       var out-addr/eax: (addr cell) <- lookup *out
+ 87       var left-ah/edx: (addr handle cell) <- get out-addr, left
  88       new-symbol left-ah, ","
- 89       var right-ah/edx: (addr handle cell) <- get out-addr, right
- 90       var close-paren?/eax: boolean <- copy 0/false
- 91       var dot?/ecx: boolean <- copy 0/false
+ 89       var right-ah/edx: (addr handle cell) <- get out-addr, right
+ 90       var close-paren?/eax: boolean <- copy 0/false
+ 91       var dot?/ecx: boolean <- copy 0/false
  92       close-paren?, dot? <- parse-sexpression tokens, right-ah, trace
- 93       trace-higher trace
+ 93       trace-higher trace
  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
+ 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
+101       var out/edi: (addr handle cell) <- copy _out
 102       allocate-pair out
-103       var out-addr/eax: (addr cell) <- lookup *out
-104       var left-ah/edx: (addr handle cell) <- get out-addr, left
+103       var out-addr/eax: (addr cell) <- lookup *out
+104       var left-ah/edx: (addr handle cell) <- get out-addr, left
 105       new-symbol left-ah, ",@"
-106       var right-ah/edx: (addr handle cell) <- get out-addr, right
-107       var close-paren?/eax: boolean <- copy 0/false
-108       var dot?/ecx: boolean <- copy 0/false
+106       var right-ah/edx: (addr handle cell) <- get out-addr, right
+107       var close-paren?/eax: boolean <- copy 0/false
+108       var dot?/ecx: boolean <- copy 0/false
 109       close-paren?, dot? <- parse-sexpression tokens, right-ah, trace
-110       trace-higher trace
+110       trace-higher trace
 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-=
-118       trace-higher trace
+118       trace-higher trace
 119       return 0/false, 1/true
 120     }
 121     # not bracket -> parse atom
-122     var bracket-token?/eax: boolean <- bracket-token? curr-token
+122     var bracket-token?/eax: boolean <- bracket-token? curr-token
 123     compare bracket-token?, 0/false
 124     {
 125       break-if-!=
@@ -185,47 +190,47 @@ if ('onhashchange' in window) {
 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-=
-134       var curr/esi: (addr handle cell) <- copy _out
+134       var curr/esi: (addr handle cell) <- copy _out
 135       allocate-pair curr
-136       var curr-addr/eax: (addr cell) <- lookup *curr
-137       var left/edx: (addr handle cell) <- get curr-addr, left
+136       var curr-addr/eax: (addr cell) <- lookup *curr
+137       var left/edx: (addr handle cell) <- get curr-addr, left
 138       {
-139         var close-paren?/eax: boolean <- copy 0/false
-140         var dot?/ecx: boolean <- copy 0/false
+139         var close-paren?/eax: boolean <- copy 0/false
+140         var dot?/ecx: boolean <- copy 0/false
 141         close-paren?, dot? <- parse-sexpression tokens, left, trace
 142         {
 143           compare dot?, 0/false
 144           break-if-=
-145           error trace, "'.' cannot be at the start of a list"
+145           error trace, "'.' cannot be at the start of a list"
 146           return 1/true, dot?
 147         }
 148         compare close-paren?, 0/false
 149         break-if-!=
-150         var curr-addr/eax: (addr cell) <- lookup *curr
+150         var curr-addr/eax: (addr cell) <- lookup *curr
 151         curr <- get curr-addr, right
 152         var tmp-storage: (handle cell)
-153         var tmp/edx: (addr handle cell) <- address tmp-storage
+153         var tmp/edx: (addr handle cell) <- address tmp-storage
 154         $parse-sexpression:list-loop: {
-155           var close-paren?/eax: boolean <- copy 0/false
-156           var dot?/ecx: boolean <- copy 0/false
+155           var close-paren?/eax: boolean <- copy 0/false
+156           var dot?/ecx: boolean <- copy 0/false
 157           close-paren?, dot? <- parse-sexpression tokens, tmp, trace
 158           # '.' -> clean up right here and return
 159           compare dot?, 0/false
 160           {
 161             break-if-=
-162             parse-dot-tail tokens, curr, trace
+162             parse-dot-tail tokens, curr, trace
 163             return 0/false, 0/false
 164           }
 165           allocate-pair curr
 166           # ')' -> return
 167           compare close-paren?, 0/false
 168           break-if-!=
-169           var curr-addr/eax: (addr cell) <- lookup *curr
-170           var left/ecx: (addr handle cell) <- get curr-addr, left
+169           var curr-addr/eax: (addr cell) <- lookup *curr
+170           var left/ecx: (addr handle cell) <- get curr-addr, left
 171           copy-object tmp, left
 172           #
 173           curr <- get curr-addr, right
@@ -235,125 +240,135 @@ 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-=
-184       trace-higher trace
+184       trace-higher trace
 185       return 1/true, 0/false
 186     }
 187     # otherwise abort
 188     var stream-storage: (stream byte 0x400)
-189     var stream/edx: (addr stream byte) <- address stream-storage
+189     var stream/edx: (addr stream byte) <- address stream-storage
 190     write stream, "unexpected token "
-191     var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
-192     var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+191     var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+192     var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
 193     rewind-stream curr-token-data
 194     write-stream stream, curr-token-data
-195     error-stream trace, stream
+195     error-stream trace, stream
 196   }
-197   trace-higher trace
+197   trace-higher trace
 198   return 0/false, 0/false
 199 }
 200 
 201 fn parse-atom _curr-token: (addr cell), _out: (addr handle cell), trace: (addr trace) {
-202   trace-text trace, "parse", "parse atom"
-203   var curr-token/ecx: (addr cell) <- copy _curr-token
-204   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
-205   var _curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
-206   var curr-token-data/esi: (addr stream byte) <- copy _curr-token-data
+202   trace-text trace, "parse", "parse atom"
+203   var curr-token/ecx: (addr cell) <- copy _curr-token
+204   var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data
+205   var _curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah
+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
+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
-214     var _val/eax: int <- parse-decimal-int-from-stream curr-token-data
-215     var val/ecx: int <- copy _val
+214     var _val/eax: int <- parse-decimal-int-from-stream curr-token-data
+215     var val/ecx: int <- copy _val
 216     var val-float/xmm0: float <- convert val
 217     allocate-number _out
-218     var out/eax: (addr handle cell) <- copy _out
-219     var out-addr/eax: (addr cell) <- lookup *out
-220     var dest/edi: (addr float) <- get out-addr, number-data
+218     var out/eax: (addr handle cell) <- copy _out
+219     var out-addr/eax: (addr cell) <- lookup *out
+220     var dest/edi: (addr float) <- get out-addr, number-data
 221     copy-to *dest, val-float
 222     {
-223       var stream-storage: (stream byte 0x400)
-224       var stream/ecx: (addr stream byte) <- address stream-storage
-225       write stream, "=> number "
-226       var nested-trace-storage: trace
-227       var nested-trace/edi: (addr trace) <- address nested-trace-storage
-228       initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
-229       print-number out-addr, stream, nested-trace
-230       trace trace, "parse", stream
-231     }
-232     return
-233   }
-234   # default: copy either to a symbol or a stream
-235   # stream token -> literal
-236   var stream-token?/eax: boolean <- stream-token? curr-token
-237   compare stream-token?, 0/false
-238   {
-239     break-if-=
-240     allocate-stream _out
-241   }
+223       {
+224         var should-trace?/eax: boolean <- should-trace? trace
+225         compare should-trace?, 0/false
+226       }
+227       break-if-=
+228       var stream-storage: (stream byte 0x400)
+229       var stream/ecx: (addr stream byte) <- address stream-storage
+230       write stream, "=> number "
+231       var nested-trace-storage: trace
+232       var nested-trace/edi: (addr trace) <- address nested-trace-storage
+233       initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
+234       print-number out-addr, stream, nested-trace
+235       trace trace, "parse", stream
+236     }
+237     return
+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
 243   {
-244     break-if-!=
-245     allocate-symbol _out
+244     break-if-=
+245     allocate-stream _out
 246   }
-247   # copy token data
-248   var out/eax: (addr handle cell) <- copy _out
-249   var out-addr/eax: (addr cell) <- lookup *out
-250   var curr-token-data-ah/ecx: (addr handle stream byte) <- get curr-token, text-data
-251   var dest-ah/edx: (addr handle stream byte) <- get out-addr, text-data
-252   copy-object curr-token-data-ah, dest-ah
-253   {
-254     var stream-storage: (stream byte 0x400)
-255     var stream/ecx: (addr stream byte) <- address stream-storage
-256     write stream, "=> symbol "
-257     var nested-trace-storage: trace
-258     var nested-trace/edi: (addr trace) <- address nested-trace-storage
-259     initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
-260     print-symbol out-addr, stream, nested-trace
-261     trace trace, "parse", stream
-262   }
-263 }
-264 
-265 fn parse-dot-tail tokens: (addr stream cell), _out: (addr handle cell), trace: (addr trace) {
-266   var out/edi: (addr handle cell) <- copy _out
-267   var close-paren?/eax: boolean <- copy 0/false
-268   var dot?/ecx: boolean <- copy 0/false
-269   close-paren?, dot? <- parse-sexpression tokens, out, trace
-270   compare close-paren?, 0/false
-271   {
-272     break-if-=
-273     error trace, "'. )' makes no sense"
-274     return
-275   }
-276   compare dot?, 0/false
-277   {
-278     break-if-=
-279     error trace, "'. .' makes no sense"
-280     return
-281   }
-282   #
-283   var dummy: (handle cell)
-284   var dummy-ah/edi: (addr handle cell) <- address dummy
-285   close-paren?, dot? <- parse-sexpression tokens, dummy-ah, trace
-286   compare close-paren?, 0/false
+247   compare stream-token?, 0/false
+248   {
+249     break-if-!=
+250     allocate-symbol _out
+251   }
+252   # copy token data
+253   var out/eax: (addr handle cell) <- copy _out
+254   var out-addr/eax: (addr cell) <- lookup *out
+255   var curr-token-data-ah/ecx: (addr handle stream byte) <- get curr-token, text-data
+256   var dest-ah/edx: (addr handle stream byte) <- get out-addr, text-data
+257   copy-object curr-token-data-ah, dest-ah
+258   {
+259     {
+260       var should-trace?/eax: boolean <- should-trace? trace
+261       compare should-trace?, 0/false
+262     }
+263     break-if-=
+264     var stream-storage: (stream byte 0x400)
+265     var stream/ecx: (addr stream byte) <- address stream-storage
+266     write stream, "=> symbol "
+267     var nested-trace-storage: trace
+268     var nested-trace/edi: (addr trace) <- address nested-trace-storage
+269     initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
+270     print-symbol out-addr, stream, nested-trace
+271     trace trace, "parse", stream
+272   }
+273 }
+274 
+275 fn parse-dot-tail tokens: (addr stream cell), _out: (addr handle cell), trace: (addr trace) {
+276   var out/edi: (addr handle cell) <- copy _out
+277   var close-paren?/eax: boolean <- copy 0/false
+278   var dot?/ecx: boolean <- copy 0/false
+279   close-paren?, dot? <- parse-sexpression tokens, out, trace
+280   compare close-paren?, 0/false
+281   {
+282     break-if-=
+283     error trace, "'. )' makes no sense"
+284     return
+285   }
+286   compare dot?, 0/false
 287   {
-288     break-if-!=
-289     error trace, "cannot have multiple expressions between '.' and ')'"
+288     break-if-=
+289     error trace, "'. .' makes no sense"
 290     return
 291   }
-292   compare dot?, 0/false
-293   {
-294     break-if-=
-295     error trace, "cannot have two dots in a single list"
-296     return
-297   }
-298 }
+292   #
+293   var dummy: (handle cell)
+294   var dummy-ah/edi: (addr handle cell) <- address dummy
+295   close-paren?, dot? <- parse-sexpression tokens, dummy-ah, trace
+296   compare close-paren?, 0/false
+297   {
+298     break-if-!=
+299     error trace, "cannot have multiple expressions between '.' and ')'"
+300     return
+301   }
+302   compare dot?, 0/false
+303   {
+304     break-if-=
+305     error trace, "cannot have two dots in a single list"
+306     return
+307   }
+308 }
 

 
 
diff --git a/html/shell/primitives.mu.html b/html/shell/primitives.mu.html
new file mode 100644
index 00000000..b050cfba
--- /dev/null
+++ b/html/shell/primitives.mu.html
@@ -0,0 +1,1669 @@
+
+
+
+
+Mu - shell/primitives.mu
+
+
+
+
+
+
+
+
+
+
+https://github.com/akkartik/mu/blob/main/shell/primitives.mu
+
+   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   }
+ 203   {
+ 204     var abs?/eax: boolean <- string-equal? f-name, "abs"
+ 205     compare abs?, 0/false
+ 206     break-if-=
+ 207     apply-abs args-ah, out, trace
+ 208     return
+ 209   }
+ 210   {
+ 211     var sgn?/eax: boolean <- string-equal? f-name, "sgn"
+ 212     compare sgn?, 0/false
+ 213     break-if-=
+ 214     apply-sgn args-ah, out, trace
+ 215     return
+ 216   }
+ 217   {
+ 218     var car?/eax: boolean <- string-equal? f-name, "car"
+ 219     compare car?, 0/false
+ 220     break-if-=
+ 221     apply-car args-ah, out, trace
+ 222     return
+ 223   }
+ 224   {
+ 225     var cdr?/eax: boolean <- string-equal? f-name, "cdr"
+ 226     compare cdr?, 0/false
+ 227     break-if-=
+ 228     apply-cdr args-ah, out, trace
+ 229     return
+ 230   }
+ 231   {
+ 232     var cons?/eax: boolean <- string-equal? f-name, "cons"
+ 233     compare cons?, 0/false
+ 234     break-if-=
+ 235     apply-cons args-ah, out, trace
+ 236     return
+ 237   }
+ 238   {
+ 239     var structurally-equal?/eax: boolean <- string-equal? f-name, "="
+ 240     compare structurally-equal?, 0/false
+ 241     break-if-=
+ 242     apply-structurally-equal args-ah, out, trace
+ 243     return
+ 244   }
+ 245   {
+ 246     var not?/eax: boolean <- string-equal? f-name, "no"
+ 247     compare not?, 0/false
+ 248     break-if-=
+ 249     apply-not args-ah, out, trace
+ 250     return
+ 251   }
+ 252   {
+ 253     var not?/eax: boolean <- string-equal? f-name, "not"
+ 254     compare not?, 0/false
+ 255     break-if-=
+ 256     apply-not args-ah, out, trace
+ 257     return
+ 258   }
+ 259   {
+ 260     var debug?/eax: boolean <- string-equal? f-name, "dbg"
+ 261     compare debug?, 0/false
+ 262     break-if-=
+ 263     apply-debug args-ah, out, trace
+ 264     return
+ 265   }
+ 266   {
+ 267     var lesser?/eax: boolean <- string-equal? f-name, "<"
+ 268     compare lesser?, 0/false
+ 269     break-if-=
+ 270     apply-< args-ah, out, trace
+ 271     return
+ 272   }
+ 273   {
+ 274     var greater?/eax: boolean <- string-equal? f-name, ">"
+ 275     compare greater?, 0/false
+ 276     break-if-=
+ 277     apply-> 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
+ 283     break-if-=
+ 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
+ 290     break-if-=
+ 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
+ 297     break-if-=
+ 298     apply-print args-ah, out, trace
+ 299     return
+ 300   }
+ 301   {
+ 302     var clear?/eax: boolean <- string-equal? f-name, "clear"
+ 303     compare clear?, 0/false
+ 304     break-if-=
+ 305     apply-clear args-ah, out, trace
+ 306     return
+ 307   }
+ 308   {
+ 309     var lines?/eax: boolean <- string-equal? f-name, "lines"
+ 310     compare lines?, 0/false
+ 311     break-if-=
+ 312     apply-lines args-ah, out, trace
+ 313     return
+ 314   }
+ 315   {
+ 316     var columns?/eax: boolean <- string-equal? f-name, "columns"
+ 317     compare columns?, 0/false
+ 318     break-if-=
+ 319     apply-columns args-ah, out, trace
+ 320     return
+ 321   }
+ 322   {
+ 323     var up?/eax: boolean <- string-equal? f-name, "up"
+ 324     compare up?, 0/false
+ 325     break-if-=
+ 326     apply-up args-ah, out, trace
+ 327     return
+ 328   }
+ 329   {
+ 330     var down?/eax: boolean <- string-equal? f-name, "down"
+ 331     compare down?, 0/false
+ 332     break-if-=
+ 333     apply-down args-ah, out, trace
+ 334     return
+ 335   }
+ 336   {
+ 337     var left?/eax: boolean <- string-equal? f-name, "left"
+ 338     compare left?, 0/false
+ 339     break-if-=
+ 340     apply-left args-ah, out, trace
+ 341     return
+ 342   }
+ 343   {
+ 344     var right?/eax: boolean <- string-equal? f-name, "right"
+ 345     compare right?, 0/false
+ 346     break-if-=
+ 347     apply-right args-ah, out, trace
+ 348     return
+ 349   }
+ 350   {
+ 351     var cr?/eax: boolean <- string-equal? f-name, "cr"
+ 352     compare cr?, 0/false
+ 353     break-if-=
+ 354     apply-cr args-ah, out, trace
+ 355     return
+ 356   }
+ 357   {
+ 358     var pixel?/eax: boolean <- string-equal? f-name, "pixel"
+ 359     compare pixel?, 0/false
+ 360     break-if-=
+ 361     apply-pixel args-ah, out, trace
+ 362     return
+ 363   }
+ 364   {
+ 365     var width?/eax: boolean <- string-equal? f-name, "width"
+ 366     compare width?, 0/false
+ 367     break-if-=
+ 368     apply-width args-ah, out, trace
+ 369     return
+ 370   }
+ 371   {
+ 372     var height?/eax: boolean <- string-equal? f-name, "height"
+ 373     compare height?, 0/false
+ 374     break-if-=
+ 375     apply-height 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
+ 381     break-if-=
+ 382     apply-wait-for-key args-ah, out, trace
+ 383     return
+ 384   }
+ 385   {
+ 386     var stream?/eax: boolean <- string-equal? f-name, "stream"
+ 387     compare stream?, 0/false
+ 388     break-if-=
+ 389     apply-stream args-ah, out, trace
+ 390     return
+ 391   }
+ 392   {
+ 393     var write?/eax: boolean <- string-equal? f-name, "write"
+ 394     compare write?, 0/false
+ 395     break-if-=
+ 396     apply-write args-ah, out, trace
+ 397     return
+ 398   }
+ 399   {
+ 400     var abort?/eax: boolean <- string-equal? f-name, "abort"
+ 401     compare abort?, 0/false
+ 402     break-if-=
+ 403     apply-abort 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
+ 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
+ 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"
+ 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
+ 832   {
+ 833     break-if-!=
+ 834     nil out
+ 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
+ 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
+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
+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
+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   {
+1242     break-if-=
+1243     error trace, "first arg for 'right' is not a screen"
+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   {
+1292     break-if-=
+1293     error trace, "pixel needs 4 args but got 0"
+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   {
+1380     break-if-=
+1381     error trace, "first arg for 'key' is not a keyboard"
+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
+1446   {
+1447     break-if-=
+1448     error trace, "second arg for stream is not a number/grapheme"
+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
+1540   {
+1541     break-if-=
+1542     error trace, "width needs 1 arg but got 0"
+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 }
+

+
+
+
diff --git a/html/shell/print.mu.html b/html/shell/print.mu.html
index 80f074e6..09e963d4 100644
--- a/html/shell/print.mu.html
+++ b/html/shell/print.mu.html
@@ -15,9 +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; }
 .Special { color: #ff6060; }
 .LineNr { }
+.muRegEsi { color: #87d787; }
+.muRegEdi { color: #87ffd7; }
 .Constant { color: #008787; }
+.muRegEax { color: #875f00; }
+.muRegEcx { color: #af875f; }
 .Delimiter { color: #c000c0; }
 .muFunction { color: #af5f00; text-decoration: underline; }
 .muTest { color: #5f8700; }
@@ -65,116 +70,116 @@ if ('onhashchange' in window) {
   6 #     if we're printing something longer than 3 bytes, try to fall back to ellipses (which are 3 bytes)
   7 fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr trace) {
   8   check-stack
-  9   trace-text trace, "print", "print"
- 10   trace-lower trace
- 11   var in/eax: (addr handle cell) <- copy _in
- 12   var in-addr/eax: (addr cell) <- lookup *in
+  9   trace-text trace, "print", "print"
+ 10   trace-lower trace
+ 11   var in/eax: (addr handle cell) <- copy _in
+ 12   var in-addr/eax: (addr cell) <- lookup *in
  13   {
  14     compare in-addr, 0
  15     break-if-!=
- 16     var overflow?/eax: boolean <- try-write out, "NULL"
+ 16     var overflow?/eax: boolean <- try-write out, "NULL"
  17     compare overflow?, 0/false
  18     {
  19       break-if-=
  20       overflow? <- try-write out, "..."
- 21       error trace, "print-cell: no space for 'NULL'"
+ 21       error trace, "print-cell: no space for 'NULL'"
  22     }
- 23     trace-higher trace
+ 23     trace-higher trace
  24     return
  25   }
  26   {
- 27     var nil?/eax: boolean <- nil? in-addr
+ 27     var nil?/eax: boolean <- nil? in-addr
  28     compare nil?, 0/false
  29     break-if-=
- 30     var overflow?/eax: boolean <- try-write out, "()"
+ 30     var overflow?/eax: boolean <- try-write out, "()"
  31     compare overflow?, 0/false
  32     {
  33       break-if-=
- 34       error trace, "print-cell: no space for '()'"
+ 34       error trace, "print-cell: no space for '()'"
  35     }
- 36     trace-higher trace
+ 36     trace-higher trace
  37     return
  38   }
- 39   var in-type/ecx: (addr int) <- get in-addr, type
+ 39   var in-type/ecx: (addr int) <- get in-addr, type
  40   compare *in-type, 0/pair
  41   {
  42     break-if-!=
  43     print-pair in-addr, out, trace
- 44     trace-higher trace
+ 44     trace-higher trace
  45     return
  46   }
  47   compare *in-type, 1/number
  48   {
  49     break-if-!=
  50     print-number in-addr, out, trace
- 51     trace-higher trace
+ 51     trace-higher trace
  52     return
  53   }
  54   compare *in-type, 2/symbol
  55   {
  56     break-if-!=
  57     print-symbol in-addr, out, trace
- 58     trace-higher trace
+ 58     trace-higher trace
  59     return
  60   }
  61   compare *in-type, 3/stream
  62   {
  63     break-if-!=
  64     print-stream in-addr, out, trace
- 65     trace-higher trace
+ 65     trace-higher trace
  66     return
  67   }
  68   compare *in-type, 4/primitive
  69   {
  70     break-if-!=
- 71     var overflow?/eax: boolean <- try-write out, "[primitive]"
+ 71     var overflow?/eax: boolean <- try-write out, "[primitive]"
  72     compare overflow?, 0/false
  73     {
  74       break-if-=
  75       overflow? <- try-write out, "..."
- 76       error trace, "print-cell: no space for primitive"
+ 76       error trace, "print-cell: no space for primitive"
  77     }
- 78     trace-higher trace
+ 78     trace-higher trace
  79     return
  80   }
  81   compare *in-type, 5/screen
  82   {
  83     break-if-!=
  84     {
- 85       var available-space/eax: int <- space-remaining-in-stream out
+ 85       var available-space/eax: int <- space-remaining-in-stream out
  86       compare available-space, 0x10
  87       break-if->=
- 88       var dummy/eax: boolean <- try-write out, "..."
- 89       error trace, "print-cell: no space for screen"
+ 88       var dummy/eax: boolean <- try-write out, "..."
+ 89       error trace, "print-cell: no space for screen"
  90       return
  91     }
  92     write out, "[screen "
- 93     var screen-ah/eax: (addr handle screen) <- get in-addr, screen-data
- 94     var screen/eax: (addr screen) <- lookup *screen-ah
- 95     var screen-addr/eax: int <- copy screen
+ 93     var screen-ah/eax: (addr handle screen) <- get in-addr, screen-data
+ 94     var screen/eax: (addr screen) <- lookup *screen-ah
+ 95     var screen-addr/eax: int <- copy screen
  96     write-int32-hex out, screen-addr
  97     write out, "]"
- 98     trace-higher trace
+ 98     trace-higher trace
  99     return
 100   }
 101   compare *in-type, 6/keyboard
 102   {
 103     break-if-!=
 104     {
-105       var available-space/eax: int <- space-remaining-in-stream out
+105       var available-space/eax: int <- space-remaining-in-stream out
 106       compare available-space, 0x10
 107       break-if->=
-108       var dummy/eax: boolean <- try-write out, "..."
-109       error trace, "print-cell: no space for keyboard"
+108       var dummy/eax: boolean <- try-write out, "..."
+109       error trace, "print-cell: no space for keyboard"
 110       return
 111     }
 112     write out, "[keyboard "
-113     var keyboard-ah/eax: (addr handle gap-buffer) <- get in-addr, keyboard-data
-114     var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
-115     var keyboard-addr/eax: int <- copy keyboard
+113     var keyboard-ah/eax: (addr handle gap-buffer) <- get in-addr, keyboard-data
+114     var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
+115     var keyboard-addr/eax: int <- copy keyboard
 116     write-int32-hex out, keyboard-addr
 117     write out, "]"
-118     trace-higher trace
+118     trace-higher trace
 119     return
 120   }
 121 }
@@ -182,110 +187,110 @@ if ('onhashchange' in window) {
 123 # debug helper
 124 fn dump-cell-at-top-right in-ah: (addr handle cell) {
 125   var stream-storage: (stream byte 0x1000)
-126   var stream/edx: (addr stream byte) <- address stream-storage
+126   var stream/edx: (addr stream byte) <- address stream-storage
 127   var trace-storage: trace
-128   var trace/edi: (addr trace) <- address trace-storage
-129   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+128   var trace/edi: (addr trace) <- address trace-storage
+129   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 130   print-cell in-ah, stream, trace
-131   var d1/eax: int <- copy 0
-132   var d2/ecx: int <- copy 0
+131   var d1/eax: int <- copy 0
+132   var d2/ecx: int <- copy 0
 133   d1, d2 <- draw-stream-wrapping-right-then-down 0/screen, stream, 0/xmin, 0/ymin, 0x80/xmax, 0x30/ymax, 0/x, 0/y, 7/fg, 0xc5/bg=blue-bg
 134 }
 135 
 136 fn dump-cell-from-cursor-over-full-screen in-ah: (addr handle cell) {
 137   var stream-storage: (stream byte 0x200)
-138   var stream/edx: (addr stream byte) <- address stream-storage
+138   var stream/edx: (addr stream byte) <- address stream-storage
 139   var trace-storage: trace
-140   var trace/edi: (addr trace) <- address trace-storage
-141   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+140   var trace/edi: (addr trace) <- address trace-storage
+141   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 142   print-cell in-ah, stream, trace
 143   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, stream, 7/fg, 0/bg
 144 }
 145 
 146 fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
-147   trace-text trace, "print", "symbol"
-148   var in/esi: (addr cell) <- copy _in
-149   var data-ah/eax: (addr handle stream byte) <- get in, text-data
-150   var _data/eax: (addr stream byte) <- lookup *data-ah
-151   var data/esi: (addr stream byte) <- copy _data
+147   trace-text trace, "print", "symbol"
+148   var in/esi: (addr cell) <- copy _in
+149   var data-ah/eax: (addr handle stream byte) <- get in, text-data
+150   var _data/eax: (addr stream byte) <- lookup *data-ah
+151   var data/esi: (addr stream byte) <- copy _data
 152   rewind-stream data
-153   var _required-space/eax: int <- stream-size data
-154   var required-space/ecx: int <- copy _required-space
-155   var available-space/eax: int <- space-remaining-in-stream out
+153   var _required-space/eax: int <- stream-size data
+154   var required-space/ecx: int <- copy _required-space
+155   var available-space/eax: int <- space-remaining-in-stream out
 156   compare required-space, available-space
 157   {
 158     break-if-<=
-159     var dummy/eax: boolean <- try-write out, "..."
-160     error trace, "print-symbol: no space"
+159     var dummy/eax: boolean <- try-write out, "..."
+160     error trace, "print-symbol: no space"
 161     return
 162   }
 163   write-stream out, data
 164   # trace
-165   var should-trace?/eax: boolean <- should-trace? trace
-166   compare should-trace?, 0/false
+165   var should-trace?/eax: boolean <- should-trace? trace
+166   compare should-trace?, 0/false
 167   break-if-=
 168   rewind-stream data
 169   var stream-storage: (stream byte 0x40)
-170   var stream/ecx: (addr stream byte) <- address stream-storage
+170   var stream/ecx: (addr stream byte) <- address stream-storage
 171   write stream, "=> symbol "
 172   write-stream stream, data
 173   trace trace, "print", stream
 174 }
 175 
 176 fn print-stream _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
-177   trace-text trace, "print", "stream"
-178   var in/esi: (addr cell) <- copy _in
-179   var data-ah/eax: (addr handle stream byte) <- get in, text-data
-180   var _data/eax: (addr stream byte) <- lookup *data-ah
-181   var data/esi: (addr stream byte) <- copy _data
+177   trace-text trace, "print", "stream"
+178   var in/esi: (addr cell) <- copy _in
+179   var data-ah/eax: (addr handle stream byte) <- get in, text-data
+180   var _data/eax: (addr stream byte) <- lookup *data-ah
+181   var data/esi: (addr stream byte) <- copy _data
 182   rewind-stream data
-183   var _required-space/eax: int <- stream-size data
-184   var required-space/ecx: int <- copy _required-space
+183   var _required-space/eax: int <- stream-size data
+184   var required-space/ecx: int <- copy _required-space
 185   required-space <- add 2  # for []
-186   var available-space/eax: int <- space-remaining-in-stream out
+186   var available-space/eax: int <- space-remaining-in-stream out
 187   compare required-space, available-space
 188   {
 189     break-if-<=
-190     var dummy/eax: boolean <- try-write out, "..."
-191     error trace, "print-stream: no space"
+190     var dummy/eax: boolean <- try-write out, "..."
+191     error trace, "print-stream: no space"
 192     return
 193   }
 194   write out, "["
 195   write-stream out, data
 196   write out, "]"
 197   # trace
-198   var should-trace?/eax: boolean <- should-trace? trace
-199   compare should-trace?, 0/false
+198   var should-trace?/eax: boolean <- should-trace? trace
+199   compare should-trace?, 0/false
 200   break-if-=
 201   rewind-stream data
 202   var stream-storage: (stream byte 0x40)
-203   var stream/ecx: (addr stream byte) <- address stream-storage
+203   var stream/ecx: (addr stream byte) <- address stream-storage
 204   write stream, "=> stream "
 205   write-stream stream, data
 206   trace trace, "print", stream
 207 }
 208 
 209 fn print-number _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
-210   var available-space/eax: int <- space-remaining-in-stream out
+210   var available-space/eax: int <- space-remaining-in-stream out
 211   compare available-space, 0x10
 212   {
 213     break-if->=
-214     var dummy/eax: boolean <- try-write out, "..."
-215     error trace, "print-number: no space"
+214     var dummy/eax: boolean <- try-write out, "..."
+215     error trace, "print-number: no space"
 216     return
 217   }
-218   var in/esi: (addr cell) <- copy _in
-219   var val/eax: (addr float) <- get in, number-data
+218   var in/esi: (addr cell) <- copy _in
+219   var val/eax: (addr float) <- get in, number-data
 220   write-float-decimal-approximate out, *val, 3/precision
 221   # trace
 222   {
-223     var should-trace?/eax: boolean <- should-trace? trace
-224     compare should-trace?, 0/false
+223     var should-trace?/eax: boolean <- should-trace? trace
+224     compare should-trace?, 0/false
 225     break-if-!=
 226     return
 227   }
 228   var stream-storage: (stream byte 0x40)
-229   var stream/ecx: (addr stream byte) <- address stream-storage
+229   var stream/ecx: (addr stream byte) <- address stream-storage
 230   write stream, "=> number "
 231   write-float-decimal-approximate stream, *val, 3/precision
 232   trace trace, "print", stream
@@ -293,97 +298,97 @@ if ('onhashchange' in window) {
 234 
 235 fn print-pair _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
 236   # if in starts with a quote, print the quote outside the expression
-237   var in/esi: (addr cell) <- copy _in
-238   var left-ah/eax: (addr handle cell) <- get in, left
-239   var _left/eax: (addr cell) <- lookup *left-ah
-240   var left/ecx: (addr cell) <- copy _left
-241   var is-quote?/eax: boolean <- symbol-equal? left, "'"
+237   var in/esi: (addr cell) <- copy _in
+238   var left-ah/eax: (addr handle cell) <- get in, left
+239   var _left/eax: (addr cell) <- lookup *left-ah
+240   var left/ecx: (addr cell) <- copy _left
+241   var is-quote?/eax: boolean <- symbol-equal? left, "'"
 242   compare is-quote?, 0/false
 243   {
 244     break-if-=
-245     var dummy/eax: boolean <- try-write out, "'"
-246     var right-ah/eax: (addr handle cell) <- get in, right
+245     var dummy/eax: boolean <- try-write out, "'"
+246     var right-ah/eax: (addr handle cell) <- get in, right
 247     print-cell right-ah, out, trace
 248     return
 249   }
-250   var is-backquote?/eax: boolean <- symbol-equal? left, "`"
+250   var is-backquote?/eax: boolean <- symbol-equal? left, "`"
 251   compare is-backquote?, 0/false
 252   {
 253     break-if-=
-254     var dummy/eax: boolean <- try-write out, "`"
-255     var right-ah/eax: (addr handle cell) <- get in, right
+254     var dummy/eax: boolean <- try-write out, "`"
+255     var right-ah/eax: (addr handle cell) <- get in, right
 256     print-cell right-ah, out, trace
 257     return
 258   }
-259   var is-unquote?/eax: boolean <- symbol-equal? left, ","
+259   var is-unquote?/eax: boolean <- symbol-equal? left, ","
 260   compare is-unquote?, 0/false
 261   {
 262     break-if-=
-263     var dummy/eax: boolean <- try-write out, ","
-264     var right-ah/eax: (addr handle cell) <- get in, right
+263     var dummy/eax: boolean <- try-write out, ","
+264     var right-ah/eax: (addr handle cell) <- get in, right
 265     print-cell right-ah, out, trace
 266     return
 267   }
-268   var is-unquote-splice?/eax: boolean <- symbol-equal? left, ",@"
+268   var is-unquote-splice?/eax: boolean <- symbol-equal? left, ",@"
 269   compare is-unquote-splice?, 0/false
 270   {
 271     break-if-=
-272     var dummy/eax: boolean <- try-write out, ",@"
-273     var right-ah/eax: (addr handle cell) <- get in, right
+272     var dummy/eax: boolean <- try-write out, ",@"
+273     var right-ah/eax: (addr handle cell) <- get in, right
 274     print-cell right-ah, out, trace
 275     return
 276   }
 277   #
-278   var curr/esi: (addr cell) <- copy _in
+278   var curr/esi: (addr cell) <- copy _in
 279   {
-280     var overflow?/eax: boolean <- try-write out, "("
+280     var overflow?/eax: boolean <- try-write out, "("
 281     compare overflow?, 0/false
 282     break-if-=
-283     error trace, "print-pair: no space for '('"
+283     error trace, "print-pair: no space for '('"
 284     return
 285   }
 286   $print-pair:loop: {
-287     var left/ecx: (addr handle cell) <- get curr, left
+287     var left/ecx: (addr handle cell) <- get curr, left
 288     print-cell left, out, trace
 289     # errors? skip
 290     {
-291       var error?/eax: boolean <- has-errors? trace
+291       var error?/eax: boolean <- has-errors? trace
 292       compare error?, 0/false
 293       break-if-=
 294       return
 295     }
-296     var right/ecx: (addr handle cell) <- get curr, right
-297     var right-addr/eax: (addr cell) <- lookup *right
+296     var right/ecx: (addr handle cell) <- get curr, right
+297     var right-addr/eax: (addr cell) <- lookup *right
 298     {
 299       compare right-addr, 0
 300       break-if-!=
 301       abort "NULL in print!"
 302     }
 303     {
-304       var right-nil?/eax: boolean <- nil? right-addr
+304       var right-nil?/eax: boolean <- nil? right-addr
 305       compare right-nil?, 0/false
 306       {
 307         break-if-=
-308         trace-text trace, "print", "right is nil"
+308         trace-text trace, "print", "right is nil"
 309         break $print-pair:loop
 310       }
 311     }
 312     {
-313       var overflow?/eax: boolean <- try-write out, " "
+313       var overflow?/eax: boolean <- try-write out, " "
 314       compare overflow?, 0/false
 315       break-if-=
-316       error trace, "print-pair: no space"
+316       error trace, "print-pair: no space"
 317       return
 318     }
-319     var right-type-addr/edx: (addr int) <- get right-addr, type
+319     var right-type-addr/edx: (addr int) <- get right-addr, type
 320     {
 321       compare *right-type-addr, 0/pair
 322       break-if-=
 323       {
-324         var overflow?/eax: boolean <- try-write out, ". "
+324         var overflow?/eax: boolean <- try-write out, ". "
 325         compare overflow?, 0/false
 326         break-if-=
-327         error trace, "print-pair: no space"
+327         error trace, "print-pair: no space"
 328         return
 329       }
 330       print-cell right, out, trace
@@ -393,36 +398,36 @@ if ('onhashchange' in window) {
 334     loop
 335   }
 336   {
-337     var overflow?/eax: boolean <- try-write out, ")"
+337     var overflow?/eax: boolean <- try-write out, ")"
 338     compare overflow?, 0/false
 339     break-if-=
-340     error trace, "print-pair: no space for ')'"
+340     error trace, "print-pair: no space for ')'"
 341     return
 342   }
 343 }
 344 
 345 # Most lisps intern nil, but we don't really have globals yet, so we'll be
 346 # less efficient for now.
-347 fn nil? _in: (addr cell) -> _/eax: boolean {
-348   var in/esi: (addr cell) <- copy _in
+347 fn nil? _in: (addr cell) -> _/eax: boolean {
+348   var in/esi: (addr cell) <- copy _in
 349   # if type != pair, return false
-350   var type/eax: (addr int) <- get in, type
+350   var type/eax: (addr int) <- get in, type
 351   compare *type, 0/pair
 352   {
 353     break-if-=
 354     return 0/false
 355   }
 356   # if left != null, return false
-357   var left-ah/eax: (addr handle cell) <- get in, left
-358   var left/eax: (addr cell) <- lookup *left-ah
+357   var left-ah/eax: (addr handle cell) <- get in, left
+358   var left/eax: (addr cell) <- lookup *left-ah
 359   compare left, 0
 360   {
 361     break-if-=
 362     return 0/false
 363   }
 364   # if right != null, return false
-365   var right-ah/eax: (addr handle cell) <- get in, right
-366   var right/eax: (addr cell) <- lookup *right-ah
+365   var right-ah/eax: (addr handle cell) <- get in, right
+366   var right/eax: (addr cell) <- lookup *right-ah
 367   compare right, 0
 368   {
 369     break-if-=
@@ -433,79 +438,79 @@ if ('onhashchange' in window) {
 374 
 375 fn test-print-cell-zero {
 376   var num-storage: (handle cell)
-377   var num/esi: (addr handle cell) <- address num-storage
+377   var num/esi: (addr handle cell) <- address num-storage
 378   new-integer num, 0
 379   var out-storage: (stream byte 0x40)
-380   var out/edi: (addr stream byte) <- address out-storage
+380   var out/edi: (addr stream byte) <- address out-storage
 381   var trace-storage: trace
-382   var trace/edx: (addr trace) <- address trace-storage
-383   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+382   var trace/edx: (addr trace) <- address trace-storage
+383   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 384   print-cell num, out, trace
 385   check-stream-equal out, "0", "F - test-print-cell-zero"
 386 }
 387 
 388 fn test-print-cell-integer {
 389   var num-storage: (handle cell)
-390   var num/esi: (addr handle cell) <- address num-storage
+390   var num/esi: (addr handle cell) <- address num-storage
 391   new-integer num, 1
 392   var out-storage: (stream byte 0x40)
-393   var out/edi: (addr stream byte) <- address out-storage
+393   var out/edi: (addr stream byte) <- address out-storage
 394   var trace-storage: trace
-395   var trace/edx: (addr trace) <- address trace-storage
-396   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+395   var trace/edx: (addr trace) <- address trace-storage
+396   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 397   print-cell num, out, trace
 398   check-stream-equal out, "1", "F - test-print-cell-integer"
 399 }
 400 
 401 fn test-print-cell-integer-2 {
 402   var num-storage: (handle cell)
-403   var num/esi: (addr handle cell) <- address num-storage
+403   var num/esi: (addr handle cell) <- address num-storage
 404   new-integer num, 0x30
 405   var out-storage: (stream byte 0x40)
-406   var out/edi: (addr stream byte) <- address out-storage
+406   var out/edi: (addr stream byte) <- address out-storage
 407   var trace-storage: trace
-408   var trace/edx: (addr trace) <- address trace-storage
-409   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+408   var trace/edx: (addr trace) <- address trace-storage
+409   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 410   print-cell num, out, trace
 411   check-stream-equal out, "48", "F - test-print-cell-integer-2"
 412 }
 413 
 414 fn test-print-cell-fraction {
 415   var num-storage: (handle cell)
-416   var num/esi: (addr handle cell) <- address num-storage
+416   var num/esi: (addr handle cell) <- address num-storage
 417   var val/xmm0: float <- rational 1, 2
 418   new-float num, val
 419   var out-storage: (stream byte 0x40)
-420   var out/edi: (addr stream byte) <- address out-storage
+420   var out/edi: (addr stream byte) <- address out-storage
 421   var trace-storage: trace
-422   var trace/edx: (addr trace) <- address trace-storage
-423   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+422   var trace/edx: (addr trace) <- address trace-storage
+423   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 424   print-cell num, out, trace
 425   check-stream-equal out, "0.5", "F - test-print-cell-fraction"
 426 }
 427 
 428 fn test-print-cell-symbol {
 429   var sym-storage: (handle cell)
-430   var sym/esi: (addr handle cell) <- address sym-storage
+430   var sym/esi: (addr handle cell) <- address sym-storage
 431   new-symbol sym, "abc"
 432   var out-storage: (stream byte 0x40)
-433   var out/edi: (addr stream byte) <- address out-storage
+433   var out/edi: (addr stream byte) <- address out-storage
 434   var trace-storage: trace
-435   var trace/edx: (addr trace) <- address trace-storage
-436   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+435   var trace/edx: (addr trace) <- address trace-storage
+436   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 437   print-cell sym, out, trace
 438   check-stream-equal out, "abc", "F - test-print-cell-symbol"
 439 }
 440 
 441 fn test-print-cell-nil-list {
 442   var nil-storage: (handle cell)
-443   var nil/esi: (addr handle cell) <- address nil-storage
+443   var nil/esi: (addr handle cell) <- address nil-storage
 444   allocate-pair nil
 445   var out-storage: (stream byte 0x40)
-446   var out/edi: (addr stream byte) <- address out-storage
+446   var out/edi: (addr stream byte) <- address out-storage
 447   var trace-storage: trace
-448   var trace/edx: (addr trace) <- address trace-storage
-449   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+448   var trace/edx: (addr trace) <- address trace-storage
+449   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 450   print-cell nil, out, trace
 451   check-stream-equal out, "()", "F - test-print-cell-nil-list"
 452 }
@@ -513,20 +518,20 @@ if ('onhashchange' in window) {
 454 fn test-print-cell-singleton-list {
 455   # list
 456   var left-storage: (handle cell)
-457   var left/ecx: (addr handle cell) <- address left-storage
+457   var left/ecx: (addr handle cell) <- address left-storage
 458   new-symbol left, "abc"
 459   var nil-storage: (handle cell)
-460   var nil/edx: (addr handle cell) <- address nil-storage
+460   var nil/edx: (addr handle cell) <- address nil-storage
 461   allocate-pair nil
 462   var list-storage: (handle cell)
-463   var list/esi: (addr handle cell) <- address list-storage
+463   var list/esi: (addr handle cell) <- address list-storage
 464   new-pair list, *left, *nil
 465   #
 466   var out-storage: (stream byte 0x40)
-467   var out/edi: (addr stream byte) <- address out-storage
+467   var out/edi: (addr stream byte) <- address out-storage
 468   var trace-storage: trace
-469   var trace/edx: (addr trace) <- address trace-storage
-470   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+469   var trace/edx: (addr trace) <- address trace-storage
+470   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 471   print-cell list, out, trace
 472   check-stream-equal out, "(abc)", "F - test-print-cell-singleton-list"
 473 }
@@ -534,23 +539,23 @@ if ('onhashchange' in window) {
 475 fn test-print-cell-list {
 476   # list = cons "abc", nil
 477   var left-storage: (handle cell)
-478   var left/ecx: (addr handle cell) <- address left-storage
+478   var left/ecx: (addr handle cell) <- address left-storage
 479   new-symbol left, "abc"
 480   var nil-storage: (handle cell)
-481   var nil/edx: (addr handle cell) <- address nil-storage
+481   var nil/edx: (addr handle cell) <- address nil-storage
 482   allocate-pair nil
 483   var list-storage: (handle cell)
-484   var list/esi: (addr handle cell) <- address list-storage
+484   var list/esi: (addr handle cell) <- address list-storage
 485   new-pair list, *left, *nil
 486   # list = cons 64, list
 487   new-integer left, 0x40
 488   new-pair list, *left, *list
 489   #
 490   var out-storage: (stream byte 0x40)
-491   var out/edi: (addr stream byte) <- address out-storage
+491   var out/edi: (addr stream byte) <- address out-storage
 492   var trace-storage: trace
-493   var trace/edx: (addr trace) <- address trace-storage
-494   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+493   var trace/edx: (addr trace) <- address trace-storage
+494   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 495   print-cell list, out, trace
 496   check-stream-equal out, "(64 abc)", "F - test-print-cell-list"
 497 }
@@ -558,23 +563,23 @@ if ('onhashchange' in window) {
 499 fn test-print-cell-list-of-nil {
 500   # list = cons "abc", nil
 501   var left-storage: (handle cell)
-502   var left/ecx: (addr handle cell) <- address left-storage
+502   var left/ecx: (addr handle cell) <- address left-storage
 503   allocate-pair left
 504   var nil-storage: (handle cell)
-505   var nil/edx: (addr handle cell) <- address nil-storage
+505   var nil/edx: (addr handle cell) <- address nil-storage
 506   allocate-pair nil
 507   var list-storage: (handle cell)
-508   var list/esi: (addr handle cell) <- address list-storage
+508   var list/esi: (addr handle cell) <- address list-storage
 509   new-pair list, *left, *nil
 510   # list = cons 64, list
 511   new-integer left, 0x40
 512   new-pair list, *left, *list
 513   #
 514   var out-storage: (stream byte 0x40)
-515   var out/edi: (addr stream byte) <- address out-storage
+515   var out/edi: (addr stream byte) <- address out-storage
 516   var trace-storage: trace
-517   var trace/edx: (addr trace) <- address trace-storage
-518   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+517   var trace/edx: (addr trace) <- address trace-storage
+518   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 519   print-cell list, out, trace
 520   check-stream-equal out, "(64 ())", "F - test-print-cell-list-nil"
 521 }
@@ -582,33 +587,33 @@ if ('onhashchange' in window) {
 523 fn test-print-dotted-list {
 524   # list = cons 64, "abc"
 525   var left-storage: (handle cell)
-526   var left/ecx: (addr handle cell) <- address left-storage
+526   var left/ecx: (addr handle cell) <- address left-storage
 527   new-symbol left, "abc"
 528   var right-storage: (handle cell)
-529   var right/edx: (addr handle cell) <- address right-storage
+529   var right/edx: (addr handle cell) <- address right-storage
 530   new-integer right, 0x40
 531   var list-storage: (handle cell)
-532   var list/esi: (addr handle cell) <- address list-storage
+532   var list/esi: (addr handle cell) <- address list-storage
 533   new-pair list, *left, *right
 534   #
 535   var out-storage: (stream byte 0x40)
-536   var out/edi: (addr stream byte) <- address out-storage
+536   var out/edi: (addr stream byte) <- address out-storage
 537   var trace-storage: trace
-538   var trace/edx: (addr trace) <- address trace-storage
-539   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+538   var trace/edx: (addr trace) <- address trace-storage
+539   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 540   print-cell list, out, trace
 541   check-stream-equal out, "(abc . 64)", "F - test-print-dotted-list"
 542 }
 543 
 544 fn test-print-cell-interrupted {
 545   var sym-storage: (handle cell)
-546   var sym/esi: (addr handle cell) <- address sym-storage
+546   var sym/esi: (addr handle cell) <- address sym-storage
 547   new-symbol sym, "abcd"  # requires 4 bytes
 548   var out-storage: (stream byte 3)  # space for just 3 bytes
-549   var out/edi: (addr stream byte) <- address out-storage
+549   var out/edi: (addr stream byte) <- address out-storage
 550   var trace-storage: trace
-551   var trace/edx: (addr trace) <- address trace-storage
-552   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+551   var trace/edx: (addr trace) <- address trace-storage
+552   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 553   print-cell sym, out, trace
 554   # insufficient space to print out the symbol; print out ellipses if we can
 555   check-stream-equal out, "...", "F - test-print-cell-interrupted"
@@ -616,13 +621,13 @@ if ('onhashchange' in window) {
 557 
 558 fn test-print-cell-impossible {
 559   var sym-storage: (handle cell)
-560   var sym/esi: (addr handle cell) <- address sym-storage
+560   var sym/esi: (addr handle cell) <- address sym-storage
 561   new-symbol sym, "abcd"  # requires 4 bytes
 562   var out-storage: (stream byte 2)
-563   var out/edi: (addr stream byte) <- address out-storage
+563   var out/edi: (addr stream byte) <- address out-storage
 564   var trace-storage: trace
-565   var trace/edx: (addr trace) <- address trace-storage
-566   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+565   var trace/edx: (addr trace) <- address trace-storage
+566   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 567   print-cell sym, out, trace
 568   # insufficient space even for ellipses; print nothing
 569   check-stream-equal out, "", "F - test-print-cell-impossible"
@@ -631,20 +636,20 @@ if ('onhashchange' in window) {
 572 fn test-print-cell-interrupted-list {
 573   # list = (abcd) requires 6 bytes
 574   var left-storage: (handle cell)
-575   var left/ecx: (addr handle cell) <- address left-storage
+575   var left/ecx: (addr handle cell) <- address left-storage
 576   new-symbol left, "abcd"
 577   var nil-storage: (handle cell)
-578   var nil/edx: (addr handle cell) <- address nil-storage
+578   var nil/edx: (addr handle cell) <- address nil-storage
 579   allocate-pair nil
 580   var list-storage: (handle cell)
-581   var list/esi: (addr handle cell) <- address list-storage
+581   var list/esi: (addr handle cell) <- address list-storage
 582   new-pair list, *left, *nil
 583   #
 584   var out-storage: (stream byte 4)  # space for just 4 bytes
-585   var out/edi: (addr stream byte) <- address out-storage
+585   var out/edi: (addr stream byte) <- address out-storage
 586   var trace-storage: trace
-587   var trace/edx: (addr trace) <- address trace-storage
-588   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+587   var trace/edx: (addr trace) <- address trace-storage
+588   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
 589   print-cell list, out, trace
 590   check-stream-equal out, "(...", "F - test-print-cell-interrupted-list"
 591 }
diff --git a/html/shell/read.mu.html b/html/shell/read.mu.html
index ba9473f3..c25ebb64 100644
--- a/html/shell/read.mu.html
+++ b/html/shell/read.mu.html
@@ -18,6 +18,8 @@ a { color:inherit; }
 .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; }
@@ -60,9 +62,9 @@ if ('onhashchange' in window) {
  2   # TODO: we may be able to generate tokens lazily and drop this stream.
  3   # Depends on how we implement indent-sensitivity and infix.
  4   var tokens-storage: (stream cell 0x400)
- 5   var tokens/ecx: (addr stream cell) <- address tokens-storage
+ 5   var tokens/ecx: (addr stream cell) <- address tokens-storage
  6   tokenize in, tokens, trace
- 7   var error?/eax: boolean <- has-errors? trace
+ 7   var error?/eax: boolean <- has-errors? trace
  8   compare error?, 0/false
  9   {
 10     break-if-=
diff --git a/html/shell/sandbox.mu.html b/html/shell/sandbox.mu.html
index 59e674c7..d75bd69e 100644
--- a/html/shell/sandbox.mu.html
+++ b/html/shell/sandbox.mu.html
@@ -14,15 +14,21 @@ 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; }
 .LineNr { }
-.CommentedCode { color: #8a8a8a; }
-.Constant { color: #008787; }
-.muComment { color: #005faf; }
 .Delimiter { color: #c000c0; }
 .muFunction { color: #af5f00; text-decoration: underline; }
-.muTest { color: #5f8700; }
+.muRegEbx { color: #8787af; }
+.muRegEsi { color: #87d787; }
+.muRegEdi { color: #87ffd7; }
+.Constant { color: #008787; }
 .Special { color: #ff6060; }
+.PreProc { color: #c000c0; }
+.CommentedCode { color: #8a8a8a; }
+.muTest { color: #5f8700; }
+.muComment { color: #005faf; }
+.muRegEax { color: #875f00; }
+.muRegEcx { color: #af875f; }
+.muRegEdx { color: #878700; }
 -->
 
 
@@ -61,1081 +67,1203 @@ if ('onhashchange' in window) {
    1 type sandbox {
    2   data: (handle gap-buffer)
    3   value: (handle stream byte)
-   4   screen-var: (handle cell)
-   5   keyboard-var: (handle cell)
-   6   trace: (handle trace)
+   4   trace: (handle trace)
+   5   screen-var: (handle cell)
+   6   keyboard-var: (handle cell)
    7   cursor-in-data?: boolean
-   8   cursor-in-keyboard?: boolean
-   9   cursor-in-trace?: boolean
+   8   cursor-in-trace?: boolean
+   9   cursor-in-keyboard?: boolean
   10 }
   11 
   12 fn initialize-sandbox _self: (addr sandbox), fake-screen-and-keyboard?: boolean {
-  13   var self/esi: (addr sandbox) <- copy _self
-  14   var data-ah/eax: (addr handle gap-buffer) <- get self, data
+  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
+  16   var data/eax: (addr gap-buffer) <- lookup *data-ah
   17   initialize-gap-buffer data, 0x1000/4KB
   18   #
-  19   var value-ah/eax: (addr handle stream byte) <- get self, value
+  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
   24     break-if-=
-  25     var screen-ah/eax: (addr handle cell) <- get self, screen-var
+  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
-  27     var keyboard-ah/eax: (addr handle cell) <- get self, keyboard-var
+  27     var keyboard-ah/eax: (addr handle cell) <- get self, keyboard-var
   28     new-fake-keyboard keyboard-ah, 0x10/keyboard-capacity
   29   }
   30   #
-  31   var trace-ah/eax: (addr handle trace) <- get self, trace
+  31   var trace-ah/eax: (addr handle trace) <- get self, trace
   32   allocate trace-ah
-  33   var trace/eax: (addr trace) <- lookup *trace-ah
-  34   initialize-trace trace, 4/max-depth, 0x8000/lines, 0x80/visible
-  35   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
+  33   var trace/eax: (addr trace) <- lookup *trace-ah
+  34   initialize-trace trace, 4/max-depth, 0x8000/lines, 0x80/visible
+  35   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
   36   copy-to *cursor-in-data?, 1/true
   37 }
   38 
   39 ## some helpers for tests
   40 
   41 fn initialize-sandbox-with _self: (addr sandbox), s: (addr array byte) {
-  42   var self/esi: (addr sandbox) <- copy _self
-  43   var data-ah/eax: (addr handle gap-buffer) <- get self, data
+  42   var self/esi: (addr sandbox) <- copy _self
+  43   var data-ah/eax: (addr handle gap-buffer) <- get self, data
   44   allocate data-ah
-  45   var data/eax: (addr gap-buffer) <- lookup *data-ah
-  46   initialize-gap-buffer-with data, s
-  47   var value-ah/eax: (addr handle stream byte) <- get self, value
+  45   var data/eax: (addr gap-buffer) <- lookup *data-ah
+  46   initialize-gap-buffer-with data, s
+  47   var value-ah/eax: (addr handle stream byte) <- get self, value
   48   populate-stream value-ah, 0x1000/4KB
-  49   var trace-ah/eax: (addr handle trace) <- get self, trace
+  49   var trace-ah/eax: (addr handle trace) <- get self, trace
   50   allocate trace-ah
-  51   var trace/eax: (addr trace) <- lookup *trace-ah
-  52   initialize-trace trace, 3/max-depth, 0x8000/lines, 0x80/visible
-  53   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
+  51   var trace/eax: (addr trace) <- lookup *trace-ah
+  52   initialize-trace trace, 3/max-depth, 0x8000/lines, 0x80/visible
+  53   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
   54   copy-to *cursor-in-data?, 1/true
   55 }
   56 
   57 fn allocate-sandbox-with _out: (addr handle sandbox), s: (addr array byte) {
-  58   var out/eax: (addr handle sandbox) <- copy _out
+  58   var out/eax: (addr handle sandbox) <- copy _out
   59   allocate out
-  60   var out-addr/eax: (addr sandbox) <- lookup *out
+  60   var out-addr/eax: (addr sandbox) <- lookup *out
   61   initialize-sandbox-with out-addr, s
   62 }
   63 
   64 fn write-sandbox out: (addr stream byte), _self: (addr sandbox) {
-  65   var self/eax: (addr sandbox) <- copy _self
-  66   var data-ah/eax: (addr handle gap-buffer) <- get self, data
-  67   var data/eax: (addr gap-buffer) <- lookup *data-ah
+  65   var self/eax: (addr sandbox) <- copy _self
+  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
   73   }
   74   write out, "  (sandbox . "
-  75   append-gap-buffer data, out
+  75   append-gap-buffer data, out
   76   write out, ")\n"
   77 }
   78 
   79 ##
   80 
-  81 fn render-sandbox screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int {
+  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
   83   add-to xmin, 1/padding-left
   84   add-to ymin, 1/padding-top
   85   subtract-from xmax, 1/padding-right
-  86   var self/esi: (addr sandbox) <- copy _self
+  86   var self/esi: (addr sandbox) <- copy _self
   87   # data
-  88   var data-ah/eax: (addr handle gap-buffer) <- get self, data
-  89   var _data/eax: (addr gap-buffer) <- lookup *data-ah
-  90   var data/edx: (addr gap-buffer) <- copy _data
-  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
-  95   var cursor-in-sandbox?/ebx: (addr boolean) <- get self, cursor-in-data?
-  96   x, y <- render-gap-buffer-wrapping-right-then-down screen, data, x, y, xmax, ymax, *cursor-in-sandbox?, 7/fg, 0xc5/bg=blue-bg
-  97   y <- increment
-  98   # trace
-  99   var trace-ah/eax: (addr handle trace) <- get self, trace
- 100   var _trace/eax: (addr trace) <- lookup *trace-ah
- 101   var trace/edx: (addr trace) <- copy _trace
- 102   var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
- 103   y <- render-trace screen, trace, xmin, y, xmax, ymax, *cursor-in-trace?
- 104   # value
- 105   $render-sandbox:value: {
- 106     compare y, ymax
- 107     break-if->=
- 108     var value-ah/eax: (addr handle stream byte) <- get self, value
- 109     var _value/eax: (addr stream byte) <- lookup *value-ah
- 110     var value/esi: (addr stream byte) <- copy _value
- 111     rewind-stream value
- 112     var done?/eax: boolean <- stream-empty? value
- 113     compare done?, 0/false
- 114     break-if-!=
- 115     var x/eax: int <- copy 0
- 116     x, y <- draw-text-wrapping-right-then-down screen, "=> ", xmin, y, xmax, ymax, xmin, y, 7/fg, 0xc5/bg=blue-bg
- 117     var x2/edx: int <- copy x
- 118     var dummy/eax: int <- draw-stream-rightward screen, value, x2, xmax, y, 7/fg=grey, 0xc5/bg=blue-bg
- 119   }
- 120   y <- add 2  # padding
- 121   y <- maybe-render-screen screen, self, xmin, y
- 122   # render menu
- 123   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
- 124   compare *cursor-in-data?, 0/false
- 125   {
- 126     break-if-=
- 127     render-sandbox-menu screen, self
- 128     return
- 129   }
- 130   var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
- 131   compare *cursor-in-trace?, 0/false
- 132   {
- 133     break-if-=
- 134     render-trace-menu screen
- 135     return
- 136   }
- 137   var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
- 138   compare *cursor-in-keyboard?, 0/false
- 139   {
- 140     break-if-=
- 141     render-keyboard-menu screen
- 142     return
- 143   }
- 144 }
- 145 
- 146 fn clear-sandbox-output screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int {
- 147   # render just enough of the sandbox to figure out what to erase
- 148   var self/esi: (addr sandbox) <- copy _self
- 149   var data-ah/eax: (addr handle gap-buffer) <- get self, data
- 150   var _data/eax: (addr gap-buffer) <- lookup *data-ah
- 151   var data/edx: (addr gap-buffer) <- copy _data
- 152   var x/eax: int <- copy xmin
- 153   var y/ecx: int <- copy ymin
- 154   y <- maybe-render-empty-screen screen, self, xmin, y
- 155   y <- maybe-render-keyboard screen, self, xmin, y
- 156   var cursor-in-sandbox?/ebx: (addr boolean) <- get self, cursor-in-data?
- 157   x, y <- render-gap-buffer-wrapping-right-then-down screen, data, x, y, xmax, ymax, *cursor-in-sandbox?, 3/fg, 0xc5/bg=blue-bg
- 158   y <- increment
- 159   clear-rect screen, xmin, y, xmax, ymax, 0xc5/bg=blue-bg
- 160 }
- 161 
- 162 fn maybe-render-empty-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
- 163   var self/esi: (addr sandbox) <- copy _self
- 164   var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var
- 165   var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah
- 166   compare screen-obj-cell, 0
- 167   {
- 168     break-if-!=
- 169     return ymin
- 170   }
- 171   var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type
- 172   compare *screen-obj-cell-type, 5/screen
- 173   {
- 174     break-if-=
- 175     return ymin  # silently give up on rendering the screen
- 176   }
- 177   var y/ecx: int <- copy ymin
- 178   var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data
- 179   var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
- 180   var screen-obj/edx: (addr screen) <- copy _screen-obj
- 181   var x/eax: int <- draw-text-rightward screen, "screen:   ", xmin, 0x99/xmax, y, 0x17/fg, 0xc5/bg=blue-bg
- 182   y <- render-empty-screen screen, screen-obj, x, y
- 183   return y
- 184 }
- 185 
- 186 fn maybe-render-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
- 187   var self/esi: (addr sandbox) <- copy _self
- 188   var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var
- 189   var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah
- 190   compare screen-obj-cell, 0
- 191   {
- 192     break-if-!=
- 193     return ymin
- 194   }
- 195   var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type
- 196   compare *screen-obj-cell-type, 5/screen
- 197   {
- 198     break-if-=
- 199     return ymin  # silently give up on rendering the screen
- 200   }
- 201   var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data
- 202   var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
- 203   var screen-obj/edx: (addr screen) <- copy _screen-obj
- 204   {
- 205     var screen-empty?/eax: boolean <- fake-screen-empty? screen-obj
- 206     compare screen-empty?, 0/false
+  88   var data-ah/eax: (addr handle gap-buffer) <- get self, data
+  89   var _data/eax: (addr gap-buffer) <- lookup *data-ah
+  90   var data/edx: (addr gap-buffer) <- copy _data
+  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
+  95   var cursor-in-editor?/ebx: boolean <- copy show-cursor?
+  96   {
+  97     compare cursor-in-editor?, 0/false
+  98     break-if-=
+  99     var cursor-in-data-a/eax: (addr boolean) <- get self, cursor-in-data?
+ 100     cursor-in-editor? <- copy *cursor-in-data-a
+ 101   }
+ 102   x, y <- render-gap-buffer-wrapping-right-then-down screen, data, x, y, xmax, ymax, cursor-in-editor?, 7/fg, 0xc5/bg=blue-bg
+ 103   y <- increment
+ 104   # trace
+ 105   var trace-ah/eax: (addr handle trace) <- get self, trace
+ 106   var _trace/eax: (addr trace) <- lookup *trace-ah
+ 107   var trace/edx: (addr trace) <- copy _trace
+ 108   var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
+ 109   y <- render-trace screen, trace, xmin, y, xmax, ymax, *cursor-in-trace?
+ 110   # value
+ 111   $render-sandbox:value: {
+ 112     compare y, ymax
+ 113     break-if->=
+ 114     var value-ah/eax: (addr handle stream byte) <- get self, value
+ 115     var _value/eax: (addr stream byte) <- lookup *value-ah
+ 116     var value/esi: (addr stream byte) <- copy _value
+ 117     rewind-stream value
+ 118     var done?/eax: boolean <- stream-empty? value
+ 119     compare done?, 0/false
+ 120     break-if-!=
+ 121     var x/eax: int <- copy 0
+ 122     x, y <- draw-text-wrapping-right-then-down screen, "=> ", xmin, y, xmax, ymax, xmin, y, 7/fg, 0xc5/bg=blue-bg
+ 123     var x2/edx: int <- copy x
+ 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
+ 128 }
+ 129 
+ 130 fn render-sandbox-menu screen: (addr screen), _self: (addr sandbox) {
+ 131   var self/esi: (addr sandbox) <- copy _self
+ 132   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
+ 133   compare *cursor-in-data?, 0/false
+ 134   {
+ 135     break-if-=
+ 136     render-sandbox-edit-menu screen, self
+ 137     return
+ 138   }
+ 139   var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
+ 140   compare *cursor-in-trace?, 0/false
+ 141   {
+ 142     break-if-=
+ 143     render-trace-menu screen
+ 144     return
+ 145   }
+ 146   var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
+ 147   compare *cursor-in-keyboard?, 0/false
+ 148   {
+ 149     break-if-=
+ 150     render-keyboard-menu screen
+ 151     return
+ 152   }
+ 153 }
+ 154 
+ 155 fn clear-sandbox-output screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int {
+ 156   # render just enough of the sandbox to figure out what to erase
+ 157   var self/esi: (addr sandbox) <- copy _self
+ 158   var data-ah/eax: (addr handle gap-buffer) <- get self, data
+ 159   var _data/eax: (addr gap-buffer) <- lookup *data-ah
+ 160   var data/edx: (addr gap-buffer) <- copy _data
+ 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
+ 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
+ 169 }
+ 170 
+ 171 fn maybe-render-empty-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
+ 172   var self/esi: (addr sandbox) <- copy _self
+ 173   var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var
+ 174   var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah
+ 175   compare screen-obj-cell, 0
+ 176   {
+ 177     break-if-!=
+ 178     return ymin
+ 179   }
+ 180   var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type
+ 181   compare *screen-obj-cell-type, 5/screen
+ 182   {
+ 183     break-if-=
+ 184     return ymin  # silently give up on rendering the screen
+ 185   }
+ 186   var y/ecx: int <- copy ymin
+ 187   var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data
+ 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
+ 208     return ymin  # silently give up on rendering the screen
  209   }
- 210   var x/eax: int <- draw-text-rightward screen, "screen:   ", xmin, 0x99/xmax, ymin, 0x17/fg, 0xc5/bg=blue-bg
- 211   var y/ecx: int <- copy ymin
- 212   y <- render-screen screen, screen-obj, x, y
- 213   return y
- 214 }
- 215 
- 216 fn render-empty-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int {
- 217   var target-screen/esi: (addr screen) <- copy _target-screen
- 218   var screen-y/edi: int <- copy ymin
- 219   # screen
- 220   var height/edx: (addr int) <- get target-screen, height
- 221   var y/ecx: int <- copy 0
- 222   {
- 223     compare y, *height
- 224     break-if->=
- 225     set-cursor-position screen, xmin, screen-y
- 226     var width/edx: (addr int) <- get target-screen, width
- 227     var x/ebx: int <- copy 0
- 228     {
- 229       compare x, *width
- 230       break-if->=
- 231       draw-code-point-at-cursor screen, 0x20/space, 0x18/fg, 0/bg
- 232       move-cursor-right screen
- 233       x <- increment
- 234       loop
- 235     }
- 236     y <- increment
- 237     screen-y <- increment
- 238     loop
- 239   }
- 240   return screen-y
- 241 }
- 242 
- 243 fn render-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int {
- 244   var target-screen/esi: (addr screen) <- copy _target-screen
- 245   var screen-y/edi: int <- copy ymin
- 246   # text data
- 247   {
- 248     var height/edx: (addr int) <- get target-screen, height
- 249     var y/ecx: int <- copy 0
- 250     {
- 251       compare y, *height
- 252       break-if->=
- 253       set-cursor-position screen, xmin, screen-y
- 254       var width/edx: (addr int) <- get target-screen, width
- 255       var x/ebx: int <- copy 0
- 256       {
- 257         compare x, *width
- 258         break-if->=
- 259         print-screen-cell-of-fake-screen screen, target-screen, x, y
- 260         move-cursor-right screen
- 261         x <- increment
- 262         loop
- 263       }
- 264       y <- increment
- 265       screen-y <- increment
- 266       loop
- 267     }
- 268   }
- 269   # pixel data
- 270   {
- 271     # screen top left pixels x y width height
- 272     var tmp/eax: int <- copy xmin
- 273     tmp <- shift-left 3/log2-font-width
- 274     var left: int
- 275     copy-to left, tmp
- 276     tmp <- copy ymin
- 277     tmp <- shift-left 4/log2-font-height
- 278     var top: int
- 279     copy-to top, tmp
- 280     var pixels-ah/eax: (addr handle array byte) <- get target-screen, pixels
- 281     var _pixels/eax: (addr array byte) <- lookup *pixels-ah
- 282     var pixels/edi: (addr array byte) <- copy _pixels
- 283     compare pixels, 0
- 284     break-if-=
- 285     var y/ebx: int <- copy 0
- 286     var height-addr/edx: (addr int) <- get target-screen, height
- 287     var height/edx: int <- copy *height-addr
- 288     height <- shift-left 4/log2-font-height
- 289     {
- 290       compare y, height
- 291       break-if->=
- 292       var width-addr/edx: (addr int) <- get target-screen, width
- 293       var width/edx: int <- copy *width-addr
- 294       width <- shift-left 3/log2-font-width
- 295       var x/eax: int <- copy 0
- 296       {
- 297         compare x, width
- 298         break-if->=
- 299         {
- 300           var idx/ecx: int <- pixel-index target-screen, x, y
- 301           var color-addr/ecx: (addr byte) <- index pixels, idx
- 302           var color/ecx: byte <- copy-byte *color-addr
- 303           var color2/ecx: int <- copy color
- 304           compare color2, 0
- 305           break-if-=
- 306           var x2/eax: int <- copy x
- 307           x2 <- add left
- 308           var y2/ebx: int <- copy y
- 309           y2 <- add top
- 310           pixel screen, x2, y2, color2
- 311         }
- 312         x <- increment
- 313         loop
- 314       }
- 315       y <- increment
- 316       loop
- 317     }
- 318   }
- 319   return screen-y
- 320 }
- 321 
- 322 fn has-keyboard? _self: (addr sandbox) -> _/eax: boolean {
- 323   var self/esi: (addr sandbox) <- copy _self
- 324   var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
- 325   var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah
- 326   compare keyboard-obj-cell, 0
- 327   {
- 328     break-if-!=
- 329     return 0/false
- 330   }
- 331   var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type
- 332   compare *keyboard-obj-cell-type, 6/keyboard
- 333   {
- 334     break-if-=
- 335     return 0/false
- 336   }
- 337   var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data
- 338   var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah
- 339   var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj
- 340   compare keyboard-obj, 0
- 341   {
- 342     break-if-!=
- 343     return 0/false
- 344   }
- 345   return 1/true
- 346 }
- 347 
- 348 fn maybe-render-keyboard screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
- 349   var self/esi: (addr sandbox) <- copy _self
- 350   var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
- 351   var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah
- 352   compare keyboard-obj-cell, 0
- 353   {
- 354     break-if-!=
- 355     return ymin
- 356   }
- 357   var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type
- 358   compare *keyboard-obj-cell-type, 6/keyboard
- 359   {
- 360     break-if-=
- 361     return ymin  # silently give up on rendering the keyboard
- 362   }
- 363   var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data
- 364   var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah
- 365   var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj
- 366   var y/ecx: int <- copy ymin
- 367   y <- increment  # padding
- 368   var x/eax: int <- draw-text-rightward screen, "keyboard: ", xmin, 0x99/xmax, y, 0x17/fg, 0xc5/bg=blue-bg
- 369   var cursor-in-keyboard?/esi: (addr boolean) <- get self, cursor-in-keyboard?
- 370   y <- render-keyboard screen, keyboard-obj, x, y, *cursor-in-keyboard?
- 371   y <- increment  # padding
- 372   return y
- 373 }
- 374 
- 375 fn render-keyboard screen: (addr screen), _keyboard: (addr gap-buffer), xmin: int, ymin: int, render-cursor?: boolean -> _/ecx: int {
- 376   var keyboard/esi: (addr gap-buffer) <- copy _keyboard
- 377   var width/edx: int <- copy 0x10/keyboard-capacity
- 378   var y/edi: int <- copy ymin
- 379   # keyboard
- 380   var x/eax: int <- copy xmin
- 381   var xmax/ecx: int <- copy x
- 382   xmax <- add 0x10
- 383   var ymax/edx: int <- copy ymin
- 384   ymax <- add 1
- 385   clear-rect screen, x, y, xmax, ymax, 0/bg
- 386   x <- render-gap-buffer screen, keyboard, x, y, render-cursor?, 3/fg, 0/bg
- 387   y <- increment
- 388   return y
- 389 }
- 390 
- 391 fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), x: int, y: int {
- 392   var target/ecx: (addr screen) <- copy _target
- 393   var data-ah/eax: (addr handle array screen-cell) <- get target, data
- 394   var data/eax: (addr array screen-cell) <- lookup *data-ah
- 395   var index/ecx: int <- screen-cell-index target, x, y
- 396   var offset/ecx: (offset screen-cell) <- compute-offset data, index
- 397   var src-cell/esi: (addr screen-cell) <- index data, offset
- 398   var src-grapheme/eax: (addr grapheme) <- get src-cell, data
- 399   var src-color/ecx: (addr int) <- get src-cell, color
- 400   var src-background-color/edx: (addr int) <- get src-cell, background-color
- 401   draw-grapheme-at-cursor screen, *src-grapheme, *src-color, *src-background-color
- 402 }
- 403 
- 404 fn render-sandbox-menu screen: (addr screen), _self: (addr sandbox) {
- 405   var _width/eax: int <- copy 0
- 406   var height/ecx: int <- copy 0
- 407   _width, height <- screen-size screen
- 408   var width/edx: int <- copy _width
- 409   var y/ecx: int <- copy height
- 410   y <- decrement
- 411   var height/ebx: int <- copy y
- 412   height <- increment
- 413   clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg
- 414   set-cursor-position screen, 0/x, y
- 415   draw-text-rightward-from-cursor screen, " ctrl+... ", width, 0xf/fg, 0xc5/bg=blue-bg
- 416   draw-text-rightward-from-cursor screen, " r ", width, 0/fg, 0x5c/bg=black
- 417   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0xc5/bg=blue-bg
- 418   $render-sandbox-menu:render-ctrl-m: {
- 419     var self/eax: (addr sandbox) <- copy _self
- 420     var has-trace?/eax: boolean <- has-trace? self
- 421     compare has-trace?, 0/false
- 422     {
- 423       break-if-=
- 424       draw-text-rightward-from-cursor screen, " m ", width, 0/fg, 0x38/bg=trace
- 425       draw-text-rightward-from-cursor screen, " to trace  ", width, 7/fg, 0xc5/bg=blue-bg
- 426       break $render-sandbox-menu:render-ctrl-m
- 427     }
- 428     draw-text-rightward-from-cursor screen, " m ", width, 0/fg, 3/bg=keyboard
- 429     draw-text-rightward-from-cursor screen, " to keyboard  ", width, 7/fg, 0xc5/bg=blue-bg
- 430   }
- 431   draw-text-rightward-from-cursor screen, " s ", width, 0/fg, 0x5c/bg=black
- 432   draw-text-rightward-from-cursor screen, " run sandbox  ", width, 7/fg, 0xc5/bg=blue-bg
- 433   draw-text-rightward-from-cursor screen, " a ", width, 0/fg, 0x5c/bg=black
- 434   draw-text-rightward-from-cursor screen, " <<  ", width, 7/fg, 0xc5/bg=blue-bg
- 435   draw-text-rightward-from-cursor screen, " b ", width, 0/fg, 0x5c/bg=black
- 436   draw-text-rightward-from-cursor screen, " <word  ", width, 7/fg, 0xc5/bg=blue-bg
- 437   draw-text-rightward-from-cursor screen, " f ", width, 0/fg, 0x5c/bg=black
- 438   draw-text-rightward-from-cursor screen, " word>  ", width, 7/fg, 0xc5/bg=blue-bg
- 439   draw-text-rightward-from-cursor screen, " e ", width, 0/fg, 0x5c/bg=black
- 440   draw-text-rightward-from-cursor screen, " >>  ", width, 7/fg, 0xc5/bg=blue-bg
- 441 }
- 442 
- 443 fn render-keyboard-menu screen: (addr screen) {
- 444   var width/eax: int <- copy 0
- 445   var height/ecx: int <- copy 0
- 446   width, height <- screen-size screen
- 447   var y/ecx: int <- copy height
- 448   y <- decrement
- 449   var height/edx: int <- copy y
- 450   height <- increment
- 451   clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg
- 452   set-cursor-position screen, 0/x, y
- 453   draw-text-rightward-from-cursor screen, " ctrl+... ", width, 0xf/fg, 0xc5/bg=blue-bg
- 454   draw-text-rightward-from-cursor screen, " r ", width, 0/fg, 0x5c/bg=black
- 455   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0xc5/bg=blue-bg
- 456   draw-text-rightward-from-cursor screen, " s ", width, 0/fg, 0x5c/bg=black
- 457   draw-text-rightward-from-cursor screen, " run sandbox  ", width, 7/fg, 0xc5/bg=blue-bg
- 458   draw-text-rightward-from-cursor screen, " m ", width, 0/fg, 7/bg
- 459   draw-text-rightward-from-cursor screen, " to sandbox  ", width, 7/fg, 0xc5/bg=blue-bg
- 460 }
- 461 
- 462 fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table), data-disk: (addr disk), real-screen: (addr screen), tweak-real-screen?: boolean {
- 463   var self/esi: (addr sandbox) <- copy _self
- 464   var g/edx: grapheme <- copy key
- 465   # ctrl-s
- 466   {
- 467     compare g, 0x13/ctrl-s
- 468     break-if-!=
- 469     # if cursor is in trace, skip
- 470     var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
- 471     compare *cursor-in-trace?, 0/false
- 472     break-if-!=
- 473     # minor gotcha here: any bindings created later in this iteration won't be
- 474     # persisted until the next call to ctrl-s.
- 475     store-state data-disk, self, globals
- 476     #
- 477     run-sandbox self, globals, real-screen, tweak-real-screen?
- 478     return
- 479   }
- 480   # ctrl-m
- 481   {
- 482     compare g, 0xd/ctrl-m
- 483     break-if-!=
- 484     # if cursor in data, switch to trace or fall through to keyboard
- 485     {
- 486       var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
- 487       compare *cursor-in-data?, 0/false
- 488       break-if-=
- 489       var has-trace?/eax: boolean <- has-trace? self
- 490       compare has-trace?, 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-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
- 496         copy-to *cursor-in-trace?, 1/false
- 497         return
- 498       }
- 499       var has-keyboard?/eax: boolean <- has-keyboard? self
- 500       compare has-keyboard?, 0/false
+ 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
+ 342   {
+ 343     break-if-=
+ 344     return 0/false
+ 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
+ 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?
+ 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-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
- 506         copy-to *cursor-in-keyboard?, 1/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       return
- 510     }
- 511     # if cursor in trace, switch to keyboard or fall through to data
- 512     {
- 513       var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
- 514       compare *cursor-in-trace?, 0/false
- 515       break-if-=
- 516       copy-to *cursor-in-trace?, 0/false
- 517       var cursor-target/ecx: (addr boolean) <- get self, cursor-in-keyboard?
- 518       var has-keyboard?/eax: boolean <- has-keyboard? self
- 519       compare has-keyboard?, 0/false
- 520       {
- 521         break-if-!=
- 522         cursor-target <- get self, cursor-in-data?
- 523       }
- 524       copy-to *cursor-target, 1/true
- 525       return
- 526     }
- 527     # otherwise if cursor in keyboard, switch to data
- 528     {
- 529       var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
- 530       compare *cursor-in-keyboard?, 0/false
- 531       break-if-=
- 532       copy-to *cursor-in-keyboard?, 0/false
- 533       var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
- 534       copy-to *cursor-in-data?, 1/true
+ 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     return
- 538   }
- 539   # if cursor in data, send key to data
- 540   {
- 541     var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
- 542     compare *cursor-in-data?, 0/false
- 543     break-if-=
- 544     var data-ah/eax: (addr handle gap-buffer) <- get self, data
- 545     var data/eax: (addr gap-buffer) <- lookup *data-ah
- 546     edit-gap-buffer data, g
+ 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 keyboard, send key to keyboard
+ 549   # if cursor in data, send key to data
  550   {
- 551     var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
- 552     compare *cursor-in-keyboard?, 0/false
+ 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 keyboard-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
- 555     var keyboard-cell/eax: (addr cell) <- lookup *keyboard-cell-ah
- 556     compare keyboard-cell, 0
- 557     {
- 558       break-if-!=
- 559       return
- 560     }
- 561     var keyboard-cell-type/ecx: (addr int) <- get keyboard-cell, type
- 562     compare *keyboard-cell-type, 6/keyboard
- 563     {
- 564       break-if-=
- 565       return
- 566     }
- 567     var keyboard-ah/eax: (addr handle gap-buffer) <- get keyboard-cell, keyboard-data
- 568     var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
- 569     edit-gap-buffer keyboard, g
- 570     return
- 571   }
- 572   # if cursor in trace, send key to trace
- 573   {
- 574     var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
- 575     compare *cursor-in-trace?, 0/false
- 576     break-if-=
- 577     var trace-ah/eax: (addr handle trace) <- get self, trace
- 578     var trace/eax: (addr trace) <- lookup *trace-ah
- 579     # if expanding the trace, first check if we need to run the sandbox again with a deeper trace
- 580     {
- 581       compare g, 0xa/newline
- 582       break-if-!=
- 583       {
- 584         var need-rerun?/eax: boolean <- cursor-too-deep? trace
- 585         compare need-rerun?, 0/false
- 586       }
- 587       break-if-=
- 588       var max-depth-addr/eax: (addr int) <- get trace, max-depth
- 589       increment *max-depth-addr
- 590       run-sandbox self, globals, real-screen, tweak-real-screen?
- 591     }
- 592     edit-trace trace, g
- 593     return
- 594   }
- 595 }
- 596 
- 597 # hack: tweak-real-screen guards things there are no tests for
- 598 fn run-sandbox _self: (addr sandbox), globals: (addr global-table), real-screen: (addr screen), tweak-real-screen?: boolean {
- 599   var self/esi: (addr sandbox) <- copy _self
- 600   var data-ah/ecx: (addr handle gap-buffer) <- get self, data
- 601   var value-ah/eax: (addr handle stream byte) <- get self, value
- 602   var _value/eax: (addr stream byte) <- lookup *value-ah
- 603   var value/edx: (addr stream byte) <- copy _value
- 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   {
- 609     compare tweak-real-screen?, 0/false
- 610     break-if-=
- 611     clear-sandbox-output real-screen, self, 0x56/sandbox-left-margin, 1/y, 0x80/screen-width, 0x2f/screen-height-without-menu
- 612   }
- 613   var screen-cell/eax: (addr handle cell) <- get self, screen-var
- 614   clear-screen-cell screen-cell
- 615   var keyboard-cell/esi: (addr handle cell) <- get self, keyboard-var
- 616   rewind-keyboard-cell keyboard-cell  # don't clear keys from before
- 617   {
- 618     compare tweak-real-screen?, 0/false
- 619     break-if-=
- 620     set-cursor-position real-screen, 0/x, 0/y  # for any debug prints during evaluation
- 621   }
- 622   run data-ah, value, globals, trace, screen-cell, keyboard-cell
- 623 }
- 624 
- 625 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) {
- 626   var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah
- 627   var in/eax: (addr gap-buffer) <- lookup *in-ah
- 628   var read-result-h: (handle cell)
- 629   var read-result-ah/esi: (addr handle cell) <- address read-result-h
- 630   read-cell in, read-result-ah, trace
- 631   var error?/eax: boolean <- has-errors? trace
- 632   {
- 633     compare error?, 0/false
- 634     break-if-=
- 635     return
- 636   }
- 637   macroexpand read-result-ah, globals, trace
- 638   var error?/eax: boolean <- has-errors? trace
- 639   {
- 640     compare error?, 0/false
- 641     break-if-=
- 642     return
- 643   }
- 644   var nil-h: (handle cell)
- 645   var nil-ah/eax: (addr handle cell) <- address nil-h
- 646   allocate-pair nil-ah
- 647   var eval-result-h: (handle cell)
- 648   var eval-result-ah/edi: (addr handle cell) <- address eval-result-h
- 649 #?   set-cursor-position 0/screen, 0 0
- 650 #?   turn-on-debug-print
- 651   debug-print "^", 4/fg, 0/bg
- 652   evaluate read-result-ah, eval-result-ah, *nil-ah, globals, trace, screen-cell, keyboard-cell, 1/call-number
- 653   debug-print "$", 4/fg, 0/bg
- 654   var error?/eax: boolean <- has-errors? trace
- 655   {
- 656     compare error?, 0/false
- 657     break-if-=
- 658     return
- 659   }
- 660   # if there was no error and the read-result starts with "set" or "def", save
- 661   # the gap buffer in the modified global, then create a new one for the next
- 662   # command.
- 663   maybe-stash-gap-buffer-to-global globals, read-result-ah, _in-ah
- 664   clear-stream out
- 665   print-cell eval-result-ah, out, trace
- 666   mark-lines-dirty trace
- 667 }
- 668 
- 669 fn read-evaluate-and-move-to-globals _in-ah: (addr handle gap-buffer), globals: (addr global-table), definition-name: (addr stream byte) {
- 670   var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah
- 671   var in/eax: (addr gap-buffer) <- lookup *in-ah
- 672   var read-result-h: (handle cell)
- 673   var read-result-ah/esi: (addr handle cell) <- address read-result-h
- 674   var trace-storage: trace
- 675   var trace/edx: (addr trace) <- address trace-storage
- 676   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
- 677   read-cell in, read-result-ah, trace
- 678   macroexpand read-result-ah, globals, trace
- 679   var nil-storage: (handle cell)
- 680   var nil-ah/eax: (addr handle cell) <- address nil-storage
- 681   allocate-pair nil-ah
- 682   var eval-result-storage: (handle cell)
- 683   var eval-result/edi: (addr handle cell) <- address eval-result-storage
- 684   debug-print "^", 4/fg, 0/bg
- 685   evaluate read-result-ah, eval-result, *nil-ah, globals, trace, 0/no-screen-cell, 0/no-keyboard-cell, 1/call-number
- 686   {
- 687     var error?/eax: boolean <- has-errors? trace
- 688     compare error?, 0/false
- 689     break-if-=
- 690     set-cursor-position 0/screen, 0x40/x, 0x18/y
- 691     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "error when loading definition for ", 4/fg 0/bg
- 692     rewind-stream definition-name
- 693     draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, definition-name, 3/fg 0/bg
- 694     set-cursor-position 0/screen, 0x40/x, 0x19/y
- 695     draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "see trace in grey at top-left", 7/fg 0/bg
- 696     dump-trace trace  # will print from 0, 0
- 697     {
- 698       loop
- 699     }
- 700   }
- 701   debug-print "$", 4/fg, 0/bg
- 702   move-gap-buffer-to-global globals, read-result-ah, _in-ah
- 703 }
- 704 
- 705 fn test-run-integer {
- 706   var sandbox-storage: sandbox
- 707   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 708   initialize-sandbox-with sandbox, "1"
- 709   # eval
- 710   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 711   # setup: screen
- 712   var screen-on-stack: screen
- 713   var screen/edi: (addr screen) <- address screen-on-stack
- 714   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 715   #
- 716   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 717   # skip one line of padding
- 718   check-screen-row screen, 1/y, " 1    ", "F - test-run-integer/0"
- 719   check-screen-row screen, 2/y, " ...  ", "F - test-run-integer/1"
- 720   check-screen-row screen, 3/y, " => 1 ", "F - test-run-integer/2"
- 721 }
- 722 
- 723 fn test-run-error-invalid-integer {
- 724   var sandbox-storage: sandbox
- 725   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 726   initialize-sandbox-with sandbox, "1a"
- 727   # eval
- 728   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 729   # setup: screen
- 730   var screen-on-stack: screen
- 731   var screen/edi: (addr screen) <- address screen-on-stack
- 732   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 733   #
- 734   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 735   # skip one line of padding
- 736   check-screen-row            screen,               1/y, " 1a             ", "F - test-run-error-invalid-integer/0"
- 737   check-screen-row            screen,               2/y, " ...            ", "F - test-run-error-invalid-integer/1"
- 738   check-screen-row-in-color   screen, 0xc/fg=error, 3/y, " invalid number ", "F - test-run-error-invalid-integer/2"
- 739 }
- 740 
- 741 fn test-run-error-unknown-symbol {
- 742   var sandbox-storage: sandbox
- 743   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 744   initialize-sandbox-with sandbox, "a"
- 745   # eval
- 746   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 747   # setup: screen
- 748   var screen-on-stack: screen
- 749   var screen/edi: (addr screen) <- address screen-on-stack
- 750   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 751   #
- 752   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 753   # skip one line of padding
- 754   check-screen-row            screen,               1/y, " a                  ", "F - test-run-error-unknown-symbol/0"
- 755   check-screen-row            screen,               2/y, " ...                ", "F - test-run-error-unknown-symbol/1"
- 756   check-screen-row-in-color   screen, 0xc/fg=error, 3/y, " unbound symbol: a  ", "F - test-run-error-unknown-symbol/2"
- 757 }
- 758 
- 759 fn test-run-with-spaces {
- 760   var sandbox-storage: sandbox
- 761   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 762   initialize-sandbox-with sandbox, " 1 \n"
- 763   # eval
- 764   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 765   # setup: screen
- 766   var screen-on-stack: screen
- 767   var screen/edi: (addr screen) <- address screen-on-stack
- 768   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 769   #
- 770   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 771   # skip one line of padding
- 772   check-screen-row screen, 1/y, "  1   ", "F - test-run-with-spaces/0"
- 773   check-screen-row screen, 2/y, "      ", "F - test-run-with-spaces/1"
- 774   check-screen-row screen, 3/y, " ...  ", "F - test-run-with-spaces/2"
- 775   check-screen-row screen, 4/y, " => 1 ", "F - test-run-with-spaces/3"
- 776 }
- 777 
- 778 fn test-run-quote {
- 779   var sandbox-storage: sandbox
- 780   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 781   initialize-sandbox-with sandbox, "'a"
- 782   # eval
- 783   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 784   # setup: screen
- 785   var screen-on-stack: screen
- 786   var screen/edi: (addr screen) <- address screen-on-stack
- 787   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 788   #
- 789   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 790   # skip one line of padding
- 791   check-screen-row screen, 1/y, " 'a   ", "F - test-run-quote/0"
- 792   check-screen-row screen, 2/y, " ...  ", "F - test-run-quote/1"
- 793   check-screen-row screen, 3/y, " => a ", "F - test-run-quote/2"
- 794 }
- 795 
- 796 fn test-run-dotted-list {
- 797   var sandbox-storage: sandbox
- 798   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 799   initialize-sandbox-with sandbox, "'(a . b)"
- 800   # eval
- 801   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 802   # setup: screen
- 803   var screen-on-stack: screen
- 804   var screen/edi: (addr screen) <- address screen-on-stack
- 805   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 806   #
- 807   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 808   # skip one line of padding
- 809   check-screen-row screen, 1/y, " '(a . b)   ", "F - test-run-dotted-list/0"
- 810   check-screen-row screen, 2/y, " ...        ", "F - test-run-dotted-list/1"
- 811   check-screen-row screen, 3/y, " => (a . b) ", "F - test-run-dotted-list/2"
- 812 }
- 813 
- 814 fn test-run-dot-and-list {
- 815   var sandbox-storage: sandbox
- 816   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 817   initialize-sandbox-with sandbox, "'(a . (b))"
- 818   # eval
- 819   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 820   # setup: screen
- 821   var screen-on-stack: screen
- 822   var screen/edi: (addr screen) <- address screen-on-stack
- 823   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 824   #
- 825   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 826   # skip one line of padding
- 827   check-screen-row screen, 1/y, " '(a . (b)) ", "F - test-run-dot-and-list/0"
- 828   check-screen-row screen, 2/y, " ...        ", "F - test-run-dot-and-list/1"
- 829   check-screen-row screen, 3/y, " => (a b)   ", "F - test-run-dot-and-list/2"
- 830 }
- 831 
- 832 fn test-run-final-dot {
- 833   var sandbox-storage: sandbox
- 834   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 835   initialize-sandbox-with sandbox, "'(a .)"
- 836   # eval
- 837   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 838   # setup: screen
- 839   var screen-on-stack: screen
- 840   var screen/edi: (addr screen) <- address screen-on-stack
- 841   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 842   #
- 843   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 844   # skip one line of padding
- 845   check-screen-row screen, 1/y, " '(a .)               ", "F - test-run-final-dot/0"
- 846   check-screen-row screen, 2/y, " ...                  ", "F - test-run-final-dot/1"
- 847   check-screen-row screen, 3/y, " '. )' makes no sense ", "F - test-run-final-dot/2"
- 848   # further errors may occur
- 849 }
- 850 
- 851 fn test-run-double-dot {
- 852   var sandbox-storage: sandbox
- 853   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 854   initialize-sandbox-with sandbox, "'(a . .)"
- 855   # eval
- 856   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 857   # setup: screen
- 858   var screen-on-stack: screen
- 859   var screen/edi: (addr screen) <- address screen-on-stack
- 860   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 861   #
- 862   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 863   # skip one line of padding
- 864   check-screen-row screen, 1/y, " '(a . .)             ", "F - test-run-double-dot/0"
- 865   check-screen-row screen, 2/y, " ...                  ", "F - test-run-double-dot/1"
- 866   check-screen-row screen, 3/y, " '. .' makes no sense ", "F - test-run-double-dot/2"
- 867   # further errors may occur
- 868 }
- 869 
- 870 fn test-run-multiple-expressions-after-dot {
- 871   var sandbox-storage: sandbox
- 872   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 873   initialize-sandbox-with sandbox, "'(a . b c)"
- 874   # eval
- 875   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 876   # setup: screen
- 877   var screen-on-stack: screen
- 878   var screen/edi: (addr screen) <- address screen-on-stack
- 879   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 880   #
- 881   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 882   # skip one line of padding
- 883   check-screen-row screen, 1/y, " '(a . b c)                                           ", "F - test-run-multiple-expressions-after-dot/0"
- 884   check-screen-row screen, 2/y, " ...                                                  ", "F - test-run-multiple-expressions-after-dot/1"
- 885   check-screen-row screen, 3/y, " cannot have multiple expressions between '.' and ')' ", "F - test-run-multiple-expressions-after-dot/2"
- 886   # further errors may occur
- 887 }
- 888 
- 889 fn test-run-stream {
- 890   var sandbox-storage: sandbox
- 891   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 892   initialize-sandbox-with sandbox, "[a b]"
- 893   # eval
- 894   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 895   # setup: screen
- 896   var screen-on-stack: screen
- 897   var screen/edi: (addr screen) <- address screen-on-stack
- 898   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 899   #
- 900   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 901   # skip one line of padding
- 902   check-screen-row screen, 1/y, " [a b]    ", "F - test-run-stream/0"
- 903   check-screen-row screen, 2/y, " ...      ", "F - test-run-stream/1"
- 904   check-screen-row screen, 3/y, " => [a b] ", "F - test-run-stream/2"
- 905 }
- 906 
- 907 fn test-run-move-cursor-into-trace {
- 908   var sandbox-storage: sandbox
- 909   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 910   initialize-sandbox-with sandbox, "12"
- 911   # eval
- 912   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 913   # setup: screen
- 914   var screen-on-stack: screen
- 915   var screen/edi: (addr screen) <- address screen-on-stack
- 916   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 917   #
- 918   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 919   # skip one line of padding
- 920   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-move-cursor-into-trace/pre-0"
- 921   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "   |   ", "F - test-run-move-cursor-into-trace/pre-0/cursor"
- 922   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-move-cursor-into-trace/pre-1"
- 923   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "       ", "F - test-run-move-cursor-into-trace/pre-1/cursor"
- 924   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-move-cursor-into-trace/pre-2"
- 925   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-move-cursor-into-trace/pre-2/cursor"
- 926   # move cursor into trace
- 927   edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 928   #
- 929   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 930   # skip one line of padding
- 931   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-move-cursor-into-trace/trace-0"
- 932   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "       ", "F - test-run-move-cursor-into-trace/trace-0/cursor"
- 933   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-move-cursor-into-trace/trace-1"
- 934   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " |||   ", "F - test-run-move-cursor-into-trace/trace-1/cursor"
- 935   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-move-cursor-into-trace/trace-2"
- 936   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-move-cursor-into-trace/trace-2/cursor"
- 937   # move cursor into input
- 938   edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 939   #
- 940   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 941   # skip one line of padding
- 942   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-move-cursor-into-trace/input-0"
- 943   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "   |   ", "F - test-run-move-cursor-into-trace/input-0/cursor"
- 944   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-move-cursor-into-trace/input-1"
- 945   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "       ", "F - test-run-move-cursor-into-trace/input-1/cursor"
- 946   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-move-cursor-into-trace/input-2"
- 947   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-move-cursor-into-trace/input-2/cursor"
- 948 }
- 949 
- 950 fn has-trace? _self: (addr sandbox) -> _/eax: boolean {
- 951   var self/esi: (addr sandbox) <- copy _self
- 952   var trace-ah/eax: (addr handle trace) <- get self, trace
- 953   var _trace/eax: (addr trace) <- lookup *trace-ah
- 954   var trace/edx: (addr trace) <- copy _trace
- 955   compare trace, 0
- 956   {
- 957     break-if-!=
- 958     abort "null trace"
- 959   }
- 960   var first-free/ebx: (addr int) <- get trace, first-free
- 961   compare *first-free, 0
- 962   {
- 963     break-if->
- 964     return 0/false
- 965   }
- 966   return 1/true
- 967 }
- 968 
- 969 fn test-run-expand-trace {
- 970   var sandbox-storage: sandbox
- 971   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 972   initialize-sandbox-with sandbox, "12"
- 973   # eval
- 974   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 975   # setup: screen
- 976   var screen-on-stack: screen
- 977   var screen/edi: (addr screen) <- address screen-on-stack
- 978   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 979   #
- 980   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 981   # skip one line of padding
- 982   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-expand-trace/pre0-0"
- 983   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "   |   ", "F - test-run-expand-trace/pre0-0/cursor"
- 984   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-expand-trace/pre0-1"
- 985   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "       ", "F - test-run-expand-trace/pre0-1/cursor"
- 986   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-expand-trace/pre0-2"
- 987   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-expand-trace/pre0-2/cursor"
- 988   # move cursor into trace
- 989   edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 990   #
- 991   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 992   # skip one line of padding
- 993   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-expand-trace/pre1-0"
- 994   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "       ", "F - test-run-expand-trace/pre1-0/cursor"
- 995   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-expand-trace/pre1-1"
- 996   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " |||   ", "F - test-run-expand-trace/pre1-1/cursor"
- 997   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-expand-trace/pre1-2"
- 998   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-expand-trace/pre1-2/cursor"
- 999   # expand
-1000   edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-1001   #
-1002   clear-screen screen
-1003   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-1004   # skip one line of padding
-1005   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-expand-trace/expand-0"
-1006   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "       ", "F - test-run-expand-trace/expand-0/cursor"
-1007   check-screen-row screen,                                  2/y, " 1 toke", "F - test-run-expand-trace/expand-1"
-1008   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||||||", "F - test-run-expand-trace/expand-1/cursor"
-1009   check-screen-row screen,                                  3/y, " ...   ", "F - test-run-expand-trace/expand-2"
-1010   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-expand-trace/expand-2/cursor"
-1011   check-screen-row screen,                                  4/y, " 1 pars", "F - test-run-expand-trace/expand-2"
-1012   check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, "       ", "F - test-run-expand-trace/expand-2/cursor"
-1013 }
-1014 
-1015 fn test-run-can-rerun-when-expanding-trace {
-1016   var sandbox-storage: sandbox
-1017   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-1018   # initialize sandbox with a max-depth of 3
-1019   initialize-sandbox-with sandbox, "12"
-1020   # eval
-1021   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-1022   # setup: screen
-1023   var screen-on-stack: screen
-1024   var screen/edi: (addr screen) <- address screen-on-stack
-1025   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
-1026   #
-1027   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-1028   # skip one line of padding
-1029   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-can-rerun-when-expanding-trace/pre0-0"
-1030   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "   |   ", "F - test-run-can-rerun-when-expanding-trace/pre0-0/cursor"
-1031   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-can-rerun-when-expanding-trace/pre0-1"
-1032   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "       ", "F - test-run-can-rerun-when-expanding-trace/pre0-1/cursor"
-1033   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-can-rerun-when-expanding-trace/pre0-2"
-1034   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-can-rerun-when-expanding-trace/pre0-2/cursor"
-1035   # move cursor into trace
-1036   edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-1037   #
-1038   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-1039   # skip one line of padding
-1040   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-can-rerun-when-expanding-trace/pre1-0"
-1041   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "       ", "F - test-run-can-rerun-when-expanding-trace/pre1-0/cursor"
-1042   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-can-rerun-when-expanding-trace/pre1-1"
-1043   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " |||   ", "F - test-run-can-rerun-when-expanding-trace/pre1-1/cursor"
-1044   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-can-rerun-when-expanding-trace/pre1-2"
-1045   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-can-rerun-when-expanding-trace/pre1-2/cursor"
-1046   # expand
-1047   edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-1048   #
-1049   clear-screen screen
-1050   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-1051   # skip one line of padding
-1052   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-can-rerun-when-expanding-trace/pre2-0"
-1053   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "       ", "F - test-run-can-rerun-when-expanding-trace/pre2-0/cursor"
-1054   check-screen-row screen,                                  2/y, " 1 toke", "F - test-run-can-rerun-when-expanding-trace/pre2-1"
-1055   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ||||||", "F - test-run-can-rerun-when-expanding-trace/pre2-1/cursor"
-1056   check-screen-row screen,                                  3/y, " ...   ", "F - test-run-can-rerun-when-expanding-trace/pre2-2"
-1057   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-can-rerun-when-expanding-trace/pre2-2/cursor"
-1058   check-screen-row screen,                                  4/y, " 1 pars", "F - test-run-can-rerun-when-expanding-trace/pre2-2"
-1059   check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, "       ", "F - test-run-can-rerun-when-expanding-trace/pre2-2/cursor"
-1060   # move cursor down and expand
-1061   edit-sandbox sandbox, 0x6a/j, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-1062   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-1063   edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-1064   #
-1065   clear-screen screen
-1066   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-1067   # screen looks same as if trace max-depth was really high
-1068   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-can-rerun-when-expanding-trace/expand-0"
-1069   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "       ", "F - test-run-can-rerun-when-expanding-trace/expand-0/cursor"
-1070   check-screen-row screen,                                  2/y, " 1 toke", "F - test-run-can-rerun-when-expanding-trace/expand-1"
-1071   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "       ", "F - test-run-can-rerun-when-expanding-trace/expand-1/cursor"
-1072   check-screen-row screen,                                  3/y, " 2 next", "F - test-run-can-rerun-when-expanding-trace/expand-2"
-1073   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ||||||", "F - test-run-can-rerun-when-expanding-trace/expand-2/cursor"
-1074   check-screen-row screen,                                  4/y, " ...   ", "F - test-run-can-rerun-when-expanding-trace/expand-3"
-1075   check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, "       ", "F - test-run-can-rerun-when-expanding-trace/expand-3/cursor"
-1076   check-screen-row screen,                                  5/y, " 2 => 1", "F - test-run-can-rerun-when-expanding-trace/expand-4"
-1077   check-background-color-in-screen-row screen, 7/bg=cursor, 5/y, "       ", "F - test-run-can-rerun-when-expanding-trace/expand-4/cursor"
-1078 }
+ 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
+ 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
+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 }
diff --git a/html/shell/tokenize.mu.html b/html/shell/tokenize.mu.html index 22c33dde..46eb9a77 100644 --- a/html/shell/tokenize.mu.html +++ b/html/shell/tokenize.mu.html @@ -14,14 +14,20 @@ 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; } -.Special { color: #ff6060; } .LineNr { } -.Constant { color: #008787; } .Delimiter { color: #c000c0; } +.muRegEbx { color: #8787af; } +.muRegEsi { color: #87d787; } +.muRegEdi { color: #87ffd7; } +.Constant { color: #008787; } +.Special { color: #ff6060; } +.PreProc { color: #c000c0; } .muFunction { color: #af5f00; text-decoration: underline; } .muTest { color: #5f8700; } .muComment { color: #005faf; } +.muRegEax { color: #875f00; } +.muRegEcx { color: #af875f; } +.muRegEdx { color: #878700; } --> @@ -62,239 +68,239 @@ if ('onhashchange' in window) { 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 + 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 + 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 + 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 + 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 + 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 + 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)" + 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 + 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 + 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 + 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 + 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 + 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 + 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)" + 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 + 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 + 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 + 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 + 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 + 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 + 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)" + 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 + 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 + 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 +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 +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 +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 +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" +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 +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 +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 +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 +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)" +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 +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 +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 +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 +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 +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 +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]" +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 +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 +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 +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 +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" +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 +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])" +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 +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 +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 +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 +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 +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" +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 +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 +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 +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 +227 var stream/esi: (addr stream byte) <- address stream-storage 228 write stream, "next: " -229 var gval/eax: int <- copy g +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 +233 var out-cell/eax: (addr cell) <- copy _out-cell 234 { -235 var out-cell-type/eax: (addr int) <- get out-cell, type +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 +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. @@ -306,19 +312,19 @@ if ('onhashchange' in window) { 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 +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 +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 +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 +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 } @@ -331,7 +337,7 @@ if ('onhashchange' in window) { 272 } 273 # digit 274 { -275 var digit?/eax: boolean <- decimal-digit? g +275 var digit?/eax: boolean <- decimal-digit? g 276 compare digit?, 0/false 277 break-if-= 278 next-number-token in, out, trace @@ -339,7 +345,7 @@ if ('onhashchange' in window) { 280 } 281 # other symbol char 282 { -283 var symbol?/eax: boolean <- symbol-grapheme? g +283 var symbol?/eax: boolean <- symbol-grapheme? g 284 compare symbol?, 0/false 285 break-if-= 286 next-symbol-token in, out, trace @@ -349,21 +355,21 @@ if ('onhashchange' in window) { 290 { 291 compare g, 0x5d/close-square-bracket 292 break-if-!= -293 error trace, "unbalanced ']'" +293 error trace, "unbalanced ']'" 294 return 295 } 296 # other brackets are always single-char tokens 297 { -298 var bracket?/eax: boolean <- bracket-grapheme? g +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 +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 +307 var operator?/eax: boolean <- operator-grapheme? g 308 compare operator?, 0/false 309 break-if-= 310 next-operator-token in, out, trace @@ -373,7 +379,7 @@ if ('onhashchange' in window) { 314 { 315 compare g, 0x27/single-quote 316 break-if-!= -317 var g/eax: grapheme <- read-from-gap-buffer in # consume +317 var g/eax: grapheme <- read-from-gap-buffer in # consume 318 write-grapheme out, g 319 break $next-token:case 320 } @@ -381,7 +387,7 @@ if ('onhashchange' in window) { 322 { 323 compare g, 0x60/backquote 324 break-if-!= -325 var g/eax: grapheme <- read-from-gap-buffer in # consume +325 var g/eax: grapheme <- read-from-gap-buffer in # consume 326 write-grapheme out, g 327 break $next-token:case 328 } @@ -389,23 +395,23 @@ if ('onhashchange' in window) { 330 { 331 compare g, 0x2c/comma 332 break-if-!= -333 var g/eax: grapheme <- read-from-gap-buffer in # consume +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 +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 +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 +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 +349 var stream/eax: (addr stream byte) <- address stream-storage 350 write stream, "=> " 351 rewind-stream out 352 write-stream stream, out @@ -413,36 +419,36 @@ if ('onhashchange' in window) { 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 +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 +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 +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 +366 var stream/esi: (addr stream byte) <- address stream-storage 367 write stream, "next: " -368 var gval/eax: int <- copy g +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 +374 var symbol-grapheme?/eax: boolean <- symbol-grapheme? g 375 compare symbol-grapheme?, 0/false 376 break-if-!= -377 trace-text trace, "tokenize", "stop" +377 trace-text trace, "tokenize", "stop" 378 break $next-symbol-token:loop 379 } -380 var g/eax: grapheme <- read-from-gap-buffer in +380 var g/eax: grapheme <- read-from-gap-buffer in 381 write-grapheme out, g 382 loop 383 } -384 trace-higher trace +384 trace-higher trace 385 var stream-storage: (stream byte 0x40) -386 var stream/esi: (addr stream byte) <- address stream-storage +386 var stream/esi: (addr stream byte) <- address stream-storage 387 write stream, "=> " 388 rewind-stream out 389 write-stream stream, out @@ -450,36 +456,36 @@ if ('onhashchange' in window) { 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 +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 +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 +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 +403 var stream/esi: (addr stream byte) <- address stream-storage 404 write stream, "next: " -405 var gval/eax: int <- copy g +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 +411 var operator-grapheme?/eax: boolean <- operator-grapheme? g 412 compare operator-grapheme?, 0/false 413 break-if-!= -414 trace-text trace, "tokenize", "stop" +414 trace-text trace, "tokenize", "stop" 415 break $next-operator-token:loop 416 } -417 var g/eax: grapheme <- read-from-gap-buffer in +417 var g/eax: grapheme <- read-from-gap-buffer in 418 write-grapheme out, g 419 loop 420 } -421 trace-higher trace +421 trace-higher trace 422 var stream-storage: (stream byte 0x40) -423 var stream/esi: (addr stream byte) <- address stream-storage +423 var stream/esi: (addr stream byte) <- address stream-storage 424 write stream, "=> " 425 rewind-stream out 426 write-stream stream, out @@ -487,63 +493,63 @@ if ('onhashchange' in window) { 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 +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 +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 +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 +440 var stream/esi: (addr stream byte) <- address stream-storage 441 write stream, "next: " -442 var gval/eax: int <- copy g +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 +448 var symbol-grapheme?/eax: boolean <- symbol-grapheme? g 449 compare symbol-grapheme?, 0/false 450 break-if-!= -451 trace-text trace, "tokenize", "stop" +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 +456 var digit?/eax: boolean <- decimal-digit? g 457 compare digit?, 0/false 458 break-if-!= -459 error trace, "invalid number" +459 error trace, "invalid number" 460 return 461 } -462 trace-text trace, "tokenize", "append" -463 var g/eax: grapheme <- read-from-gap-buffer in +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 +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" +471 trace-text trace, "tokenize", "stream" 472 { -473 var empty?/eax: boolean <- gap-buffer-scan-done? in +473 var empty?/eax: boolean <- gap-buffer-scan-done? in 474 compare empty?, 0/false 475 { 476 break-if-= -477 error trace, "unbalanced '['" +477 error trace, "unbalanced '['" 478 return 479 } -480 var g/eax: grapheme <- read-from-gap-buffer in +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 +487 var stream/esi: (addr stream byte) <- address stream-storage 488 write stream, "=> " 489 rewind-stream out 490 write-stream stream, out @@ -551,10 +557,10 @@ if ('onhashchange' in window) { 492 } 493 494 fn next-bracket-token g: grapheme, out: (addr stream byte), trace: (addr trace) { -495 trace-text trace, "tokenize", "bracket" +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 +498 var stream/esi: (addr stream byte) <- address stream-storage 499 write stream, "=> " 500 rewind-stream out 501 write-stream stream, out @@ -562,29 +568,29 @@ if ('onhashchange' in window) { 503 } 504 505 fn rest-of-line in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { -506 trace-text trace, "tokenize", "comment" +506 trace-text trace, "tokenize", "comment" 507 { -508 var empty?/eax: boolean <- gap-buffer-scan-done? in +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 +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 +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 { +528 fn symbol-grapheme? g: grapheme -> _/eax: boolean { 529 ## whitespace 530 compare g, 9/tab 531 { @@ -756,7 +762,7 @@ if ('onhashchange' in window) { 697 return 1/true 698 } 699 -700 fn bracket-grapheme? g: grapheme -> _/eax: boolean { +700 fn bracket-grapheme? g: grapheme -> _/eax: boolean { 701 compare g, 0x28/open-paren 702 { 703 break-if-!= @@ -790,7 +796,7 @@ if ('onhashchange' in window) { 731 return 0/false 732 } 733 -734 fn operator-grapheme? g: grapheme -> _/eax: boolean { +734 fn operator-grapheme? g: grapheme -> _/eax: boolean { 735 # '$' is a symbol char 736 compare g, 0x25/percent 737 { @@ -897,112 +903,112 @@ if ('onhashchange' in window) { 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 +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 +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 +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 +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 +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 +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 +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, "'" +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 +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, "`" +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 +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, "," +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 +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, ",@" +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 +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 +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 +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 +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 +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 +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 +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 +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 +946 var result/eax: boolean <- stream-empty? in-data 947 return result 948 } 949 return 0/false @@ -1010,16 +1016,16 @@ if ('onhashchange' in window) { 951 952 fn test-dot-token { 953 var tmp-storage: (handle cell) -954 var tmp-ah/eax: (addr handle cell) <- address tmp-storage +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 +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 +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-= @@ -1028,12 +1034,12 @@ if ('onhashchange' in window) { 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 +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 +977 var g/eax: grapheme <- read-grapheme in-data 978 compare g, 0x23/hash 979 { 980 break-if-= diff --git a/html/shell/trace.mu.html b/html/shell/trace.mu.html index e1bfe1c0..56a78d1f 100644 --- a/html/shell/trace.mu.html +++ b/html/shell/trace.mu.html @@ -14,14 +14,21 @@ 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; } -.Special { color: #ff6060; } .LineNr { } -.Constant { color: #008787; } .Delimiter { color: #c000c0; } +.CommentedCode { color: #8a8a8a; } +.muRegEbx { color: #8787af; } +.muRegEsi { color: #87d787; } +.muRegEdi { color: #87ffd7; } +.Constant { color: #008787; } +.Special { color: #ff6060; } +.PreProc { color: #c000c0; } .muFunction { color: #af5f00; text-decoration: underline; } .muTest { color: #5f8700; } .muComment { color: #005faf; } +.muRegEax { color: #875f00; } +.muRegEcx { color: #af875f; } +.muRegEdx { color: #878700; } --> @@ -91,7 +98,7 @@ if ('onhashchange' in window) { 32 recreate-caches?: boolean 33 cursor-line-index: int # index into data 34 cursor-y: int # row index on screen - 35 unclip-cursor-line?: boolean # extremely short-lived; reset any time cursor moves + 35 unclip-cursor-line?: boolean # extremely short-lived; reset any time cursor moves 36 top-line-index: int # start rendering trace past this index into data (updated on re-evaluation) 37 top-line-y: int # trace starts rendering at this row index on screen (updated on re-evaluation) 38 screen-height: int # initialized during render-trace @@ -104,2041 +111,2178 @@ if ('onhashchange' in window) { 45 visible?: boolean 46 } 47 - 48 ## generating traces - 49 - 50 fn initialize-trace _self: (addr trace), max-depth: int, capacity: int, visible-capacity: int { - 51 var self/esi: (addr trace) <- copy _self - 52 compare self, 0 - 53 { - 54 break-if-!= - 55 abort "null trace" - 56 } - 57 var src/ecx: int <- copy max-depth - 58 var dest/eax: (addr int) <- get self, max-depth - 59 copy-to *dest, src - 60 dest <- get self, curr-depth - 61 copy-to *dest, 1 # 0 is the error depth - 62 var trace-ah/eax: (addr handle array trace-line) <- get self, data - 63 populate trace-ah, capacity - 64 var visible-ah/eax: (addr handle array trace-line) <- get self, visible - 65 populate visible-ah, visible-capacity - 66 mark-lines-dirty self - 67 } - 68 - 69 fn clear-trace _self: (addr trace) { - 70 var self/eax: (addr trace) <- copy _self - 71 compare self, 0 - 72 { - 73 break-if-!= - 74 abort "null trace" - 75 } - 76 var curr-depth-addr/ecx: (addr int) <- get self, curr-depth - 77 copy-to *curr-depth-addr, 1 - 78 var len/edx: (addr int) <- get self, first-free - 79 copy-to *len, 0 - 80 # might leak memory; existing elements won't be used anymore - 81 } - 82 - 83 fn has-errors? _self: (addr trace) -> _/eax: boolean { - 84 var self/eax: (addr trace) <- copy _self - 85 compare self, 0 - 86 { - 87 break-if-!= - 88 abort "null trace" - 89 } - 90 var max/edx: (addr int) <- get self, first-free - 91 var trace-ah/eax: (addr handle array trace-line) <- get self, data - 92 var _trace/eax: (addr array trace-line) <- lookup *trace-ah - 93 var trace/esi: (addr array trace-line) <- copy _trace - 94 var i/ecx: int <- copy 0 - 95 { - 96 compare i, *max - 97 break-if->= - 98 var offset/eax: (offset trace-line) <- compute-offset trace, i - 99 var curr/eax: (addr trace-line) <- index trace, offset - 100 var curr-depth-a/eax: (addr int) <- get curr, depth - 101 compare *curr-depth-a, 0/error - 102 { - 103 break-if-!= - 104 return 1/true - 105 } - 106 i <- increment - 107 loop - 108 } - 109 return 0/false - 110 } - 111 - 112 fn should-trace? _self: (addr trace) -> _/eax: boolean { - 113 var self/esi: (addr trace) <- copy _self - 114 compare self, 0 - 115 { - 116 break-if-!= - 117 abort "null trace" - 118 } - 119 var depth-a/ecx: (addr int) <- get self, curr-depth - 120 var depth/ecx: int <- copy *depth-a - 121 var max-depth-a/eax: (addr int) <- get self, max-depth - 122 compare depth, *max-depth-a - 123 { - 124 break-if->= - 125 return 1/true - 126 } - 127 return 0/false - 128 } - 129 - 130 fn trace _self: (addr trace), label: (addr array byte), message: (addr stream byte) { - 131 var self/esi: (addr trace) <- copy _self - 132 compare self, 0 - 133 { - 134 break-if-!= - 135 abort "null trace" - 136 } - 137 var should-trace?/eax: boolean <- should-trace? self - 138 compare should-trace?, 0/false - 139 { - 140 break-if-!= - 141 return - 142 } - 143 var data-ah/eax: (addr handle array trace-line) <- get self, data - 144 var data/eax: (addr array trace-line) <- lookup *data-ah - 145 var index-addr/edi: (addr int) <- get self, first-free - 146 { - 147 compare *index-addr, 0x8000/lines - 148 break-if-< - 149 return - 150 } - 151 var index/ecx: int <- copy *index-addr - 152 var offset/ecx: (offset trace-line) <- compute-offset data, index - 153 var dest/eax: (addr trace-line) <- index data, offset - 154 var depth/ecx: (addr int) <- get self, curr-depth - 155 rewind-stream message - 156 { - 157 compare *index-addr, 0x7fff/lines - 158 break-if-< - 159 clear-stream message - 160 write message, "No space left in trace\n" - 161 write message, "Please either:\n" - 162 write message, " - find a smaller sub-computation to test,\n" - 163 write message, " - allocate more space to the trace in initialize-sandbox\n" - 164 write message, " (shell/sandbox.mu), or\n" - 165 write message, " - move the computation to 'main' and run it using ctrl-r" - 166 initialize-trace-line 0/depth, "error", message, dest - 167 increment *index-addr - 168 return - 169 } - 170 initialize-trace-line *depth, label, message, dest - 171 increment *index-addr - 172 } - 173 - 174 fn trace-text self: (addr trace), label: (addr array byte), s: (addr array byte) { - 175 compare self, 0 - 176 { - 177 break-if-!= - 178 abort "null trace" - 179 } - 180 var data-storage: (stream byte 0x100) - 181 var data/eax: (addr stream byte) <- address data-storage - 182 write data, s - 183 trace self, label, data - 184 } - 185 - 186 fn error _self: (addr trace), message: (addr array byte) { - 187 var self/esi: (addr trace) <- copy _self - 188 compare self, 0 - 189 { - 190 break-if-!= - 191 abort "null trace" - 192 } - 193 var curr-depth-a/eax: (addr int) <- get self, curr-depth - 194 var save-depth/ecx: int <- copy *curr-depth-a - 195 copy-to *curr-depth-a, 0/error - 196 trace-text self, "error", message - 197 copy-to *curr-depth-a, save-depth - 198 } - 199 - 200 fn error-stream _self: (addr trace), message: (addr stream byte) { - 201 var self/esi: (addr trace) <- copy _self - 202 compare self, 0 - 203 { - 204 break-if-!= - 205 abort "null trace" - 206 } - 207 var curr-depth-a/eax: (addr int) <- get self, curr-depth - 208 var save-depth/ecx: int <- copy *curr-depth-a - 209 copy-to *curr-depth-a, 0/error - 210 trace self, "error", message - 211 copy-to *curr-depth-a, save-depth - 212 } - 213 - 214 fn initialize-trace-line depth: int, label: (addr array byte), data: (addr stream byte), _out: (addr trace-line) { - 215 var out/edi: (addr trace-line) <- copy _out - 216 # depth - 217 var src/eax: int <- copy depth - 218 var dest/ecx: (addr int) <- get out, depth - 219 copy-to *dest, src - 220 # label - 221 var dest/eax: (addr handle array byte) <- get out, label - 222 copy-array-object label, dest - 223 # data - 224 var dest/eax: (addr handle array byte) <- get out, data - 225 stream-to-array data, dest - 226 } - 227 - 228 fn trace-lower _self: (addr trace) { - 229 var self/esi: (addr trace) <- copy _self - 230 compare self, 0 - 231 { - 232 break-if-!= - 233 abort "null trace" - 234 } - 235 var depth/eax: (addr int) <- get self, curr-depth - 236 increment *depth + 48 # when we recreate the trace this data structure will help stabilize our view into it + 49 # we can shallowly copy handles because lines are not reused across reruns + 50 type trace-index-stash { + 51 cursor-line-depth: int + 52 cursor-line-label: (handle array byte) + 53 cursor-line-data: (handle array byte) + 54 top-line-depth: int + 55 top-line-label: (handle array byte) + 56 top-line-data: (handle array byte) + 57 } + 58 + 59 ## generating traces + 60 + 61 fn initialize-trace _self: (addr trace), max-depth: int, capacity: int, visible-capacity: int { + 62 var self/esi: (addr trace) <- copy _self + 63 compare self, 0 + 64 { + 65 break-if-!= + 66 abort "null trace" + 67 } + 68 var src/ecx: int <- copy max-depth + 69 var dest/eax: (addr int) <- get self, max-depth + 70 copy-to *dest, src + 71 dest <- get self, curr-depth + 72 copy-to *dest, 1 # 0 is the error depth + 73 var trace-ah/eax: (addr handle array trace-line) <- get self, data + 74 populate trace-ah, capacity + 75 var visible-ah/eax: (addr handle array trace-line) <- get self, visible + 76 populate visible-ah, visible-capacity + 77 mark-lines-dirty self + 78 } + 79 + 80 fn clear-trace _self: (addr trace) { + 81 var self/eax: (addr trace) <- copy _self + 82 compare self, 0 + 83 { + 84 break-if-!= + 85 abort "null trace" + 86 } + 87 var curr-depth-addr/ecx: (addr int) <- get self, curr-depth + 88 copy-to *curr-depth-addr, 1 + 89 var len/edx: (addr int) <- get self, first-free + 90 copy-to *len, 0 + 91 # leak: nested handles within trace-lines + 92 } + 93 + 94 fn has-errors? _self: (addr trace) -> _/eax: boolean { + 95 var self/eax: (addr trace) <- copy _self + 96 compare self, 0 + 97 { + 98 break-if-!= + 99 abort "null trace" + 100 } + 101 var max/edx: (addr int) <- get self, first-free + 102 var trace-ah/eax: (addr handle array trace-line) <- get self, data + 103 var _trace/eax: (addr array trace-line) <- lookup *trace-ah + 104 var trace/esi: (addr array trace-line) <- copy _trace + 105 var i/ecx: int <- copy 0 + 106 { + 107 compare i, *max + 108 break-if->= + 109 var offset/eax: (offset trace-line) <- compute-offset trace, i + 110 var curr/eax: (addr trace-line) <- index trace, offset + 111 var curr-depth-a/eax: (addr int) <- get curr, depth + 112 compare *curr-depth-a, 0/error + 113 { + 114 break-if-!= + 115 return 1/true + 116 } + 117 i <- increment + 118 loop + 119 } + 120 return 0/false + 121 } + 122 + 123 fn should-trace? _self: (addr trace) -> _/eax: boolean { + 124 var self/esi: (addr trace) <- copy _self + 125 compare self, 0 + 126 { + 127 break-if-!= + 128 abort "null trace" + 129 } + 130 var depth-a/ecx: (addr int) <- get self, curr-depth + 131 var depth/ecx: int <- copy *depth-a + 132 var max-depth-a/eax: (addr int) <- get self, max-depth + 133 compare depth, *max-depth-a + 134 { + 135 break-if->= + 136 return 1/true + 137 } + 138 return 0/false + 139 } + 140 + 141 fn trace _self: (addr trace), label: (addr array byte), message: (addr stream byte) { + 142 var self/esi: (addr trace) <- copy _self + 143 compare self, 0 + 144 { + 145 break-if-!= + 146 abort "null trace" + 147 } + 148 var should-trace?/eax: boolean <- should-trace? self + 149 compare should-trace?, 0/false + 150 { + 151 break-if-!= + 152 return + 153 } + 154 var data-ah/eax: (addr handle array trace-line) <- get self, data + 155 var data/eax: (addr array trace-line) <- lookup *data-ah + 156 var index-addr/edi: (addr int) <- get self, first-free + 157 { + 158 compare *index-addr, 0x8000/lines + 159 break-if-< + 160 return + 161 } + 162 var index/ecx: int <- copy *index-addr + 163 var offset/ecx: (offset trace-line) <- compute-offset data, index + 164 var dest/eax: (addr trace-line) <- index data, offset + 165 var depth/ecx: (addr int) <- get self, curr-depth + 166 rewind-stream message + 167 { + 168 compare *index-addr, 0x7fff/lines + 169 break-if-< + 170 clear-stream message + 171 write message, "No space left in trace\n" + 172 write message, "Please either:\n" + 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" + 177 initialize-trace-line 0/depth, "error", message, dest + 178 increment *index-addr + 179 return + 180 } + 181 initialize-trace-line *depth, label, message, dest + 182 increment *index-addr + 183 } + 184 + 185 fn trace-text self: (addr trace), label: (addr array byte), s: (addr array byte) { + 186 compare self, 0 + 187 { + 188 break-if-!= + 189 abort "null trace" + 190 } + 191 var data-storage: (stream byte 0x100) + 192 var data/eax: (addr stream byte) <- address data-storage + 193 write data, s + 194 trace self, label, data + 195 } + 196 + 197 fn error _self: (addr trace), message: (addr array byte) { + 198 var self/esi: (addr trace) <- copy _self + 199 compare self, 0 + 200 { + 201 break-if-!= + 202 abort "null trace" + 203 } + 204 var curr-depth-a/eax: (addr int) <- get self, curr-depth + 205 var save-depth/ecx: int <- copy *curr-depth-a + 206 copy-to *curr-depth-a, 0/error + 207 trace-text self, "error", message + 208 copy-to *curr-depth-a, save-depth + 209 } + 210 + 211 fn error-stream _self: (addr trace), message: (addr stream byte) { + 212 var self/esi: (addr trace) <- copy _self + 213 compare self, 0 + 214 { + 215 break-if-!= + 216 abort "null trace" + 217 } + 218 var curr-depth-a/eax: (addr int) <- get self, curr-depth + 219 var save-depth/ecx: int <- copy *curr-depth-a + 220 copy-to *curr-depth-a, 0/error + 221 trace self, "error", message + 222 copy-to *curr-depth-a, save-depth + 223 } + 224 + 225 fn initialize-trace-line depth: int, label: (addr array byte), data: (addr stream byte), _out: (addr trace-line) { + 226 var out/edi: (addr trace-line) <- copy _out + 227 # depth + 228 var src/eax: int <- copy depth + 229 var dest/ecx: (addr int) <- get out, depth + 230 copy-to *dest, src + 231 # label + 232 var dest/eax: (addr handle array byte) <- get out, label + 233 copy-array-object label, dest + 234 # data + 235 var dest/eax: (addr handle array byte) <- get out, data + 236 stream-to-array data, dest 237 } 238 - 239 fn trace-higher _self: (addr trace) { - 240 var self/esi: (addr trace) <- copy _self + 239 fn trace-lower _self: (addr trace) { + 240 var self/esi: (addr trace) <- copy _self 241 compare self, 0 242 { 243 break-if-!= 244 abort "null trace" 245 } - 246 var depth/eax: (addr int) <- get self, curr-depth - 247 decrement *depth + 246 var depth/eax: (addr int) <- get self, curr-depth + 247 increment *depth 248 } 249 - 250 ## checking traces - 251 - 252 fn check-trace-scans-to self: (addr trace), label: (addr array byte), data: (addr array byte), message: (addr array byte) { - 253 var tmp/eax: boolean <- trace-scans-to? self, label, data - 254 check tmp, message - 255 } - 256 - 257 fn trace-scans-to? _self: (addr trace), label: (addr array byte), data: (addr array byte) -> _/eax: boolean { - 258 var self/esi: (addr trace) <- copy _self - 259 var start/eax: (addr int) <- get self, first-full - 260 var result/eax: boolean <- trace-contains? self, label, data, *start - 261 return result - 262 } - 263 - 264 fn test-trace-scans-to { - 265 var t-storage: trace - 266 var t/esi: (addr trace) <- address t-storage - 267 initialize-trace t, 0x100/max-depth, 0x10/capacity, 0/visible # we don't use trace UI - 268 # - 269 trace-text t, "label", "line 1" - 270 trace-text t, "label", "line 2" - 271 check-trace-scans-to t, "label", "line 1", "F - test-trace-scans-to/0" - 272 check-trace-scans-to t, "label", "line 2", "F - test-trace-scans-to/1" - 273 var tmp/eax: boolean <- trace-scans-to? t, "label", "line 1" - 274 check-not tmp, "F - test-trace-scans-to: fail on previously encountered lines" - 275 var tmp/eax: boolean <- trace-scans-to? t, "label", "line 3" - 276 check-not tmp, "F - test-trace-scans-to: fail on missing" - 277 } - 278 - 279 # scan trace from start - 280 # resets previous scans - 281 fn check-trace-contains self: (addr trace), label: (addr array byte), data: (addr array byte), message: (addr array byte) { - 282 var tmp/eax: boolean <- trace-contains? self, label, data, 0 - 283 check tmp, message - 284 } - 285 - 286 fn test-trace-contains { - 287 var t-storage: trace - 288 var t/esi: (addr trace) <- address t-storage - 289 initialize-trace t, 0x100/max-depth, 0x10/capacity, 0/visible # we don't use trace UI - 290 # - 291 trace-text t, "label", "line 1" - 292 trace-text t, "label", "line 2" - 293 check-trace-contains t, "label", "line 1", "F - test-trace-contains/0" - 294 check-trace-contains t, "label", "line 2", "F - test-trace-contains/1" - 295 check-trace-contains t, "label", "line 1", "F - test-trace-contains: find previously encountered lines" - 296 var tmp/eax: boolean <- trace-contains? t, "label", "line 3", 0/start - 297 check-not tmp, "F - test-trace-contains: fail on missing" - 298 } - 299 - 300 # this is super-inefficient, string comparing every trace line - 301 # against every visible line on every render - 302 fn trace-contains? _self: (addr trace), label: (addr array byte), data: (addr array byte), start: int -> _/eax: boolean { - 303 var self/esi: (addr trace) <- copy _self - 304 var candidates-ah/eax: (addr handle array trace-line) <- get self, data - 305 var candidates/eax: (addr array trace-line) <- lookup *candidates-ah - 306 var i/ecx: int <- copy start - 307 var max/edx: (addr int) <- get self, first-free - 308 { - 309 compare i, *max - 310 break-if->= - 311 { - 312 var read-until-index/eax: (addr int) <- get self, first-full - 313 copy-to *read-until-index, i - 314 } - 315 { - 316 var curr-offset/ecx: (offset trace-line) <- compute-offset candidates, i - 317 var curr/ecx: (addr trace-line) <- index candidates, curr-offset - 318 # if curr->label does not match, return false - 319 var curr-label-ah/eax: (addr handle array byte) <- get curr, label - 320 var curr-label/eax: (addr array byte) <- lookup *curr-label-ah - 321 var match?/eax: boolean <- string-equal? curr-label, label - 322 compare match?, 0/false - 323 break-if-= - 324 # if curr->data does not match, return false - 325 var curr-data-ah/eax: (addr handle array byte) <- get curr, data - 326 var curr-data/eax: (addr array byte) <- lookup *curr-data-ah - 327 var match?/eax: boolean <- string-equal? curr-data, data - 328 compare match?, 0/false - 329 break-if-= - 330 return 1/true - 331 } - 332 i <- increment - 333 loop - 334 } - 335 return 0/false - 336 } - 337 - 338 fn trace-lines-equal? _a: (addr trace-line), _b: (addr trace-line) -> _/eax: boolean { - 339 var a/esi: (addr trace-line) <- copy _a - 340 var b/edi: (addr trace-line) <- copy _b - 341 var a-depth/ecx: (addr int) <- get a, depth - 342 var b-depth/edx: (addr int) <- get b, depth - 343 var benchmark/eax: int <- copy *b-depth - 344 compare *a-depth, benchmark - 345 { - 346 break-if-= - 347 return 0/false - 348 } - 349 var a-label-ah/eax: (addr handle array byte) <- get a, label - 350 var _a-label/eax: (addr array byte) <- lookup *a-label-ah - 351 var a-label/ecx: (addr array byte) <- copy _a-label - 352 var b-label-ah/ebx: (addr handle array byte) <- get b, label - 353 var b-label/eax: (addr array byte) <- lookup *b-label-ah - 354 var label-match?/eax: boolean <- string-equal? a-label, b-label + 250 fn trace-higher _self: (addr trace) { + 251 var self/esi: (addr trace) <- copy _self + 252 compare self, 0 + 253 { + 254 break-if-!= + 255 abort "null trace" + 256 } + 257 var depth/eax: (addr int) <- get self, curr-depth + 258 decrement *depth + 259 } + 260 + 261 ## checking traces + 262 + 263 fn check-trace-scans-to self: (addr trace), label: (addr array byte), data: (addr array byte), message: (addr array byte) { + 264 var tmp/eax: boolean <- trace-scans-to? self, label, data + 265 check tmp, message + 266 } + 267 + 268 fn trace-scans-to? _self: (addr trace), label: (addr array byte), data: (addr array byte) -> _/eax: boolean { + 269 var self/esi: (addr trace) <- copy _self + 270 var start/eax: (addr int) <- get self, first-full + 271 var result/eax: boolean <- trace-contains? self, label, data, *start + 272 return result + 273 } + 274 + 275 fn test-trace-scans-to { + 276 var t-storage: trace + 277 var t/esi: (addr trace) <- address t-storage + 278 initialize-trace t, 0x100/max-depth, 0x10/capacity, 0/visible # we don't use trace UI + 279 # + 280 trace-text t, "label", "line 1" + 281 trace-text t, "label", "line 2" + 282 check-trace-scans-to t, "label", "line 1", "F - test-trace-scans-to/0" + 283 check-trace-scans-to t, "label", "line 2", "F - test-trace-scans-to/1" + 284 var tmp/eax: boolean <- trace-scans-to? t, "label", "line 1" + 285 check-not tmp, "F - test-trace-scans-to: fail on previously encountered lines" + 286 var tmp/eax: boolean <- trace-scans-to? t, "label", "line 3" + 287 check-not tmp, "F - test-trace-scans-to: fail on missing" + 288 } + 289 + 290 # scan trace from start + 291 # resets previous scans + 292 fn check-trace-contains self: (addr trace), label: (addr array byte), data: (addr array byte), message: (addr array byte) { + 293 var tmp/eax: boolean <- trace-contains? self, label, data, 0 + 294 check tmp, message + 295 } + 296 + 297 fn test-trace-contains { + 298 var t-storage: trace + 299 var t/esi: (addr trace) <- address t-storage + 300 initialize-trace t, 0x100/max-depth, 0x10/capacity, 0/visible # we don't use trace UI + 301 # + 302 trace-text t, "label", "line 1" + 303 trace-text t, "label", "line 2" + 304 check-trace-contains t, "label", "line 1", "F - test-trace-contains/0" + 305 check-trace-contains t, "label", "line 2", "F - test-trace-contains/1" + 306 check-trace-contains t, "label", "line 1", "F - test-trace-contains: find previously encountered lines" + 307 var tmp/eax: boolean <- trace-contains? t, "label", "line 3", 0/start + 308 check-not tmp, "F - test-trace-contains: fail on missing" + 309 } + 310 + 311 # this is super-inefficient, string comparing every trace line + 312 fn trace-contains? _self: (addr trace), label: (addr array byte), data: (addr array byte), start: int -> _/eax: boolean { + 313 var self/esi: (addr trace) <- copy _self + 314 var candidates-ah/eax: (addr handle array trace-line) <- get self, data + 315 var candidates/eax: (addr array trace-line) <- lookup *candidates-ah + 316 var i/ecx: int <- copy start + 317 var max/edx: (addr int) <- get self, first-free + 318 { + 319 compare i, *max + 320 break-if->= + 321 { + 322 var read-until-index/eax: (addr int) <- get self, first-full + 323 copy-to *read-until-index, i + 324 } + 325 { + 326 var curr-offset/ecx: (offset trace-line) <- compute-offset candidates, i + 327 var curr/ecx: (addr trace-line) <- index candidates, curr-offset + 328 # if curr->label does not match, return false + 329 var curr-label-ah/eax: (addr handle array byte) <- get curr, label + 330 var curr-label/eax: (addr array byte) <- lookup *curr-label-ah + 331 var match?/eax: boolean <- string-equal? curr-label, label + 332 compare match?, 0/false + 333 break-if-= + 334 # if curr->data does not match, return false + 335 var curr-data-ah/eax: (addr handle array byte) <- get curr, data + 336 var curr-data/eax: (addr array byte) <- lookup *curr-data-ah + 337 var match?/eax: boolean <- string-equal? curr-data, data + 338 compare match?, 0/false + 339 break-if-= + 340 return 1/true + 341 } + 342 i <- increment + 343 loop + 344 } + 345 return 0/false + 346 } + 347 + 348 fn trace-lines-equal? _a: (addr trace-line), _b: (addr trace-line) -> _/eax: boolean { + 349 var a/esi: (addr trace-line) <- copy _a + 350 var b/edi: (addr trace-line) <- copy _b + 351 var a-depth/ecx: (addr int) <- get a, depth + 352 var b-depth/edx: (addr int) <- get b, depth + 353 var benchmark/eax: int <- copy *b-depth + 354 compare *a-depth, benchmark 355 { - 356 compare label-match?, 0/false - 357 break-if-!= - 358 return 0/false - 359 } - 360 var a-data-ah/eax: (addr handle array byte) <- get a, data - 361 var _a-data/eax: (addr array byte) <- lookup *a-data-ah - 362 var a-data/ecx: (addr array byte) <- copy _a-data - 363 var b-data-ah/ebx: (addr handle array byte) <- get b, data - 364 var b-data/eax: (addr array byte) <- lookup *b-data-ah - 365 var data-match?/eax: boolean <- string-equal? a-data, b-data - 366 return data-match? - 367 } - 368 - 369 fn dump-trace _self: (addr trace) { - 370 var y/ecx: int <- copy 0 - 371 var self/esi: (addr trace) <- copy _self - 372 compare self, 0 - 373 { - 374 break-if-!= - 375 abort "null trace" - 376 } - 377 var trace-ah/eax: (addr handle array trace-line) <- get self, data - 378 var _trace/eax: (addr array trace-line) <- lookup *trace-ah - 379 var trace/edi: (addr array trace-line) <- copy _trace - 380 var i/edx: int <- copy 0 - 381 var max-addr/ebx: (addr int) <- get self, first-free - 382 var max/ebx: int <- copy *max-addr - 383 $dump-trace:loop: { - 384 compare i, max - 385 break-if->= - 386 $dump-trace:iter: { - 387 var offset/ebx: (offset trace-line) <- compute-offset trace, i - 388 var curr/ebx: (addr trace-line) <- index trace, offset - 389 y <- render-trace-line 0/screen, curr, 0, y, 0x80/width, 0x30/height, 7/fg, 0/bg, 0/clip - 390 } - 391 i <- increment - 392 loop - 393 } - 394 } - 395 - 396 fn dump-trace-with-label _self: (addr trace), label: (addr array byte) { - 397 var y/ecx: int <- copy 0 - 398 var self/esi: (addr trace) <- copy _self - 399 compare self, 0 - 400 { - 401 break-if-!= - 402 abort "null trace" + 356 break-if-= + 357 return 0/false + 358 } + 359 var a-label-ah/eax: (addr handle array byte) <- get a, label + 360 var _a-label/eax: (addr array byte) <- lookup *a-label-ah + 361 var a-label/ecx: (addr array byte) <- copy _a-label + 362 var b-label-ah/ebx: (addr handle array byte) <- get b, label + 363 var b-label/eax: (addr array byte) <- lookup *b-label-ah + 364 var label-match?/eax: boolean <- string-equal? a-label, b-label + 365 { + 366 compare label-match?, 0/false + 367 break-if-!= + 368 return 0/false + 369 } + 370 var a-data-ah/eax: (addr handle array byte) <- get a, data + 371 var _a-data/eax: (addr array byte) <- lookup *a-data-ah + 372 var a-data/ecx: (addr array byte) <- copy _a-data + 373 var b-data-ah/ebx: (addr handle array byte) <- get b, data + 374 var b-data/eax: (addr array byte) <- lookup *b-data-ah + 375 var data-match?/eax: boolean <- string-equal? a-data, b-data + 376 return data-match? + 377 } + 378 + 379 fn dump-trace _self: (addr trace) { + 380 var y/ecx: int <- copy 0 + 381 var self/esi: (addr trace) <- copy _self + 382 compare self, 0 + 383 { + 384 break-if-!= + 385 abort "null trace" + 386 } + 387 var trace-ah/eax: (addr handle array trace-line) <- get self, data + 388 var _trace/eax: (addr array trace-line) <- lookup *trace-ah + 389 var trace/edi: (addr array trace-line) <- copy _trace + 390 var i/edx: int <- copy 0 + 391 var max-addr/ebx: (addr int) <- get self, first-free + 392 var max/ebx: int <- copy *max-addr + 393 $dump-trace:loop: { + 394 compare i, max + 395 break-if->= + 396 $dump-trace:iter: { + 397 var offset/ebx: (offset trace-line) <- compute-offset trace, i + 398 var curr/ebx: (addr trace-line) <- index trace, offset + 399 y <- render-trace-line 0/screen, curr, 0, y, 0x80/width, 0x30/height, 7/fg, 0/bg, 0/clip + 400 } + 401 i <- increment + 402 loop 403 } - 404 var trace-ah/eax: (addr handle array trace-line) <- get self, data - 405 var _trace/eax: (addr array trace-line) <- lookup *trace-ah - 406 var trace/edi: (addr array trace-line) <- copy _trace - 407 var i/edx: int <- copy 0 - 408 var max-addr/ebx: (addr int) <- get self, first-free - 409 var max/ebx: int <- copy *max-addr - 410 $dump-trace:loop: { - 411 compare i, max - 412 break-if->= - 413 $dump-trace:iter: { - 414 var offset/ebx: (offset trace-line) <- compute-offset trace, i - 415 var curr/ebx: (addr trace-line) <- index trace, offset - 416 var curr-label-ah/eax: (addr handle array byte) <- get curr, label - 417 var curr-label/eax: (addr array byte) <- lookup *curr-label-ah - 418 var show?/eax: boolean <- string-equal? curr-label, label - 419 compare show?, 0/false - 420 break-if-= - 421 y <- render-trace-line 0/screen, curr, 0, y, 0x80/width, 0x30/height, 7/fg, 0/bg, 0/clip - 422 } - 423 i <- increment - 424 loop - 425 } - 426 } - 427 - 428 ## UI stuff - 429 - 430 fn mark-lines-dirty _self: (addr trace) { - 431 var self/eax: (addr trace) <- copy _self - 432 var dest/edx: (addr boolean) <- get self, recreate-caches? - 433 copy-to *dest, 1/true - 434 } - 435 - 436 fn mark-lines-clean _self: (addr trace) { - 437 var self/eax: (addr trace) <- copy _self - 438 var dest/edx: (addr boolean) <- get self, recreate-caches? - 439 copy-to *dest, 0/false - 440 } - 441 - 442 fn render-trace screen: (addr screen), _self: (addr trace), xmin: int, ymin: int, xmax: int, ymax: int, show-cursor?: boolean -> _/ecx: int { - 443 var already-hiding-lines?: boolean - 444 var self/esi: (addr trace) <- copy _self - 445 compare self, 0 - 446 { - 447 break-if-!= - 448 abort "null trace" - 449 } - 450 var y/ecx: int <- copy ymin - 451 # recreate caches if necessary - 452 var recreate-caches?/eax: (addr boolean) <- get self, recreate-caches? - 453 compare *recreate-caches?, 0/false - 454 { - 455 break-if-= - 456 # cache ymin - 457 var dest/eax: (addr int) <- get self, top-line-y - 458 copy-to *dest, y - 459 # cache ymax - 460 var ymax/ecx: int <- copy ymax - 461 dest <- get self, screen-height - 462 copy-to *dest, ymax - 463 # - 464 recompute-all-visible-lines self - 465 mark-lines-clean self - 466 } - 467 clamp-cursor-to-top self, y - 468 var trace-ah/eax: (addr handle array trace-line) <- get self, data - 469 var _trace/eax: (addr array trace-line) <- lookup *trace-ah - 470 var trace/edi: (addr array trace-line) <- copy _trace - 471 var max-addr/ebx: (addr int) <- get self, first-free - 472 var max/ebx: int <- copy *max-addr - 473 # display trace depth (not in tests) - 474 $render-trace:render-depth: { - 475 compare max, 0 - 476 break-if-<= - 477 var max-depth/edx: (addr int) <- get self, max-depth - 478 { - 479 var width/eax: int <- copy 0 - 480 var height/ecx: int <- copy 0 - 481 width, height <- screen-size screen - 482 compare width, 0x80 - 483 break-if-< $render-trace:render-depth - 484 } - 485 set-cursor-position screen, 0x70/x, y - 486 draw-text-rightward-from-cursor-over-full-screen screen, "trace depth: ", 0x17/fg, 0xc5/bg=blue-bg - 487 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, *max-depth, 0x7/fg, 0xc5/bg=blue-bg - 488 } - 489 var top-line-addr/edx: (addr int) <- get self, top-line-index - 490 var i/edx: int <- copy *top-line-addr - 491 $render-trace:loop: { - 492 compare i, max - 493 break-if->= - 494 compare y, ymax - 495 break-if->= - 496 $render-trace:iter: { - 497 var offset/ebx: (offset trace-line) <- compute-offset trace, i - 498 var curr/ebx: (addr trace-line) <- index trace, offset - 499 var curr-label-ah/eax: (addr handle array byte) <- get curr, label - 500 var curr-label/eax: (addr array byte) <- lookup *curr-label-ah - 501 var bg: int - 502 copy-to bg, 0xc5/bg=blue-bg - 503 var fg: int - 504 copy-to fg, 0x38/fg=trace - 505 compare show-cursor?, 0/false - 506 { - 507 break-if-= - 508 var cursor-y/eax: (addr int) <- get self, cursor-y - 509 compare *cursor-y, y - 510 break-if-!= - 511 copy-to bg, 7/trace-cursor-line-bg - 512 copy-to fg, 0x68/cursor-line-fg=sober-blue - 513 var cursor-line-index/eax: (addr int) <- get self, cursor-line-index - 514 copy-to *cursor-line-index, i - 515 } - 516 # always display errors - 517 { - 518 var curr-depth/eax: (addr int) <- get curr, depth - 519 compare *curr-depth, 0/error + 404 } + 405 + 406 fn dump-trace-with-label _self: (addr trace), label: (addr array byte) { + 407 var y/ecx: int <- copy 0 + 408 var self/esi: (addr trace) <- copy _self + 409 compare self, 0 + 410 { + 411 break-if-!= + 412 abort "null trace" + 413 } + 414 var trace-ah/eax: (addr handle array trace-line) <- get self, data + 415 var _trace/eax: (addr array trace-line) <- lookup *trace-ah + 416 var trace/edi: (addr array trace-line) <- copy _trace + 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: { + 421 compare i, max + 422 break-if->= + 423 $dump-trace: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 + 427 var curr-label/eax: (addr array byte) <- lookup *curr-label-ah + 428 var show?/eax: boolean <- string-equal? curr-label, label + 429 compare show?, 0/false + 430 break-if-= + 431 y <- render-trace-line 0/screen, curr, 0, y, 0x80/width, 0x30/height, 7/fg, 0/bg, 0/clip + 432 } + 433 i <- increment + 434 loop + 435 } + 436 } + 437 + 438 ## UI stuff + 439 + 440 fn mark-lines-dirty _self: (addr trace) { + 441 var self/eax: (addr trace) <- copy _self + 442 var dest/edx: (addr boolean) <- get self, recreate-caches? + 443 copy-to *dest, 1/true + 444 } + 445 + 446 fn mark-lines-clean _self: (addr trace) { + 447 var self/eax: (addr trace) <- copy _self + 448 var dest/edx: (addr boolean) <- get self, recreate-caches? + 449 copy-to *dest, 0/false + 450 } + 451 + 452 fn render-trace screen: (addr screen), _self: (addr trace), xmin: int, ymin: int, xmax: int, ymax: int, show-cursor?: boolean -> _/ecx: int { + 453 var already-hiding-lines?: boolean + 454 var self/esi: (addr trace) <- copy _self + 455 compare self, 0 + 456 { + 457 break-if-!= + 458 abort "null trace" + 459 } + 460 var y/ecx: int <- copy ymin + 461 # recreate caches if necessary + 462 var recreate-caches?/eax: (addr boolean) <- get self, recreate-caches? + 463 compare *recreate-caches?, 0/false + 464 { + 465 break-if-= + 466 # cache ymin + 467 var dest/eax: (addr int) <- get self, top-line-y + 468 copy-to *dest, y + 469 # cache ymax + 470 var ymax/ecx: int <- copy ymax + 471 dest <- get self, screen-height + 472 copy-to *dest, ymax + 473 # + 474 recompute-all-visible-lines self + 475 mark-lines-clean self + 476 } + 477 clamp-cursor-to-top self, y + 478 var trace-ah/eax: (addr handle array trace-line) <- get self, data + 479 var _trace/eax: (addr array trace-line) <- lookup *trace-ah + 480 var trace/edi: (addr array trace-line) <- copy _trace + 481 var max-addr/ebx: (addr int) <- get self, first-free + 482 var max/ebx: int <- copy *max-addr + 483 # display trace depth (not in tests) + 484 $render-trace:render-depth: { + 485 compare max, 0 + 486 break-if-<= + 487 var max-depth/edx: (addr int) <- get self, max-depth + 488 { + 489 var width/eax: int <- copy 0 + 490 var height/ecx: int <- copy 0 + 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 + 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 } + 499 var top-line-addr/edx: (addr int) <- get self, top-line-index + 500 var i/edx: int <- copy *top-line-addr + 501 $render-trace:loop: { + 502 compare i, max + 503 break-if->= + 504 compare y, ymax + 505 break-if->= + 506 $render-trace:iter: { + 507 var offset/ebx: (offset trace-line) <- compute-offset trace, i + 508 var curr/ebx: (addr trace-line) <- index trace, offset + 509 var curr-label-ah/eax: (addr handle array byte) <- get curr, label + 510 var curr-label/eax: (addr array byte) <- lookup *curr-label-ah + 511 var bg: int + 512 copy-to bg, 0xc5/bg=blue-bg + 513 var fg: int + 514 copy-to fg, 0x38/fg=trace + 515 compare show-cursor?, 0/false + 516 { + 517 break-if-= + 518 var cursor-y/eax: (addr int) <- get self, cursor-y + 519 compare *cursor-y, y 520 break-if-!= - 521 y <- render-trace-line screen, curr, xmin, y, xmax, ymax, 0xc/fg=trace-error, bg, 0/clip - 522 copy-to already-hiding-lines?, 0/false - 523 break $render-trace:iter - 524 } - 525 # display expanded lines - 526 var display?/eax: boolean <- should-render? curr + 521 copy-to bg, 7/trace-cursor-line-bg + 522 copy-to fg, 0x68/cursor-line-fg=sober-blue + 523 var cursor-line-index/eax: (addr int) <- get self, cursor-line-index + 524 copy-to *cursor-line-index, i + 525 } + 526 # always display errors 527 { - 528 compare display?, 0/false - 529 break-if-= - 530 var unclip-cursor-line?/eax: boolean <- unclip-cursor-line? self, i - 531 y <- render-trace-line screen, curr, xmin, y, xmax, ymax, fg, bg, unclip-cursor-line? + 528 var curr-depth/eax: (addr int) <- get curr, depth + 529 compare *curr-depth, 0/error + 530 break-if-!= + 531 y <- render-trace-line screen, curr, xmin, y, xmax, ymax, 0xc/fg=trace-error, bg, 0/clip 532 copy-to already-hiding-lines?, 0/false 533 break $render-trace:iter 534 } - 535 # ignore the rest - 536 compare already-hiding-lines?, 0/false + 535 # display expanded lines + 536 var display?/eax: boolean <- should-render? curr 537 { - 538 break-if-!= - 539 var x/eax: int <- copy xmin - 540 x, y <- draw-text-wrapping-right-then-down screen, "...", xmin, ymin, xmax, ymax, x, y, fg, bg - 541 y <- increment - 542 copy-to already-hiding-lines?, 1/true - 543 } - 544 } - 545 i <- increment - 546 loop - 547 } - 548 # prevent cursor from going too far down - 549 clamp-cursor-to-bottom self, y, screen, xmin, ymin, xmax, ymax - 550 return y - 551 } - 552 - 553 fn unclip-cursor-line? _self: (addr trace), _i: int -> _/eax: boolean { - 554 # if unclip? and i == *cursor-line-index, render unclipped - 555 var self/esi: (addr trace) <- copy _self - 556 var unclip-cursor-line?/eax: (addr boolean) <- get self, unclip-cursor-line? - 557 compare *unclip-cursor-line?, 0/false - 558 { - 559 break-if-!= - 560 return 0/false - 561 } - 562 var cursor-line-index/eax: (addr int) <- get self, cursor-line-index - 563 var i/ecx: int <- copy _i - 564 compare i, *cursor-line-index - 565 { - 566 break-if-= - 567 return 0/false - 568 } - 569 return 1/true - 570 } - 571 - 572 fn render-trace-line screen: (addr screen), _self: (addr trace-line), xmin: int, ymin: int, xmax: int, ymax: int, fg: int, bg: int, unclip?: boolean -> _/ecx: int { - 573 var self/esi: (addr trace-line) <- copy _self - 574 var xsave/edx: int <- copy xmin - 575 var y/ecx: int <- copy ymin - 576 # show depth for non-errors - 577 var depth-a/ebx: (addr int) <- get self, depth - 578 compare *depth-a, 0/error - 579 { - 580 break-if-= - 581 var x/eax: int <- copy xsave - 582 { - 583 x, y <- draw-int32-decimal-wrapping-right-then-down screen, *depth-a, xmin, ymin, xmax, ymax, x, y, fg, bg - 584 x, y <- draw-text-wrapping-right-then-down screen, " ", xmin, ymin, xmax, ymax, x, y, fg, bg - 585 # don't show label in UI; it's just for tests - 586 } - 587 xsave <- copy x - 588 } - 589 var data-ah/eax: (addr handle array byte) <- get self, data - 590 var _data/eax: (addr array byte) <- lookup *data-ah - 591 var data/ebx: (addr array byte) <- copy _data - 592 var x/eax: int <- copy xsave - 593 compare unclip?, 0/false - 594 { - 595 break-if-= - 596 x, y <- draw-text-wrapping-right-then-down screen, data, xmin, ymin, xmax, ymax, x, y, fg, bg - 597 } - 598 compare unclip?, 0/false - 599 { - 600 break-if-!= - 601 x <- draw-text-rightward screen, data, x, xmax, y, fg, bg - 602 } - 603 y <- increment - 604 return y - 605 } - 606 - 607 fn should-render? _line: (addr trace-line) -> _/eax: boolean { - 608 var line/eax: (addr trace-line) <- copy _line - 609 var result/eax: (addr boolean) <- get line, visible? - 610 return *result - 611 } - 612 - 613 # This is super-inefficient, string-comparing every trace line - 614 # against every visible line. - 615 fn recompute-all-visible-lines _self: (addr trace) { - 616 var self/esi: (addr trace) <- copy _self - 617 var max-addr/edx: (addr int) <- get self, first-free - 618 var trace-ah/eax: (addr handle array trace-line) <- get self, data - 619 var _trace/eax: (addr array trace-line) <- lookup *trace-ah - 620 var trace/esi: (addr array trace-line) <- copy _trace - 621 var i/ecx: int <- copy 0 - 622 { - 623 compare i, *max-addr - 624 break-if->= - 625 var offset/ebx: (offset trace-line) <- compute-offset trace, i - 626 var curr/ebx: (addr trace-line) <- index trace, offset - 627 recompute-visibility _self, curr - 628 i <- increment - 629 loop - 630 } - 631 } - 632 - 633 fn recompute-visibility _self: (addr trace), _line: (addr trace-line) { - 634 var self/esi: (addr trace) <- copy _self - 635 # recompute - 636 var candidates-ah/eax: (addr handle array trace-line) <- get self, visible - 637 var candidates/eax: (addr array trace-line) <- lookup *candidates-ah - 638 var i/ecx: int <- copy 0 - 639 var len/edx: int <- length candidates - 640 { - 641 compare i, len - 642 break-if->= - 643 { - 644 var curr-offset/ecx: (offset trace-line) <- compute-offset candidates, i - 645 var curr/ecx: (addr trace-line) <- index candidates, curr-offset - 646 var match?/eax: boolean <- trace-lines-equal? curr, _line - 647 compare match?, 0/false - 648 break-if-= - 649 var line/eax: (addr trace-line) <- copy _line - 650 var dest/eax: (addr boolean) <- get line, visible? - 651 copy-to *dest, 1/true - 652 return - 653 } - 654 i <- increment - 655 loop - 656 } - 657 var line/eax: (addr trace-line) <- copy _line - 658 var dest/eax: (addr boolean) <- get line, visible? - 659 copy-to *dest, 0/false - 660 } - 661 - 662 fn clamp-cursor-to-top _self: (addr trace), _y: int { - 663 var y/ecx: int <- copy _y - 664 var self/esi: (addr trace) <- copy _self - 665 var cursor-y/eax: (addr int) <- get self, cursor-y - 666 compare *cursor-y, y - 667 break-if->= - 668 copy-to *cursor-y, y - 669 } - 670 - 671 # extremely hacky; consider deleting test-render-trace-empty-3 when you clean this up - 672 # TODO: duplicates logic for rendering a line - 673 fn clamp-cursor-to-bottom _self: (addr trace), _y: int, screen: (addr screen), xmin: int, ymin: int, xmax: int, ymax: int { - 674 var y/ebx: int <- copy _y - 675 compare y, ymin - 676 { - 677 break-if-> - 678 return - 679 } - 680 y <- decrement - 681 var self/esi: (addr trace) <- copy _self - 682 var cursor-y/eax: (addr int) <- get self, cursor-y - 683 compare *cursor-y, y - 684 break-if-<= - 685 copy-to *cursor-y, y - 686 # redraw cursor-line - 687 var trace-ah/eax: (addr handle array trace-line) <- get self, data - 688 var trace/eax: (addr array trace-line) <- lookup *trace-ah - 689 var cursor-line-index-addr/ecx: (addr int) <- get self, cursor-line-index - 690 var cursor-line-index/ecx: int <- copy *cursor-line-index-addr - 691 var first-free/edx: (addr int) <- get self, first-free - 692 compare cursor-line-index, *first-free - 693 { - 694 break-if-< - 695 return - 696 } - 697 var cursor-offset/ecx: (offset trace-line) <- compute-offset trace, cursor-line-index - 698 var cursor-line/ecx: (addr trace-line) <- index trace, cursor-offset - 699 var display?/eax: boolean <- should-render? cursor-line - 700 { - 701 compare display?, 0/false - 702 break-if-= - 703 var dummy/ecx: int <- render-trace-line screen, cursor-line, xmin, y, xmax, ymax, 0x38/fg=trace, 7/cursor-line-bg, 0/clip - 704 return - 705 } - 706 var dummy1/eax: int <- copy 0 - 707 var dummy2/ecx: int <- copy 0 - 708 dummy1, dummy2 <- draw-text-wrapping-right-then-down screen, "...", xmin, ymin, xmax, ymax, xmin, y, 9/fg=trace, 7/cursor-line-bg - 709 } - 710 - 711 fn test-render-trace-empty { - 712 var t-storage: trace - 713 var t/esi: (addr trace) <- address t-storage - 714 initialize-trace t, 0x100/max-depth, 0x10, 0x10 - 715 # setup: screen - 716 var screen-on-stack: screen - 717 var screen/edi: (addr screen) <- address screen-on-stack - 718 initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics - 719 # - 720 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 5/xmax, 4/ymax, 0/no-cursor - 721 # - 722 check-ints-equal y, 0, "F - test-render-trace-empty/cursor" - 723 check-screen-row screen, 0/y, " ", "F - test-render-trace-empty" - 724 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-render-trace-empty/bg" - 725 } - 726 - 727 fn test-render-trace-empty-2 { - 728 var t-storage: trace - 729 var t/esi: (addr trace) <- address t-storage - 730 initialize-trace t, 0x100/max-depth, 0x10, 0x10 - 731 # setup: screen - 732 var screen-on-stack: screen - 733 var screen/edi: (addr screen) <- address screen-on-stack - 734 initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics - 735 # - 736 var y/ecx: int <- render-trace screen, t, 0/xmin, 2/ymin, 5/xmax, 4/ymax, 0/no-cursor # cursor below top row - 737 # - 738 check-ints-equal y, 2, "F - test-render-trace-empty-2/cursor" - 739 check-screen-row screen, 2/y, " ", "F - test-render-trace-empty-2" - 740 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-render-trace-empty-2/bg" - 741 } - 742 - 743 fn test-render-trace-empty-3 { - 744 var t-storage: trace - 745 var t/esi: (addr trace) <- address t-storage - 746 initialize-trace t, 0x100/max-depth, 0x10, 0x10 - 747 # setup: screen - 748 var screen-on-stack: screen - 749 var screen/edi: (addr screen) <- address screen-on-stack - 750 initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics - 751 # - 752 var y/ecx: int <- render-trace screen, t, 0/xmin, 2/ymin, 5/xmax, 4/ymax, 1/show-cursor # try show cursor - 753 # still no cursor to show - 754 check-ints-equal y, 2, "F - test-render-trace-empty-3/cursor" - 755 check-screen-row screen, 1/y, " ", "F - test-render-trace-empty-3/line-above-cursor" - 756 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-render-trace-empty-3/bg-for-line-above-cursor" - 757 check-screen-row screen, 2/y, " ", "F - test-render-trace-empty-3" - 758 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-render-trace-empty-3/bg" - 759 } - 760 - 761 fn test-render-trace-collapsed-by-default { - 762 var t-storage: trace - 763 var t/esi: (addr trace) <- address t-storage - 764 initialize-trace t, 0x100/max-depth, 0x10, 0x10 - 765 trace-text t, "l", "data" - 766 # setup: screen - 767 var screen-on-stack: screen - 768 var screen/edi: (addr screen) <- address screen-on-stack - 769 initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics - 770 # - 771 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 5/xmax, 4/ymax, 0/no-cursor - 772 # - 773 check-ints-equal y, 1, "F - test-render-trace-collapsed-by-default/cursor" - 774 check-screen-row screen, 0/y, "... ", "F - test-render-trace-collapsed-by-default" - 775 } - 776 - 777 fn test-render-trace-error { - 778 var t-storage: trace - 779 var t/esi: (addr trace) <- address t-storage - 780 initialize-trace t, 0x100/max-depth, 0x10, 0x10 - 781 error t, "error" - 782 # setup: screen - 783 var screen-on-stack: screen - 784 var screen/edi: (addr screen) <- address screen-on-stack - 785 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics - 786 # - 787 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor - 788 # - 789 check-ints-equal y, 1, "F - test-render-trace-error/cursor" - 790 check-screen-row screen, 0/y, "error", "F - test-render-trace-error" - 791 } - 792 - 793 fn test-render-trace-error-at-start { - 794 var t-storage: trace - 795 var t/esi: (addr trace) <- address t-storage - 796 initialize-trace t, 0x100/max-depth, 0x10, 0x10 - 797 # - 798 error t, "error" - 799 trace-text t, "l", "data" - 800 # setup: screen - 801 var screen-on-stack: screen - 802 var screen/edi: (addr screen) <- address screen-on-stack - 803 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics - 804 # - 805 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor - 806 # - 807 check-ints-equal y, 2, "F - test-render-trace-error-at-start/cursor" - 808 check-screen-row screen, 0/y, "error", "F - test-render-trace-error-at-start/0" - 809 check-screen-row screen, 1/y, "... ", "F - test-render-trace-error-at-start/1" - 810 } - 811 - 812 fn test-render-trace-error-at-end { - 813 var t-storage: trace - 814 var t/esi: (addr trace) <- address t-storage - 815 initialize-trace t, 0x100/max-depth, 0x10, 0x10 + 538 compare display?, 0/false + 539 break-if-= + 540 var unclip-cursor-line?/eax: boolean <- unclip-cursor-line? self, i + 541 y <- render-trace-line screen, curr, xmin, y, xmax, ymax, fg, bg, unclip-cursor-line? + 542 copy-to already-hiding-lines?, 0/false + 543 break $render-trace:iter + 544 } + 545 # ignore the rest + 546 compare already-hiding-lines?, 0/false + 547 { + 548 break-if-!= + 549 var x/eax: int <- copy xmin + 550 x, y <- draw-text-wrapping-right-then-down screen, "...", xmin, ymin, xmax, ymax, x, y, fg, bg + 551 y <- increment + 552 copy-to already-hiding-lines?, 1/true + 553 } + 554 } + 555 i <- increment + 556 loop + 557 } + 558 # prevent cursor from going too far down + 559 clamp-cursor-to-bottom self, y, screen, xmin, ymin, xmax, ymax + 560 return y + 561 } + 562 + 563 fn unclip-cursor-line? _self: (addr trace), _i: int -> _/eax: boolean { + 564 # if unclip? and i == *cursor-line-index, render unclipped + 565 var self/esi: (addr trace) <- copy _self + 566 var unclip-cursor-line?/eax: (addr boolean) <- get self, unclip-cursor-line? + 567 compare *unclip-cursor-line?, 0/false + 568 { + 569 break-if-!= + 570 return 0/false + 571 } + 572 var cursor-line-index/eax: (addr int) <- get self, cursor-line-index + 573 var i/ecx: int <- copy _i + 574 compare i, *cursor-line-index + 575 { + 576 break-if-= + 577 return 0/false + 578 } + 579 return 1/true + 580 } + 581 + 582 fn render-trace-line screen: (addr screen), _self: (addr trace-line), xmin: int, ymin: int, xmax: int, ymax: int, fg: int, bg: int, unclip?: boolean -> _/ecx: int { + 583 var self/esi: (addr trace-line) <- copy _self + 584 var xsave/edx: int <- copy xmin + 585 var y/ecx: int <- copy ymin + 586 # show depth for non-errors + 587 var depth-a/ebx: (addr int) <- get self, depth + 588 compare *depth-a, 0/error + 589 { + 590 break-if-= + 591 var x/eax: int <- copy xsave + 592 { + 593 x, y <- draw-int32-decimal-wrapping-right-then-down screen, *depth-a, xmin, ymin, xmax, ymax, x, y, fg, bg + 594 x, y <- draw-text-wrapping-right-then-down screen, " ", xmin, ymin, xmax, ymax, x, y, fg, bg + 595 # don't show label in UI; it's just for tests + 596 } + 597 xsave <- copy x + 598 } + 599 var data-ah/eax: (addr handle array byte) <- get self, data + 600 var _data/eax: (addr array byte) <- lookup *data-ah + 601 var data/ebx: (addr array byte) <- copy _data + 602 var x/eax: int <- copy xsave + 603 compare unclip?, 0/false + 604 { + 605 break-if-= + 606 x, y <- draw-text-wrapping-right-then-down screen, data, xmin, ymin, xmax, ymax, x, y, fg, bg + 607 } + 608 compare unclip?, 0/false + 609 { + 610 break-if-!= + 611 x <- draw-text-rightward screen, data, x, xmax, y, fg, bg + 612 } + 613 y <- increment + 614 return y + 615 } + 616 + 617 fn should-render? _line: (addr trace-line) -> _/eax: boolean { + 618 var line/eax: (addr trace-line) <- copy _line + 619 var result/eax: (addr boolean) <- get line, visible? + 620 return *result + 621 } + 622 + 623 # This is super-inefficient, string-comparing every trace line + 624 # against every visible line. + 625 fn recompute-all-visible-lines _self: (addr trace) { + 626 var self/esi: (addr trace) <- copy _self + 627 var max-addr/edx: (addr int) <- get self, first-free + 628 var trace-ah/eax: (addr handle array trace-line) <- get self, data + 629 var _trace/eax: (addr array trace-line) <- lookup *trace-ah + 630 var trace/esi: (addr array trace-line) <- copy _trace + 631 var i/ecx: int <- copy 0 + 632 { + 633 compare i, *max-addr + 634 break-if->= + 635 var offset/ebx: (offset trace-line) <- compute-offset trace, i + 636 var curr/ebx: (addr trace-line) <- index trace, offset + 637 recompute-visibility _self, curr + 638 i <- increment + 639 loop + 640 } + 641 } + 642 + 643 fn recompute-visibility _self: (addr trace), _line: (addr trace-line) { + 644 var self/esi: (addr trace) <- copy _self + 645 # recompute + 646 var candidates-ah/eax: (addr handle array trace-line) <- get self, visible + 647 var candidates/eax: (addr array trace-line) <- lookup *candidates-ah + 648 var i/ecx: int <- copy 0 + 649 var len/edx: int <- length candidates + 650 { + 651 compare i, len + 652 break-if->= + 653 { + 654 var curr-offset/ecx: (offset trace-line) <- compute-offset candidates, i + 655 var curr/ecx: (addr trace-line) <- index candidates, curr-offset + 656 var match?/eax: boolean <- trace-lines-equal? curr, _line + 657 compare match?, 0/false + 658 break-if-= + 659 var line/eax: (addr trace-line) <- copy _line + 660 var dest/eax: (addr boolean) <- get line, visible? + 661 copy-to *dest, 1/true + 662 return + 663 } + 664 i <- increment + 665 loop + 666 } + 667 var line/eax: (addr trace-line) <- copy _line + 668 var dest/eax: (addr boolean) <- get line, visible? + 669 copy-to *dest, 0/false + 670 } + 671 + 672 fn clamp-cursor-to-top _self: (addr trace), _y: int { + 673 var y/ecx: int <- copy _y + 674 var self/esi: (addr trace) <- copy _self + 675 var cursor-y/eax: (addr int) <- get self, cursor-y + 676 compare *cursor-y, y + 677 break-if->= + 678 copy-to *cursor-y, y + 679 } + 680 + 681 # extremely hacky; consider deleting test-render-trace-empty-3 when you clean this up + 682 # TODO: duplicates logic for rendering a line + 683 fn clamp-cursor-to-bottom _self: (addr trace), _y: int, screen: (addr screen), xmin: int, ymin: int, xmax: int, ymax: int { + 684 var y/ebx: int <- copy _y + 685 compare y, ymin + 686 { + 687 break-if-> + 688 return + 689 } + 690 y <- decrement + 691 var self/esi: (addr trace) <- copy _self + 692 var cursor-y/eax: (addr int) <- get self, cursor-y + 693 compare *cursor-y, y + 694 break-if-<= + 695 copy-to *cursor-y, y + 696 # redraw cursor-line + 697 var trace-ah/eax: (addr handle array trace-line) <- get self, data + 698 var trace/eax: (addr array trace-line) <- lookup *trace-ah + 699 var cursor-line-index-addr/ecx: (addr int) <- get self, cursor-line-index + 700 var cursor-line-index/ecx: int <- copy *cursor-line-index-addr + 701 var first-free/edx: (addr int) <- get self, first-free + 702 compare cursor-line-index, *first-free + 703 { + 704 break-if-< + 705 return + 706 } + 707 var cursor-offset/ecx: (offset trace-line) <- compute-offset trace, cursor-line-index + 708 var cursor-line/ecx: (addr trace-line) <- index trace, cursor-offset + 709 var display?/eax: boolean <- should-render? cursor-line + 710 { + 711 compare display?, 0/false + 712 break-if-= + 713 var dummy/ecx: int <- render-trace-line screen, cursor-line, xmin, y, xmax, ymax, 0x38/fg=trace, 7/cursor-line-bg, 0/clip + 714 return + 715 } + 716 var dummy1/eax: int <- copy 0 + 717 var dummy2/ecx: int <- copy 0 + 718 dummy1, dummy2 <- draw-text-wrapping-right-then-down screen, "...", xmin, ymin, xmax, ymax, xmin, y, 9/fg=trace, 7/cursor-line-bg + 719 } + 720 + 721 fn test-render-trace-empty { + 722 var t-storage: trace + 723 var t/esi: (addr trace) <- address t-storage + 724 initialize-trace t, 0x100/max-depth, 0x10, 0x10 + 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 + 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" + 735 } + 736 + 737 fn test-render-trace-empty-2 { + 738 var t-storage: trace + 739 var t/esi: (addr trace) <- address t-storage + 740 initialize-trace t, 0x100/max-depth, 0x10, 0x10 + 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 + 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" + 751 } + 752 + 753 fn test-render-trace-empty-3 { + 754 var t-storage: trace + 755 var t/esi: (addr trace) <- address t-storage + 756 initialize-trace t, 0x100/max-depth, 0x10, 0x10 + 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 + 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" + 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" + 769 } + 770 + 771 fn test-render-trace-collapsed-by-default { + 772 var t-storage: trace + 773 var t/esi: (addr trace) <- address t-storage + 774 initialize-trace t, 0x100/max-depth, 0x10, 0x10 + 775 trace-text t, "l", "data" + 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 + 780 # + 781 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 5/xmax, 4/ymax, 0/no-cursor + 782 # + 783 check-ints-equal y, 1, "F - test-render-trace-collapsed-by-default/cursor" + 784 check-screen-row screen, 0/y, "... ", "F - test-render-trace-collapsed-by-default" + 785 } + 786 + 787 fn test-render-trace-error { + 788 var t-storage: trace + 789 var t/esi: (addr trace) <- address t-storage + 790 initialize-trace t, 0x100/max-depth, 0x10, 0x10 + 791 error t, "error" + 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 + 796 # + 797 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor + 798 # + 799 check-ints-equal y, 1, "F - test-render-trace-error/cursor" + 800 check-screen-row screen, 0/y, "error", "F - test-render-trace-error" + 801 } + 802 + 803 fn test-render-trace-error-at-start { + 804 var t-storage: trace + 805 var t/esi: (addr trace) <- address t-storage + 806 initialize-trace t, 0x100/max-depth, 0x10, 0x10 + 807 # + 808 error t, "error" + 809 trace-text t, "l", "data" + 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 + 814 # + 815 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor 816 # - 817 trace-text t, "l", "data" - 818 error t, "error" - 819 # setup: screen - 820 var screen-on-stack: screen - 821 var screen/edi: (addr screen) <- address screen-on-stack - 822 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics - 823 # - 824 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor - 825 # - 826 check-ints-equal y, 2, "F - test-render-trace-error-at-end/cursor" - 827 check-screen-row screen, 0/y, "... ", "F - test-render-trace-error-at-end/0" - 828 check-screen-row screen, 1/y, "error", "F - test-render-trace-error-at-end/1" - 829 } - 830 - 831 fn test-render-trace-error-in-the-middle { - 832 var t-storage: trace - 833 var t/esi: (addr trace) <- address t-storage - 834 initialize-trace t, 0x100/max-depth, 0x10, 0x10 + 817 check-ints-equal y, 2, "F - test-render-trace-error-at-start/cursor" + 818 check-screen-row screen, 0/y, "error", "F - test-render-trace-error-at-start/0" + 819 check-screen-row screen, 1/y, "... ", "F - test-render-trace-error-at-start/1" + 820 } + 821 + 822 fn test-render-trace-error-at-end { + 823 var t-storage: trace + 824 var t/esi: (addr trace) <- address t-storage + 825 initialize-trace t, 0x100/max-depth, 0x10, 0x10 + 826 # + 827 trace-text t, "l", "data" + 828 error t, "error" + 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 + 833 # + 834 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor 835 # - 836 trace-text t, "l", "line 1" - 837 error t, "error" - 838 trace-text t, "l", "line 3" - 839 # setup: screen - 840 var screen-on-stack: screen - 841 var screen/edi: (addr screen) <- address screen-on-stack - 842 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics - 843 # - 844 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor + 836 check-ints-equal y, 2, "F - test-render-trace-error-at-end/cursor" + 837 check-screen-row screen, 0/y, "... ", "F - test-render-trace-error-at-end/0" + 838 check-screen-row screen, 1/y, "error", "F - test-render-trace-error-at-end/1" + 839 } + 840 + 841 fn test-render-trace-error-in-the-middle { + 842 var t-storage: trace + 843 var t/esi: (addr trace) <- address t-storage + 844 initialize-trace t, 0x100/max-depth, 0x10, 0x10 845 # - 846 check-ints-equal y, 3, "F - test-render-trace-error-in-the-middle/cursor" - 847 check-screen-row screen, 0/y, "... ", "F - test-render-trace-error-in-the-middle/0" - 848 check-screen-row screen, 1/y, "error", "F - test-render-trace-error-in-the-middle/1" - 849 check-screen-row screen, 2/y, "... ", "F - test-render-trace-error-in-the-middle/2" - 850 } - 851 - 852 fn test-render-trace-cursor-in-single-line { - 853 var t-storage: trace - 854 var t/esi: (addr trace) <- address t-storage - 855 initialize-trace t, 0x100/max-depth, 0x10, 0x10 - 856 # - 857 trace-text t, "l", "line 1" - 858 error t, "error" - 859 trace-text t, "l", "line 3" - 860 # setup: screen - 861 var screen-on-stack: screen - 862 var screen/edi: (addr screen) <- address screen-on-stack - 863 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics - 864 # - 865 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor + 846 trace-text t, "l", "line 1" + 847 error t, "error" + 848 trace-text t, "l", "line 3" + 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 + 853 # + 854 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor + 855 # + 856 check-ints-equal y, 3, "F - test-render-trace-error-in-the-middle/cursor" + 857 check-screen-row screen, 0/y, "... ", "F - test-render-trace-error-in-the-middle/0" + 858 check-screen-row screen, 1/y, "error", "F - test-render-trace-error-in-the-middle/1" + 859 check-screen-row screen, 2/y, "... ", "F - test-render-trace-error-in-the-middle/2" + 860 } + 861 + 862 fn test-render-trace-cursor-in-single-line { + 863 var t-storage: trace + 864 var t/esi: (addr trace) <- address t-storage + 865 initialize-trace t, 0x100/max-depth, 0x10, 0x10 866 # - 867 check-screen-row screen, 0/y, "... ", "F - test-render-trace-cursor-in-single-line/0" - 868 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-render-trace-cursor-in-single-line/0/cursor" - 869 check-screen-row screen, 1/y, "error ", "F - test-render-trace-cursor-in-single-line/1" - 870 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-render-trace-cursor-in-single-line/1/cursor" - 871 check-screen-row screen, 2/y, "... ", "F - test-render-trace-cursor-in-single-line/2" - 872 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-render-trace-cursor-in-single-line/2/cursor" - 873 } - 874 - 875 fn render-trace-menu screen: (addr screen) { - 876 var width/eax: int <- copy 0 - 877 var height/ecx: int <- copy 0 - 878 width, height <- screen-size screen - 879 var y/ecx: int <- copy height - 880 y <- decrement - 881 var height/edx: int <- copy y - 882 height <- increment - 883 clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg - 884 set-cursor-position screen, 0/x, y - 885 draw-text-rightward-from-cursor screen, " enter/bksp ", width, 0/fg, 0x5c/bg=black - 886 draw-text-rightward-from-cursor screen, " expand/collapse ", width, 7/fg, 0xc5/bg=blue-bg - 887 draw-text-rightward-from-cursor screen, " ctrl+... ", width, 0xf/fg, 0xc5/bg=blue-bg - 888 draw-text-rightward-from-cursor screen, " r ", width, 0/fg, 0x5c/bg=black - 889 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0xc5/bg=blue-bg - 890 draw-text-rightward-from-cursor screen, " m ", width, 0/fg, 3/bg=keyboard - 891 draw-text-rightward-from-cursor screen, " to keyboard ", width, 7/fg, 0xc5/bg=blue-bg - 892 draw-text-rightward-from-cursor screen, " s ", width, 0/fg, 3/bg=keyboard - 893 draw-text-rightward-from-cursor screen, " show whole line ", width, 7/fg, 0xc5/bg=blue-bg - 894 } - 895 - 896 fn edit-trace _self: (addr trace), key: grapheme { - 897 var self/esi: (addr trace) <- copy _self - 898 # cursor down - 899 { - 900 compare key, 0x6a/j - 901 break-if-!= - 902 var cursor-y/eax: (addr int) <- get self, cursor-y - 903 increment *cursor-y - 904 var unclip-cursor-line?/eax: (addr boolean) <- get self, unclip-cursor-line? - 905 copy-to *unclip-cursor-line?, 0/false - 906 return - 907 } - 908 { - 909 compare key, 0x81/down-arrow - 910 break-if-!= - 911 var cursor-y/eax: (addr int) <- get self, cursor-y - 912 increment *cursor-y - 913 var unclip-cursor-line?/eax: (addr boolean) <- get self, unclip-cursor-line? - 914 copy-to *unclip-cursor-line?, 0/false - 915 return - 916 } - 917 # cursor up - 918 { - 919 compare key, 0x6b/k - 920 break-if-!= - 921 var cursor-y/eax: (addr int) <- get self, cursor-y - 922 decrement *cursor-y - 923 var unclip-cursor-line?/eax: (addr boolean) <- get self, unclip-cursor-line? - 924 copy-to *unclip-cursor-line?, 0/false - 925 return - 926 } - 927 { - 928 compare key, 0x82/up-arrow - 929 break-if-!= - 930 var cursor-y/eax: (addr int) <- get self, cursor-y - 931 decrement *cursor-y - 932 var unclip-cursor-line?/eax: (addr boolean) <- get self, unclip-cursor-line? - 933 copy-to *unclip-cursor-line?, 0/false - 934 return - 935 } - 936 # enter = expand - 937 { - 938 compare key, 0xa/newline - 939 break-if-!= - 940 expand self - 941 return - 942 } - 943 # backspace = collapse - 944 { - 945 compare key, 8/backspace - 946 break-if-!= - 947 collapse self - 948 return - 949 } - 950 # ctrl-s: temporarily unclip current line - 951 { - 952 compare key, 0x13/ctrl-s - 953 break-if-!= - 954 var unclip-cursor-line?/eax: (addr boolean) <- get self, unclip-cursor-line? - 955 copy-to *unclip-cursor-line?, 1/true - 956 return - 957 } - 958 # ctrl-f: scroll down - 959 { - 960 compare key, 6/ctrl-f - 961 break-if-!= - 962 scroll-down self - 963 return - 964 } - 965 # ctrl-b: scroll up - 966 { - 967 compare key, 2/ctrl-b - 968 break-if-!= - 969 scroll-up self - 970 return - 971 } - 972 } - 973 - 974 fn expand _self: (addr trace) { - 975 var self/esi: (addr trace) <- copy _self - 976 var trace-ah/eax: (addr handle array trace-line) <- get self, data - 977 var _trace/eax: (addr array trace-line) <- lookup *trace-ah - 978 var trace/edi: (addr array trace-line) <- copy _trace - 979 var cursor-line-index-addr/ecx: (addr int) <- get self, cursor-line-index - 980 var cursor-line-index/ecx: int <- copy *cursor-line-index-addr - 981 var cursor-line-offset/eax: (offset trace-line) <- compute-offset trace, cursor-line-index - 982 var cursor-line/edx: (addr trace-line) <- index trace, cursor-line-offset - 983 var cursor-line-visible?/eax: (addr boolean) <- get cursor-line, visible? - 984 var cursor-line-depth/ebx: (addr int) <- get cursor-line, depth - 985 var target-depth/ebx: int <- copy *cursor-line-depth - 986 # if cursor-line is already visible, increment target-depth - 987 compare *cursor-line-visible?, 0/false - 988 { - 989 break-if-= - 990 target-depth <- increment - 991 } - 992 # reveal the run of lines starting at cursor-line-index with depth target-depth - 993 var i/ecx: int <- copy cursor-line-index - 994 var max/edx: (addr int) <- get self, first-free - 995 { - 996 compare i, *max - 997 break-if->= - 998 var curr-line-offset/eax: (offset trace-line) <- compute-offset trace, i - 999 var curr-line/edx: (addr trace-line) <- index trace, curr-line-offset -1000 var curr-line-depth/eax: (addr int) <- get curr-line, depth -1001 compare *curr-line-depth, target-depth -1002 break-if-< -1003 { -1004 break-if-!= -1005 var curr-line-visible?/eax: (addr boolean) <- get curr-line, visible? -1006 copy-to *curr-line-visible?, 1/true -1007 reveal-trace-line self, curr-line -1008 } -1009 i <- increment -1010 loop -1011 } -1012 } -1013 -1014 fn collapse _self: (addr trace) { -1015 var self/esi: (addr trace) <- copy _self -1016 var trace-ah/eax: (addr handle array trace-line) <- get self, data -1017 var _trace/eax: (addr array trace-line) <- lookup *trace-ah -1018 var trace/edi: (addr array trace-line) <- copy _trace -1019 var cursor-line-index-addr/ecx: (addr int) <- get self, cursor-line-index -1020 var cursor-line-index/ecx: int <- copy *cursor-line-index-addr -1021 var cursor-line-offset/eax: (offset trace-line) <- compute-offset trace, cursor-line-index -1022 var cursor-line/edx: (addr trace-line) <- index trace, cursor-line-offset -1023 var cursor-line-visible?/eax: (addr boolean) <- get cursor-line, visible? -1024 # if cursor-line is not visible, do nothing -1025 compare *cursor-line-visible?, 0/false -1026 { -1027 break-if-!= -1028 return -1029 } -1030 # hide all lines between previous and next line with a lower depth -1031 var cursor-line-depth/ebx: (addr int) <- get cursor-line, depth -1032 var cursor-y/edx: (addr int) <- get self, cursor-y -1033 var target-depth/ebx: int <- copy *cursor-line-depth -1034 var i/ecx: int <- copy cursor-line-index -1035 $collapse:loop1: { -1036 compare i, 0 -1037 break-if-< -1038 var curr-line-offset/eax: (offset trace-line) <- compute-offset trace, i -1039 var curr-line/eax: (addr trace-line) <- index trace, curr-line-offset -1040 { -1041 var curr-line-depth/eax: (addr int) <- get curr-line, depth -1042 compare *curr-line-depth, target-depth -1043 break-if-< $collapse:loop1 -1044 } -1045 # if cursor-line is visible, decrement cursor-y -1046 { -1047 var curr-line-visible?/eax: (addr boolean) <- get curr-line, visible? -1048 compare *curr-line-visible?, 0/false -1049 break-if-= -1050 decrement *cursor-y -1051 } -1052 i <- decrement -1053 loop -1054 } -1055 i <- increment -1056 var max/edx: (addr int) <- get self, first-free -1057 $collapse:loop2: { -1058 compare i, *max -1059 break-if->= -1060 var curr-line-offset/eax: (offset trace-line) <- compute-offset trace, i -1061 var curr-line/edx: (addr trace-line) <- index trace, curr-line-offset -1062 var curr-line-depth/eax: (addr int) <- get curr-line, depth -1063 compare *curr-line-depth, target-depth -1064 break-if-< -1065 { -1066 hide-trace-line self, curr-line -1067 var curr-line-visible?/eax: (addr boolean) <- get curr-line, visible? -1068 copy-to *curr-line-visible?, 0/false -1069 } -1070 i <- increment -1071 loop -1072 } -1073 } -1074 -1075 # the 'visible' array is not required to be in order -1076 # elements can also be deleted out of order -1077 # so it can have holes -1078 # however, lines in it always have visible? set -1079 # we'll use visible? being unset as a sign of emptiness -1080 fn reveal-trace-line _self: (addr trace), line: (addr trace-line) { -1081 var self/esi: (addr trace) <- copy _self -1082 var visible-ah/eax: (addr handle array trace-line) <- get self, visible -1083 var visible/eax: (addr array trace-line) <- lookup *visible-ah -1084 var i/ecx: int <- copy 0 -1085 var len/edx: int <- length visible -1086 { -1087 compare i, len -1088 break-if->= -1089 var curr-offset/edx: (offset trace-line) <- compute-offset visible, i -1090 var curr/edx: (addr trace-line) <- index visible, curr-offset -1091 var curr-visible?/eax: (addr boolean) <- get curr, visible? -1092 compare *curr-visible?, 0/false -1093 { -1094 break-if-!= -1095 # empty slot found -1096 copy-object line, curr -1097 return -1098 } -1099 i <- increment -1100 loop -1101 } -1102 abort "too many visible lines; increase size of array trace.visible" -1103 } -1104 -1105 fn hide-trace-line _self: (addr trace), line: (addr trace-line) { -1106 var self/esi: (addr trace) <- copy _self -1107 var visible-ah/eax: (addr handle array trace-line) <- get self, visible -1108 var visible/eax: (addr array trace-line) <- lookup *visible-ah -1109 var i/ecx: int <- copy 0 -1110 var len/edx: int <- length visible -1111 { -1112 compare i, len -1113 break-if->= -1114 var curr-offset/edx: (offset trace-line) <- compute-offset visible, i -1115 var curr/edx: (addr trace-line) <- index visible, curr-offset -1116 var found?/eax: boolean <- trace-lines-equal? curr, line -1117 compare found?, 0/false -1118 { -1119 break-if-= -1120 clear-object curr -1121 } -1122 i <- increment -1123 loop -1124 } -1125 } -1126 -1127 fn cursor-too-deep? _self: (addr trace) -> _/eax: boolean { -1128 var self/esi: (addr trace) <- copy _self -1129 var trace-ah/eax: (addr handle array trace-line) <- get self, data -1130 var _trace/eax: (addr array trace-line) <- lookup *trace-ah -1131 var trace/edi: (addr array trace-line) <- copy _trace -1132 var cursor-line-index-addr/ecx: (addr int) <- get self, cursor-line-index -1133 var cursor-line-index/ecx: int <- copy *cursor-line-index-addr -1134 var cursor-line-offset/eax: (offset trace-line) <- compute-offset trace, cursor-line-index -1135 var cursor-line/edx: (addr trace-line) <- index trace, cursor-line-offset -1136 var cursor-line-visible?/eax: (addr boolean) <- get cursor-line, visible? -1137 var cursor-line-depth/ebx: (addr int) <- get cursor-line, depth -1138 var target-depth/ebx: int <- copy *cursor-line-depth -1139 # if cursor-line is visible, return false -1140 compare *cursor-line-visible?, 0/false -1141 { -1142 break-if-= -1143 return 0/false -1144 } -1145 # return cursor-line-depth >= max-depth-1 -1146 target-depth <- increment -1147 var max-depth-addr/eax: (addr int) <- get self, max-depth -1148 compare target-depth, *max-depth-addr -1149 { -1150 break-if-< -1151 return 1/true -1152 } -1153 return 0/false -1154 } -1155 -1156 fn test-cursor-down-and-up-within-trace { -1157 var t-storage: trace -1158 var t/esi: (addr trace) <- address t-storage -1159 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1160 # -1161 trace-text t, "l", "line 1" -1162 error t, "error" -1163 trace-text t, "l", "line 3" -1164 # setup: screen -1165 var screen-on-stack: screen -1166 var screen/edi: (addr screen) <- address screen-on-stack -1167 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics -1168 # -1169 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor -1170 # -1171 check-screen-row screen, 0/y, "... ", "F - test-cursor-down-and-up-within-trace/pre-0" -1172 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-cursor-down-and-up-within-trace/pre-0/cursor" -1173 check-screen-row screen, 1/y, "error ", "F - test-cursor-down-and-up-within-trace/pre-1" -1174 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-cursor-down-and-up-within-trace/pre-1/cursor" -1175 check-screen-row screen, 2/y, "... ", "F - test-cursor-down-and-up-within-trace/pre-2" -1176 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-cursor-down-and-up-within-trace/pre-2/cursor" -1177 # cursor down -1178 edit-trace t, 0x6a/j -1179 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor + 867 trace-text t, "l", "line 1" + 868 error t, "error" + 869 trace-text t, "l", "line 3" + 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 + 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" + 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" + 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" + 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 + 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 + 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 + 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 + 900 draw-text-rightward-from-cursor screen, " to keyboard ", width, 7/fg, 0xc5/bg=blue-bg + 901 draw-text-rightward-from-cursor screen, " enter/bksp ", width, 0/fg, 0x5c/bg=menu-highlight + 902 draw-text-rightward-from-cursor screen, " expand/collapse ", width, 7/fg, 0xc5/bg=blue-bg + 903 draw-text-rightward-from-cursor screen, " ^s ", width, 0/fg, 0x5c/bg=menu-highlight + 904 draw-text-rightward-from-cursor screen, " show whole line ", width, 7/fg, 0xc5/bg=blue-bg + 905 } + 906 + 907 fn edit-trace _self: (addr trace), key: grapheme { + 908 var self/esi: (addr trace) <- copy _self + 909 # cursor down + 910 { + 911 compare key, 0x6a/j + 912 break-if-!= + 913 var cursor-y/eax: (addr int) <- get self, cursor-y + 914 increment *cursor-y + 915 var unclip-cursor-line?/eax: (addr boolean) <- get self, unclip-cursor-line? + 916 copy-to *unclip-cursor-line?, 0/false + 917 return + 918 } + 919 { + 920 compare key, 0x81/down-arrow + 921 break-if-!= + 922 var cursor-y/eax: (addr int) <- get self, cursor-y + 923 increment *cursor-y + 924 var unclip-cursor-line?/eax: (addr boolean) <- get self, unclip-cursor-line? + 925 copy-to *unclip-cursor-line?, 0/false + 926 return + 927 } + 928 # cursor up + 929 { + 930 compare key, 0x6b/k + 931 break-if-!= + 932 var cursor-y/eax: (addr int) <- get self, cursor-y + 933 decrement *cursor-y + 934 var unclip-cursor-line?/eax: (addr boolean) <- get self, unclip-cursor-line? + 935 copy-to *unclip-cursor-line?, 0/false + 936 return + 937 } + 938 { + 939 compare key, 0x82/up-arrow + 940 break-if-!= + 941 var cursor-y/eax: (addr int) <- get self, cursor-y + 942 decrement *cursor-y + 943 var unclip-cursor-line?/eax: (addr boolean) <- get self, unclip-cursor-line? + 944 copy-to *unclip-cursor-line?, 0/false + 945 return + 946 } + 947 # enter = expand + 948 { + 949 compare key, 0xa/newline + 950 break-if-!= + 951 expand self + 952 return + 953 } + 954 # backspace = collapse + 955 { + 956 compare key, 8/backspace + 957 break-if-!= + 958 collapse self + 959 return + 960 } + 961 # ctrl-s: temporarily unclip current line + 962 { + 963 compare key, 0x13/ctrl-s + 964 break-if-!= + 965 var unclip-cursor-line?/eax: (addr boolean) <- get self, unclip-cursor-line? + 966 copy-to *unclip-cursor-line?, 1/true + 967 return + 968 } + 969 # ctrl-f: scroll down + 970 { + 971 compare key, 6/ctrl-f + 972 break-if-!= + 973 scroll-down self + 974 return + 975 } + 976 # ctrl-b: scroll up + 977 { + 978 compare key, 2/ctrl-b + 979 break-if-!= + 980 scroll-up self + 981 return + 982 } + 983 } + 984 + 985 fn expand _self: (addr trace) { + 986 var self/esi: (addr trace) <- copy _self + 987 var trace-ah/eax: (addr handle array trace-line) <- get self, data + 988 var _trace/eax: (addr array trace-line) <- lookup *trace-ah + 989 var trace/edi: (addr array trace-line) <- copy _trace + 990 var cursor-line-index-addr/ecx: (addr int) <- get self, cursor-line-index + 991 var cursor-line-index/ecx: int <- copy *cursor-line-index-addr + 992 var cursor-line-offset/eax: (offset trace-line) <- compute-offset trace, cursor-line-index + 993 var cursor-line/edx: (addr trace-line) <- index trace, cursor-line-offset + 994 var cursor-line-visible?/eax: (addr boolean) <- get cursor-line, visible? + 995 var cursor-line-depth/ebx: (addr int) <- get cursor-line, depth + 996 var target-depth/ebx: int <- copy *cursor-line-depth + 997 # if cursor-line is already visible, do nothing + 998 compare *cursor-line-visible?, 0/false + 999 { +1000 break-if-= +1001 #? draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "visible", 7/fg 0/bg +1002 return +1003 } +1004 # reveal the run of lines starting at cursor-line-index with depth target-depth +1005 var i/ecx: int <- copy cursor-line-index +1006 var max/edx: (addr int) <- get self, first-free +1007 { +1008 compare i, *max +1009 break-if->= +1010 var curr-line-offset/eax: (offset trace-line) <- compute-offset trace, i +1011 var curr-line/edx: (addr trace-line) <- index trace, curr-line-offset +1012 var curr-line-depth/eax: (addr int) <- get curr-line, depth +1013 compare *curr-line-depth, target-depth +1014 break-if-< +1015 { +1016 break-if-!= +1017 var curr-line-visible?/eax: (addr boolean) <- get curr-line, visible? +1018 copy-to *curr-line-visible?, 1/true +1019 reveal-trace-line self, curr-line +1020 } +1021 i <- increment +1022 loop +1023 } +1024 } +1025 +1026 fn collapse _self: (addr trace) { +1027 var self/esi: (addr trace) <- copy _self +1028 var trace-ah/eax: (addr handle array trace-line) <- get self, data +1029 var _trace/eax: (addr array trace-line) <- lookup *trace-ah +1030 var trace/edi: (addr array trace-line) <- copy _trace +1031 var cursor-line-index-addr/ecx: (addr int) <- get self, cursor-line-index +1032 var cursor-line-index/ecx: int <- copy *cursor-line-index-addr +1033 var cursor-line-offset/eax: (offset trace-line) <- compute-offset trace, cursor-line-index +1034 var cursor-line/edx: (addr trace-line) <- index trace, cursor-line-offset +1035 var cursor-line-visible?/eax: (addr boolean) <- get cursor-line, visible? +1036 # if cursor-line is not visible, do nothing +1037 compare *cursor-line-visible?, 0/false +1038 { +1039 break-if-!= +1040 return +1041 } +1042 # hide all lines between previous and next line with a lower depth +1043 var cursor-line-depth/ebx: (addr int) <- get cursor-line, depth +1044 var cursor-y/edx: (addr int) <- get self, cursor-y +1045 var target-depth/ebx: int <- copy *cursor-line-depth +1046 var i/ecx: int <- copy cursor-line-index +1047 $collapse:loop1: { +1048 compare i, 0 +1049 break-if-< +1050 var curr-line-offset/eax: (offset trace-line) <- compute-offset trace, i +1051 var curr-line/eax: (addr trace-line) <- index trace, curr-line-offset +1052 { +1053 var curr-line-depth/eax: (addr int) <- get curr-line, depth +1054 compare *curr-line-depth, target-depth +1055 break-if-< $collapse:loop1 +1056 } +1057 # if cursor-line is visible, decrement cursor-y +1058 { +1059 var curr-line-visible?/eax: (addr boolean) <- get curr-line, visible? +1060 compare *curr-line-visible?, 0/false +1061 break-if-= +1062 decrement *cursor-y +1063 } +1064 i <- decrement +1065 loop +1066 } +1067 i <- increment +1068 var max/edx: (addr int) <- get self, first-free +1069 $collapse:loop2: { +1070 compare i, *max +1071 break-if->= +1072 var curr-line-offset/eax: (offset trace-line) <- compute-offset trace, i +1073 var curr-line/edx: (addr trace-line) <- index trace, curr-line-offset +1074 var curr-line-depth/eax: (addr int) <- get curr-line, depth +1075 compare *curr-line-depth, target-depth +1076 break-if-< +1077 { +1078 hide-trace-line self, curr-line +1079 var curr-line-visible?/eax: (addr boolean) <- get curr-line, visible? +1080 copy-to *curr-line-visible?, 0/false +1081 } +1082 i <- increment +1083 loop +1084 } +1085 } +1086 +1087 # the 'visible' array is not required to be in order +1088 # elements can also be deleted out of order +1089 # so it can have holes +1090 # however, lines in it always have visible? set +1091 # we'll use visible? being unset as a sign of emptiness +1092 fn reveal-trace-line _self: (addr trace), line: (addr trace-line) { +1093 var self/esi: (addr trace) <- copy _self +1094 var visible-ah/eax: (addr handle array trace-line) <- get self, visible +1095 var visible/eax: (addr array trace-line) <- lookup *visible-ah +1096 var i/ecx: int <- copy 0 +1097 var len/edx: int <- length visible +1098 { +1099 compare i, len +1100 break-if->= +1101 var curr-offset/edx: (offset trace-line) <- compute-offset visible, i +1102 var curr/edx: (addr trace-line) <- index visible, curr-offset +1103 var curr-visible?/eax: (addr boolean) <- get curr, visible? +1104 compare *curr-visible?, 0/false +1105 { +1106 break-if-!= +1107 # empty slot found +1108 copy-object line, curr +1109 return +1110 } +1111 i <- increment +1112 loop +1113 } +1114 abort "too many visible lines; increase size of array trace.visible" +1115 } +1116 +1117 fn hide-trace-line _self: (addr trace), line: (addr trace-line) { +1118 var self/esi: (addr trace) <- copy _self +1119 var visible-ah/eax: (addr handle array trace-line) <- get self, visible +1120 var visible/eax: (addr array trace-line) <- lookup *visible-ah +1121 var i/ecx: int <- copy 0 +1122 var len/edx: int <- length visible +1123 { +1124 compare i, len +1125 break-if->= +1126 var curr-offset/edx: (offset trace-line) <- compute-offset visible, i +1127 var curr/edx: (addr trace-line) <- index visible, curr-offset +1128 var found?/eax: boolean <- trace-lines-equal? curr, line +1129 compare found?, 0/false +1130 { +1131 break-if-= +1132 clear-object curr +1133 } +1134 i <- increment +1135 loop +1136 } +1137 } +1138 +1139 fn cursor-too-deep? _self: (addr trace) -> _/eax: boolean { +1140 var self/esi: (addr trace) <- copy _self +1141 var trace-ah/eax: (addr handle array trace-line) <- get self, data +1142 var _trace/eax: (addr array trace-line) <- lookup *trace-ah +1143 var trace/edi: (addr array trace-line) <- copy _trace +1144 var cursor-line-index-addr/ecx: (addr int) <- get self, cursor-line-index +1145 var cursor-line-index/ecx: int <- copy *cursor-line-index-addr +1146 var cursor-line-offset/eax: (offset trace-line) <- compute-offset trace, cursor-line-index +1147 var cursor-line/edx: (addr trace-line) <- index trace, cursor-line-offset +1148 var cursor-line-visible?/eax: (addr boolean) <- get cursor-line, visible? +1149 var cursor-line-depth/ebx: (addr int) <- get cursor-line, depth +1150 var target-depth/ebx: int <- copy *cursor-line-depth +1151 # if cursor-line is visible, return false +1152 compare *cursor-line-visible?, 0/false +1153 { +1154 break-if-= +1155 return 0/false +1156 } +1157 # return cursor-line-depth >= max-depth-1 +1158 target-depth <- increment +1159 var max-depth-addr/eax: (addr int) <- get self, max-depth +1160 compare target-depth, *max-depth-addr +1161 { +1162 break-if-< +1163 return 1/true +1164 } +1165 return 0/false +1166 } +1167 +1168 fn test-cursor-down-and-up-within-trace { +1169 var t-storage: trace +1170 var t/esi: (addr trace) <- address t-storage +1171 initialize-trace t, 0x100/max-depth, 0x10, 0x10 +1172 # +1173 trace-text t, "l", "line 1" +1174 error t, "error" +1175 trace-text t, "l", "line 3" +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 1180 # -1181 check-screen-row screen, 0/y, "... ", "F - test-cursor-down-and-up-within-trace/down-0" -1182 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-cursor-down-and-up-within-trace/down-0/cursor" -1183 check-screen-row screen, 1/y, "error ", "F - test-cursor-down-and-up-within-trace/down-1" -1184 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "||||| ", "F - test-cursor-down-and-up-within-trace/down-1/cursor" -1185 check-screen-row screen, 2/y, "... ", "F - test-cursor-down-and-up-within-trace/down-2" -1186 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-cursor-down-and-up-within-trace/down-2/cursor" -1187 # cursor up -1188 edit-trace t, 0x6b/k -1189 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor -1190 # -1191 check-screen-row screen, 0/y, "... ", "F - test-cursor-down-and-up-within-trace/up-0" -1192 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-cursor-down-and-up-within-trace/up-0/cursor" -1193 check-screen-row screen, 1/y, "error ", "F - test-cursor-down-and-up-within-trace/up-1" -1194 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-cursor-down-and-up-within-trace/up-1/cursor" -1195 check-screen-row screen, 2/y, "... ", "F - test-cursor-down-and-up-within-trace/up-2" -1196 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-cursor-down-and-up-within-trace/up-2/cursor" -1197 } -1198 -1199 fn test-cursor-down-past-bottom-of-trace { -1200 var t-storage: trace -1201 var t/esi: (addr trace) <- address t-storage -1202 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1203 # -1204 trace-text t, "l", "line 1" -1205 error t, "error" -1206 trace-text t, "l", "line 3" -1207 # setup: screen -1208 var screen-on-stack: screen -1209 var screen/edi: (addr screen) <- address screen-on-stack -1210 initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics -1211 # -1212 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor -1213 # -1214 check-screen-row screen, 0/y, "... ", "F - test-cursor-down-past-bottom-of-trace/pre-0" -1215 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-cursor-down-past-bottom-of-trace/pre-0/cursor" -1216 check-screen-row screen, 1/y, "error ", "F - test-cursor-down-past-bottom-of-trace/pre-1" -1217 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-cursor-down-past-bottom-of-trace/pre-1/cursor" -1218 check-screen-row screen, 2/y, "... ", "F - test-cursor-down-past-bottom-of-trace/pre-2" -1219 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-cursor-down-past-bottom-of-trace/pre-2/cursor" -1220 # cursor down several times -1221 edit-trace t, 0x6a/j -1222 edit-trace t, 0x6a/j -1223 edit-trace t, 0x6a/j -1224 edit-trace t, 0x6a/j -1225 edit-trace t, 0x6a/j -1226 # hack: we do need to render to make this test pass; we're mixing state management with rendering -1227 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor -1228 # cursor clamps at bottom -1229 check-screen-row screen, 0/y, "... ", "F - test-cursor-down-past-bottom-of-trace/down-0" -1230 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-cursor-down-past-bottom-of-trace/down-0/cursor" -1231 check-screen-row screen, 1/y, "error ", "F - test-cursor-down-past-bottom-of-trace/down-1" -1232 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-cursor-down-past-bottom-of-trace/down-1/cursor" -1233 check-screen-row screen, 2/y, "... ", "F - test-cursor-down-past-bottom-of-trace/down-2" -1234 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "||| ", "F - test-cursor-down-past-bottom-of-trace/down-2/cursor" -1235 } -1236 -1237 fn test-expand-within-trace { -1238 var t-storage: trace -1239 var t/esi: (addr trace) <- address t-storage -1240 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1241 # -1242 trace-text t, "l", "line 1" -1243 trace-text t, "l", "line 2" -1244 # setup: screen -1245 var screen-on-stack: screen -1246 var screen/edi: (addr screen) <- address screen-on-stack -1247 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics -1248 # -1249 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1250 # -1251 check-screen-row screen, 0/y, "... ", "F - test-expand-within-trace/pre-0" -1252 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-expand-within-trace/pre-0/cursor" -1253 check-screen-row screen, 1/y, " ", "F - test-expand-within-trace/pre-1" -1254 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-expand-within-trace/pre-1/cursor" -1255 # expand -1256 edit-trace t, 0xa/enter -1257 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1258 # -1259 check-screen-row screen, 0/y, "1 line 1 ", "F - test-expand-within-trace/expand-0" -1260 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-expand-within-trace/expand-0/cursor" -1261 check-screen-row screen, 1/y, "1 line 2 ", "F - test-expand-within-trace/expand-1" -1262 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-expand-within-trace/expand-1/cursor" -1263 check-screen-row screen, 2/y, " ", "F - test-expand-within-trace/expand-2" -1264 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-expand-within-trace/expand-2/cursor" -1265 } -1266 -1267 fn test-trace-expand-skips-lower-depth { -1268 var t-storage: trace -1269 var t/esi: (addr trace) <- address t-storage -1270 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1271 # -1272 trace-text t, "l", "line 1" -1273 trace-lower t -1274 trace-text t, "l", "line 2" -1275 # setup: screen -1276 var screen-on-stack: screen -1277 var screen/edi: (addr screen) <- address screen-on-stack -1278 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics -1279 # -1280 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1281 # -1282 check-screen-row screen, 0/y, "... ", "F - test-trace-expand-skips-lower-depth/pre-0" -1283 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-expand-skips-lower-depth/pre-0/cursor" -1284 check-screen-row screen, 1/y, " ", "F - test-trace-expand-skips-lower-depth/pre-1" -1285 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-skips-lower-depth/pre-1/cursor" -1286 # expand -1287 edit-trace t, 0xa/enter -1288 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1289 # -1290 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-expand-skips-lower-depth/expand-0" -1291 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-expand-skips-lower-depth/expand-0/cursor" -1292 check-screen-row screen, 1/y, "... ", "F - test-trace-expand-skips-lower-depth/expand-1" -1293 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-skips-lower-depth/expand-1/cursor" -1294 check-screen-row screen, 2/y, " ", "F - test-trace-expand-skips-lower-depth/expand-2" -1295 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-skips-lower-depth/expand-2/cursor" -1296 } -1297 -1298 fn test-trace-expand-continues-past-lower-depth { -1299 var t-storage: trace -1300 var t/esi: (addr trace) <- address t-storage -1301 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1302 # -1303 trace-text t, "l", "line 1" -1304 trace-lower t -1305 trace-text t, "l", "line 1.1" -1306 trace-higher t -1307 trace-text t, "l", "line 2" -1308 # setup: screen -1309 var screen-on-stack: screen -1310 var screen/edi: (addr screen) <- address screen-on-stack -1311 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics -1312 # -1313 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor +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" +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" +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" +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" +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" +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" +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" +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" +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" +1209 } +1210 +1211 fn test-cursor-down-past-bottom-of-trace { +1212 var t-storage: trace +1213 var t/esi: (addr trace) <- address t-storage +1214 initialize-trace t, 0x100/max-depth, 0x10, 0x10 +1215 # +1216 trace-text t, "l", "line 1" +1217 error t, "error" +1218 trace-text t, "l", "line 3" +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 +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" +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" +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" +1232 # cursor down several times +1233 edit-trace t, 0x6a/j +1234 edit-trace t, 0x6a/j +1235 edit-trace t, 0x6a/j +1236 edit-trace t, 0x6a/j +1237 edit-trace t, 0x6a/j +1238 # hack: we do need to render to make this test pass; we're mixing state management with rendering +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" +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" +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" +1247 } +1248 +1249 fn test-expand-within-trace { +1250 var t-storage: trace +1251 var t/esi: (addr trace) <- address t-storage +1252 initialize-trace t, 0x100/max-depth, 0x10, 0x10 +1253 # +1254 trace-text t, "l", "line 1" +1255 trace-text t, "l", "line 2" +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 +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" +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" +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" +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" +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" +1277 } +1278 +1279 fn test-trace-expand-skips-lower-depth { +1280 var t-storage: trace +1281 var t/esi: (addr trace) <- address t-storage +1282 initialize-trace t, 0x100/max-depth, 0x10, 0x10 +1283 # +1284 trace-text t, "l", "line 1" +1285 trace-lower t +1286 trace-text t, "l", "line 2" +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 +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" +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" +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" +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" +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" +1308 } +1309 +1310 fn test-trace-expand-continues-past-lower-depth { +1311 var t-storage: trace +1312 var t/esi: (addr trace) <- address t-storage +1313 initialize-trace t, 0x100/max-depth, 0x10, 0x10 1314 # -1315 check-screen-row screen, 0/y, "... ", "F - test-trace-expand-continues-past-lower-depth/pre-0" -1316 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-expand-continues-past-lower-depth/pre-0/cursor" -1317 check-screen-row screen, 1/y, " ", "F - test-trace-expand-continues-past-lower-depth/pre-1" -1318 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-continues-past-lower-depth/pre-1/cursor" -1319 # expand -1320 edit-trace t, 0xa/enter -1321 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1322 # -1323 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-expand-continues-past-lower-depth/expand-0" -1324 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-expand-continues-past-lower-depth/expand-0/cursor" -1325 # TODO: might be too wasteful to show every place where lines are hidden -1326 check-screen-row screen, 1/y, "... ", "F - test-trace-expand-continues-past-lower-depth/expand-1" -1327 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-continues-past-lower-depth/expand-1/cursor" -1328 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-expand-continues-past-lower-depth/expand-2" -1329 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-continues-past-lower-depth/expand-2/cursor" -1330 } -1331 -1332 fn test-trace-expand-stops-at-higher-depth { -1333 var t-storage: trace -1334 var t/esi: (addr trace) <- address t-storage -1335 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1336 # -1337 trace-lower t -1338 trace-text t, "l", "line 1.1" -1339 trace-lower t -1340 trace-text t, "l", "line 1.1.1" -1341 trace-higher t -1342 trace-text t, "l", "line 1.2" -1343 trace-higher t -1344 trace-text t, "l", "line 2" -1345 trace-lower t -1346 trace-text t, "l", "line 2.1" -1347 # setup: screen -1348 var screen-on-stack: screen -1349 var screen/edi: (addr screen) <- address screen-on-stack -1350 initialize-screen screen, 0x10/width, 8/height, 0/no-pixel-graphics -1351 # -1352 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor -1353 # -1354 check-screen-row screen, 0/y, "... ", "F - test-trace-expand-stops-at-higher-depth/pre-0" -1355 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-expand-stops-at-higher-depth/pre-0/cursor" -1356 check-screen-row screen, 1/y, " ", "F - test-trace-expand-stops-at-higher-depth/pre-1" -1357 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-stops-at-higher-depth/pre-1/cursor" -1358 # expand -1359 edit-trace t, 0xa/enter -1360 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor -1361 # -1362 check-screen-row screen, 0/y, "2 line 1.1 ", "F - test-trace-expand-stops-at-higher-depth/expand-0" -1363 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||||| ", "F - test-trace-expand-stops-at-higher-depth/expand-0/cursor" -1364 check-screen-row screen, 1/y, "... ", "F - test-trace-expand-stops-at-higher-depth/expand-1" -1365 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-1/cursor" -1366 check-screen-row screen, 2/y, "2 line 1.2 ", "F - test-trace-expand-stops-at-higher-depth/expand-2" -1367 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-2/cursor" -1368 check-screen-row screen, 3/y, "... ", "F - test-trace-expand-stops-at-higher-depth/expand-3" -1369 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-3/cursor" -1370 check-screen-row screen, 4/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-4" -1371 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-trace-expand-stops-at-higher-depth/expand-4/cursor" -1372 } -1373 -1374 fn test-trace-expand-twice { -1375 var t-storage: trace -1376 var t/esi: (addr trace) <- address t-storage -1377 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1378 # -1379 trace-text t, "l", "line 1" -1380 trace-lower t -1381 trace-text t, "l", "line 1.1" -1382 trace-higher t -1383 trace-text t, "l", "line 2" -1384 # setup: screen -1385 var screen-on-stack: screen -1386 var screen/edi: (addr screen) <- address screen-on-stack -1387 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics -1388 # -1389 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor +1315 trace-text t, "l", "line 1" +1316 trace-lower t +1317 trace-text t, "l", "line 1.1" +1318 trace-higher t +1319 trace-text t, "l", "line 2" +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 +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" +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" +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" +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" +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" +1342 } +1343 +1344 fn test-trace-expand-stops-at-higher-depth { +1345 var t-storage: trace +1346 var t/esi: (addr trace) <- address t-storage +1347 initialize-trace t, 0x100/max-depth, 0x10, 0x10 +1348 # +1349 trace-lower t +1350 trace-text t, "l", "line 1.1" +1351 trace-lower t +1352 trace-text t, "l", "line 1.1.1" +1353 trace-higher t +1354 trace-text t, "l", "line 1.2" +1355 trace-higher t +1356 trace-text t, "l", "line 2" +1357 trace-lower t +1358 trace-text t, "l", "line 2.1" +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 +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" +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" +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" +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" +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" +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" +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" +1384 } +1385 +1386 fn test-trace-expand-twice { +1387 var t-storage: trace +1388 var t/esi: (addr trace) <- address t-storage +1389 initialize-trace t, 0x100/max-depth, 0x10, 0x10 1390 # -1391 check-screen-row screen, 0/y, "... ", "F - test-trace-expand-twice/pre-0" -1392 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-expand-twice/pre-0/cursor" -1393 check-screen-row screen, 1/y, " ", "F - test-trace-expand-twice/pre-1" -1394 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-twice/pre-1/cursor" -1395 # expand -1396 edit-trace t, 0xa/enter -1397 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1398 # -1399 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-expand-twice/expand-0" -1400 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-expand-twice/expand-0/cursor" -1401 check-screen-row screen, 1/y, "... ", "F - test-trace-expand-twice/expand-1" -1402 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-expand-twice/expand-1/cursor" -1403 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-expand-twice/expand-2" -1404 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-twice/expand-2/cursor" -1405 # cursor down -1406 edit-trace t, 0x6a/j -1407 # hack: we need to render here to make this test pass; we're mixing state management with rendering -1408 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1409 # -1410 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-expand-twice/down-0" -1411 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-expand-twice/down-0/cursor" -1412 check-screen-row screen, 1/y, "... ", "F - test-trace-expand-twice/down-1" -1413 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "||| ", "F - test-trace-expand-twice/down-1/cursor" -1414 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-expand-twice/down-2" -1415 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-twice/down-2/cursor" -1416 # expand again -1417 edit-trace t, 0xa/enter -1418 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1419 # -1420 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-expand-twice/expand2-0" -1421 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-expand-twice/expand2-0/cursor" -1422 check-screen-row screen, 1/y, "2 line 1.1 ", "F - test-trace-expand-twice/expand2-1" -1423 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "|||||||||| ", "F - test-trace-expand-twice/expand2-1/cursor" -1424 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-expand-twice/expand2-2" -1425 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-expand-twice/expand2-2/cursor" -1426 } -1427 -1428 fn test-trace-refresh-cursor { -1429 var t-storage: trace -1430 var t/esi: (addr trace) <- address t-storage -1431 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1432 # -1433 trace-text t, "l", "line 1" -1434 trace-text t, "l", "line 2" -1435 trace-text t, "l", "line 3" -1436 # setup: screen -1437 var screen-on-stack: screen -1438 var screen/edi: (addr screen) <- address screen-on-stack -1439 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics -1440 # -1441 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1442 # -1443 check-screen-row screen, 0/y, "... ", "F - test-trace-refresh-cursor/pre-0" -1444 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-refresh-cursor/pre-0/cursor" -1445 check-screen-row screen, 1/y, " ", "F - test-trace-refresh-cursor/pre-1" -1446 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-refresh-cursor/pre-1/cursor" -1447 # expand -1448 edit-trace t, 0xa/enter -1449 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1450 # -1451 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-refresh-cursor/expand-0" -1452 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-refresh-cursor/expand-0/cursor" -1453 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-refresh-cursor/expand-1" -1454 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-refresh-cursor/expand-1/cursor" -1455 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-refresh-cursor/expand-2" -1456 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-refresh-cursor/expand-2/cursor" -1457 # cursor down -1458 edit-trace t, 0x6a/j -1459 edit-trace t, 0x6a/j -1460 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1461 # -1462 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-refresh-cursor/down-0" -1463 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-refresh-cursor/down-0/cursor" -1464 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-refresh-cursor/down-1" -1465 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-refresh-cursor/down-1/cursor" -1466 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-refresh-cursor/down-2" -1467 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-refresh-cursor/down-2/cursor" -1468 # recreate trace -1469 clear-trace t -1470 trace-text t, "l", "line 1" -1471 trace-text t, "l", "line 2" -1472 trace-text t, "l", "line 3" -1473 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1474 # cursor remains unchanged -1475 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-refresh-cursor/refresh-0" -1476 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-refresh-cursor/refresh-0/cursor" -1477 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-refresh-cursor/refresh-1" -1478 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-refresh-cursor/refresh-1/cursor" -1479 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-refresh-cursor/refresh-2" -1480 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-refresh-cursor/refresh-2/cursor" -1481 } -1482 -1483 fn test-trace-preserve-cursor-on-refresh { -1484 var t-storage: trace -1485 var t/esi: (addr trace) <- address t-storage -1486 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1487 # -1488 trace-text t, "l", "line 1" -1489 trace-text t, "l", "line 2" -1490 trace-text t, "l", "line 3" -1491 # setup: screen -1492 var screen-on-stack: screen -1493 var screen/edi: (addr screen) <- address screen-on-stack -1494 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics -1495 # -1496 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1497 # -1498 check-screen-row screen, 0/y, "... ", "F - test-trace-preserve-cursor-on-refresh/pre-0" -1499 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-preserve-cursor-on-refresh/pre-0/cursor" -1500 check-screen-row screen, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/pre-1" -1501 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/pre-1/cursor" -1502 # expand -1503 edit-trace t, 0xa/enter -1504 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1505 # -1506 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-preserve-cursor-on-refresh/expand-0" -1507 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-preserve-cursor-on-refresh/expand-0/cursor" -1508 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-preserve-cursor-on-refresh/expand-1" -1509 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/expand-1/cursor" -1510 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-preserve-cursor-on-refresh/expand-2" -1511 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-preserve-cursor-on-refresh/expand-2/cursor" -1512 # cursor down -1513 edit-trace t, 0x6a/j -1514 edit-trace t, 0x6a/j -1515 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1516 # -1517 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-preserve-cursor-on-refresh/down-0" -1518 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-preserve-cursor-on-refresh/down-0/cursor" -1519 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-preserve-cursor-on-refresh/down-1" -1520 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/down-1/cursor" -1521 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-preserve-cursor-on-refresh/down-2" -1522 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-preserve-cursor-on-refresh/down-2/cursor" -1523 # recreate trace with slightly different lines -1524 clear-trace t -1525 trace-text t, "l", "line 4" -1526 trace-text t, "l", "line 5" -1527 trace-text t, "l", "line 3" # cursor line is unchanged -1528 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1529 # cursor remains unchanged -1530 check-screen-row screen, 0/y, "1 line 4 ", "F - test-trace-preserve-cursor-on-refresh/refresh-0" -1531 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-preserve-cursor-on-refresh/refresh-0/cursor" -1532 check-screen-row screen, 1/y, "1 line 5 ", "F - test-trace-preserve-cursor-on-refresh/refresh-1" -1533 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-preserve-cursor-on-refresh/refresh-1/cursor" -1534 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-preserve-cursor-on-refresh/refresh-2" -1535 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-preserve-cursor-on-refresh/refresh-2/cursor" -1536 } -1537 -1538 fn test-trace-keep-cursor-visible-on-refresh { -1539 var t-storage: trace -1540 var t/esi: (addr trace) <- address t-storage -1541 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1542 # -1543 trace-text t, "l", "line 1" -1544 trace-text t, "l", "line 2" -1545 trace-text t, "l", "line 3" -1546 # setup: screen -1547 var screen-on-stack: screen -1548 var screen/edi: (addr screen) <- address screen-on-stack -1549 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics -1550 # -1551 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1552 # -1553 check-screen-row screen, 0/y, "... ", "F - test-trace-keep-cursor-visible-on-refresh/pre-0" -1554 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-keep-cursor-visible-on-refresh/pre-0/cursor" -1555 check-screen-row screen, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/pre-1" -1556 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/pre-1/cursor" -1557 # expand -1558 edit-trace t, 0xa/enter -1559 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1560 # -1561 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-keep-cursor-visible-on-refresh/expand-0" -1562 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-keep-cursor-visible-on-refresh/expand-0/cursor" -1563 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-keep-cursor-visible-on-refresh/expand-1" -1564 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/expand-1/cursor" -1565 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-keep-cursor-visible-on-refresh/expand-2" -1566 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/expand-2/cursor" -1567 # cursor down -1568 edit-trace t, 0x6a/j -1569 edit-trace t, 0x6a/j -1570 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1571 # -1572 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-keep-cursor-visible-on-refresh/down-0" -1573 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/down-0/cursor" -1574 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-keep-cursor-visible-on-refresh/down-1" -1575 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/down-1/cursor" -1576 check-screen-row screen, 2/y, "1 line 3 ", "F - test-trace-keep-cursor-visible-on-refresh/down-2" -1577 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-keep-cursor-visible-on-refresh/down-2/cursor" -1578 # recreate trace with entirely different lines -1579 clear-trace t -1580 trace-text t, "l", "line 4" -1581 trace-text t, "l", "line 5" -1582 trace-text t, "l", "line 6" -1583 mark-lines-dirty t -1584 clear-screen screen -1585 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1586 # trace collapses, and cursor bumps up -1587 check-screen-row screen, 0/y, "... ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-0" -1588 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-0/cursor" -1589 check-screen-row screen, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-1" -1590 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-1/cursor" -1591 check-screen-row screen, 2/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-2" -1592 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-2/cursor" -1593 } -1594 -1595 fn test-trace-collapse-at-top { -1596 var t-storage: trace -1597 var t/esi: (addr trace) <- address t-storage -1598 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1599 # -1600 trace-text t, "l", "line 1" -1601 trace-lower t -1602 trace-text t, "l", "line 1.1" -1603 trace-higher t -1604 trace-text t, "l", "line 2" -1605 # setup: screen -1606 var screen-on-stack: screen -1607 var screen/edi: (addr screen) <- address screen-on-stack -1608 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics -1609 # -1610 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor +1391 trace-text t, "l", "line 1" +1392 trace-lower t +1393 trace-text t, "l", "line 1.1" +1394 trace-higher t +1395 trace-text t, "l", "line 2" +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 +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" +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" +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" +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" +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" +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" +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" +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" +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" +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" +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" +1438 } +1439 +1440 fn test-trace-refresh-cursor { +1441 var t-storage: trace +1442 var t/esi: (addr trace) <- address t-storage +1443 initialize-trace t, 0x100/max-depth, 0x10, 0x10 +1444 # +1445 trace-text t, "l", "line 1" +1446 trace-text t, "l", "line 2" +1447 trace-text t, "l", "line 3" +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 +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" +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" +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" +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" +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" +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" +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" +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" +1480 # recreate trace +1481 clear-trace t +1482 trace-text t, "l", "line 1" +1483 trace-text t, "l", "line 2" +1484 trace-text t, "l", "line 3" +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" +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" +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" +1493 } +1494 +1495 fn test-trace-preserve-cursor-on-refresh { +1496 var t-storage: trace +1497 var t/esi: (addr trace) <- address t-storage +1498 initialize-trace t, 0x100/max-depth, 0x10, 0x10 +1499 # +1500 trace-text t, "l", "line 1" +1501 trace-text t, "l", "line 2" +1502 trace-text t, "l", "line 3" +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 +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" +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" +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" +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" +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" +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" +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" +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" +1535 # recreate trace with slightly different lines +1536 clear-trace t +1537 trace-text t, "l", "line 4" +1538 trace-text t, "l", "line 5" +1539 trace-text t, "l", "line 3" # cursor line is unchanged +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" +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" +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" +1548 } +1549 +1550 fn test-trace-keep-cursor-visible-on-refresh { +1551 var t-storage: trace +1552 var t/esi: (addr trace) <- address t-storage +1553 initialize-trace t, 0x100/max-depth, 0x10, 0x10 +1554 # +1555 trace-text t, "l", "line 1" +1556 trace-text t, "l", "line 2" +1557 trace-text t, "l", "line 3" +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 +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" +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" +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" +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" +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" +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" +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" +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" +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 +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" +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" +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" +1605 } +1606 +1607 fn test-trace-collapse-at-top { +1608 var t-storage: trace +1609 var t/esi: (addr trace) <- address t-storage +1610 initialize-trace t, 0x100/max-depth, 0x10, 0x10 1611 # -1612 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-at-top/pre-0" -1613 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-at-top/pre-0/cursor" -1614 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-at-top/pre-1" -1615 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-at-top/pre-1/cursor" -1616 # expand -1617 edit-trace t, 0xa/enter -1618 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1619 # -1620 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-at-top/expand-0" -1621 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse-at-top/expand-0/cursor" -1622 check-screen-row screen, 1/y, "... ", "F - test-trace-collapse-at-top/expand-1" -1623 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-at-top/expand-1/cursor" -1624 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-at-top/expand-2" -1625 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-at-top/expand-2/cursor" -1626 # collapse -1627 edit-trace t, 8/backspace -1628 # hack: we need to render here to make this test pass; we're mixing state management with rendering -1629 clear-screen screen -1630 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor +1612 trace-text t, "l", "line 1" +1613 trace-lower t +1614 trace-text t, "l", "line 1.1" +1615 trace-higher t +1616 trace-text t, "l", "line 2" +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 +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" +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" +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-ints-equal y, 1, "F - test-trace-collapse-at-top/post-0/y" -1633 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-at-top/post-0" -1634 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-at-top/post-0/cursor" -1635 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-at-top/post-1" -1636 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-at-top/post-1/cursor" -1637 } -1638 -1639 fn test-trace-collapse { -1640 var t-storage: trace -1641 var t/esi: (addr trace) <- address t-storage -1642 initialize-trace t, 0x100/max-depth, 0x10, 0x10 +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" +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" +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" +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 +1642 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1643 # -1644 trace-text t, "l", "line 1" -1645 trace-text t, "l", "line 2" -1646 # setup: screen -1647 var screen-on-stack: screen -1648 var screen/edi: (addr screen) <- address screen-on-stack -1649 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics -1650 # -1651 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1652 # -1653 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse/pre-0" -1654 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse/pre-0/cursor" -1655 check-screen-row screen, 1/y, " ", "F - test-trace-collapse/pre-1" -1656 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse/pre-1/cursor" -1657 # expand -1658 edit-trace t, 0xa/enter -1659 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1660 # -1661 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse/expand-0" -1662 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse/expand-0/cursor" -1663 check-screen-row screen, 1/y, "1 line 2 ", "F - test-trace-collapse/expand-1" -1664 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse/expand-1/cursor" -1665 # cursor down -1666 edit-trace t, 0x6a/j -1667 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1668 # collapse -1669 edit-trace t, 8/backspace -1670 clear-screen screen -1671 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor +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" +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" +1649 } +1650 +1651 fn test-trace-collapse { +1652 var t-storage: trace +1653 var t/esi: (addr trace) <- address t-storage +1654 initialize-trace t, 0x100/max-depth, 0x10, 0x10 +1655 # +1656 trace-text t, "l", "line 1" +1657 trace-text t, "l", "line 2" +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 +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" +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" +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-ints-equal y, 1, "F - test-trace-collapse/post-0/y" -1674 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse/post-0" -1675 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse/post-0/cursor" -1676 check-screen-row screen, 1/y, " ", "F - test-trace-collapse/post-1" -1677 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse/post-1/cursor" -1678 } -1679 -1680 fn test-trace-collapse-skips-invisible-lines { -1681 var t-storage: trace -1682 var t/esi: (addr trace) <- address t-storage -1683 initialize-trace t, 0x100/max-depth, 0x10, 0x10 +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" +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" +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 +1683 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor 1684 # -1685 trace-text t, "l", "line 1" -1686 trace-lower t -1687 trace-text t, "l", "line 1.1" -1688 trace-higher t -1689 trace-text t, "l", "line 2" -1690 # setup: screen -1691 var screen-on-stack: screen -1692 var screen/edi: (addr screen) <- address screen-on-stack -1693 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics -1694 # -1695 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor +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" +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" +1690 } +1691 +1692 fn test-trace-collapse-skips-invisible-lines { +1693 var t-storage: trace +1694 var t/esi: (addr trace) <- address t-storage +1695 initialize-trace t, 0x100/max-depth, 0x10, 0x10 1696 # -1697 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-skips-invisible-lines/pre-0" -1698 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-skips-invisible-lines/pre-0/cursor" -1699 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-skips-invisible-lines/pre-1" -1700 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-skips-invisible-lines/pre-1/cursor" -1701 # expand -1702 edit-trace t, 0xa/enter -1703 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1704 # two visible lines with an invisible line in between -1705 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-skips-invisible-lines/expand-0" -1706 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse-skips-invisible-lines/expand-0/cursor" -1707 check-screen-row screen, 1/y, "... ", "F - test-trace-collapse-skips-invisible-lines/expand-1" -1708 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-skips-invisible-lines/expand-1/cursor" -1709 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-skips-invisible-lines/expand-2" -1710 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-skips-invisible-lines/expand-2/cursor" -1711 # cursor down to second visible line -1712 edit-trace t, 0x6a/j -1713 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1714 edit-trace t, 0x6a/j -1715 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1716 # collapse -1717 edit-trace t, 8/backspace -1718 clear-screen screen -1719 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1720 # -1721 check-ints-equal y, 1, "F - test-trace-collapse-skips-invisible-lines/post-0/y" -1722 var cursor-y/eax: (addr int) <- get t, cursor-y -1723 check-ints-equal *cursor-y, 0, "F - test-trace-collapse-skips-invisible-lines/post-0/cursor-y" -1724 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-skips-invisible-lines/post-0" -1725 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-skips-invisible-lines/post-0/cursor" -1726 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-skips-invisible-lines/post-1" -1727 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-skips-invisible-lines/post-1/cursor" -1728 } -1729 -1730 fn test-trace-collapse-two-levels { -1731 var t-storage: trace -1732 var t/esi: (addr trace) <- address t-storage -1733 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1734 # -1735 trace-text t, "l", "line 1" -1736 trace-lower t -1737 trace-text t, "l", "line 1.1" -1738 trace-higher t -1739 trace-text t, "l", "line 2" -1740 # setup: screen -1741 var screen-on-stack: screen -1742 var screen/edi: (addr screen) <- address screen-on-stack -1743 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics -1744 # -1745 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor +1697 trace-text t, "l", "line 1" +1698 trace-lower t +1699 trace-text t, "l", "line 1.1" +1700 trace-higher t +1701 trace-text t, "l", "line 2" +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 +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" +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" +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" +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" +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" +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 +1726 edit-trace t, 0x6a/j +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 +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" +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" +1740 } +1741 +1742 fn test-trace-collapse-two-levels { +1743 var t-storage: trace +1744 var t/esi: (addr trace) <- address t-storage +1745 initialize-trace t, 0x100/max-depth, 0x10, 0x10 1746 # -1747 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-two-levels/pre-0" -1748 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-two-levels/pre-0/cursor" -1749 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-two-levels/pre-1" -1750 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-two-levels/pre-1/cursor" -1751 # expand -1752 edit-trace t, 0xa/enter -1753 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1754 # two visible lines with an invisible line in between -1755 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-two-levels/expand-0" -1756 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse-two-levels/expand-0/cursor" -1757 check-screen-row screen, 1/y, "... ", "F - test-trace-collapse-two-levels/expand-1" -1758 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-two-levels/expand-1/cursor" -1759 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-two-levels/expand-2" -1760 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-two-levels/expand-2/cursor" -1761 # cursor down to ellipses -1762 edit-trace t, 0x6a/j -1763 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1764 # expand -1765 edit-trace t, 0xa/enter -1766 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1767 # two visible lines with an invisible line in between -1768 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-two-levels/expand2-0" -1769 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-collapse-two-levels/expand2-0/cursor" -1770 check-screen-row screen, 1/y, "2 line 1.1 ", "F - test-trace-collapse-two-levels/expand2-1" -1771 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "|||||||||| ", "F - test-trace-collapse-two-levels/expand2-1/cursor" -1772 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-two-levels/expand2-2" -1773 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-two-levels/expand2-2/cursor" -1774 # cursor down to second visible line -1775 edit-trace t, 0x6a/j -1776 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1777 # collapse -1778 edit-trace t, 8/backspace -1779 clear-screen screen -1780 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1781 # -1782 check-ints-equal y, 1, "F - test-trace-collapse-two-levels/post-0/y" -1783 var cursor-y/eax: (addr int) <- get t, cursor-y -1784 check-ints-equal *cursor-y, 0, "F - test-trace-collapse-two-levels/post-0/cursor-y" -1785 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-two-levels/post-0" -1786 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-two-levels/post-0/cursor" -1787 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-two-levels/post-1" -1788 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-two-levels/post-1/cursor" -1789 } -1790 -1791 fn test-trace-collapse-nested-level { -1792 var t-storage: trace -1793 var t/esi: (addr trace) <- address t-storage -1794 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1795 # -1796 trace-text t, "l", "line 1" -1797 trace-lower t -1798 trace-text t, "l", "line 1.1" -1799 trace-higher t -1800 trace-text t, "l", "line 2" -1801 trace-lower t -1802 trace-text t, "l", "line 2.1" -1803 trace-text t, "l", "line 2.2" -1804 trace-higher t -1805 # setup: screen -1806 var screen-on-stack: screen -1807 var screen/edi: (addr screen) <- address screen-on-stack -1808 initialize-screen screen, 0x10/width, 8/height, 0/no-pixel-graphics -1809 # -1810 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor -1811 # -1812 check-screen-row screen, 0/y, "... ", "F - test-trace-collapse-nested-level/pre-0" -1813 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-collapse-nested-level/pre-0/cursor" -1814 check-screen-row screen, 1/y, " ", "F - test-trace-collapse-nested-level/pre-1" -1815 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-nested-level/pre-1/cursor" -1816 # expand -1817 edit-trace t, 0xa/enter -1818 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor -1819 # two visible lines with an invisible line in between -1820 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-nested-level/expand-0" -1821 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-collapse-nested-level/expand-0/cursor" -1822 check-screen-row screen, 1/y, "... ", "F - test-trace-collapse-nested-level/expand-1" -1823 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-nested-level/expand-1/cursor" -1824 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-nested-level/expand-2" -1825 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-nested-level/expand-2/cursor" -1826 check-screen-row screen, 3/y, "... ", "F - test-trace-collapse-nested-level/expand-3" -1827 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-collapse-nested-level/expand-3/cursor" -1828 # cursor down to bottom -1829 edit-trace t, 0x6a/j -1830 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor -1831 edit-trace t, 0x6a/j -1832 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor -1833 edit-trace t, 0x6a/j -1834 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor -1835 # expand -1836 edit-trace t, 0xa/enter -1837 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor -1838 # two visible lines with an invisible line in between -1839 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-nested-level/expand2-0" -1840 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-collapse-nested-level/expand2-0/cursor" -1841 check-screen-row screen, 1/y, "... ", "F - test-trace-collapse-nested-level/expand2-1" -1842 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-nested-level/expand2-1/cursor" -1843 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-nested-level/expand2-2" -1844 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-collapse-nested-level/expand2-2/cursor" -1845 check-screen-row screen, 3/y, "2 line 2.1 ", "F - test-trace-collapse-nested-level/expand2-3" -1846 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "|||||||||| ", "F - test-trace-collapse-nested-level/expand2-3/cursor" -1847 check-screen-row screen, 4/y, "2 line 2.2 ", "F - test-trace-collapse-nested-level/expand2-4" -1848 check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, " ", "F - test-trace-collapse-nested-level/expand2-4/cursor" -1849 # collapse -1850 edit-trace t, 8/backspace -1851 clear-screen screen -1852 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor -1853 # -1854 check-ints-equal y, 4, "F - test-trace-collapse-nested-level/post-0/y" -1855 var cursor-y/eax: (addr int) <- get t, cursor-y -1856 check-ints-equal *cursor-y, 2, "F - test-trace-collapse-nested-level/post-0/cursor-y" -1857 check-screen-row screen, 0/y, "1 line 1 ", "F - test-trace-collapse-nested-level/post-0" -1858 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-trace-collapse-nested-level/post-0/cursor" -1859 check-screen-row screen, 1/y, "... ", "F - test-trace-collapse-nested-level/post-1" -1860 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-collapse-nested-level/post-1/cursor" -1861 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-collapse-nested-level/post-2" -1862 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||||||| ", "F - test-trace-collapse-nested-level/post-2/cursor" -1863 check-screen-row screen, 3/y, "... ", "F - test-trace-collapse-nested-level/post-3" -1864 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-collapse-nested-level/post-3/cursor" -1865 } -1866 -1867 fn scroll-down _self: (addr trace) { -1868 var self/esi: (addr trace) <- copy _self -1869 var screen-height-addr/ebx: (addr int) <- get self, screen-height # only available after first render -1870 var lines-to-skip/ebx: int <- copy *screen-height-addr -1871 var top-line-y-addr/eax: (addr int) <- get self, top-line-y -1872 lines-to-skip <- subtract *top-line-y-addr -1873 var already-hiding-lines-storage: boolean -1874 var already-hiding-lines/edx: (addr boolean) <- address already-hiding-lines-storage -1875 var top-line-addr/edi: (addr int) <- get self, top-line-index -1876 var i/eax: int <- copy *top-line-addr -1877 var max-addr/ecx: (addr int) <- get self, first-free -1878 { -1879 # if we run out of trace, return without changing anything -1880 compare i, *max-addr -1881 { -1882 break-if-< -1883 return -1884 } -1885 # if we've skipped enough, break -1886 compare lines-to-skip, 0 -1887 break-if-<= -1888 # -1889 { -1890 var display?/eax: boolean <- count-line? self, i, already-hiding-lines -1891 compare display?, 0/false -1892 break-if-= -1893 lines-to-skip <- decrement -1894 } -1895 i <- increment -1896 loop -1897 } -1898 # update top-line -1899 copy-to *top-line-addr, i -1900 } -1901 -1902 fn scroll-up _self: (addr trace) { -1903 var self/esi: (addr trace) <- copy _self -1904 var screen-height-addr/ebx: (addr int) <- get self, screen-height # only available after first render -1905 var lines-to-skip/ebx: int <- copy *screen-height-addr -1906 var top-line-y-addr/eax: (addr int) <- get self, top-line-y -1907 lines-to-skip <- subtract *top-line-y-addr -1908 var already-hiding-lines-storage: boolean -1909 var already-hiding-lines/edx: (addr boolean) <- address already-hiding-lines-storage -1910 var top-line-addr/ecx: (addr int) <- get self, top-line-index -1911 $scroll-up:loop: { -1912 # if we run out of trace, break -1913 compare *top-line-addr, 0 -1914 break-if-<= -1915 # if we've skipped enough, break -1916 compare lines-to-skip, 0 -1917 break-if-<= -1918 # -1919 var display?/eax: boolean <- count-line? self, *top-line-addr, already-hiding-lines -1920 compare display?, 0/false -1921 { -1922 break-if-= -1923 lines-to-skip <- decrement -1924 } -1925 decrement *top-line-addr -1926 loop -1927 } -1928 } -1929 -1930 # TODO: duplicates logic for counting lines rendered -1931 fn count-line? _self: (addr trace), index: int, _already-hiding-lines?: (addr boolean) -> _/eax: boolean { -1932 var self/esi: (addr trace) <- copy _self -1933 var trace-ah/eax: (addr handle array trace-line) <- get self, data -1934 var trace/eax: (addr array trace-line) <- lookup *trace-ah -1935 var offset/ecx: (offset trace-line) <- compute-offset trace, index -1936 var curr/eax: (addr trace-line) <- index trace, offset -1937 var already-hiding-lines?/ecx: (addr boolean) <- copy _already-hiding-lines? -1938 # count errors -1939 { -1940 var curr-depth/eax: (addr int) <- get curr, depth -1941 compare *curr-depth, 0/error -1942 break-if-!= -1943 copy-to *already-hiding-lines?, 0/false -1944 return 1/true -1945 } -1946 # count visible lines -1947 { -1948 var display?/eax: boolean <- should-render? curr -1949 compare display?, 0/false -1950 break-if-= -1951 copy-to *already-hiding-lines?, 0/false -1952 return 1/true -1953 } -1954 # count first undisplayed line after line to display -1955 compare *already-hiding-lines?, 0/false -1956 { -1957 break-if-!= -1958 copy-to *already-hiding-lines?, 1/true -1959 return 1/true -1960 } -1961 return 0/false -1962 } -1963 -1964 fn test-trace-scroll { -1965 var t-storage: trace -1966 var t/esi: (addr trace) <- address t-storage -1967 initialize-trace t, 0x100/max-depth, 0x10, 0x10 -1968 # -1969 trace-text t, "l", "line 0" -1970 trace-text t, "l", "line 1" -1971 trace-text t, "l", "line 2" -1972 trace-text t, "l", "line 3" -1973 trace-text t, "l", "line 4" -1974 trace-text t, "l", "line 5" -1975 trace-text t, "l", "line 6" -1976 trace-text t, "l", "line 7" -1977 trace-text t, "l", "line 8" -1978 trace-text t, "l", "line 9" -1979 # setup: screen -1980 var screen-on-stack: screen -1981 var screen/edi: (addr screen) <- address screen-on-stack -1982 initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics -1983 # pre-render -1984 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1985 # -1986 check-screen-row screen, 0/y, "... ", "F - test-trace-scroll/pre-0" -1987 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||| ", "F - test-trace-scroll/pre-0/cursor" -1988 check-screen-row screen, 1/y, " ", "F - test-trace-scroll/pre-1" -1989 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/pre-1/cursor" -1990 check-screen-row screen, 2/y, " ", "F - test-trace-scroll/pre-2" -1991 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/pre-2/cursor" -1992 check-screen-row screen, 3/y, " ", "F - test-trace-scroll/pre-3" -1993 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/pre-3/cursor" -1994 # expand -1995 edit-trace t, 0xa/enter -1996 clear-screen screen -1997 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -1998 # -1999 check-screen-row screen, 0/y, "1 line 0 ", "F - test-trace-scroll/expand-0" -2000 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/expand-0/cursor" -2001 check-screen-row screen, 1/y, "1 line 1 ", "F - test-trace-scroll/expand-1" -2002 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/expand-1/cursor" -2003 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-scroll/expand-2" -2004 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/expand-2/cursor" -2005 check-screen-row screen, 3/y, "1 line 3 ", "F - test-trace-scroll/expand-3" -2006 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/expand-3/cursor" -2007 # scroll up -2008 # hack: we must have rendered before this point; we're mixing state management with rendering -2009 edit-trace t, 2/ctrl-b -2010 clear-screen screen -2011 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -2012 # no change since we're already at the top -2013 check-screen-row screen, 0/y, "1 line 0 ", "F - test-trace-scroll/up0-0" -2014 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/up0-0/cursor" -2015 check-screen-row screen, 1/y, "1 line 1 ", "F - test-trace-scroll/up0-1" -2016 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/up0-1/cursor" -2017 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-scroll/up0-2" -2018 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/up0-2/cursor" -2019 check-screen-row screen, 3/y, "1 line 3 ", "F - test-trace-scroll/up0-3" -2020 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/up0-3/cursor" -2021 # scroll down -2022 edit-trace t, 6/ctrl-f -2023 clear-screen screen -2024 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -2025 check-screen-row screen, 0/y, "1 line 4 ", "F - test-trace-scroll/down1-0" -2026 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/down1-0/cursor" -2027 check-screen-row screen, 1/y, "1 line 5 ", "F - test-trace-scroll/down1-1" -2028 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/down1-1/cursor" -2029 check-screen-row screen, 2/y, "1 line 6 ", "F - test-trace-scroll/down1-2" -2030 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/down1-2/cursor" -2031 check-screen-row screen, 3/y, "1 line 7 ", "F - test-trace-scroll/down1-3" -2032 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/down1-3/cursor" +1747 trace-text t, "l", "line 1" +1748 trace-lower t +1749 trace-text t, "l", "line 1.1" +1750 trace-higher t +1751 trace-text t, "l", "line 2" +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 +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" +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" +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" +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" +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" +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 +1776 # expand +1777 edit-trace t, 0xa/enter +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" +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" +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" +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 +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" +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" +1801 } +1802 +1803 fn test-trace-collapse-nested-level { +1804 var t-storage: trace +1805 var t/esi: (addr trace) <- address t-storage +1806 initialize-trace t, 0x100/max-depth, 0x10, 0x10 +1807 # +1808 trace-text t, "l", "line 1" +1809 trace-lower t +1810 trace-text t, "l", "line 1.1" +1811 trace-higher t +1812 trace-text t, "l", "line 2" +1813 trace-lower t +1814 trace-text t, "l", "line 2.1" +1815 trace-text t, "l", "line 2.2" +1816 trace-higher t +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 +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" +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" +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" +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" +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" +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" +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 +1843 edit-trace t, 0x6a/j +1844 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor +1845 edit-trace t, 0x6a/j +1846 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor +1847 # expand +1848 edit-trace t, 0xa/enter +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" +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" +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" +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" +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" +1861 # collapse +1862 edit-trace t, 8/backspace +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" +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" +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" +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" +1877 } +1878 +1879 fn scroll-down _self: (addr trace) { +1880 var self/esi: (addr trace) <- copy _self +1881 var screen-height-addr/ebx: (addr int) <- get self, screen-height # only available after first render +1882 var lines-to-skip/ebx: int <- copy *screen-height-addr +1883 var top-line-y-addr/eax: (addr int) <- get self, top-line-y +1884 lines-to-skip <- subtract *top-line-y-addr +1885 var already-hiding-lines-storage: boolean +1886 var already-hiding-lines/edx: (addr boolean) <- address already-hiding-lines-storage +1887 var top-line-addr/edi: (addr int) <- get self, top-line-index +1888 var i/eax: int <- copy *top-line-addr +1889 var max-addr/ecx: (addr int) <- get self, first-free +1890 { +1891 # if we run out of trace, return without changing anything +1892 compare i, *max-addr +1893 { +1894 break-if-< +1895 return +1896 } +1897 # if we've skipped enough, break +1898 compare lines-to-skip, 0 +1899 break-if-<= +1900 # +1901 { +1902 var display?/eax: boolean <- count-line? self, i, already-hiding-lines +1903 compare display?, 0/false +1904 break-if-= +1905 lines-to-skip <- decrement +1906 } +1907 i <- increment +1908 loop +1909 } +1910 # update top-line +1911 copy-to *top-line-addr, i +1912 } +1913 +1914 fn scroll-up _self: (addr trace) { +1915 var self/esi: (addr trace) <- copy _self +1916 var screen-height-addr/ebx: (addr int) <- get self, screen-height # only available after first render +1917 var lines-to-skip/ebx: int <- copy *screen-height-addr +1918 var top-line-y-addr/eax: (addr int) <- get self, top-line-y +1919 lines-to-skip <- subtract *top-line-y-addr +1920 var already-hiding-lines-storage: boolean +1921 var already-hiding-lines/edx: (addr boolean) <- address already-hiding-lines-storage +1922 var top-line-addr/ecx: (addr int) <- get self, top-line-index +1923 $scroll-up:loop: { +1924 # if we run out of trace, break +1925 compare *top-line-addr, 0 +1926 break-if-<= +1927 # if we've skipped enough, break +1928 compare lines-to-skip, 0 +1929 break-if-<= +1930 # +1931 var display?/eax: boolean <- count-line? self, *top-line-addr, already-hiding-lines +1932 compare display?, 0/false +1933 { +1934 break-if-= +1935 lines-to-skip <- decrement +1936 } +1937 decrement *top-line-addr +1938 loop +1939 } +1940 } +1941 +1942 # TODO: duplicates logic for counting lines rendered +1943 fn count-line? _self: (addr trace), index: int, _already-hiding-lines?: (addr boolean) -> _/eax: boolean { +1944 var self/esi: (addr trace) <- copy _self +1945 var trace-ah/eax: (addr handle array trace-line) <- get self, data +1946 var trace/eax: (addr array trace-line) <- lookup *trace-ah +1947 var offset/ecx: (offset trace-line) <- compute-offset trace, index +1948 var curr/eax: (addr trace-line) <- index trace, offset +1949 var already-hiding-lines?/ecx: (addr boolean) <- copy _already-hiding-lines? +1950 # count errors +1951 { +1952 var curr-depth/eax: (addr int) <- get curr, depth +1953 compare *curr-depth, 0/error +1954 break-if-!= +1955 copy-to *already-hiding-lines?, 0/false +1956 return 1/true +1957 } +1958 # count visible lines +1959 { +1960 var display?/eax: boolean <- should-render? curr +1961 compare display?, 0/false +1962 break-if-= +1963 copy-to *already-hiding-lines?, 0/false +1964 return 1/true +1965 } +1966 # count first undisplayed line after line to display +1967 compare *already-hiding-lines?, 0/false +1968 { +1969 break-if-!= +1970 copy-to *already-hiding-lines?, 1/true +1971 return 1/true +1972 } +1973 return 0/false +1974 } +1975 +1976 fn test-trace-scroll { +1977 var t-storage: trace +1978 var t/esi: (addr trace) <- address t-storage +1979 initialize-trace t, 0x100/max-depth, 0x10, 0x10 +1980 # +1981 trace-text t, "l", "line 0" +1982 trace-text t, "l", "line 1" +1983 trace-text t, "l", "line 2" +1984 trace-text t, "l", "line 3" +1985 trace-text t, "l", "line 4" +1986 trace-text t, "l", "line 5" +1987 trace-text t, "l", "line 6" +1988 trace-text t, "l", "line 7" +1989 trace-text t, "l", "line 8" +1990 trace-text t, "l", "line 9" +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 +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" +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" +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" +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" +2006 # expand +2007 edit-trace t, 0xa/enter +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" +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" +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" +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" +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 +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" +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" +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" +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" 2033 # scroll down -2034 edit-trace t, 6/ctrl-f +2034 edit-trace t, 6/ctrl-f 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 8 ", "F - test-trace-scroll/down2-0" -2038 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/down2-0/cursor" -2039 check-screen-row screen, 1/y, "1 line 9 ", "F - test-trace-scroll/down2-1" -2040 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/down2-1/cursor" -2041 check-screen-row screen, 2/y, " ", "F - test-trace-scroll/down2-2" -2042 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/down2-2/cursor" -2043 check-screen-row screen, 3/y, " ", "F - test-trace-scroll/down2-3" -2044 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/down2-3/cursor" +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" +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" +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" +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" 2045 # scroll down -2046 edit-trace t, 6/ctrl-f +2046 edit-trace t, 6/ctrl-f 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 # no change since we're already at the bottom -2050 check-screen-row screen, 0/y, "1 line 8 ", "F - test-trace-scroll/down3-0" -2051 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/down3-0/cursor" -2052 check-screen-row screen, 1/y, "1 line 9 ", "F - test-trace-scroll/down3-1" -2053 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/down3-1/cursor" -2054 check-screen-row screen, 2/y, " ", "F - test-trace-scroll/down3-2" -2055 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/down3-2/cursor" -2056 check-screen-row screen, 3/y, " ", "F - test-trace-scroll/down3-3" -2057 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/down3-3/cursor" -2058 # scroll up -2059 edit-trace t, 2/ctrl-b -2060 clear-screen screen -2061 var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor -2062 check-screen-row screen, 0/y, "1 line 4 ", "F - test-trace-scroll/up1-0" -2063 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/up1-0/cursor" -2064 check-screen-row screen, 1/y, "1 line 5 ", "F - test-trace-scroll/up1-1" -2065 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/up1-1/cursor" -2066 check-screen-row screen, 2/y, "1 line 6 ", "F - test-trace-scroll/up1-2" -2067 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/up1-2/cursor" -2068 check-screen-row screen, 3/y, "1 line 7 ", "F - test-trace-scroll/up1-3" -2069 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/up1-3/cursor" +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" +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" +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" +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" +2057 # scroll down +2058 edit-trace t, 6/ctrl-f +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" +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" +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" +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" 2070 # scroll up -2071 edit-trace t, 2/ctrl-b +2071 edit-trace t, 2/ctrl-b 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 0 ", "F - test-trace-scroll/up2-0" -2075 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-scroll/up2-0/cursor" -2076 check-screen-row screen, 1/y, "1 line 1 ", "F - test-trace-scroll/up2-1" -2077 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-trace-scroll/up2-1/cursor" -2078 check-screen-row screen, 2/y, "1 line 2 ", "F - test-trace-scroll/up2-2" -2079 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-trace-scroll/up2-2/cursor" -2080 check-screen-row screen, 3/y, "1 line 3 ", "F - test-trace-scroll/up2-3" -2081 check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, " ", "F - test-trace-scroll/up2-3/cursor" -2082 } +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" +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" +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" +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" +2082 # scroll up +2083 edit-trace t, 2/ctrl-b +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" +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" +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" +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" +2094 } +2095 +2096 # saving and restoring trace indices +2097 +2098 fn save-indices _self: (addr trace), _out: (addr trace-index-stash) { +2099 var self/esi: (addr trace) <- copy _self +2100 var out/edi: (addr trace-index-stash) <- copy _out +2101 var data-ah/eax: (addr handle array trace-line) <- get self, data +2102 var _data/eax: (addr array trace-line) <- lookup *data-ah +2103 var data/ebx: (addr array trace-line) <- copy _data +2104 # cursor +2105 var cursor-line-index-addr/eax: (addr int) <- get self, cursor-line-index +2106 var cursor-line-index/eax: int <- copy *cursor-line-index-addr +2107 #? draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, cursor-line-index, 2/fg 0/bg +2108 var offset/eax: (offset trace-line) <- compute-offset data, cursor-line-index +2109 var cursor-line/ecx: (addr trace-line) <- index data, offset +2110 var src/eax: (addr int) <- get cursor-line, depth +2111 var dest/edx: (addr int) <- get out, cursor-line-depth +2112 copy-object src, dest +2113 var src/eax: (addr handle array byte) <- get cursor-line, label +2114 var dest/edx: (addr handle array byte) <- get out, cursor-line-label +2115 copy-object src, dest +2116 src <- get cursor-line, data +2117 #? { +2118 #? var foo/eax: (addr array byte) <- lookup *src +2119 #? draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, foo, 7/fg 0/bg +2120 #? var cursor-line-visible-addr/eax: (addr boolean) <- get cursor-line, visible? +2121 #? var cursor-line-visible?/eax: boolean <- copy *cursor-line-visible-addr +2122 #? var foo/eax: int <- copy cursor-line-visible? +2123 #? draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, foo, 5/fg 0/bg +2124 #? } +2125 dest <- get out, cursor-line-data +2126 copy-object src, dest +2127 # top of screen +2128 var top-line-index-addr/eax: (addr int) <- get self, top-line-index +2129 var top-line-index/eax: int <- copy *top-line-index-addr +2130 #? draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, top-line-index, 2/fg 0/bg +2131 var offset/eax: (offset trace-line) <- compute-offset data, top-line-index +2132 var top-line/ecx: (addr trace-line) <- index data, offset +2133 var src/eax: (addr int) <- get top-line, depth +2134 var dest/edx: (addr int) <- get out, top-line-depth +2135 copy-object src, dest +2136 var src/eax: (addr handle array byte) <- get top-line, label +2137 var dest/edx: (addr handle array byte) <- get out, top-line-label +2138 copy-object src, dest +2139 src <- get top-line, data +2140 dest <- get out, top-line-data +2141 copy-object src, dest +2142 } +2143 +2144 fn restore-indices _self: (addr trace), _in: (addr trace-index-stash) { +2145 var self/edi: (addr trace) <- copy _self +2146 var in/esi: (addr trace-index-stash) <- copy _in +2147 var data-ah/eax: (addr handle array trace-line) <- get self, data +2148 var _data/eax: (addr array trace-line) <- lookup *data-ah +2149 var data/ebx: (addr array trace-line) <- copy _data +2150 # cursor +2151 var cursor-depth/edx: (addr int) <- get in, cursor-line-depth +2152 var cursor-line-label-ah/eax: (addr handle array byte) <- get in, cursor-line-label +2153 var _cursor-line-label/eax: (addr array byte) <- lookup *cursor-line-label-ah +2154 var cursor-line-label/ecx: (addr array byte) <- copy _cursor-line-label +2155 var cursor-line-data-ah/eax: (addr handle array byte) <- get in, cursor-line-data +2156 var cursor-line-data/eax: (addr array byte) <- lookup *cursor-line-data-ah +2157 var new-cursor-line-index/eax: int <- find-in-trace self, *cursor-depth, cursor-line-label, cursor-line-data +2158 var dest/edx: (addr int) <- get self, cursor-line-index +2159 copy-to *dest, new-cursor-line-index +2160 # top of screen +2161 var top-depth/edx: (addr int) <- get in, top-line-depth +2162 var top-line-label-ah/eax: (addr handle array byte) <- get in, top-line-label +2163 var _top-line-label/eax: (addr array byte) <- lookup *top-line-label-ah +2164 var top-line-label/ecx: (addr array byte) <- copy _top-line-label +2165 var top-line-data-ah/eax: (addr handle array byte) <- get in, top-line-data +2166 var top-line-data/eax: (addr array byte) <- lookup *top-line-data-ah +2167 var new-top-line-index/eax: int <- find-in-trace self, *top-depth, top-line-label, top-line-data +2168 var dest/edx: (addr int) <- get self, top-line-index +2169 copy-to *dest, new-top-line-index +2170 } +2171 +2172 # like trace-contains? but stateless +2173 # this is super-inefficient, string comparing every trace line +2174 fn find-in-trace _self: (addr trace), depth: int, label: (addr array byte), data: (addr array byte) -> _/eax: int { +2175 var self/esi: (addr trace) <- copy _self +2176 var candidates-ah/eax: (addr handle array trace-line) <- get self, data +2177 var candidates/eax: (addr array trace-line) <- lookup *candidates-ah +2178 var i/ecx: int <- copy 0 +2179 var max/edx: (addr int) <- get self, first-free +2180 { +2181 compare i, *max +2182 break-if->= +2183 { +2184 var curr-offset/edx: (offset trace-line) <- compute-offset candidates, i +2185 var curr/edx: (addr trace-line) <- index candidates, curr-offset +2186 # if curr->depth does not match, continue +2187 var curr-depth-addr/eax: (addr int) <- get curr, depth +2188 var curr-depth/eax: int <- copy *curr-depth-addr +2189 compare curr-depth, depth +2190 break-if-!= +2191 # if curr->label does not match, continue +2192 var curr-label-ah/eax: (addr handle array byte) <- get curr, label +2193 var curr-label/eax: (addr array byte) <- lookup *curr-label-ah +2194 var match?/eax: boolean <- string-equal? curr-label, label +2195 compare match?, 0/false +2196 break-if-= +2197 # if curr->data does not match, continue +2198 var curr-data-ah/eax: (addr handle array byte) <- get curr, data +2199 var curr-data/eax: (addr array byte) <- lookup *curr-data-ah +2200 { +2201 var match?/eax: boolean <- string-equal? curr-data, data +2202 compare match?, 0/false +2203 } +2204 break-if-= +2205 #? draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " => ", 7/fg 0/bg +2206 #? #? draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, i, 4/fg 0/bg +2207 #? draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, curr-data, 7/fg 0/bg +2208 #? var curr-visible-addr/eax: (addr boolean) <- get curr, visible? +2209 #? var curr-visible?/eax: boolean <- copy *curr-visible-addr +2210 #? var foo/eax: int <- copy curr-visible? +2211 #? draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, foo, 2/fg 0/bg +2212 return i +2213 } +2214 i <- increment +2215 loop +2216 } +2217 abort "not in trace" +2218 return -1 +2219 }