From 82171a0fdfa28251cbc360dcf205392fee2c7eeb Mon Sep 17 00:00:00 2001 From: Kartik Agaram Date: Mon, 31 May 2021 10:47:05 -0700 Subject: [PATCH] . --- html/101screen.subx.html | 2 +- html/103grapheme.subx.html | 2 +- html/108write.subx.html | 266 +- html/113write-stream.subx.html | 2 +- html/120allocate.subx.html | 46 +- html/123slice.subx.html | 2 +- html/309stream.subx.html | 4 +- html/313index-bounds-check.subx.html | 24 +- html/315stack-debug.subx.html | 16 +- html/317abort.subx.html | 30 +- html/318counter.subx.html | 92 + html/400.mu.html | 141 +- html/500fake-screen.mu.html | 875 +++--- html/501draw-text.mu.html | 701 ++--- html/502test.mu.html | 12 +- html/504test-screen.mu.html | 164 +- html/507line.mu.html | 6 +- html/508circle.mu.html | 8 +- html/509bezier.mu.html | 2 +- html/boot.subx.html | 1262 ++++----- html/colors.mu.html | 14 +- html/ex10.mu.html | 8 +- html/ex11.mu.html | 2 +- html/ex2.mu.html | 2 +- html/ex6.mu.html | 18 +- html/ex7.mu.html | 4 +- html/ex9.mu.html | 4 +- html/hest-life.mu.html | 40 +- html/mandelbrot-fixed.mu.html | 2 +- html/mandelbrot.mu.html | 2 +- html/mu-init.subx.html | 4 +- html/rpn.mu.html | 4 +- html/shell/cell.mu.html | 2 +- html/shell/evaluate.mu.html | 3381 ++++++++++++----------- html/shell/gap-buffer.mu.html | 2 +- html/shell/global.mu.html | 322 +-- html/shell/grapheme-stack.mu.html | 6 +- html/shell/macroexpand.mu.html | 867 +++--- html/shell/main.mu.html | 217 +- html/shell/parse.mu.html | 517 ++-- html/shell/print.mu.html | 990 ++++--- html/shell/read.mu.html | 32 +- html/shell/sandbox.mu.html | 1978 +++++++------- html/shell/tokenize.mu.html | 1863 ++++++------- html/shell/trace.mu.html | 3692 ++++++++++++++------------ 45 files changed, 9504 insertions(+), 8126 deletions(-) create mode 100644 html/318counter.subx.html diff --git a/html/101screen.subx.html b/html/101screen.subx.html index 4ce0397a..27e5514b 100644 --- a/html/101screen.subx.html +++ b/html/101screen.subx.html @@ -85,7 +85,7 @@ if ('onhashchange' in window) { 28 c1/shift 4/subop/left %eax 0xa/imm8 29 03/add-> *(ebp+8) 0/r32/eax 30 # eax += location of frame buffer -31 03/add-> *Video-memory-addr 0/r32/eax +31 03/add-> *Video-memory-addr 0/r32/eax 32 # *eax = color 33 8b/-> *(ebp+0x10) 1/r32/ecx 34 88/byte<- *eax 1/r32/CL diff --git a/html/103grapheme.subx.html b/html/103grapheme.subx.html index fdbf0e99..42c4f598 100644 --- a/html/103grapheme.subx.html +++ b/html/103grapheme.subx.html @@ -84,7 +84,7 @@ if ('onhashchange' in window) { 27 # var letter-bitmap/esi = font[g] 28 8b/-> *(ebp+8) 6/r32/esi 29 c1 4/subop/shift-left %esi 4/imm8 - 30 81 0/subop/add %esi Font/imm32 + 30 81 0/subop/add %esi Font/imm32 31 # if (letter-bitmap >= 0x9400) return # characters beyond ASCII currently not supported 32 81 7/subop/compare %esi 0x9400/imm32 33 7d/jump-if->= $draw-grapheme-on-real-screen:end/disp8 diff --git a/html/108write.subx.html b/html/108write.subx.html index 7f5a6178..763f35bf 100644 --- a/html/108write.subx.html +++ b/html/108write.subx.html @@ -96,7 +96,7 @@ if ('onhashchange' in window) { 36 8d/copy-address 1/mod/*+disp8 4/rm32/sib 1/base/ecx 2/index/edx . 3/r32/ebx 0xc/disp8 . # copy ecx+edx+12 to ebx 37 53/push-ebx 38 # . . call - 39 e8/call _append-3/disp32 + 39 e8/call _append-3/disp32 40 # . . discard args 41 81 0/subop/add 3/mod/direct 4/rm32/esp . . . . . 0xc/imm32 # add to esp 42 # f->write += eax @@ -195,95 +195,181 @@ if ('onhashchange' in window) { 135 136 == code 137 -138 # 3-argument variant of _append -139 _append-3: # out: (addr byte), outend: (addr byte), s: (addr array byte) -> num_bytes_appended/eax -140 # . prologue -141 55/push-ebp -142 89/copy 3/mod/direct 5/rm32/ebp . . . 4/r32/esp . . # copy esp to ebp -143 # . save registers -144 51/push-ecx -145 # eax = _append-4(out, outend, &s->data[0], &s->data[s->size]) -146 # . . push &s->data[s->size] -147 8b/copy 1/mod/*+disp8 5/rm32/ebp . . 0/r32/eax 0x10/disp8 . # copy *(ebp+16) to eax -148 8b/copy 0/mod/indirect 0/rm32/eax . . . 1/r32/ecx . . # copy *eax to ecx -149 8d/copy-address 1/mod/*+disp8 4/rm32/sib 0/base/eax 1/index/ecx . 1/r32/ecx 4/disp8 . # copy eax+ecx+4 to ecx -150 51/push-ecx -151 # . . push &s->data[0] -152 8d/copy-address 1/mod/*+disp8 0/rm32/eax . . . 1/r32/ecx 4/disp8 . # copy eax+4 to ecx -153 51/push-ecx -154 # . . push outend -155 ff 6/subop/push 1/mod/*+disp8 5/rm32/ebp . . . . 0xc/disp8 . # push *(ebp+12) -156 # . . push out -157 ff 6/subop/push 1/mod/*+disp8 5/rm32/ebp . . . . 8/disp8 . # push *(ebp+8) -158 # . . call -159 e8/call _append-4/disp32 -160 # . . discard args -161 81 0/subop/add 3/mod/direct 4/rm32/esp . . . . . 0x10/imm32 # add to esp -162 $_append-3:end: -163 # . restore registers -164 59/pop-to-ecx -165 # . epilogue -166 89/copy 3/mod/direct 4/rm32/esp . . . 5/r32/ebp . . # copy ebp to esp -167 5d/pop-to-ebp -168 c3/return -169 -170 # 4-argument variant of _append -171 _append-4: # out: (addr byte), outend: (addr byte), in: (addr byte), inend: (addr byte) -> num_bytes_appended/eax: int -172 # . prologue -173 55/push-ebp -174 89/copy 3/mod/direct 5/rm32/ebp . . . 4/r32/esp . . # copy esp to ebp -175 # . save registers -176 51/push-ecx -177 52/push-edx -178 53/push-ebx -179 56/push-esi -180 57/push-edi -181 # num_bytes_appended = 0 -182 b8/copy-to-eax 0/imm32 -183 # edi = out -184 8b/copy 1/mod/*+disp8 5/rm32/ebp . . . 7/r32/edi 8/disp8 . # copy *(ebp+8) to edi -185 # edx = outend -186 8b/copy 1/mod/*+disp8 5/rm32/ebp . . . 2/r32/edx 0xc/disp8 . # copy *(ebp+12) to edx -187 # esi = in -188 8b/copy 1/mod/*+disp8 5/rm32/ebp . . . 6/r32/esi 0x10/disp8 . # copy *(ebp+16) to esi -189 # ecx = inend -190 8b/copy 1/mod/*+disp8 5/rm32/ebp . . . 1/r32/ecx 0x14/disp8 . # copy *(ebp+20) to ecx -191 $_append-4:loop: -192 # if (in >= inend) break -193 39/compare 3/mod/direct 6/rm32/esi . . . 1/r32/ecx . . # compare esi with ecx -194 73/jump-if-addr>= $_append-4:end/disp8 -195 # if (out >= outend) abort # just to catch test failures fast -196 39/compare 3/mod/direct 7/rm32/edi . . . 2/r32/edx . . # compare edi with edx -197 0f 83/jump-if-addr>= $_append-4:abort/disp32 -198 # *out = *in -199 8a/copy-byte 0/mod/indirect 6/rm32/esi . . . 3/r32/BL . . # copy byte at *esi to BL -200 88/copy-byte 0/mod/indirect 7/rm32/edi . . . 3/r32/BL . . # copy byte at BL to *edi -201 # ++num_bytes_appended -202 40/increment-eax -203 # ++in -204 46/increment-esi -205 # ++out -206 47/increment-edi -207 eb/jump $_append-4:loop/disp8 -208 $_append-4:end: -209 # . restore registers -210 5f/pop-to-edi -211 5e/pop-to-esi -212 5b/pop-to-ebx -213 5a/pop-to-edx -214 59/pop-to-ecx -215 # . epilogue -216 89/copy 3/mod/direct 4/rm32/esp . . . 5/r32/ebp . . # copy ebp to esp -217 5d/pop-to-ebp -218 c3/return -219 -220 $_append-4:abort: -221 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "_append-4: stream full at " 3 0) # 3=cyan -222 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 %eax 3 0) -223 (abort "") -224 # never gets here -225 -226 # . . vim:nowrap:textwidth=0 +138 try-write: # f: (addr stream byte), s: (addr array byte) -> overflow?/eax: boolean +139 # . prologue +140 55/push-ebp +141 89/copy 3/mod/direct 5/rm32/ebp . . . 4/r32/esp . . # copy esp to ebp +142 # if (s == 0) return +143 81 7/subop/compare 1/mod/*+disp8 5/rm32/ebp . . . . 0xc/disp8 0/imm32 # compare *(ebp+12) +144 74/jump-if-= $write:end/disp8 +145 # . save registers +146 51/push-ecx +147 # if (f->size - f->write < s->size) return +148 # . eax = f->size - f->write - s->size +149 8b/copy 1/mod/*+disp8 5/rm32/ebp . . 1/r32/ecx 8/disp8 . # copy *(ebp+8) to ecx +150 8b/copy 1/mod/*+disp8 1/rm32/ecx . . . 0/r32/eax 8/disp8 . # copy *(ecx+8) to eax +151 2b/subtract 0/mod/indirect 1/rm32/ecx . . . 0/r32/eax . . # subtract *ecx from eax +152 8b/copy 1/mod/*+disp8 5/rm32/ebp . . 1/r32/ecx 0xc/disp8 . # copy *(ebp+12) to ecx +153 2b/subtract 0/mod/indirect 1/rm32/ecx . . . 0/r32/eax . . # subtract *ecx from eax +154 # . if (eax < 0) return +155 3d/compare-eax-and 0/imm32 +156 7c/jump-if-< $try-write:end/disp8 +157 # write(f, s) +158 # . . push args +159 ff 6/subop/push 1/mod/*+disp8 5/rm32/ebp . . . . 0xc/disp8 . # push *(ebp+12) +160 ff 6/subop/push 1/mod/*+disp8 5/rm32/ebp . . . . 8/disp8 . # push *(ebp+8) +161 # . . call +162 e8/call write/disp32 +163 # . . discard args +164 81 0/subop/add 3/mod/direct 4/rm32/esp . . . . . 8/imm32 # add to esp +165 # . restore registers +166 59/pop-to-ecx +167 # return 0 +168 b8/copy-to-eax 0/imm32 +169 $try-write:end: +170 # . epilogue +171 89/copy 3/mod/direct 4/rm32/esp . . . 5/r32/ebp . . # copy ebp to esp +172 5d/pop-to-ebp +173 c3/return +174 +175 # probably a bad idea +176 space-remaining-in-stream: # f: (addr stream byte) -> n/eax: int +177 # . prologue +178 55/push-ebp +179 89/copy 3/mod/direct 5/rm32/ebp . . . 4/r32/esp . . # copy esp to ebp +180 # . save registers +181 51/push-ecx +182 # return f->size - f->write +183 8b/copy 1/mod/*+disp8 5/rm32/ebp . . 1/r32/ecx 8/disp8 . # copy *(ebp+8) to ecx +184 8b/copy 1/mod/*+disp8 1/rm32/ecx . . . 0/r32/eax 8/disp8 . # copy *(ecx+8) to eax +185 2b/subtract 0/mod/indirect 1/rm32/ecx . . . 0/r32/eax . . # subtract *ecx from eax +186 # . restore registers +187 59/pop-to-ecx +188 $space-remaining-in-stream:end: +189 # . epilogue +190 89/copy 3/mod/direct 4/rm32/esp . . . 5/r32/ebp . . # copy ebp to esp +191 5d/pop-to-ebp +192 c3/return +193 +194 stream-size: # f: (addr stream byte) -> n/eax: int +195 # . prologue +196 55/push-ebp +197 89/copy 3/mod/direct 5/rm32/ebp . . . 4/r32/esp . . # copy esp to ebp +198 # . save registers +199 51/push-ecx +200 # return f->write +201 8b/copy 1/mod/*+disp8 5/rm32/ebp . . 1/r32/ecx 8/disp8 . # copy *(ebp+8) to ecx +202 8b/copy 0/mod/indirect 1/rm32/ecx . . . 0/r32/eax . . # copy *ecx to eax +203 # . restore registers +204 59/pop-to-ecx +205 $space-remaining-in-stream:end: +206 # . epilogue +207 89/copy 3/mod/direct 4/rm32/esp . . . 5/r32/ebp . . # copy ebp to esp +208 5d/pop-to-ebp +209 c3/return +210 +211 # 3-argument variant of _append +212 _append-3: # out: (addr byte), outend: (addr byte), s: (addr array byte) -> num_bytes_appended/eax +213 # . prologue +214 55/push-ebp +215 89/copy 3/mod/direct 5/rm32/ebp . . . 4/r32/esp . . # copy esp to ebp +216 # . save registers +217 51/push-ecx +218 # if (outend - out < s->size) abort +219 # . eax = f->size - f->write - s->size +220 8b/copy 1/mod/*+disp8 5/rm32/ebp . . 0/r32/eax 0xc/disp8 . # copy *(ebp+12) to eax +221 2b/subtract 1/mod/*+disp8 5/rm32/ebp . . . 0/r32/eax 8/disp8 . # subtract *(ebp+8) from eax +222 8b/copy 1/mod/*+disp8 5/rm32/ebp . . 1/r32/ecx 0x10/disp8 . # copy *(ebp+16) to ecx +223 2b/subtract 0/mod/indirect 1/rm32/ecx . . . 0/r32/eax . . # subtract *ecx from eax +224 # . if (eax < 0) abort +225 3d/compare-eax-and 0/imm32 +226 7c/jump-if-< $_append-3:abort/disp8 +227 # eax = _append-4(out, outend, &s->data[0], &s->data[s->size]) +228 # . . push &s->data[s->size] +229 8b/copy 1/mod/*+disp8 5/rm32/ebp . . 0/r32/eax 0x10/disp8 . # copy *(ebp+16) to eax +230 8b/copy 0/mod/indirect 0/rm32/eax . . . 1/r32/ecx . . # copy *eax to ecx +231 8d/copy-address 1/mod/*+disp8 4/rm32/sib 0/base/eax 1/index/ecx . 1/r32/ecx 4/disp8 . # copy eax+ecx+4 to ecx +232 51/push-ecx +233 # . . push &s->data[0] +234 8d/copy-address 1/mod/*+disp8 0/rm32/eax . . . 1/r32/ecx 4/disp8 . # copy eax+4 to ecx +235 51/push-ecx +236 # . . push outend +237 ff 6/subop/push 1/mod/*+disp8 5/rm32/ebp . . . . 0xc/disp8 . # push *(ebp+12) +238 # . . push out +239 ff 6/subop/push 1/mod/*+disp8 5/rm32/ebp . . . . 8/disp8 . # push *(ebp+8) +240 # . . call +241 e8/call _append-4/disp32 +242 # . . discard args +243 81 0/subop/add 3/mod/direct 4/rm32/esp . . . . . 0x10/imm32 # add to esp +244 $_append-3:end: +245 # . restore registers +246 59/pop-to-ecx +247 # . epilogue +248 89/copy 3/mod/direct 4/rm32/esp . . . 5/r32/ebp . . # copy ebp to esp +249 5d/pop-to-ebp +250 c3/return +251 +252 $_append-3:abort: +253 (abort "_append-3 about to overflow") # 3=cyan +254 # never gets here +255 +256 # 4-argument variant of _append +257 _append-4: # out: (addr byte), outend: (addr byte), in: (addr byte), inend: (addr byte) -> num_bytes_appended/eax: int +258 # . prologue +259 55/push-ebp +260 89/copy 3/mod/direct 5/rm32/ebp . . . 4/r32/esp . . # copy esp to ebp +261 # . save registers +262 51/push-ecx +263 52/push-edx +264 53/push-ebx +265 56/push-esi +266 57/push-edi +267 # num_bytes_appended = 0 +268 b8/copy-to-eax 0/imm32 +269 # edi = out +270 8b/copy 1/mod/*+disp8 5/rm32/ebp . . . 7/r32/edi 8/disp8 . # copy *(ebp+8) to edi +271 # edx = outend +272 8b/copy 1/mod/*+disp8 5/rm32/ebp . . . 2/r32/edx 0xc/disp8 . # copy *(ebp+12) to edx +273 # esi = in +274 8b/copy 1/mod/*+disp8 5/rm32/ebp . . . 6/r32/esi 0x10/disp8 . # copy *(ebp+16) to esi +275 # ecx = inend +276 8b/copy 1/mod/*+disp8 5/rm32/ebp . . . 1/r32/ecx 0x14/disp8 . # copy *(ebp+20) to ecx +277 $_append-4:loop: +278 # if (in >= inend) break +279 39/compare 3/mod/direct 6/rm32/esi . . . 1/r32/ecx . . # compare esi with ecx +280 73/jump-if-addr>= $_append-4:end/disp8 +281 # if (out >= outend) abort # just to catch test failures fast +282 39/compare 3/mod/direct 7/rm32/edi . . . 2/r32/edx . . # compare edi with edx +283 0f 83/jump-if-addr>= $_append-4:abort/disp32 +284 # *out = *in +285 8a/copy-byte 0/mod/indirect 6/rm32/esi . . . 3/r32/BL . . # copy byte at *esi to BL +286 88/copy-byte 0/mod/indirect 7/rm32/edi . . . 3/r32/BL . . # copy byte at BL to *edi +287 # ++num_bytes_appended +288 40/increment-eax +289 # ++in +290 46/increment-esi +291 # ++out +292 47/increment-edi +293 eb/jump $_append-4:loop/disp8 +294 $_append-4:end: +295 # . restore registers +296 5f/pop-to-edi +297 5e/pop-to-esi +298 5b/pop-to-ebx +299 5a/pop-to-edx +300 59/pop-to-ecx +301 # . epilogue +302 89/copy 3/mod/direct 4/rm32/esp . . . 5/r32/ebp . . # copy ebp to esp +303 5d/pop-to-ebp +304 c3/return +305 +306 $_append-4:abort: +307 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "_append-4: stream full at " 3 0) # 3=cyan +308 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 %eax 3 0) +309 (abort "") +310 # never gets here +311 +312 # . . vim:nowrap:textwidth=0 diff --git a/html/113write-stream.subx.html b/html/113write-stream.subx.html index 0a221564..86372daf 100644 --- a/html/113write-stream.subx.html +++ b/html/113write-stream.subx.html @@ -95,7 +95,7 @@ if ('onhashchange' in window) { 35 8d/copy-address 1/mod/*+disp8 4/rm32/sib 7/base/edi 0/index/eax . 0/r32/eax 0xc/disp8 . # copy edi+eax+12 to eax 36 50/push-eax 37 # . . call - 38 e8/call _append-4/disp32 + 38 e8/call _append-4/disp32 39 # . . discard args 40 81 0/subop/add 3/mod/direct 4/rm32/esp . . . . . 0x10/imm32 # add to esp 41 # f->write += eax diff --git a/html/120allocate.subx.html b/html/120allocate.subx.html index e5b5d820..023ba795 100644 --- a/html/120allocate.subx.html +++ b/html/120allocate.subx.html @@ -310,36 +310,36 @@ if ('onhashchange' in window) { 249 c3/return 250 251 $lookup:abort: -252 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "lookup failed: (" 3 0) # 3=cyan -253 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+8) 3 0) -254 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 ", " 3 0) -255 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0xc) 3 0) -256 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 ") -> " 3 0) -257 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) -258 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 ". Contents of a few words starting from address 0: " 3 0) +252 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "lookup failed: (" 3 0) # 3=cyan +253 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+8) 3 0) +254 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 ", " 3 0) +255 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0xc) 3 0) +256 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 ") -> " 3 0) +257 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) +258 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 ". Contents of a few words starting from address 0: " 3 0) 259 b8/copy-to-eax 0/imm32 -260 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 2 0) -261 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) +260 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 2 0) +261 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) 262 40/increment-eax -263 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) -264 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) +263 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) +264 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) 265 40/increment-eax -266 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) -267 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) +266 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) +267 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) 268 40/increment-eax -269 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) -270 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) +269 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) +270 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) 271 40/increment-eax -272 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) -273 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) +272 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) +273 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) 274 40/increment-eax -275 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) -276 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) +275 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) +276 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) 277 40/increment-eax -278 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) -279 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) +278 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) +279 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 2 0) 280 40/increment-eax -281 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) +281 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *eax 3 0) 282 (abort "\n") 283 # never gets here 284 @@ -790,7 +790,7 @@ if ('onhashchange' in window) { 729 # . . push payload 730 50/push-eax 731 # . . call -732 e8/call _append-4/disp32 +732 e8/call _append-4/disp32 733 # . . discard args 734 81 0/subop/add 3/mod/direct 4/rm32/esp . . . . . 0x10/imm32 # add to esp 735 $copy-array:end: diff --git a/html/123slice.subx.html b/html/123slice.subx.html index 8257f816..b2e641b4 100644 --- a/html/123slice.subx.html +++ b/html/123slice.subx.html @@ -1010,7 +1010,7 @@ if ('onhashchange' in window) { 949 81 0/subop/add 3/mod/direct 0/rm32/eax . . . . . 4/imm32 # add to eax 950 50/push-eax 951 # . . call - 952 e8/call _append-4/disp32 + 952 e8/call _append-4/disp32 953 # . . discard args 954 81 0/subop/add 3/mod/direct 4/rm32/esp . . . . . 0x10/imm32 # add to esp 955 # restore out (assumes _append-4 can't error) diff --git a/html/309stream.subx.html b/html/309stream.subx.html index 07fd0681..8cb9f603 100644 --- a/html/309stream.subx.html +++ b/html/309stream.subx.html @@ -137,7 +137,7 @@ if ('onhashchange' in window) { 81 8b/-> *(ebp+0x10) 1/r32/ecx 82 8d/copy-address *(eax+ecx) 1/r32/ecx 83 # - 84 (_append-4 %edx %ebx %eax %ecx) # => eax + 84 (_append-4 %edx %ebx %eax %ecx) # => eax 85 # s->write += n 86 8b/-> *(ebp+0x10) 1/r32/ecx 87 01/add-to *edi 1/r32/ecx @@ -187,7 +187,7 @@ if ('onhashchange' in window) { 131 8b/-> *(ebp+0x10) 1/r32/ecx 132 8d/copy-address *(eax+ecx) 1/r32/ecx 133 # -134 (_append-4 %eax %ecx %edx %ebx) # => eax +134 (_append-4 %eax %ecx %edx %ebx) # => eax 135 # s->read += n 136 8b/-> *(ebp+0x10) 1/r32/ecx 137 01/add-to *(esi+4) 1/r32/ecx diff --git a/html/313index-bounds-check.subx.html b/html/313index-bounds-check.subx.html index 9b7c3592..72ce05db 100644 --- a/html/313index-bounds-check.subx.html +++ b/html/313index-bounds-check.subx.html @@ -82,13 +82,13 @@ if ('onhashchange' in window) { 26 39/compare %eax 1/r32/ecx 27 0f 82/jump-if-unsigned< $__check-mu-array-bounds:end/disp32 # negative index should always abort 28 # abort if necessary -29 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "fn " 3 0) # 3=cyan -30 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0x14) 3 0) # 3=cyan -31 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 ": offset " 3 0) # 3=cyan -32 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 %eax 3 0) # 3=cyan -33 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " is too large for array '" 3 0) # 3=cyan -34 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0x18) 3 0) # 3=cyan -35 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "'" 3 0) # 3=cyan +29 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "fn " 3 0) # 3=cyan +30 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0x14) 3 0) # 3=cyan +31 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 ": offset " 3 0) # 3=cyan +32 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 %eax 3 0) # 3=cyan +33 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " is too large for array '" 3 0) # 3=cyan +34 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0x18) 3 0) # 3=cyan +35 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "'" 3 0) # 3=cyan 36 (abort "") 37 # never gets here 38 $__check-mu-array-bounds:end: @@ -102,11 +102,11 @@ if ('onhashchange' in window) { 46 c3/return 47 48 __check-mu-array-bounds:overflow: -49 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "fn " 3 0) # 3=cyan -50 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0x14) 3 0) # 3=cyan -51 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 ": offset to array '" 3 0) # 3=cyan -52 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0x18) 3 0) # 3=cyan -53 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "' overflowed 32 bits" 3 0) # 3=cyan +49 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "fn " 3 0) # 3=cyan +50 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0x14) 3 0) # 3=cyan +51 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 ": offset to array '" 3 0) # 3=cyan +52 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0x18) 3 0) # 3=cyan +53 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "' overflowed 32 bits" 3 0) # 3=cyan 54 (abort "") 55 # never gets here 56 diff --git a/html/315stack-debug.subx.html b/html/315stack-debug.subx.html index bd9d5e3f..edb1b99e 100644 --- a/html/315stack-debug.subx.html +++ b/html/315stack-debug.subx.html @@ -92,12 +92,12 @@ if ('onhashchange' in window) { 34 # 35 89/<- %edx 4/r32/esp 36 # save old cursor position - 37 (cursor-position 0) # => eax, ecx + 37 (cursor-position 0) # => eax, ecx 38 # print at top-right - 39 (set-cursor-position 0 0x70 0) - 40 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 %edx 0xf 0xc) + 39 (set-cursor-position 0 0x70 0) + 40 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 %edx 0xf 0xc) 41 # restore cursor position - 42 (set-cursor-position %eax %ecx) + 42 (set-cursor-position %eax %ecx) 43 $show-stack-state:end: 44 # . restore registers 45 5a/pop-to-edx @@ -122,13 +122,13 @@ if ('onhashchange' in window) { 64 { 65 81 7/subop/compare *Really-debug-print 0/imm32/false 66 74/jump-if-= break/disp8 - 67 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+8) *(ebp+0xc) *(ebp+0x10)) + 67 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+8) *(ebp+0xc) *(ebp+0x10)) 68 # clear the screen and continue if we got too close to the bottom - 69 (cursor-position 0) # => eax, ecx + 69 (cursor-position 0) # => eax, ecx 70 81 7/subop/compare %ecx 0x28/imm32 71 75/jump-if-!= break/disp8 - 72 (clear-screen 0) - 73 (set-cursor-position 0 0 0) + 72 (clear-screen 0) + 73 (set-cursor-position 0 0 0) 74 } 75 $debug-print:end: 76 # . restore registers diff --git a/html/317abort.subx.html b/html/317abort.subx.html index f53236b1..ddc1b979 100644 --- a/html/317abort.subx.html +++ b/html/317abort.subx.html @@ -66,7 +66,7 @@ if ('onhashchange' in window) { 8 89/<- %ebp 4/r32/esp 9 # 10 (set-cursor-position-on-real-screen 0 0) - 11 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+8) 0xf 0xc) # 0/real-screen, 0xf/fg=white, 0xc/bg=red + 11 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+8) 0xf 0xc) # 0/real-screen, 0xf/fg=white, 0xc/bg=red 12 (dump-call-stack) 13 # crash 14 { @@ -101,9 +101,9 @@ if ('onhashchange' in window) { 43 81 7/subop/compare %ebx 0/imm32 44 0f 84/jump-if-= break/disp32 45 # loop body - 46 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "\n" 0 0xc) - 47 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebx+4) 0xf 0xc) - 48 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 0 0xc) + 46 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "\n" 0 0xc) + 47 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebx+4) 0xf 0xc) + 48 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 " " 0 0xc) 49 (containing-function %edx *(ebx+4)) # => eax, ecx 50 (draw-slice-wrapping-right-then-down-from-cursor-over-full-screen 0 %eax %ecx 0 0xc) 51 # loop update @@ -140,10 +140,10 @@ if ('onhashchange' in window) { 82 c7 0/subop/copy *(ecx+4) 0/imm32 # read index 83 c7 0/subop/copy *(ecx+8) 0x01000000/imm32 # stream capacity = 16MB 84 # load 0x400 sectors starting from sector 10080 = 0x2760 - 85 (load-sectors Primary-bus-primary-drive 0x2760 0x100 %ecx) - 86 (load-sectors Primary-bus-primary-drive 0x2860 0x100 %ecx) - 87 (load-sectors Primary-bus-primary-drive 0x2960 0x100 %ecx) - 88 (load-sectors Primary-bus-primary-drive 0x2a60 0x100 %ecx) + 85 (load-sectors Primary-bus-primary-drive 0x2760 0x100 %ecx) + 86 (load-sectors Primary-bus-primary-drive 0x2860 0x100 %ecx) + 87 (load-sectors Primary-bus-primary-drive 0x2960 0x100 %ecx) + 88 (load-sectors Primary-bus-primary-drive 0x2a60 0x100 %ecx) 89 # - parse pointers to portions of this stream into labels 90 # var curr/ecx: (addr byte) = s->data 91 81 0/subop/add %ecx 0xc/imm32 @@ -193,7 +193,7 @@ if ('onhashchange' in window) { 135 3d/compare-eax-and 0/imm32 136 { 137 75/jump-if-!= break/disp8 -138 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "done loading" 7 0) +138 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "done loading" 7 0) 139 { 140 eb/jump loop/disp8 141 } @@ -201,7 +201,7 @@ if ('onhashchange' in window) { 143 3d/compare-eax-and 0xa/imm32/newline 144 { 145 75/jump-if-!= break/disp8 -146 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "unexpected newline" 7 0) +146 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "unexpected newline" 7 0) 147 { 148 eb/jump loop/disp8 149 } @@ -234,7 +234,7 @@ if ('onhashchange' in window) { 176 3d/compare-eax-and 0/imm32 177 { 178 75/jump-if-!= break/disp8 -179 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "done loading" 7 0) +179 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "done loading" 7 0) 180 { 181 eb/jump loop/disp8 182 } @@ -242,7 +242,7 @@ if ('onhashchange' in window) { 184 3d/compare-eax-and 0x20/imm32/space 185 { 186 75/jump-if-!= break/disp8 -187 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "unexpected space" 7 0) +187 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "unexpected space" 7 0) 188 { 189 eb/jump loop/disp8 190 } @@ -313,8 +313,8 @@ if ('onhashchange' in window) { 255 39/compare %ecx 2/r32/edx 256 { 257 0f 82/jump-if-addr< break/disp32 -258 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "failed to find function for address " 7 0) -259 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0xc) 7 0) +258 (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "failed to find function for address " 7 0) +259 (draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0xc) 7 0) 260 { 261 eb/jump loop/disp8 262 } @@ -373,7 +373,7 @@ if ('onhashchange' in window) { 315 # print *curr 316 8a/byte-> *ecx 0/r32/eax 317 (draw-grapheme-at-cursor *(ebp+8) %eax *(ebp+0x14) *(ebp+0x18)) -318 (move-cursor-rightward-and-downward *(ebp+8)) +318 (move-cursor-rightward-and-downward *(ebp+8)) 319 # 320 41/increment-ecx 321 # diff --git a/html/318counter.subx.html b/html/318counter.subx.html new file mode 100644 index 00000000..a892f566 --- /dev/null +++ b/html/318counter.subx.html @@ -0,0 +1,92 @@ + + + + +Mu - 318counter.subx + + + + + + + + + + +https://github.com/akkartik/mu/blob/main/318counter.subx +
+ 1 # A rudimentary counter that can be called from anywhere.
+ 2 
+ 3 == code
+ 4 
+ 5 count-event:
+ 6     # . prologue
+ 7     55/push-ebp
+ 8     89/<- %ebp 4/r32/esp
+ 9     #
+10     ff 0/subop/increment *Foo
+11 $count-event:end:
+12     # . epilogue
+13     89/<- %esp 5/r32/ebp
+14     5d/pop-to-ebp
+15     c3/return
+16 
+17 count-of-events:  # -> _/eax: int
+18     # . prologue
+19     55/push-ebp
+20     89/<- %ebp 4/r32/esp
+21     #
+22     8b/-> *Foo 0/r32/eax
+23 $count-of-events:end:
+24     # . epilogue
+25     89/<- %esp 5/r32/ebp
+26     5d/pop-to-ebp
+27     c3/return
+28 
+29 == data
+30 Foo:
+31   0/imm32
+
+ + + diff --git a/html/400.mu.html b/html/400.mu.html index e7a56322..e071ade5 100644 --- a/html/400.mu.html +++ b/html/400.mu.html @@ -65,11 +65,11 @@ if ('onhashchange' in window) { 10 sig read-key kbd: (addr keyboard) -> _/eax: byte 11 12 # disk - 13 sig load-sectors disk: (addr disk), lba: int, n: int, out: (addr stream byte) - 14 sig store-sectors disk: (addr disk), lba: int, n: int, out: (addr stream byte) + 13 sig load-sectors disk: (addr disk), lba: int, n: int, out: (addr stream byte) + 14 sig store-sectors disk: (addr disk), lba: int, n: int, out: (addr stream byte) 15 16 # mouse - 17 sig read-mouse-event -> _/eax: int, _/ecx: int + 17 sig read-mouse-event -> _/eax: int, _/ecx: int 18 19 # tests 20 sig count-test-failure @@ -89,71 +89,78 @@ if ('onhashchange' in window) { 34 sig abort e: (addr array byte) 35 sig dump-call-stack 36 - 37 # streams - 38 sig clear-stream f: (addr stream _) - 39 sig rewind-stream f: (addr stream _) - 40 sig stream-data-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean - 41 sig streams-data-equal? f: (addr stream byte), s: (addr stream byte) -> _/eax: boolean - 42 sig check-stream-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte) - 43 sig next-stream-line-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean - 44 sig check-next-stream-line-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte) - 45 sig write f: (addr stream byte), s: (addr array byte) - 46 sig write-stream f: (addr stream byte), s: (addr stream byte) - 47 sig read-byte s: (addr stream byte) -> _/eax: byte - 48 sig append-byte f: (addr stream byte), n: int # really just a byte, but I want to pass in literal numbers - 49 #sig to-hex-char in/eax: int -> out/eax: int - 50 sig append-byte-hex f: (addr stream byte), n: int # really just a byte, but I want to pass in literal numbers - 51 sig write-int32-hex f: (addr stream byte), n: int - 52 sig write-int32-hex-bits f: (addr stream byte), n: int, bits: int - 53 sig hex-int? in: (addr slice) -> _/eax: boolean - 54 sig parse-hex-int in: (addr array byte) -> _/eax: int - 55 sig parse-hex-int-from-slice in: (addr slice) -> _/eax: int - 56 #sig parse-hex-int-helper start: (addr byte), end: (addr byte) -> _/eax: int - 57 sig hex-digit? c: byte -> _/eax: boolean - 58 #sig from-hex-char in/eax: byte -> out/eax: nibble - 59 sig parse-decimal-int in: (addr array byte) -> _/eax: int - 60 sig parse-decimal-int-from-slice in: (addr slice) -> _/eax: int - 61 sig parse-decimal-int-from-stream in: (addr stream byte) -> _/eax: int - 62 #sig parse-decimal-int-helper start: (addr byte), end: (addr byte) -> _/eax: int - 63 sig decimal-size n: int -> _/eax: int - 64 #sig allocate ad: (addr allocation-descriptor), n: int, out: (addr handle _) - 65 #sig allocate-raw ad: (addr allocation-descriptor), n: int, out: (addr handle _) - 66 sig lookup h: (handle _T) -> _/eax: (addr _T) - 67 sig handle-equal? a: (handle _T), b: (handle _T) -> _/eax: boolean - 68 sig copy-handle src: (handle _T), dest: (addr handle _T) - 69 #sig allocate-region ad: (addr allocation-descriptor), n: int, out: (addr handle allocation-descriptor) - 70 #sig allocate-array ad: (addr allocation-descriptor), n: int, out: (addr handle _) - 71 sig copy-array ad: (addr allocation-descriptor), src: (addr array _T), out: (addr handle array _T) - 72 #sig zero-out start: (addr byte), size: int - 73 sig slice-empty? s: (addr slice) -> _/eax: boolean - 74 sig slice-equal? s: (addr slice), p: (addr array byte) -> _/eax: boolean - 75 sig slice-starts-with? s: (addr slice), head: (addr array byte) -> _/eax: boolean - 76 sig write-slice out: (addr stream byte), s: (addr slice) - 77 # bad name alert - 78 sig slice-to-string ad: (addr allocation-descriptor), in: (addr slice), out: (addr handle array byte) - 79 sig write-int32-decimal out: (addr stream byte), n: int - 80 sig decimal-digit? c: grapheme -> _/eax: boolean - 81 sig to-decimal-digit in: grapheme -> _/eax: int - 82 # bad name alert - 83 # next-word really tokenizes - 84 # next-raw-word really reads whitespace-separated words - 85 sig next-word line: (addr stream byte), out: (addr slice) # skips '#' comments - 86 sig next-raw-word line: (addr stream byte), out: (addr slice) # does not skip '#' comments - 87 sig stream-empty? s: (addr stream _) -> _/eax: boolean - 88 sig stream-full? s: (addr stream _) -> _/eax: boolean - 89 sig stream-to-array in: (addr stream _), out: (addr handle array _) - 90 sig unquote-stream-to-array in: (addr stream _), out: (addr handle array _) - 91 sig stream-first s: (addr stream byte) -> _/eax: byte - 92 sig stream-final s: (addr stream byte) -> _/eax: byte - 93 - 94 #sig copy-bytes src: (addr byte), dest: (addr byte), n: int - 95 sig copy-array-object src: (addr array _), dest-ah: (addr handle array _) - 96 sig array-equal? a: (addr array int), b: (addr array int) -> _/eax: boolean - 97 sig parse-array-of-ints s: (addr array byte), out: (addr handle array int) - 98 sig parse-array-of-decimal-ints s: (addr array byte), out: (addr handle array int) - 99 sig check-array-equal a: (addr array int), expected: (addr string), msg: (addr string) + 37 sig count-event + 38 sig count-of-events -> _/eax: int + 39 + 40 # streams + 41 sig clear-stream f: (addr stream _) + 42 sig rewind-stream f: (addr stream _) + 43 sig stream-data-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean + 44 sig streams-data-equal? f: (addr stream byte), s: (addr stream byte) -> _/eax: boolean + 45 sig check-stream-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte) + 46 sig next-stream-line-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean + 47 sig check-next-stream-line-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte) + 48 sig write f: (addr stream byte), s: (addr array byte) + 49 sig try-write f: (addr stream byte), s: (addr array byte) -> _/eax: boolean + 50 # probably a bad idea; I definitely want to discourage its use for streams of non-bytes + 51 sig stream-size f: (addr stream byte) -> _/eax: int + 52 sig space-remaining-in-stream f: (addr stream byte) -> _/eax: int + 53 sig write-stream f: (addr stream byte), s: (addr stream byte) + 54 sig read-byte s: (addr stream byte) -> _/eax: byte + 55 sig append-byte f: (addr stream byte), n: int # really just a byte, but I want to pass in literal numbers + 56 #sig to-hex-char in/eax: int -> out/eax: int + 57 sig append-byte-hex f: (addr stream byte), n: int # really just a byte, but I want to pass in literal numbers + 58 sig write-int32-hex f: (addr stream byte), n: int + 59 sig write-int32-hex-bits f: (addr stream byte), n: int, bits: int + 60 sig hex-int? in: (addr slice) -> _/eax: boolean + 61 sig parse-hex-int in: (addr array byte) -> _/eax: int + 62 sig parse-hex-int-from-slice in: (addr slice) -> _/eax: int + 63 #sig parse-hex-int-helper start: (addr byte), end: (addr byte) -> _/eax: int + 64 sig hex-digit? c: byte -> _/eax: boolean + 65 #sig from-hex-char in/eax: byte -> out/eax: nibble + 66 sig parse-decimal-int in: (addr array byte) -> _/eax: int + 67 sig parse-decimal-int-from-slice in: (addr slice) -> _/eax: int + 68 sig parse-decimal-int-from-stream in: (addr stream byte) -> _/eax: int + 69 #sig parse-decimal-int-helper start: (addr byte), end: (addr byte) -> _/eax: int + 70 sig decimal-size n: int -> _/eax: int + 71 #sig allocate ad: (addr allocation-descriptor), n: int, out: (addr handle _) + 72 #sig allocate-raw ad: (addr allocation-descriptor), n: int, out: (addr handle _) + 73 sig lookup h: (handle _T) -> _/eax: (addr _T) + 74 sig handle-equal? a: (handle _T), b: (handle _T) -> _/eax: boolean + 75 sig copy-handle src: (handle _T), dest: (addr handle _T) + 76 #sig allocate-region ad: (addr allocation-descriptor), n: int, out: (addr handle allocation-descriptor) + 77 #sig allocate-array ad: (addr allocation-descriptor), n: int, out: (addr handle _) + 78 sig copy-array ad: (addr allocation-descriptor), src: (addr array _T), out: (addr handle array _T) + 79 #sig zero-out start: (addr byte), size: int + 80 sig slice-empty? s: (addr slice) -> _/eax: boolean + 81 sig slice-equal? s: (addr slice), p: (addr array byte) -> _/eax: boolean + 82 sig slice-starts-with? s: (addr slice), head: (addr array byte) -> _/eax: boolean + 83 sig write-slice out: (addr stream byte), s: (addr slice) + 84 # bad name alert + 85 sig slice-to-string ad: (addr allocation-descriptor), in: (addr slice), out: (addr handle array byte) + 86 sig write-int32-decimal out: (addr stream byte), n: int + 87 sig decimal-digit? c: grapheme -> _/eax: boolean + 88 sig to-decimal-digit in: grapheme -> _/eax: int + 89 # bad name alert + 90 # next-word really tokenizes + 91 # next-raw-word really reads whitespace-separated words + 92 sig next-word line: (addr stream byte), out: (addr slice) # skips '#' comments + 93 sig next-raw-word line: (addr stream byte), out: (addr slice) # does not skip '#' comments + 94 sig stream-empty? s: (addr stream _) -> _/eax: boolean + 95 sig stream-full? s: (addr stream _) -> _/eax: boolean + 96 sig stream-to-array in: (addr stream _), out: (addr handle array _) + 97 sig unquote-stream-to-array in: (addr stream _), out: (addr handle array _) + 98 sig stream-first s: (addr stream byte) -> _/eax: byte + 99 sig stream-final s: (addr stream byte) -> _/eax: byte 100 -101 sig integer-divide a: int, b: int -> _/eax: int, _/edx: int +101 #sig copy-bytes src: (addr byte), dest: (addr byte), n: int +102 sig copy-array-object src: (addr array _), dest-ah: (addr handle array _) +103 sig array-equal? a: (addr array int), b: (addr array int) -> _/eax: boolean +104 sig parse-array-of-ints s: (addr array byte), out: (addr handle array int) +105 sig parse-array-of-decimal-ints s: (addr array byte), out: (addr handle array int) +106 sig check-array-equal a: (addr array int), expected: (addr string), msg: (addr string) +107 +108 sig integer-divide a: int, b: int -> _/eax: int, _/edx: int diff --git a/html/500fake-screen.mu.html b/html/500fake-screen.mu.html index edf7b8f5..b6b99964 100644 --- a/html/500fake-screen.mu.html +++ b/html/500fake-screen.mu.html @@ -174,445 +174,446 @@ if ('onhashchange' in window) { 116 draw-grapheme screen, g, x, y, color, background-color 117 } 118 -119 # not really needed for a real screen, though it shouldn't do any harm +119 # fake screens only 120 fn screen-cell-index _screen: (addr screen), x: int, y: int -> _/ecx: int { 121 var screen/esi: (addr screen) <- copy _screen -122 { -123 compare x, 0 -124 break-if->= -125 abort "screen-cell-index: negative x" -126 } -127 { -128 var xmax/eax: (addr int) <- get screen, width -129 var xcurr/ecx: int <- copy x -130 compare xcurr, *xmax -131 break-if-< -132 abort "screen-cell-index: x too high" -133 } -134 { -135 compare y, 0 -136 break-if->= -137 abort "screen-cell-index: negative y" -138 } -139 { -140 var ymax/eax: (addr int) <- get screen, height -141 var ycurr/ecx: int <- copy y -142 compare ycurr, *ymax -143 break-if-< -144 abort "screen-cell-index: y too high" -145 } -146 var width-addr/eax: (addr int) <- get screen, width -147 var result/ecx: int <- copy y -148 result <- multiply *width-addr -149 result <- add x -150 return result -151 } -152 -153 fn cursor-position _screen: (addr screen) -> _/eax: int, _/ecx: int { -154 var screen/esi: (addr screen) <- copy _screen -155 { -156 compare screen, 0 -157 break-if-!= -158 var x/eax: int <- copy 0 -159 var y/ecx: int <- copy 0 -160 x, y <- cursor-position-on-real-screen -161 return x, y -162 } -163 # fake screen -164 var cursor-x-addr/eax: (addr int) <- get screen, cursor-x -165 var cursor-y-addr/ecx: (addr int) <- get screen, cursor-y -166 return *cursor-x-addr, *cursor-y-addr -167 } -168 -169 fn set-cursor-position _screen: (addr screen), x: int, y: int { -170 var screen/esi: (addr screen) <- copy _screen -171 { -172 compare screen, 0 -173 break-if-!= -174 set-cursor-position-on-real-screen x, y -175 return -176 } -177 # fake screen -178 # ignore x < 0 -179 { -180 compare x, 0 -181 break-if->= -182 return -183 } -184 # ignore x >= width -185 { -186 var width-addr/eax: (addr int) <- get screen, width -187 var width/eax: int <- copy *width-addr -188 compare x, width -189 break-if-<= -190 return -191 } -192 # ignore y < 0 -193 { -194 compare y, 0 -195 break-if->= -196 return -197 } -198 # ignore y >= height -199 { -200 var height-addr/eax: (addr int) <- get screen, height -201 var height/eax: int <- copy *height-addr -202 compare y, height -203 break-if-< -204 return -205 } -206 # screen->cursor-x = x -207 var dest/edi: (addr int) <- get screen, cursor-x -208 var src/eax: int <- copy x -209 copy-to *dest, src -210 # screen->cursor-y = y -211 dest <- get screen, cursor-y -212 src <- copy y -213 copy-to *dest, src -214 } -215 -216 fn draw-cursor screen: (addr screen), g: grapheme { -217 { -218 compare screen, 0 -219 break-if-!= -220 draw-cursor-on-real-screen g -221 return -222 } -223 # fake screen -224 var cursor-x/eax: int <- copy 0 -225 var cursor-y/ecx: int <- copy 0 -226 cursor-x, cursor-y <- cursor-position screen -227 draw-grapheme screen, g, cursor-x, cursor-y, 0/fg, 7/bg -228 } -229 -230 fn clear-screen _screen: (addr screen) { -231 var screen/esi: (addr screen) <- copy _screen -232 { -233 compare screen, 0 -234 break-if-!= -235 clear-real-screen -236 return -237 } -238 # fake screen -239 set-cursor-position screen, 0, 0 -240 var y/eax: int <- copy 0 -241 var height/ecx: (addr int) <- get screen, height -242 { -243 compare y, *height -244 break-if->= -245 var x/edx: int <- copy 0 -246 var width/ebx: (addr int) <- get screen, width -247 { -248 compare x, *width -249 break-if->= -250 draw-code-point screen, 0x20/space, x, y, 0/fg=black, 0/bg=black -251 x <- increment -252 loop -253 } -254 y <- increment -255 loop -256 } -257 set-cursor-position screen, 0, 0 -258 var pixels-ah/eax: (addr handle array byte) <- get screen, pixels -259 var pixels/eax: (addr array byte) <- lookup *pixels-ah -260 var i/ecx: int <- copy 0 -261 var max/edx: int <- length pixels -262 { -263 compare i, max -264 break-if->= -265 var curr/eax: (addr byte) <- index pixels, i -266 var zero/ebx: byte <- copy 0 -267 copy-byte-to *curr, zero -268 i <- increment -269 loop -270 } -271 } -272 -273 fn fake-screen-empty? _screen: (addr screen) -> _/eax: boolean { -274 var screen/esi: (addr screen) <- copy _screen -275 var y/eax: int <- copy 0 -276 var height/ecx: (addr int) <- get screen, height -277 { -278 compare y, *height -279 break-if->= -280 var x/edx: int <- copy 0 -281 var width/ebx: (addr int) <- get screen, width -282 { -283 compare x, *width -284 break-if->= -285 var g/eax: grapheme <- screen-grapheme-at screen, x, y -286 { -287 compare g, 0 -288 break-if-= -289 compare g, 0x20/space -290 break-if-= -291 return 0/false -292 } -293 x <- increment -294 loop -295 } -296 y <- increment -297 loop -298 } -299 var pixels-ah/eax: (addr handle array byte) <- get screen, pixels -300 var pixels/eax: (addr array byte) <- lookup *pixels-ah -301 var y/ebx: int <- copy 0 -302 var height-addr/edx: (addr int) <- get screen, height -303 var height/edx: int <- copy *height-addr -304 height <- shift-left 4/log2-font-height -305 { -306 compare y, height -307 break-if->= -308 var width-addr/edx: (addr int) <- get screen, width -309 var width/edx: int <- copy *width-addr -310 width <- shift-left 3/log2-font-width -311 var x/edi: int <- copy 0 -312 { -313 compare x, width -314 break-if->= -315 var idx/ecx: int <- pixel-index screen, x, y -316 var color-addr/ecx: (addr byte) <- index pixels, idx -317 var color/ecx: byte <- copy-byte *color-addr -318 compare color, 0 -319 { -320 break-if-= -321 return 0/false -322 } -323 x <- increment -324 loop -325 } -326 y <- increment -327 loop -328 } -329 return 1/true -330 } -331 -332 fn clear-rect _screen: (addr screen), xmin: int, ymin: int, xmax: int, ymax: int, background-color: int { -333 var screen/esi: (addr screen) <- copy _screen -334 { -335 compare screen, 0 -336 break-if-!= -337 clear-rect-on-real-screen xmin, ymin, xmax, ymax, background-color -338 return -339 } -340 # fake screen -341 set-cursor-position screen, 0, 0 -342 var y/eax: int <- copy ymin -343 var ymax/ecx: int <- copy ymax -344 { -345 compare y, ymax -346 break-if->= -347 var x/edx: int <- copy xmin -348 var xmax/ebx: int <- copy xmax -349 { -350 compare x, xmax -351 break-if->= -352 draw-code-point screen, 0x20/space, x, y, 0/fg, background-color -353 x <- increment -354 loop -355 } -356 y <- increment -357 loop -358 } -359 set-cursor-position screen, 0, 0 -360 } -361 -362 # there's no grapheme that guarantees to cover every pixel, so we'll bump down -363 # to pixels for a real screen -364 fn clear-real-screen { -365 var y/eax: int <- copy 0 -366 { -367 compare y, 0x300/screen-height=768 -368 break-if->= -369 var x/edx: int <- copy 0 -370 { -371 compare x, 0x400/screen-width=1024 -372 break-if->= -373 pixel-on-real-screen x, y, 0/color=black -374 x <- increment -375 loop -376 } -377 y <- increment -378 loop -379 } -380 } -381 -382 fn clear-rect-on-real-screen xmin: int, ymin: int, xmax: int, ymax: int, background-color: int { -383 var y/eax: int <- copy ymin -384 y <- shift-left 4/log2-font-height -385 var ymax/ecx: int <- copy ymax -386 ymax <- shift-left 4/log2-font-height -387 { -388 compare y, ymax -389 break-if->= -390 var x/edx: int <- copy xmin -391 x <- shift-left 3/log2-font-width -392 var xmax/ebx: int <- copy xmax -393 xmax <- shift-left 3/log2-font-width -394 { -395 compare x, xmax -396 break-if->= -397 pixel-on-real-screen x, y, background-color -398 x <- increment -399 loop -400 } -401 y <- increment -402 loop -403 } -404 } -405 -406 fn screen-grapheme-at _screen: (addr screen), x: int, y: int -> _/eax: grapheme { -407 var screen/esi: (addr screen) <- copy _screen -408 var idx/ecx: int <- screen-cell-index screen, x, y -409 var result/eax: grapheme <- screen-grapheme-at-idx screen, idx -410 return result -411 } -412 -413 fn screen-grapheme-at-idx _screen: (addr screen), idx-on-stack: int -> _/eax: grapheme { -414 var screen/esi: (addr screen) <- copy _screen -415 var data-ah/eax: (addr handle array screen-cell) <- get screen, data -416 var data/eax: (addr array screen-cell) <- lookup *data-ah -417 var idx/ecx: int <- copy idx-on-stack -418 var offset/ecx: (offset screen-cell) <- compute-offset data, idx -419 var cell/eax: (addr screen-cell) <- index data, offset -420 var src/eax: (addr grapheme) <- get cell, data -421 return *src -422 } -423 -424 fn screen-color-at _screen: (addr screen), x: int, y: int -> _/eax: int { -425 var screen/esi: (addr screen) <- copy _screen -426 var idx/ecx: int <- screen-cell-index screen, x, y -427 var result/eax: int <- screen-color-at-idx screen, idx -428 return result -429 } -430 -431 fn screen-color-at-idx _screen: (addr screen), idx-on-stack: int -> _/eax: int { -432 var screen/esi: (addr screen) <- copy _screen -433 var data-ah/eax: (addr handle array screen-cell) <- get screen, data -434 var data/eax: (addr array screen-cell) <- lookup *data-ah -435 var idx/ecx: int <- copy idx-on-stack -436 var offset/ecx: (offset screen-cell) <- compute-offset data, idx -437 var cell/eax: (addr screen-cell) <- index data, offset -438 var src/eax: (addr int) <- get cell, color -439 var result/eax: int <- copy *src -440 return result -441 } -442 -443 fn screen-background-color-at _screen: (addr screen), x: int, y: int -> _/eax: int { -444 var screen/esi: (addr screen) <- copy _screen -445 var idx/ecx: int <- screen-cell-index screen, x, y -446 var result/eax: int <- screen-background-color-at-idx screen, idx -447 return result -448 } -449 -450 fn screen-background-color-at-idx _screen: (addr screen), idx-on-stack: int -> _/eax: int { -451 var screen/esi: (addr screen) <- copy _screen -452 var data-ah/eax: (addr handle array screen-cell) <- get screen, data -453 var data/eax: (addr array screen-cell) <- lookup *data-ah -454 var idx/ecx: int <- copy idx-on-stack -455 var offset/ecx: (offset screen-cell) <- compute-offset data, idx -456 var cell/eax: (addr screen-cell) <- index data, offset -457 var src/eax: (addr int) <- get cell, background-color -458 var result/eax: int <- copy *src -459 return result -460 } -461 -462 fn pixel screen: (addr screen), x: int, y: int, color: int { -463 { -464 compare screen, 0 -465 break-if-!= -466 pixel-on-real-screen x, y, color -467 return -468 } -469 # fake screen -470 var screen/esi: (addr screen) <- copy screen -471 var pixels-ah/eax: (addr handle array byte) <- get screen, pixels -472 var pixels/eax: (addr array byte) <- lookup *pixels-ah -473 { -474 compare pixels, 0 -475 break-if-!= -476 abort "pixel graphics not enabled for this screen" -477 } -478 var idx/ecx: int <- pixel-index screen, x, y -479 var dest/ecx: (addr byte) <- index pixels, idx -480 var src/eax: byte <- copy-byte color -481 copy-byte-to *dest, src -482 } -483 -484 fn pixel-index _screen: (addr screen), x: int, y: int -> _/ecx: int { -485 var screen/esi: (addr screen) <- copy _screen -486 { -487 compare x, 0 -488 break-if->= -489 abort "screen-cell-index: negative x" -490 } -491 { -492 var xmax-a/eax: (addr int) <- get screen, width -493 var xmax/eax: int <- copy *xmax-a -494 xmax <- shift-left 3/log2-font-width -495 compare x, xmax -496 break-if-< -497 abort "screen-cell-index: x too high" -498 } -499 { -500 compare y, 0 -501 break-if->= -502 abort "screen-cell-index: negative y" -503 } -504 { -505 var ymax-a/eax: (addr int) <- get screen, height -506 var ymax/eax: int <- copy *ymax-a -507 ymax <- shift-left 4/log2-font-height -508 compare y, ymax -509 break-if-< -510 abort "screen-cell-index: y too high" -511 } -512 var width-addr/eax: (addr int) <- get screen, width -513 var result/ecx: int <- copy y -514 result <- multiply *width-addr -515 result <- shift-left 3/log2-font-width -516 result <- add x -517 return result -518 } -519 -520 # double-buffering primitive -521 # 'screen' must be a fake screen. 'target-screen' is usually real. -522 # Both screens must have the same size. -523 fn copy-pixels _screen: (addr screen), target-screen: (addr screen) { -524 var screen/esi: (addr screen) <- copy _screen -525 var pixels-ah/eax: (addr handle array byte) <- get screen, pixels -526 var _pixels/eax: (addr array byte) <- lookup *pixels-ah -527 var pixels/edi: (addr array byte) <- copy _pixels -528 var width-a/edx: (addr int) <- get screen, width -529 var width/edx: int <- copy *width-a -530 width <- shift-left 3/log2-font-width -531 var height-a/ebx: (addr int) <- get screen, height -532 var height/ebx: int <- copy *height-a -533 height <- shift-left 4/log2-font-height -534 var i/esi: int <- copy 0 -535 var y/ecx: int <- copy 0 -536 { -537 # screen top left pixels x y width height -538 compare y, height -539 break-if->= -540 var x/eax: int <- copy 0 -541 { -542 compare x, width -543 break-if->= -544 { -545 var color-addr/ebx: (addr byte) <- index pixels, i -546 var color/ebx: byte <- copy-byte *color-addr -547 var color2/ebx: int <- copy color -548 pixel target-screen, x, y, color2 -549 } -550 x <- increment -551 i <- increment -552 loop -553 } -554 y <- increment -555 loop -556 } -557 } +122 # some bounds checks that aren't needed for a real screen, but might help catch problems +123 { +124 compare x, 0 +125 break-if->= +126 abort "screen-cell-index: negative x" +127 } +128 { +129 var xmax/eax: (addr int) <- get screen, width +130 var xcurr/ecx: int <- copy x +131 compare xcurr, *xmax +132 break-if-< +133 abort "screen-cell-index: x too high" +134 } +135 { +136 compare y, 0 +137 break-if->= +138 abort "screen-cell-index: negative y" +139 } +140 { +141 var ymax/eax: (addr int) <- get screen, height +142 var ycurr/ecx: int <- copy y +143 compare ycurr, *ymax +144 break-if-< +145 abort "screen-cell-index: y too high" +146 } +147 var width-addr/eax: (addr int) <- get screen, width +148 var result/ecx: int <- copy y +149 result <- multiply *width-addr +150 result <- add x +151 return result +152 } +153 +154 fn cursor-position _screen: (addr screen) -> _/eax: int, _/ecx: int { +155 var screen/esi: (addr screen) <- copy _screen +156 { +157 compare screen, 0 +158 break-if-!= +159 var x/eax: int <- copy 0 +160 var y/ecx: int <- copy 0 +161 x, y <- cursor-position-on-real-screen +162 return x, y +163 } +164 # fake screen +165 var cursor-x-addr/eax: (addr int) <- get screen, cursor-x +166 var cursor-y-addr/ecx: (addr int) <- get screen, cursor-y +167 return *cursor-x-addr, *cursor-y-addr +168 } +169 +170 fn set-cursor-position _screen: (addr screen), x: int, y: int { +171 var screen/esi: (addr screen) <- copy _screen +172 { +173 compare screen, 0 +174 break-if-!= +175 set-cursor-position-on-real-screen x, y +176 return +177 } +178 # fake screen +179 # ignore x < 0 +180 { +181 compare x, 0 +182 break-if->= +183 return +184 } +185 # ignore x >= width +186 { +187 var width-addr/eax: (addr int) <- get screen, width +188 var width/eax: int <- copy *width-addr +189 compare x, width +190 break-if-<= +191 return +192 } +193 # ignore y < 0 +194 { +195 compare y, 0 +196 break-if->= +197 return +198 } +199 # ignore y >= height +200 { +201 var height-addr/eax: (addr int) <- get screen, height +202 var height/eax: int <- copy *height-addr +203 compare y, height +204 break-if-< +205 return +206 } +207 # screen->cursor-x = x +208 var dest/edi: (addr int) <- get screen, cursor-x +209 var src/eax: int <- copy x +210 copy-to *dest, src +211 # screen->cursor-y = y +212 dest <- get screen, cursor-y +213 src <- copy y +214 copy-to *dest, src +215 } +216 +217 fn draw-cursor screen: (addr screen), g: grapheme { +218 { +219 compare screen, 0 +220 break-if-!= +221 draw-cursor-on-real-screen g +222 return +223 } +224 # fake screen +225 var cursor-x/eax: int <- copy 0 +226 var cursor-y/ecx: int <- copy 0 +227 cursor-x, cursor-y <- cursor-position screen +228 draw-grapheme screen, g, cursor-x, cursor-y, 0/fg, 7/bg +229 } +230 +231 fn clear-screen _screen: (addr screen) { +232 var screen/esi: (addr screen) <- copy _screen +233 { +234 compare screen, 0 +235 break-if-!= +236 clear-real-screen +237 return +238 } +239 # fake screen +240 set-cursor-position screen, 0, 0 +241 var y/eax: int <- copy 0 +242 var height/ecx: (addr int) <- get screen, height +243 { +244 compare y, *height +245 break-if->= +246 var x/edx: int <- copy 0 +247 var width/ebx: (addr int) <- get screen, width +248 { +249 compare x, *width +250 break-if->= +251 draw-code-point screen, 0x20/space, x, y, 0/fg=black, 0/bg=black +252 x <- increment +253 loop +254 } +255 y <- increment +256 loop +257 } +258 set-cursor-position screen, 0, 0 +259 var pixels-ah/eax: (addr handle array byte) <- get screen, pixels +260 var pixels/eax: (addr array byte) <- lookup *pixels-ah +261 var i/ecx: int <- copy 0 +262 var max/edx: int <- length pixels +263 { +264 compare i, max +265 break-if->= +266 var curr/eax: (addr byte) <- index pixels, i +267 var zero/ebx: byte <- copy 0 +268 copy-byte-to *curr, zero +269 i <- increment +270 loop +271 } +272 } +273 +274 fn fake-screen-empty? _screen: (addr screen) -> _/eax: boolean { +275 var screen/esi: (addr screen) <- copy _screen +276 var y/eax: int <- copy 0 +277 var height/ecx: (addr int) <- get screen, height +278 { +279 compare y, *height +280 break-if->= +281 var x/edx: int <- copy 0 +282 var width/ebx: (addr int) <- get screen, width +283 { +284 compare x, *width +285 break-if->= +286 var g/eax: grapheme <- screen-grapheme-at screen, x, y +287 { +288 compare g, 0 +289 break-if-= +290 compare g, 0x20/space +291 break-if-= +292 return 0/false +293 } +294 x <- increment +295 loop +296 } +297 y <- increment +298 loop +299 } +300 var pixels-ah/eax: (addr handle array byte) <- get screen, pixels +301 var pixels/eax: (addr array byte) <- lookup *pixels-ah +302 var y/ebx: int <- copy 0 +303 var height-addr/edx: (addr int) <- get screen, height +304 var height/edx: int <- copy *height-addr +305 height <- shift-left 4/log2-font-height +306 { +307 compare y, height +308 break-if->= +309 var width-addr/edx: (addr int) <- get screen, width +310 var width/edx: int <- copy *width-addr +311 width <- shift-left 3/log2-font-width +312 var x/edi: int <- copy 0 +313 { +314 compare x, width +315 break-if->= +316 var idx/ecx: int <- pixel-index screen, x, y +317 var color-addr/ecx: (addr byte) <- index pixels, idx +318 var color/ecx: byte <- copy-byte *color-addr +319 compare color, 0 +320 { +321 break-if-= +322 return 0/false +323 } +324 x <- increment +325 loop +326 } +327 y <- increment +328 loop +329 } +330 return 1/true +331 } +332 +333 fn clear-rect _screen: (addr screen), xmin: int, ymin: int, xmax: int, ymax: int, background-color: int { +334 var screen/esi: (addr screen) <- copy _screen +335 { +336 compare screen, 0 +337 break-if-!= +338 clear-rect-on-real-screen xmin, ymin, xmax, ymax, background-color +339 return +340 } +341 # fake screen +342 set-cursor-position screen, 0, 0 +343 var y/eax: int <- copy ymin +344 var ymax/ecx: int <- copy ymax +345 { +346 compare y, ymax +347 break-if->= +348 var x/edx: int <- copy xmin +349 var xmax/ebx: int <- copy xmax +350 { +351 compare x, xmax +352 break-if->= +353 draw-code-point screen, 0x20/space, x, y, 0/fg, background-color +354 x <- increment +355 loop +356 } +357 y <- increment +358 loop +359 } +360 set-cursor-position screen, 0, 0 +361 } +362 +363 # there's no grapheme that guarantees to cover every pixel, so we'll bump down +364 # to pixels for a real screen +365 fn clear-real-screen { +366 var y/eax: int <- copy 0 +367 { +368 compare y, 0x300/screen-height=768 +369 break-if->= +370 var x/edx: int <- copy 0 +371 { +372 compare x, 0x400/screen-width=1024 +373 break-if->= +374 pixel-on-real-screen x, y, 0/color=black +375 x <- increment +376 loop +377 } +378 y <- increment +379 loop +380 } +381 } +382 +383 fn clear-rect-on-real-screen xmin: int, ymin: int, xmax: int, ymax: int, background-color: int { +384 var y/eax: int <- copy ymin +385 y <- shift-left 4/log2-font-height +386 var ymax/ecx: int <- copy ymax +387 ymax <- shift-left 4/log2-font-height +388 { +389 compare y, ymax +390 break-if->= +391 var x/edx: int <- copy xmin +392 x <- shift-left 3/log2-font-width +393 var xmax/ebx: int <- copy xmax +394 xmax <- shift-left 3/log2-font-width +395 { +396 compare x, xmax +397 break-if->= +398 pixel-on-real-screen x, y, background-color +399 x <- increment +400 loop +401 } +402 y <- increment +403 loop +404 } +405 } +406 +407 fn screen-grapheme-at _screen: (addr screen), x: int, y: int -> _/eax: grapheme { +408 var screen/esi: (addr screen) <- copy _screen +409 var idx/ecx: int <- screen-cell-index screen, x, y +410 var result/eax: grapheme <- screen-grapheme-at-idx screen, idx +411 return result +412 } +413 +414 fn screen-grapheme-at-idx _screen: (addr screen), idx-on-stack: int -> _/eax: grapheme { +415 var screen/esi: (addr screen) <- copy _screen +416 var data-ah/eax: (addr handle array screen-cell) <- get screen, data +417 var data/eax: (addr array screen-cell) <- lookup *data-ah +418 var idx/ecx: int <- copy idx-on-stack +419 var offset/ecx: (offset screen-cell) <- compute-offset data, idx +420 var cell/eax: (addr screen-cell) <- index data, offset +421 var src/eax: (addr grapheme) <- get cell, data +422 return *src +423 } +424 +425 fn screen-color-at _screen: (addr screen), x: int, y: int -> _/eax: int { +426 var screen/esi: (addr screen) <- copy _screen +427 var idx/ecx: int <- screen-cell-index screen, x, y +428 var result/eax: int <- screen-color-at-idx screen, idx +429 return result +430 } +431 +432 fn screen-color-at-idx _screen: (addr screen), idx-on-stack: int -> _/eax: int { +433 var screen/esi: (addr screen) <- copy _screen +434 var data-ah/eax: (addr handle array screen-cell) <- get screen, data +435 var data/eax: (addr array screen-cell) <- lookup *data-ah +436 var idx/ecx: int <- copy idx-on-stack +437 var offset/ecx: (offset screen-cell) <- compute-offset data, idx +438 var cell/eax: (addr screen-cell) <- index data, offset +439 var src/eax: (addr int) <- get cell, color +440 var result/eax: int <- copy *src +441 return result +442 } +443 +444 fn screen-background-color-at _screen: (addr screen), x: int, y: int -> _/eax: int { +445 var screen/esi: (addr screen) <- copy _screen +446 var idx/ecx: int <- screen-cell-index screen, x, y +447 var result/eax: int <- screen-background-color-at-idx screen, idx +448 return result +449 } +450 +451 fn screen-background-color-at-idx _screen: (addr screen), idx-on-stack: int -> _/eax: int { +452 var screen/esi: (addr screen) <- copy _screen +453 var data-ah/eax: (addr handle array screen-cell) <- get screen, data +454 var data/eax: (addr array screen-cell) <- lookup *data-ah +455 var idx/ecx: int <- copy idx-on-stack +456 var offset/ecx: (offset screen-cell) <- compute-offset data, idx +457 var cell/eax: (addr screen-cell) <- index data, offset +458 var src/eax: (addr int) <- get cell, background-color +459 var result/eax: int <- copy *src +460 return result +461 } +462 +463 fn pixel screen: (addr screen), x: int, y: int, color: int { +464 { +465 compare screen, 0 +466 break-if-!= +467 pixel-on-real-screen x, y, color +468 return +469 } +470 # fake screen +471 var screen/esi: (addr screen) <- copy screen +472 var pixels-ah/eax: (addr handle array byte) <- get screen, pixels +473 var pixels/eax: (addr array byte) <- lookup *pixels-ah +474 { +475 compare pixels, 0 +476 break-if-!= +477 abort "pixel graphics not enabled for this screen" +478 } +479 var idx/ecx: int <- pixel-index screen, x, y +480 var dest/ecx: (addr byte) <- index pixels, idx +481 var src/eax: byte <- copy-byte color +482 copy-byte-to *dest, src +483 } +484 +485 fn pixel-index _screen: (addr screen), x: int, y: int -> _/ecx: int { +486 var screen/esi: (addr screen) <- copy _screen +487 { +488 compare x, 0 +489 break-if->= +490 abort "screen-cell-index: negative x" +491 } +492 { +493 var xmax-a/eax: (addr int) <- get screen, width +494 var xmax/eax: int <- copy *xmax-a +495 xmax <- shift-left 3/log2-font-width +496 compare x, xmax +497 break-if-< +498 abort "screen-cell-index: x too high" +499 } +500 { +501 compare y, 0 +502 break-if->= +503 abort "screen-cell-index: negative y" +504 } +505 { +506 var ymax-a/eax: (addr int) <- get screen, height +507 var ymax/eax: int <- copy *ymax-a +508 ymax <- shift-left 4/log2-font-height +509 compare y, ymax +510 break-if-< +511 abort "screen-cell-index: y too high" +512 } +513 var width-addr/eax: (addr int) <- get screen, width +514 var result/ecx: int <- copy y +515 result <- multiply *width-addr +516 result <- shift-left 3/log2-font-width +517 result <- add x +518 return result +519 } +520 +521 # double-buffering primitive +522 # 'screen' must be a fake screen. 'target-screen' is usually real. +523 # Both screens must have the same size. +524 fn copy-pixels _screen: (addr screen), target-screen: (addr screen) { +525 var screen/esi: (addr screen) <- copy _screen +526 var pixels-ah/eax: (addr handle array byte) <- get screen, pixels +527 var _pixels/eax: (addr array byte) <- lookup *pixels-ah +528 var pixels/edi: (addr array byte) <- copy _pixels +529 var width-a/edx: (addr int) <- get screen, width +530 var width/edx: int <- copy *width-a +531 width <- shift-left 3/log2-font-width +532 var height-a/ebx: (addr int) <- get screen, height +533 var height/ebx: int <- copy *height-a +534 height <- shift-left 4/log2-font-height +535 var i/esi: int <- copy 0 +536 var y/ecx: int <- copy 0 +537 { +538 # screen top left pixels x y width height +539 compare y, height +540 break-if->= +541 var x/eax: int <- copy 0 +542 { +543 compare x, width +544 break-if->= +545 { +546 var color-addr/ebx: (addr byte) <- index pixels, i +547 var color/ebx: byte <- copy-byte *color-addr +548 var color2/ebx: int <- copy color +549 pixel target-screen, x, y, color2 +550 } +551 x <- increment +552 i <- increment +553 loop +554 } +555 y <- increment +556 loop +557 } +558 } diff --git a/html/501draw-text.mu.html b/html/501draw-text.mu.html index 0e951a27..547c338c 100644 --- a/html/501draw-text.mu.html +++ b/html/501draw-text.mu.html @@ -61,14 +61,14 @@ if ('onhashchange' in window) { 3 fn move-cursor-left screen: (addr screen) { 4 var cursor-x/eax: int <- copy 0 5 var cursor-y/ecx: int <- copy 0 - 6 cursor-x, cursor-y <- cursor-position screen + 6 cursor-x, cursor-y <- cursor-position screen 7 compare cursor-x, 0 8 { 9 break-if-> 10 return 11 } 12 cursor-x <- decrement - 13 set-cursor-position screen, cursor-x, cursor-y + 13 set-cursor-position screen, cursor-x, cursor-y 14 } 15 16 fn move-cursor-right screen: (addr screen) { @@ -79,27 +79,27 @@ if ('onhashchange' in window) { 21 limit <- decrement 22 var cursor-x/eax: int <- copy 0 23 var cursor-y/ecx: int <- copy 0 - 24 cursor-x, cursor-y <- cursor-position screen + 24 cursor-x, cursor-y <- cursor-position screen 25 compare cursor-x, limit 26 { 27 break-if-< 28 return 29 } 30 cursor-x <- increment - 31 set-cursor-position screen, cursor-x, cursor-y + 31 set-cursor-position screen, cursor-x, cursor-y 32 } 33 34 fn move-cursor-up screen: (addr screen) { 35 var cursor-x/eax: int <- copy 0 36 var cursor-y/ecx: int <- copy 0 - 37 cursor-x, cursor-y <- cursor-position screen + 37 cursor-x, cursor-y <- cursor-position screen 38 compare cursor-y, 0 39 { 40 break-if-> 41 return 42 } 43 cursor-y <- decrement - 44 set-cursor-position screen, cursor-x, cursor-y + 44 set-cursor-position screen, cursor-x, cursor-y 45 } 46 47 fn move-cursor-down screen: (addr screen) { @@ -110,14 +110,14 @@ if ('onhashchange' in window) { 52 limit <- decrement 53 var cursor-x/eax: int <- copy 0 54 var cursor-y/ecx: int <- copy 0 - 55 cursor-x, cursor-y <- cursor-position screen + 55 cursor-x, cursor-y <- cursor-position screen 56 compare cursor-y, limit 57 { 58 break-if-< 59 return 60 } 61 cursor-y <- increment - 62 set-cursor-position screen, cursor-x, cursor-y + 62 set-cursor-position screen, cursor-x, cursor-y 63 } 64 65 fn move-cursor-to-left-margin-of-next-line screen: (addr screen) { @@ -128,7 +128,7 @@ if ('onhashchange' in window) { 70 limit <- decrement 71 var cursor-x/eax: int <- copy 0 72 var cursor-y/ecx: int <- copy 0 - 73 cursor-x, cursor-y <- cursor-position screen + 73 cursor-x, cursor-y <- cursor-position screen 74 compare cursor-y, limit 75 { 76 break-if-< @@ -136,13 +136,13 @@ if ('onhashchange' in window) { 78 } 79 cursor-y <- increment 80 cursor-x <- copy 0 - 81 set-cursor-position screen, cursor-x, cursor-y + 81 set-cursor-position screen, cursor-x, cursor-y 82 } 83 84 fn draw-grapheme-at-cursor screen: (addr screen), g: grapheme, color: int, background-color: int { 85 var cursor-x/eax: int <- copy 0 86 var cursor-y/ecx: int <- copy 0 - 87 cursor-x, cursor-y <- cursor-position screen + 87 cursor-x, cursor-y <- cursor-position screen 88 draw-grapheme screen, g, cursor-x, cursor-y, color, background-color 89 } 90 @@ -156,7 +156,7 @@ if ('onhashchange' in window) { 98 # return the next 'x' coordinate 99 # if there isn't enough space, truncate 100 fn draw-text-rightward screen: (addr screen), text: (addr array byte), x: int, xmax: int, y: int, color: int, background-color: int -> _/eax: int { -101 var stream-storage: (stream byte 0x100) +101 var stream-storage: (stream byte 0x200/print-buffer-size) 102 var stream/esi: (addr stream byte) <- address stream-storage 103 write stream, text 104 var xcurr/eax: int <- draw-stream-rightward screen, stream, x, xmax, y, color, background-color @@ -176,7 +176,7 @@ if ('onhashchange' in window) { 118 xcurr <- increment 119 loop 120 } -121 set-cursor-position screen, xcurr, y +121 set-cursor-position screen, xcurr, y 122 return xcurr 123 } 124 @@ -191,348 +191,369 @@ if ('onhashchange' in window) { 133 fn draw-text-rightward-from-cursor screen: (addr screen), text: (addr array byte), xmax: int, color: int, background-color: int { 134 var cursor-x/eax: int <- copy 0 135 var cursor-y/ecx: int <- copy 0 -136 cursor-x, cursor-y <- cursor-position screen +136 cursor-x, cursor-y <- cursor-position screen 137 cursor-x <- draw-text-rightward screen, text, cursor-x, xmax, cursor-y, color, background-color -138 set-cursor-position screen, cursor-x, cursor-y +138 set-cursor-position screen, cursor-x, cursor-y 139 } 140 -141 fn render-grapheme screen: (addr screen), g: grapheme, xmin: int, ymin: int, xmax: int, ymax: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { -142 compare g, 0xa/newline -143 var x/eax: int <- copy x -144 { -145 break-if-!= -146 # minimum effort to clear cursor -147 draw-code-point screen, 0x20/space, x, y, color, background-color -148 x <- copy xmin -149 increment y -150 return x, y -151 } -152 draw-grapheme screen, g, x, y, color, background-color -153 x <- increment -154 compare x, xmax -155 { -156 break-if-< -157 x <- copy xmin -158 increment y -159 } -160 return x, y -161 } -162 -163 # draw text in the rectangle from (xmin, ymin) to (xmax, ymax), starting from (x, y), wrapping as necessary -164 # return the next (x, y) coordinate in raster order where drawing stopped -165 # that way the caller can draw more if given the same min and max bounding-box. -166 # if there isn't enough space, truncate -167 fn draw-text-wrapping-right-then-down screen: (addr screen), text: (addr array byte), xmin: int, ymin: int, xmax: int, ymax: int, _x: int, _y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { -168 var stream-storage: (stream byte 0x100) -169 var stream/esi: (addr stream byte) <- address stream-storage -170 write stream, text -171 var x/eax: int <- copy _x -172 var y/ecx: int <- copy _y -173 x, y <- draw-stream-wrapping-right-then-down screen, stream, xmin, ymin, xmax, ymax, x, y, color, background-color -174 return x, y -175 } -176 -177 # draw a stream in the rectangle from (xmin, ymin) to (xmax, ymax), starting from (x, y), wrapping as necessary -178 # return the next (x, y) coordinate in raster order where drawing stopped -179 # that way the caller can draw more if given the same min and max bounding-box. -180 # if there isn't enough space, truncate -181 fn draw-stream-wrapping-right-then-down screen: (addr screen), stream: (addr stream byte), xmin: int, ymin: int, xmax: int, ymax: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { -182 var xcurr/eax: int <- copy x -183 var ycurr/ecx: int <- copy y -184 var g/ebx: grapheme <- copy 0 -185 { -186 { -187 var _g/eax: grapheme <- read-grapheme stream -188 g <- copy _g -189 } -190 compare g, 0xffffffff/end-of-file -191 break-if-= -192 xcurr, ycurr <- render-grapheme screen, g, xmin, ymin, xmax, ymax, xcurr, ycurr, color, background-color -193 loop -194 } -195 set-cursor-position screen, xcurr, ycurr -196 return xcurr, ycurr -197 } -198 -199 fn draw-stream-wrapping-right-then-down-from-cursor screen: (addr screen), stream: (addr stream byte), xmin: int, ymin: int, xmax: int, ymax: int, color: int, background-color: int { -200 var cursor-x/eax: int <- copy 0 -201 var cursor-y/ecx: int <- copy 0 -202 cursor-x, cursor-y <- cursor-position screen -203 var end-x/edx: int <- copy cursor-x -204 end-x <- increment -205 compare end-x, xmax +141 fn draw-text-rightward-from-cursor-over-full-screen screen: (addr screen), text: (addr array byte), color: int, background-color: int { +142 var width/eax: int <- copy 0 +143 var height/ecx: int <- copy 0 +144 width, height <- screen-size screen +145 draw-text-rightward-from-cursor screen, text, width, color, background-color +146 } +147 +148 fn render-grapheme screen: (addr screen), g: grapheme, xmin: int, ymin: int, xmax: int, ymax: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { +149 compare g, 0xa/newline +150 var x/eax: int <- copy x +151 { +152 break-if-!= +153 # minimum effort to clear cursor +154 draw-code-point screen, 0x20/space, x, y, color, background-color +155 x <- copy xmin +156 increment y +157 return x, y +158 } +159 draw-grapheme screen, g, x, y, color, background-color +160 x <- increment +161 compare x, xmax +162 { +163 break-if-< +164 x <- copy xmin +165 increment y +166 } +167 return x, y +168 } +169 +170 # draw text in the rectangle from (xmin, ymin) to (xmax, ymax), starting from (x, y), wrapping as necessary +171 # return the next (x, y) coordinate in raster order where drawing stopped +172 # that way the caller can draw more if given the same min and max bounding-box. +173 # if there isn't enough space, truncate +174 fn draw-text-wrapping-right-then-down screen: (addr screen), _text: (addr array byte), xmin: int, ymin: int, xmax: int, ymax: int, _x: int, _y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { +175 var stream-storage: (stream byte 0x200/print-buffer-size) # 4 rows of text = 1/12th of a real screen +176 # fake screens unlikely to be larger +177 # so this seems a reasonable size +178 # allocated on the stack, so quickly reclaimed +179 var stream/edi: (addr stream byte) <- address stream-storage +180 var text/esi: (addr array byte) <- copy _text +181 var len/eax: int <- length text +182 compare len, 0x200 +183 { +184 break-if-< +185 write stream, "ERROR: stream too small in draw-text-wrapping-right-then-down" +186 } +187 compare len, 0x200 +188 { +189 break-if->= +190 write stream, text +191 } +192 var x/eax: int <- copy _x +193 var y/ecx: int <- copy _y +194 x, y <- draw-stream-wrapping-right-then-down screen, stream, xmin, ymin, xmax, ymax, x, y, color, background-color +195 return x, y +196 } +197 +198 # draw a stream in the rectangle from (xmin, ymin) to (xmax, ymax), starting from (x, y), wrapping as necessary +199 # return the next (x, y) coordinate in raster order where drawing stopped +200 # that way the caller can draw more if given the same min and max bounding-box. +201 # if there isn't enough space, truncate +202 fn draw-stream-wrapping-right-then-down screen: (addr screen), stream: (addr stream byte), xmin: int, ymin: int, xmax: int, ymax: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { +203 var xcurr/eax: int <- copy x +204 var ycurr/ecx: int <- copy y +205 var g/ebx: grapheme <- copy 0 206 { -207 break-if-< -208 cursor-x <- copy xmin -209 cursor-y <- increment -210 } -211 cursor-x, cursor-y <- draw-stream-wrapping-right-then-down screen, stream, xmin, ymin, xmax, ymax, cursor-x, cursor-y, color, background-color -212 } -213 -214 fn draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen: (addr screen), stream: (addr stream byte), color: int, background-color: int { -215 var width/eax: int <- copy 0 -216 var height/ecx: int <- copy 0 -217 width, height <- screen-size screen -218 draw-stream-wrapping-right-then-down-from-cursor screen, stream, 0/xmin, 0/ymin, width, height, color, background-color -219 } -220 -221 fn move-cursor-rightward-and-downward screen: (addr screen), xmin: int, xmax: int { -222 var cursor-x/eax: int <- copy 0 -223 var cursor-y/ecx: int <- copy 0 -224 cursor-x, cursor-y <- cursor-position screen -225 cursor-x <- increment -226 compare cursor-x, xmax +207 { +208 var _g/eax: grapheme <- read-grapheme stream +209 g <- copy _g +210 } +211 compare g, 0xffffffff/end-of-file +212 break-if-= +213 xcurr, ycurr <- render-grapheme screen, g, xmin, ymin, xmax, ymax, xcurr, ycurr, color, background-color +214 loop +215 } +216 set-cursor-position screen, xcurr, ycurr +217 return xcurr, ycurr +218 } +219 +220 fn draw-stream-wrapping-right-then-down-from-cursor screen: (addr screen), stream: (addr stream byte), xmin: int, ymin: int, xmax: int, ymax: int, color: int, background-color: int { +221 var cursor-x/eax: int <- copy 0 +222 var cursor-y/ecx: int <- copy 0 +223 cursor-x, cursor-y <- cursor-position screen +224 var end-x/edx: int <- copy cursor-x +225 end-x <- increment +226 compare end-x, xmax 227 { 228 break-if-< 229 cursor-x <- copy xmin 230 cursor-y <- increment 231 } -232 set-cursor-position screen, cursor-x, cursor-y +232 cursor-x, cursor-y <- draw-stream-wrapping-right-then-down screen, stream, xmin, ymin, xmax, ymax, cursor-x, cursor-y, color, background-color 233 } 234 -235 fn draw-text-wrapping-right-then-down-over-full-screen screen: (addr screen), text: (addr array byte), x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { -236 var x2/eax: int <- copy 0 -237 var y2/ecx: int <- copy 0 -238 x2, y2 <- screen-size screen # width, height -239 x2, y2 <- draw-text-wrapping-right-then-down screen, text, 0/xmin, 0/ymin, x2, y2, x, y, color, background-color -240 return x2, y2 # cursor-x, cursor-y -241 } -242 -243 fn draw-text-wrapping-right-then-down-from-cursor screen: (addr screen), text: (addr array byte), xmin: int, ymin: int, xmax: int, ymax: int, color: int, background-color: int { -244 var cursor-x/eax: int <- copy 0 -245 var cursor-y/ecx: int <- copy 0 -246 cursor-x, cursor-y <- cursor-position screen -247 var end-x/edx: int <- copy cursor-x -248 end-x <- increment -249 compare end-x, xmax -250 { -251 break-if-< -252 cursor-x <- copy xmin -253 cursor-y <- increment -254 } -255 cursor-x, cursor-y <- draw-text-wrapping-right-then-down screen, text, xmin, ymin, xmax, ymax, cursor-x, cursor-y, color, background-color -256 } -257 -258 fn draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen: (addr screen), text: (addr array byte), color: int, background-color: int { -259 var width/eax: int <- copy 0 -260 var height/ecx: int <- copy 0 -261 width, height <- screen-size screen -262 draw-text-wrapping-right-then-down-from-cursor screen, text, 0/xmin, 0/ymin, width, height, color, background-color -263 } -264 -265 fn draw-int32-hex-wrapping-right-then-down screen: (addr screen), n: int, xmin: int, ymin: int, xmax: int, ymax: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { -266 var stream-storage: (stream byte 0x100) -267 var stream/esi: (addr stream byte) <- address stream-storage -268 write-int32-hex stream, n -269 var xcurr/edx: int <- copy x -270 var ycurr/ecx: int <- copy y +235 fn draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen: (addr screen), stream: (addr stream byte), color: int, background-color: int { +236 var width/eax: int <- copy 0 +237 var height/ecx: int <- copy 0 +238 width, height <- screen-size screen +239 draw-stream-wrapping-right-then-down-from-cursor screen, stream, 0/xmin, 0/ymin, width, height, color, background-color +240 } +241 +242 fn move-cursor-rightward-and-downward screen: (addr screen), xmin: int, xmax: int { +243 var cursor-x/eax: int <- copy 0 +244 var cursor-y/ecx: int <- copy 0 +245 cursor-x, cursor-y <- cursor-position screen +246 cursor-x <- increment +247 compare cursor-x, xmax +248 { +249 break-if-< +250 cursor-x <- copy xmin +251 cursor-y <- increment +252 } +253 set-cursor-position screen, cursor-x, cursor-y +254 } +255 +256 fn draw-text-wrapping-right-then-down-over-full-screen screen: (addr screen), text: (addr array byte), x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { +257 var x2/eax: int <- copy 0 +258 var y2/ecx: int <- copy 0 +259 x2, y2 <- screen-size screen # width, height +260 x2, y2 <- draw-text-wrapping-right-then-down screen, text, 0/xmin, 0/ymin, x2, y2, x, y, color, background-color +261 return x2, y2 # cursor-x, cursor-y +262 } +263 +264 fn draw-text-wrapping-right-then-down-from-cursor screen: (addr screen), text: (addr array byte), xmin: int, ymin: int, xmax: int, ymax: int, color: int, background-color: int { +265 var cursor-x/eax: int <- copy 0 +266 var cursor-y/ecx: int <- copy 0 +267 cursor-x, cursor-y <- cursor-position screen +268 var end-x/edx: int <- copy cursor-x +269 end-x <- increment +270 compare end-x, xmax 271 { -272 var g/eax: grapheme <- read-grapheme stream -273 compare g, 0xffffffff/end-of-file -274 break-if-= -275 draw-grapheme screen, g, xcurr, ycurr, color, background-color -276 xcurr <- increment -277 compare xcurr, xmax -278 { -279 break-if-< -280 xcurr <- copy xmin -281 ycurr <- increment -282 } -283 loop -284 } -285 set-cursor-position screen, xcurr, ycurr -286 return xcurr, ycurr -287 } -288 -289 fn draw-int32-hex-wrapping-right-then-down-over-full-screen screen: (addr screen), n: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { -290 var x2/eax: int <- copy 0 -291 var y2/ecx: int <- copy 0 -292 x2, y2 <- screen-size screen # width, height -293 x2, y2 <- draw-int32-hex-wrapping-right-then-down screen, n, 0/xmin, 0/ymin, x2, y2, x, y, color, background-color -294 return x2, y2 # cursor-x, cursor-y -295 } -296 -297 fn draw-int32-hex-wrapping-right-then-down-from-cursor screen: (addr screen), n: int, xmin: int, ymin: int, xmax: int, ymax: int, color: int, background-color: int { -298 var cursor-x/eax: int <- copy 0 -299 var cursor-y/ecx: int <- copy 0 -300 cursor-x, cursor-y <- cursor-position screen -301 var end-x/edx: int <- copy cursor-x -302 end-x <- increment -303 compare end-x, xmax -304 { -305 break-if-< -306 cursor-x <- copy xmin -307 cursor-y <- increment -308 } -309 cursor-x, cursor-y <- draw-int32-hex-wrapping-right-then-down screen, n, xmin, ymin, xmax, ymax, cursor-x, cursor-y, color, background-color -310 } -311 -312 fn draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen: (addr screen), n: int, color: int, background-color: int { -313 var width/eax: int <- copy 0 -314 var height/ecx: int <- copy 0 -315 width, height <- screen-size screen -316 draw-int32-hex-wrapping-right-then-down-from-cursor screen, n, 0/xmin, 0/ymin, width, height, color, background-color -317 } -318 -319 fn draw-int32-decimal-wrapping-right-then-down screen: (addr screen), n: int, xmin: int, ymin: int, xmax: int, ymax: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { -320 var stream-storage: (stream byte 0x100) -321 var stream/esi: (addr stream byte) <- address stream-storage -322 write-int32-decimal stream, n -323 var xcurr/edx: int <- copy x -324 var ycurr/ecx: int <- copy y +272 break-if-< +273 cursor-x <- copy xmin +274 cursor-y <- increment +275 } +276 cursor-x, cursor-y <- draw-text-wrapping-right-then-down screen, text, xmin, ymin, xmax, ymax, cursor-x, cursor-y, color, background-color +277 } +278 +279 fn draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen: (addr screen), text: (addr array byte), color: int, background-color: int { +280 var width/eax: int <- copy 0 +281 var height/ecx: int <- copy 0 +282 width, height <- screen-size screen +283 draw-text-wrapping-right-then-down-from-cursor screen, text, 0/xmin, 0/ymin, width, height, color, background-color +284 } +285 +286 fn draw-int32-hex-wrapping-right-then-down screen: (addr screen), n: int, xmin: int, ymin: int, xmax: int, ymax: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { +287 var stream-storage: (stream byte 0x100) +288 var stream/esi: (addr stream byte) <- address stream-storage +289 write-int32-hex stream, n +290 var xcurr/edx: int <- copy x +291 var ycurr/ecx: int <- copy y +292 { +293 var g/eax: grapheme <- read-grapheme stream +294 compare g, 0xffffffff/end-of-file +295 break-if-= +296 draw-grapheme screen, g, xcurr, ycurr, color, background-color +297 xcurr <- increment +298 compare xcurr, xmax +299 { +300 break-if-< +301 xcurr <- copy xmin +302 ycurr <- increment +303 } +304 loop +305 } +306 set-cursor-position screen, xcurr, ycurr +307 return xcurr, ycurr +308 } +309 +310 fn draw-int32-hex-wrapping-right-then-down-over-full-screen screen: (addr screen), n: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { +311 var x2/eax: int <- copy 0 +312 var y2/ecx: int <- copy 0 +313 x2, y2 <- screen-size screen # width, height +314 x2, y2 <- draw-int32-hex-wrapping-right-then-down screen, n, 0/xmin, 0/ymin, x2, y2, x, y, color, background-color +315 return x2, y2 # cursor-x, cursor-y +316 } +317 +318 fn draw-int32-hex-wrapping-right-then-down-from-cursor screen: (addr screen), n: int, xmin: int, ymin: int, xmax: int, ymax: int, color: int, background-color: int { +319 var cursor-x/eax: int <- copy 0 +320 var cursor-y/ecx: int <- copy 0 +321 cursor-x, cursor-y <- cursor-position screen +322 var end-x/edx: int <- copy cursor-x +323 end-x <- increment +324 compare end-x, xmax 325 { -326 var g/eax: grapheme <- read-grapheme stream -327 compare g, 0xffffffff/end-of-file -328 break-if-= -329 draw-grapheme screen, g, xcurr, ycurr, color, background-color -330 xcurr <- increment -331 compare xcurr, xmax -332 { -333 break-if-< -334 xcurr <- copy xmin -335 ycurr <- increment -336 } -337 loop -338 } -339 set-cursor-position screen, xcurr, ycurr -340 return xcurr, ycurr -341 } -342 -343 fn draw-int32-decimal-wrapping-right-then-down-over-full-screen screen: (addr screen), n: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { -344 var x2/eax: int <- copy 0 -345 var y2/ecx: int <- copy 0 -346 x2, y2 <- screen-size screen # width, height -347 x2, y2 <- draw-int32-decimal-wrapping-right-then-down screen, n, 0/xmin, 0/ymin, x2, y2, x, y, color, background-color -348 return x2, y2 # cursor-x, cursor-y -349 } -350 -351 fn draw-int32-decimal-wrapping-right-then-down-from-cursor screen: (addr screen), n: int, xmin: int, ymin: int, xmax: int, ymax: int, color: int, background-color: int { -352 var cursor-x/eax: int <- copy 0 -353 var cursor-y/ecx: int <- copy 0 -354 cursor-x, cursor-y <- cursor-position screen -355 var end-x/edx: int <- copy cursor-x -356 end-x <- increment -357 compare end-x, xmax -358 { -359 break-if-< -360 cursor-x <- copy xmin -361 cursor-y <- increment -362 } -363 cursor-x, cursor-y <- draw-int32-decimal-wrapping-right-then-down screen, n, xmin, ymin, xmax, ymax, cursor-x, cursor-y, color, background-color -364 } -365 -366 fn draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen: (addr screen), n: int, color: int, background-color: int { -367 var width/eax: int <- copy 0 -368 var height/ecx: int <- copy 0 -369 width, height <- screen-size screen -370 draw-int32-decimal-wrapping-right-then-down-from-cursor screen, n, 0/xmin, 0/ymin, width, height, color, background-color -371 } -372 -373 ## Text direction: down then right -374 -375 # draw a single line of text vertically from x, y to ymax -376 # return the next 'y' coordinate -377 # if there isn't enough space, truncate -378 fn draw-text-downward screen: (addr screen), text: (addr array byte), x: int, y: int, ymax: int, color: int, background-color: int -> _/eax: int { -379 var stream-storage: (stream byte 0x100) -380 var stream/esi: (addr stream byte) <- address stream-storage -381 write stream, text -382 var ycurr/eax: int <- draw-stream-downward screen, stream, x, y, ymax, color, background-color -383 return ycurr -384 } -385 -386 # draw a single-line stream vertically from x, y to ymax -387 # return the next 'y' coordinate -388 # if there isn't enough space, truncate -389 fn draw-stream-downward screen: (addr screen), stream: (addr stream byte), x: int, y: int, ymax: int, color: int, background-color: int -> _/eax: int { -390 var ycurr/ecx: int <- copy y -391 { -392 var g/eax: grapheme <- read-grapheme stream -393 compare g, 0xffffffff/end-of-file -394 break-if-= -395 draw-grapheme screen, g, x, ycurr, color, background-color -396 ycurr <- increment -397 loop -398 } -399 set-cursor-position screen, x, ycurr -400 return ycurr -401 } -402 -403 fn draw-text-downward-from-cursor screen: (addr screen), text: (addr array byte), ymax: int, color: int, background-color: int { -404 var cursor-x/eax: int <- copy 0 -405 var cursor-y/ecx: int <- copy 0 -406 cursor-x, cursor-y <- cursor-position screen -407 var result/eax: int <- draw-text-downward screen, text, cursor-x, cursor-y, ymax, color, background-color -408 } -409 -410 # draw text down and right in the rectangle from (xmin, ymin) to (xmax, ymax), starting from (x, y), wrapping as necessary -411 # return the next (x, y) coordinate in raster order where drawing stopped -412 # that way the caller can draw more if given the same min and max bounding-box. -413 # if there isn't enough space, truncate -414 fn draw-text-wrapping-down-then-right screen: (addr screen), text: (addr array byte), xmin: int, ymin: int, xmax: int, ymax: int, _x: int, _y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { -415 var stream-storage: (stream byte 0x100) -416 var stream/esi: (addr stream byte) <- address stream-storage -417 write stream, text -418 var x/eax: int <- copy _x -419 var y/ecx: int <- copy _y -420 x, y <- draw-stream-wrapping-down-then-right screen, stream, xmin, ymin, xmax, ymax, x, y, color, background-color -421 return x, y +326 break-if-< +327 cursor-x <- copy xmin +328 cursor-y <- increment +329 } +330 cursor-x, cursor-y <- draw-int32-hex-wrapping-right-then-down screen, n, xmin, ymin, xmax, ymax, cursor-x, cursor-y, color, background-color +331 } +332 +333 fn draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen: (addr screen), n: int, color: int, background-color: int { +334 var width/eax: int <- copy 0 +335 var height/ecx: int <- copy 0 +336 width, height <- screen-size screen +337 draw-int32-hex-wrapping-right-then-down-from-cursor screen, n, 0/xmin, 0/ymin, width, height, color, background-color +338 } +339 +340 fn draw-int32-decimal-wrapping-right-then-down screen: (addr screen), n: int, xmin: int, ymin: int, xmax: int, ymax: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { +341 var stream-storage: (stream byte 0x100) +342 var stream/esi: (addr stream byte) <- address stream-storage +343 write-int32-decimal stream, n +344 var xcurr/edx: int <- copy x +345 var ycurr/ecx: int <- copy y +346 { +347 var g/eax: grapheme <- read-grapheme stream +348 compare g, 0xffffffff/end-of-file +349 break-if-= +350 draw-grapheme screen, g, xcurr, ycurr, color, background-color +351 xcurr <- increment +352 compare xcurr, xmax +353 { +354 break-if-< +355 xcurr <- copy xmin +356 ycurr <- increment +357 } +358 loop +359 } +360 set-cursor-position screen, xcurr, ycurr +361 return xcurr, ycurr +362 } +363 +364 fn draw-int32-decimal-wrapping-right-then-down-over-full-screen screen: (addr screen), n: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { +365 var x2/eax: int <- copy 0 +366 var y2/ecx: int <- copy 0 +367 x2, y2 <- screen-size screen # width, height +368 x2, y2 <- draw-int32-decimal-wrapping-right-then-down screen, n, 0/xmin, 0/ymin, x2, y2, x, y, color, background-color +369 return x2, y2 # cursor-x, cursor-y +370 } +371 +372 fn draw-int32-decimal-wrapping-right-then-down-from-cursor screen: (addr screen), n: int, xmin: int, ymin: int, xmax: int, ymax: int, color: int, background-color: int { +373 var cursor-x/eax: int <- copy 0 +374 var cursor-y/ecx: int <- copy 0 +375 cursor-x, cursor-y <- cursor-position screen +376 var end-x/edx: int <- copy cursor-x +377 end-x <- increment +378 compare end-x, xmax +379 { +380 break-if-< +381 cursor-x <- copy xmin +382 cursor-y <- increment +383 } +384 cursor-x, cursor-y <- draw-int32-decimal-wrapping-right-then-down screen, n, xmin, ymin, xmax, ymax, cursor-x, cursor-y, color, background-color +385 } +386 +387 fn draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen: (addr screen), n: int, color: int, background-color: int { +388 var width/eax: int <- copy 0 +389 var height/ecx: int <- copy 0 +390 width, height <- screen-size screen +391 draw-int32-decimal-wrapping-right-then-down-from-cursor screen, n, 0/xmin, 0/ymin, width, height, color, background-color +392 } +393 +394 ## Text direction: down then right +395 +396 # draw a single line of text vertically from x, y to ymax +397 # return the next 'y' coordinate +398 # if there isn't enough space, truncate +399 fn draw-text-downward screen: (addr screen), text: (addr array byte), x: int, y: int, ymax: int, color: int, background-color: int -> _/eax: int { +400 var stream-storage: (stream byte 0x100) +401 var stream/esi: (addr stream byte) <- address stream-storage +402 write stream, text +403 var ycurr/eax: int <- draw-stream-downward screen, stream, x, y, ymax, color, background-color +404 return ycurr +405 } +406 +407 # draw a single-line stream vertically from x, y to ymax +408 # return the next 'y' coordinate +409 # if there isn't enough space, truncate +410 fn draw-stream-downward screen: (addr screen), stream: (addr stream byte), x: int, y: int, ymax: int, color: int, background-color: int -> _/eax: int { +411 var ycurr/ecx: int <- copy y +412 { +413 var g/eax: grapheme <- read-grapheme stream +414 compare g, 0xffffffff/end-of-file +415 break-if-= +416 draw-grapheme screen, g, x, ycurr, color, background-color +417 ycurr <- increment +418 loop +419 } +420 set-cursor-position screen, x, ycurr +421 return ycurr 422 } 423 -424 # draw a stream down and right in the rectangle from (xmin, ymin) to (xmax, ymax), starting from (x, y), wrapping as necessary -425 # return the next (x, y) coordinate in raster order where drawing stopped -426 # that way the caller can draw more if given the same min and max bounding-box. -427 # if there isn't enough space, truncate -428 fn draw-stream-wrapping-down-then-right screen: (addr screen), stream: (addr stream byte), xmin: int, ymin: int, xmax: int, ymax: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { -429 var xcurr/edx: int <- copy x -430 var ycurr/ecx: int <- copy y -431 { -432 var g/eax: grapheme <- read-grapheme stream -433 compare g, 0xffffffff/end-of-file -434 break-if-= -435 draw-grapheme screen, g, xcurr, ycurr, color, background-color -436 ycurr <- increment -437 compare ycurr, ymax -438 { -439 break-if-< -440 xcurr <- increment -441 ycurr <- copy ymin -442 } -443 loop -444 } -445 set-cursor-position screen, xcurr, ycurr -446 return xcurr, ycurr -447 } -448 -449 fn draw-text-wrapping-down-then-right-over-full-screen screen: (addr screen), text: (addr array byte), x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { -450 var x2/eax: int <- copy 0 -451 var y2/ecx: int <- copy 0 -452 x2, y2 <- screen-size screen # width, height -453 x2, y2 <- draw-text-wrapping-down-then-right screen, text, 0/xmin, 0/ymin, x2, y2, x, y, color, background-color -454 return x2, y2 # cursor-x, cursor-y -455 } -456 -457 fn draw-text-wrapping-down-then-right-from-cursor screen: (addr screen), text: (addr array byte), xmin: int, ymin: int, xmax: int, ymax: int, color: int, background-color: int { -458 var cursor-x/eax: int <- copy 0 -459 var cursor-y/ecx: int <- copy 0 -460 cursor-x, cursor-y <- cursor-position screen -461 var end-y/edx: int <- copy cursor-y -462 end-y <- increment -463 compare end-y, ymax -464 { -465 break-if-< -466 cursor-x <- increment -467 cursor-y <- copy ymin -468 } -469 cursor-x, cursor-y <- draw-text-wrapping-down-then-right screen, text, xmin, ymin, xmax, ymax, cursor-x, cursor-y, color, background-color -470 } -471 -472 fn draw-text-wrapping-down-then-right-from-cursor-over-full-screen screen: (addr screen), text: (addr array byte), color: int, background-color: int { -473 var width/eax: int <- copy 0 -474 var height/ecx: int <- copy 0 -475 width, height <- screen-size screen -476 draw-text-wrapping-down-then-right-from-cursor screen, text, 0/xmin, 0/ymin, width, height, color, background-color -477 } +424 fn draw-text-downward-from-cursor screen: (addr screen), text: (addr array byte), ymax: int, color: int, background-color: int { +425 var cursor-x/eax: int <- copy 0 +426 var cursor-y/ecx: int <- copy 0 +427 cursor-x, cursor-y <- cursor-position screen +428 var result/eax: int <- draw-text-downward screen, text, cursor-x, cursor-y, ymax, color, background-color +429 } +430 +431 # draw text down and right in the rectangle from (xmin, ymin) to (xmax, ymax), starting from (x, y), wrapping as necessary +432 # return the next (x, y) coordinate in raster order where drawing stopped +433 # that way the caller can draw more if given the same min and max bounding-box. +434 # if there isn't enough space, truncate +435 fn draw-text-wrapping-down-then-right screen: (addr screen), text: (addr array byte), xmin: int, ymin: int, xmax: int, ymax: int, _x: int, _y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { +436 var stream-storage: (stream byte 0x100) +437 var stream/esi: (addr stream byte) <- address stream-storage +438 write stream, text +439 var x/eax: int <- copy _x +440 var y/ecx: int <- copy _y +441 x, y <- draw-stream-wrapping-down-then-right screen, stream, xmin, ymin, xmax, ymax, x, y, color, background-color +442 return x, y +443 } +444 +445 # draw a stream down and right in the rectangle from (xmin, ymin) to (xmax, ymax), starting from (x, y), wrapping as necessary +446 # return the next (x, y) coordinate in raster order where drawing stopped +447 # that way the caller can draw more if given the same min and max bounding-box. +448 # if there isn't enough space, truncate +449 fn draw-stream-wrapping-down-then-right screen: (addr screen), stream: (addr stream byte), xmin: int, ymin: int, xmax: int, ymax: int, x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { +450 var xcurr/edx: int <- copy x +451 var ycurr/ecx: int <- copy y +452 { +453 var g/eax: grapheme <- read-grapheme stream +454 compare g, 0xffffffff/end-of-file +455 break-if-= +456 draw-grapheme screen, g, xcurr, ycurr, color, background-color +457 ycurr <- increment +458 compare ycurr, ymax +459 { +460 break-if-< +461 xcurr <- increment +462 ycurr <- copy ymin +463 } +464 loop +465 } +466 set-cursor-position screen, xcurr, ycurr +467 return xcurr, ycurr +468 } +469 +470 fn draw-text-wrapping-down-then-right-over-full-screen screen: (addr screen), text: (addr array byte), x: int, y: int, color: int, background-color: int -> _/eax: int, _/ecx: int { +471 var x2/eax: int <- copy 0 +472 var y2/ecx: int <- copy 0 +473 x2, y2 <- screen-size screen # width, height +474 x2, y2 <- draw-text-wrapping-down-then-right screen, text, 0/xmin, 0/ymin, x2, y2, x, y, color, background-color +475 return x2, y2 # cursor-x, cursor-y +476 } +477 +478 fn draw-text-wrapping-down-then-right-from-cursor screen: (addr screen), text: (addr array byte), xmin: int, ymin: int, xmax: int, ymax: int, color: int, background-color: int { +479 var cursor-x/eax: int <- copy 0 +480 var cursor-y/ecx: int <- copy 0 +481 cursor-x, cursor-y <- cursor-position screen +482 var end-y/edx: int <- copy cursor-y +483 end-y <- increment +484 compare end-y, ymax +485 { +486 break-if-< +487 cursor-x <- increment +488 cursor-y <- copy ymin +489 } +490 cursor-x, cursor-y <- draw-text-wrapping-down-then-right screen, text, xmin, ymin, xmax, ymax, cursor-x, cursor-y, color, background-color +491 } +492 +493 fn draw-text-wrapping-down-then-right-from-cursor-over-full-screen screen: (addr screen), text: (addr array byte), color: int, background-color: int { +494 var width/eax: int <- copy 0 +495 var height/ecx: int <- copy 0 +496 width, height <- screen-size screen +497 draw-text-wrapping-down-then-right-from-cursor screen, text, 0/xmin, 0/ymin, width, height, color, background-color +498 } diff --git a/html/502test.mu.html b/html/502test.mu.html index 98bb9ede..edb32774 100644 --- a/html/502test.mu.html +++ b/html/502test.mu.html @@ -63,10 +63,10 @@ if ('onhashchange' in window) { 4 compare a, b 5 { 6 break-if-!= - 7 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg + 7 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg 8 return 9 } -10 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg +10 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg 11 move-cursor-to-left-margin-of-next-line 0/screen 12 count-test-failure 13 } @@ -80,10 +80,10 @@ if ('onhashchange' in window) { 21 compare a, 0/false 22 { 23 break-if-= -24 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg +24 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg 25 return 26 } -27 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg +27 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg 28 move-cursor-to-left-margin-of-next-line 0/screen 29 count-test-failure 30 } @@ -93,10 +93,10 @@ if ('onhashchange' in window) { 34 compare a, 0/false 35 { 36 break-if-!= -37 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg +37 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg 38 return 39 } -40 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg +40 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg 41 move-cursor-to-left-margin-of-next-line 0/screen 42 count-test-failure 43 } diff --git a/html/504test-screen.mu.html b/html/504test-screen.mu.html index bee33f6b..32122ddf 100644 --- a/html/504test-screen.mu.html +++ b/html/504test-screen.mu.html @@ -78,7 +78,7 @@ if ('onhashchange' in window) { 19 var done?/eax: boolean <- stream-empty? e-addr 20 compare done?, 0 21 break-if-!= - 22 var _g/eax: grapheme <- screen-grapheme-at-idx screen, idx + 22 var _g/eax: grapheme <- screen-grapheme-at-idx screen, idx 23 var g/ebx: grapheme <- copy _g 24 var expected-grapheme/eax: grapheme <- read-grapheme e-addr 25 # compare graphemes @@ -94,23 +94,23 @@ if ('onhashchange' in window) { 35 compare g, expected-grapheme 36 { 37 break-if-!= - 38 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg + 38 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg 39 break $check-screen-row-from:compare-graphemes 40 } 41 # otherwise print an error 42 count-test-failure - 43 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg - 44 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg + 43 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg + 44 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg 45 draw-grapheme-at-cursor 0/screen, expected-grapheme, 3/cyan, 0/bg - 46 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width - 47 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg - 48 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg - 49 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg - 50 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg - 51 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") but observed '", 3/fg/cyan, 0/bg + 46 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width + 47 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg + 48 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg + 49 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg + 50 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg + 51 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") but observed '", 3/fg/cyan, 0/bg 52 draw-grapheme-at-cursor 0/screen, g, 3/cyan, 0/bg - 53 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width - 54 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "'", 3/fg/cyan, 0/bg + 53 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width + 54 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "'", 3/fg/cyan, 0/bg 55 move-cursor-to-left-margin-of-next-line 0/screen 56 } 57 idx <- increment @@ -136,7 +136,7 @@ if ('onhashchange' in window) { 77 var done?/eax: boolean <- stream-empty? e-addr 78 compare done?, 0 79 break-if-!= - 80 var _g/eax: grapheme <- screen-grapheme-at-idx screen, idx + 80 var _g/eax: grapheme <- screen-grapheme-at-idx screen, idx 81 var g/ebx: grapheme <- copy _g 82 var _expected-grapheme/eax: grapheme <- read-grapheme e-addr 83 var expected-grapheme/edi: grapheme <- copy _expected-grapheme @@ -152,7 +152,7 @@ if ('onhashchange' in window) { 93 { 94 compare expected-grapheme, 0x20 95 break-if-!= - 96 var color/eax: int <- screen-color-at-idx screen, idx + 96 var color/eax: int <- screen-color-at-idx screen, idx 97 compare color, fg 98 break-if-!= $check-screen-row-in-color-from:compare-cells 99 } @@ -162,47 +162,47 @@ if ('onhashchange' in window) { 103 compare g, expected-grapheme 104 { 105 break-if-!= -106 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg +106 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg 107 break $check-screen-row-in-color-from:compare-graphemes 108 } 109 # otherwise print an error 110 count-test-failure -111 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg -112 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg +111 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg +112 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg 113 draw-grapheme-at-cursor 0/screen, expected-grapheme, 3/cyan, 0/bg -114 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width -115 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg -116 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg -117 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg -118 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg -119 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") but observed '", 3/fg/cyan, 0/bg +114 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width +115 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg +116 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg +117 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg +118 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg +119 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") but observed '", 3/fg/cyan, 0/bg 120 draw-grapheme-at-cursor 0/screen, g, 3/cyan, 0/bg -121 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width -122 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "'", 3/fg/cyan, 0/bg +121 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width +122 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "'", 3/fg/cyan, 0/bg 123 move-cursor-to-left-margin-of-next-line 0/screen 124 } 125 $check-screen-row-in-color-from:compare-colors: { -126 var color/eax: int <- screen-color-at-idx screen, idx +126 var color/eax: int <- screen-color-at-idx screen, idx 127 compare fg, color 128 { 129 break-if-!= -130 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg +130 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg 131 break $check-screen-row-in-color-from:compare-colors 132 } 133 # otherwise print an error 134 count-test-failure -135 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg -136 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg +135 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg +136 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg 137 draw-grapheme-at-cursor 0/screen, expected-grapheme, 3/cyan, 0/bg -138 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width -139 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg -140 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg -141 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg -142 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg -143 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") in color ", 3/fg/cyan, 0/bg -144 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, fg, 3/fg/cyan, 0/bg -145 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " but observed color ", 3/fg/cyan, 0/bg -146 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, color, 3/fg/cyan, 0/bg +138 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width +139 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg +140 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg +141 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg +142 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg +143 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") in color ", 3/fg/cyan, 0/bg +144 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, fg, 3/fg/cyan, 0/bg +145 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " but observed color ", 3/fg/cyan, 0/bg +146 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, color, 3/fg/cyan, 0/bg 147 move-cursor-to-left-margin-of-next-line 0/screen 148 } 149 } @@ -227,7 +227,7 @@ if ('onhashchange' in window) { 168 var done?/eax: boolean <- stream-empty? e-addr 169 compare done?, 0 170 break-if-!= -171 var _g/eax: grapheme <- screen-grapheme-at-idx screen, idx +171 var _g/eax: grapheme <- screen-grapheme-at-idx screen, idx 172 var g/ebx: grapheme <- copy _g 173 var _expected-grapheme/eax: grapheme <- read-grapheme e-addr 174 var expected-grapheme/edi: grapheme <- copy _expected-grapheme @@ -243,7 +243,7 @@ if ('onhashchange' in window) { 184 { 185 compare expected-grapheme, 0x20 186 break-if-!= -187 var background-color/eax: int <- screen-background-color-at-idx screen, idx +187 var background-color/eax: int <- screen-background-color-at-idx screen, idx 188 compare background-color, bg 189 break-if-!= $check-screen-row-in-background-color-from:compare-cells 190 } @@ -253,48 +253,48 @@ if ('onhashchange' in window) { 194 compare g, expected-grapheme 195 { 196 break-if-!= -197 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg +197 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg 198 break $check-screen-row-in-background-color-from:compare-graphemes 199 } 200 # otherwise print an error 201 count-test-failure -202 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg -203 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg +202 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg +203 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg 204 draw-grapheme-at-cursor 0/screen, expected-grapheme, 3/cyan, 0/bg -205 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width -206 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg -207 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg -208 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg -209 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg -210 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") but observed '", 3/fg/cyan, 0/bg +205 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width +206 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg +207 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg +208 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg +209 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg +210 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") but observed '", 3/fg/cyan, 0/bg 211 draw-grapheme-at-cursor 0/screen, g, 3/cyan, 0/bg -212 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width -213 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "'", 3/fg/cyan, 0/bg +212 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width +213 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "'", 3/fg/cyan, 0/bg 214 move-cursor-to-left-margin-of-next-line 0/screen 215 break $check-screen-row-in-background-color-from:compare-graphemes 216 } 217 $check-screen-row-in-background-color-from:compare-background-colors: { -218 var background-color/eax: int <- screen-background-color-at-idx screen, idx +218 var background-color/eax: int <- screen-background-color-at-idx screen, idx 219 compare bg, background-color 220 { 221 break-if-!= -222 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg +222 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ".", 3/fg/cyan, 0/bg 223 break $check-screen-row-in-background-color-from:compare-background-colors 224 } 225 # otherwise print an error 226 count-test-failure -227 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg -228 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg +227 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg +228 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected '", 3/fg/cyan, 0/bg 229 draw-grapheme-at-cursor 0/screen, expected-grapheme, 3/cyan, 0/bg -230 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width -231 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg -232 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg -233 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg -234 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg -235 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") in background-color ", 3/fg/cyan, 0/bg -236 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, bg, 3/fg/cyan, 0/bg -237 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " but observed background-color ", 3/fg/cyan, 0/bg -238 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, background-color, 3/fg/cyan, 0/bg +230 move-cursor-rightward-and-downward 0/screen, 0/xmin, 0x80/xmax=screen-width +231 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "' at (", 3/fg/cyan, 0/bg +232 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg +233 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg +234 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg +235 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") in background-color ", 3/fg/cyan, 0/bg +236 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, bg, 3/fg/cyan, 0/bg +237 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " but observed background-color ", 3/fg/cyan, 0/bg +238 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, background-color, 3/fg/cyan, 0/bg 239 move-cursor-to-left-margin-of-next-line 0/screen 240 } 241 } @@ -325,7 +325,7 @@ if ('onhashchange' in window) { 266 var _expected-bit/eax: grapheme <- read-grapheme e-addr 267 var expected-bit/edi: grapheme <- copy _expected-bit 268 $check-background-color-in-screen-row-from:compare-cells: { -269 var background-color/eax: int <- screen-background-color-at-idx screen, idx +269 var background-color/eax: int <- screen-background-color-at-idx screen, idx 270 # if expected-bit is space, assert that background is NOT bg 271 compare expected-bit, 0x20 272 { @@ -333,13 +333,13 @@ if ('onhashchange' in window) { 274 compare background-color, bg 275 break-if-!= $check-background-color-in-screen-row-from:compare-cells 276 count-test-failure -277 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg -278 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected (", 3/fg/cyan, 0/bg -279 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg -280 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg -281 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg -282 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") to not be in background-color ", 3/fg/cyan, 0/bg -283 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, bg, 3/fg/cyan, 0/bg +277 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg +278 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected (", 3/fg/cyan, 0/bg +279 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg +280 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg +281 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg +282 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") to not be in background-color ", 3/fg/cyan, 0/bg +283 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, bg, 3/fg/cyan, 0/bg 284 move-cursor-to-left-margin-of-next-line 0/screen 285 break $check-background-color-in-screen-row-from:compare-cells 286 } @@ -347,15 +347,15 @@ if ('onhashchange' in window) { 288 compare background-color, bg 289 break-if-= $check-background-color-in-screen-row-from:compare-cells 290 count-test-failure -291 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg -292 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected (", 3/fg/cyan, 0/bg -293 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg -294 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg -295 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg -296 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") in background-color ", 3/fg/cyan, 0/bg -297 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, bg, 3/fg/cyan, 0/bg -298 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " but observed background-color ", 3/fg/cyan, 0/bg -299 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, background-color, 3/fg/cyan, 0/bg +291 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, msg, 3/fg/cyan, 0/bg +292 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ": expected (", 3/fg/cyan, 0/bg +293 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, x, 3/fg/cyan, 0/bg +294 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ", ", 3/fg/cyan, 0/bg +295 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, y, 3/fg/cyan, 0/bg +296 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, ") in background-color ", 3/fg/cyan, 0/bg +297 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, bg, 3/fg/cyan, 0/bg +298 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " but observed background-color ", 3/fg/cyan, 0/bg +299 draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, background-color, 3/fg/cyan, 0/bg 300 move-cursor-to-left-margin-of-next-line 0/screen 301 } 302 idx <- increment @@ -379,7 +379,7 @@ if ('onhashchange' in window) { 320 var screen-on-stack: screen 321 var screen/esi: (addr screen) <- address screen-on-stack 322 initialize-screen screen, 0x10/rows, 4/cols, 0/no-pixel-graphics -323 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, "Hello, 世界", 1/fg, 2/bg +323 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, "Hello, 世界", 1/fg, 2/bg 324 check-screen-row screen, 0/y, "Hello, 世界", "F - test-draw-multiple-graphemes" 325 check-screen-row-in-color screen, 1/fg, 0/y, "Hello, 世界", "F - test-draw-multiple-graphemes-fg" 326 check-background-color-in-screen-row screen, 2/bg, 0/y, "xxxxxxxxx ", "F - test-draw-multiple-graphemes-bg2" diff --git a/html/507line.mu.html b/html/507line.mu.html index df492c93..76910f05 100644 --- a/html/507line.mu.html +++ b/html/507line.mu.html @@ -87,7 +87,7 @@ if ('onhashchange' in window) { 29 var x/ecx: int <- copy x0 30 var y/edx: int <- copy y0 31 $draw-line:loop: { - 32 pixel screen, x, y, color + 32 pixel screen, x, y, color 33 # if (x == x1 && y == y1) break 34 { 35 compare x, x1 @@ -124,7 +124,7 @@ if ('onhashchange' in window) { 66 { 67 compare x, x1 68 break-if->= - 69 pixel screen, x, y, color + 69 pixel screen, x, y, color 70 x <- increment 71 loop 72 } @@ -135,7 +135,7 @@ if ('onhashchange' in window) { 77 { 78 compare y, y1 79 break-if->= - 80 pixel screen, x, y, color + 80 pixel screen, x, y, color 81 y <- increment 82 loop 83 } diff --git a/html/508circle.mu.html b/html/508circle.mu.html index c33aca77..e64f840d 100644 --- a/html/508circle.mu.html +++ b/html/508circle.mu.html @@ -79,25 +79,25 @@ if ('onhashchange' in window) { 21 tmpx <- subtract x 22 tmpy <- copy cy 23 tmpy <- add y -24 pixel screen, tmpx, tmpy, color +24 pixel screen, tmpx, tmpy, color 25 # pixel(cx-y, cy-x) 26 tmpx <- copy cx 27 tmpx <- subtract y 28 tmpy <- copy cy 29 tmpy <- subtract x -30 pixel screen, tmpx, tmpy, color +30 pixel screen, tmpx, tmpy, color 31 # pixel(cx+x, cy-y) 32 tmpx <- copy cx 33 tmpx <- add x 34 tmpy <- copy cy 35 tmpy <- subtract y -36 pixel screen, tmpx, tmpy, color +36 pixel screen, tmpx, tmpy, color 37 # pixel(cx+y, cy+x) 38 tmpx <- copy cx 39 tmpx <- add y 40 tmpy <- copy cy 41 tmpy <- add x -42 pixel screen, tmpx, tmpy, color +42 pixel screen, tmpx, tmpy, color 43 # r = err 44 tmp <- copy err 45 copy-to radius, tmp diff --git a/html/509bezier.mu.html b/html/509bezier.mu.html index c7e376eb..a956621f 100644 --- a/html/509bezier.mu.html +++ b/html/509bezier.mu.html @@ -293,7 +293,7 @@ if ('onhashchange' in window) { 235 err-f <- add xy-f 236 # 237 $draw-monotonic-bezier:loop: { -238 pixel screen, x, y, color +238 pixel screen, x, y, color 239 # if (x == x2 && y == y2) return 240 { 241 compare x, x2 diff --git a/html/boot.subx.html b/html/boot.subx.html index 221fe044..7d3914d3 100644 --- a/html/boot.subx.html +++ b/html/boot.subx.html @@ -130,678 +130,692 @@ if ('onhashchange' in window) { 70 b4/copy-to-ah 2/imm8/read-drive 71 # dl comes conveniently initialized at boot time with the index of the device being booted 72 b5/copy-to-ch 0/imm8/cylinder - 73 b6/copy-to-dh 0/imm8/head + 73 b6/copy-to-dh 0/imm8/head # <==== 74 b1/copy-to-cl 2/imm8/sector # 1-based 75 b0/copy-to-al 0x7d/imm8/num-sectors # 2*63 - 1 = 125 76 # address to write sectors to = es:bx = 0x7e00, contiguous with boot segment 77 bb/copy-to-bx 0/imm16 78 8e/->seg 3/mod/direct 3/rm32/bx 0/r32/es - 79 bb/copy-to-bx 0x7e00/imm16 + 79 bb/copy-to-bx 0x7e00/imm16 # <==== 80 cd/syscall 0x13/imm8/bios-disk-services - 81 0f 82/jump-if-carry disk_error/disp16 + 81 0f 82/jump-if-carry disk_error/disp16 82 83 # load two more tracks of disk into addresses [0x17800, 0x27400) 84 b4/copy-to-ah 2/imm8/read-drive 85 # dl comes conveniently initialized at boot time with the index of the device being booted 86 b5/copy-to-ch 0/imm8/cylinder - 87 b6/copy-to-dh 2/imm8/head + 87 b6/copy-to-dh 2/imm8/head # <==== 88 b1/copy-to-cl 1/imm8/sector # 1-based 89 b0/copy-to-al 0x7e/imm8/num-sectors # 2*63 = 126 90 # address to write sectors to = es:bx = 0x17800, contiguous with boot segment - 91 bb/copy-to-bx 0x1780/imm16 + 91 bb/copy-to-bx 0x1780/imm16 # <==== 92 8e/->seg 3/mod/direct 3/rm32/bx 0/r32/es 93 bb/copy-to-bx 0/imm16 94 cd/syscall 0x13/imm8/bios-disk-services - 95 0f 82/jump-if-carry disk_error/disp16 + 95 0f 82/jump-if-carry disk_error/disp16 96 97 # load two more tracks of disk into addresses [0x27400, 0x37000) 98 b4/copy-to-ah 2/imm8/read-drive 99 # dl comes conveniently initialized at boot time with the index of the device being booted 100 b5/copy-to-ch 0/imm8/cylinder - 101 b6/copy-to-dh 4/imm8/head + 101 b6/copy-to-dh 4/imm8/head # <==== 102 b1/copy-to-cl 1/imm8/sector # 1-based 103 b0/copy-to-al 0x7e/imm8/num-sectors # 2*63 = 126 104 # address to write sectors to = es:bx = 0x27400, contiguous with boot segment - 105 bb/copy-to-bx 0x2740/imm16 + 105 bb/copy-to-bx 0x2740/imm16 # <==== 106 8e/->seg 3/mod/direct 3/rm32/bx 0/r32/es 107 bb/copy-to-bx 0/imm16 108 cd/syscall 0x13/imm8/bios-disk-services - 109 0f 82/jump-if-carry disk_error/disp16 + 109 0f 82/jump-if-carry disk_error/disp16 110 111 # load two more tracks of disk into addresses [0x37000, 0x46c00) 112 b4/copy-to-ah 2/imm8/read-drive 113 # dl comes conveniently initialized at boot time with the index of the device being booted 114 b5/copy-to-ch 0/imm8/cylinder - 115 b6/copy-to-dh 6/imm8/head + 115 b6/copy-to-dh 6/imm8/head # <==== 116 b1/copy-to-cl 1/imm8/sector # 1-based 117 b0/copy-to-al 0x7e/imm8/num-sectors # 2*63 = 126 118 # address to write sectors to = es:bx = 0x37000, contiguous with boot segment - 119 bb/copy-to-bx 0x3700/imm16 + 119 bb/copy-to-bx 0x3700/imm16 # <==== 120 8e/->seg 3/mod/direct 3/rm32/bx 0/r32/es 121 bb/copy-to-bx 0/imm16 122 cd/syscall 0x13/imm8/bios-disk-services - 123 0f 82/jump-if-carry disk_error/disp16 + 123 0f 82/jump-if-carry disk_error/disp16 124 - 125 # reset es - 126 bb/copy-to-bx 0/imm16 - 127 8e/->seg 3/mod/direct 3/rm32/bx 0/r32/es - 128 - 129 # adjust video mode - 130 b4/copy-to-ah 0x4f/imm8 # VBE commands - 131 b0/copy-to-al 2/imm8 # set video mode - 132 bb/copy-to-bx 0x4105/imm16 # 0x0105 | 0x4000 - 133 # 0x0105 = graphics mode 1024x768x256 - 134 # (alternative candidate: 0x0101 for 640x480x256) - 135 # 0x4000 bit = configure linear frame buffer in Bochs emulator; hopefully this doesn't hurt anything when running natively - 136 cd/syscall 0x10/imm8/bios-video-services - 137 - 138 # load information for the (hopefully) current video mode - 139 # mostly just for the address to the linear frame buffer - 140 b4/copy-to-ah 0x4f/imm8 # VBE commands - 141 b0/copy-to-al 1/imm8 # get video mode info - 142 b9/copy-to-cx 0x0105/imm16 # mode we requested - 143 bf/copy-to-di Video-mode-info/imm16 - 144 cd/syscall 0x10/imm8/bios-video-services - 145 - 146 ## switch to 32-bit mode - 147 # load global descriptor table - 148 # We can't refer to the label directly because SubX doesn't do the right - 149 # thing for lgdt, so rather than make errors worse in most places we instead - 150 # pin gdt_descriptor below. - 151 0f 01 2/subop/lgdt 0/mod/indirect 6/rm32/use-disp16 0x7ce0/disp16/gdt_descriptor - 152 # enable paging - 153 0f 20/<-cr 3/mod/direct 0/rm32/eax 0/r32/cr0 - 154 66 83 1/subop/or 3/mod/direct 0/rm32/eax 1/imm8 # eax <- or 0x1 - 155 0f 22/->cr 3/mod/direct 0/rm32/eax 0/r32/cr0 - 156 # far jump to initialize_32bit_mode that sets cs to offset 8 in the gdt in the process - 157 # We can't refer to the label directly because SubX doesn't have syntax for - 158 # segment selectors. So we instead pin initialize_32bit_mode below. - 159 ea/jump-far-absolute 0x00087d00/disp32 # address 0x7d00 in offset 8 of the gdt - 160 - 161 disk_error: - 162 # print 'D' to top-left of screen to indicate disk error - 163 # *0xb8000 <- 0x0f44 - 164 bb/copy-to-bx 0xb800/imm16 - 165 8e/->seg 3/mod/direct 3/rm32/bx 3/r32/ds - 166 b0/copy-to-al 0x44/imm8/D - 167 b4/copy-to-ah 0x0f/imm8/white-on-black - 168 bb/copy-to-bx 0/imm16 - 169 89/<- 0/mod/indirect 7/rm32/bx 0/r32/ax # *ds:bx <- ax - 170 # loop forever - 171 { - 172 eb/jump loop/disp8 - 173 } + 125 # load two more tracks of disk into addresses [0x46c00, 0x56800) + 126 b4/copy-to-ah 2/imm8/read-drive + 127 # dl comes conveniently initialized at boot time with the index of the device being booted + 128 b5/copy-to-ch 0/imm8/cylinder + 129 b6/copy-to-dh 8/imm8/head # <==== + 130 b1/copy-to-cl 1/imm8/sector # 1-based + 131 b0/copy-to-al 0x7e/imm8/num-sectors # 2*63 = 126 + 132 # address to write sectors to = es:bx = 0x46c00, contiguous with boot segment + 133 bb/copy-to-bx 0x46c0/imm16 # <==== + 134 8e/->seg 3/mod/direct 3/rm32/bx 0/r32/es + 135 bb/copy-to-bx 0/imm16 + 136 cd/syscall 0x13/imm8/bios-disk-services + 137 0f 82/jump-if-carry disk_error/disp16 + 138 + 139 # reset es + 140 bb/copy-to-bx 0/imm16 + 141 8e/->seg 3/mod/direct 3/rm32/bx 0/r32/es + 142 + 143 # adjust video mode + 144 b4/copy-to-ah 0x4f/imm8 # VBE commands + 145 b0/copy-to-al 2/imm8 # set video mode + 146 bb/copy-to-bx 0x4105/imm16 # 0x0105 | 0x4000 + 147 # 0x0105 = graphics mode 1024x768x256 + 148 # (alternative candidate: 0x0101 for 640x480x256) + 149 # 0x4000 bit = configure linear frame buffer in Bochs emulator; hopefully this doesn't hurt anything when running natively + 150 cd/syscall 0x10/imm8/bios-video-services + 151 + 152 # load information for the (hopefully) current video mode + 153 # mostly just for the address to the linear frame buffer + 154 b4/copy-to-ah 0x4f/imm8 # VBE commands + 155 b0/copy-to-al 1/imm8 # get video mode info + 156 b9/copy-to-cx 0x0105/imm16 # mode we requested + 157 bf/copy-to-di Video-mode-info/imm16 + 158 cd/syscall 0x10/imm8/bios-video-services + 159 + 160 ## switch to 32-bit mode + 161 # load global descriptor table + 162 # We can't refer to the label directly because SubX doesn't do the right + 163 # thing for lgdt, so rather than make errors worse in most places we instead + 164 # pin gdt_descriptor below. + 165 0f 01 2/subop/lgdt 0/mod/indirect 6/rm32/use-disp16 0x7ce0/disp16/gdt_descriptor + 166 # enable paging + 167 0f 20/<-cr 3/mod/direct 0/rm32/eax 0/r32/cr0 + 168 66 83 1/subop/or 3/mod/direct 0/rm32/eax 1/imm8 # eax <- or 0x1 + 169 0f 22/->cr 3/mod/direct 0/rm32/eax 0/r32/cr0 + 170 # far jump to initialize_32bit_mode that sets cs to offset 8 in the gdt in the process + 171 # We can't refer to the label directly because SubX doesn't have syntax for + 172 # segment selectors. So we instead pin initialize_32bit_mode below. + 173 ea/jump-far-absolute 0x00087d00/disp32 # address 0x7d00 in offset 8 of the gdt 174 - 175 ## GDT: 3 records of 8 bytes each - 176 == data 0x7ce0 - 177 gdt_descriptor: - 178 0x17/imm16 # final index of gdt = size of gdt - 1 - 179 gdt_start/imm32/start - 180 - 181 gdt_start: - 182 # offset 0: gdt_null: mandatory null descriptor - 183 00 00 00 00 00 00 00 00 - 184 # offset 8: gdt_code - 185 ff ff # limit[0:16] - 186 00 00 00 # base[0:24] - 187 9a # 1/present 00/privilege 1/descriptor type = 1001b - 188 # 1/code 0/conforming 1/readable 0/accessed = 1010b - 189 cf # 1/granularity 1/32-bit 0/64-bit-segment 0/AVL = 1100b - 190 # limit[16:20] = 1111b - 191 00 # base[24:32] - 192 # offset 16: gdt_data - 193 ff ff # limit[0:16] - 194 00 00 00 # base[0:24] - 195 92 # 1/present 00/privilege 1/descriptor type = 1001b - 196 # 0/data 0/conforming 1/readable 0/accessed = 0010b - 197 cf # same as gdt_code - 198 00 # base[24:32] - 199 # gdt_end: - 200 - 201 ## 32-bit code from this point - 202 - 203 == code 0x7d00 - 204 initialize_32bit_mode: - 205 66 b8/copy-to-ax 0x10/imm16 # offset 16 from gdt_start - 206 8e/->seg 3/mod/direct 0/rm32/ax 3/r32/ds - 207 8e/->seg 3/mod/direct 0/rm32/ax 2/r32/ss - 208 8e/->seg 3/mod/direct 0/rm32/ax 0/r32/es - 209 8e/->seg 3/mod/direct 0/rm32/ax 4/r32/fs - 210 8e/->seg 3/mod/direct 0/rm32/ax 5/r32/gs - 211 - 212 bc/copy-to-esp 0x02000000/imm32 - 213 - 214 ## load interrupt handlers - 215 # We can't refer to the label directly because SubX doesn't do the right - 216 # thing for lidt, so rather than make errors worse in most places we instead - 217 # pin idt_descriptor below. - 218 0f 01 3/subop/lidt 0/mod/indirect 5/rm32/use-disp32 0x7e00/disp32/idt_descriptor - 219 - 220 # For now, not bothering reprogramming the IRQ to not conflict with software - 221 # exceptions. - 222 # https://wiki.osdev.org/index.php?title=8259_PIC&oldid=24650#Protected_Mode - 223 # - 224 # Interrupt 1 (keyboard) conflicts with debugger faults. We don't use a - 225 # debugger. - 226 # Reference: - 227 # https://wiki.osdev.org/Exceptions - 228 - 229 # enable timer IRQ0 and keyboard IRQ1 - 230 b0/copy-to-al 0xfc/imm8 # disable mask for IRQ0 and IRQ1 - 231 e6/write-al-into-port 0x21/imm8 - 232 - 233 fb/enable-interrupts - 234 - 235 (initialize-mouse) - 236 - 237 ## enable floating point - 238 db/floating-point-coprocessor e3/initialize - 239 # eax <- cr4 - 240 0f 20/<-cr 3/mod/direct 0/rm32/eax 4/r32/cr4 - 241 # eax <- or bit 9 - 242 0f ba/bit-test 5/subop/bit-test-and-set 3/mod/direct 0/rm32/eax 9/imm8 - 243 # cr4 <- eax - 244 0f 22/->cr 3/mod/direct 0/rm32/eax 4/r32/cr4 - 245 - 246 e9/jump Entry/disp32 - 247 - 248 == boot-sector-marker 0x7dfe - 249 # final 2 bytes of boot sector - 250 55 aa - 251 - 252 ## sector 2 onwards loaded by load_disk, not automatically on boot - 253 - 254 == data 0x7e00 - 255 idt_descriptor: - 256 ff 03 # final index of idt = size of idt - 1 - 257 idt_start/imm32/start - 258 - 259 +-- 55 lines: # interrupt descriptor table ---------------------------------------------------------------------------------------------------------------------------------------------- - 314 - 315 == code - 316 - 317 null-interrupt-handler: - 318 # prologue - 319 # Don't disable interrupts; the timer has the highest priority anyway, - 320 # and this interrupt triggers extremely frequently. - 321 fa/disable-interrupts - 322 60/push-all-registers - 323 9c/push-flags - 324 # acknowledge interrupt - 325 b0/copy-to-al 0x20/imm8 - 326 e6/write-al-into-port 0x20/imm8 - 327 31/xor %eax 0/r32/eax - 328 $null-interrupt-handler:epilogue: - 329 # epilogue - 330 9d/pop-flags - 331 61/pop-all-registers - 332 fb/enable-interrupts - 333 cf/return-from-interrupt - 334 - 335 timer-interrupt-handler: - 336 # prologue - 337 # Don't disable interrupts; the timer has the highest priority anyway, - 338 # and this interrupt triggers extremely frequently. - 339 fa/disable-interrupts - 340 60/push-all-registers - 341 9c/push-flags - 342 # acknowledge interrupt - 343 b0/copy-to-al 0x20/imm8 - 344 e6/write-al-into-port 0x20/imm8 - 345 31/xor %eax 0/r32/eax - 346 $timer-interrupt-handler:epilogue: - 347 # epilogue - 348 9d/pop-flags - 349 61/pop-all-registers - 350 fb/enable-interrupts - 351 cf/return-from-interrupt - 352 - 353 keyboard-interrupt-handler: - 354 # prologue - 355 fa/disable-interrupts - 356 60/push-all-registers - 357 9c/push-flags - 358 # acknowledge interrupt - 359 b0/copy-to-al 0x20/imm8 - 360 e6/write-al-into-port 0x20/imm8 - 361 31/xor %eax 0/r32/eax - 362 # check output buffer of 8042 keyboard controller (https://web.archive.org/web/20040604041507/http://panda.cs.ndsu.nodak.edu/~achapwes/PICmicro/keyboard/atkeyboard.html) - 363 e4/read-port-into-al 0x64/imm8 - 364 a8/test-bits-in-al 0x01/imm8 # set zf if bit 0 (least significant) is not set - 365 0f 84/jump-if-not-set $keyboard-interrupt-handler:epilogue/disp32 - 366 # - if keyboard buffer is full, return - 367 # var dest-addr/ecx: (addr byte) = (keyboard-buffer + *keyboard-buffer:write) - 368 31/xor %ecx 1/r32/ecx - 369 8a/byte-> *Keyboard-buffer:write 1/r32/cl - 370 81 0/subop/add %ecx Keyboard-buffer:data/imm32 - 371 # al = *dest-addr - 372 8a/byte-> *ecx 0/r32/al - 373 # if (al != 0) return - 374 3c/compare-al-and 0/imm8 - 375 0f 85/jump-if-!= $keyboard-interrupt-handler:epilogue/disp32 - 376 # - read keycode - 377 e4/read-port-into-al 0x60/imm8 - 378 # - key released - 379 # if (al == 0xaa) shift = false # left shift is being lifted - 380 { - 381 3c/compare-al-and 0xaa/imm8 - 382 75/jump-if-!= break/disp8 - 383 # *shift = 0 - 384 c7 0/subop/copy *Keyboard-shift-pressed? 0/imm32 - 385 } - 386 # if (al == 0xb6) shift = false # right shift is being lifted - 387 { - 388 3c/compare-al-and 0xb6/imm8 - 389 75/jump-if-!= break/disp8 - 390 # *shift = 0 - 391 c7 0/subop/copy *Keyboard-shift-pressed? 0/imm32 - 392 } - 393 # if (al == 0x9d) ctrl = false # ctrl is being lifted + 175 disk_error: + 176 # print 'D' to top-left of screen to indicate disk error + 177 # *0xb8000 <- 0x0f44 + 178 bb/copy-to-bx 0xb800/imm16 + 179 8e/->seg 3/mod/direct 3/rm32/bx 3/r32/ds + 180 b0/copy-to-al 0x44/imm8/D + 181 b4/copy-to-ah 0x0f/imm8/white-on-black + 182 bb/copy-to-bx 0/imm16 + 183 89/<- 0/mod/indirect 7/rm32/bx 0/r32/ax # *ds:bx <- ax + 184 # loop forever + 185 { + 186 eb/jump loop/disp8 + 187 } + 188 + 189 ## GDT: 3 records of 8 bytes each + 190 == data 0x7ce0 + 191 gdt_descriptor: + 192 0x17/imm16 # final index of gdt = size of gdt - 1 + 193 gdt_start/imm32/start + 194 + 195 gdt_start: + 196 # offset 0: gdt_null: mandatory null descriptor + 197 00 00 00 00 00 00 00 00 + 198 # offset 8: gdt_code + 199 ff ff # limit[0:16] + 200 00 00 00 # base[0:24] + 201 9a # 1/present 00/privilege 1/descriptor type = 1001b + 202 # 1/code 0/conforming 1/readable 0/accessed = 1010b + 203 cf # 1/granularity 1/32-bit 0/64-bit-segment 0/AVL = 1100b + 204 # limit[16:20] = 1111b + 205 00 # base[24:32] + 206 # offset 16: gdt_data + 207 ff ff # limit[0:16] + 208 00 00 00 # base[0:24] + 209 92 # 1/present 00/privilege 1/descriptor type = 1001b + 210 # 0/data 0/conforming 1/readable 0/accessed = 0010b + 211 cf # same as gdt_code + 212 00 # base[24:32] + 213 # gdt_end: + 214 + 215 ## 32-bit code from this point + 216 + 217 == code 0x7d00 + 218 initialize_32bit_mode: + 219 66 b8/copy-to-ax 0x10/imm16 # offset 16 from gdt_start + 220 8e/->seg 3/mod/direct 0/rm32/ax 3/r32/ds + 221 8e/->seg 3/mod/direct 0/rm32/ax 2/r32/ss + 222 8e/->seg 3/mod/direct 0/rm32/ax 0/r32/es + 223 8e/->seg 3/mod/direct 0/rm32/ax 4/r32/fs + 224 8e/->seg 3/mod/direct 0/rm32/ax 5/r32/gs + 225 + 226 bc/copy-to-esp 0x02000000/imm32 + 227 + 228 ## load interrupt handlers + 229 # We can't refer to the label directly because SubX doesn't do the right + 230 # thing for lidt, so rather than make errors worse in most places we instead + 231 # pin idt_descriptor below. + 232 0f 01 3/subop/lidt 0/mod/indirect 5/rm32/use-disp32 0x7e00/disp32/idt_descriptor + 233 + 234 # For now, not bothering reprogramming the IRQ to not conflict with software + 235 # exceptions. + 236 # https://wiki.osdev.org/index.php?title=8259_PIC&oldid=24650#Protected_Mode + 237 # + 238 # Interrupt 1 (keyboard) conflicts with debugger faults. We don't use a + 239 # debugger. + 240 # Reference: + 241 # https://wiki.osdev.org/Exceptions + 242 + 243 # enable timer IRQ0 and keyboard IRQ1 + 244 b0/copy-to-al 0xfc/imm8 # disable mask for IRQ0 and IRQ1 + 245 e6/write-al-into-port 0x21/imm8 + 246 + 247 fb/enable-interrupts + 248 + 249 (initialize-mouse) + 250 + 251 ## enable floating point + 252 db/floating-point-coprocessor e3/initialize + 253 # eax <- cr4 + 254 0f 20/<-cr 3/mod/direct 0/rm32/eax 4/r32/cr4 + 255 # eax <- or bit 9 + 256 0f ba/bit-test 5/subop/bit-test-and-set 3/mod/direct 0/rm32/eax 9/imm8 + 257 # cr4 <- eax + 258 0f 22/->cr 3/mod/direct 0/rm32/eax 4/r32/cr4 + 259 + 260 e9/jump Entry/disp32 + 261 + 262 == boot-sector-marker 0x7dfe + 263 # final 2 bytes of boot sector + 264 55 aa + 265 + 266 ## sector 2 onwards loaded by load_disk, not automatically on boot + 267 + 268 == data 0x7e00 + 269 idt_descriptor: + 270 ff 03 # final index of idt = size of idt - 1 + 271 idt_start/imm32/start + 272 + 273 +-- 55 lines: # interrupt descriptor table ---------------------------------------------------------------------------------------------------------------------------------------------- + 328 + 329 == code + 330 + 331 null-interrupt-handler: + 332 # prologue + 333 # Don't disable interrupts; the timer has the highest priority anyway, + 334 # and this interrupt triggers extremely frequently. + 335 fa/disable-interrupts + 336 60/push-all-registers + 337 9c/push-flags + 338 # acknowledge interrupt + 339 b0/copy-to-al 0x20/imm8 + 340 e6/write-al-into-port 0x20/imm8 + 341 31/xor %eax 0/r32/eax + 342 $null-interrupt-handler:epilogue: + 343 # epilogue + 344 9d/pop-flags + 345 61/pop-all-registers + 346 fb/enable-interrupts + 347 cf/return-from-interrupt + 348 + 349 timer-interrupt-handler: + 350 # prologue + 351 # Don't disable interrupts; the timer has the highest priority anyway, + 352 # and this interrupt triggers extremely frequently. + 353 fa/disable-interrupts + 354 60/push-all-registers + 355 9c/push-flags + 356 # acknowledge interrupt + 357 b0/copy-to-al 0x20/imm8 + 358 e6/write-al-into-port 0x20/imm8 + 359 31/xor %eax 0/r32/eax + 360 $timer-interrupt-handler:epilogue: + 361 # epilogue + 362 9d/pop-flags + 363 61/pop-all-registers + 364 fb/enable-interrupts + 365 cf/return-from-interrupt + 366 + 367 keyboard-interrupt-handler: + 368 # prologue + 369 fa/disable-interrupts + 370 60/push-all-registers + 371 9c/push-flags + 372 # acknowledge interrupt + 373 b0/copy-to-al 0x20/imm8 + 374 e6/write-al-into-port 0x20/imm8 + 375 31/xor %eax 0/r32/eax + 376 # check output buffer of 8042 keyboard controller (https://web.archive.org/web/20040604041507/http://panda.cs.ndsu.nodak.edu/~achapwes/PICmicro/keyboard/atkeyboard.html) + 377 e4/read-port-into-al 0x64/imm8 + 378 a8/test-bits-in-al 0x01/imm8 # set zf if bit 0 (least significant) is not set + 379 0f 84/jump-if-not-set $keyboard-interrupt-handler:epilogue/disp32 + 380 # - if keyboard buffer is full, return + 381 # var dest-addr/ecx: (addr byte) = (keyboard-buffer + *keyboard-buffer:write) + 382 31/xor %ecx 1/r32/ecx + 383 8a/byte-> *Keyboard-buffer:write 1/r32/cl + 384 81 0/subop/add %ecx Keyboard-buffer:data/imm32 + 385 # al = *dest-addr + 386 8a/byte-> *ecx 0/r32/al + 387 # if (al != 0) return + 388 3c/compare-al-and 0/imm8 + 389 0f 85/jump-if-!= $keyboard-interrupt-handler:epilogue/disp32 + 390 # - read keycode + 391 e4/read-port-into-al 0x60/imm8 + 392 # - key released + 393 # if (al == 0xaa) shift = false # left shift is being lifted 394 { - 395 3c/compare-al-and 0x9d/imm8 + 395 3c/compare-al-and 0xaa/imm8 396 75/jump-if-!= break/disp8 - 397 # *ctrl = 0 - 398 c7 0/subop/copy *Keyboard-ctrl-pressed? 0/imm32 + 397 # *shift = 0 + 398 c7 0/subop/copy *Keyboard-shift-pressed? 0/imm32 399 } - 400 # if (al & 0x80) a key is being lifted; return - 401 50/push-eax - 402 24/and-al-with 0x80/imm8 - 403 3c/compare-al-and 0/imm8 - 404 58/pop-to-eax - 405 75/jump-if-!= $keyboard-interrupt-handler:epilogue/disp8 - 406 # - key pressed - 407 # if (al == 0x2a) shift = true, return # left shift pressed + 400 # if (al == 0xb6) shift = false # right shift is being lifted + 401 { + 402 3c/compare-al-and 0xb6/imm8 + 403 75/jump-if-!= break/disp8 + 404 # *shift = 0 + 405 c7 0/subop/copy *Keyboard-shift-pressed? 0/imm32 + 406 } + 407 # if (al == 0x9d) ctrl = false # ctrl is being lifted 408 { - 409 3c/compare-al-and 0x2a/imm8 + 409 3c/compare-al-and 0x9d/imm8 410 75/jump-if-!= break/disp8 - 411 # *shift = 1 - 412 c7 0/subop/copy *Keyboard-shift-pressed? 1/imm32 - 413 # return - 414 eb/jump $keyboard-interrupt-handler:epilogue/disp8 - 415 } - 416 # if (al == 0x36) shift = true, return # right shift pressed - 417 { - 418 3c/compare-al-and 0x36/imm8 - 419 75/jump-if-!= break/disp8 - 420 # *shift = 1 - 421 c7 0/subop/copy *Keyboard-shift-pressed? 1/imm32 - 422 # return - 423 eb/jump $keyboard-interrupt-handler:epilogue/disp8 - 424 } - 425 # if (al == 0x1d) ctrl = true, return - 426 { - 427 3c/compare-al-and 0x1d/imm8 - 428 75/jump-if-!= break/disp8 - 429 # *ctrl = 1 - 430 c7 0/subop/copy *Keyboard-ctrl-pressed? 1/imm32 - 431 # return - 432 eb/jump $keyboard-interrupt-handler:epilogue/disp8 - 433 } - 434 # - convert key to character - 435 # if (shift) use keyboard shift map - 436 { - 437 81 7/subop/compare *Keyboard-shift-pressed? 0/imm32 - 438 74/jump-if-= break/disp8 - 439 # sigils don't currently support labels inside *(eax+label) - 440 05/add-to-eax Keyboard-shift-map/imm32 - 441 8a/byte-> *eax 0/r32/al - 442 eb/jump $keyboard-interrupt-handler:select-map-done/disp8 - 443 } - 444 # if (ctrl) al = *(ctrl map + al) - 445 { - 446 81 7/subop/compare *Keyboard-ctrl-pressed? 0/imm32 - 447 74/jump-if-= break/disp8 - 448 05/add-to-eax Keyboard-ctrl-map/imm32 - 449 8a/byte-> *eax 0/r32/al - 450 eb/jump $keyboard-interrupt-handler:select-map-done/disp8 - 451 } - 452 # otherwise al = *(normal map + al) - 453 05/add-to-eax Keyboard-normal-map/imm32 - 454 8a/byte-> *eax 0/r32/al - 455 $keyboard-interrupt-handler:select-map-done: - 456 # - if there's no character mapping, return - 457 { - 458 3c/compare-al-and 0/imm8 - 459 74/jump-if-= break/disp8 - 460 # - store al in keyboard buffer - 461 88/<- *ecx 0/r32/al - 462 # increment index - 463 fe/increment-byte *Keyboard-buffer:write - 464 # clear top nibble of index (keyboard buffer is circular) - 465 80 4/subop/and-byte *Keyboard-buffer:write 0x0f/imm8 - 466 } - 467 $keyboard-interrupt-handler:epilogue: - 468 # epilogue - 469 9d/pop-flags - 470 61/pop-all-registers - 471 fb/enable-interrupts - 472 cf/return-from-interrupt - 473 - 474 == data - 475 Keyboard-shift-pressed?: # boolean - 476 0/imm32 - 477 - 478 Keyboard-ctrl-pressed?: # boolean - 479 0/imm32 - 480 - 481 # var keyboard circular buffer - 482 Keyboard-buffer:write: # nibble - 483 0/imm32 - 484 Keyboard-buffer:read: # nibble - 485 0/imm32 - 486 Keyboard-buffer:data: # byte[16] - 487 00 00 00 00 - 488 00 00 00 00 - 489 00 00 00 00 - 490 00 00 00 00 + 411 # *ctrl = 0 + 412 c7 0/subop/copy *Keyboard-ctrl-pressed? 0/imm32 + 413 } + 414 # if (al & 0x80) a key is being lifted; return + 415 50/push-eax + 416 24/and-al-with 0x80/imm8 + 417 3c/compare-al-and 0/imm8 + 418 58/pop-to-eax + 419 75/jump-if-!= $keyboard-interrupt-handler:epilogue/disp8 + 420 # - key pressed + 421 # if (al == 0x2a) shift = true, return # left shift pressed + 422 { + 423 3c/compare-al-and 0x2a/imm8 + 424 75/jump-if-!= break/disp8 + 425 # *shift = 1 + 426 c7 0/subop/copy *Keyboard-shift-pressed? 1/imm32 + 427 # return + 428 eb/jump $keyboard-interrupt-handler:epilogue/disp8 + 429 } + 430 # if (al == 0x36) shift = true, return # right shift pressed + 431 { + 432 3c/compare-al-and 0x36/imm8 + 433 75/jump-if-!= break/disp8 + 434 # *shift = 1 + 435 c7 0/subop/copy *Keyboard-shift-pressed? 1/imm32 + 436 # return + 437 eb/jump $keyboard-interrupt-handler:epilogue/disp8 + 438 } + 439 # if (al == 0x1d) ctrl = true, return + 440 { + 441 3c/compare-al-and 0x1d/imm8 + 442 75/jump-if-!= break/disp8 + 443 # *ctrl = 1 + 444 c7 0/subop/copy *Keyboard-ctrl-pressed? 1/imm32 + 445 # return + 446 eb/jump $keyboard-interrupt-handler:epilogue/disp8 + 447 } + 448 # - convert key to character + 449 # if (shift) use keyboard shift map + 450 { + 451 81 7/subop/compare *Keyboard-shift-pressed? 0/imm32 + 452 74/jump-if-= break/disp8 + 453 # sigils don't currently support labels inside *(eax+label) + 454 05/add-to-eax Keyboard-shift-map/imm32 + 455 8a/byte-> *eax 0/r32/al + 456 eb/jump $keyboard-interrupt-handler:select-map-done/disp8 + 457 } + 458 # if (ctrl) al = *(ctrl map + al) + 459 { + 460 81 7/subop/compare *Keyboard-ctrl-pressed? 0/imm32 + 461 74/jump-if-= break/disp8 + 462 05/add-to-eax Keyboard-ctrl-map/imm32 + 463 8a/byte-> *eax 0/r32/al + 464 eb/jump $keyboard-interrupt-handler:select-map-done/disp8 + 465 } + 466 # otherwise al = *(normal map + al) + 467 05/add-to-eax Keyboard-normal-map/imm32 + 468 8a/byte-> *eax 0/r32/al + 469 $keyboard-interrupt-handler:select-map-done: + 470 # - if there's no character mapping, return + 471 { + 472 3c/compare-al-and 0/imm8 + 473 74/jump-if-= break/disp8 + 474 # - store al in keyboard buffer + 475 88/<- *ecx 0/r32/al + 476 # increment index + 477 fe/increment-byte *Keyboard-buffer:write + 478 # clear top nibble of index (keyboard buffer is circular) + 479 80 4/subop/and-byte *Keyboard-buffer:write 0x0f/imm8 + 480 } + 481 $keyboard-interrupt-handler:epilogue: + 482 # epilogue + 483 9d/pop-flags + 484 61/pop-all-registers + 485 fb/enable-interrupts + 486 cf/return-from-interrupt + 487 + 488 == data + 489 Keyboard-shift-pressed?: # boolean + 490 0/imm32 491 - 492 +-- 95 lines: # Keyboard maps for translating keys to ASCII ----------------------------------------------------------------------------------------------------------------------------- - 587 - 588 Video-mode-info: - 589 +-- 53 lines: # video mode info --------------------------------------------------------------------------------------------------------------------------------------------------------- - 642 - 643 Font: - 644 +--236 lines: # Bitmaps for some ASCII characters (soon Unicode) ------------------------------------------------------------------------------------------------------------------------ - 880 - 881 ## Controlling IDE (ATA) hard disks - 882 # Uses 28-bit PIO mode. - 883 # Inspired by https://colorforth.github.io/ide.html - 884 # - 885 # Resources: - 886 # https://wiki.osdev.org/ATA_PIO_Mode - 887 # https://forum.osdev.org/viewtopic.php?f=1&p=167798 - 888 # read-sector, according to https://www.scs.stanford.edu/11wi-cs140/pintos/specs/ata-3-std.pdf - 889 - 890 == data - 891 - 892 # code disk - 893 # All ports are 8-bit except data-port, which is 16-bit. - 894 Primary-bus-primary-drive: - 895 # command-port: int (write) - 896 0x1f7/imm32 - 897 # status-port: int (read) - 898 0x1f7/imm32 - 899 # alternative-status-port: int (read) - 900 0x3f6/imm32 - 901 # error-port: int (read) - 902 0x1f1/imm32 - 903 # drive-and-head-port: int - 904 0x1f6/imm32 - 905 # sector-count-port: int - 906 0x1f2/imm32 - 907 # lba-low-port: int - 908 0x1f3/imm32 - 909 # lba-mid-port: int - 910 0x1f4/imm32 - 911 # lba-high-port: int - 912 0x1f5/imm32 - 913 # data-port: int - 914 0x1f0/imm32 - 915 # drive-code: byte # only drive-specific field - 916 0xe0/imm32 # LBA mode also enabled - 917 - 918 # data disk - 919 # All ports are 8-bit except data-port, which is 16-bit. - 920 Primary-bus-secondary-drive: - 921 # command-port: int (write) - 922 0x1f7/imm32 - 923 # status-port: int (read) - 924 0x1f7/imm32 - 925 # alternative-status-port: int (read) - 926 0x3f6/imm32 - 927 # error-port: int (read) - 928 0x1f1/imm32 - 929 # drive-and-head-port: int - 930 0x1f6/imm32 - 931 # sector-count-port: int - 932 0x1f2/imm32 - 933 # lba-low-port: int - 934 0x1f3/imm32 - 935 # lba-mid-port: int - 936 0x1f4/imm32 - 937 # lba-high-port: int - 938 0x1f5/imm32 - 939 # data-port: int - 940 0x1f0/imm32 - 941 # drive-code: byte # only drive-specific field - 942 0xf0/imm32 # LBA mode also enabled - 943 - 944 == code - 945 - 946 load-sectors: # disk: (addr disk), lba: int, n: int, out: (addr stream byte) - 947 # . prologue - 948 55/push-ebp - 949 89/<- %ebp 4/r32/esp - 950 # . save registers - 951 50/push-eax - 952 51/push-ecx - 953 52/push-edx - 954 # check for drive - 955 (drive-exists? *(ebp+8)) # => eax - 956 3d/compare-eax-and 0/imm32/false - 957 0f 84/jump-if-= $load-sectors:end/disp32 - 958 # kick off read - 959 (ata-drive-select *(ebp+8) *(ebp+0xc)) - 960 (clear-ata-error *(ebp+8)) - 961 (ata-sector-count *(ebp+8) *(ebp+0x10)) - 962 (ata-lba *(ebp+8) *(ebp+0xc)) - 963 (ata-command *(ebp+8) 0x20) # read sectors with retries - 964 # for each sector - 965 { - 966 # poll for results - 967 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "waiting for sector.." 7 0) - 968 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "." 7 0) - 969 (while-ata-busy *(ebp+8)) - 970 (until-ata-data-available *(ebp+8)) - 971 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "reading\n" 7 0) - 972 # var data-port/edx = disk->data-port - 973 8b/-> *(ebp+8) 0/r32/eax - 974 8b/-> *(eax+0x24) 2/r32/edx - 975 # emit results - 976 31/xor %eax 0/r32/eax - 977 b9/copy-to-ecx 0x200/imm32 # 512 bytes per sector - 978 { - 979 81 7/subop/compare %ecx 0/imm32 - 980 74/jump-if-= break/disp8 - 981 66 ed/read-port-dx-into-ax - 982 # write 2 bytes to stream one at a time - 983 (append-byte *(ebp+0x14) %eax) - 984 49/decrement-ecx - 985 c1/shift 5/subop/right-padding-zeroes %eax 8/imm8 - 986 (append-byte *(ebp+0x14) %eax) - 987 49/decrement-ecx - 988 eb/jump loop/disp8 - 989 } - 990 # next sector - 991 ff 1/subop/decrement *(ebp+0x10) - 992 #? (draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0x10) 0xc 0) - 993 81 7/subop/compare *(ebp+0x10) 0/imm32 - 994 7e/jump-if-<= break/disp8 - 995 (wait-400ns *(ebp+8)) - 996 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "next sector\n" 7 0) - 997 e9/jump loop/disp32 - 998 } - 999 $load-sectors:end: -1000 # . restore registers -1001 5a/pop-to-edx -1002 59/pop-to-ecx -1003 58/pop-to-eax -1004 # . epilogue -1005 89/<- %esp 5/r32/ebp -1006 5d/pop-to-ebp -1007 c3/return -1008 -1009 store-sectors: # disk: (addr disk), lba: int, n: int, in: (addr stream byte) -1010 # . prologue -1011 55/push-ebp -1012 89/<- %ebp 4/r32/esp -1013 # . save registers -1014 50/push-eax -1015 51/push-ecx -1016 52/push-edx -1017 53/push-ebx -1018 # check for drive -1019 (drive-exists? *(ebp+8)) # => eax -1020 3d/compare-eax-and 0/imm32/false -1021 0f 84/jump-if-= $store-sectors:end/disp32 -1022 # kick off write -1023 (ata-drive-select *(ebp+8) *(ebp+0xc)) -1024 (clear-ata-error *(ebp+8)) -1025 (ata-sector-count *(ebp+8) *(ebp+0x10)) -1026 (ata-lba *(ebp+8) *(ebp+0xc)) -1027 (ata-command *(ebp+8) 0x30) # write sectors with retries -1028 # for each sector -1029 #? (set-cursor-position 0 0 0) -1030 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "0" 7 0) -1031 { -1032 # wait -1033 (while-ata-busy *(ebp+8)) -1034 (until-ata-ready-for-data *(ebp+8)) -1035 # var data-port/edx = disk->data-port -1036 8b/-> *(ebp+8) 0/r32/eax -1037 8b/-> *(eax+0x24) 2/r32/edx -1038 # send data -1039 b9/copy-to-ecx 0x200/imm32 # 512 bytes per sector -1040 # . var first-byte/ebx: byte -1041 # . when it's more than 0xff, we're at an even-numbered byte -1042 bb/copy-to-ebx 0xffff/imm32 -1043 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "D" 7 0) -1044 $store-sectors:store-sector: -1045 { -1046 81 7/subop/compare %ecx 0/imm32 -1047 74/jump-if-= break/disp8 -1048 # this loop is slow, but the ATA spec also requires a small delay -1049 (stream-empty? *(ebp+0x14)) # => eax -1050 3d/compare-eax-and 0/imm32/false -1051 75/jump-if-!= break/disp8 -1052 # read byte from stream -1053 (read-byte *(ebp+0x14)) # => eax -1054 # if we're at an odd-numbered byte, save it to first-byte -1055 81 7/subop/compare %ebx 0xff/imm32 -1056 { -1057 7e/jump-if-<= break/disp8 -1058 89/<- %ebx 0/r32/eax -1059 eb/jump $store-sectors:store-sector/disp8 -1060 } -1061 # otherwise OR it with first-byte and write it out -1062 c1/shift 4/subop/left %eax 8/imm8 -1063 09/or %eax 3/r32/ebx -1064 66 ef/write-ax-into-port-dx -1065 49/decrement-ecx -1066 49/decrement-ecx -1067 # reset first-byte -1068 bb/copy-to-ebx 0xffff/imm32 -1069 eb/jump loop/disp8 -1070 } -1071 # write out final first-byte if necessary -1072 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "I" 7 0) -1073 81 7/subop/compare %ebx 0xff/imm32 -1074 { -1075 7f/jump-if-> break/disp8 -1076 89/<- %eax 3/r32/ebx -1077 66 ef/write-ax-into-port-dx -1078 49/decrement-ecx + 492 Keyboard-ctrl-pressed?: # boolean + 493 0/imm32 + 494 + 495 # var keyboard circular buffer + 496 Keyboard-buffer:write: # nibble + 497 0/imm32 + 498 Keyboard-buffer:read: # nibble + 499 0/imm32 + 500 Keyboard-buffer:data: # byte[16] + 501 00 00 00 00 + 502 00 00 00 00 + 503 00 00 00 00 + 504 00 00 00 00 + 505 + 506 +-- 95 lines: # Keyboard maps for translating keys to ASCII ----------------------------------------------------------------------------------------------------------------------------- + 601 + 602 Video-mode-info: + 603 +-- 53 lines: # video mode info --------------------------------------------------------------------------------------------------------------------------------------------------------- + 656 + 657 Font: + 658 +--236 lines: # Bitmaps for some ASCII characters (soon Unicode) ------------------------------------------------------------------------------------------------------------------------ + 894 + 895 ## Controlling IDE (ATA) hard disks + 896 # Uses 28-bit PIO mode. + 897 # Inspired by https://colorforth.github.io/ide.html + 898 # + 899 # Resources: + 900 # https://wiki.osdev.org/ATA_PIO_Mode + 901 # https://forum.osdev.org/viewtopic.php?f=1&p=167798 + 902 # read-sector, according to https://www.scs.stanford.edu/11wi-cs140/pintos/specs/ata-3-std.pdf + 903 + 904 == data + 905 + 906 # code disk + 907 # All ports are 8-bit except data-port, which is 16-bit. + 908 Primary-bus-primary-drive: + 909 # command-port: int (write) + 910 0x1f7/imm32 + 911 # status-port: int (read) + 912 0x1f7/imm32 + 913 # alternative-status-port: int (read) + 914 0x3f6/imm32 + 915 # error-port: int (read) + 916 0x1f1/imm32 + 917 # drive-and-head-port: int + 918 0x1f6/imm32 + 919 # sector-count-port: int + 920 0x1f2/imm32 + 921 # lba-low-port: int + 922 0x1f3/imm32 + 923 # lba-mid-port: int + 924 0x1f4/imm32 + 925 # lba-high-port: int + 926 0x1f5/imm32 + 927 # data-port: int + 928 0x1f0/imm32 + 929 # drive-code: byte # only drive-specific field + 930 0xe0/imm32 # LBA mode also enabled + 931 + 932 # data disk + 933 # All ports are 8-bit except data-port, which is 16-bit. + 934 Primary-bus-secondary-drive: + 935 # command-port: int (write) + 936 0x1f7/imm32 + 937 # status-port: int (read) + 938 0x1f7/imm32 + 939 # alternative-status-port: int (read) + 940 0x3f6/imm32 + 941 # error-port: int (read) + 942 0x1f1/imm32 + 943 # drive-and-head-port: int + 944 0x1f6/imm32 + 945 # sector-count-port: int + 946 0x1f2/imm32 + 947 # lba-low-port: int + 948 0x1f3/imm32 + 949 # lba-mid-port: int + 950 0x1f4/imm32 + 951 # lba-high-port: int + 952 0x1f5/imm32 + 953 # data-port: int + 954 0x1f0/imm32 + 955 # drive-code: byte # only drive-specific field + 956 0xf0/imm32 # LBA mode also enabled + 957 + 958 == code + 959 + 960 load-sectors: # disk: (addr disk), lba: int, n: int, out: (addr stream byte) + 961 # . prologue + 962 55/push-ebp + 963 89/<- %ebp 4/r32/esp + 964 # . save registers + 965 50/push-eax + 966 51/push-ecx + 967 52/push-edx + 968 # check for drive + 969 (drive-exists? *(ebp+8)) # => eax + 970 3d/compare-eax-and 0/imm32/false + 971 0f 84/jump-if-= $load-sectors:end/disp32 + 972 # kick off read + 973 (ata-drive-select *(ebp+8) *(ebp+0xc)) + 974 (clear-ata-error *(ebp+8)) + 975 (ata-sector-count *(ebp+8) *(ebp+0x10)) + 976 (ata-lba *(ebp+8) *(ebp+0xc)) + 977 (ata-command *(ebp+8) 0x20) # read sectors with retries + 978 # for each sector + 979 { + 980 # poll for results + 981 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "waiting for sector.." 7 0) + 982 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "." 7 0) + 983 (while-ata-busy *(ebp+8)) + 984 (until-ata-data-available *(ebp+8)) + 985 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "reading\n" 7 0) + 986 # var data-port/edx = disk->data-port + 987 8b/-> *(ebp+8) 0/r32/eax + 988 8b/-> *(eax+0x24) 2/r32/edx + 989 # emit results + 990 31/xor %eax 0/r32/eax + 991 b9/copy-to-ecx 0x200/imm32 # 512 bytes per sector + 992 { + 993 81 7/subop/compare %ecx 0/imm32 + 994 74/jump-if-= break/disp8 + 995 66 ed/read-port-dx-into-ax + 996 # write 2 bytes to stream one at a time + 997 (append-byte *(ebp+0x14) %eax) + 998 49/decrement-ecx + 999 c1/shift 5/subop/right-padding-zeroes %eax 8/imm8 +1000 (append-byte *(ebp+0x14) %eax) +1001 49/decrement-ecx +1002 eb/jump loop/disp8 +1003 } +1004 # next sector +1005 ff 1/subop/decrement *(ebp+0x10) +1006 #? (draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0 *(ebp+0x10) 0xc 0) +1007 81 7/subop/compare *(ebp+0x10) 0/imm32 +1008 7e/jump-if-<= break/disp8 +1009 (wait-400ns *(ebp+8)) +1010 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "next sector\n" 7 0) +1011 e9/jump loop/disp32 +1012 } +1013 $load-sectors:end: +1014 # . restore registers +1015 5a/pop-to-edx +1016 59/pop-to-ecx +1017 58/pop-to-eax +1018 # . epilogue +1019 89/<- %esp 5/r32/ebp +1020 5d/pop-to-ebp +1021 c3/return +1022 +1023 store-sectors: # disk: (addr disk), lba: int, n: int, in: (addr stream byte) +1024 # . prologue +1025 55/push-ebp +1026 89/<- %ebp 4/r32/esp +1027 # . save registers +1028 50/push-eax +1029 51/push-ecx +1030 52/push-edx +1031 53/push-ebx +1032 # check for drive +1033 (drive-exists? *(ebp+8)) # => eax +1034 3d/compare-eax-and 0/imm32/false +1035 0f 84/jump-if-= $store-sectors:end/disp32 +1036 # kick off write +1037 (ata-drive-select *(ebp+8) *(ebp+0xc)) +1038 (clear-ata-error *(ebp+8)) +1039 (ata-sector-count *(ebp+8) *(ebp+0x10)) +1040 (ata-lba *(ebp+8) *(ebp+0xc)) +1041 (ata-command *(ebp+8) 0x30) # write sectors with retries +1042 # for each sector +1043 #? (set-cursor-position 0 0 0) +1044 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "0" 7 0) +1045 { +1046 # wait +1047 (while-ata-busy *(ebp+8)) +1048 (until-ata-ready-for-data *(ebp+8)) +1049 # var data-port/edx = disk->data-port +1050 8b/-> *(ebp+8) 0/r32/eax +1051 8b/-> *(eax+0x24) 2/r32/edx +1052 # send data +1053 b9/copy-to-ecx 0x200/imm32 # 512 bytes per sector +1054 # . var first-byte/ebx: byte +1055 # . when it's more than 0xff, we're at an even-numbered byte +1056 bb/copy-to-ebx 0xffff/imm32 +1057 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "D" 7 0) +1058 $store-sectors:store-sector: +1059 { +1060 81 7/subop/compare %ecx 0/imm32 +1061 74/jump-if-= break/disp8 +1062 # this loop is slow, but the ATA spec also requires a small delay +1063 (stream-empty? *(ebp+0x14)) # => eax +1064 3d/compare-eax-and 0/imm32/false +1065 75/jump-if-!= break/disp8 +1066 # read byte from stream +1067 (read-byte *(ebp+0x14)) # => eax +1068 # if we're at an odd-numbered byte, save it to first-byte +1069 81 7/subop/compare %ebx 0xff/imm32 +1070 { +1071 7e/jump-if-<= break/disp8 +1072 89/<- %ebx 0/r32/eax +1073 eb/jump $store-sectors:store-sector/disp8 +1074 } +1075 # otherwise OR it with first-byte and write it out +1076 c1/shift 4/subop/left %eax 8/imm8 +1077 09/or %eax 3/r32/ebx +1078 66 ef/write-ax-into-port-dx 1079 49/decrement-ecx -1080 } -1081 # pad zeroes -1082 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "P" 7 0) -1083 31/xor %eax 0/r32/eax -1084 { -1085 81 7/subop/compare %ecx 0/imm32 -1086 74/jump-if-= break/disp8 -1087 66 ef/write-ax-into-port-dx -1088 49/decrement-ecx -1089 49/decrement-ecx -1090 eb/jump loop/disp8 -1091 } -1092 # next sector -1093 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "N" 7 0) -1094 ff 1/subop/decrement *(ebp+0x10) -1095 81 7/subop/compare *(ebp+0x10) 0/imm32 -1096 7e/jump-if-<= break/disp8 -1097 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "W" 7 0) -1098 (wait-400ns *(ebp+8)) -1099 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "L" 7 0) -1100 e9/jump loop/disp32 -1101 } -1102 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "F" 7 0) -1103 (flush-ata-cache *(ebp+8)) -1104 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "Y" 7 0) -1105 $store-sectors:end: -1106 # . restore registers -1107 5b/pop-to-ebx -1108 5a/pop-to-edx -1109 59/pop-to-ecx -1110 58/pop-to-eax -1111 # . epilogue -1112 89/<- %esp 5/r32/ebp -1113 5d/pop-to-ebp -1114 c3/return -1115 -1116 +--289 lines: # disk helpers ------------------------------------------------------------------------------------------------------------------------------------------------------------ -1405 -1406 ## Controlling a PS/2 mouse -1407 # Uses no IRQs, just polling. -1408 # Thanks Dave Long: https://github.com/jtauber/cleese/blob/master/necco/kernel/bochs/py8042.py -1409 # -1410 # Resources: -1411 # https://wiki.osdev.org/Mouse_Input -1412 -1413 # results x/eax, y/ecx range from -256 to +255 -1414 # See https://wiki.osdev.org/index.php?title=Mouse_Input&oldid=25663#Format_of_First_3_Packet_Bytes -1415 read-mouse-event: # -> _/eax: int, _/ecx: int -1416 # . prologue -1417 55/push-ebp -1418 89/<- %ebp 4/r32/esp -1419 # . save registers -1420 52/push-edx -1421 53/push-ebx -1422 # if no event, return 0, 0 -1423 b8/copy-to-eax 0/imm32 -1424 b9/copy-to-ecx 0/imm32 -1425 (any-mouse-event?) # => eax -1426 3d/compare-eax-and 0/imm32/false -1427 74/jump-if-= $read-mouse-event:end/disp8 -1428 # var f1/edx: byte = inb(0x60) -1429 31/xor %eax 0/r32/eax -1430 e4/read-port-into-al 0x60/imm8 -1431 89/<- %edx 0/r32/eax -1432 (wait-for-mouse-event) -1433 # var dx/ebx: byte = inb(0x60) -1434 31/xor %eax 0/r32/eax -1435 e4/read-port-into-al 0x60/imm8 -1436 89/<- %ebx 0/r32/eax -1437 (wait-for-mouse-event) -1438 # var dy/ecx: byte = inb(0x60) -1439 31/xor %eax 0/r32/eax -1440 e4/read-port-into-al 0x60/imm8 -1441 89/<- %ecx 0/r32/eax -1442 # eax = dx -1443 89/<- %eax 3/r32/ebx -1444 # if (f1 & 0x10) dx = -dx -1445 { -1446 f6 0/subop/test-bits %dl 0x10/imm8 -1447 74/jump-if-zero break/disp8 -1448 0d/or-eax-with 0xffffff00/imm32 -1449 } -1450 # if (f1 & 0x20) dy = -dy -1451 { -1452 f6 0/subop/test-bits %dl 0x20/imm8 -1453 74/jump-if-zero break/disp8 -1454 81 1/subop/or %ecx 0xffffff00/imm32 -1455 } -1456 $read-mouse-event:end: -1457 # . restore registers -1458 5b/pop-to-ebx -1459 5a/pop-to-edx -1460 # . epilogue -1461 89/<- %esp 5/r32/ebp -1462 5d/pop-to-ebp -1463 c3/return -1464 -1465 +--147 lines: # mouse helpers ----------------------------------------------------------------------------------------------------------------------------------------------------------- -1612 -1613 # vim:ft=subx +1080 49/decrement-ecx +1081 # reset first-byte +1082 bb/copy-to-ebx 0xffff/imm32 +1083 eb/jump loop/disp8 +1084 } +1085 # write out final first-byte if necessary +1086 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "I" 7 0) +1087 81 7/subop/compare %ebx 0xff/imm32 +1088 { +1089 7f/jump-if-> break/disp8 +1090 89/<- %eax 3/r32/ebx +1091 66 ef/write-ax-into-port-dx +1092 49/decrement-ecx +1093 49/decrement-ecx +1094 } +1095 # pad zeroes +1096 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "P" 7 0) +1097 31/xor %eax 0/r32/eax +1098 { +1099 81 7/subop/compare %ecx 0/imm32 +1100 74/jump-if-= break/disp8 +1101 66 ef/write-ax-into-port-dx +1102 49/decrement-ecx +1103 49/decrement-ecx +1104 eb/jump loop/disp8 +1105 } +1106 # next sector +1107 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "N" 7 0) +1108 ff 1/subop/decrement *(ebp+0x10) +1109 81 7/subop/compare *(ebp+0x10) 0/imm32 +1110 7e/jump-if-<= break/disp8 +1111 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "W" 7 0) +1112 (wait-400ns *(ebp+8)) +1113 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "L" 7 0) +1114 e9/jump loop/disp32 +1115 } +1116 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "F" 7 0) +1117 (flush-ata-cache *(ebp+8)) +1118 #? (draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0 "Y" 7 0) +1119 $store-sectors:end: +1120 # . restore registers +1121 5b/pop-to-ebx +1122 5a/pop-to-edx +1123 59/pop-to-ecx +1124 58/pop-to-eax +1125 # . epilogue +1126 89/<- %esp 5/r32/ebp +1127 5d/pop-to-ebp +1128 c3/return +1129 +1130 +--289 lines: # disk helpers ------------------------------------------------------------------------------------------------------------------------------------------------------------ +1419 +1420 ## Controlling a PS/2 mouse +1421 # Uses no IRQs, just polling. +1422 # Thanks Dave Long: https://github.com/jtauber/cleese/blob/master/necco/kernel/bochs/py8042.py +1423 # +1424 # Resources: +1425 # https://wiki.osdev.org/Mouse_Input +1426 +1427 # results x/eax, y/ecx range from -256 to +255 +1428 # See https://wiki.osdev.org/index.php?title=Mouse_Input&oldid=25663#Format_of_First_3_Packet_Bytes +1429 read-mouse-event: # -> _/eax: int, _/ecx: int +1430 # . prologue +1431 55/push-ebp +1432 89/<- %ebp 4/r32/esp +1433 # . save registers +1434 52/push-edx +1435 53/push-ebx +1436 # if no event, return 0, 0 +1437 b8/copy-to-eax 0/imm32 +1438 b9/copy-to-ecx 0/imm32 +1439 (any-mouse-event?) # => eax +1440 3d/compare-eax-and 0/imm32/false +1441 74/jump-if-= $read-mouse-event:end/disp8 +1442 # var f1/edx: byte = inb(0x60) +1443 31/xor %eax 0/r32/eax +1444 e4/read-port-into-al 0x60/imm8 +1445 89/<- %edx 0/r32/eax +1446 (wait-for-mouse-event) +1447 # var dx/ebx: byte = inb(0x60) +1448 31/xor %eax 0/r32/eax +1449 e4/read-port-into-al 0x60/imm8 +1450 89/<- %ebx 0/r32/eax +1451 (wait-for-mouse-event) +1452 # var dy/ecx: byte = inb(0x60) +1453 31/xor %eax 0/r32/eax +1454 e4/read-port-into-al 0x60/imm8 +1455 89/<- %ecx 0/r32/eax +1456 # eax = dx +1457 89/<- %eax 3/r32/ebx +1458 # if (f1 & 0x10) dx = -dx +1459 { +1460 f6 0/subop/test-bits %dl 0x10/imm8 +1461 74/jump-if-zero break/disp8 +1462 0d/or-eax-with 0xffffff00/imm32 +1463 } +1464 # if (f1 & 0x20) dy = -dy +1465 { +1466 f6 0/subop/test-bits %dl 0x20/imm8 +1467 74/jump-if-zero break/disp8 +1468 81 1/subop/or %ecx 0xffffff00/imm32 +1469 } +1470 $read-mouse-event:end: +1471 # . restore registers +1472 5b/pop-to-ebx +1473 5a/pop-to-edx +1474 # . epilogue +1475 89/<- %esp 5/r32/ebp +1476 5d/pop-to-ebp +1477 c3/return +1478 +1479 +--147 lines: # mouse helpers ----------------------------------------------------------------------------------------------------------------------------------------------------------- +1626 +1627 # vim:ft=subx diff --git a/html/colors.mu.html b/html/colors.mu.html index 756f0f90..33a0bff2 100644 --- a/html/colors.mu.html +++ b/html/colors.mu.html @@ -78,7 +78,7 @@ if ('onhashchange' in window) { 19 # read line from keyboard 20 clear-stream in 21 { - 22 draw-cursor screen, 0x20/space + 22 draw-cursor screen, 0x20/space 23 var key/eax: byte <- read-key keyboard 24 compare key, 0xa/newline 25 break-if-= @@ -91,7 +91,7 @@ if ('onhashchange' in window) { 32 move-cursor-right 0 33 loop 34 } - 35 clear-screen screen + 35 clear-screen screen 36 # parse 37 var a/ecx: int <- copy 0 38 var b/edx: int <- copy 0 @@ -275,11 +275,11 @@ if ('onhashchange' in window) { 216 break-if-!= 217 compare c, l 218 break-if-!= -219 set-cursor-position screen, 0x10/x, y -220 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, color, 7/fg, 0/bg -221 set-cursor-position screen, 0x14/x, y -222 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg -223 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 0/fg, color +219 set-cursor-position screen, 0x10/x, y +220 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, color, 7/fg, 0/bg +221 set-cursor-position screen, 0x14/x, y +222 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg +223 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 0/fg, color 224 #? draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg 225 #? draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen, a, 7/fg, 0/bg 226 #? draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg diff --git a/html/ex10.mu.html b/html/ex10.mu.html index 71ede3a0..93781f42 100644 --- a/html/ex10.mu.html +++ b/html/ex10.mu.html @@ -74,7 +74,7 @@ if ('onhashchange' in window) { 16 $main:event-loop: { 17 var dx/eax: int <- copy 0 18 var dy/ecx: int <- copy 0 -19 dx, dy <- read-mouse-event +19 dx, dy <- read-mouse-event 20 { 21 compare dx, 0 22 break-if-!= @@ -85,15 +85,15 @@ if ('onhashchange' in window) { 27 { 28 var dummy1/eax: int <- copy 0 29 var dummy2/ecx: int <- copy 0 -30 dummy1, dummy2 <- draw-text-wrapping-right-then-down-over-full-screen screen, " ", 0/x, 0x10/y, 0x31/fg, 0/bg +30 dummy1, dummy2 <- draw-text-wrapping-right-then-down-over-full-screen screen, " ", 0/x, 0x10/y, 0x31/fg, 0/bg 31 } 32 { 33 var dummy/ecx: int <- copy 0 -34 dx, dummy <- draw-int32-decimal-wrapping-right-then-down-over-full-screen screen, dx, 0/x, 0x10/y, 0x31/fg, 0/bg +34 dx, dummy <- draw-int32-decimal-wrapping-right-then-down-over-full-screen screen, dx, 0/x, 0x10/y, 0x31/fg, 0/bg 35 } 36 { 37 var dummy/eax: int <- copy 0 -38 dummy, dy <- draw-int32-decimal-wrapping-right-then-down-over-full-screen screen, dy, 5/x, 0x10/y, 0x31/fg, 0/bg +38 dummy, dy <- draw-int32-decimal-wrapping-right-then-down-over-full-screen screen, dy, 5/x, 0x10/y, 0x31/fg, 0/bg 39 } 40 loop 41 } diff --git a/html/ex11.mu.html b/html/ex11.mu.html index 853b68d0..084d01d7 100644 --- a/html/ex11.mu.html +++ b/html/ex11.mu.html @@ -93,7 +93,7 @@ if ('onhashchange' in window) { 35 } 36 37 fn render screen: (addr screen), _self: (addr environment) { - 38 clear-screen screen + 38 clear-screen screen 39 var self/esi: (addr environment) <- copy _self 40 var tmp-ah/ecx: (addr handle point) <- get self, p0 41 var tmp/eax: (addr point) <- lookup *tmp-ah diff --git a/html/ex2.mu.html b/html/ex2.mu.html index b9fc5124..ee5edcd4 100644 --- a/html/ex2.mu.html +++ b/html/ex2.mu.html @@ -76,7 +76,7 @@ if ('onhashchange' in window) { 18 break-if->= 19 var color/ecx: int <- copy x 20 color <- and 0xff -21 pixel screen x, y, color +21 pixel screen x, y, color 22 x <- increment 23 loop 24 } diff --git a/html/ex6.mu.html b/html/ex6.mu.html index 113bc486..47ef7b14 100644 --- a/html/ex6.mu.html +++ b/html/ex6.mu.html @@ -72,21 +72,21 @@ if ('onhashchange' in window) { 14 draw-box-on-real-screen 0xf, 0x1f, 0x79, 0x51, 0x4 15 var x/eax: int <- copy 0x20 16 var y/ecx: int <- copy 0x20 -17 x, y <- draw-text-wrapping-right-then-down screen, "hello ", 0x10/xmin, 0x20/ymin, 0x78/xmax, 0x50/ymax, x, y, 0xa/fg, 0/bg -18 x, y <- draw-text-wrapping-right-then-down screen, "from ", 0x10/xmin, 0x20/ymin, 0x78/xmax, 0x50/ymax, x, y, 0xa/fg, 0/bg -19 x, y <- draw-text-wrapping-right-then-down screen, "baremetal ", 0x10/xmin, 0x20/ymin, 0x78/xmax, 0x50/ymax, x, y, 0xa/fg, 0/bg -20 x, y <- draw-text-wrapping-right-then-down screen, "Mu!", 0x10/xmin, 0x20/ymin, 0x78/xmax, 0x50/ymax, x, y, 0xa/fg, 0/bg +17 x, y <- draw-text-wrapping-right-then-down screen, "hello ", 0x10/xmin, 0x20/ymin, 0x78/xmax, 0x50/ymax, x, y, 0xa/fg, 0/bg +18 x, y <- draw-text-wrapping-right-then-down screen, "from ", 0x10/xmin, 0x20/ymin, 0x78/xmax, 0x50/ymax, x, y, 0xa/fg, 0/bg +19 x, y <- draw-text-wrapping-right-then-down screen, "baremetal ", 0x10/xmin, 0x20/ymin, 0x78/xmax, 0x50/ymax, x, y, 0xa/fg, 0/bg +20 x, y <- draw-text-wrapping-right-then-down screen, "Mu!", 0x10/xmin, 0x20/ymin, 0x78/xmax, 0x50/ymax, x, y, 0xa/fg, 0/bg 21 22 # drawing at the cursor in multiple directions -23 draw-text-wrapping-down-then-right-from-cursor-over-full-screen screen, "abc", 0xa/fg, 0/bg -24 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, "def", 0xa/fg, 0/bg +23 draw-text-wrapping-down-then-right-from-cursor-over-full-screen screen, "abc", 0xa/fg, 0/bg +24 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, "def", 0xa/fg, 0/bg 25 26 # test drawing near the edge 27 x <- draw-text-rightward screen, "R", 0x7f/x, 0x80/xmax=screen-width, 0x18/y, 0xa/fg, 0/bg -28 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, "wrapped from R", 0xa/fg, 0/bg +28 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, "wrapped from R", 0xa/fg, 0/bg 29 -30 x <- draw-text-downward screen, "D", 0x20/x, 0x2f/y, 0x30/ymax=screen-height, 0xa/fg, 0/bg -31 draw-text-wrapping-down-then-right-from-cursor-over-full-screen screen, "wrapped from D", 0xa/fg, 0/bg +30 x <- draw-text-downward screen, "D", 0x20/x, 0x2f/y, 0x30/ymax=screen-height, 0xa/fg, 0/bg +31 draw-text-wrapping-down-then-right-from-cursor-over-full-screen screen, "wrapped from D", 0xa/fg, 0/bg 32 } diff --git a/html/ex7.mu.html b/html/ex7.mu.html index 25f8975d..8fc47169 100644 --- a/html/ex7.mu.html +++ b/html/ex7.mu.html @@ -70,9 +70,9 @@ if ('onhashchange' in window) { 12 13 fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) { 14 var space/eax: grapheme <- copy 0x20 -15 set-cursor-position screen, 0, 0 +15 set-cursor-position screen, 0, 0 16 { -17 draw-cursor screen, space +17 draw-cursor screen, space 18 var key/eax: byte <- read-key keyboard 19 { 20 compare key, 0x68/h diff --git a/html/ex9.mu.html b/html/ex9.mu.html index c14e8878..f64c025c 100644 --- a/html/ex9.mu.html +++ b/html/ex9.mu.html @@ -76,14 +76,14 @@ if ('onhashchange' in window) { 18 fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) { 19 var text-storage: (stream byte 0x200) 20 var text/esi: (addr stream byte) <- address text-storage -21 load-sectors data-disk, 0/lba, 1/num-sectors, text +21 load-sectors data-disk, 0/lba, 1/num-sectors, text 22 23 var word-count/eax: int <- word-count text 24 25 var result-storage: (stream byte 0x10) 26 var result/edi: (addr stream byte) <- address result-storage 27 write-int32-decimal result, word-count -28 store-sectors data-disk, 0/lba, 1/num-sectors, result +28 store-sectors data-disk, 0/lba, 1/num-sectors, result 29 } 30 31 fn word-count in: (addr stream byte) -> _/eax: int { diff --git a/html/hest-life.mu.html b/html/hest-life.mu.html index 0dafde10..32456854 100644 --- a/html/hest-life.mu.html +++ b/html/hest-life.mu.html @@ -87,7 +87,7 @@ if ('onhashchange' in window) { 28 var second-screen/edi: (addr screen) <- address second-buffer 29 initialize-screen second-screen, 0x80, 0x30, 1/include-pixels 30 render second-screen, env - 31 copy-pixels second-screen, screen + 31 copy-pixels second-screen, screen 32 { 33 edit keyboard, env 34 var play?/eax: (addr boolean) <- get env, play? @@ -96,7 +96,7 @@ if ('onhashchange' in window) { 37 break-if-= 38 step env 39 render second-screen, env - 40 copy-pixels second-screen, screen + 40 copy-pixels second-screen, screen 41 } 42 linger env 43 loop @@ -122,13 +122,13 @@ if ('onhashchange' in window) { 63 compare *zoom, 0 64 { 65 break-if-!= - 66 clear-screen screen + 66 clear-screen screen 67 render0 screen, self 68 } 69 compare *zoom, 1 70 { 71 break-if-!= - 72 clear-screen screen + 72 clear-screen screen 73 render1 screen, self 74 } 75 compare *zoom, 4 @@ -138,8 +138,8 @@ if ('onhashchange' in window) { 79 } 80 # clock 81 var tick-a/eax: (addr int) <- get self, tick - 82 set-cursor-position screen, 0x78/x, 0/y - 83 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, *tick-a, 7/fg 0/bg + 82 set-cursor-position screen, 0x78/x, 0/y + 83 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, *tick-a, 7/fg 0/bg 84 } 85 86 # Lots of hardcoded constants for now. @@ -172,8 +172,8 @@ if ('onhashchange' in window) { 113 draw-rect screen, 0x350/xmin 0x170/ymin, 0x370/xmax 0x190/ymax, color 114 # sum node 115 draw-rect screen, 0x170/xsmin 0x140/ysmin, 0x190/xsmax 0x160/ysmax, 0x40/color - 116 set-cursor-position screen, 0x2d/scol, 0x13/srow - 117 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, "+", 0xf/color, 0/bg + 116 set-cursor-position screen, 0x2d/scol, 0x13/srow + 117 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, "+", 0xf/color, 0/bg 118 # conveyors from neighboring inputs to sum node 119 draw-monotonic-bezier screen, 0xa0/x0 0x20/y0, 0x100/x1 0x150/ys, 0x180/xs 0x150/ys, 4/color 120 draw-monotonic-bezier screen, 0xa0/x0 0x180/y0, 0xc0/x1 0x150/ys, 0x180/xs 0x150/ys, 4/color @@ -185,8 +185,8 @@ if ('onhashchange' in window) { 126 draw-monotonic-bezier screen, 0x360/x0 0x2e0/y0, 0x180/x1 0x200/y1, 0x180/xs 0x150/ys, 4/color 127 # filter node 128 draw-rect screen, 0x200/xfmin 0x1c0/yfmin, 0x220/xfmax 0x1e0/yfmax, 0x31/color - 129 set-cursor-position screen, 0x40/fcol, 0x1b/frow - 130 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, "?", 0xf/color, 0/bg + 129 set-cursor-position screen, 0x40/fcol, 0x1b/frow + 130 draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, "?", 0xf/color, 0/bg 131 # conveyor from sum node to filter node 132 draw-line screen 0x180/xs, 0x150/ys, 0x210/xf, 0x1d0/yf, 0xa2/color 133 # cell outputs at corners @@ -243,9 +243,9 @@ if ('onhashchange' in window) { 184 var three-f/xmm0: float <- convert three 185 u <- divide three-f 186 draw-linear-point screen, u, 0x180/xs, 0x150/ys, 0x210/xf, 0x1d0/yf, 7/color, 4/radius - 187 set-cursor-position screen, 0x3a/scol, 0x18/srow + 187 set-cursor-position screen, 0x3a/scol, 0x18/srow 188 var n/eax: int <- num-live-neighbors self, 0x80/curx, 0x60/cury - 189 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, n, 0xf/fg 0/bg + 189 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, n, 0xf/fg 0/bg 190 return 191 } 192 # final 7 time steps for updating output @@ -361,17 +361,17 @@ if ('onhashchange' in window) { 302 draw-rect screen, 0x2a0/xfmin 0x218/yfmin, 0x2b0/xfmax 0x228/yfmax, 0x31/color 303 # neighbor counts 304 var n/eax: int <- num-live-neighbors self, 0x80/curx, 0x60/cury - 305 set-cursor-position screen, 0x2d, 0xe - 306 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, n, 0xf/fg 0/bg + 305 set-cursor-position screen, 0x2d, 0xe + 306 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, n, 0xf/fg 0/bg 307 var n/eax: int <- num-live-neighbors self, 0x81/curx, 0x60/cury - 308 set-cursor-position screen, 0x52, 0xe - 309 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, n, 0xf/fg 0/bg + 308 set-cursor-position screen, 0x52, 0xe + 309 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, n, 0xf/fg 0/bg 310 var n/eax: int <- num-live-neighbors self, 0x80/curx, 0x61/cury - 311 set-cursor-position screen, 0x2d, 0x20 - 312 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, n, 0xf/fg 0/bg + 311 set-cursor-position screen, 0x2d, 0x20 + 312 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, n, 0xf/fg 0/bg 313 var n/eax: int <- num-live-neighbors self, 0x81/curx, 0x61/cury - 314 set-cursor-position screen, 0x52, 0x20 - 315 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, n, 0xf/fg 0/bg + 314 set-cursor-position screen, 0x52, 0x20 + 315 draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, n, 0xf/fg 0/bg 316 # cell 0: conveyors from neighboring inputs to sum node 317 draw-monotonic-bezier screen, 0xc0/x0 0x40/y0, 0x100/x1 0xd0/ys, 0x150/xs 0xd0/ys, 4/color 318 draw-monotonic-bezier screen, 0xc0/x0 0xe8/y0, 0xc0/x1 0xd0/ys, 0x150/xs 0xd0/ys, 4/color diff --git a/html/mandelbrot-fixed.mu.html b/html/mandelbrot-fixed.mu.html index 3f7a6acb..3e4b205e 100644 --- a/html/mandelbrot-fixed.mu.html +++ b/html/mandelbrot-fixed.mu.html @@ -209,7 +209,7 @@ if ('onhashchange' in window) { 150 dummy, color <- integer-divide iterations, 0x18/24/size-of-cycle-0 151 color <- add 0x20/cycle-0 152 } -153 pixel screen, x, y, color +153 pixel screen, x, y, color 154 x <- increment 155 loop 156 } diff --git a/html/mandelbrot.mu.html b/html/mandelbrot.mu.html index 6cc460b6..d4264d38 100644 --- a/html/mandelbrot.mu.html +++ b/html/mandelbrot.mu.html @@ -119,7 +119,7 @@ if ('onhashchange' in window) { 61 var color/edx: int <- copy 0 62 iterations, color <- integer-divide iterations, 0x18/24/size-of-cycle-0 63 color <- add 0x20/cycle-0 - 64 pixel screen, x, y, color + 64 pixel screen, x, y, color 65 x <- increment 66 loop 67 } diff --git a/html/mu-init.subx.html b/html/mu-init.subx.html index e36e8a54..946275de 100644 --- a/html/mu-init.subx.html +++ b/html/mu-init.subx.html @@ -77,10 +77,10 @@ if ('onhashchange' in window) { 21 { 22 3d/compare-eax-and 0/imm32 23 75/jump-if-!= break/disp8 -24 (clear-real-screen) +24 (clear-real-screen) 25 c7 0/subop/copy *Real-screen-cursor-x 0/imm32 26 c7 0/subop/copy *Real-screen-cursor-y 0/imm32 -27 (main 0 0 Primary-bus-secondary-drive) +27 (main 0 0 Primary-bus-secondary-drive) 28 } 29 30 # hang indefinitely diff --git a/html/rpn.mu.html b/html/rpn.mu.html index d6f10d20..5b521abc 100644 --- a/html/rpn.mu.html +++ b/html/rpn.mu.html @@ -85,7 +85,7 @@ if ('onhashchange' in window) { 27 # read line from keyboard 28 clear-stream in 29 { - 30 draw-cursor screen, space + 30 draw-cursor screen, space 31 var key/eax: byte <- read-key keyboard 32 compare key, 0xa/newline 33 break-if-= @@ -104,7 +104,7 @@ if ('onhashchange' in window) { 46 var out/eax: int <- simplify in 47 # print 48 y <- increment - 49 out, y <- draw-int32-decimal-wrapping-right-then-down screen, out, 0/xmin, y, 0x80/xmax, 0x30/ymax, 0/x, y, 7/fg, 0/bg + 49 out, y <- draw-int32-decimal-wrapping-right-then-down screen, out, 0/xmin, y, 0x80/xmax, 0x30/ymax, 0/x, y, 7/fg, 0/bg 50 # newline 51 y <- increment 52 # diff --git a/html/shell/cell.mu.html b/html/shell/cell.mu.html index 5386139c..56a79650 100644 --- a/html/shell/cell.mu.html +++ b/html/shell/cell.mu.html @@ -229,7 +229,7 @@ if ('onhashchange' in window) { 171 } 172 var screen-ah/eax: (addr handle screen) <- get self, screen-data 173 var screen/eax: (addr screen) <- lookup *screen-ah -174 clear-screen screen +174 clear-screen screen 175 } 176 177 fn allocate-keyboard _out: (addr handle cell) { diff --git a/html/shell/evaluate.mu.html b/html/shell/evaluate.mu.html index 4ea7e6a2..d4a7d4f6 100644 --- a/html/shell/evaluate.mu.html +++ b/html/shell/evaluate.mu.html @@ -78,1627 +78,1784 @@ if ('onhashchange' in window) { 17 } 18 # errors? skip 19 { - 20 compare trace, 0 - 21 break-if-= - 22 var error?/eax: boolean <- has-errors? trace - 23 compare error?, 0/false - 24 break-if-= - 25 return - 26 } - 27 var in-ah/esi: (addr handle cell) <- copy _in-ah - 28 # show intermediate progress on screen if necessary - 29 { - 30 compare screen-cell, 0 - 31 break-if-= - 32 var tmp/eax: int <- copy call-number - 33 tmp <- and 0xf # every 16 calls to evaluate - 34 compare tmp, 0 - 35 break-if-!= - 36 var screen-cell/eax: (addr handle cell) <- copy screen-cell - 37 var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell - 38 compare screen-cell-addr, 0 - 39 break-if-= - 40 var screen-obj-ah/eax: (addr handle screen) <- get screen-cell-addr, screen-data - 41 var screen-obj/eax: (addr screen) <- lookup *screen-obj-ah - 42 compare screen-obj, 0 - 43 break-if-= - 44 var y/ecx: int <- render-screen 0/screen, screen-obj, 0x70/xmin, 1/ymin - 45 } - 46 #? dump-cell in-ah - 47 #? { - 48 #? var foo/eax: byte <- read-key 0/keyboard - 49 #? compare foo, 0 - 50 #? loop-if-= - 51 #? } - 52 +-- 14 lines: # trace "evaluate " in " in environment " env ----------------------------------------------------------------------------------------------------------------------------- - 66 trace-lower trace - 67 var in/eax: (addr cell) <- lookup *in-ah - 68 { - 69 var nil?/eax: boolean <- nil? in - 70 compare nil?, 0/false - 71 break-if-= - 72 # nil is a literal - 73 trace-text trace, "eval", "nil" - 74 copy-object _in-ah, _out-ah - 75 trace-higher trace - 76 return - 77 } - 78 var in-type/ecx: (addr int) <- get in, type - 79 compare *in-type, 1/number - 80 { - 81 break-if-!= - 82 # numbers are literals - 83 trace-text trace, "eval", "number" - 84 copy-object _in-ah, _out-ah - 85 trace-higher trace - 86 return - 87 } - 88 compare *in-type, 3/stream - 89 { - 90 break-if-!= - 91 # streams are literals - 92 trace-text trace, "eval", "stream" - 93 copy-object _in-ah, _out-ah - 94 trace-higher trace - 95 return - 96 } - 97 compare *in-type, 2/symbol - 98 { - 99 break-if-!= - 100 trace-text trace, "eval", "symbol" - 101 debug-print "a", 7/fg, 0/bg - 102 lookup-symbol in, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell - 103 debug-print "z", 7/fg, 0/bg - 104 trace-higher trace - 105 return - 106 } - 107 compare *in-type, 5/screen - 108 { - 109 break-if-!= - 110 trace-text trace, "eval", "screen" - 111 copy-object _in-ah, _out-ah - 112 trace-higher trace - 113 return - 114 } - 115 compare *in-type, 6/keyboard - 116 { - 117 break-if-!= - 118 trace-text trace, "eval", "keyboard" - 119 copy-object _in-ah, _out-ah - 120 trace-higher trace - 121 return - 122 } - 123 # 'in' is a syntax tree - 124 $evaluate:literal-function: { - 125 # trees starting with "litfn" are literals - 126 var expr/esi: (addr cell) <- copy in - 127 var in/edx: (addr cell) <- copy in - 128 var first-ah/ecx: (addr handle cell) <- get in, left - 129 var first/eax: (addr cell) <- lookup *first-ah - 130 var litfn?/eax: boolean <- litfn? first - 131 compare litfn?, 0/false - 132 break-if-= - 133 trace-text trace, "eval", "literal function" - 134 copy-object _in-ah, _out-ah - 135 trace-higher trace - 136 return - 137 } - 138 $evaluate:literal-macro: { - 139 # trees starting with "litmac" are literals - 140 var expr/esi: (addr cell) <- copy in - 141 var in/edx: (addr cell) <- copy in - 142 var first-ah/ecx: (addr handle cell) <- get in, left - 143 var first/eax: (addr cell) <- lookup *first-ah - 144 var litmac?/eax: boolean <- litmac? first - 145 compare litmac?, 0/false - 146 break-if-= - 147 trace-text trace, "eval", "literal macro" - 148 copy-object _in-ah, _out-ah - 149 trace-higher trace - 150 return - 151 } - 152 $evaluate:anonymous-function: { - 153 # trees starting with "fn" are anonymous functions - 154 var expr/esi: (addr cell) <- copy in - 155 var in/edx: (addr cell) <- copy in - 156 var first-ah/ecx: (addr handle cell) <- get in, left - 157 var first/eax: (addr cell) <- lookup *first-ah - 158 var fn?/eax: boolean <- fn? first - 159 compare fn?, 0/false - 160 break-if-= - 161 # turn (fn ...) into (litfn env ...) - 162 trace-text trace, "eval", "anonymous function" - 163 var rest-ah/eax: (addr handle cell) <- get in, right - 164 var tmp: (handle cell) - 165 var tmp-ah/edi: (addr handle cell) <- address tmp - 166 new-pair tmp-ah, env-h, *rest-ah - 167 var litfn: (handle cell) - 168 var litfn-ah/eax: (addr handle cell) <- address litfn - 169 new-symbol litfn-ah, "litfn" - 170 new-pair _out-ah, *litfn-ah, *tmp-ah - 171 trace-higher trace - 172 return - 173 } - 174 # builtins with "special" evaluation rules - 175 $evaluate:quote: { - 176 # trees starting with single quote create literals - 177 var expr/esi: (addr cell) <- copy in - 178 # if its first elem is not "'", break - 179 var first-ah/ecx: (addr handle cell) <- get in, left - 180 var rest-ah/edx: (addr handle cell) <- get in, right - 181 var first/eax: (addr cell) <- lookup *first-ah - 182 var quote?/eax: boolean <- symbol-equal? first, "'" - 183 compare quote?, 0/false - 184 break-if-= - 185 # - 186 trace-text trace, "eval", "quote" - 187 copy-object rest-ah, _out-ah - 188 trace-higher trace - 189 return - 190 } - 191 $evaluate:backquote: { - 192 # trees starting with single backquote create literals - 193 var expr/esi: (addr cell) <- copy in - 194 # if its first elem is not "'", break - 195 var first-ah/ecx: (addr handle cell) <- get in, left - 196 var rest-ah/edx: (addr handle cell) <- get in, right - 197 var first/eax: (addr cell) <- lookup *first-ah - 198 var backquote?/eax: boolean <- symbol-equal? first, "`" - 199 compare backquote?, 0/false - 200 break-if-= - 201 # - 202 trace-text trace, "eval", "backquote" - 203 debug-print "`(", 7/fg, 0/bg - 204 evaluate-backquote rest-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 205 debug-print ")", 7/fg, 0/bg - 206 trace-higher trace - 207 return - 208 } - 209 $evaluate:def: { - 210 # trees starting with "def" define globals - 211 var expr/esi: (addr cell) <- copy in - 212 # if its first elem is not "def", break - 213 var first-ah/ecx: (addr handle cell) <- get in, left - 214 var rest-ah/edx: (addr handle cell) <- get in, right - 215 var first/eax: (addr cell) <- lookup *first-ah - 216 var def?/eax: boolean <- symbol-equal? first, "def" - 217 compare def?, 0/false - 218 break-if-= - 219 # - 220 trace-text trace, "eval", "def" - 221 trace-text trace, "eval", "evaluating second arg" - 222 var rest/eax: (addr cell) <- lookup *rest-ah - 223 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 224 { - 225 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 226 var first-arg-type/eax: (addr int) <- get first-arg, type - 227 compare *first-arg-type, 2/symbol - 228 break-if-= - 229 error trace, "first arg to def must be a symbol" - 230 trace-higher trace - 231 return - 232 } - 233 rest-ah <- get rest, right - 234 rest <- lookup *rest-ah - 235 var second-arg-ah/edx: (addr handle cell) <- get rest, left - 236 debug-print "P", 4/fg, 0/bg - 237 increment call-number - 238 evaluate second-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 239 debug-print "Q", 4/fg, 0/bg - 240 trace-text trace, "eval", "saving global binding" - 241 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 242 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data - 243 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah - 244 var tmp-string: (handle array byte) - 245 var tmp-ah/edx: (addr handle array byte) <- address tmp-string - 246 rewind-stream first-arg-data - 247 stream-to-array first-arg-data, tmp-ah - 248 var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah - 249 var out-ah/edi: (addr handle cell) <- copy _out-ah - 250 assign-or-create-global globals, first-arg-data-string, *out-ah, trace - 251 trace-higher trace - 252 return - 253 } - 254 $evaluate:set: { - 255 # trees starting with "set" mutate bindings - 256 var expr/esi: (addr cell) <- copy in - 257 # if its first elem is not "set", break - 258 var first-ah/ecx: (addr handle cell) <- get in, left - 259 var rest-ah/edx: (addr handle cell) <- get in, right - 260 var first/eax: (addr cell) <- lookup *first-ah - 261 var set?/eax: boolean <- symbol-equal? first, "set" - 262 compare set?, 0/false - 263 break-if-= - 264 # - 265 trace-text trace, "eval", "set" - 266 trace-text trace, "eval", "evaluating second arg" - 267 var rest/eax: (addr cell) <- lookup *rest-ah - 268 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 269 { - 270 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 271 var first-arg-type/eax: (addr int) <- get first-arg, type - 272 compare *first-arg-type, 2/symbol - 273 break-if-= - 274 error trace, "first arg to set must be a symbol" - 275 trace-higher trace - 276 return - 277 } - 278 rest-ah <- get rest, right - 279 rest <- lookup *rest-ah - 280 var second-arg-ah/edx: (addr handle cell) <- get rest, left - 281 debug-print "P", 4/fg, 0/bg - 282 increment call-number - 283 evaluate second-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 284 debug-print "Q", 4/fg, 0/bg - 285 trace-text trace, "eval", "mutating binding" - 286 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 287 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data - 288 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah - 289 mutate-binding first-arg-data, _out-ah, env-h, globals, trace - 290 trace-higher trace - 291 return - 292 } - 293 $evaluate:and: { - 294 var expr/esi: (addr cell) <- copy in - 295 # if its first elem is not "and", break - 296 var first-ah/ecx: (addr handle cell) <- get in, left - 297 var rest-ah/edx: (addr handle cell) <- get in, right - 298 var first/eax: (addr cell) <- lookup *first-ah - 299 var and?/eax: boolean <- symbol-equal? first, "and" - 300 compare and?, 0/false - 301 break-if-= - 302 # - 303 trace-text trace, "eval", "and" - 304 trace-text trace, "eval", "evaluating first arg" - 305 var rest/eax: (addr cell) <- lookup *rest-ah - 306 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 307 debug-print "R2", 4/fg, 0/bg - 308 increment call-number - 309 evaluate first-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 310 debug-print "S2", 4/fg, 0/bg - 311 # if first arg is nil, short-circuit - 312 var out-ah/eax: (addr handle cell) <- copy _out-ah - 313 var out/eax: (addr cell) <- lookup *out-ah - 314 var nil?/eax: boolean <- nil? out - 315 compare nil?, 0/false - 316 { - 317 break-if-= - 318 return - 319 } - 320 var rest/eax: (addr cell) <- lookup *rest-ah - 321 rest-ah <- get rest, right - 322 rest <- lookup *rest-ah - 323 var second-ah/eax: (addr handle cell) <- get rest, left - 324 debug-print "T2", 4/fg, 0/bg - 325 increment call-number - 326 evaluate second-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 327 debug-print "U2", 4/fg, 0/bg - 328 trace-higher trace - 329 return - 330 } - 331 $evaluate:or: { - 332 var expr/esi: (addr cell) <- copy in - 333 # if its first elem is not "or", break - 334 var first-ah/ecx: (addr handle cell) <- get in, left - 335 var rest-ah/edx: (addr handle cell) <- get in, right - 336 var first/eax: (addr cell) <- lookup *first-ah - 337 var or?/eax: boolean <- symbol-equal? first, "or" - 338 compare or?, 0/false - 339 break-if-= - 340 # - 341 trace-text trace, "eval", "or" - 342 trace-text trace, "eval", "evaluating first arg" - 343 var rest/eax: (addr cell) <- lookup *rest-ah - 344 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 345 debug-print "R2", 4/fg, 0/bg - 346 increment call-number - 347 evaluate first-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 348 debug-print "S2", 4/fg, 0/bg - 349 # if first arg is not nil, short-circuit - 350 var out-ah/eax: (addr handle cell) <- copy _out-ah - 351 var out/eax: (addr cell) <- lookup *out-ah - 352 var nil?/eax: boolean <- nil? out - 353 compare nil?, 0/false - 354 { - 355 break-if-!= - 356 return - 357 } - 358 var rest/eax: (addr cell) <- lookup *rest-ah - 359 rest-ah <- get rest, right - 360 rest <- lookup *rest-ah - 361 var second-ah/eax: (addr handle cell) <- get rest, left - 362 debug-print "T2", 4/fg, 0/bg - 363 increment call-number - 364 evaluate second-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 365 debug-print "U2", 4/fg, 0/bg - 366 trace-higher trace - 367 return - 368 } - 369 $evaluate:if: { - 370 # trees starting with "if" are conditionals - 371 var expr/esi: (addr cell) <- copy in - 372 # if its first elem is not "if", break - 373 var first-ah/ecx: (addr handle cell) <- get in, left - 374 var rest-ah/edx: (addr handle cell) <- get in, right - 375 var first/eax: (addr cell) <- lookup *first-ah - 376 var if?/eax: boolean <- symbol-equal? first, "if" - 377 compare if?, 0/false - 378 break-if-= - 379 # - 380 trace-text trace, "eval", "if" - 381 trace-text trace, "eval", "evaluating first arg" - 382 var rest/eax: (addr cell) <- lookup *rest-ah - 383 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 384 var guard-h: (handle cell) - 385 var guard-ah/esi: (addr handle cell) <- address guard-h - 386 debug-print "R", 4/fg, 0/bg - 387 increment call-number - 388 evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 389 debug-print "S", 4/fg, 0/bg - 390 rest-ah <- get rest, right - 391 rest <- lookup *rest-ah - 392 var branch-ah/edi: (addr handle cell) <- get rest, left - 393 var guard-a/eax: (addr cell) <- lookup *guard-ah - 394 var skip-to-third-arg?/eax: boolean <- nil? guard-a - 395 compare skip-to-third-arg?, 0/false - 396 { - 397 break-if-= - 398 trace-text trace, "eval", "skipping to third arg" - 399 var rest/eax: (addr cell) <- lookup *rest-ah - 400 rest-ah <- get rest, right - 401 rest <- lookup *rest-ah - 402 branch-ah <- get rest, left - 403 } - 404 debug-print "T", 4/fg, 0/bg - 405 increment call-number - 406 evaluate branch-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 407 debug-print "U", 4/fg, 0/bg - 408 trace-higher trace - 409 return - 410 } - 411 $evaluate:while: { - 412 # trees starting with "while" are loops - 413 var expr/esi: (addr cell) <- copy in - 414 # if its first elem is not "while", break - 415 var first-ah/ecx: (addr handle cell) <- get in, left - 416 var rest-ah/edx: (addr handle cell) <- get in, right - 417 var first/eax: (addr cell) <- lookup *first-ah - 418 var first-type/ecx: (addr int) <- get first, type - 419 compare *first-type, 2/symbol - 420 break-if-!= - 421 var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data - 422 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 423 var while?/eax: boolean <- stream-data-equal? sym-data, "while" - 424 compare while?, 0/false - 425 break-if-= - 426 # - 427 trace-text trace, "eval", "while" - 428 var rest/eax: (addr cell) <- lookup *rest-ah - 429 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 430 rest-ah <- get rest, right - 431 var guard-h: (handle cell) - 432 var guard-ah/esi: (addr handle cell) <- address guard-h - 433 $evaluate:while:loop-execution: { - 434 { - 435 compare trace, 0 - 436 break-if-= - 437 var error?/eax: boolean <- has-errors? trace - 438 compare error?, 0/false - 439 break-if-!= $evaluate:while:loop-execution - 440 } - 441 trace-text trace, "eval", "loop termination check" - 442 debug-print "V", 4/fg, 0/bg - 443 increment call-number - 444 evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 445 debug-print "W", 4/fg, 0/bg - 446 var guard-a/eax: (addr cell) <- lookup *guard-ah - 447 var done?/eax: boolean <- nil? guard-a - 448 compare done?, 0/false - 449 break-if-!= - 450 evaluate-exprs rest-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 451 loop - 452 } - 453 trace-text trace, "eval", "loop terminated" - 454 trace-higher trace - 455 return - 456 } - 457 trace-text trace, "eval", "function call" - 458 trace-text trace, "eval", "evaluating list elements" - 459 trace-lower trace - 460 var evaluated-list-storage: (handle cell) - 461 var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage - 462 var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah - 463 var curr/ecx: (addr cell) <- copy in - 464 $evaluate-list:loop: { - 465 allocate-pair curr-out-ah - 466 var nil?/eax: boolean <- nil? curr - 467 compare nil?, 0/false - 468 break-if-!= - 469 # eval left - 470 var curr-out/eax: (addr cell) <- lookup *curr-out-ah - 471 var left-out-ah/edi: (addr handle cell) <- get curr-out, left - 472 var left-ah/esi: (addr handle cell) <- get curr, left - 473 debug-print "A", 4/fg, 0/bg - 474 increment call-number - 475 evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 476 debug-print "B", 4/fg, 0/bg - 477 # a trip wire in case we're running without a trace (e.g. when loading the initial state from disk) - 478 { - 479 compare trace, 0 - 480 break-if-!= - 481 var left-out/eax: (addr cell) <- lookup *left-out-ah - 482 compare left-out, 0 - 483 { - 484 break-if-!= - 485 abort "there was some error (likely in syntax): eval-list" - 486 } - 487 } - 488 # - 489 curr-out-ah <- get curr-out, right - 490 var right-ah/eax: (addr handle cell) <- get curr, right - 491 var right/eax: (addr cell) <- lookup *right-ah - 492 curr <- copy right - 493 loop - 494 } - 495 trace-higher trace - 496 var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah - 497 var function-ah/ecx: (addr handle cell) <- get evaluated-list, left - 498 var args-ah/edx: (addr handle cell) <- get evaluated-list, right - 499 debug-print "C", 4/fg, 0/bg - 500 apply function-ah, args-ah, _out-ah, globals, trace, screen-cell, keyboard-cell, call-number - 501 debug-print "Y", 4/fg, 0/bg - 502 trace-higher trace - 503 +-- 11 lines: # trace "=> " _out-ah ----------------------------------------------------------------------------------------------------------------------------------------------------- - 514 debug-print "Z", 4/fg, 0/bg - 515 } - 516 - 517 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 { - 518 var f-ah/eax: (addr handle cell) <- copy _f-ah - 519 var _f/eax: (addr cell) <- lookup *f-ah - 520 var f/esi: (addr cell) <- copy _f - 521 # call primitive functions - 522 { - 523 var f-type/eax: (addr int) <- get f, type - 524 compare *f-type, 4/primitive-function - 525 break-if-!= - 526 apply-primitive f, args-ah, out, globals, trace - 527 return - 528 } - 529 # if it's not a primitive function it must be an anonymous function - 530 +-- 14 lines: # trace "apply anonymous function " f " in environment " env -------------------------------------------------------------------------------------------------------------- - 544 trace-lower trace - 545 { - 546 var f-type/ecx: (addr int) <- get f, type - 547 compare *f-type, 0/pair - 548 break-if-!= - 549 var first-ah/eax: (addr handle cell) <- get f, left - 550 var first/eax: (addr cell) <- lookup *first-ah - 551 var litfn?/eax: boolean <- litfn? first - 552 compare litfn?, 0/false - 553 break-if-= - 554 var rest-ah/esi: (addr handle cell) <- get f, right - 555 var rest/eax: (addr cell) <- lookup *rest-ah - 556 var callee-env-ah/edx: (addr handle cell) <- get rest, left - 557 rest-ah <- get rest, right - 558 rest <- lookup *rest-ah - 559 var params-ah/ecx: (addr handle cell) <- get rest, left - 560 var body-ah/eax: (addr handle cell) <- get rest, right - 561 debug-print "D", 7/fg, 0/bg - 562 apply-function params-ah, args-ah, body-ah, out, *callee-env-ah, globals, trace, screen-cell, keyboard-cell, call-number - 563 debug-print "Y", 7/fg, 0/bg - 564 trace-higher trace - 565 return - 566 } - 567 error trace, "unknown function" - 568 } - 569 - 570 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 { - 571 # push bindings for params to env - 572 var new-env-h: (handle cell) - 573 var new-env-ah/esi: (addr handle cell) <- address new-env-h - 574 push-bindings params-ah, args-ah, env-h, new-env-ah, trace - 575 # - 576 evaluate-exprs body-ah, out, new-env-h, globals, trace, screen-cell, keyboard-cell, call-number - 577 } - 578 - 579 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 { - 580 # eval all exprs, writing result to `out` each time - 581 var exprs-ah/ecx: (addr handle cell) <- copy _exprs-ah - 582 $evaluate-exprs:loop: { - 583 var exprs/eax: (addr cell) <- lookup *exprs-ah - 584 # stop when exprs is nil - 585 { - 586 var exprs-nil?/eax: boolean <- nil? exprs - 587 compare exprs-nil?, 0/false - 588 break-if-!= $evaluate-exprs:loop - 589 } - 590 # evaluate each expression, writing result to `out` - 591 { - 592 var curr-ah/eax: (addr handle cell) <- get exprs, left - 593 debug-print "E", 7/fg, 0/bg - 594 increment call-number - 595 evaluate curr-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 596 debug-print "X", 7/fg, 0/bg - 597 } - 598 # - 599 exprs-ah <- get exprs, right - 600 loop - 601 } - 602 # `out` contains result of evaluating final expression - 603 } - 604 - 605 # Bind params to corresponding args and add the bindings to old-env. Return - 606 # the result in env-ah. - 607 # - 608 # We never modify old-env, but we point to it. This way other parts of the - 609 # interpreter can continue using old-env, and everything works harmoniously - 610 # even though no cells are copied around. - 611 # - 612 # env should always be a DAG (ignoring internals of values). It doesn't have - 613 # to be a tree (some values may be shared), but there are also no cycles. - 614 # - 615 # Learn more: https://en.wikipedia.org/wiki/Persistent_data_structure - 616 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) { - 617 var params-ah/edx: (addr handle cell) <- copy _params-ah - 618 var args-ah/ebx: (addr handle cell) <- copy _args-ah - 619 var _params/eax: (addr cell) <- lookup *params-ah - 620 var params/esi: (addr cell) <- copy _params - 621 { - 622 var params-nil?/eax: boolean <- nil? params - 623 compare params-nil?, 0/false - 624 break-if-= - 625 # nil is a literal - 626 trace-text trace, "eval", "done with push-bindings" - 627 copy-handle old-env-h, env-ah - 628 return - 629 } - 630 # Params can only be symbols or pairs. Args can be anything. - 631 +-- 16 lines: # trace "pushing bindings from " params " to " args ----------------------------------------------------------------------------------------------------------------------- - 647 trace-lower trace - 648 var params-type/eax: (addr int) <- get params, type - 649 compare *params-type, 2/symbol + 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 + 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 + 41 break-if-= + 42 var y/ecx: int <- render-screen 0/screen, screen-obj, 0x70/xmin, 1/ymin + 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 + 116 return + 117 } + 118 compare *in-type, 6/keyboard + 119 { + 120 break-if-!= + 121 trace-text trace, "eval", "keyboard" + 122 copy-object _in-ah, _out-ah + 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 break-if-!= - 652 trace-text trace, "eval", "symbol; binding to all remaining args" - 653 # create a new binding - 654 var new-binding-storage: (handle cell) - 655 var new-binding-ah/eax: (addr handle cell) <- address new-binding-storage - 656 new-pair new-binding-ah, *params-ah, *args-ah - 657 # push it to env - 658 new-pair env-ah, *new-binding-ah, old-env-h - 659 trace-higher trace - 660 return - 661 } - 662 compare *params-type, 0/pair - 663 { - 664 break-if-= - 665 error trace, "cannot bind a non-symbol" - 666 trace-higher trace - 667 return - 668 } - 669 var _args/eax: (addr cell) <- lookup *args-ah - 670 var args/edi: (addr cell) <- copy _args - 671 # params is now a pair, so args must be also - 672 var args-type/eax: (addr int) <- get args, type - 673 compare *args-type, 0/pair - 674 { - 675 break-if-= - 676 error trace, "args not in a proper list" - 677 trace-higher trace - 678 return - 679 } - 680 var intermediate-env-storage: (handle cell) - 681 var intermediate-env-ah/edx: (addr handle cell) <- address intermediate-env-storage - 682 var first-param-ah/eax: (addr handle cell) <- get params, left - 683 var first-arg-ah/ecx: (addr handle cell) <- get args, left - 684 push-bindings first-param-ah, first-arg-ah, old-env-h, intermediate-env-ah, trace - 685 var remaining-params-ah/eax: (addr handle cell) <- get params, right - 686 var remaining-args-ah/ecx: (addr handle cell) <- get args, right - 687 push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace - 688 trace-higher trace - 689 } - 690 - 691 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) { - 692 # trace sym - 693 { - 694 compare trace, 0 - 695 break-if-= - 696 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` - 697 var stream/ecx: (addr stream byte) <- address stream-storage - 698 write stream, "look up " - 699 var sym2/eax: (addr cell) <- copy sym - 700 var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data - 701 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 702 rewind-stream sym-data - 703 write-stream stream, sym-data - 704 write stream, " in " - 705 var env-ah/eax: (addr handle cell) <- address env-h - 706 print-cell env-ah, stream, 0/no-trace - 707 trace trace, "eval", stream - 708 } - 709 trace-lower trace - 710 var _env/eax: (addr cell) <- lookup env-h - 711 var env/ebx: (addr cell) <- copy _env - 712 # if env is not a list, abort - 713 { - 714 var env-type/ecx: (addr int) <- get env, type - 715 compare *env-type, 0/pair - 716 break-if-= - 717 error trace, "eval found a non-list environment" - 718 trace-higher trace - 719 return - 720 } - 721 # if env is nil, look up in globals - 722 { - 723 var env-nil?/eax: boolean <- nil? env - 724 compare env-nil?, 0/false - 725 break-if-= - 726 debug-print "b", 7/fg, 0/bg - 727 lookup-symbol-in-globals sym, out, globals, trace, screen-cell, keyboard-cell - 728 debug-print "x", 7/fg, 0/bg - 729 trace-higher trace - 730 +-- 15 lines: # trace "=> " out " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- - 745 debug-print "y", 7/fg, 0/bg - 746 return - 747 } - 748 # check car - 749 var env-head-storage: (handle cell) - 750 var env-head-ah/eax: (addr handle cell) <- address env-head-storage - 751 car env, env-head-ah, 0/no-trace - 752 var _env-head/eax: (addr cell) <- lookup *env-head-ah - 753 var env-head/ecx: (addr cell) <- copy _env-head - 754 # if car is not a list, abort - 755 { - 756 var env-head-type/eax: (addr int) <- get env-head, type - 757 compare *env-head-type, 0/pair + 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, "environment is not a list of (key . value) pairs" - 760 trace-higher trace + 759 error trace, "cannot bind a non-symbol" + 760 trace-higher trace 761 return 762 } - 763 # check key - 764 var curr-key-storage: (handle cell) - 765 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage - 766 car env-head, curr-key-ah, trace - 767 var curr-key/eax: (addr cell) <- lookup *curr-key-ah - 768 # if key is not a symbol, abort - 769 { - 770 var curr-key-type/eax: (addr int) <- get curr-key, type - 771 compare *curr-key-type, 2/symbol - 772 break-if-= - 773 error trace, "environment contains a binding for a non-symbol" - 774 trace-higher trace - 775 return - 776 } - 777 # if key matches sym, return val - 778 var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace - 779 compare match?, 0/false - 780 { - 781 break-if-= - 782 cdr env-head, out, 0/no-trace - 783 +-- 15 lines: # trace "=> " out " (match)" ---------------------------------------------------------------------------------------------------------------------------------------------- - 798 trace-higher trace - 799 return - 800 } - 801 # otherwise recurse - 802 var env-tail-storage: (handle cell) - 803 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage - 804 cdr env, env-tail-ah, trace - 805 lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell, keyboard-cell - 806 trace-higher trace - 807 +-- 15 lines: # trace "=> " out " (recurse)" -------------------------------------------------------------------------------------------------------------------------------------------- - 822 } - 823 - 824 fn test-lookup-symbol-in-env { - 825 # tmp = (a . 3) - 826 var val-storage: (handle cell) - 827 var val-ah/ecx: (addr handle cell) <- address val-storage - 828 new-integer val-ah, 3 - 829 var key-storage: (handle cell) - 830 var key-ah/edx: (addr handle cell) <- address key-storage - 831 new-symbol key-ah, "a" - 832 var env-storage: (handle cell) - 833 var env-ah/ebx: (addr handle cell) <- address env-storage - 834 new-pair env-ah, *key-ah, *val-ah - 835 # env = ((a . 3)) - 836 var nil-storage: (handle cell) - 837 var nil-ah/ecx: (addr handle cell) <- address nil-storage - 838 allocate-pair nil-ah - 839 new-pair env-ah, *env-ah, *nil-ah - 840 # lookup sym(a) in env tmp - 841 var tmp-storage: (handle cell) - 842 var tmp-ah/edx: (addr handle cell) <- address tmp-storage - 843 new-symbol tmp-ah, "a" - 844 var in/eax: (addr cell) <- lookup *tmp-ah - 845 lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard - 846 var result/eax: (addr cell) <- lookup *tmp-ah - 847 var result-type/edx: (addr int) <- get result, type - 848 check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0" - 849 var result-value-addr/eax: (addr float) <- get result, number-data - 850 var result-value/eax: int <- convert *result-value-addr - 851 check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1" - 852 } - 853 - 854 fn test-lookup-symbol-in-globals { - 855 var globals-storage: global-table - 856 var globals/edi: (addr global-table) <- address globals-storage - 857 initialize-globals globals - 858 # env = nil - 859 var nil-storage: (handle cell) - 860 var nil-ah/ecx: (addr handle cell) <- address nil-storage - 861 allocate-pair nil-ah - 862 # lookup sym(a), env - 863 var tmp-storage: (handle cell) - 864 var tmp-ah/ebx: (addr handle cell) <- address tmp-storage - 865 new-symbol tmp-ah, "+" - 866 var in/eax: (addr cell) <- lookup *tmp-ah - 867 lookup-symbol in, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard - 868 var result/eax: (addr cell) <- lookup *tmp-ah - 869 var result-type/edx: (addr int) <- get result, type - 870 check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0" - 871 var result-value/eax: (addr int) <- get result, index-data - 872 check-ints-equal *result-value, 1/add, "F - test-lookup-symbol-in-globals/1" - 873 } - 874 - 875 fn mutate-binding name: (addr stream byte), val: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace) { - 876 # trace name + 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 + 787 { + 788 var error?/eax: boolean <- has-errors? trace + 789 compare error?, 0/false + 790 break-if-= + 791 trace-higher trace + 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 compare trace, 0 - 879 break-if-= - 880 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` - 881 var stream/ecx: (addr stream byte) <- address stream-storage - 882 write stream, "bind " - 883 rewind-stream name - 884 write-stream stream, name - 885 write stream, " to " - 886 print-cell val, stream, 0/no-trace - 887 write stream, " in " - 888 var env-ah/eax: (addr handle cell) <- address env-h - 889 print-cell env-ah, stream, 0/no-trace - 890 trace trace, "eval", stream - 891 } - 892 trace-lower trace - 893 var _env/eax: (addr cell) <- lookup env-h - 894 var env/ebx: (addr cell) <- copy _env - 895 # if env is not a list, abort - 896 { - 897 var env-type/ecx: (addr int) <- get env, type - 898 compare *env-type, 0/pair - 899 break-if-= - 900 error trace, "eval found a non-list environment" - 901 trace-higher trace - 902 return - 903 } - 904 # if env is nil, look in globals - 905 { - 906 var env-nil?/eax: boolean <- nil? env - 907 compare env-nil?, 0/false - 908 break-if-= - 909 debug-print "b", 3/fg, 0/bg - 910 mutate-binding-in-globals name, val, globals, trace - 911 debug-print "x", 3/fg, 0/bg - 912 trace-higher trace - 913 +-- 15 lines: # trace "=> " val " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- - 928 debug-print "y", 3/fg, 0/bg - 929 return - 930 } - 931 # check car - 932 var env-head-storage: (handle cell) - 933 var env-head-ah/eax: (addr handle cell) <- address env-head-storage - 934 car env, env-head-ah, 0/no-trace - 935 var _env-head/eax: (addr cell) <- lookup *env-head-ah - 936 var env-head/ecx: (addr cell) <- copy _env-head - 937 # if car is not a list, abort - 938 { - 939 var env-head-type/eax: (addr int) <- get env-head, type - 940 compare *env-head-type, 0/pair - 941 break-if-= - 942 error trace, "environment is not a list of (key . value) pairs" - 943 trace-higher trace - 944 return - 945 } - 946 # check key - 947 var curr-key-storage: (handle cell) - 948 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage - 949 car env-head, curr-key-ah, trace - 950 var curr-key/eax: (addr cell) <- lookup *curr-key-ah - 951 # if key is not a symbol, abort - 952 { - 953 var curr-key-type/eax: (addr int) <- get curr-key, type - 954 compare *curr-key-type, 2/symbol - 955 break-if-= - 956 error trace, "environment contains a binding for a non-symbol" - 957 trace-higher trace - 958 return - 959 } - 960 # if key matches name, return val - 961 var curr-key-data-ah/eax: (addr handle stream byte) <- get curr-key, text-data - 962 var curr-key-data/eax: (addr stream byte) <- lookup *curr-key-data-ah - 963 var match?/eax: boolean <- streams-data-equal? curr-key-data, name - 964 compare match?, 0/false - 965 { - 966 break-if-= - 967 var dest/eax: (addr handle cell) <- get env-head, right - 968 copy-object val, dest - 969 trace-text trace, "eval", "=> done" - 970 trace-higher trace - 971 return - 972 } - 973 # otherwise recurse - 974 var env-tail-storage: (handle cell) - 975 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage - 976 cdr env, env-tail-ah, trace - 977 mutate-binding name, val, *env-tail-ah, globals, trace - 978 trace-higher trace - 979 } - 980 - 981 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) { - 982 trace-text trace, "eval", "car" - 983 trace-lower trace - 984 var in/eax: (addr cell) <- copy _in - 985 # if in is not a list, abort - 986 { - 987 var in-type/ecx: (addr int) <- get in, type - 988 compare *in-type, 0/pair - 989 break-if-= - 990 error trace, "car on a non-list" - 991 trace-higher trace - 992 return - 993 } - 994 # if in is nil, abort - 995 { - 996 var in-nil?/eax: boolean <- nil? in - 997 compare in-nil?, 0/false - 998 break-if-= - 999 error trace, "car on nil" -1000 trace-higher trace -1001 return -1002 } -1003 var in-left/eax: (addr handle cell) <- get in, left -1004 copy-object in-left, out -1005 trace-higher trace -1006 return -1007 } -1008 -1009 fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) { -1010 trace-text trace, "eval", "cdr" -1011 trace-lower trace -1012 var in/eax: (addr cell) <- copy _in -1013 # if in is not a list, abort + 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 in-type/ecx: (addr int) <- get in, type -1016 compare *in-type, 0/pair +1015 var should-trace?/eax: boolean <- should-trace? trace +1016 compare should-trace?, 0/false 1017 break-if-= -1018 error trace, "car on a non-list" -1019 trace-higher trace -1020 return -1021 } -1022 # if in is nil, abort -1023 { -1024 var in-nil?/eax: boolean <- nil? in -1025 compare in-nil?, 0/false -1026 break-if-= -1027 error trace, "car on nil" -1028 trace-higher trace -1029 return -1030 } -1031 var in-right/eax: (addr handle cell) <- get in, right -1032 copy-object in-right, out -1033 trace-higher trace -1034 return -1035 } -1036 -1037 fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean { -1038 trace-text trace, "eval", "cell-isomorphic?" -1039 trace-lower trace -1040 var a/esi: (addr cell) <- copy _a -1041 var b/edi: (addr cell) <- copy _b -1042 # if types don't match, return false -1043 var a-type-addr/eax: (addr int) <- get a, type -1044 var b-type-addr/ecx: (addr int) <- get b, type -1045 var b-type/ecx: int <- copy *b-type-addr -1046 compare b-type, *a-type-addr +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 break-if-= -1049 trace-higher trace -1050 trace-text trace, "eval", "=> false (type)" -1051 return 0/false -1052 } -1053 # if types are number, compare number-data -1054 # TODO: exactly comparing floats is a bad idea -1055 compare b-type, 1/number -1056 { -1057 break-if-!= -1058 var a-val-addr/eax: (addr float) <- get a, number-data -1059 var b-val-addr/ecx: (addr float) <- get b, number-data -1060 var a-val/xmm0: float <- copy *a-val-addr -1061 compare a-val, *b-val-addr -1062 { -1063 break-if-= -1064 trace-higher trace -1065 trace-text trace, "eval", "=> false (numbers)" -1066 return 0/false -1067 } -1068 trace-higher trace -1069 trace-text trace, "eval", "=> true (numbers)" -1070 return 1/true -1071 } -1072 $cell-isomorphic?:text-data: { -1073 { -1074 compare b-type, 2/symbol -1075 break-if-= -1076 compare b-type, 3/stream -1077 break-if-= -1078 break $cell-isomorphic?:text-data -1079 } -1080 var b-val-ah/eax: (addr handle stream byte) <- get b, text-data -1081 var _b-val/eax: (addr stream byte) <- lookup *b-val-ah -1082 var b-val/ecx: (addr stream byte) <- copy _b-val -1083 var a-val-ah/eax: (addr handle stream byte) <- get a, text-data -1084 var a-val/eax: (addr stream byte) <- lookup *a-val-ah -1085 var tmp-array: (handle array byte) -1086 var tmp-ah/edx: (addr handle array byte) <- address tmp-array -1087 rewind-stream a-val -1088 stream-to-array a-val, tmp-ah -1089 var tmp/eax: (addr array byte) <- lookup *tmp-ah -1090 var match?/eax: boolean <- stream-data-equal? b-val, tmp -1091 trace-higher trace -1092 { -1093 compare match?, 0/false -1094 break-if-= -1095 trace-text trace, "eval", "=> true (symbols)" -1096 } -1097 { -1098 compare match?, 0/false -1099 break-if-!= -1100 trace-text trace, "eval", "=> false (symbols)" -1101 } -1102 return match? -1103 } -1104 # if objects are primitive functions, compare index-data -1105 compare b-type, 4/primitive -1106 { -1107 break-if-!= -1108 var a-val-addr/eax: (addr int) <- get a, index-data -1109 var b-val-addr/ecx: (addr int) <- get b, index-data -1110 var a-val/eax: int <- copy *a-val-addr -1111 compare a-val, *b-val-addr -1112 { -1113 break-if-= -1114 trace-higher trace -1115 trace-text trace, "eval", "=> false (primitives)" -1116 return 0/false -1117 } -1118 trace-higher trace -1119 trace-text trace, "eval", "=> true (primitives)" -1120 return 1/true +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 # if objects are screens, check if they're the same object -1123 compare b-type, 5/screen -1124 { -1125 break-if-!= -1126 var a-val-addr/eax: (addr handle screen) <- get a, screen-data -1127 var b-val-addr/ecx: (addr handle screen) <- get b, screen-data -1128 var result/eax: boolean <- handle-equal? *a-val-addr, *b-val-addr -1129 compare result, 0/false -1130 return result -1131 } -1132 # if objects are keyboards, check if they have the same contents -1133 compare b-type, 6/keyboard -1134 { -1135 break-if-!= -1136 var a-val-addr/ecx: (addr handle gap-buffer) <- get a, keyboard-data -1137 var _a/eax: (addr gap-buffer) <- lookup *a-val-addr -1138 var a/ecx: (addr gap-buffer) <- copy _a -1139 var b-val-addr/eax: (addr handle gap-buffer) <- get b, keyboard-data -1140 var b/eax: (addr gap-buffer) <- lookup *b-val-addr -1141 var result/eax: boolean <- gap-buffers-equal? a, b -1142 return result -1143 } -1144 # if a is nil, b should be nil -1145 { -1146 # (assumes nil? returns 0 or 1) -1147 var _b-nil?/eax: boolean <- nil? b -1148 var b-nil?/ecx: boolean <- copy _b-nil? -1149 var a-nil?/eax: boolean <- nil? a -1150 # a == nil and b == nil => return true -1151 { -1152 compare a-nil?, 0/false -1153 break-if-= -1154 compare b-nil?, 0/false -1155 break-if-= -1156 trace-higher trace -1157 trace-text trace, "eval", "=> true (nils)" -1158 return 1/true -1159 } -1160 # a == nil => return false -1161 { -1162 compare a-nil?, 0/false -1163 break-if-= -1164 trace-higher trace -1165 trace-text trace, "eval", "=> false (b != nil)" -1166 return 0/false -1167 } -1168 # b == nil => return false -1169 { -1170 compare b-nil?, 0/false -1171 break-if-= -1172 trace-higher trace -1173 trace-text trace, "eval", "=> false (a != nil)" -1174 return 0/false -1175 } -1176 } -1177 # a and b are pairs -1178 var a-tmp-storage: (handle cell) -1179 var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage -1180 var b-tmp-storage: (handle cell) -1181 var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage -1182 # if cars aren't equal, return false -1183 car a, a-tmp-ah, trace -1184 car b, b-tmp-ah, trace -1185 { -1186 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah -1187 var a-tmp/ecx: (addr cell) <- copy _a-tmp -1188 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah -1189 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace -1190 compare result, 0/false -1191 break-if-!= -1192 trace-higher trace -1193 trace-text trace, "eval", "=> false (car mismatch)" -1194 return 0/false -1195 } -1196 # recurse on cdrs -1197 cdr a, a-tmp-ah, trace -1198 cdr b, b-tmp-ah, trace -1199 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah -1200 var a-tmp/ecx: (addr cell) <- copy _a-tmp -1201 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah -1202 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace -1203 trace-higher trace -1204 return result -1205 } -1206 -1207 fn fn? _x: (addr cell) -> _/eax: boolean { -1208 var x/esi: (addr cell) <- copy _x -1209 var type/eax: (addr int) <- get x, type -1210 compare *type, 2/symbol -1211 { -1212 break-if-= -1213 return 0/false -1214 } -1215 var contents-ah/eax: (addr handle stream byte) <- get x, text-data -1216 var contents/eax: (addr stream byte) <- lookup *contents-ah -1217 var result/eax: boolean <- stream-data-equal? contents, "fn" -1218 return result -1219 } -1220 -1221 fn litfn? _x: (addr cell) -> _/eax: boolean { -1222 var x/esi: (addr cell) <- copy _x -1223 var type/eax: (addr int) <- get x, type -1224 compare *type, 2/symbol -1225 { -1226 break-if-= -1227 return 0/false -1228 } -1229 var contents-ah/eax: (addr handle stream byte) <- get x, text-data -1230 var contents/eax: (addr stream byte) <- lookup *contents-ah -1231 var result/eax: boolean <- stream-data-equal? contents, "litfn" -1232 return result -1233 } -1234 -1235 fn litmac? _x: (addr cell) -> _/eax: boolean { -1236 var x/esi: (addr cell) <- copy _x -1237 var type/eax: (addr int) <- get x, type -1238 compare *type, 2/symbol -1239 { -1240 break-if-= -1241 return 0/false -1242 } -1243 var contents-ah/eax: (addr handle stream byte) <- get x, text-data -1244 var contents/eax: (addr stream byte) <- lookup *contents-ah -1245 var result/eax: boolean <- stream-data-equal? contents, "litmac" -1246 return result -1247 } -1248 -1249 fn test-evaluate-is-well-behaved { -1250 var t-storage: trace -1251 var t/esi: (addr trace) <- address t-storage -1252 initialize-trace t, 0x10, 0/visible # we don't use trace UI -1253 # env = nil -1254 var env-storage: (handle cell) -1255 var env-ah/ecx: (addr handle cell) <- address env-storage -1256 allocate-pair env-ah -1257 # eval sym(a), nil env -1258 var tmp-storage: (handle cell) -1259 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1260 new-symbol tmp-ah, "a" -1261 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard, 0/call-number -1262 # doesn't die -1263 check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved" -1264 } -1265 -1266 fn test-evaluate-number { -1267 # env = nil -1268 var env-storage: (handle cell) -1269 var env-ah/ecx: (addr handle cell) <- address env-storage -1270 allocate-pair env-ah -1271 # tmp = 3 -1272 var tmp-storage: (handle cell) -1273 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1274 new-integer tmp-ah, 3 -1275 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number -1276 # -1277 var result/eax: (addr cell) <- lookup *tmp-ah -1278 var result-type/edx: (addr int) <- get result, type -1279 check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0" -1280 var result-value-addr/eax: (addr float) <- get result, number-data -1281 var result-value/eax: int <- convert *result-value-addr -1282 check-ints-equal result-value, 3, "F - test-evaluate-number/1" -1283 } -1284 -1285 fn test-evaluate-symbol { -1286 # tmp = (a . 3) -1287 var val-storage: (handle cell) -1288 var val-ah/ecx: (addr handle cell) <- address val-storage -1289 new-integer val-ah, 3 -1290 var key-storage: (handle cell) -1291 var key-ah/edx: (addr handle cell) <- address key-storage -1292 new-symbol key-ah, "a" -1293 var env-storage: (handle cell) -1294 var env-ah/ebx: (addr handle cell) <- address env-storage -1295 new-pair env-ah, *key-ah, *val-ah -1296 # env = ((a . 3)) -1297 var nil-storage: (handle cell) -1298 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1299 allocate-pair nil-ah -1300 new-pair env-ah, *env-ah, *nil-ah -1301 # eval sym(a), env -1302 var tmp-storage: (handle cell) -1303 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1304 new-symbol tmp-ah, "a" -1305 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number -1306 var result/eax: (addr cell) <- lookup *tmp-ah -1307 var result-type/edx: (addr int) <- get result, type -1308 check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0" -1309 var result-value-addr/eax: (addr float) <- get result, number-data -1310 var result-value/eax: int <- convert *result-value-addr -1311 check-ints-equal result-value, 3, "F - test-evaluate-symbol/1" -1312 } -1313 -1314 fn test-evaluate-quote { -1315 # env = nil -1316 var nil-storage: (handle cell) -1317 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1318 allocate-pair nil-ah -1319 # eval `a, env -1320 var tmp-storage: (handle cell) -1321 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1322 new-symbol tmp-ah, "'" -1323 var tmp2-storage: (handle cell) -1324 var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage -1325 new-symbol tmp2-ah, "a" -1326 new-pair tmp-ah, *tmp-ah, *tmp2-ah -1327 evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number -1328 var result/eax: (addr cell) <- lookup *tmp-ah -1329 var result-type/edx: (addr int) <- get result, type -1330 check-ints-equal *result-type, 2/symbol, "F - test-evaluate-quote/0" -1331 var sym?/eax: boolean <- symbol-equal? result, "a" -1332 check sym?, "F - test-evaluate-quote/1" -1333 } -1334 -1335 fn test-evaluate-primitive-function { -1336 var globals-storage: global-table -1337 var globals/edi: (addr global-table) <- address globals-storage -1338 initialize-globals globals -1339 var nil-storage: (handle cell) -1340 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1341 allocate-pair nil-ah -1342 var add-storage: (handle cell) -1343 var add-ah/ebx: (addr handle cell) <- address add-storage -1344 new-symbol add-ah, "+" -1345 # eval +, nil env -1346 var tmp-storage: (handle cell) -1347 var tmp-ah/esi: (addr handle cell) <- address tmp-storage -1348 evaluate add-ah, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number -1349 # -1350 var result/eax: (addr cell) <- lookup *tmp-ah -1351 var result-type/edx: (addr int) <- get result, type -1352 check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0" -1353 var result-value/eax: (addr int) <- get result, index-data -1354 check-ints-equal *result-value, 1/add, "F - test-evaluate-primitive-function/1" -1355 } -1356 -1357 fn test-evaluate-primitive-function-call { -1358 var t-storage: trace -1359 var t/edi: (addr trace) <- address t-storage -1360 initialize-trace t, 0x100, 0/visible # we don't use trace UI -1361 # -1362 var nil-storage: (handle cell) -1363 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1364 allocate-pair nil-ah -1365 var one-storage: (handle cell) -1366 var one-ah/edx: (addr handle cell) <- address one-storage -1367 new-integer one-ah, 1 -1368 var add-storage: (handle cell) -1369 var add-ah/ebx: (addr handle cell) <- address add-storage -1370 new-symbol add-ah, "+" -1371 # input is (+ 1 1) -1372 var tmp-storage: (handle cell) -1373 var tmp-ah/esi: (addr handle cell) <- address tmp-storage -1374 new-pair tmp-ah, *one-ah, *nil-ah -1375 new-pair tmp-ah, *one-ah, *tmp-ah -1376 new-pair tmp-ah, *add-ah, *tmp-ah -1377 #? dump-cell tmp-ah -1378 # -1379 var globals-storage: global-table -1380 var globals/edx: (addr global-table) <- address globals-storage -1381 initialize-globals globals -1382 # -1383 evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/call-number -1384 #? dump-trace t -1385 # -1386 var result/eax: (addr cell) <- lookup *tmp-ah -1387 var result-type/edx: (addr int) <- get result, type -1388 check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0" -1389 var result-value-addr/eax: (addr float) <- get result, number-data -1390 var result-value/eax: int <- convert *result-value-addr -1391 check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1" -1392 } -1393 -1394 fn test-evaluate-backquote { -1395 # env = nil -1396 var nil-storage: (handle cell) -1397 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1398 allocate-pair nil-ah -1399 # eval `a, env -1400 var tmp-storage: (handle cell) -1401 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1402 new-symbol tmp-ah, "`" -1403 var tmp2-storage: (handle cell) -1404 var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage -1405 new-symbol tmp2-ah, "a" -1406 new-pair tmp-ah, *tmp-ah, *tmp2-ah -1407 clear-object tmp2-ah -1408 evaluate tmp-ah, tmp2-ah, *nil-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number -1409 var result/eax: (addr cell) <- lookup *tmp2-ah -1410 var result-type/edx: (addr int) <- get result, type -1411 check-ints-equal *result-type, 2/symbol, "F - test-evaluate-backquote/0" -1412 var sym?/eax: boolean <- symbol-equal? result, "a" -1413 check sym?, "F - test-evaluate-backquote/1" -1414 } -1415 -1416 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 { -1417 # stack overflow? # disable when enabling Really-debug-print -1418 #? dump-cell-from-cursor-over-full-screen _in-ah -1419 check-stack -1420 { -1421 var screen-cell/eax: (addr handle cell) <- copy screen-cell -1422 compare screen-cell, 0 -1423 break-if-= -1424 var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell -1425 compare screen-cell-addr, 0 -1426 break-if-= -1427 # if screen-cell exists, we're probably not in a test -1428 show-stack-state -1429 } -1430 # errors? skip -1431 { -1432 compare trace, 0 -1433 break-if-= -1434 var error?/eax: boolean <- has-errors? trace -1435 compare error?, 0/false -1436 break-if-= -1437 return -1438 } -1439 var in-ah/esi: (addr handle cell) <- copy _in-ah -1440 var in/eax: (addr cell) <- lookup *in-ah -1441 { -1442 var nil?/eax: boolean <- nil? in -1443 compare nil?, 0/false -1444 break-if-= -1445 # nil is a literal -1446 trace-text trace, "eval", "backquote nil" -1447 copy-object _in-ah, _out-ah -1448 trace-higher trace -1449 return -1450 } -1451 var in-type/ecx: (addr int) <- get in, type -1452 compare *in-type, 0/pair -1453 { -1454 break-if-= -1455 # copy non-pairs directly -1456 # TODO: streams might need to be copied -1457 trace-text trace, "eval", "backquote atom" -1458 copy-object _in-ah, _out-ah -1459 trace-higher trace -1460 return -1461 } -1462 # 'in' is a pair -1463 debug-print "()", 4/fg, 0/bg -1464 var in-ah/esi: (addr handle cell) <- copy _in-ah -1465 var _in/eax: (addr cell) <- lookup *in-ah -1466 var in/ebx: (addr cell) <- copy _in -1467 var in-left-ah/ecx: (addr handle cell) <- get in, left -1468 debug-print "10", 4/fg, 0/bg -1469 # check for unquote -1470 $macroexpand-iter:unquote: { -1471 var in-left/eax: (addr cell) <- lookup *in-left-ah -1472 var unquote?/eax: boolean <- symbol-equal? in-left, "," -1473 compare unquote?, 0/false -1474 break-if-= -1475 trace-text trace, "eval", "unquote" -1476 var rest-ah/eax: (addr handle cell) <- get in, right -1477 increment call-number -1478 debug-print ",", 3/fg, 0/bg -1479 evaluate rest-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1480 debug-print ",)", 3/fg, 0/bg -1481 return -1482 } -1483 # check for unquote-splice in in-left -1484 debug-print "11", 4/fg, 0/bg -1485 var out-ah/edi: (addr handle cell) <- copy _out-ah -1486 $macroexpand-iter:unquote-splice: { -1487 #? dump-cell-from-cursor-over-full-screen in-left-ah -1488 var in-left/eax: (addr cell) <- lookup *in-left-ah -1489 { -1490 debug-print "12", 4/fg, 0/bg -1491 { -1492 var in-left-is-nil?/eax: boolean <- nil? in-left -1493 compare in-left-is-nil?, 0/false -1494 } -1495 break-if-!= $macroexpand-iter:unquote-splice -1496 var in-left-type/ecx: (addr int) <- get in-left, type -1497 debug-print "13", 4/fg, 0/bg -1498 compare *in-left-type, 0/pair -1499 break-if-!= $macroexpand-iter:unquote-splice -1500 var in-left-left-ah/eax: (addr handle cell) <- get in-left, left -1501 debug-print "14", 4/fg, 0/bg -1502 var in-left-left/eax: (addr cell) <- lookup *in-left-left-ah -1503 debug-print "15", 4/fg, 0/bg -1504 var in-left-left-type/ecx: (addr int) <- get in-left-left, type -1505 var left-is-unquote-splice?/eax: boolean <- symbol-equal? in-left-left, ",@" -1506 debug-print "16", 4/fg, 0/bg -1507 compare left-is-unquote-splice?, 0/false -1508 } -1509 break-if-= -1510 debug-print "17", 4/fg, 0/bg -1511 trace-text trace, "eval", "unquote-splice" -1512 var in-unquote-payload-ah/eax: (addr handle cell) <- get in-left, right -1513 increment call-number -1514 evaluate in-unquote-payload-ah, out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1515 # while (*out-ah != null) out-ah = cdr(out-ah) -1516 { -1517 var out/eax: (addr cell) <- lookup *out-ah -1518 { -1519 var done?/eax: boolean <- nil? out -1520 compare done?, 0/false -1521 } -1522 break-if-!= -1523 out-ah <- get out, right -1524 loop -1525 } -1526 # append result of in-right -1527 var in-right-ah/ecx: (addr handle cell) <- get in, right -1528 evaluate-backquote in-right-ah, out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1529 return -1530 } -1531 debug-print "19", 4/fg, 0/bg -1532 # otherwise continue copying -1533 trace-text trace, "eval", "backquote: copy" -1534 var out-ah/edi: (addr handle cell) <- copy _out-ah -1535 allocate-pair out-ah -1536 debug-print "20", 7/fg, 0/bg -1537 #? dump-cell-from-cursor-over-full-screen out-ah -1538 var out/eax: (addr cell) <- lookup *out-ah -1539 var out-left-ah/edx: (addr handle cell) <- get out, left -1540 debug-print "`(l", 3/fg, 0/bg -1541 evaluate-backquote in-left-ah, out-left-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1542 debug-print "`r)", 3/fg, 0/bg -1543 var in-right-ah/ecx: (addr handle cell) <- get in, right -1544 var out-right-ah/edx: (addr handle cell) <- get out, right -1545 debug-print "`r(", 3/fg, 0/bg -1546 evaluate-backquote in-right-ah, out-right-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number -1547 debug-print "`r)", 3/fg, 0/bg -1548 } -1549 -1550 fn test-evaluate-backquote-list { -1551 var nil-storage: (handle cell) -1552 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1553 allocate-pair nil-ah -1554 var backquote-storage: (handle cell) -1555 var backquote-ah/edx: (addr handle cell) <- address backquote-storage -1556 new-symbol backquote-ah, "`" -1557 # input is `(a b) -1558 var a-storage: (handle cell) -1559 var a-ah/ebx: (addr handle cell) <- address a-storage -1560 new-symbol a-ah, "a" -1561 var b-storage: (handle cell) -1562 var b-ah/esi: (addr handle cell) <- address b-storage -1563 new-symbol b-ah, "b" -1564 var tmp-storage: (handle cell) -1565 var tmp-ah/eax: (addr handle cell) <- address tmp-storage -1566 new-pair tmp-ah, *b-ah, *nil-ah -1567 new-pair tmp-ah, *a-ah, *tmp-ah -1568 new-pair tmp-ah, *backquote-ah, *tmp-ah -1569 # -1570 evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number -1571 # result is (a b) -1572 var result/eax: (addr cell) <- lookup *tmp-ah -1573 { -1574 var result-type/eax: (addr int) <- get result, type -1575 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list/0" -1576 } -1577 { -1578 var a1-ah/eax: (addr handle cell) <- get result, left -1579 var a1/eax: (addr cell) <- lookup *a1-ah -1580 var check1/eax: boolean <- symbol-equal? a1, "a" -1581 check check1, "F - test-evaluate-backquote-list/1" -1582 } -1583 var rest-ah/eax: (addr handle cell) <- get result, right -1584 var rest/eax: (addr cell) <- lookup *rest-ah -1585 { -1586 var a2-ah/eax: (addr handle cell) <- get rest, left -1587 var a2/eax: (addr cell) <- lookup *a2-ah -1588 var check2/eax: boolean <- symbol-equal? a2, "b" -1589 check check2, "F - test-evaluate-backquote-list/2" -1590 } -1591 var rest-ah/eax: (addr handle cell) <- get rest, right -1592 var rest/eax: (addr cell) <- lookup *rest-ah -1593 var check3/eax: boolean <- nil? rest -1594 check check3, "F - test-evaluate-backquote-list/3" -1595 } -1596 -1597 fn test-evaluate-backquote-list-with-unquote { -1598 var nil-h: (handle cell) -1599 var nil-ah/eax: (addr handle cell) <- address nil-h -1600 allocate-pair nil-ah -1601 var backquote-h: (handle cell) -1602 var backquote-ah/eax: (addr handle cell) <- address backquote-h -1603 new-symbol backquote-ah, "`" -1604 var unquote-h: (handle cell) -1605 var unquote-ah/eax: (addr handle cell) <- address unquote-h -1606 new-symbol unquote-ah, "," -1607 var a-h: (handle cell) -1608 var a-ah/eax: (addr handle cell) <- address a-h -1609 new-symbol a-ah, "a" -1610 var b-h: (handle cell) -1611 var b-ah/eax: (addr handle cell) <- address b-h -1612 new-symbol b-ah, "b" -1613 # env = ((b . 3)) -1614 var val-h: (handle cell) -1615 var val-ah/eax: (addr handle cell) <- address val-h -1616 new-integer val-ah, 3 -1617 var env-h: (handle cell) -1618 var env-ah/eax: (addr handle cell) <- address env-h -1619 new-pair env-ah, b-h, val-h -1620 new-pair env-ah, env-h, nil-h -1621 # input is `(a ,b) -1622 var tmp-h: (handle cell) -1623 var tmp-ah/eax: (addr handle cell) <- address tmp-h -1624 # tmp = cons(unquote, b) -1625 new-pair tmp-ah, unquote-h, b-h -1626 # tmp = cons(tmp, nil) -1627 new-pair tmp-ah, tmp-h, nil-h -1628 # tmp = cons(a, tmp) -1629 new-pair tmp-ah, a-h, tmp-h -1630 # tmp = cons(backquote, tmp) -1631 new-pair tmp-ah, backquote-h, tmp-h -1632 # -1633 evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number -1634 # result is (a 3) -1635 var result/eax: (addr cell) <- lookup *tmp-ah -1636 { -1637 var result-type/eax: (addr int) <- get result, type -1638 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote/0" -1639 } -1640 { -1641 var a1-ah/eax: (addr handle cell) <- get result, left -1642 var a1/eax: (addr cell) <- lookup *a1-ah -1643 var check1/eax: boolean <- symbol-equal? a1, "a" -1644 check check1, "F - test-evaluate-backquote-list-with-unquote/1" -1645 } -1646 var rest-ah/eax: (addr handle cell) <- get result, right -1647 var rest/eax: (addr cell) <- lookup *rest-ah -1648 { -1649 var a2-ah/eax: (addr handle cell) <- get rest, left -1650 var a2/eax: (addr cell) <- lookup *a2-ah -1651 var a2-value-addr/eax: (addr float) <- get a2, number-data -1652 var a2-value/eax: int <- convert *a2-value-addr -1653 check-ints-equal a2-value, 3, "F - test-evaluate-backquote-list-with-unquote/2" -1654 } -1655 var rest-ah/eax: (addr handle cell) <- get rest, right -1656 var rest/eax: (addr cell) <- lookup *rest-ah -1657 var check3/eax: boolean <- nil? rest -1658 check check3, "F - test-evaluate-backquote-list-with-unquote/3" -1659 } -1660 -1661 fn test-evaluate-backquote-list-with-unquote-splice { -1662 var nil-h: (handle cell) -1663 var nil-ah/eax: (addr handle cell) <- address nil-h -1664 allocate-pair nil-ah -1665 var backquote-h: (handle cell) -1666 var backquote-ah/eax: (addr handle cell) <- address backquote-h -1667 new-symbol backquote-ah, "`" -1668 var unquote-splice-h: (handle cell) -1669 var unquote-splice-ah/eax: (addr handle cell) <- address unquote-splice-h -1670 new-symbol unquote-splice-ah, ",@" -1671 var a-h: (handle cell) -1672 var a-ah/eax: (addr handle cell) <- address a-h -1673 new-symbol a-ah, "a" -1674 var b-h: (handle cell) -1675 var b-ah/eax: (addr handle cell) <- address b-h -1676 new-symbol b-ah, "b" -1677 # env = ((b . (a 3))) -1678 var val-h: (handle cell) -1679 var val-ah/eax: (addr handle cell) <- address val-h -1680 new-integer val-ah, 3 -1681 new-pair val-ah, val-h, nil-h -1682 new-pair val-ah, a-h, val-h -1683 var env-h: (handle cell) -1684 var env-ah/eax: (addr handle cell) <- address env-h -1685 new-pair env-ah, b-h, val-h -1686 new-pair env-ah, env-h, nil-h -1687 # input is `(a ,@b b) -1688 var tmp-h: (handle cell) -1689 var tmp-ah/eax: (addr handle cell) <- address tmp-h -1690 # tmp = cons(b, nil) -1691 new-pair tmp-ah, b-h, nil-h -1692 # tmp2 = cons(unquote-splice, b) -1693 var tmp2-h: (handle cell) -1694 var tmp2-ah/ecx: (addr handle cell) <- address tmp2-h -1695 new-pair tmp2-ah, unquote-splice-h, b-h -1696 # tmp = cons(tmp2, tmp) -1697 new-pair tmp-ah, tmp2-h, tmp-h -1698 # tmp = cons(a, tmp) -1699 new-pair tmp-ah, a-h, tmp-h -1700 # tmp = cons(backquote, tmp) -1701 new-pair tmp-ah, backquote-h, tmp-h -1702 #? dump-cell-from-cursor-over-full-screen tmp-ah -1703 # -1704 evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number -1705 # result is (a a 3 b) -1706 #? dump-cell-from-cursor-over-full-screen tmp-ah -1707 var result/eax: (addr cell) <- lookup *tmp-ah -1708 { -1709 var result-type/eax: (addr int) <- get result, type -1710 check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote-splice/0" -1711 } -1712 { -1713 var a1-ah/eax: (addr handle cell) <- get result, left -1714 var a1/eax: (addr cell) <- lookup *a1-ah -1715 var check1/eax: boolean <- symbol-equal? a1, "a" -1716 check check1, "F - test-evaluate-backquote-list-with-unquote-splice/1" -1717 } -1718 var rest-ah/eax: (addr handle cell) <- get result, right -1719 var rest/eax: (addr cell) <- lookup *rest-ah -1720 { -1721 var a2-ah/eax: (addr handle cell) <- get rest, left -1722 var a2/eax: (addr cell) <- lookup *a2-ah -1723 var check2/eax: boolean <- symbol-equal? a2, "a" -1724 check check2, "F - test-evaluate-backquote-list-with-unquote-splice/2" -1725 } -1726 var rest-ah/eax: (addr handle cell) <- get rest, right -1727 var rest/eax: (addr cell) <- lookup *rest-ah -1728 { -1729 var a3-ah/eax: (addr handle cell) <- get rest, left -1730 var a3/eax: (addr cell) <- lookup *a3-ah -1731 var a3-value-addr/eax: (addr float) <- get a3, number-data -1732 var a3-value/eax: int <- convert *a3-value-addr -1733 check-ints-equal a3-value, 3, "F - test-evaluate-backquote-list-with-unquote-splice/3" -1734 } -1735 var rest-ah/eax: (addr handle cell) <- get rest, right -1736 var rest/eax: (addr cell) <- lookup *rest-ah -1737 { -1738 var a4-ah/eax: (addr handle cell) <- get rest, left -1739 var a4/eax: (addr cell) <- lookup *a4-ah -1740 var check4/eax: boolean <- symbol-equal? a4, "b" -1741 check check4, "F - test-evaluate-backquote-list-with-unquote-splice/4" -1742 } -1743 var rest-ah/eax: (addr handle cell) <- get rest, right -1744 var rest/eax: (addr cell) <- lookup *rest-ah -1745 var check5/eax: boolean <- nil? rest -1746 check check5, "F - test-evaluate-backquote-list-with-unquote-splice/5" -1747 } +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 +1224 break-if-= +1225 compare b-type, 3/stream +1226 break-if-= +1227 break $cell-isomorphic?:text-data +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 +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 +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 +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 +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 +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 +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 } diff --git a/html/shell/gap-buffer.mu.html b/html/shell/gap-buffer.mu.html index 29e58b75..63864745 100644 --- a/html/shell/gap-buffer.mu.html +++ b/html/shell/gap-buffer.mu.html @@ -203,7 +203,7 @@ if ('onhashchange' in window) { 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 + 147 x2, y2 <- render-grapheme screen, space, xmin, ymin, xmax, ymax, x2, y2, color, bg 148 return x2, y2 149 } 150 diff --git a/html/shell/global.mu.html b/html/shell/global.mu.html index db15c53f..ba1551ce 100644 --- a/html/shell/global.mu.html +++ b/html/shell/global.mu.html @@ -123,41 +123,41 @@ if ('onhashchange' in window) { 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 + 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/ecx: (addr cell) <- copy _remaining - 72 var done?/eax: boolean <- nil? remaining + 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 remaining-ah <- get remaining, right - 79 { - 80 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " ", 2/fg 0/bg - 81 var name-ah/ecx: (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 rewind-stream name-data - 86 draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, name-data, 3/fg, 0/bg - 87 } + 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/edx: (addr handle gap-buffer) <- address value-gap-buffer-storage + 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 + 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 } @@ -213,7 +213,7 @@ if ('onhashchange' in window) { 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 + 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 { @@ -338,7 +338,7 @@ if ('onhashchange' in window) { 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 + 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 } @@ -454,7 +454,7 @@ if ('onhashchange' in window) { 395 write stream, "unbound symbol: " 396 rewind-stream sym-name 397 write-stream stream, sym-name - 398 trace trace, "error", stream + 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) { @@ -565,7 +565,7 @@ if ('onhashchange' in window) { 506 write stream, "unbound symbol: " 507 rewind-stream name 508 write-stream stream, name - 509 trace trace, "error", stream + 509 error-stream trace, stream 510 } 511 512 # a little strange; goes from value to name and selects primitive based on name @@ -828,16 +828,16 @@ if ('onhashchange' in window) { 769 } 770 771 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 772 trace-text trace, "eval", "apply +" + 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 + 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" + 781 error trace, "+ needs 2 args but got 0" 782 return 783 } 784 # args->left->value @@ -847,7 +847,7 @@ if ('onhashchange' in window) { 788 compare *first-type, 1/number 789 { 790 break-if-= - 791 error trace, "first arg for + is not a number" + 791 error trace, "first arg for + is not a number" 792 return 793 } 794 var first-value/ecx: (addr float) <- get first, number-data @@ -863,7 +863,7 @@ if ('onhashchange' in window) { 804 compare *second-type, 1/number 805 { 806 break-if-= - 807 error trace, "second arg for + is not a number" + 807 error trace, "second arg for + is not a number" 808 return 809 } 810 var second-value/edx: (addr float) <- get second, number-data @@ -874,16 +874,16 @@ if ('onhashchange' in window) { 815 } 816 817 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 818 trace-text trace, "eval", "apply -" + 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 + 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" + 827 error trace, "- needs 2 args but got 0" 828 return 829 } 830 # args->left->value @@ -893,7 +893,7 @@ if ('onhashchange' in window) { 834 compare *first-type, 1/number 835 { 836 break-if-= - 837 error trace, "first arg for - is not a number" + 837 error trace, "first arg for - is not a number" 838 return 839 } 840 var first-value/ecx: (addr float) <- get first, number-data @@ -907,7 +907,7 @@ if ('onhashchange' in window) { 848 compare *second-type, 1/number 849 { 850 break-if-= - 851 error trace, "second arg for - is not a number" + 851 error trace, "second arg for - is not a number" 852 return 853 } 854 var second-value/edx: (addr float) <- get second, number-data @@ -918,16 +918,16 @@ if ('onhashchange' in window) { 859 } 860 861 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 862 trace-text trace, "eval", "apply *" + 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 + 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" + 871 error trace, "* needs 2 args but got 0" 872 return 873 } 874 # args->left->value @@ -937,7 +937,7 @@ if ('onhashchange' in window) { 878 compare *first-type, 1/number 879 { 880 break-if-= - 881 error trace, "first arg for * is not a number" + 881 error trace, "first arg for * is not a number" 882 return 883 } 884 var first-value/ecx: (addr float) <- get first, number-data @@ -951,7 +951,7 @@ if ('onhashchange' in window) { 892 compare *second-type, 1/number 893 { 894 break-if-= - 895 error trace, "second arg for * is not a number" + 895 error trace, "second arg for * is not a number" 896 return 897 } 898 var second-value/edx: (addr float) <- get second, number-data @@ -962,16 +962,16 @@ if ('onhashchange' in window) { 903 } 904 905 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 906 trace-text trace, "eval", "apply /" + 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 + 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" + 915 error trace, "/ needs 2 args but got 0" 916 return 917 } 918 # args->left->value @@ -981,7 +981,7 @@ if ('onhashchange' in window) { 922 compare *first-type, 1/number 923 { 924 break-if-= - 925 error trace, "first arg for / is not a number" + 925 error trace, "first arg for / is not a number" 926 return 927 } 928 var first-value/ecx: (addr float) <- get first, number-data @@ -995,7 +995,7 @@ if ('onhashchange' in window) { 936 compare *second-type, 1/number 937 { 938 break-if-= - 939 error trace, "second arg for / is not a number" + 939 error trace, "second arg for / is not a number" 940 return 941 } 942 var second-value/edx: (addr float) <- get second, number-data @@ -1006,16 +1006,16 @@ if ('onhashchange' in window) { 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" + 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 + 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" + 959 error trace, "sqrt needs 1 arg but got 0" 960 return 961 } 962 # args->left->value @@ -1025,7 +1025,7 @@ if ('onhashchange' in window) { 966 compare *first-type, 1/number 967 { 968 break-if-= - 969 error trace, "arg for sqrt is not a number" + 969 error trace, "arg for sqrt is not a number" 970 return 971 } 972 var first-value/ecx: (addr float) <- get first, number-data @@ -1035,16 +1035,16 @@ if ('onhashchange' in window) { 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" + 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 + 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" + 988 error trace, "abs needs 1 arg but got 0" 989 return 990 } 991 # args->left->value @@ -1054,7 +1054,7 @@ if ('onhashchange' in window) { 995 compare *first-type, 1/number 996 { 997 break-if-= - 998 error trace, "arg for abs is not a number" + 998 error trace, "arg for abs is not a number" 999 return 1000 } 1001 var first-value/ecx: (addr float) <- get first, number-data @@ -1072,16 +1072,16 @@ if ('onhashchange' in window) { 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" +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 +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" +1025 error trace, "sgn needs 1 arg but got 0" 1026 return 1027 } 1028 # args->left->value @@ -1091,7 +1091,7 @@ if ('onhashchange' in window) { 1032 compare *first-type, 1/number 1033 { 1034 break-if-= -1035 error trace, "arg for sgn is not a number" +1035 error trace, "arg for sgn is not a number" 1036 return 1037 } 1038 var first-value/ecx: (addr float) <- get first, number-data @@ -1118,16 +1118,16 @@ if ('onhashchange' in window) { 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" +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 +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" +1071 error trace, "car needs 1 arg but got 0" 1072 return 1073 } 1074 # args->left @@ -1137,7 +1137,7 @@ if ('onhashchange' in window) { 1078 compare *first-type, 0/pair 1079 { 1080 break-if-= -1081 error trace, "arg for car is not a pair" +1081 error trace, "arg for car is not a pair" 1082 return 1083 } 1084 # car @@ -1146,16 +1146,16 @@ if ('onhashchange' in window) { 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" +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 +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" +1099 error trace, "cdr needs 1 arg but got 0" 1100 return 1101 } 1102 # args->left @@ -1165,7 +1165,7 @@ if ('onhashchange' in window) { 1106 compare *first-type, 0/pair 1107 { 1108 break-if-= -1109 error trace, "arg for cdr is not a pair" +1109 error trace, "arg for cdr is not a pair" 1110 return 1111 } 1112 # cdr @@ -1174,16 +1174,16 @@ if ('onhashchange' in window) { 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" +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 +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" +1127 error trace, "cons needs 2 args but got 0" 1128 return 1129 } 1130 # args->left @@ -1198,16 +1198,16 @@ if ('onhashchange' in window) { 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 '='" +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 +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" +1151 error trace, "'=' needs 2 args but got 0" 1152 return 1153 } 1154 # args->left @@ -1221,7 +1221,7 @@ if ('onhashchange' in window) { 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 +1165 var match?/eax: boolean <- cell-isomorphic? first, second, trace 1166 compare match?, 0/false 1167 { 1168 break-if-!= @@ -1232,24 +1232,24 @@ if ('onhashchange' in window) { 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" +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 +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" +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 +1192 var nil?/eax: boolean <- nil? first +1193 compare nil?, 0/false 1194 { 1195 break-if-!= 1196 nil out @@ -1259,21 +1259,21 @@ if ('onhashchange' in window) { 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" +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 +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" +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 +1217 dump-cell-from-cursor-over-full-screen first-ah 1218 { 1219 var foo/eax: byte <- read-key 0/keyboard 1220 compare foo, 0 @@ -1283,16 +1283,16 @@ if ('onhashchange' in window) { 1224 } 1225 1226 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1227 trace-text trace, "eval", "apply '<'" +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 +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" +1236 error trace, "'<' needs 2 args but got 0" 1237 return 1238 } 1239 # args->left @@ -1309,7 +1309,7 @@ if ('onhashchange' in window) { 1250 compare *first-type, 1/number 1251 { 1252 break-if-= -1253 error trace, "first arg for '<' is not a number" +1253 error trace, "first arg for '<' is not a number" 1254 return 1255 } 1256 var first-value/ecx: (addr float) <- get first, number-data @@ -1319,7 +1319,7 @@ if ('onhashchange' in window) { 1260 compare *second-type, 1/number 1261 { 1262 break-if-= -1263 error trace, "first arg for '<' is not a number" +1263 error trace, "first arg for '<' is not a number" 1264 return 1265 } 1266 var second-value/eax: (addr float) <- get second, number-data @@ -1333,16 +1333,16 @@ if ('onhashchange' in window) { 1274 } 1275 1276 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1277 trace-text trace, "eval", "apply '>'" +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 +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" +1286 error trace, "'>' needs 2 args but got 0" 1287 return 1288 } 1289 # args->left @@ -1359,7 +1359,7 @@ if ('onhashchange' in window) { 1300 compare *first-type, 1/number 1301 { 1302 break-if-= -1303 error trace, "first arg for '>' is not a number" +1303 error trace, "first arg for '>' is not a number" 1304 return 1305 } 1306 var first-value/ecx: (addr float) <- get first, number-data @@ -1369,7 +1369,7 @@ if ('onhashchange' in window) { 1310 compare *second-type, 1/number 1311 { 1312 break-if-= -1313 error trace, "first arg for '>' is not a number" +1313 error trace, "first arg for '>' is not a number" 1314 return 1315 } 1316 var second-value/eax: (addr float) <- get second, number-data @@ -1383,16 +1383,16 @@ if ('onhashchange' in window) { 1324 } 1325 1326 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1327 trace-text trace, "eval", "apply '<='" +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 +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" +1336 error trace, "'<=' needs 2 args but got 0" 1337 return 1338 } 1339 # args->left @@ -1409,7 +1409,7 @@ if ('onhashchange' in window) { 1350 compare *first-type, 1/number 1351 { 1352 break-if-= -1353 error trace, "first arg for '<=' is not a number" +1353 error trace, "first arg for '<=' is not a number" 1354 return 1355 } 1356 var first-value/ecx: (addr float) <- get first, number-data @@ -1419,7 +1419,7 @@ if ('onhashchange' in window) { 1360 compare *second-type, 1/number 1361 { 1362 break-if-= -1363 error trace, "first arg for '<=' is not a number" +1363 error trace, "first arg for '<=' is not a number" 1364 return 1365 } 1366 var second-value/eax: (addr float) <- get second, number-data @@ -1433,16 +1433,16 @@ if ('onhashchange' in window) { 1374 } 1375 1376 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1377 trace-text trace, "eval", "apply '>='" +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 +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" +1386 error trace, "'>=' needs 2 args but got 0" 1387 return 1388 } 1389 # args->left @@ -1459,7 +1459,7 @@ if ('onhashchange' in window) { 1400 compare *first-type, 1/number 1401 { 1402 break-if-= -1403 error trace, "first arg for '>=' is not a number" +1403 error trace, "first arg for '>=' is not a number" 1404 return 1405 } 1406 var first-value/ecx: (addr float) <- get first, number-data @@ -1469,7 +1469,7 @@ if ('onhashchange' in window) { 1410 compare *second-type, 1/number 1411 { 1412 break-if-= -1413 error trace, "first arg for '>=' is not a number" +1413 error trace, "first arg for '>=' is not a number" 1414 return 1415 } 1416 var second-value/eax: (addr float) <- get second, number-data @@ -1483,16 +1483,16 @@ if ('onhashchange' in window) { 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" +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 +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" +1436 error trace, "print needs 2 args but got 0" 1437 return 1438 } 1439 # screen = args->left @@ -1502,7 +1502,7 @@ if ('onhashchange' in window) { 1443 compare *first-type, 5/screen 1444 { 1445 break-if-= -1446 error trace, "first arg for 'print' is not a screen" +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 @@ -1515,23 +1515,23 @@ if ('onhashchange' in window) { 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 +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" +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 +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" +1475 error trace, "'clear' needs 1 arg but got 0" 1476 return 1477 } 1478 # screen = args->left @@ -1541,27 +1541,27 @@ if ('onhashchange' in window) { 1482 compare *first-type, 5/screen 1483 { 1484 break-if-= -1485 error trace, "first arg for 'clear' is not a screen" +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 +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" +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 +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" +1505 error trace, "'up' needs 1 arg but got 0" 1506 return 1507 } 1508 # screen = args->left @@ -1571,7 +1571,7 @@ if ('onhashchange' in window) { 1512 compare *first-type, 5/screen 1513 { 1514 break-if-= -1515 error trace, "first arg for 'up' is not a screen" +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 @@ -1582,16 +1582,16 @@ if ('onhashchange' in window) { 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'" +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 +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" +1535 error trace, "'down' needs 1 arg but got 0" 1536 return 1537 } 1538 # screen = args->left @@ -1601,7 +1601,7 @@ if ('onhashchange' in window) { 1542 compare *first-type, 5/screen 1543 { 1544 break-if-= -1545 error trace, "first arg for 'down' is not a screen" +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 @@ -1612,16 +1612,16 @@ if ('onhashchange' in window) { 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'" +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 +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" +1565 error trace, "'left' needs 1 arg but got 0" 1566 return 1567 } 1568 # screen = args->left @@ -1631,7 +1631,7 @@ if ('onhashchange' in window) { 1572 compare *first-type, 5/screen 1573 { 1574 break-if-= -1575 error trace, "first arg for 'left' is not a screen" +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 @@ -1642,16 +1642,16 @@ if ('onhashchange' in window) { 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'" +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 +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" +1595 error trace, "'right' needs 1 arg but got 0" 1596 return 1597 } 1598 # screen = args->left @@ -1661,7 +1661,7 @@ if ('onhashchange' in window) { 1602 compare *first-type, 5/screen 1603 { 1604 break-if-= -1605 error trace, "first arg for 'right' is not a screen" +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 @@ -1672,16 +1672,16 @@ if ('onhashchange' in window) { 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'" +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 +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" +1625 error trace, "'cr' needs 1 arg but got 0" 1626 return 1627 } 1628 # screen = args->left @@ -1691,7 +1691,7 @@ if ('onhashchange' in window) { 1632 compare *first-type, 5/screen 1633 { 1634 break-if-= -1635 error trace, "first arg for 'cr' is not a screen" +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 @@ -1702,16 +1702,16 @@ if ('onhashchange' in window) { 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" +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 +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" +1655 error trace, "pixel needs 4 args but got 0" 1656 return 1657 } 1658 # screen = args->left @@ -1721,7 +1721,7 @@ if ('onhashchange' in window) { 1662 compare *first-type, 5/screen 1663 { 1664 break-if-= -1665 error trace, "first arg for 'pixel' is not a screen" +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 @@ -1738,7 +1738,7 @@ if ('onhashchange' in window) { 1679 compare *second-type, 1/number 1680 { 1681 break-if-= -1682 error trace, "second arg for 'pixel' is not an int (x coordinate)" +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 @@ -1754,7 +1754,7 @@ if ('onhashchange' in window) { 1695 compare *third-type, 1/number 1696 { 1697 break-if-= -1698 error trace, "third arg for 'pixel' is not an int (y coordinate)" +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 @@ -1770,26 +1770,26 @@ if ('onhashchange' in window) { 1711 compare *fourth-type, 1/number 1712 { 1713 break-if-= -1714 error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)" +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 +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" +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 +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" +1733 error trace, "key needs 1 arg but got 0" 1734 return 1735 } 1736 # keyboard = args->left @@ -1799,7 +1799,7 @@ if ('onhashchange' in window) { 1740 compare *first-type, 6/keyboard 1741 { 1742 break-if-= -1743 error trace, "first arg for 'key' is not a keyboard" +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 @@ -1826,21 +1826,21 @@ if ('onhashchange' in window) { 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" +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" +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 +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" +1784 error trace, "write needs 2 args but got 0" 1785 return 1786 } 1787 # stream = args->left @@ -1850,7 +1850,7 @@ if ('onhashchange' in window) { 1791 compare *first-type, 3/stream 1792 { 1793 break-if-= -1794 error trace, "first arg for 'write' is not a stream" +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 @@ -1866,7 +1866,7 @@ if ('onhashchange' in window) { 1807 compare *second-type, 1/number 1808 { 1809 break-if-= -1810 error trace, "second arg for stream is not a number/grapheme" +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 @@ -1879,16 +1879,16 @@ if ('onhashchange' in window) { 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" +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 +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" +1832 error trace, "lines needs 1 arg but got 0" 1833 return 1834 } 1835 # screen = args->left @@ -1898,7 +1898,7 @@ if ('onhashchange' in window) { 1839 compare *first-type, 5/screen 1840 { 1841 break-if-= -1842 error trace, "first arg for 'lines' is not a screen" +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 @@ -1917,16 +1917,16 @@ if ('onhashchange' in window) { 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" +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 +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" +1870 error trace, "columns needs 1 arg but got 0" 1871 return 1872 } 1873 # screen = args->left @@ -1936,7 +1936,7 @@ if ('onhashchange' in window) { 1877 compare *first-type, 5/screen 1878 { 1879 break-if-= -1880 error trace, "first arg for 'columns' is not a screen" +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 @@ -1951,16 +1951,16 @@ if ('onhashchange' in window) { 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" +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 +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" +1904 error trace, "width needs 1 arg but got 0" 1905 return 1906 } 1907 # screen = args->left @@ -1970,7 +1970,7 @@ if ('onhashchange' in window) { 1911 compare *first-type, 5/screen 1912 { 1913 break-if-= -1914 error trace, "first arg for 'width' is not a screen" +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 @@ -1986,16 +1986,16 @@ if ('onhashchange' in window) { 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" +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 +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" +1939 error trace, "height needs 1 arg but got 0" 1940 return 1941 } 1942 # screen = args->left @@ -2005,7 +2005,7 @@ if ('onhashchange' in window) { 1946 compare *first-type, 5/screen 1947 { 1948 break-if-= -1949 error trace, "first arg for 'height' is not a screen" +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 diff --git a/html/shell/grapheme-stack.mu.html b/html/shell/grapheme-stack.mu.html index a4e0719d..d5da89b7 100644 --- a/html/shell/grapheme-stack.mu.html +++ b/html/shell/grapheme-stack.mu.html @@ -168,7 +168,7 @@ if ('onhashchange' in window) { 109 break-if-!= 110 copy-to fg, 0xf/highlight 111 } -112 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, fg, background-color +112 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, fg, background-color 113 } 114 i <- increment 115 loop @@ -212,7 +212,7 @@ if ('onhashchange' in window) { 153 compare i, 0 154 break-if-< 155 var g/esi: (addr grapheme) <- index data, i -156 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, color, 7/bg=cursor +156 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, color, 7/bg=cursor 157 i <- decrement 158 } 159 # remaining iterations @@ -232,7 +232,7 @@ if ('onhashchange' in window) { 173 } 174 # 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 +176 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, fg, background-color 177 i <- decrement 178 loop 179 } diff --git a/html/shell/macroexpand.mu.html b/html/shell/macroexpand.mu.html index 4dfb34e4..bdd65450 100644 --- a/html/shell/macroexpand.mu.html +++ b/html/shell/macroexpand.mu.html @@ -60,368 +60,513 @@ 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) {
-  2 +-- 11 lines: # trace "macroexpand " expr-ah --------------------------------------------------------------------------------------------------------------------------------------------
- 13   # loop until convergence
- 14   {
- 15     var expanded?/eax: boolean <- macroexpand-iter expr-ah, globals, trace
- 16     compare expanded?, 0/false
- 17     loop-if-!=
- 18   }
- 19 +-- 11 lines: # trace "=> " expr-ah -----------------------------------------------------------------------------------------------------------------------------------------------------
- 30 }
- 31 
- 32 # return true if we found any macros
- 33 fn macroexpand-iter _expr-ah: (addr handle cell), globals: (addr global-table), trace: (addr trace) -> _/eax: boolean {
- 34   var expr-ah/esi: (addr handle cell) <- copy _expr-ah
- 35 +-- 11 lines: # trace "macroexpand-iter " expr ------------------------------------------------------------------------------------------------------------------------------------------
- 46   # if expr is a non-pair, return
- 47   var expr/eax: (addr cell) <- lookup *expr-ah
- 48   {
- 49     var nil?/eax: boolean <- nil? expr
- 50     compare nil?, 0/false
- 51     break-if-=
- 52     # nil is a literal
- 53     trace-text trace, "mac", "nil"
- 54     trace-higher trace
- 55     return 0/false
- 56   }
- 57   {
- 58     var expr-type/eax: (addr int) <- get expr, type
- 59     compare *expr-type, 0/pair
- 60     break-if-=
- 61     # non-pairs are literals
- 62     trace-text trace, "mac", "non-pair"
- 63     trace-higher trace
- 64     return 0/false
- 65   }
- 66   # if expr is a literal pair, return
- 67   var first-ah/ebx: (addr handle cell) <- get expr, left
- 68   var rest-ah/ecx: (addr handle cell) <- get expr, right
- 69   var first/eax: (addr cell) <- lookup *first-ah
- 70   {
- 71     var litfn?/eax: boolean <- litfn? first
- 72     compare litfn?, 0/false
- 73     break-if-=
- 74     # litfn is a literal
- 75     trace-text trace, "mac", "literal function"
- 76     trace-higher trace
- 77     return 0/false
- 78   }
- 79   {
- 80     var litmac?/eax: boolean <- litmac? first
- 81     compare litmac?, 0/false
- 82     break-if-=
- 83     # litmac is a literal
- 84     trace-text trace, "mac", "literal macro"
- 85     trace-higher trace
- 86     return 0/false
- 87   }
- 88   var result/edi: boolean <- copy 0/false
- 89   # for each builtin, expand only what will later be evaluated
- 90   $macroexpand-iter:anonymous-function: {
- 91     var fn?/eax: boolean <- fn? first
- 92     compare fn?, 0/false
- 93     break-if-=
- 94     # fn: expand every expression in the body
- 95     trace-text trace, "mac", "anonymous function"
- 96     # skip parameters
- 97     var rest/eax: (addr cell) <- lookup *rest-ah
- 98     {
- 99       rest-ah <- get rest, right
-100       rest <- lookup *rest-ah
-101       {
-102         var done?/eax: boolean <- nil? rest
-103         compare done?, 0/false
-104       }
-105       break-if-!=
-106       var curr-ah/eax: (addr handle cell) <- get rest, left
-107       var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace
-108       result <- or macro-found?
-109       loop
-110     }
-111     trace-higher trace
-112     return result
-113   }
-114   # builtins with "special" evaluation rules
-115   $macroexpand-iter:quote: {
-116     # trees starting with single quote create literals
-117     var quote?/eax: boolean <- symbol-equal? first, "'"
-118     compare quote?, 0/false
-119     break-if-=
-120     #
-121     trace-text trace, "mac", "quote"
-122     trace-higher trace
-123     return 0/false
-124   }
-125   $macroexpand-iter:backquote: {
-126     # nested backquote not supported for now
-127     var backquote?/eax: boolean <- symbol-equal? first, "`"
-128     compare backquote?, 0/false
-129     break-if-=
-130     #
-131     error trace, "nested backquote not supported yet"
-132     trace-higher trace
-133     return 0/false
-134   }
-135   $macroexpand-iter:def: {
-136     # trees starting with "def" define globals
-137     var def?/eax: boolean <- symbol-equal? first, "def"
-138     compare def?, 0/false
-139     break-if-=
-140     #
-141     trace-text trace, "mac", "def"
-142     var rest/eax: (addr cell) <- lookup *rest-ah
-143     rest-ah <- get rest, right  # skip name
-144     rest <- lookup *rest-ah
-145     var val-ah/edx: (addr handle cell) <- get rest, left
-146     var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
-147     trace-higher trace
-148     return macro-found?
-149   }
-150   $macroexpand-iter:set: {
-151     # trees starting with "set" mutate bindings
-152     var set?/eax: boolean <- symbol-equal? first, "set"
-153     compare set?, 0/false
-154     break-if-=
-155     #
-156     trace-text trace, "mac", "set"
-157     var rest/eax: (addr cell) <- lookup *rest-ah
-158     rest-ah <- get rest, right  # skip name
-159     rest <- lookup *rest-ah
-160     var val-ah/edx: (addr handle cell) <- get rest, left
-161     var macro-found?/eax: boolean <- macroexpand-iter val-ah, globals, trace
-162     trace-higher trace
-163     return macro-found?
+  2 +-- 15 lines: # trace "macroexpand " expr-ah --------------------------------------------------------------------------------------------------------------------------------------------
+ 17   trace-lower trace
+ 18   # loop until convergence
+ 19   {
+ 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
+ 24     compare expanded?, 0/false
+ 25     loop-if-!=
+ 26   }
+ 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
+ 48 +-- 15 lines: # trace "macroexpand-iter " expr ------------------------------------------------------------------------------------------------------------------------------------------
+ 63   trace-lower trace
+ 64   # if expr is a non-pair, return
+ 65   var expr/eax: (addr cell) <- lookup *expr-ah
+ 66   {
+ 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
+ 73     return 0/false
+ 74   }
+ 75   {
+ 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
+ 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
+ 88   {
+ 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
+ 95     return 0/false
+ 96   }
+ 97   {
+ 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
+104     return 0/false
+105   }
+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
+111     break-if-=
+112     # fn: expand every expression in the body
+113     trace-text trace, "mac", "anonymous function"
+114     # skip parameters
+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
+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
+126       result <- or macro-found?
+127       {
+128         var error?/eax: boolean <- has-errors? trace
+129         compare error?, 0/false
+130         break-if-=
+131         trace-higher trace
+132         return result
+133       }
+134       loop
+135     }
+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, "'"
+158     compare quote?, 0/false
+159     break-if-=
+160     #
+161     trace-text trace, "mac", "quote"
+162     trace-higher trace
+163     return 0/false
 164   }
-165   # 'and' is like a function for macroexpansion purposes
-166   # 'or' is like a function for macroexpansion purposes
-167   # 'if' is like a function for macroexpansion purposes
-168   # 'while' is like a function for macroexpansion purposes
-169   # if car(expr) is a symbol defined as a macro, expand it
-170   {
-171     var definition-h: (handle cell)
-172     var definition-ah/edx: (addr handle cell) <- address definition-h
-173     maybe-lookup-symbol-in-globals first, definition-ah, globals, trace
-174     var definition/eax: (addr cell) <- lookup *definition-ah
-175     compare definition, 0
-176     break-if-=
-177     # definition found
-178     {
-179       var definition-type/eax: (addr int) <- get definition, type
-180       compare *definition-type, 0/pair
-181     }
-182     break-if-!=
-183     # definition is a pair
-184     {
-185       var definition-car-ah/eax: (addr handle cell) <- get definition, left
-186       var definition-car/eax: (addr cell) <- lookup *definition-car-ah
-187       var macro?/eax: boolean <- litmac? definition-car
-188       compare macro?, 0/false
-189     }
-190     break-if-=
-191     # definition is a macro
-192     var macro-definition-ah/eax: (addr handle cell) <- get definition, right
-193     # TODO: check car(macro-definition) is litfn
-194 #?     turn-on-debug-print
-195     apply macro-definition-ah, rest-ah, expr-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number
-196     return 1/true
-197   }
-198   # no macro found; process any macros within args
-199   trace-text trace, "mac", "recursing into function definition"
-200   var curr-ah/ebx: (addr handle cell) <- copy first-ah
-201   $macroexpand-iter:loop: {
-202 #?     clear-screen 0/screen
-203 #?     dump-trace trace
-204     var macro-found?/eax: boolean <- macroexpand-iter curr-ah, globals, trace
-205     result <- or macro-found?
-206     var rest/eax: (addr cell) <- lookup *rest-ah
-207     {
-208       var nil?/eax: boolean <- nil? rest
-209       compare nil?, 0/false
-210     }
-211     break-if-!=
-212     curr-ah <- get rest, left
-213     rest-ah <- get rest, right
-214     loop
-215   }
-216   return result
-217 }
-218 
-219 fn test-macroexpand {
-220   var globals-storage: global-table
-221   var globals/edx: (addr global-table) <- address globals-storage
-222   initialize-globals globals
-223   # new macro: m
-224   var sandbox-storage: sandbox
-225   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-226   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
-227   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-228   var trace-ah/eax: (addr handle trace) <- get sandbox, trace
-229   var trace/eax: (addr trace) <- lookup *trace-ah
-230   # invoke macro
-231   initialize-sandbox-with sandbox, "(m 3 4)"
-232   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-233   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
-234   var result-h: (handle cell)
-235   var result-ah/ebx: (addr handle cell) <- address result-h
-236   read-cell gap, result-ah, 0/no-trace
-237   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
-238 #?   dump-cell-from-cursor-over-full-screen result-ah
-239   var _result/eax: (addr cell) <- lookup *result-ah
-240   var result/edi: (addr cell) <- copy _result
-241   # expected
-242   initialize-sandbox-with sandbox, "(+ 3 4)"
-243   var expected-gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-244   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
-245   var expected-h: (handle cell)
-246   var expected-ah/ecx: (addr handle cell) <- address expected-h
-247   read-cell expected-gap, expected-ah, 0/no-trace
-248 #?   dump-cell-from-cursor-over-full-screen expected-ah
-249   var expected/eax: (addr cell) <- lookup *expected-ah
-250   #
-251   var assertion/eax: boolean <- cell-isomorphic? result, expected, 0/no-trace
-252   check assertion, "F - test-macroexpand"
-253 }
-254 
-255 fn test-macroexpand-inside-anonymous-fn {
-256   var globals-storage: global-table
-257   var globals/edx: (addr global-table) <- address globals-storage
-258   initialize-globals globals
-259   # new macro: m
-260   var sandbox-storage: sandbox
-261   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-262   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
-263   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-264   var trace-ah/eax: (addr handle trace) <- get sandbox, trace
-265   var trace/eax: (addr trace) <- lookup *trace-ah
-266   # invoke macro
-267   initialize-sandbox-with sandbox, "(fn() (m 3 4))"
-268   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-269   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
-270   var result-h: (handle cell)
-271   var result-ah/ebx: (addr handle cell) <- address result-h
-272   read-cell gap, result-ah, 0/no-trace
-273   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
-274 #?   dump-cell-from-cursor-over-full-screen result-ah
-275   var _result/eax: (addr cell) <- lookup *result-ah
-276   var result/edi: (addr cell) <- copy _result
-277   # expected
-278   initialize-sandbox-with sandbox, "(fn() (+ 3 4))"
-279   var expected-gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-280   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
-281   var expected-h: (handle cell)
-282   var expected-ah/ecx: (addr handle cell) <- address expected-h
-283   read-cell expected-gap, expected-ah, 0/no-trace
-284 #?   dump-cell-from-cursor-over-full-screen expected-ah
-285   var expected/eax: (addr cell) <- lookup *expected-ah
-286   #
-287   var assertion/eax: boolean <- cell-isomorphic? result, expected, 0/no-trace
-288   check assertion, "F - test-macroexpand-inside-anonymous-fn"
-289 }
-290 
-291 fn test-macroexpand-inside-fn-call {
-292   var globals-storage: global-table
-293   var globals/edx: (addr global-table) <- address globals-storage
-294   initialize-globals globals
-295   # new macro: m
-296   var sandbox-storage: sandbox
-297   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-298   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
-299   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-300   # invoke macro
-301   initialize-sandbox-with sandbox, "((fn() (m 3 4)))"
-302   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-303   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
-304   var result-h: (handle cell)
-305   var result-ah/ebx: (addr handle cell) <- address result-h
-306   read-cell gap, result-ah, 0/no-trace
-307   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
-308 #?   dump-cell-from-cursor-over-full-screen result-ah
-309   var _result/eax: (addr cell) <- lookup *result-ah
-310   var result/edi: (addr cell) <- copy _result
-311   # expected
-312   initialize-sandbox-with sandbox, "((fn() (+ 3 4)))"
-313   var expected-gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-314   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
-315   var expected-h: (handle cell)
-316   var expected-ah/ecx: (addr handle cell) <- address expected-h
-317   read-cell expected-gap, expected-ah, 0/no-trace
-318 #?   dump-cell-from-cursor-over-full-screen expected-ah
-319   var expected/eax: (addr cell) <- lookup *expected-ah
-320   #
-321   var assertion/eax: boolean <- cell-isomorphic? result, expected, 0/no-trace
-322   check assertion, "F - test-macroexpand-inside-fn-call"
-323 }
-324 
-325 fn pending-test-macroexpand-inside-backquote-unquote {
-326   var globals-storage: global-table
-327   var globals/edx: (addr global-table) <- address globals-storage
-328   initialize-globals globals
-329   # new macro: m
-330   var sandbox-storage: sandbox
-331   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-332   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
-333   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-334   # invoke macro
-335   initialize-sandbox-with sandbox, "`(print [result is ] ,(m 3 4)))"
-336   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-337   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
-338   var result-h: (handle cell)
-339   var result-ah/ebx: (addr handle cell) <- address result-h
-340   read-cell gap, result-ah, 0/no-trace
-341   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
-342   dump-cell-from-cursor-over-full-screen result-ah
-343   var _result/eax: (addr cell) <- lookup *result-ah
-344   var result/edi: (addr cell) <- copy _result
-345   # expected
-346   initialize-sandbox-with sandbox, "`(print [result is ] ,(+ 3 4)))"
-347   var expected-gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-348   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
-349   var expected-h: (handle cell)
-350   var expected-ah/ecx: (addr handle cell) <- address expected-h
-351   read-cell expected-gap, expected-ah, 0/no-trace
-352   dump-cell-from-cursor-over-full-screen expected-ah
-353   var expected/eax: (addr cell) <- lookup *expected-ah
-354   #
-355   var assertion/eax: boolean <- cell-isomorphic? result, expected, 0/no-trace
-356   check assertion, "F - test-macroexpand-inside-backquote-unquote"
-357 }
-358 
-359 fn pending-test-macroexpand-inside-nested-backquote-unquote {
-360   var globals-storage: global-table
-361   var globals/edx: (addr global-table) <- address globals-storage
-362   initialize-globals globals
-363   # new macro: m
-364   var sandbox-storage: sandbox
-365   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-366   initialize-sandbox-with sandbox, "(def m (litmac litfn () (a b) `(+ ,a ,b)))"
-367   edit-sandbox sandbox, 0x13/ctrl-s, globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-368   # invoke macro
-369   initialize-sandbox-with sandbox, "`(a ,(m 3 4) `(b ,(m 3 4) ,,(m 3 4)))"
-370   var gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-371   var gap/eax: (addr gap-buffer) <- lookup *gap-ah
-372   var result-h: (handle cell)
-373   var result-ah/ebx: (addr handle cell) <- address result-h
-374   read-cell gap, result-ah, 0/no-trace
-375   var dummy/eax: boolean <- macroexpand-iter result-ah, globals, 0/no-trace
-376   dump-cell-from-cursor-over-full-screen result-ah
-377   var _result/eax: (addr cell) <- lookup *result-ah
-378   var result/edi: (addr cell) <- copy _result
-379   # expected
-380   initialize-sandbox-with sandbox, "`(a ,(+ 3 4) `(b ,(m 3 4) ,,(+ 3 4)))"
-381   var expected-gap-ah/ecx: (addr handle gap-buffer) <- get sandbox, data
-382   var expected-gap/eax: (addr gap-buffer) <- lookup *expected-gap-ah
-383   var expected-h: (handle cell)
-384   var expected-ah/ecx: (addr handle cell) <- address expected-h
-385   read-cell expected-gap, expected-ah, 0/no-trace
-386   dump-cell-from-cursor-over-full-screen expected-ah
-387   var expected/eax: (addr cell) <- lookup *expected-ah
-388   #
-389   var assertion/eax: boolean <- cell-isomorphic? result, expected, 0/no-trace
-390   check assertion, "F - test-macroexpand-inside-nested-backquote-unquote"
-391 }
-392 
-393 # TODO: unquote-splice, nested and unnested
+165   $macroexpand-iter:backquote: {
+166     # nested backquote not supported for now
+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
+174     compare double-unquote-found?, 0/false
+175     {
+176       break-if-=
+177       error trace, "double unquote not supported yet"
+178     }
+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
+186     break-if-=
+187     #
+188     trace-text trace, "mac", "def"
+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 -------------------------------------------------------------------------------------------------------------------------------------------------
+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"
+215     compare set?, 0/false
+216     break-if-=
+217     #
+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
+225 +-- 15 lines: # trace "set=> " _expr-ah -------------------------------------------------------------------------------------------------------------------------------------------------
+240     return macro-found?
+241   }
+242   # 'and' is like a function for macroexpansion purposes
+243   # 'or' is like a function for macroexpansion purposes
+244   # 'if' is like a function for macroexpansion purposes
+245   # 'while' is like a function for macroexpansion purposes
+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
+252     compare definition, 0
+253     break-if-=
+254     # definition found
+255     {
+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
+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
+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
+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
+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
+298     result <- or macro-found?
+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
+303     {
+304       var nil?/eax: boolean <- nil? rest
+305       compare nil?, 0/false
+306     }
+307     break-if-!=
+308     curr-ah <- get rest, left
+309     rest-ah <- get rest, right
+310     loop
+311   }
+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 {
+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
+335   {
+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
+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
+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, ","
+357         compare unquote?, 0/false
+358       }
+359       break-if-!=
+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
+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
+373     {
+374       {
+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, ",@"
+380       compare unquote-splice?, 0/false
+381       break-if-!=
+382       break $look-for-double-unquote:check
+383     }
+384     # error
+385     return 1/true
+386   }
+387   var result/eax: boolean <- look-for-double-unquote car-ah
+388   compare result, 0/false
+389   {
+390     break-if-=
+391     return result
+392   }
+393   result <- look-for-double-unquote cdr-ah
+394   return result
+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
+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
+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
+410   var result-h: (handle cell)
+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
+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
+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
+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
+426   var expected-h: (handle cell)
+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
+431   #
+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
+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
+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
+449   var result-h: (handle cell)
+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
+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
+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
+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
+465   var expected-h: (handle cell)
+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
+469   #
+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
+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
+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
+487   var result-h: (handle cell)
+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
+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
+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
+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
+503   var expected-h: (handle cell)
+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
+508   #
+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
+517   # macroexpand an expression with a backquote but no macro
+518   var sandbox-storage: sandbox
+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
+523   var result-h: (handle cell)
+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
+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
+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
+537     {
+538       loop
+539     }
+540   }
+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
+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
+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
+556   var result-h: (handle cell)
+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
+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
+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
+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
+572   var expected-h: (handle cell)
+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
+576   #
+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
+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
+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
+594   var result-h: (handle cell)
+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
+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
+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
+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
+610   var expected-h: (handle cell)
+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
+615   #
+616   var assertion/eax: boolean <- cell-isomorphic? result, expected, trace
+617   check assertion, "F - test-macroexpand-inside-nested-backquote-unquote"
+618 }
+619 
+620 # TODO: unquote-splice, nested and unnested
diff --git a/html/shell/main.mu.html b/html/shell/main.mu.html index d606c1b5..f4ff8f02 100644 --- a/html/shell/main.mu.html +++ b/html/shell/main.mu.html @@ -67,7 +67,7 @@ if ('onhashchange' in window) { 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 + 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 @@ -110,113 +110,122 @@ if ('onhashchange' in window) { 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 + 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 evaluate tmp, out-ah, nil, globals, 0/trace, 0/no-fake-screen, 0/no-fake-keyboard, 0/call-number - 60 { - 61 var tmp/eax: byte <- read-key keyboard - 62 compare tmp, 0 - 63 loop-if-= - 64 } - 65 # - 66 loop $main:loop - 67 } - 68 # no way to quit right now; just reboot - 69 edit-sandbox sandbox, key, globals, data-disk, screen, 1/tweak-real-screen - 70 } - 71 loop - 72 } - 73 } - 74 - 75 # Gotcha: some saved state may not load. - 76 fn load-state data-disk: (addr disk), _sandbox: (addr sandbox), globals: (addr global-table) { - 77 var sandbox/eax: (addr sandbox) <- copy _sandbox - 78 var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data - 79 var _data/eax: (addr gap-buffer) <- lookup *data-ah - 80 var data/esi: (addr gap-buffer) <- copy _data - 81 # data-disk -> stream - 82 var s-storage: (stream byte 0x1000) # space for 8/sectors - 83 var s/ebx: (addr stream byte) <- address s-storage - 84 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sectors from data disk", 3/fg, 0/bg - 85 move-cursor-to-left-margin-of-next-line 0/screen - 86 load-sectors data-disk, 0/lba, 8/sectors, s - 87 #? draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg, 0xc5/bg=blue-bg - 88 # stream -> gap-buffer - 89 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "parsing", 3/fg, 0/bg - 90 move-cursor-to-left-margin-of-next-line 0/screen - 91 load-gap-buffer-from-stream data, s - 92 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " into gap buffer", 3/fg, 0/bg + 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 clear-stream s - 95 # read: gap-buffer -> cell - 96 var initial-root-storage: (handle cell) - 97 var initial-root/ecx: (addr handle cell) <- address initial-root-storage - 98 read-cell data, initial-root, 0/no-trace - 99 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " into s-expressions", 3/fg, 0/bg -100 move-cursor-to-left-margin-of-next-line 0/screen -101 clear-gap-buffer data -102 # -103 { -104 var initial-root-addr/eax: (addr cell) <- lookup *initial-root -105 compare initial-root-addr, 0 -106 break-if-!= -107 return -108 } -109 # load globals from assoc(initial-root, 'globals) -110 var globals-literal-storage: (handle cell) -111 var globals-literal-ah/eax: (addr handle cell) <- address globals-literal-storage -112 new-symbol globals-literal-ah, "globals" -113 var globals-literal/eax: (addr cell) <- lookup *globals-literal-ah -114 var globals-cell-storage: (handle cell) -115 var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage -116 lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard -117 var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah -118 { -119 compare globals-cell, 0 -120 break-if-= -121 load-globals globals-cell-ah, globals -122 } -123 # sandbox = assoc(initial-root, 'sandbox) -124 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sandbox", 3/fg, 0/bg -125 var sandbox-literal-storage: (handle cell) -126 var sandbox-literal-ah/eax: (addr handle cell) <- address sandbox-literal-storage -127 new-symbol sandbox-literal-ah, "sandbox" -128 var sandbox-literal/eax: (addr cell) <- lookup *sandbox-literal-ah -129 var sandbox-cell-storage: (handle cell) -130 var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage -131 lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard -132 var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah -133 { -134 compare sandbox-cell, 0 -135 break-if-= -136 # print: cell -> stream -137 print-cell sandbox-cell-ah, s, 0/no-trace -138 # stream -> gap-buffer -139 load-gap-buffer-from-stream data, s -140 } -141 } -142 -143 # Save state as an alist of alists: -144 # ((globals . ((a . (fn ...)) -145 # ...)) -146 # (sandbox . ...)) -147 fn store-state data-disk: (addr disk), sandbox: (addr sandbox), globals: (addr global-table) { -148 compare data-disk, 0/no-disk -149 { -150 break-if-!= -151 return -152 } -153 var stream-storage: (stream byte 0x1000) # space enough for 8/sectors -154 var stream/edi: (addr stream byte) <- address stream-storage -155 write stream, "(\n" -156 write-globals stream, globals -157 write-sandbox stream, sandbox -158 write stream, ")\n" -159 store-sectors data-disk, 0/lba, 8/sectors, stream -160 } + 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 } diff --git a/html/shell/parse.mu.html b/html/shell/parse.mu.html index 8e01546d..d4f045c9 100644 --- a/html/shell/parse.mu.html +++ b/html/shell/parse.mu.html @@ -62,7 +62,7 @@ if ('onhashchange' in window) { 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 @@ -71,14 +71,14 @@ if ('onhashchange' in window) { 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 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 @@ -86,263 +86,274 @@ if ('onhashchange' in window) { 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 + 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 36 compare empty?, 0/false 37 { 38 break-if-= - 39 error trace, "end of stream; never found a balancing ')'" - 40 return 1/true, 0/false - 41 } - 42 read-from-stream tokens, curr-token - 43 $parse-sexpression:type-check: { - 44 # single quote -> parse as list with a special car - 45 var quote-token?/eax: boolean <- quote-token? curr-token - 46 compare quote-token?, 0/false - 47 { - 48 break-if-= - 49 var out/edi: (addr handle cell) <- copy _out - 50 allocate-pair out - 51 var out-addr/eax: (addr cell) <- lookup *out - 52 var left-ah/edx: (addr handle cell) <- get out-addr, left - 53 new-symbol left-ah, "'" - 54 var right-ah/edx: (addr handle cell) <- get out-addr, right - 55 var close-paren?/eax: boolean <- copy 0/false - 56 var dot?/ecx: boolean <- copy 0/false - 57 close-paren?, dot? <- parse-sexpression tokens, right-ah, trace - 58 return close-paren?, dot? - 59 } - 60 # backquote quote -> parse as list with a special car - 61 var backquote-token?/eax: boolean <- backquote-token? curr-token - 62 compare backquote-token?, 0/false - 63 { - 64 break-if-= - 65 var out/edi: (addr handle cell) <- copy _out - 66 allocate-pair out - 67 var out-addr/eax: (addr cell) <- lookup *out - 68 var left-ah/edx: (addr handle cell) <- get out-addr, left - 69 new-symbol left-ah, "`" - 70 var right-ah/edx: (addr handle cell) <- get out-addr, right - 71 var close-paren?/eax: boolean <- copy 0/false - 72 var dot?/ecx: boolean <- copy 0/false - 73 close-paren?, dot? <- parse-sexpression tokens, right-ah, trace - 74 return close-paren?, dot? - 75 } - 76 # unquote -> parse as list with a special car - 77 var unquote-token?/eax: boolean <- unquote-token? curr-token - 78 compare unquote-token?, 0/false - 79 { - 80 break-if-= - 81 var out/edi: (addr handle cell) <- copy _out - 82 allocate-pair out - 83 var out-addr/eax: (addr cell) <- lookup *out - 84 var left-ah/edx: (addr handle cell) <- get out-addr, left - 85 new-symbol left-ah, "," - 86 var right-ah/edx: (addr handle cell) <- get out-addr, right - 87 var close-paren?/eax: boolean <- copy 0/false - 88 var dot?/ecx: boolean <- copy 0/false - 89 close-paren?, dot? <- parse-sexpression tokens, right-ah, trace - 90 return close-paren?, dot? - 91 } - 92 # unquote-splice -> parse as list with a special car - 93 var unquote-splice-token?/eax: boolean <- unquote-splice-token? curr-token - 94 compare unquote-splice-token?, 0/false - 95 { - 96 break-if-= - 97 var out/edi: (addr handle cell) <- copy _out - 98 allocate-pair out - 99 var out-addr/eax: (addr cell) <- lookup *out -100 var left-ah/edx: (addr handle cell) <- get out-addr, left -101 new-symbol left-ah, ",@" -102 var right-ah/edx: (addr handle cell) <- get out-addr, right -103 var close-paren?/eax: boolean <- copy 0/false -104 var dot?/ecx: boolean <- copy 0/false -105 close-paren?, dot? <- parse-sexpression tokens, right-ah, trace -106 return close-paren?, dot? -107 } -108 # dot -> return -109 var dot?/eax: boolean <- dot-token? curr-token -110 compare dot?, 0/false -111 { -112 break-if-= -113 trace-higher trace -114 return 0/false, 1/true -115 } -116 # not bracket -> parse atom -117 var bracket-token?/eax: boolean <- bracket-token? curr-token -118 compare bracket-token?, 0/false -119 { -120 break-if-!= -121 parse-atom curr-token, _out, trace -122 break $parse-sexpression:type-check -123 } -124 # open paren -> parse list -125 var open-paren?/eax: boolean <- open-paren-token? curr-token -126 compare open-paren?, 0/false -127 { -128 break-if-= -129 var curr/esi: (addr handle cell) <- copy _out -130 allocate-pair curr -131 var curr-addr/eax: (addr cell) <- lookup *curr -132 var left/edx: (addr handle cell) <- get curr-addr, left -133 { -134 var close-paren?/eax: boolean <- copy 0/false -135 var dot?/ecx: boolean <- copy 0/false -136 close-paren?, dot? <- parse-sexpression tokens, left, trace -137 { -138 compare dot?, 0/false -139 break-if-= -140 error trace, "'.' cannot be at the start of a list" -141 return 1/true, dot? -142 } -143 compare close-paren?, 0/false -144 break-if-!= -145 var curr-addr/eax: (addr cell) <- lookup *curr -146 curr <- get curr-addr, right -147 var tmp-storage: (handle cell) -148 var tmp/edx: (addr handle cell) <- address tmp-storage -149 $parse-sexpression:list-loop: { -150 var close-paren?/eax: boolean <- copy 0/false -151 var dot?/ecx: boolean <- copy 0/false -152 close-paren?, dot? <- parse-sexpression tokens, tmp, trace -153 # '.' -> clean up right here and return -154 compare dot?, 0/false -155 { -156 break-if-= -157 parse-dot-tail tokens, curr, trace -158 return 0/false, 0/false -159 } -160 allocate-pair curr -161 # ')' -> return -162 compare close-paren?, 0/false -163 break-if-!= -164 var curr-addr/eax: (addr cell) <- lookup *curr -165 var left/ecx: (addr handle cell) <- get curr-addr, left -166 copy-object tmp, left -167 # -168 curr <- get curr-addr, right -169 loop -170 } -171 } -172 break $parse-sexpression:type-check -173 } -174 # close paren -> return -175 var close-paren?/eax: boolean <- close-paren-token? curr-token -176 compare close-paren?, 0/false -177 { -178 break-if-= -179 trace-higher trace -180 return 1/true, 0/false -181 } -182 # otherwise abort -183 var stream-storage: (stream byte 0x400) -184 var stream/edx: (addr stream byte) <- address stream-storage -185 write stream, "unexpected token " -186 var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data -187 var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah -188 rewind-stream curr-token-data -189 write-stream stream, curr-token-data -190 trace trace, "error", stream -191 } -192 trace-higher trace -193 return 0/false, 0/false -194 } -195 -196 fn parse-atom _curr-token: (addr cell), _out: (addr handle cell), trace: (addr trace) { -197 trace-text trace, "parse", "parse atom" -198 var curr-token/ecx: (addr cell) <- copy _curr-token -199 var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data -200 var _curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah -201 var curr-token-data/esi: (addr stream byte) <- copy _curr-token-data -202 trace trace, "parse", curr-token-data -203 # number -204 var number-token?/eax: boolean <- number-token? curr-token -205 compare number-token?, 0/false -206 { -207 break-if-= -208 rewind-stream curr-token-data -209 var _val/eax: int <- parse-decimal-int-from-stream curr-token-data -210 var val/ecx: int <- copy _val -211 var val-float/xmm0: float <- convert val -212 allocate-number _out -213 var out/eax: (addr handle cell) <- copy _out -214 var out-addr/eax: (addr cell) <- lookup *out -215 var dest/edi: (addr float) <- get out-addr, number-data -216 copy-to *dest, val-float -217 { -218 var stream-storage: (stream byte 0x400) -219 var stream/ecx: (addr stream byte) <- address stream-storage -220 write stream, "=> number " -221 print-number out-addr, stream, 0/no-trace -222 trace trace, "parse", stream -223 } -224 return -225 } -226 # default: copy either to a symbol or a stream -227 # stream token -> literal -228 var stream-token?/eax: boolean <- stream-token? curr-token -229 compare stream-token?, 0/false -230 { -231 break-if-= -232 allocate-stream _out + 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 + 47 compare quote-token?, 0/false + 48 { + 49 break-if-= + 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 + 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 + 58 close-paren?, dot? <- parse-sexpression tokens, right-ah, 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 + 64 compare backquote-token?, 0/false + 65 { + 66 break-if-= + 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 + 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 + 75 close-paren?, dot? <- parse-sexpression tokens, right-ah, 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 + 81 compare unquote-token?, 0/false + 82 { + 83 break-if-= + 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 + 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 + 92 close-paren?, dot? <- parse-sexpression tokens, right-ah, 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 + 98 compare unquote-splice-token?, 0/false + 99 { +100 break-if-= +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 +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 +109 close-paren?, dot? <- parse-sexpression tokens, right-ah, trace +110 trace-higher trace +111 return close-paren?, dot? +112 } +113 # dot -> return +114 var dot?/eax: boolean <- dot-token? curr-token +115 compare dot?, 0/false +116 { +117 break-if-= +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 +123 compare bracket-token?, 0/false +124 { +125 break-if-!= +126 parse-atom curr-token, _out, trace +127 break $parse-sexpression:type-check +128 } +129 # open paren -> parse list +130 var open-paren?/eax: boolean <- open-paren-token? curr-token +131 compare open-paren?, 0/false +132 { +133 break-if-= +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 +138 { +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" +146 return 1/true, dot? +147 } +148 compare close-paren?, 0/false +149 break-if-!= +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 +154 $parse-sexpression:list-loop: { +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 +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 +171 copy-object tmp, left +172 # +173 curr <- get curr-addr, right +174 loop +175 } +176 } +177 break $parse-sexpression:type-check +178 } +179 # close paren -> return +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 +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 +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 +193 rewind-stream curr-token-data +194 write-stream stream, curr-token-data +195 error-stream trace, stream +196 } +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 +207 trace trace, "parse", curr-token-data +208 # number +209 var number-token?/eax: boolean <- number-token? curr-token +210 compare number-token?, 0/false +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 +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 +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 compare stream-token?, 0/false -235 { -236 break-if-!= -237 allocate-symbol _out -238 } -239 # copy token data -240 var out/eax: (addr handle cell) <- copy _out -241 var out-addr/eax: (addr cell) <- lookup *out -242 var curr-token-data-ah/ecx: (addr handle stream byte) <- get curr-token, text-data -243 var dest-ah/edx: (addr handle stream byte) <- get out-addr, text-data -244 copy-object curr-token-data-ah, dest-ah -245 { -246 var stream-storage: (stream byte 0x400) -247 var stream/ecx: (addr stream byte) <- address stream-storage -248 write stream, "=> symbol " -249 print-symbol out-addr, stream, 0/no-trace -250 trace trace, "parse", stream -251 } -252 } -253 -254 fn parse-dot-tail tokens: (addr stream cell), _out: (addr handle cell), trace: (addr trace) { -255 var out/edi: (addr handle cell) <- copy _out -256 var close-paren?/eax: boolean <- copy 0/false -257 var dot?/ecx: boolean <- copy 0/false -258 close-paren?, dot? <- parse-sexpression tokens, out, trace -259 compare close-paren?, 0/false -260 { -261 break-if-= -262 error trace, "'. )' makes no sense" -263 return -264 } -265 compare dot?, 0/false -266 { -267 break-if-= -268 error trace, "'. .' makes no sense" -269 return -270 } -271 # -272 var dummy: (handle cell) -273 var dummy-ah/edi: (addr handle cell) <- address dummy -274 close-paren?, dot? <- parse-sexpression tokens, dummy-ah, trace -275 compare close-paren?, 0/false -276 { -277 break-if-!= -278 error trace, "cannot have multiple expressions between '.' and ')'" -279 return -280 } -281 compare dot?, 0/false -282 { -283 break-if-= -284 error trace, "cannot have two dots in a single list" -285 return -286 } -287 } +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 } +242 compare stream-token?, 0/false +243 { +244 break-if-!= +245 allocate-symbol _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 +287 { +288 break-if-!= +289 error trace, "cannot have multiple expressions between '.' and ')'" +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 } diff --git a/html/shell/print.mu.html b/html/shell/print.mu.html index e880b03c..80f074e6 100644 --- a/html/shell/print.mu.html +++ b/html/shell/print.mu.html @@ -15,13 +15,13 @@ body { font-size:12pt; font-family: monospace; color: #000000; background-color: a { color:inherit; } * { font-size:12pt; font-size: 1em; } .PreProc { color: #c000c0; } +.Special { color: #ff6060; } .LineNr { } .Constant { color: #008787; } -.muComment { color: #005faf; } .Delimiter { color: #c000c0; } .muFunction { color: #af5f00; text-decoration: underline; } .muTest { color: #5f8700; } -.Special { color: #ff6060; } +.muComment { color: #005faf; } --> @@ -57,407 +57,597 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/main/shell/print.mu 
-  1 fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr trace) {
-  2   check-stack
-  3   trace-text trace, "print", "print"
-  4   trace-lower trace
-  5   var in/eax: (addr handle cell) <- copy _in
-  6   var in-addr/eax: (addr cell) <- lookup *in
-  7   {
-  8     compare in-addr, 0
-  9     break-if-!=
- 10     write out, "NULL"
- 11     trace-higher trace
- 12     return
- 13   }
- 14   {
- 15     var nil?/eax: boolean <- nil? in-addr
- 16     compare nil?, 0/false
- 17     break-if-=
- 18     write out, "()"
- 19     trace-higher trace
- 20     return
- 21   }
- 22   var in-type/ecx: (addr int) <- get in-addr, type
- 23   compare *in-type, 0/pair
- 24   {
- 25     break-if-!=
- 26     print-pair in-addr, out, trace
- 27     trace-higher trace
- 28     return
- 29   }
- 30   compare *in-type, 1/number
- 31   {
- 32     break-if-!=
- 33     print-number in-addr, out, trace
- 34     trace-higher trace
- 35     return
- 36   }
- 37   compare *in-type, 2/symbol
- 38   {
- 39     break-if-!=
- 40     print-symbol in-addr, out, trace
- 41     trace-higher trace
- 42     return
- 43   }
- 44   compare *in-type, 3/stream
- 45   {
- 46     break-if-!=
- 47     print-stream in-addr, out, trace
- 48     trace-higher trace
- 49     return
- 50   }
- 51   compare *in-type, 4/primitive
- 52   {
- 53     break-if-!=
- 54     write out, "[primitive]"
- 55     trace-higher trace
- 56     return
- 57   }
- 58   compare *in-type, 5/screen
- 59   {
- 60     break-if-!=
- 61     write out, "[screen "
- 62     var screen-ah/eax: (addr handle screen) <- get in-addr, screen-data
- 63     var screen/eax: (addr screen) <- lookup *screen-ah
- 64     var screen-addr/eax: int <- copy screen
- 65     write-int32-hex out, screen-addr
- 66     write out, "]"
- 67     trace-higher trace
- 68     return
- 69   }
- 70   compare *in-type, 6/keyboard
- 71   {
- 72     break-if-!=
- 73     write out, "[keyboard "
- 74     var keyboard-ah/eax: (addr handle gap-buffer) <- get in-addr, keyboard-data
- 75     var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
- 76     var keyboard-addr/eax: int <- copy keyboard
- 77     write-int32-hex out, keyboard-addr
- 78     write out, "]"
- 79     trace-higher trace
- 80     return
- 81   }
- 82 }
- 83 
- 84 # debug helper
- 85 fn dump-cell-at-top-right in-ah: (addr handle cell) {
- 86   var stream-storage: (stream byte 0x1000)
- 87   var stream/edx: (addr stream byte) <- address stream-storage
- 88   print-cell in-ah, stream, 0/no-trace
- 89   var d1/eax: int <- copy 0
- 90   var d2/ecx: int <- copy 0
- 91   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
- 92 }
- 93 
- 94 fn dump-cell-from-cursor-over-full-screen in-ah: (addr handle cell) {
- 95   var stream-storage: (stream byte 0x200)
- 96   var stream/edx: (addr stream byte) <- address stream-storage
- 97   print-cell in-ah, stream, 0/no-trace
- 98   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, stream, 7/fg, 0/bg
- 99 }
-100 
-101 fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
-102   trace-text trace, "print", "symbol"
-103   var in/esi: (addr cell) <- copy _in
-104   var data-ah/eax: (addr handle stream byte) <- get in, text-data
-105   var _data/eax: (addr stream byte) <- lookup *data-ah
-106   var data/esi: (addr stream byte) <- copy _data
-107   rewind-stream data
-108   write-stream out, data
-109   # trace
-110   compare trace, 0
-111   break-if-=
-112   rewind-stream data
-113   var stream-storage: (stream byte 0x40)
-114   var stream/ecx: (addr stream byte) <- address stream-storage
-115   write stream, "=> symbol "
-116   write-stream stream, data
-117   trace trace, "print", stream
-118 }
-119 
-120 fn print-stream _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
-121   trace-text trace, "print", "stream"
-122   var in/esi: (addr cell) <- copy _in
-123   var data-ah/eax: (addr handle stream byte) <- get in, text-data
-124   var _data/eax: (addr stream byte) <- lookup *data-ah
-125   var data/esi: (addr stream byte) <- copy _data
-126   rewind-stream data
-127   write out, "["
-128   write-stream out, data
-129   write out, "]"
-130   # trace
-131   compare trace, 0
-132   break-if-=
-133   rewind-stream data
-134   var stream-storage: (stream byte 0x40)
-135   var stream/ecx: (addr stream byte) <- address stream-storage
-136   write stream, "=> stream "
-137   write-stream stream, data
-138   trace trace, "print", stream
-139 }
-140 
-141 fn print-number _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
-142   var in/esi: (addr cell) <- copy _in
-143   var val/eax: (addr float) <- get in, number-data
-144   write-float-decimal-approximate out, *val, 3/precision
-145   # trace
-146   compare trace, 0
-147   break-if-=
-148   var stream-storage: (stream byte 0x40)
-149   var stream/ecx: (addr stream byte) <- address stream-storage
-150   write stream, "=> number "
-151   write-float-decimal-approximate stream, *val, 3/precision
-152   trace trace, "print", stream
-153 }
-154 
-155 fn print-pair _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
-156   # if in starts with a quote, print the quote outside the expression
-157   var in/esi: (addr cell) <- copy _in
-158   var left-ah/eax: (addr handle cell) <- get in, left
-159   var _left/eax: (addr cell) <- lookup *left-ah
-160   var left/ecx: (addr cell) <- copy _left
-161   var is-quote?/eax: boolean <- symbol-equal? left, "'"
-162   compare is-quote?, 0/false
-163   {
-164     break-if-=
-165     write out, "'"
-166     var right-ah/eax: (addr handle cell) <- get in, right
-167     print-cell right-ah, out, trace
-168     return
-169   }
-170   var is-backquote?/eax: boolean <- symbol-equal? left, "`"
-171   compare is-backquote?, 0/false
-172   {
-173     break-if-=
-174     write out, "`"
-175     var right-ah/eax: (addr handle cell) <- get in, right
-176     print-cell right-ah, out, trace
-177     return
-178   }
-179   var is-unquote?/eax: boolean <- symbol-equal? left, ","
-180   compare is-unquote?, 0/false
-181   {
-182     break-if-=
-183     write out, ","
-184     var right-ah/eax: (addr handle cell) <- get in, right
-185     print-cell right-ah, out, trace
-186     return
-187   }
-188   var is-unquote-splice?/eax: boolean <- symbol-equal? left, ",@"
-189   compare is-unquote-splice?, 0/false
-190   {
-191     break-if-=
-192     write out, ",@"
-193     var right-ah/eax: (addr handle cell) <- get in, right
-194     print-cell right-ah, out, trace
-195     return
-196   }
-197   #
-198   var curr/esi: (addr cell) <- copy _in
-199   write out, "("
-200   $print-pair:loop: {
-201     var left/ecx: (addr handle cell) <- get curr, left
-202     print-cell left, out, trace
-203     var right/ecx: (addr handle cell) <- get curr, right
-204     var right-addr/eax: (addr cell) <- lookup *right
-205     {
-206       compare right-addr, 0
-207       break-if-!=
-208       abort "null encountered"
-209     }
-210     {
-211       var right-nil?/eax: boolean <- nil? right-addr
-212       compare right-nil?, 0/false
-213       {
-214         break-if-=
-215         trace-text trace, "print", "right is nil"
-216         break $print-pair:loop
-217       }
-218     }
-219     write out, " "
-220     var right-type-addr/edx: (addr int) <- get right-addr, type
-221     {
-222       compare *right-type-addr, 0/pair
-223       break-if-=
-224       write out, ". "
-225       print-cell right, out, trace
-226       break $print-pair:loop
-227     }
-228     curr <- copy right-addr
-229     loop
-230   }
-231   write out, ")"
-232 }
-233 
-234 # Most lisps intern nil, but we don't really have globals yet, so we'll be
-235 # less efficient for now.
-236 fn nil? _in: (addr cell) -> _/eax: boolean {
+  1 # Scenario:
+  2 #   print-cell can be used for printing into a trace
+  3 #   traces can run out of space
+  4 #   therefore, we need to gracefully handle insufficient space in 'out'
+  5 #     if we're printing something 3 bytes or less, just make sure it doesn't crash
+  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
+ 13   {
+ 14     compare in-addr, 0
+ 15     break-if-!=
+ 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'"
+ 22     }
+ 23     trace-higher trace
+ 24     return
+ 25   }
+ 26   {
+ 27     var nil?/eax: boolean <- nil? in-addr
+ 28     compare nil?, 0/false
+ 29     break-if-=
+ 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 '()'"
+ 35     }
+ 36     trace-higher trace
+ 37     return
+ 38   }
+ 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
+ 45     return
+ 46   }
+ 47   compare *in-type, 1/number
+ 48   {
+ 49     break-if-!=
+ 50     print-number in-addr, out, 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
+ 59     return
+ 60   }
+ 61   compare *in-type, 3/stream
+ 62   {
+ 63     break-if-!=
+ 64     print-stream in-addr, out, 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]"
+ 72     compare overflow?, 0/false
+ 73     {
+ 74       break-if-=
+ 75       overflow? <- try-write out, "..."
+ 76       error trace, "print-cell: no space for primitive"
+ 77     }
+ 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
+ 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"
+ 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
+ 96     write-int32-hex out, screen-addr
+ 97     write out, "]"
+ 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
+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"
+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
+116     write-int32-hex out, keyboard-addr
+117     write out, "]"
+118     trace-higher trace
+119     return
+120   }
+121 }
+122 
+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
+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
+130   print-cell in-ah, stream, trace
+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
+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
+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
+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
+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"
+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
+167   break-if-=
+168   rewind-stream data
+169   var stream-storage: (stream byte 0x40)
+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
+182   rewind-stream data
+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
+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"
+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
+200   break-if-=
+201   rewind-stream data
+202   var stream-storage: (stream byte 0x40)
+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
+211   compare available-space, 0x10
+212   {
+213     break-if->=
+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
+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
+225     break-if-!=
+226     return
+227   }
+228   var stream-storage: (stream byte 0x40)
+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
+233 }
+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   # if type != pair, return false
-239   var type/eax: (addr int) <- get in, type
-240   compare *type, 0/pair
-241   {
-242     break-if-=
-243     return 0/false
-244   }
-245   # if left != null, return false
-246   var left-ah/eax: (addr handle cell) <- get in, left
-247   var left/eax: (addr cell) <- lookup *left-ah
-248   compare left, 0
-249   {
-250     break-if-=
-251     return 0/false
-252   }
-253   # if right != null, return false
-254   var right-ah/eax: (addr handle cell) <- get in, right
-255   var right/eax: (addr cell) <- lookup *right-ah
-256   compare right, 0
-257   {
-258     break-if-=
-259     return 0/false
-260   }
-261   return 1/true
-262 }
-263 
-264 fn test-print-cell-zero {
-265   var num-storage: (handle cell)
-266   var num/esi: (addr handle cell) <- address num-storage
-267   new-integer num, 0
-268   var out-storage: (stream byte 0x40)
-269   var out/edi: (addr stream byte) <- address out-storage
-270   print-cell num, out, 0/no-trace
-271   check-stream-equal out, "0", "F - test-print-cell-zero"
-272 }
-273 
-274 fn test-print-cell-integer {
-275   var num-storage: (handle cell)
-276   var num/esi: (addr handle cell) <- address num-storage
-277   new-integer num, 1
-278   var out-storage: (stream byte 0x40)
-279   var out/edi: (addr stream byte) <- address out-storage
-280   print-cell num, out, 0/no-trace
-281   check-stream-equal out, "1", "F - test-print-cell-integer"
-282 }
-283 
-284 fn test-print-cell-integer-2 {
-285   var num-storage: (handle cell)
-286   var num/esi: (addr handle cell) <- address num-storage
-287   new-integer num, 0x30
-288   var out-storage: (stream byte 0x40)
-289   var out/edi: (addr stream byte) <- address out-storage
-290   print-cell num, out, 0/no-trace
-291   check-stream-equal out, "48", "F - test-print-cell-integer-2"
-292 }
-293 
-294 fn test-print-cell-fraction {
-295   var num-storage: (handle cell)
-296   var num/esi: (addr handle cell) <- address num-storage
-297   var val/xmm0: float <- rational 1, 2
-298   new-float num, val
-299   var out-storage: (stream byte 0x40)
-300   var out/edi: (addr stream byte) <- address out-storage
-301   print-cell num, out, 0/no-trace
-302   check-stream-equal out, "0.5", "F - test-print-cell-fraction"
-303 }
-304 
-305 fn test-print-cell-symbol {
-306   var sym-storage: (handle cell)
-307   var sym/esi: (addr handle cell) <- address sym-storage
-308   new-symbol sym, "abc"
-309   var out-storage: (stream byte 0x40)
-310   var out/edi: (addr stream byte) <- address out-storage
-311   print-cell sym, out, 0/no-trace
-312   check-stream-equal out, "abc", "F - test-print-cell-symbol"
-313 }
-314 
-315 fn test-print-cell-nil-list {
-316   var nil-storage: (handle cell)
-317   var nil/esi: (addr handle cell) <- address nil-storage
-318   allocate-pair nil
-319   var out-storage: (stream byte 0x40)
-320   var out/edi: (addr stream byte) <- address out-storage
-321   print-cell nil, out, 0/no-trace
-322   check-stream-equal out, "()", "F - test-print-cell-nil-list"
-323 }
-324 
-325 fn test-print-cell-singleton-list {
-326   # list
-327   var left-storage: (handle cell)
-328   var left/ecx: (addr handle cell) <- address left-storage
-329   new-symbol left, "abc"
-330   var nil-storage: (handle cell)
-331   var nil/edx: (addr handle cell) <- address nil-storage
-332   allocate-pair nil
-333   var list-storage: (handle cell)
-334   var list/esi: (addr handle cell) <- address list-storage
-335   new-pair list, *left, *nil
-336   #
-337   var out-storage: (stream byte 0x40)
-338   var out/edi: (addr stream byte) <- address out-storage
-339   print-cell list, out, 0/no-trace
-340   check-stream-equal out, "(abc)", "F - test-print-cell-singleton-list"
-341 }
-342 
-343 fn test-print-cell-list {
-344   # list = cons "abc", nil
-345   var left-storage: (handle cell)
-346   var left/ecx: (addr handle cell) <- address left-storage
-347   new-symbol left, "abc"
-348   var nil-storage: (handle cell)
-349   var nil/edx: (addr handle cell) <- address nil-storage
-350   allocate-pair nil
-351   var list-storage: (handle cell)
-352   var list/esi: (addr handle cell) <- address list-storage
-353   new-pair list, *left, *nil
-354   # list = cons 64, list
-355   new-integer left, 0x40
-356   new-pair list, *left, *list
-357   #
-358   var out-storage: (stream byte 0x40)
-359   var out/edi: (addr stream byte) <- address out-storage
-360   print-cell list, out, 0/no-trace
-361   check-stream-equal out, "(64 abc)", "F - test-print-cell-list"
-362 }
-363 
-364 fn test-print-cell-list-of-nil {
-365   # list = cons "abc", nil
-366   var left-storage: (handle cell)
-367   var left/ecx: (addr handle cell) <- address left-storage
-368   allocate-pair left
-369   var nil-storage: (handle cell)
-370   var nil/edx: (addr handle cell) <- address nil-storage
-371   allocate-pair nil
-372   var list-storage: (handle cell)
-373   var list/esi: (addr handle cell) <- address list-storage
-374   new-pair list, *left, *nil
-375   # list = cons 64, list
-376   new-integer left, 0x40
-377   new-pair list, *left, *list
-378   #
+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
+247     print-cell right-ah, out, trace
+248     return
+249   }
+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
+256     print-cell right-ah, out, trace
+257     return
+258   }
+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
+265     print-cell right-ah, out, trace
+266     return
+267   }
+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
+274     print-cell right-ah, out, trace
+275     return
+276   }
+277   #
+278   var curr/esi: (addr cell) <- copy _in
+279   {
+280     var overflow?/eax: boolean <- try-write out, "("
+281     compare overflow?, 0/false
+282     break-if-=
+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
+288     print-cell left, out, trace
+289     # errors? skip
+290     {
+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
+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
+305       compare right-nil?, 0/false
+306       {
+307         break-if-=
+308         trace-text trace, "print", "right is nil"
+309         break $print-pair:loop
+310       }
+311     }
+312     {
+313       var overflow?/eax: boolean <- try-write out, " "
+314       compare overflow?, 0/false
+315       break-if-=
+316       error trace, "print-pair: no space"
+317       return
+318     }
+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, ". "
+325         compare overflow?, 0/false
+326         break-if-=
+327         error trace, "print-pair: no space"
+328         return
+329       }
+330       print-cell right, out, trace
+331       break $print-pair:loop
+332     }
+333     curr <- copy right-addr
+334     loop
+335   }
+336   {
+337     var overflow?/eax: boolean <- try-write out, ")"
+338     compare overflow?, 0/false
+339     break-if-=
+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
+349   # if type != pair, return false
+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
+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
+367   compare right, 0
+368   {
+369     break-if-=
+370     return 0/false
+371   }
+372   return 1/true
+373 }
+374 
+375 fn test-print-cell-zero {
+376   var num-storage: (handle cell)
+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
-381   print-cell list, out, 0/no-trace
-382   check-stream-equal out, "(64 ())", "F - test-print-cell-list-nil"
-383 }
-384 
-385 fn test-print-dotted-list {
-386   # list = cons 64, "abc"
-387   var left-storage: (handle cell)
-388   var left/ecx: (addr handle cell) <- address left-storage
-389   new-symbol left, "abc"
-390   var right-storage: (handle cell)
-391   var right/edx: (addr handle cell) <- address right-storage
-392   new-integer right, 0x40
-393   var list-storage: (handle cell)
-394   var list/esi: (addr handle cell) <- address list-storage
-395   new-pair list, *left, *right
-396   #
-397   var out-storage: (stream byte 0x40)
-398   var out/edi: (addr stream byte) <- address out-storage
-399   print-cell list, out, 0/no-trace
-400   check-stream-equal out, "(abc . 64)", "F - test-print-dotted-list"
-401 }
+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
+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
+391   new-integer num, 1
+392   var out-storage: (stream byte 0x40)
+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
+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
+404   new-integer num, 0x30
+405   var out-storage: (stream byte 0x40)
+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
+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
+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
+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
+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
+431   new-symbol sym, "abc"
+432   var out-storage: (stream byte 0x40)
+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
+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
+444   allocate-pair nil
+445   var out-storage: (stream byte 0x40)
+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
+450   print-cell nil, out, trace
+451   check-stream-equal out, "()", "F - test-print-cell-nil-list"
+452 }
+453 
+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
+458   new-symbol left, "abc"
+459   var nil-storage: (handle cell)
+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
+464   new-pair list, *left, *nil
+465   #
+466   var out-storage: (stream byte 0x40)
+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
+471   print-cell list, out, trace
+472   check-stream-equal out, "(abc)", "F - test-print-cell-singleton-list"
+473 }
+474 
+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
+479   new-symbol left, "abc"
+480   var nil-storage: (handle cell)
+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
+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
+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
+495   print-cell list, out, trace
+496   check-stream-equal out, "(64 abc)", "F - test-print-cell-list"
+497 }
+498 
+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
+503   allocate-pair left
+504   var nil-storage: (handle cell)
+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
+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
+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
+519   print-cell list, out, trace
+520   check-stream-equal out, "(64 ())", "F - test-print-cell-list-nil"
+521 }
+522 
+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
+527   new-symbol left, "abc"
+528   var right-storage: (handle cell)
+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
+533   new-pair list, *left, *right
+534   #
+535   var out-storage: (stream byte 0x40)
+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
+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
+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
+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
+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"
+556 }
+557 
+558 fn test-print-cell-impossible {
+559   var sym-storage: (handle cell)
+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
+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
+567   print-cell sym, out, trace
+568   # insufficient space even for ellipses; print nothing
+569   check-stream-equal out, "", "F - test-print-cell-impossible"
+570 }
+571 
+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
+576   new-symbol left, "abcd"
+577   var nil-storage: (handle cell)
+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
+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
+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
+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 ec0cf368..ba9473f3 100644 --- a/html/shell/read.mu.html +++ b/html/shell/read.mu.html @@ -15,12 +15,12 @@ body { font-size:12pt; font-family: monospace; color: #000000; background-color: a { color:inherit; } * { font-size:12pt; font-size: 1em; } .PreProc { color: #c000c0; } +.Special { color: #ff6060; } .LineNr { } .Constant { color: #008787; } -.muComment { color: #005faf; } .Delimiter { color: #c000c0; } .muFunction { color: #af5f00; text-decoration: underline; } -.Special { color: #ff6060; } +.muComment { color: #005faf; } --> @@ -57,19 +57,21 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/main/shell/read.mu 
  1 fn read-cell in: (addr gap-buffer), out: (addr handle cell), trace: (addr trace) {
- 2   var tokens-storage: (stream cell 0x400)
- 3   var tokens/ecx: (addr stream cell) <- address tokens-storage
- 4   tokenize in, tokens, trace
- 5   var error?/eax: boolean <- has-errors? trace
- 6   compare error?, 0/false
- 7   {
- 8     break-if-=
- 9     return
-10   }
-11   # TODO: insert parens
-12   # TODO: transform infix
-13   parse-input tokens, out, trace
-14 }
+ 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
+ 6   tokenize in, tokens, trace
+ 7   var error?/eax: boolean <- has-errors? trace
+ 8   compare error?, 0/false
+ 9   {
+10     break-if-=
+11     return
+12   }
+13   # TODO: insert parens
+14   # TODO: transform infix
+15   parse-input tokens, out, trace
+16 }
diff --git a/html/shell/sandbox.mu.html b/html/shell/sandbox.mu.html index cbdc7c9f..59e674c7 100644 --- a/html/shell/sandbox.mu.html +++ b/html/shell/sandbox.mu.html @@ -58,906 +58,1084 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/main/shell/sandbox.mu 
-  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)
-  7   cursor-in-data?: boolean
-  8   cursor-in-keyboard?: boolean
-  9   cursor-in-trace?: 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
- 15   allocate 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
- 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
- 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
- 28     new-fake-keyboard keyboard-ah, 0x10/keyboard-capacity
- 29   }
- 30   #
- 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, 0x8000/lines, 0x80/visible-lines
- 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
- 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
- 48   populate-stream value-ah, 0x1000/4KB
- 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, 0x8000/lines, 0x80/visible-lines
- 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
- 59   allocate 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
- 68   {
- 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
- 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 {
- 82   clear-rect screen, xmin, ymin, xmax, ymax, 0xc5/bg=blue-bg=black
- 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
- 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     var value-ah/eax: (addr handle stream byte) <- get self, value
-107     var _value/eax: (addr stream byte) <- lookup *value-ah
-108     var value/esi: (addr stream byte) <- copy _value
-109     rewind-stream value
-110     var done?/eax: boolean <- stream-empty? value
-111     compare done?, 0/false
-112     break-if-!=
-113     var x/eax: int <- copy 0
-114     x, y <- draw-text-wrapping-right-then-down screen, "=> ", xmin, y, xmax, ymax, xmin, y, 7/fg, 0xc5/bg=blue-bg
-115     var x2/edx: int <- copy x
-116     var dummy/eax: int <- draw-stream-rightward screen, value, x2, xmax, y, 7/fg=grey, 0xc5/bg=blue-bg
-117   }
-118   y <- add 2  # padding
-119   y <- maybe-render-screen screen, self, xmin, y
-120   # render menu
-121   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
-122   compare *cursor-in-data?, 0/false
-123   {
-124     break-if-=
-125     render-sandbox-menu screen, self
-126     return
-127   }
-128   var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
-129   compare *cursor-in-trace?, 0/false
-130   {
-131     break-if-=
-132     render-trace-menu screen
-133     return
-134   }
-135   var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
-136   compare *cursor-in-keyboard?, 0/false
-137   {
-138     break-if-=
-139     render-keyboard-menu screen
-140     return
-141   }
-142 }
-143 
-144 fn clear-sandbox-output screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int {
-145   # render just enough of the sandbox to figure out what to erase
-146   var self/esi: (addr sandbox) <- copy _self
-147   var data-ah/eax: (addr handle gap-buffer) <- get self, data
-148   var _data/eax: (addr gap-buffer) <- lookup *data-ah
-149   var data/edx: (addr gap-buffer) <- copy _data
-150   var x/eax: int <- copy xmin
-151   var y/ecx: int <- copy ymin
-152   y <- maybe-render-empty-screen screen, self, xmin, y
-153   y <- maybe-render-keyboard screen, self, xmin, y
-154   var cursor-in-sandbox?/ebx: (addr boolean) <- get self, cursor-in-data?
-155   x, y <- render-gap-buffer-wrapping-right-then-down screen, data, x, y, xmax, ymax, *cursor-in-sandbox?, 3/fg, 0xc5/bg=blue-bg
-156   y <- increment
-157   clear-rect screen, xmin, y, xmax, ymax, 0xc5/bg=blue-bg=black
-158 }
-159 
-160 fn maybe-render-empty-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
-161   var self/esi: (addr sandbox) <- copy _self
-162   var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var
-163   var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah
-164   compare screen-obj-cell, 0
-165   {
-166     break-if-!=
-167     return ymin
-168   }
-169   var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type
-170   compare *screen-obj-cell-type, 5/screen
-171   {
-172     break-if-=
-173     return ymin  # silently give up on rendering the screen
-174   }
-175   var y/ecx: int <- copy ymin
-176   var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data
-177   var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
-178   var screen-obj/edx: (addr screen) <- copy _screen-obj
-179   var x/eax: int <- draw-text-rightward screen, "screen:   ", xmin, 0x99/xmax, y, 0x17/fg, 0xc5/bg=blue-bg
-180   y <- render-empty-screen screen, screen-obj, x, y
-181   return y
-182 }
-183 
-184 fn maybe-render-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
-185   var self/esi: (addr sandbox) <- copy _self
-186   var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var
-187   var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah
-188   compare screen-obj-cell, 0
-189   {
-190     break-if-!=
-191     return ymin
-192   }
-193   var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type
-194   compare *screen-obj-cell-type, 5/screen
-195   {
-196     break-if-=
-197     return ymin  # silently give up on rendering the screen
-198   }
-199   var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data
-200   var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
-201   var screen-obj/edx: (addr screen) <- copy _screen-obj
-202   {
-203     var screen-empty?/eax: boolean <- fake-screen-empty? screen-obj
-204     compare screen-empty?, 0/false
-205     break-if-=
-206     return ymin
-207   }
-208   var x/eax: int <- draw-text-rightward screen, "screen:   ", xmin, 0x99/xmax, ymin, 0x17/fg, 0xc5/bg=blue-bg
-209   var y/ecx: int <- copy ymin
-210   y <- render-screen screen, screen-obj, x, y
-211   return y
-212 }
-213 
-214 fn render-empty-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int {
-215   var target-screen/esi: (addr screen) <- copy _target-screen
-216   var screen-y/edi: int <- copy ymin
-217   # screen
-218   var height/edx: (addr int) <- get target-screen, height
-219   var y/ecx: int <- copy 0
-220   {
-221     compare y, *height
-222     break-if->=
-223     set-cursor-position screen, xmin, screen-y
-224     var width/edx: (addr int) <- get target-screen, width
-225     var x/ebx: int <- copy 0
-226     {
-227       compare x, *width
-228       break-if->=
-229       draw-code-point-at-cursor screen, 0x20/space, 0x18/fg, 0/bg
-230       move-cursor-right screen
-231       x <- increment
-232       loop
-233     }
-234     y <- increment
-235     screen-y <- increment
-236     loop
-237   }
-238   return screen-y
-239 }
-240 
-241 fn render-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int {
-242   var target-screen/esi: (addr screen) <- copy _target-screen
-243   var screen-y/edi: int <- copy ymin
-244   # text data
-245   {
-246     var height/edx: (addr int) <- get target-screen, height
-247     var y/ecx: int <- copy 0
-248     {
-249       compare y, *height
-250       break-if->=
-251       set-cursor-position screen, xmin, screen-y
-252       var width/edx: (addr int) <- get target-screen, width
-253       var x/ebx: int <- copy 0
-254       {
-255         compare x, *width
-256         break-if->=
-257         print-screen-cell-of-fake-screen screen, target-screen, x, y
-258         move-cursor-right screen
-259         x <- increment
-260         loop
-261       }
-262       y <- increment
-263       screen-y <- increment
-264       loop
-265     }
-266   }
-267   # pixel data
-268   {
-269     # screen top left pixels x y width height
-270     var tmp/eax: int <- copy xmin
-271     tmp <- shift-left 3/log2-font-width
-272     var left: int
-273     copy-to left, tmp
-274     tmp <- copy ymin
-275     tmp <- shift-left 4/log2-font-height
-276     var top: int
-277     copy-to top, tmp
-278     var pixels-ah/eax: (addr handle array byte) <- get target-screen, pixels
-279     var _pixels/eax: (addr array byte) <- lookup *pixels-ah
-280     var pixels/edi: (addr array byte) <- copy _pixels
-281     compare pixels, 0
-282     break-if-=
-283     var y/ebx: int <- copy 0
-284     var height-addr/edx: (addr int) <- get target-screen, height
-285     var height/edx: int <- copy *height-addr
-286     height <- shift-left 4/log2-font-height
-287     {
-288       compare y, height
-289       break-if->=
-290       var width-addr/edx: (addr int) <- get target-screen, width
-291       var width/edx: int <- copy *width-addr
-292       width <- shift-left 3/log2-font-width
-293       var x/eax: int <- copy 0
-294       {
-295         compare x, width
-296         break-if->=
-297         {
-298           var idx/ecx: int <- pixel-index target-screen, x, y
-299           var color-addr/ecx: (addr byte) <- index pixels, idx
-300           var color/ecx: byte <- copy-byte *color-addr
-301           var color2/ecx: int <- copy color
-302           compare color2, 0
-303           break-if-=
-304           var x2/eax: int <- copy x
-305           x2 <- add left
-306           var y2/ebx: int <- copy y
-307           y2 <- add top
-308           pixel screen, x2, y2, color2
-309         }
-310         x <- increment
-311         loop
-312       }
-313       y <- increment
-314       loop
-315     }
-316   }
-317   return screen-y
-318 }
-319 
-320 fn has-keyboard? _self: (addr sandbox) -> _/eax: boolean {
-321   var self/esi: (addr sandbox) <- copy _self
-322   var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
-323   var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah
-324   compare keyboard-obj-cell, 0
-325   {
-326     break-if-!=
-327     return 0/false
-328   }
-329   var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type
-330   compare *keyboard-obj-cell-type, 6/keyboard
-331   {
-332     break-if-=
-333     return 0/false
-334   }
-335   var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data
-336   var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah
-337   var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj
-338   compare keyboard-obj, 0
-339   {
-340     break-if-!=
-341     return 0/false
-342   }
-343   return 1/true
-344 }
-345 
-346 fn maybe-render-keyboard screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
-347   var self/esi: (addr sandbox) <- copy _self
-348   var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
-349   var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah
-350   compare keyboard-obj-cell, 0
-351   {
-352     break-if-!=
-353     return ymin
-354   }
-355   var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type
-356   compare *keyboard-obj-cell-type, 6/keyboard
-357   {
-358     break-if-=
-359     return ymin  # silently give up on rendering the keyboard
-360   }
-361   var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data
-362   var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah
-363   var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj
-364   var y/ecx: int <- copy ymin
-365   y <- increment  # padding
-366   var x/eax: int <- draw-text-rightward screen, "keyboard: ", xmin, 0x99/xmax, y, 0x17/fg, 0xc5/bg=blue-bg
-367   var cursor-in-keyboard?/esi: (addr boolean) <- get self, cursor-in-keyboard?
-368   y <- render-keyboard screen, keyboard-obj, x, y, *cursor-in-keyboard?
-369   y <- increment  # padding
-370   return y
-371 }
-372 
-373 fn render-keyboard screen: (addr screen), _keyboard: (addr gap-buffer), xmin: int, ymin: int, render-cursor?: boolean -> _/ecx: int {
-374   var keyboard/esi: (addr gap-buffer) <- copy _keyboard
-375   var width/edx: int <- copy 0x10/keyboard-capacity
-376   var y/edi: int <- copy ymin
-377   # keyboard
-378   var x/eax: int <- copy xmin
-379   var xmax/ecx: int <- copy x
-380   xmax <- add 0x10
-381   var ymax/edx: int <- copy ymin
-382   ymax <- add 1
-383   clear-rect screen, x, y, xmax, ymax, 0/bg
-384   x <- render-gap-buffer screen, keyboard, x, y, render-cursor?, 3/fg, 0/bg
-385   y <- increment
-386   return y
-387 }
-388 
-389 fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), x: int, y: int {
-390   var target/ecx: (addr screen) <- copy _target
-391   var data-ah/eax: (addr handle array screen-cell) <- get target, data
-392   var data/eax: (addr array screen-cell) <- lookup *data-ah
-393   var index/ecx: int <- screen-cell-index target, x, y
-394   var offset/ecx: (offset screen-cell) <- compute-offset data, index
-395   var src-cell/esi: (addr screen-cell) <- index data, offset
-396   var src-grapheme/eax: (addr grapheme) <- get src-cell, data
-397   var src-color/ecx: (addr int) <- get src-cell, color
-398   var src-background-color/edx: (addr int) <- get src-cell, background-color
-399   draw-grapheme-at-cursor screen, *src-grapheme, *src-color, *src-background-color
-400 }
-401 
-402 fn render-sandbox-menu screen: (addr screen), _self: (addr sandbox) {
-403   var _width/eax: int <- copy 0
-404   var height/ecx: int <- copy 0
-405   _width, height <- screen-size screen
-406   var width/edx: int <- copy _width
-407   var y/ecx: int <- copy height
-408   y <- decrement
-409   var height/ebx: int <- copy y
-410   height <- increment
-411   clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg=black
-412   set-cursor-position screen, 0/x, y
-413   draw-text-rightward-from-cursor screen, " ctrl+... ", width, 0xf/fg, 0xc5/bg=blue-bg
-414   draw-text-rightward-from-cursor screen, " r ", width, 0/fg, 0x5c/bg=black
-415   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0xc5/bg=blue-bg
-416   draw-text-rightward-from-cursor screen, " s ", width, 0/fg, 0x5c/bg=black
-417   draw-text-rightward-from-cursor screen, " run sandbox  ", 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, " a ", width, 0/fg, 0x5c/bg=black
-432   draw-text-rightward-from-cursor screen, " <<  ", width, 7/fg, 0xc5/bg=blue-bg
-433   draw-text-rightward-from-cursor screen, " b ", width, 0/fg, 0x5c/bg=black
-434   draw-text-rightward-from-cursor screen, " <word  ", width, 7/fg, 0xc5/bg=blue-bg
-435   draw-text-rightward-from-cursor screen, " f ", 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, " e ", width, 0/fg, 0x5c/bg=black
-438   draw-text-rightward-from-cursor screen, " >>  ", width, 7/fg, 0xc5/bg=blue-bg
-439 }
-440 
-441 fn render-keyboard-menu screen: (addr screen) {
-442   var width/eax: int <- copy 0
-443   var height/ecx: int <- copy 0
-444   width, height <- screen-size screen
-445   var y/ecx: int <- copy height
-446   y <- decrement
-447   var height/edx: int <- copy y
-448   height <- increment
-449   clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg=black
-450   set-cursor-position screen, 0/x, y
-451   draw-text-rightward-from-cursor screen, " ctrl+... ", width, 0xf/fg, 0xc5/bg=blue-bg
-452   draw-text-rightward-from-cursor screen, " r ", width, 0/fg, 0x5c/bg=black
-453   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0xc5/bg=blue-bg
-454   draw-text-rightward-from-cursor screen, " s ", width, 0/fg, 0x5c/bg=black
-455   draw-text-rightward-from-cursor screen, " run sandbox  ", width, 7/fg, 0xc5/bg=blue-bg
-456   draw-text-rightward-from-cursor screen, " m ", width, 0/fg, 7/bg
-457   draw-text-rightward-from-cursor screen, " to sandbox  ", width, 7/fg, 0xc5/bg=blue-bg
-458 }
-459 
-460 fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table), data-disk: (addr disk), real-screen: (addr screen), tweak-real-screen?: boolean {
-461   var self/esi: (addr sandbox) <- copy _self
-462   var g/edx: grapheme <- copy key
-463   # ctrl-s
-464   {
-465     compare g, 0x13/ctrl-s
-466     break-if-!=
-467     # minor gotcha here: any bindings created later in this iteration won't be
-468     # persisted until the next call to ctrl-s.
-469     store-state data-disk, self, globals
-470     # run sandbox
-471     var data-ah/ecx: (addr handle gap-buffer) <- get self, data
-472     var value-ah/eax: (addr handle stream byte) <- get self, value
-473     var _value/eax: (addr stream byte) <- lookup *value-ah
-474     var value/edx: (addr stream byte) <- copy _value
-475     var trace-ah/eax: (addr handle trace) <- get self, trace
-476     var _trace/eax: (addr trace) <- lookup *trace-ah
-477     var trace/ebx: (addr trace) <- copy _trace
-478     clear-trace trace
-479     {
-480       compare tweak-real-screen?, 0/false
-481       break-if-=
-482       clear-sandbox-output real-screen, self, 0x56/sandbox-left-margin, 1/y, 0x80/screen-width, 0x2f/screen-height-without-menu
-483     }
-484     var screen-cell/eax: (addr handle cell) <- get self, screen-var
-485     clear-screen-cell screen-cell
-486     var keyboard-cell/esi: (addr handle cell) <- get self, keyboard-var
-487     rewind-keyboard-cell keyboard-cell  # don't clear keys from before
-488     {
-489       compare tweak-real-screen?, 0/false
-490       break-if-=
-491       set-cursor-position real-screen, 0/x, 0/y  # for any debug prints during evaluation
-492     }
-493     run data-ah, value, globals, trace, screen-cell, keyboard-cell
-494     return
-495   }
-496   # ctrl-m
-497   {
-498     compare g, 0xd/ctrl-m
-499     break-if-!=
-500     # if cursor in data, switch to trace or fall through to keyboard
-501     {
-502       var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
-503       compare *cursor-in-data?, 0/false
-504       break-if-=
-505       var has-trace?/eax: boolean <- has-trace? self
-506       compare has-trace?, 0/false
-507       {
-508         break-if-=
-509         var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
-510         copy-to *cursor-in-data?, 0/false
-511         var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
-512         copy-to *cursor-in-trace?, 1/false
-513         return
-514       }
-515       var has-keyboard?/eax: boolean <- has-keyboard? self
-516       compare has-keyboard?, 0/false
-517       {
-518         break-if-=
-519         var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
-520         copy-to *cursor-in-data?, 0/false
-521         var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
-522         copy-to *cursor-in-keyboard?, 1/false
-523         return
-524       }
-525       return
-526     }
-527     # if cursor in trace, switch to keyboard or fall through to data
-528     {
-529       var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
-530       compare *cursor-in-trace?, 0/false
-531       break-if-=
-532       copy-to *cursor-in-trace?, 0/false
-533       var cursor-target/ecx: (addr boolean) <- get self, cursor-in-keyboard?
-534       var has-keyboard?/eax: boolean <- has-keyboard? self
-535       compare has-keyboard?, 0/false
-536       {
-537         break-if-!=
-538         cursor-target <- get self, cursor-in-data?
-539       }
-540       copy-to *cursor-target, 1/true
-541       return
-542     }
-543     # otherwise if cursor in keyboard, switch to data
-544     {
-545       var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
-546       compare *cursor-in-keyboard?, 0/false
-547       break-if-=
-548       copy-to *cursor-in-keyboard?, 0/false
-549       var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
-550       copy-to *cursor-in-data?, 1/true
-551       return
-552     }
-553     return
-554   }
-555   # if cursor in data, send key to data
-556   {
-557     var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
-558     compare *cursor-in-data?, 0/false
-559     break-if-=
-560     var data-ah/eax: (addr handle gap-buffer) <- get self, data
-561     var data/eax: (addr gap-buffer) <- lookup *data-ah
-562     edit-gap-buffer data, g
-563     return
-564   }
-565   # if cursor in keyboard, send key to keyboard
-566   {
-567     var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
-568     compare *cursor-in-keyboard?, 0/false
-569     break-if-=
-570     var keyboard-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
-571     var keyboard-cell/eax: (addr cell) <- lookup *keyboard-cell-ah
-572     compare keyboard-cell, 0
-573     {
-574       break-if-!=
-575       return
-576     }
-577     var keyboard-cell-type/ecx: (addr int) <- get keyboard-cell, type
-578     compare *keyboard-cell-type, 6/keyboard
-579     {
-580       break-if-=
-581       return
-582     }
-583     var keyboard-ah/eax: (addr handle gap-buffer) <- get keyboard-cell, keyboard-data
-584     var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
-585     edit-gap-buffer keyboard, g
-586     return
-587   }
-588   # if cursor in trace, send key to trace
-589   {
-590     var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
-591     compare *cursor-in-trace?, 0/false
-592     break-if-=
-593     var trace-ah/eax: (addr handle trace) <- get self, trace
-594     var trace/eax: (addr trace) <- lookup *trace-ah
-595     edit-trace trace, g
-596     return
-597   }
-598 }
-599 
-600 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) {
-601   var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah
-602   var in/eax: (addr gap-buffer) <- lookup *in-ah
-603   var read-result-h: (handle cell)
-604   var read-result-ah/esi: (addr handle cell) <- address read-result-h
-605   read-cell in, read-result-ah, trace
-606   var error?/eax: boolean <- has-errors? trace
-607   {
-608     compare error?, 0/false
-609     break-if-=
-610     return
-611   }
-612   macroexpand read-result-ah, globals, trace
-613   var nil-h: (handle cell)
-614   var nil-ah/eax: (addr handle cell) <- address nil-h
-615   allocate-pair nil-ah
-616   var eval-result-h: (handle cell)
-617   var eval-result-ah/edi: (addr handle cell) <- address eval-result-h
-618 #?   set-cursor-position 0/screen, 0 0
-619 #?   turn-on-debug-print
-620   debug-print "^", 4/fg, 0/bg
-621   evaluate read-result-ah, eval-result-ah, *nil-ah, globals, trace, screen-cell, keyboard-cell, 1/call-number
-622   debug-print "$", 4/fg, 0/bg
-623   var error?/eax: boolean <- has-errors? trace
-624   {
-625     compare error?, 0/false
-626     break-if-=
-627     return
-628   }
-629   # if there was no error and the read-result starts with "set" or "def", save
-630   # the gap buffer in the modified global, then create a new one for the next
-631   # command.
-632   maybe-stash-gap-buffer-to-global globals, read-result-ah, _in-ah
-633   clear-stream out
-634   print-cell eval-result-ah, out, trace
-635   mark-lines-dirty trace
-636 }
-637 
-638 fn read-evaluate-and-move-to-globals _in-ah: (addr handle gap-buffer), globals: (addr global-table) {
-639   var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah
-640   var in/eax: (addr gap-buffer) <- lookup *in-ah
-641   var read-result-h: (handle cell)
-642   var read-result-ah/esi: (addr handle cell) <- address read-result-h
-643   read-cell in, read-result-ah, 0/no-trace
-644   macroexpand read-result-ah, globals, 0/no-trace
-645   var nil-storage: (handle cell)
-646   var nil-ah/eax: (addr handle cell) <- address nil-storage
-647   allocate-pair nil-ah
-648   var eval-result-storage: (handle cell)
-649   var eval-result/edi: (addr handle cell) <- address eval-result-storage
-650   debug-print "^", 4/fg, 0/bg
-651   evaluate read-result-ah, eval-result, *nil-ah, globals, 0/no-trace, 0/no-screen-cell, 0/no-keyboard-cell, 1/call-number
-652   debug-print "$", 4/fg, 0/bg
-653   move-gap-buffer-to-global globals, read-result-ah, _in-ah
-654 }
-655 
-656 fn test-run-integer {
-657   var sandbox-storage: sandbox
-658   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-659   initialize-sandbox-with sandbox, "1"
-660   # eval
-661   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-662   # setup: screen
-663   var screen-on-stack: screen
-664   var screen/edi: (addr screen) <- address screen-on-stack
-665   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
-666   #
-667   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-668   # skip one line of padding
-669   check-screen-row screen, 1/y, " 1    ", "F - test-run-integer/0"
-670   check-screen-row screen, 2/y, " ...  ", "F - test-run-integer/1"
-671   check-screen-row screen, 3/y, " => 1 ", "F - test-run-integer/2"
-672 }
-673 
-674 fn test-run-error-invalid-integer {
-675   var sandbox-storage: sandbox
-676   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-677   initialize-sandbox-with sandbox, "1a"
-678   # eval
-679   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-680   # setup: screen
-681   var screen-on-stack: screen
-682   var screen/edi: (addr screen) <- address screen-on-stack
-683   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
-684   #
-685   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-686   # skip one line of padding
-687   check-screen-row screen, 1/y, " 1a             ", "F - test-run-error-invalid-integer/0"
-688   check-screen-row screen, 2/y, " ...            ", "F - test-run-error-invalid-integer/0"
-689   check-screen-row screen, 3/y, " invalid number ", "F - test-run-error-invalid-integer/2"
-690 }
-691 
-692 fn test-run-with-spaces {
-693   var sandbox-storage: sandbox
-694   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-695   initialize-sandbox-with sandbox, " 1 \n"
-696   # eval
-697   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-698   # setup: screen
-699   var screen-on-stack: screen
-700   var screen/edi: (addr screen) <- address screen-on-stack
-701   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
-702   #
-703   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-704   # skip one line of padding
-705   check-screen-row screen, 1/y, "  1   ", "F - test-run-with-spaces/0"
-706   check-screen-row screen, 2/y, "      ", "F - test-run-with-spaces/1"
-707   check-screen-row screen, 3/y, " ...  ", "F - test-run-with-spaces/2"
-708   check-screen-row screen, 4/y, " => 1 ", "F - test-run-with-spaces/3"
-709 }
-710 
-711 fn test-run-quote {
-712   var sandbox-storage: sandbox
-713   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-714   initialize-sandbox-with sandbox, "'a"
-715   # eval
-716   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-717   # setup: screen
-718   var screen-on-stack: screen
-719   var screen/edi: (addr screen) <- address screen-on-stack
-720   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
-721   #
-722   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-723   # skip one line of padding
-724   check-screen-row screen, 1/y, " 'a   ", "F - test-run-quote/0"
-725   check-screen-row screen, 2/y, " ...  ", "F - test-run-quote/1"
-726   check-screen-row screen, 3/y, " => a ", "F - test-run-quote/2"
-727 }
-728 
-729 fn test-run-dotted-list {
-730   var sandbox-storage: sandbox
-731   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-732   initialize-sandbox-with sandbox, "'(a . b)"
-733   # eval
-734   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-735   # setup: screen
-736   var screen-on-stack: screen
-737   var screen/edi: (addr screen) <- address screen-on-stack
-738   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
-739   #
-740   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-741   # skip one line of padding
-742   check-screen-row screen, 1/y, " '(a . b)   ", "F - test-run-dotted-list/0"
-743   check-screen-row screen, 2/y, " ...        ", "F - test-run-dotted-list/1"
-744   check-screen-row screen, 3/y, " => (a . b) ", "F - test-run-dotted-list/2"
-745 }
-746 
-747 fn test-run-dot-and-list {
-748   var sandbox-storage: sandbox
-749   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-750   initialize-sandbox-with sandbox, "'(a . (b))"
-751   # eval
-752   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-753   # setup: screen
-754   var screen-on-stack: screen
-755   var screen/edi: (addr screen) <- address screen-on-stack
-756   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
-757   #
-758   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-759   # skip one line of padding
-760   check-screen-row screen, 1/y, " '(a . (b)) ", "F - test-run-dot-and-list/0"
-761   check-screen-row screen, 2/y, " ...        ", "F - test-run-dot-and-list/1"
-762   check-screen-row screen, 3/y, " => (a b)   ", "F - test-run-dot-and-list/2"
-763 }
-764 
-765 fn test-run-final-dot {
-766   var sandbox-storage: sandbox
-767   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-768   initialize-sandbox-with sandbox, "'(a .)"
-769   # eval
-770   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-771   # setup: screen
-772   var screen-on-stack: screen
-773   var screen/edi: (addr screen) <- address screen-on-stack
-774   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
-775   #
-776   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-777   # skip one line of padding
-778   check-screen-row screen, 1/y, " '(a .)               ", "F - test-run-final-dot/0"
-779   check-screen-row screen, 2/y, " ...                  ", "F - test-run-final-dot/1"
-780   check-screen-row screen, 3/y, " '. )' makes no sense ", "F - test-run-final-dot/2"
-781   # further errors may occur
-782 }
-783 
-784 fn test-run-double-dot {
-785   var sandbox-storage: sandbox
-786   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-787   initialize-sandbox-with sandbox, "'(a . .)"
-788   # eval
-789   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-790   # setup: screen
-791   var screen-on-stack: screen
-792   var screen/edi: (addr screen) <- address screen-on-stack
-793   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
-794   #
-795   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-796   # skip one line of padding
-797   check-screen-row screen, 1/y, " '(a . .)             ", "F - test-run-double-dot/0"
-798   check-screen-row screen, 2/y, " ...                  ", "F - test-run-double-dot/1"
-799   check-screen-row screen, 3/y, " '. .' makes no sense ", "F - test-run-double-dot/2"
-800   # further errors may occur
-801 }
-802 
-803 fn test-run-multiple-expressions-after-dot {
-804   var sandbox-storage: sandbox
-805   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-806   initialize-sandbox-with sandbox, "'(a . b c)"
-807   # eval
-808   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-809   # setup: screen
-810   var screen-on-stack: screen
-811   var screen/edi: (addr screen) <- address screen-on-stack
-812   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
-813   #
-814   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-815   # skip one line of padding
-816   check-screen-row screen, 1/y, " '(a . b c)                                           ", "F - test-run-multiple-expressions-after-dot/0"
-817   check-screen-row screen, 2/y, " ...                                                  ", "F - test-run-multiple-expressions-after-dot/1"
-818   check-screen-row screen, 3/y, " cannot have multiple expressions between '.' and ')' ", "F - test-run-multiple-expressions-after-dot/2"
-819   # further errors may occur
-820 }
-821 
-822 fn test-run-stream {
-823   var sandbox-storage: sandbox
-824   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-825   initialize-sandbox-with sandbox, "[a b]"
-826   # eval
-827   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-828   # setup: screen
-829   var screen-on-stack: screen
-830   var screen/edi: (addr screen) <- address screen-on-stack
-831   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
-832   #
-833   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-834   # skip one line of padding
-835   check-screen-row screen, 1/y, " [a b]    ", "F - test-run-stream/0"
-836   check-screen-row screen, 2/y, " ...      ", "F - test-run-stream/1"
-837   check-screen-row screen, 3/y, " => [a b] ", "F - test-run-stream/2"
-838 }
-839 
-840 fn test-run-move-cursor-into-trace {
-841   var sandbox-storage: sandbox
-842   var sandbox/esi: (addr sandbox) <- address sandbox-storage
-843   initialize-sandbox-with sandbox, "12"
-844   # eval
-845   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-846   # setup: screen
-847   var screen-on-stack: screen
-848   var screen/edi: (addr screen) <- address screen-on-stack
-849   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
-850   #
-851   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-852   # skip one line of padding
-853   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-move-cursor-into-trace/pre-0"
-854   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "   |   ", "F - test-run-move-cursor-into-trace/pre-0/cursor"
-855   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-move-cursor-into-trace/pre-1"
-856   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "       ", "F - test-run-move-cursor-into-trace/pre-1/cursor"
-857   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-move-cursor-into-trace/pre-2"
-858   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-move-cursor-into-trace/pre-2/cursor"
-859   # move cursor into trace
-860   edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-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, " 12    ", "F - test-run-move-cursor-into-trace/trace-0"
-865   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "       ", "F - test-run-move-cursor-into-trace/trace-0/cursor"
-866   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-move-cursor-into-trace/trace-1"
-867   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " |||   ", "F - test-run-move-cursor-into-trace/trace-1/cursor"
-868   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-move-cursor-into-trace/trace-2"
-869   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-move-cursor-into-trace/trace-2/cursor"
-870   # move cursor into input
-871   edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
-872   #
-873   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
-874   # skip one line of padding
-875   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-move-cursor-into-trace/input-0"
-876   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "   |   ", "F - test-run-move-cursor-into-trace/input-0/cursor"
-877   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-move-cursor-into-trace/input-1"
-878   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "       ", "F - test-run-move-cursor-into-trace/input-1/cursor"
-879   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-move-cursor-into-trace/input-2"
-880   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-move-cursor-into-trace/input-2/cursor"
-881 }
-882 
-883 fn has-trace? _self: (addr sandbox) -> _/eax: boolean {
-884   var self/esi: (addr sandbox) <- copy _self
-885   var trace-ah/eax: (addr handle trace) <- get self, trace
-886   var _trace/eax: (addr trace) <- lookup *trace-ah
-887   var trace/edx: (addr trace) <- copy _trace
-888   compare trace, 0
-889   {
-890     break-if-!=
-891     return 0/false
-892   }
-893   var first-free/ebx: (addr int) <- get trace, first-free
-894   compare *first-free, 0
-895   {
-896     break-if->
-897     return 0/false
-898   }
-899   return 1/true
-900 }
+   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)
+   7   cursor-in-data?: boolean
+   8   cursor-in-keyboard?: boolean
+   9   cursor-in-trace?: 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
+  15   allocate 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
+  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
+  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
+  28     new-fake-keyboard keyboard-ah, 0x10/keyboard-capacity
+  29   }
+  30   #
+  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?
+  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
+  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
+  48   populate-stream value-ah, 0x1000/4KB
+  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?
+  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
+  59   allocate 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
+  68   {
+  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
+  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 {
+  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
+  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
+ 207     break-if-=
+ 208     return ymin
+ 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
+ 501       {
+ 502         break-if-=
+ 503         var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
+ 504         copy-to *cursor-in-data?, 0/false
+ 505         var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
+ 506         copy-to *cursor-in-keyboard?, 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
+ 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
+ 547     return
+ 548   }
+ 549   # if cursor in keyboard, send key to keyboard
+ 550   {
+ 551     var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
+ 552     compare *cursor-in-keyboard?, 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 }
diff --git a/html/shell/tokenize.mu.html b/html/shell/tokenize.mu.html index 2b14ee40..22c33dde 100644 --- a/html/shell/tokenize.mu.html +++ b/html/shell/tokenize.mu.html @@ -18,7 +18,6 @@ a { color:inherit; } .Special { color: #ff6060; } .LineNr { } .Constant { color: #008787; } -.CommentedCode { color: #8a8a8a; } .Delimiter { color: #c000c0; } .muFunction { color: #af5f00; text-decoration: underline; } .muTest { color: #5f8700; } @@ -63,8 +62,8 @@ 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 + 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 @@ -73,947 +72,975 @@ if ('onhashchange' in window) { 13 var done?/eax: boolean <- gap-buffer-scan-done? in 14 compare done?, 0/false 15 break-if-!= - 16 # initialize token data each iteration to avoid aliasing - 17 var dest-ah/eax: (addr handle stream byte) <- get token, text-data - 18 # I'm allocating 1KB for every. single. token. Just because a whole definition needs to fit in a string sometimes. Absolutely bonkers. - 19 populate-stream dest-ah, 0x400/max-definition-size - 20 # - 21 next-token in, token, trace - 22 var skip?/eax: boolean <- comment-token? token - 23 compare skip?, 0/false - 24 loop-if-!= - 25 var error?/eax: boolean <- has-errors? trace - 26 compare error?, 0/false - 27 { - 28 break-if-= - 29 return - 30 } - 31 write-to-stream out, token # shallow-copy text-data - 32 loop - 33 } - 34 trace-higher trace - 35 } - 36 - 37 fn test-tokenize-quote { - 38 var in-storage: gap-buffer - 39 var in/esi: (addr gap-buffer) <- address in-storage - 40 initialize-gap-buffer-with in, "'(a)" - 41 # - 42 var stream-storage: (stream cell 0x10) - 43 var stream/edi: (addr stream cell) <- address stream-storage - 44 # - 45 tokenize in, stream, 0/no-trace - 46 # - 47 var curr-token-storage: cell - 48 var curr-token/ebx: (addr cell) <- address curr-token-storage - 49 read-from-stream stream, curr-token - 50 var quote?/eax: boolean <- quote-token? curr-token - 51 check quote?, "F - test-tokenize-quote: quote" - 52 read-from-stream stream, curr-token - 53 var open-paren?/eax: boolean <- open-paren-token? curr-token - 54 check open-paren?, "F - test-tokenize-quote: open paren" - 55 read-from-stream stream, curr-token # skip a - 56 read-from-stream stream, curr-token - 57 var close-paren?/eax: boolean <- close-paren-token? curr-token - 58 check close-paren?, "F - test-tokenize-quote: close paren" - 59 } - 60 - 61 fn test-tokenize-backquote { - 62 var in-storage: gap-buffer - 63 var in/esi: (addr gap-buffer) <- address in-storage - 64 initialize-gap-buffer-with in, "`(a)" - 65 # - 66 var stream-storage: (stream cell 0x10) - 67 var stream/edi: (addr stream cell) <- address stream-storage - 68 # - 69 tokenize in, stream, 0/no-trace - 70 # - 71 var curr-token-storage: cell - 72 var curr-token/ebx: (addr cell) <- address curr-token-storage - 73 read-from-stream stream, curr-token - 74 var backquote?/eax: boolean <- backquote-token? curr-token - 75 check backquote?, "F - test-tokenize-backquote: backquote" - 76 read-from-stream stream, curr-token - 77 var open-paren?/eax: boolean <- open-paren-token? curr-token - 78 check open-paren?, "F - test-tokenize-backquote: open paren" - 79 read-from-stream stream, curr-token # skip a - 80 read-from-stream stream, curr-token - 81 var close-paren?/eax: boolean <- close-paren-token? curr-token - 82 check close-paren?, "F - test-tokenize-backquote: close paren" - 83 } - 84 - 85 fn test-tokenize-unquote { - 86 var in-storage: gap-buffer - 87 var in/esi: (addr gap-buffer) <- address in-storage - 88 initialize-gap-buffer-with in, ",(a)" - 89 # - 90 var stream-storage: (stream cell 0x10) - 91 var stream/edi: (addr stream cell) <- address stream-storage - 92 # - 93 tokenize in, stream, 0/no-trace + 16 # + 17 next-token in, token, trace + 18 var error?/eax: boolean <- has-errors? trace + 19 compare error?, 0/false + 20 { + 21 break-if-= + 22 return + 23 } + 24 var skip?/eax: boolean <- comment-token? token + 25 compare skip?, 0/false + 26 loop-if-!= + 27 write-to-stream out, token # shallow-copy text-data + 28 loop + 29 } + 30 trace-higher trace + 31 } + 32 + 33 fn test-tokenize-quote { + 34 var in-storage: gap-buffer + 35 var in/esi: (addr gap-buffer) <- address in-storage + 36 initialize-gap-buffer-with in, "'(a)" + 37 # + 38 var stream-storage: (stream cell 0x10) + 39 var stream/edi: (addr stream cell) <- address stream-storage + 40 # + 41 var trace-storage: trace + 42 var trace/edx: (addr trace) <- address trace-storage + 43 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible + 44 tokenize in, stream, trace + 45 # + 46 var curr-token-storage: cell + 47 var curr-token/ebx: (addr cell) <- address curr-token-storage + 48 read-from-stream stream, curr-token + 49 var quote?/eax: boolean <- quote-token? curr-token + 50 check quote?, "F - test-tokenize-quote: quote" + 51 read-from-stream stream, curr-token + 52 var open-paren?/eax: boolean <- open-paren-token? curr-token + 53 check open-paren?, "F - test-tokenize-quote: open paren" + 54 read-from-stream stream, curr-token # skip a + 55 read-from-stream stream, curr-token + 56 var close-paren?/eax: boolean <- close-paren-token? curr-token + 57 check close-paren?, "F - test-tokenize-quote: close paren" + 58 } + 59 + 60 fn test-tokenize-backquote { + 61 var in-storage: gap-buffer + 62 var in/esi: (addr gap-buffer) <- address in-storage + 63 initialize-gap-buffer-with in, "`(a)" + 64 # + 65 var stream-storage: (stream cell 0x10) + 66 var stream/edi: (addr stream cell) <- address stream-storage + 67 # + 68 var trace-storage: trace + 69 var trace/edx: (addr trace) <- address trace-storage + 70 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible + 71 tokenize in, stream, trace + 72 # + 73 var curr-token-storage: cell + 74 var curr-token/ebx: (addr cell) <- address curr-token-storage + 75 read-from-stream stream, curr-token + 76 var backquote?/eax: boolean <- backquote-token? curr-token + 77 check backquote?, "F - test-tokenize-backquote: backquote" + 78 read-from-stream stream, curr-token + 79 var open-paren?/eax: boolean <- open-paren-token? curr-token + 80 check open-paren?, "F - test-tokenize-backquote: open paren" + 81 read-from-stream stream, curr-token # skip a + 82 read-from-stream stream, curr-token + 83 var close-paren?/eax: boolean <- close-paren-token? curr-token + 84 check close-paren?, "F - test-tokenize-backquote: close paren" + 85 } + 86 + 87 fn test-tokenize-unquote { + 88 var in-storage: gap-buffer + 89 var in/esi: (addr gap-buffer) <- address in-storage + 90 initialize-gap-buffer-with in, ",(a)" + 91 # + 92 var stream-storage: (stream cell 0x10) + 93 var stream/edi: (addr stream cell) <- address stream-storage 94 # - 95 var curr-token-storage: cell - 96 var curr-token/ebx: (addr cell) <- address curr-token-storage - 97 read-from-stream stream, curr-token - 98 var unquote?/eax: boolean <- unquote-token? curr-token - 99 check unquote?, "F - test-tokenize-unquote: unquote" -100 read-from-stream stream, curr-token -101 var open-paren?/eax: boolean <- open-paren-token? curr-token -102 check open-paren?, "F - test-tokenize-unquote: open paren" -103 read-from-stream stream, curr-token # skip a -104 read-from-stream stream, curr-token -105 var close-paren?/eax: boolean <- close-paren-token? curr-token -106 check close-paren?, "F - test-tokenize-unquote: close paren" -107 } -108 -109 fn test-tokenize-unquote-splice { -110 var in-storage: gap-buffer -111 var in/esi: (addr gap-buffer) <- address in-storage -112 initialize-gap-buffer-with in, ",@a" -113 # -114 var stream-storage: (stream cell 0x10) -115 var stream/edi: (addr stream cell) <- address stream-storage -116 # -117 tokenize in, stream, 0/no-trace + 95 var trace-storage: trace + 96 var trace/edx: (addr trace) <- address trace-storage + 97 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible + 98 tokenize in, stream, trace + 99 # +100 var curr-token-storage: cell +101 var curr-token/ebx: (addr cell) <- address curr-token-storage +102 read-from-stream stream, curr-token +103 var unquote?/eax: boolean <- unquote-token? curr-token +104 check unquote?, "F - test-tokenize-unquote: unquote" +105 read-from-stream stream, curr-token +106 var open-paren?/eax: boolean <- open-paren-token? curr-token +107 check open-paren?, "F - test-tokenize-unquote: open paren" +108 read-from-stream stream, curr-token # skip a +109 read-from-stream stream, curr-token +110 var close-paren?/eax: boolean <- close-paren-token? curr-token +111 check close-paren?, "F - test-tokenize-unquote: close paren" +112 } +113 +114 fn test-tokenize-unquote-splice { +115 var in-storage: gap-buffer +116 var in/esi: (addr gap-buffer) <- address in-storage +117 initialize-gap-buffer-with in, ",@a" 118 # -119 var curr-token-storage: cell -120 var curr-token/ebx: (addr cell) <- address curr-token-storage -121 read-from-stream stream, curr-token -122 var unquote-splice?/eax: boolean <- unquote-splice-token? curr-token -123 check unquote-splice?, "F - test-tokenize-unquote-splice: unquote-splice" -124 } -125 -126 fn test-tokenize-dotted-list { -127 var in-storage: gap-buffer -128 var in/esi: (addr gap-buffer) <- address in-storage -129 initialize-gap-buffer-with in, "(a . b)" -130 # -131 var stream-storage: (stream cell 0x10) -132 var stream/edi: (addr stream cell) <- address stream-storage -133 # -134 tokenize in, stream, 0/no-trace -135 # -136 var curr-token-storage: cell -137 var curr-token/ebx: (addr cell) <- address curr-token-storage -138 read-from-stream stream, curr-token -139 var open-paren?/eax: boolean <- open-paren-token? curr-token -140 check open-paren?, "F - test-tokenize-dotted-list: open paren" -141 read-from-stream stream, curr-token # skip a -142 read-from-stream stream, curr-token -143 var dot?/eax: boolean <- dot-token? curr-token -144 check dot?, "F - test-tokenize-dotted-list: dot" -145 read-from-stream stream, curr-token # skip b -146 read-from-stream stream, curr-token -147 var close-paren?/eax: boolean <- close-paren-token? curr-token -148 check close-paren?, "F - test-tokenize-dotted-list: close paren" -149 } -150 -151 fn test-tokenize-stream-literal { -152 var in-storage: gap-buffer -153 var in/esi: (addr gap-buffer) <- address in-storage -154 initialize-gap-buffer-with in, "[abc def]" -155 # -156 var stream-storage: (stream cell 0x10) -157 var stream/edi: (addr stream cell) <- address stream-storage -158 # -159 tokenize in, stream, 0/no-trace -160 # -161 var curr-token-storage: cell -162 var curr-token/ebx: (addr cell) <- address curr-token-storage -163 read-from-stream stream, curr-token -164 var stream?/eax: boolean <- stream-token? curr-token -165 check stream?, "F - test-tokenize-stream-literal: type" -166 var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data -167 var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah -168 var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def" -169 check data-equal?, "F - test-tokenize-stream-literal" -170 var empty?/eax: boolean <- stream-empty? stream -171 check empty?, "F - test-tokenize-stream-literal: empty?" -172 } -173 -174 fn test-tokenize-stream-literal-in-tree { -175 var in-storage: gap-buffer -176 var in/esi: (addr gap-buffer) <- address in-storage -177 initialize-gap-buffer-with in, "([abc def])" -178 # -179 var stream-storage: (stream cell 0x10) -180 var stream/edi: (addr stream cell) <- address stream-storage -181 # -182 tokenize in, stream, 0/no-trace -183 # -184 var curr-token-storage: cell -185 var curr-token/ebx: (addr cell) <- address curr-token-storage -186 read-from-stream stream, curr-token -187 var bracket?/eax: boolean <- bracket-token? curr-token -188 check bracket?, "F - test-tokenize-stream-literal-in-tree: open paren" -189 read-from-stream stream, curr-token -190 var stream?/eax: boolean <- stream-token? curr-token -191 check stream?, "F - test-tokenize-stream-literal-in-tree: type" -192 var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data -193 var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah -194 var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def" -195 check data-equal?, "F - test-tokenize-stream-literal-in-tree" -196 read-from-stream stream, curr-token -197 var bracket?/eax: boolean <- bracket-token? curr-token -198 check bracket?, "F - test-tokenize-stream-literal-in-tree: close paren" -199 var empty?/eax: boolean <- stream-empty? stream -200 check empty?, "F - test-tokenize-stream-literal-in-tree: empty?" -201 } -202 -203 fn next-token in: (addr gap-buffer), _out-cell: (addr cell), trace: (addr trace) { -204 trace-text trace, "tokenize", "next-token" -205 trace-lower trace -206 var out-cell/eax: (addr cell) <- copy _out-cell -207 { -208 var out-cell-type/eax: (addr int) <- get out-cell, type -209 copy-to *out-cell-type, 0/uninitialized -210 } -211 var out-ah/eax: (addr handle stream byte) <- get out-cell, text-data -212 var _out/eax: (addr stream byte) <- lookup *out-ah -213 var out/edi: (addr stream byte) <- copy _out -214 $next-token:body: { -215 clear-stream out -216 var g/eax: grapheme <- peek-from-gap-buffer in -217 #? draw-grapheme-at-cursor 0/screen, g, 7/fg, 0/bg -218 #? move-cursor-rightward-and-downward 0/screen, 0, 0x80 -219 { -220 var stream-storage: (stream byte 0x40) -221 var stream/esi: (addr stream byte) <- address stream-storage -222 write stream, "next: " -223 var gval/eax: int <- copy g -224 write-int32-hex stream, gval -225 trace trace, "tokenize", stream -226 } -227 # comment -228 { -229 compare g, 0x23/comment -230 break-if-!= -231 rest-of-line in, out, trace -232 break $next-token:body -233 } -234 # digit -235 { -236 var digit?/eax: boolean <- decimal-digit? g -237 compare digit?, 0/false -238 break-if-= -239 next-number-token in, out, trace -240 break $next-token:body -241 } -242 # other symbol char +119 var stream-storage: (stream cell 0x10) +120 var stream/edi: (addr stream cell) <- address stream-storage +121 # +122 var trace-storage: trace +123 var trace/edx: (addr trace) <- address trace-storage +124 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +125 tokenize in, stream, trace +126 # +127 var curr-token-storage: cell +128 var curr-token/ebx: (addr cell) <- address curr-token-storage +129 read-from-stream stream, curr-token +130 var unquote-splice?/eax: boolean <- unquote-splice-token? curr-token +131 check unquote-splice?, "F - test-tokenize-unquote-splice: unquote-splice" +132 } +133 +134 fn test-tokenize-dotted-list { +135 var in-storage: gap-buffer +136 var in/esi: (addr gap-buffer) <- address in-storage +137 initialize-gap-buffer-with in, "(a . b)" +138 # +139 var stream-storage: (stream cell 0x10) +140 var stream/edi: (addr stream cell) <- address stream-storage +141 # +142 var trace-storage: trace +143 var trace/edx: (addr trace) <- address trace-storage +144 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +145 tokenize in, stream, trace +146 # +147 var curr-token-storage: cell +148 var curr-token/ebx: (addr cell) <- address curr-token-storage +149 read-from-stream stream, curr-token +150 var open-paren?/eax: boolean <- open-paren-token? curr-token +151 check open-paren?, "F - test-tokenize-dotted-list: open paren" +152 read-from-stream stream, curr-token # skip a +153 read-from-stream stream, curr-token +154 var dot?/eax: boolean <- dot-token? curr-token +155 check dot?, "F - test-tokenize-dotted-list: dot" +156 read-from-stream stream, curr-token # skip b +157 read-from-stream stream, curr-token +158 var close-paren?/eax: boolean <- close-paren-token? curr-token +159 check close-paren?, "F - test-tokenize-dotted-list: close paren" +160 } +161 +162 fn test-tokenize-stream-literal { +163 var in-storage: gap-buffer +164 var in/esi: (addr gap-buffer) <- address in-storage +165 initialize-gap-buffer-with in, "[abc def]" +166 # +167 var stream-storage: (stream cell 0x10) +168 var stream/edi: (addr stream cell) <- address stream-storage +169 # +170 var trace-storage: trace +171 var trace/edx: (addr trace) <- address trace-storage +172 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +173 tokenize in, stream, trace +174 # +175 var curr-token-storage: cell +176 var curr-token/ebx: (addr cell) <- address curr-token-storage +177 read-from-stream stream, curr-token +178 var stream?/eax: boolean <- stream-token? curr-token +179 check stream?, "F - test-tokenize-stream-literal: type" +180 var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data +181 var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah +182 var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def" +183 check data-equal?, "F - test-tokenize-stream-literal" +184 var empty?/eax: boolean <- stream-empty? stream +185 check empty?, "F - test-tokenize-stream-literal: empty?" +186 } +187 +188 fn test-tokenize-stream-literal-in-tree { +189 var in-storage: gap-buffer +190 var in/esi: (addr gap-buffer) <- address in-storage +191 initialize-gap-buffer-with in, "([abc def])" +192 # +193 var stream-storage: (stream cell 0x10) +194 var stream/edi: (addr stream cell) <- address stream-storage +195 # +196 var trace-storage: trace +197 var trace/edx: (addr trace) <- address trace-storage +198 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible +199 tokenize in, stream, trace +200 # +201 var curr-token-storage: cell +202 var curr-token/ebx: (addr cell) <- address curr-token-storage +203 read-from-stream stream, curr-token +204 var bracket?/eax: boolean <- bracket-token? curr-token +205 check bracket?, "F - test-tokenize-stream-literal-in-tree: open paren" +206 read-from-stream stream, curr-token +207 var stream?/eax: boolean <- stream-token? curr-token +208 check stream?, "F - test-tokenize-stream-literal-in-tree: type" +209 var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data +210 var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah +211 var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def" +212 check data-equal?, "F - test-tokenize-stream-literal-in-tree" +213 read-from-stream stream, curr-token +214 var bracket?/eax: boolean <- bracket-token? curr-token +215 check bracket?, "F - test-tokenize-stream-literal-in-tree: close paren" +216 var empty?/eax: boolean <- stream-empty? stream +217 check empty?, "F - test-tokenize-stream-literal-in-tree: empty?" +218 } +219 +220 fn next-token in: (addr gap-buffer), _out-cell: (addr cell), trace: (addr trace) { +221 trace-text trace, "tokenize", "next-token" +222 trace-lower trace +223 var _g/eax: grapheme <- peek-from-gap-buffer in +224 var g/ecx: grapheme <- copy _g +225 { +226 var stream-storage: (stream byte 0x40) +227 var stream/esi: (addr stream byte) <- address stream-storage +228 write stream, "next: " +229 var gval/eax: int <- copy g +230 write-int32-hex stream, gval +231 trace trace, "tokenize", stream +232 } +233 var out-cell/eax: (addr cell) <- copy _out-cell +234 { +235 var out-cell-type/eax: (addr int) <- get out-cell, type +236 copy-to *out-cell-type, 0/uninitialized +237 } +238 var out-ah/edi: (addr handle stream byte) <- get out-cell, text-data +239 $next-token:allocate: { +240 # Allocate a large buffer if it's a stream. +241 # Sometimes a whole function definition will need to fit in it. +242 compare g, 0x5b/open-square-bracket 243 { -244 var symbol?/eax: boolean <- symbol-grapheme? g -245 compare symbol?, 0/false -246 break-if-= -247 next-symbol-token in, out, trace -248 break $next-token:body -249 } -250 # open square brackets begin streams -251 { -252 compare g, 0x5b/open-square-bracket -253 break-if-!= -254 g <- read-from-gap-buffer in # skip open bracket -255 next-stream-token in, out, trace -256 var out-cell/eax: (addr cell) <- copy _out-cell -257 var out-cell-type/eax: (addr int) <- get out-cell, type -258 copy-to *out-cell-type, 3/stream -259 break $next-token:body -260 } -261 # unbalanced close square brackets are errors -262 { -263 compare g, 0x5d/close-square-bracket -264 break-if-!= -265 error trace, "unbalanced ']'" -266 return -267 } -268 # other brackets are always single-char tokens -269 { -270 var bracket?/eax: boolean <- bracket-grapheme? g -271 compare bracket?, 0/false -272 break-if-= -273 var g/eax: grapheme <- read-from-gap-buffer in -274 next-bracket-token g, out, trace -275 break $next-token:body -276 } -277 # non-symbol operators -278 { -279 var operator?/eax: boolean <- operator-grapheme? g -280 compare operator?, 0/false -281 break-if-= -282 next-operator-token in, out, trace -283 break $next-token:body -284 } -285 # quote -286 { -287 compare g, 0x27/single-quote -288 break-if-!= -289 g <- read-from-gap-buffer in # consume -290 write-grapheme out, g -291 break $next-token:body -292 } -293 # backquote -294 { -295 compare g, 0x60/single-quote -296 break-if-!= -297 g <- read-from-gap-buffer in # consume -298 write-grapheme out, g -299 break $next-token:body -300 } -301 # unquote -302 { -303 compare g, 0x2c/comma -304 break-if-!= -305 g <- read-from-gap-buffer in # consume -306 write-grapheme out, g -307 # check for unquote-splice -308 { -309 var g2/eax: grapheme <- peek-from-gap-buffer in -310 compare g2, 0x40/at-sign -311 break-if-!= -312 g2 <- read-from-gap-buffer in -313 write-grapheme out, g2 -314 } -315 break $next-token:body -316 } -317 abort "unknown token type" -318 } -319 trace-higher trace -320 var stream-storage: (stream byte 0x400) # maximum possible token size (next-stream-token) -321 var stream/eax: (addr stream byte) <- address stream-storage -322 write stream, "=> " -323 rewind-stream out -324 write-stream stream, out -325 trace trace, "tokenize", stream -326 } -327 -328 fn next-symbol-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { -329 trace-text trace, "tokenize", "looking for a symbol" -330 trace-lower trace -331 $next-symbol-token:loop: { -332 var done?/eax: boolean <- gap-buffer-scan-done? in -333 compare done?, 0/false -334 break-if-!= -335 var g/eax: grapheme <- peek-from-gap-buffer in -336 { -337 var stream-storage: (stream byte 0x40) -338 var stream/esi: (addr stream byte) <- address stream-storage -339 write stream, "next: " -340 var gval/eax: int <- copy g -341 write-int32-hex stream, gval -342 trace trace, "tokenize", stream -343 } -344 # if non-symbol, return -345 { -346 var symbol-grapheme?/eax: boolean <- symbol-grapheme? g -347 compare symbol-grapheme?, 0/false -348 break-if-!= -349 trace-text trace, "tokenize", "stop" -350 break $next-symbol-token:loop -351 } -352 var g/eax: grapheme <- read-from-gap-buffer in -353 write-grapheme out, g -354 loop -355 } -356 trace-higher trace -357 var stream-storage: (stream byte 0x40) -358 var stream/esi: (addr stream byte) <- address stream-storage -359 write stream, "=> " -360 rewind-stream out -361 write-stream stream, out -362 trace trace, "tokenize", stream -363 } -364 -365 fn next-operator-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { -366 trace-text trace, "tokenize", "looking for a operator" -367 trace-lower trace -368 $next-operator-token:loop: { -369 var done?/eax: boolean <- gap-buffer-scan-done? in -370 compare done?, 0/false -371 break-if-!= -372 var g/eax: grapheme <- peek-from-gap-buffer in +244 break-if-!= +245 populate-stream out-ah, 0x400/max-definition-size=1KB +246 break $next-token:allocate +247 } +248 populate-stream out-ah, 0x40 +249 } +250 var _out/eax: (addr stream byte) <- lookup *out-ah +251 var out/edi: (addr stream byte) <- copy _out +252 clear-stream out +253 $next-token:case: { +254 # open square brackets begin streams +255 { +256 compare g, 0x5b/open-square-bracket +257 break-if-!= +258 var dummy/eax: grapheme <- read-from-gap-buffer in # skip open bracket +259 next-stream-token in, out, trace +260 var out-cell/eax: (addr cell) <- copy _out-cell +261 # streams set the type +262 var out-cell-type/eax: (addr int) <- get out-cell, type +263 copy-to *out-cell-type, 3/stream +264 break $next-token:case +265 } +266 # comment +267 { +268 compare g, 0x23/comment +269 break-if-!= +270 rest-of-line in, out, trace +271 break $next-token:case +272 } +273 # digit +274 { +275 var digit?/eax: boolean <- decimal-digit? g +276 compare digit?, 0/false +277 break-if-= +278 next-number-token in, out, trace +279 break $next-token:case +280 } +281 # other symbol char +282 { +283 var symbol?/eax: boolean <- symbol-grapheme? g +284 compare symbol?, 0/false +285 break-if-= +286 next-symbol-token in, out, trace +287 break $next-token:case +288 } +289 # unbalanced close square brackets are errors +290 { +291 compare g, 0x5d/close-square-bracket +292 break-if-!= +293 error trace, "unbalanced ']'" +294 return +295 } +296 # other brackets are always single-char tokens +297 { +298 var bracket?/eax: boolean <- bracket-grapheme? g +299 compare bracket?, 0/false +300 break-if-= +301 var g/eax: grapheme <- read-from-gap-buffer in +302 next-bracket-token g, out, trace +303 break $next-token:case +304 } +305 # non-symbol operators +306 { +307 var operator?/eax: boolean <- operator-grapheme? g +308 compare operator?, 0/false +309 break-if-= +310 next-operator-token in, out, trace +311 break $next-token:case +312 } +313 # quote +314 { +315 compare g, 0x27/single-quote +316 break-if-!= +317 var g/eax: grapheme <- read-from-gap-buffer in # consume +318 write-grapheme out, g +319 break $next-token:case +320 } +321 # backquote +322 { +323 compare g, 0x60/backquote +324 break-if-!= +325 var g/eax: grapheme <- read-from-gap-buffer in # consume +326 write-grapheme out, g +327 break $next-token:case +328 } +329 # unquote +330 { +331 compare g, 0x2c/comma +332 break-if-!= +333 var g/eax: grapheme <- read-from-gap-buffer in # consume +334 write-grapheme out, g +335 # check for unquote-splice +336 { +337 var g2/eax: grapheme <- peek-from-gap-buffer in +338 compare g2, 0x40/at-sign +339 break-if-!= +340 g2 <- read-from-gap-buffer in +341 write-grapheme out, g2 +342 } +343 break $next-token:case +344 } +345 abort "unknown token type" +346 } +347 trace-higher trace +348 var stream-storage: (stream byte 0x400) # maximum possible token size (next-stream-token) +349 var stream/eax: (addr stream byte) <- address stream-storage +350 write stream, "=> " +351 rewind-stream out +352 write-stream stream, out +353 trace trace, "tokenize", stream +354 } +355 +356 fn next-symbol-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { +357 trace-text trace, "tokenize", "looking for a symbol" +358 trace-lower trace +359 $next-symbol-token:loop: { +360 var done?/eax: boolean <- gap-buffer-scan-done? in +361 compare done?, 0/false +362 break-if-!= +363 var g/eax: grapheme <- peek-from-gap-buffer in +364 { +365 var stream-storage: (stream byte 0x40) +366 var stream/esi: (addr stream byte) <- address stream-storage +367 write stream, "next: " +368 var gval/eax: int <- copy g +369 write-int32-hex stream, gval +370 trace trace, "tokenize", stream +371 } +372 # if non-symbol, return 373 { -374 var stream-storage: (stream byte 0x40) -375 var stream/esi: (addr stream byte) <- address stream-storage -376 write stream, "next: " -377 var gval/eax: int <- copy g -378 write-int32-hex stream, gval -379 trace trace, "tokenize", stream -380 } -381 # if non-operator, return -382 { -383 var operator-grapheme?/eax: boolean <- operator-grapheme? g -384 compare operator-grapheme?, 0/false -385 break-if-!= -386 trace-text trace, "tokenize", "stop" -387 break $next-operator-token:loop -388 } -389 var g/eax: grapheme <- read-from-gap-buffer in -390 write-grapheme out, g -391 loop -392 } -393 trace-higher trace -394 var stream-storage: (stream byte 0x40) -395 var stream/esi: (addr stream byte) <- address stream-storage -396 write stream, "=> " -397 rewind-stream out -398 write-stream stream, out -399 trace trace, "tokenize", stream -400 } -401 -402 fn next-number-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { -403 trace-text trace, "tokenize", "looking for a number" -404 trace-lower trace -405 $next-number-token:loop: { -406 var done?/eax: boolean <- gap-buffer-scan-done? in -407 compare done?, 0/false -408 break-if-!= -409 var g/eax: grapheme <- peek-from-gap-buffer in +374 var symbol-grapheme?/eax: boolean <- symbol-grapheme? g +375 compare symbol-grapheme?, 0/false +376 break-if-!= +377 trace-text trace, "tokenize", "stop" +378 break $next-symbol-token:loop +379 } +380 var g/eax: grapheme <- read-from-gap-buffer in +381 write-grapheme out, g +382 loop +383 } +384 trace-higher trace +385 var stream-storage: (stream byte 0x40) +386 var stream/esi: (addr stream byte) <- address stream-storage +387 write stream, "=> " +388 rewind-stream out +389 write-stream stream, out +390 trace trace, "tokenize", stream +391 } +392 +393 fn next-operator-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { +394 trace-text trace, "tokenize", "looking for a operator" +395 trace-lower trace +396 $next-operator-token:loop: { +397 var done?/eax: boolean <- gap-buffer-scan-done? in +398 compare done?, 0/false +399 break-if-!= +400 var g/eax: grapheme <- peek-from-gap-buffer in +401 { +402 var stream-storage: (stream byte 0x40) +403 var stream/esi: (addr stream byte) <- address stream-storage +404 write stream, "next: " +405 var gval/eax: int <- copy g +406 write-int32-hex stream, gval +407 trace trace, "tokenize", stream +408 } +409 # if non-operator, return 410 { -411 var stream-storage: (stream byte 0x40) -412 var stream/esi: (addr stream byte) <- address stream-storage -413 write stream, "next: " -414 var gval/eax: int <- copy g -415 write-int32-hex stream, gval -416 trace trace, "tokenize", stream -417 } -418 # if not symbol grapheme, return -419 { -420 var symbol-grapheme?/eax: boolean <- symbol-grapheme? g -421 compare symbol-grapheme?, 0/false -422 break-if-!= -423 trace-text trace, "tokenize", "stop" -424 break $next-number-token:loop -425 } -426 # if not digit grapheme, abort -427 { -428 var digit?/eax: boolean <- decimal-digit? g -429 compare digit?, 0/false -430 break-if-!= -431 error trace, "invalid number" -432 return -433 } -434 trace-text trace, "tokenize", "append" -435 var g/eax: grapheme <- read-from-gap-buffer in -436 write-grapheme out, g -437 loop -438 } -439 trace-higher trace -440 } -441 -442 fn next-stream-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { -443 trace-text trace, "tokenize", "stream" -444 { -445 var empty?/eax: boolean <- gap-buffer-scan-done? in -446 compare empty?, 0/false +411 var operator-grapheme?/eax: boolean <- operator-grapheme? g +412 compare operator-grapheme?, 0/false +413 break-if-!= +414 trace-text trace, "tokenize", "stop" +415 break $next-operator-token:loop +416 } +417 var g/eax: grapheme <- read-from-gap-buffer in +418 write-grapheme out, g +419 loop +420 } +421 trace-higher trace +422 var stream-storage: (stream byte 0x40) +423 var stream/esi: (addr stream byte) <- address stream-storage +424 write stream, "=> " +425 rewind-stream out +426 write-stream stream, out +427 trace trace, "tokenize", stream +428 } +429 +430 fn next-number-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { +431 trace-text trace, "tokenize", "looking for a number" +432 trace-lower trace +433 $next-number-token:loop: { +434 var done?/eax: boolean <- gap-buffer-scan-done? in +435 compare done?, 0/false +436 break-if-!= +437 var g/eax: grapheme <- peek-from-gap-buffer in +438 { +439 var stream-storage: (stream byte 0x40) +440 var stream/esi: (addr stream byte) <- address stream-storage +441 write stream, "next: " +442 var gval/eax: int <- copy g +443 write-int32-hex stream, gval +444 trace trace, "tokenize", stream +445 } +446 # if not symbol grapheme, return 447 { -448 break-if-= -449 error trace, "unbalanced '['" -450 return -451 } -452 var g/eax: grapheme <- read-from-gap-buffer in -453 compare g, 0x5d/close-square-bracket -454 break-if-= -455 write-grapheme out, g -456 loop -457 } -458 var stream-storage: (stream byte 0x400) # max-definition-size -459 var stream/esi: (addr stream byte) <- address stream-storage -460 write stream, "=> " -461 rewind-stream out -462 write-stream stream, out -463 trace trace, "tokenize", stream -464 } -465 -466 fn next-bracket-token g: grapheme, out: (addr stream byte), trace: (addr trace) { -467 trace-text trace, "tokenize", "bracket" -468 write-grapheme out, g -469 var stream-storage: (stream byte 0x40) -470 var stream/esi: (addr stream byte) <- address stream-storage -471 write stream, "=> " -472 rewind-stream out -473 write-stream stream, out -474 trace trace, "tokenize", stream -475 } -476 -477 fn rest-of-line in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { -478 trace-text trace, "tokenize", "comment" -479 { -480 var empty?/eax: boolean <- gap-buffer-scan-done? in -481 compare empty?, 0/false -482 { -483 break-if-= -484 return -485 } -486 var g/eax: grapheme <- read-from-gap-buffer in -487 compare g, 0xa/newline -488 break-if-= -489 write-grapheme out, g -490 loop -491 } -492 var stream-storage: (stream byte 0x80) -493 var stream/esi: (addr stream byte) <- address stream-storage -494 write stream, "=> " -495 rewind-stream out -496 write-stream stream, out -497 trace trace, "tokenize", stream -498 } -499 -500 fn symbol-grapheme? g: grapheme -> _/eax: boolean { -501 ## whitespace -502 compare g, 9/tab -503 { -504 break-if-!= -505 return 0/false -506 } -507 compare g, 0xa/newline -508 { -509 break-if-!= -510 return 0/false -511 } -512 compare g, 0x20/space -513 { -514 break-if-!= -515 return 0/false -516 } -517 ## quotes -518 compare g, 0x22/double-quote -519 { -520 break-if-!= -521 return 0/false -522 } -523 compare g, 0x60/backquote -524 { -525 break-if-!= -526 return 0/false -527 } -528 ## brackets -529 compare g, 0x28/open-paren -530 { -531 break-if-!= -532 return 0/false -533 } -534 compare g, 0x29/close-paren -535 { -536 break-if-!= -537 return 0/false -538 } -539 compare g, 0x5b/open-square-bracket -540 { -541 break-if-!= -542 return 0/false -543 } -544 compare g, 0x5d/close-square-bracket -545 { -546 break-if-!= -547 return 0/false -548 } -549 compare g, 0x7b/open-curly-bracket -550 { -551 break-if-!= -552 return 0/false -553 } -554 compare g, 0x7d/close-curly-bracket -555 { -556 break-if-!= -557 return 0/false -558 } -559 # - other punctuation -560 # '!' is a symbol char -561 compare g, 0x23/hash -562 { -563 break-if-!= -564 return 0/false -565 } -566 # '$' is a symbol char -567 compare g, 0x25/percent +448 var symbol-grapheme?/eax: boolean <- symbol-grapheme? g +449 compare symbol-grapheme?, 0/false +450 break-if-!= +451 trace-text trace, "tokenize", "stop" +452 break $next-number-token:loop +453 } +454 # if not digit grapheme, abort +455 { +456 var digit?/eax: boolean <- decimal-digit? g +457 compare digit?, 0/false +458 break-if-!= +459 error trace, "invalid number" +460 return +461 } +462 trace-text trace, "tokenize", "append" +463 var g/eax: grapheme <- read-from-gap-buffer in +464 write-grapheme out, g +465 loop +466 } +467 trace-higher trace +468 } +469 +470 fn next-stream-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { +471 trace-text trace, "tokenize", "stream" +472 { +473 var empty?/eax: boolean <- gap-buffer-scan-done? in +474 compare empty?, 0/false +475 { +476 break-if-= +477 error trace, "unbalanced '['" +478 return +479 } +480 var g/eax: grapheme <- read-from-gap-buffer in +481 compare g, 0x5d/close-square-bracket +482 break-if-= +483 write-grapheme out, g +484 loop +485 } +486 var stream-storage: (stream byte 0x400) # max-definition-size +487 var stream/esi: (addr stream byte) <- address stream-storage +488 write stream, "=> " +489 rewind-stream out +490 write-stream stream, out +491 trace trace, "tokenize", stream +492 } +493 +494 fn next-bracket-token g: grapheme, out: (addr stream byte), trace: (addr trace) { +495 trace-text trace, "tokenize", "bracket" +496 write-grapheme out, g +497 var stream-storage: (stream byte 0x40) +498 var stream/esi: (addr stream byte) <- address stream-storage +499 write stream, "=> " +500 rewind-stream out +501 write-stream stream, out +502 trace trace, "tokenize", stream +503 } +504 +505 fn rest-of-line in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { +506 trace-text trace, "tokenize", "comment" +507 { +508 var empty?/eax: boolean <- gap-buffer-scan-done? in +509 compare empty?, 0/false +510 { +511 break-if-= +512 return +513 } +514 var g/eax: grapheme <- read-from-gap-buffer in +515 compare g, 0xa/newline +516 break-if-= +517 write-grapheme out, g +518 loop +519 } +520 var stream-storage: (stream byte 0x80) +521 var stream/esi: (addr stream byte) <- address stream-storage +522 write stream, "=> " +523 rewind-stream out +524 write-stream stream, out +525 trace trace, "tokenize", stream +526 } +527 +528 fn symbol-grapheme? g: grapheme -> _/eax: boolean { +529 ## whitespace +530 compare g, 9/tab +531 { +532 break-if-!= +533 return 0/false +534 } +535 compare g, 0xa/newline +536 { +537 break-if-!= +538 return 0/false +539 } +540 compare g, 0x20/space +541 { +542 break-if-!= +543 return 0/false +544 } +545 ## quotes +546 compare g, 0x22/double-quote +547 { +548 break-if-!= +549 return 0/false +550 } +551 compare g, 0x60/backquote +552 { +553 break-if-!= +554 return 0/false +555 } +556 ## brackets +557 compare g, 0x28/open-paren +558 { +559 break-if-!= +560 return 0/false +561 } +562 compare g, 0x29/close-paren +563 { +564 break-if-!= +565 return 0/false +566 } +567 compare g, 0x5b/open-square-bracket 568 { 569 break-if-!= 570 return 0/false 571 } -572 compare g, 0x26/ampersand +572 compare g, 0x5d/close-square-bracket 573 { 574 break-if-!= 575 return 0/false 576 } -577 compare g, 0x27/single-quote +577 compare g, 0x7b/open-curly-bracket 578 { 579 break-if-!= 580 return 0/false 581 } -582 compare g, 0x60/backquote +582 compare g, 0x7d/close-curly-bracket 583 { 584 break-if-!= 585 return 0/false 586 } -587 compare g, 0x2c/comma -588 { -589 break-if-!= -590 return 0/false -591 } -592 compare g, 0x40/at-sign -593 { -594 break-if-!= -595 return 0/false -596 } -597 compare g, 0x2a/asterisk -598 { -599 break-if-!= -600 return 0/false -601 } -602 compare g, 0x2b/plus -603 { -604 break-if-!= -605 return 0/false -606 } -607 compare g, 0x2d/dash # '-' not allowed in symbols -608 { -609 break-if-!= -610 return 0/false -611 } -612 compare g, 0x2e/period -613 { -614 break-if-!= -615 return 0/false -616 } -617 compare g, 0x2f/slash -618 { -619 break-if-!= -620 return 0/false -621 } -622 compare g, 0x3a/colon -623 { -624 break-if-!= -625 return 0/false -626 } -627 compare g, 0x3b/semi-colon -628 { -629 break-if-!= -630 return 0/false -631 } -632 compare g, 0x3c/less-than -633 { -634 break-if-!= -635 return 0/false -636 } -637 compare g, 0x3d/equal -638 { -639 break-if-!= -640 return 0/false -641 } -642 compare g, 0x3e/greater-than -643 { -644 break-if-!= -645 return 0/false -646 } -647 # '?' is a symbol char -648 compare g, 0x5c/backslash -649 { -650 break-if-!= -651 return 0/false -652 } -653 compare g, 0x5e/caret -654 { -655 break-if-!= -656 return 0/false -657 } -658 # '_' is a symbol char -659 compare g, 0x7c/vertical-line -660 { -661 break-if-!= -662 return 0/false -663 } -664 compare g, 0x7e/tilde -665 { -666 break-if-!= -667 return 0/false -668 } -669 return 1/true -670 } -671 -672 fn bracket-grapheme? g: grapheme -> _/eax: boolean { -673 compare g, 0x28/open-paren -674 { -675 break-if-!= -676 return 1/true -677 } -678 compare g, 0x29/close-paren -679 { -680 break-if-!= -681 return 1/true -682 } -683 compare g, 0x5b/open-square-bracket -684 { -685 break-if-!= -686 return 1/true -687 } -688 compare g, 0x5d/close-square-bracket -689 { -690 break-if-!= -691 return 1/true -692 } -693 compare g, 0x7b/open-curly-bracket -694 { -695 break-if-!= -696 return 1/true -697 } -698 compare g, 0x7d/close-curly-bracket -699 { -700 break-if-!= -701 return 1/true -702 } -703 return 0/false -704 } -705 -706 fn operator-grapheme? g: grapheme -> _/eax: boolean { -707 # '$' is a symbol char -708 compare g, 0x25/percent -709 { -710 break-if-!= -711 return 1/false -712 } -713 compare g, 0x26/ampersand -714 { -715 break-if-!= -716 return 1/true -717 } -718 compare g, 0x27/single-quote -719 { -720 break-if-!= -721 return 0/true -722 } -723 compare g, 0x60/backquote -724 { -725 break-if-!= -726 return 0/false -727 } -728 compare g, 0x2c/comma -729 { -730 break-if-!= -731 return 0/false -732 } -733 compare g, 0x40/at-sign -734 { -735 break-if-!= -736 return 0/false -737 } -738 compare g, 0x2a/asterisk -739 { -740 break-if-!= -741 return 1/true -742 } -743 compare g, 0x2b/plus -744 { -745 break-if-!= -746 return 1/true -747 } -748 compare g, 0x2d/dash # '-' not allowed in symbols -749 { -750 break-if-!= -751 return 1/true -752 } -753 compare g, 0x2e/period -754 { -755 break-if-!= -756 return 1/true -757 } -758 compare g, 0x2f/slash -759 { -760 break-if-!= -761 return 1/true -762 } -763 compare g, 0x3a/colon -764 { -765 break-if-!= -766 return 1/true -767 } -768 compare g, 0x3b/semi-colon -769 { -770 break-if-!= -771 return 1/true -772 } -773 compare g, 0x3c/less-than -774 { -775 break-if-!= -776 return 1/true -777 } -778 compare g, 0x3d/equal -779 { -780 break-if-!= -781 return 1/true -782 } -783 compare g, 0x3e/greater-than -784 { -785 break-if-!= -786 return 1/true -787 } -788 # '?' is a symbol char -789 compare g, 0x5c/backslash -790 { -791 break-if-!= -792 return 1/true -793 } -794 compare g, 0x5e/caret -795 { -796 break-if-!= -797 return 1/true -798 } -799 # '_' is a symbol char -800 compare g, 0x7c/vertical-line -801 { -802 break-if-!= -803 return 1/true -804 } -805 compare g, 0x7e/tilde -806 { -807 break-if-!= -808 return 1/true -809 } -810 return 0/false -811 } -812 -813 fn number-token? _in: (addr cell) -> _/eax: boolean { -814 var in/eax: (addr cell) <- copy _in -815 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -816 var in-data/eax: (addr stream byte) <- lookup *in-data-ah -817 rewind-stream in-data -818 var g/eax: grapheme <- read-grapheme in-data -819 var result/eax: boolean <- decimal-digit? g -820 return result -821 } -822 -823 fn bracket-token? _in: (addr cell) -> _/eax: boolean { -824 var in/eax: (addr cell) <- copy _in -825 { -826 var in-type/eax: (addr int) <- get in, type -827 compare *in-type, 3/stream -828 break-if-!= -829 # streams are never paren tokens -830 return 0/false -831 } -832 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -833 var in-data/eax: (addr stream byte) <- lookup *in-data-ah -834 rewind-stream in-data -835 var g/eax: grapheme <- read-grapheme in-data -836 var result/eax: boolean <- bracket-grapheme? g -837 return result -838 } -839 -840 fn quote-token? _in: (addr cell) -> _/eax: boolean { -841 var in/eax: (addr cell) <- copy _in -842 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -843 var in-data/eax: (addr stream byte) <- lookup *in-data-ah -844 rewind-stream in-data -845 var result/eax: boolean <- stream-data-equal? in-data, "'" -846 return result -847 } -848 -849 fn backquote-token? _in: (addr cell) -> _/eax: boolean { -850 var in/eax: (addr cell) <- copy _in -851 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -852 var in-data/eax: (addr stream byte) <- lookup *in-data-ah -853 rewind-stream in-data -854 var result/eax: boolean <- stream-data-equal? in-data, "`" -855 return result -856 } -857 -858 fn unquote-token? _in: (addr cell) -> _/eax: boolean { -859 var in/eax: (addr cell) <- copy _in +587 # - other punctuation +588 # '!' is a symbol char +589 compare g, 0x23/hash +590 { +591 break-if-!= +592 return 0/false +593 } +594 # '$' is a symbol char +595 compare g, 0x25/percent +596 { +597 break-if-!= +598 return 0/false +599 } +600 compare g, 0x26/ampersand +601 { +602 break-if-!= +603 return 0/false +604 } +605 compare g, 0x27/single-quote +606 { +607 break-if-!= +608 return 0/false +609 } +610 compare g, 0x60/backquote +611 { +612 break-if-!= +613 return 0/false +614 } +615 compare g, 0x2c/comma +616 { +617 break-if-!= +618 return 0/false +619 } +620 compare g, 0x40/at-sign +621 { +622 break-if-!= +623 return 0/false +624 } +625 compare g, 0x2a/asterisk +626 { +627 break-if-!= +628 return 0/false +629 } +630 compare g, 0x2b/plus +631 { +632 break-if-!= +633 return 0/false +634 } +635 compare g, 0x2d/dash # '-' not allowed in symbols +636 { +637 break-if-!= +638 return 0/false +639 } +640 compare g, 0x2e/period +641 { +642 break-if-!= +643 return 0/false +644 } +645 compare g, 0x2f/slash +646 { +647 break-if-!= +648 return 0/false +649 } +650 compare g, 0x3a/colon +651 { +652 break-if-!= +653 return 0/false +654 } +655 compare g, 0x3b/semi-colon +656 { +657 break-if-!= +658 return 0/false +659 } +660 compare g, 0x3c/less-than +661 { +662 break-if-!= +663 return 0/false +664 } +665 compare g, 0x3d/equal +666 { +667 break-if-!= +668 return 0/false +669 } +670 compare g, 0x3e/greater-than +671 { +672 break-if-!= +673 return 0/false +674 } +675 # '?' is a symbol char +676 compare g, 0x5c/backslash +677 { +678 break-if-!= +679 return 0/false +680 } +681 compare g, 0x5e/caret +682 { +683 break-if-!= +684 return 0/false +685 } +686 # '_' is a symbol char +687 compare g, 0x7c/vertical-line +688 { +689 break-if-!= +690 return 0/false +691 } +692 compare g, 0x7e/tilde +693 { +694 break-if-!= +695 return 0/false +696 } +697 return 1/true +698 } +699 +700 fn bracket-grapheme? g: grapheme -> _/eax: boolean { +701 compare g, 0x28/open-paren +702 { +703 break-if-!= +704 return 1/true +705 } +706 compare g, 0x29/close-paren +707 { +708 break-if-!= +709 return 1/true +710 } +711 compare g, 0x5b/open-square-bracket +712 { +713 break-if-!= +714 return 1/true +715 } +716 compare g, 0x5d/close-square-bracket +717 { +718 break-if-!= +719 return 1/true +720 } +721 compare g, 0x7b/open-curly-bracket +722 { +723 break-if-!= +724 return 1/true +725 } +726 compare g, 0x7d/close-curly-bracket +727 { +728 break-if-!= +729 return 1/true +730 } +731 return 0/false +732 } +733 +734 fn operator-grapheme? g: grapheme -> _/eax: boolean { +735 # '$' is a symbol char +736 compare g, 0x25/percent +737 { +738 break-if-!= +739 return 1/false +740 } +741 compare g, 0x26/ampersand +742 { +743 break-if-!= +744 return 1/true +745 } +746 compare g, 0x27/single-quote +747 { +748 break-if-!= +749 return 0/true +750 } +751 compare g, 0x60/backquote +752 { +753 break-if-!= +754 return 0/false +755 } +756 compare g, 0x2c/comma +757 { +758 break-if-!= +759 return 0/false +760 } +761 compare g, 0x40/at-sign +762 { +763 break-if-!= +764 return 0/false +765 } +766 compare g, 0x2a/asterisk +767 { +768 break-if-!= +769 return 1/true +770 } +771 compare g, 0x2b/plus +772 { +773 break-if-!= +774 return 1/true +775 } +776 compare g, 0x2d/dash # '-' not allowed in symbols +777 { +778 break-if-!= +779 return 1/true +780 } +781 compare g, 0x2e/period +782 { +783 break-if-!= +784 return 1/true +785 } +786 compare g, 0x2f/slash +787 { +788 break-if-!= +789 return 1/true +790 } +791 compare g, 0x3a/colon +792 { +793 break-if-!= +794 return 1/true +795 } +796 compare g, 0x3b/semi-colon +797 { +798 break-if-!= +799 return 1/true +800 } +801 compare g, 0x3c/less-than +802 { +803 break-if-!= +804 return 1/true +805 } +806 compare g, 0x3d/equal +807 { +808 break-if-!= +809 return 1/true +810 } +811 compare g, 0x3e/greater-than +812 { +813 break-if-!= +814 return 1/true +815 } +816 # '?' is a symbol char +817 compare g, 0x5c/backslash +818 { +819 break-if-!= +820 return 1/true +821 } +822 compare g, 0x5e/caret +823 { +824 break-if-!= +825 return 1/true +826 } +827 # '_' is a symbol char +828 compare g, 0x7c/vertical-line +829 { +830 break-if-!= +831 return 1/true +832 } +833 compare g, 0x7e/tilde +834 { +835 break-if-!= +836 return 1/true +837 } +838 return 0/false +839 } +840 +841 fn number-token? _in: (addr cell) -> _/eax: boolean { +842 var in/eax: (addr cell) <- copy _in +843 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +844 var in-data/eax: (addr stream byte) <- lookup *in-data-ah +845 rewind-stream in-data +846 var g/eax: grapheme <- read-grapheme in-data +847 var result/eax: boolean <- decimal-digit? g +848 return result +849 } +850 +851 fn bracket-token? _in: (addr cell) -> _/eax: boolean { +852 var in/eax: (addr cell) <- copy _in +853 { +854 var in-type/eax: (addr int) <- get in, type +855 compare *in-type, 3/stream +856 break-if-!= +857 # streams are never paren tokens +858 return 0/false +859 } 860 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data 861 var in-data/eax: (addr stream byte) <- lookup *in-data-ah 862 rewind-stream in-data -863 var result/eax: boolean <- stream-data-equal? in-data, "," -864 return result -865 } -866 -867 fn unquote-splice-token? _in: (addr cell) -> _/eax: boolean { -868 var in/eax: (addr cell) <- copy _in -869 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -870 var in-data/eax: (addr stream byte) <- lookup *in-data-ah -871 rewind-stream in-data -872 var result/eax: boolean <- stream-data-equal? in-data, ",@" -873 return result -874 } -875 -876 fn open-paren-token? _in: (addr cell) -> _/eax: boolean { -877 var in/eax: (addr cell) <- copy _in -878 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -879 var _in-data/eax: (addr stream byte) <- lookup *in-data-ah -880 var in-data/ecx: (addr stream byte) <- copy _in-data +863 var g/eax: grapheme <- read-grapheme in-data +864 var result/eax: boolean <- bracket-grapheme? g +865 return result +866 } +867 +868 fn quote-token? _in: (addr cell) -> _/eax: boolean { +869 var in/eax: (addr cell) <- copy _in +870 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +871 var in-data/eax: (addr stream byte) <- lookup *in-data-ah +872 rewind-stream in-data +873 var result/eax: boolean <- stream-data-equal? in-data, "'" +874 return result +875 } +876 +877 fn backquote-token? _in: (addr cell) -> _/eax: boolean { +878 var in/eax: (addr cell) <- copy _in +879 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +880 var in-data/eax: (addr stream byte) <- lookup *in-data-ah 881 rewind-stream in-data -882 var g/eax: grapheme <- read-grapheme in-data -883 compare g, 0x28/open-paren -884 { -885 break-if-!= -886 var result/eax: boolean <- stream-empty? in-data -887 return result -888 } -889 return 0/false -890 } -891 -892 fn close-paren-token? _in: (addr cell) -> _/eax: boolean { -893 var in/eax: (addr cell) <- copy _in -894 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -895 var _in-data/eax: (addr stream byte) <- lookup *in-data-ah -896 var in-data/ecx: (addr stream byte) <- copy _in-data -897 rewind-stream in-data -898 var g/eax: grapheme <- read-grapheme in-data -899 compare g, 0x29/close-paren -900 { -901 break-if-!= -902 var result/eax: boolean <- stream-empty? in-data -903 return result -904 } -905 return 0/false -906 } -907 -908 fn dot-token? _in: (addr cell) -> _/eax: boolean { -909 var in/eax: (addr cell) <- copy _in -910 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -911 var _in-data/eax: (addr stream byte) <- lookup *in-data-ah -912 var in-data/ecx: (addr stream byte) <- copy _in-data -913 rewind-stream in-data -914 var g/eax: grapheme <- read-grapheme in-data -915 compare g, 0x2e/dot -916 { -917 break-if-!= -918 var result/eax: boolean <- stream-empty? in-data -919 return result -920 } -921 return 0/false -922 } -923 -924 fn test-dot-token { -925 var tmp-storage: (handle cell) -926 var tmp-ah/eax: (addr handle cell) <- address tmp-storage -927 new-symbol tmp-ah, "." -928 var tmp/eax: (addr cell) <- lookup *tmp-ah -929 var result/eax: boolean <- dot-token? tmp -930 check result, "F - test-dot-token" -931 } -932 -933 fn stream-token? _in: (addr cell) -> _/eax: boolean { -934 var in/eax: (addr cell) <- copy _in -935 var in-type/eax: (addr int) <- get in, type -936 compare *in-type, 3/stream -937 { -938 break-if-= -939 return 0/false -940 } -941 return 1/true -942 } -943 -944 fn comment-token? _in: (addr cell) -> _/eax: boolean { -945 var in/eax: (addr cell) <- copy _in -946 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -947 var in-data/eax: (addr stream byte) <- lookup *in-data-ah -948 rewind-stream in-data -949 var g/eax: grapheme <- read-grapheme in-data -950 compare g, 0x23/hash -951 { -952 break-if-= -953 return 0/false -954 } -955 return 1/true -956 } +882 var result/eax: boolean <- stream-data-equal? in-data, "`" +883 return result +884 } +885 +886 fn unquote-token? _in: (addr cell) -> _/eax: boolean { +887 var in/eax: (addr cell) <- copy _in +888 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +889 var in-data/eax: (addr stream byte) <- lookup *in-data-ah +890 rewind-stream in-data +891 var result/eax: boolean <- stream-data-equal? in-data, "," +892 return result +893 } +894 +895 fn unquote-splice-token? _in: (addr cell) -> _/eax: boolean { +896 var in/eax: (addr cell) <- copy _in +897 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +898 var in-data/eax: (addr stream byte) <- lookup *in-data-ah +899 rewind-stream in-data +900 var result/eax: boolean <- stream-data-equal? in-data, ",@" +901 return result +902 } +903 +904 fn open-paren-token? _in: (addr cell) -> _/eax: boolean { +905 var in/eax: (addr cell) <- copy _in +906 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +907 var _in-data/eax: (addr stream byte) <- lookup *in-data-ah +908 var in-data/ecx: (addr stream byte) <- copy _in-data +909 rewind-stream in-data +910 var g/eax: grapheme <- read-grapheme in-data +911 compare g, 0x28/open-paren +912 { +913 break-if-!= +914 var result/eax: boolean <- stream-empty? in-data +915 return result +916 } +917 return 0/false +918 } +919 +920 fn close-paren-token? _in: (addr cell) -> _/eax: boolean { +921 var in/eax: (addr cell) <- copy _in +922 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +923 var _in-data/eax: (addr stream byte) <- lookup *in-data-ah +924 var in-data/ecx: (addr stream byte) <- copy _in-data +925 rewind-stream in-data +926 var g/eax: grapheme <- read-grapheme in-data +927 compare g, 0x29/close-paren +928 { +929 break-if-!= +930 var result/eax: boolean <- stream-empty? in-data +931 return result +932 } +933 return 0/false +934 } +935 +936 fn dot-token? _in: (addr cell) -> _/eax: boolean { +937 var in/eax: (addr cell) <- copy _in +938 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +939 var _in-data/eax: (addr stream byte) <- lookup *in-data-ah +940 var in-data/ecx: (addr stream byte) <- copy _in-data +941 rewind-stream in-data +942 var g/eax: grapheme <- read-grapheme in-data +943 compare g, 0x2e/dot +944 { +945 break-if-!= +946 var result/eax: boolean <- stream-empty? in-data +947 return result +948 } +949 return 0/false +950 } +951 +952 fn test-dot-token { +953 var tmp-storage: (handle cell) +954 var tmp-ah/eax: (addr handle cell) <- address tmp-storage +955 new-symbol tmp-ah, "." +956 var tmp/eax: (addr cell) <- lookup *tmp-ah +957 var result/eax: boolean <- dot-token? tmp +958 check result, "F - test-dot-token" +959 } +960 +961 fn stream-token? _in: (addr cell) -> _/eax: boolean { +962 var in/eax: (addr cell) <- copy _in +963 var in-type/eax: (addr int) <- get in, type +964 compare *in-type, 3/stream +965 { +966 break-if-= +967 return 0/false +968 } +969 return 1/true +970 } +971 +972 fn comment-token? _in: (addr cell) -> _/eax: boolean { +973 var in/eax: (addr cell) <- copy _in +974 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +975 var in-data/eax: (addr stream byte) <- lookup *in-data-ah +976 rewind-stream in-data +977 var g/eax: grapheme <- read-grapheme in-data +978 compare g, 0x23/hash +979 { +980 break-if-= +981 return 0/false +982 } +983 return 1/true +984 } diff --git a/html/shell/trace.mu.html b/html/shell/trace.mu.html index ebab0591..e1bfe1c0 100644 --- a/html/shell/trace.mu.html +++ b/html/shell/trace.mu.html @@ -58,1649 +58,2087 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/main/shell/trace.mu 
    1 # A trace records the evolution of a computation.
-   2 # An integral part of the Mu Shell is facilities for browsing traces.
-   3 
-   4 type trace {
-   5   curr-depth: int  # depth that will be assigned to next line appended
-   6   data: (handle array trace-line)
-   7   first-free: int
-   8   first-full: int  # used only by check-trace-scan
-   9 
-  10   # steady-state life cycle of a trace:
-  11   #   reload loop:
-  12   #     there are already some visible lines
-  13   #     append a bunch of new trace lines to the trace
-  14   #     render loop:
-  15   #       rendering displays trace lines that match visible lines
-  16   #       rendering computes cursor-line based on the cursor-y coordinate
-  17   #       edit-trace updates cursor-y coordinate
-  18   #       edit-trace might add/remove lines to visible
-  19   visible: (handle array trace-line)
-  20   recompute-visible?: boolean
-  21   top-line-index: int  # index into data
-  22   cursor-y: int  # row index on screen
-  23   cursor-line-index: int  # index into data
-  24 }
-  25 
-  26 type trace-line {
-  27   depth: int
-  28   label: (handle array byte)
-  29   data: (handle array byte)
-  30   visible?: boolean
-  31 }
-  32 
-  33 ## generating traces
-  34 
-  35 fn initialize-trace _self: (addr trace), capacity: int, visible-capacity: int {
-  36   var self/esi: (addr trace) <- copy _self
-  37   compare self, 0
-  38   break-if-=
-  39   var trace-ah/eax: (addr handle array trace-line) <- get self, data
-  40   populate trace-ah, capacity
-  41   var visible-ah/eax: (addr handle array trace-line) <- get self, visible
-  42   populate visible-ah, visible-capacity
-  43 }
-  44 
-  45 fn clear-trace _self: (addr trace) {
-  46   var self/eax: (addr trace) <- copy _self
-  47   compare self, 0
-  48   break-if-=
-  49   var len/edx: (addr int) <- get self, first-free
-  50   copy-to *len, 0
-  51   # might leak memory; existing elements won't be used anymore
-  52 }
-  53 
-  54 fn has-errors? _self: (addr trace) -> _/eax: boolean {
-  55   var self/eax: (addr trace) <- copy _self
-  56   {
-  57     compare self, 0
-  58     break-if-!=
-  59     return 0/false
-  60   }
-  61   var max/edx: (addr int) <- get self, first-free
-  62   var trace-ah/eax: (addr handle array trace-line) <- get self, data
-  63   var _trace/eax: (addr array trace-line) <- lookup *trace-ah
-  64   var trace/esi: (addr array trace-line) <- copy _trace
-  65   var i/ecx: int <- copy 0
-  66   {
-  67     compare i, *max
-  68     break-if->=
-  69     var offset/eax: (offset trace-line) <- compute-offset trace, i
-  70     var curr/eax: (addr trace-line) <- index trace, offset
-  71     var curr-label-ah/eax: (addr handle array byte) <- get curr, label
-  72     var curr-label/eax: (addr array byte) <- lookup *curr-label-ah
-  73     var error?/eax: boolean <- string-equal? curr-label, "error"
-  74     compare error?, 0/false
-  75     {
-  76       break-if-=
-  77       return 1/true
-  78     }
-  79     i <- increment
-  80     loop
-  81   }
-  82   return 0/false
-  83 }
-  84 
-  85 fn trace _self: (addr trace), label: (addr array byte), message: (addr stream byte) {
-  86   var self/esi: (addr trace) <- copy _self
-  87   compare self, 0
-  88   break-if-=
-  89   var data-ah/eax: (addr handle array trace-line) <- get self, data
-  90   var data/eax: (addr array trace-line) <- lookup *data-ah
-  91   var index-addr/edi: (addr int) <- get self, first-free
-  92   {
-  93     compare *index-addr, 0x8000/lines
-  94     break-if-<
-  95     return
-  96   }
-  97   var index/ecx: int <- copy *index-addr
-  98   var offset/ecx: (offset trace-line) <- compute-offset data, index
-  99   var dest/eax: (addr trace-line) <- index data, offset
- 100   var depth/ecx: (addr int) <- get self, curr-depth
- 101   rewind-stream message
- 102   {
- 103     compare *index-addr, 0x7fff/lines
- 104     break-if-<
- 105     clear-stream message
- 106     write message, "No space left in trace\n"
- 107     write message, "Please either:\n"
- 108     write message, "  - find a smaller sub-computation to test,\n"
- 109     write message, "  - allocate more space to the trace in initialize-sandbox\n"
- 110     write message, "    (shell/sandbox.mu), or\n"
- 111     write message, "  - move the computation to 'main' and run it using ctrl-s"
- 112     initialize-trace-line 0/depth, "error", message, dest
- 113     increment *index-addr
- 114     return
- 115   }
- 116   initialize-trace-line *depth, label, message, dest
- 117   increment *index-addr
- 118 }
- 119 
- 120 fn trace-text self: (addr trace), label: (addr array byte), s: (addr array byte) {
- 121   compare self, 0
- 122   break-if-=
- 123   var data-storage: (stream byte 0x100)
- 124   var data/eax: (addr stream byte) <- address data-storage
- 125   write data, s
- 126   trace self, label, data
- 127 }
- 128 
- 129 fn error self: (addr trace), message: (addr array byte) {
- 130   trace-text self, "error", message
- 131 }
- 132 
- 133 fn initialize-trace-line depth: int, label: (addr array byte), data: (addr stream byte), _out: (addr trace-line) {
- 134   var out/edi: (addr trace-line) <- copy _out
- 135   # depth
- 136   var src/eax: int <- copy depth
- 137   var dest/ecx: (addr int) <- get out, depth
- 138   copy-to *dest, src
- 139   # label
- 140   var dest/eax: (addr handle array byte) <- get out, label
- 141   copy-array-object label, dest
- 142   # data
- 143   var dest/eax: (addr handle array byte) <- get out, data
- 144   stream-to-array data, dest
- 145 }
- 146 
- 147 fn trace-lower _self: (addr trace) {
- 148   var self/esi: (addr trace) <- copy _self
- 149   compare self, 0
- 150   break-if-=
- 151   var depth/eax: (addr int) <- get self, curr-depth
- 152   increment *depth
- 153 }
- 154 
- 155 fn trace-higher _self: (addr trace) {
- 156   var self/esi: (addr trace) <- copy _self
- 157   compare self, 0
- 158   break-if-=
- 159   var depth/eax: (addr int) <- get self, curr-depth
- 160   decrement *depth
- 161 }
- 162 
- 163 ## checking traces
- 164 
- 165 fn check-trace-scans-to self: (addr trace), label: (addr array byte), data: (addr array byte), message: (addr array byte) {
- 166   var tmp/eax: boolean <- trace-scans-to? self, label, data
- 167   check tmp, message
- 168 }
- 169 
- 170 fn trace-scans-to? _self: (addr trace), label: (addr array byte), data: (addr array byte) -> _/eax: boolean {
- 171   var self/esi: (addr trace) <- copy _self
- 172   var start/eax: (addr int) <- get self, first-full
- 173   var result/eax: boolean <- trace-contains? self, label, data, *start
- 174   return result
- 175 }
- 176 
- 177 fn test-trace-scans-to {
- 178   var t-storage: trace
- 179   var t/esi: (addr trace) <- address t-storage
- 180   initialize-trace t, 0x10, 0/visible  # we don't use trace UI
- 181   #
- 182   trace-text t, "label", "line 1"
- 183   trace-text t, "label", "line 2"
- 184   check-trace-scans-to t, "label", "line 1", "F - test-trace-scans-to/0"
- 185   check-trace-scans-to t, "label", "line 2", "F - test-trace-scans-to/1"
- 186   var tmp/eax: boolean <- trace-scans-to? t, "label", "line 1"
- 187   check-not tmp, "F - test-trace-scans-to: fail on previously encountered lines"
- 188   var tmp/eax: boolean <- trace-scans-to? t, "label", "line 3"
- 189   check-not tmp, "F - test-trace-scans-to: fail on missing"
- 190 }
- 191 
- 192 # scan trace from start
- 193 # resets previous scans
- 194 fn check-trace-contains self: (addr trace), label: (addr array byte), data: (addr array byte), message: (addr array byte) {
- 195   var tmp/eax: boolean <- trace-contains? self, label, data, 0
- 196   check tmp, message
- 197 }
- 198 
- 199 fn test-trace-contains {
- 200   var t-storage: trace
- 201   var t/esi: (addr trace) <- address t-storage
- 202   initialize-trace t, 0x10, 0/visible  # we don't use trace UI
- 203   #
- 204   trace-text t, "label", "line 1"
- 205   trace-text t, "label", "line 2"
- 206   check-trace-contains t, "label", "line 1", "F - test-trace-contains/0"
- 207   check-trace-contains t, "label", "line 2", "F - test-trace-contains/1"
- 208   check-trace-contains t, "label", "line 1", "F - test-trace-contains: find previously encountered lines"
- 209   var tmp/eax: boolean <- trace-contains? t, "label", "line 3", 0/start
- 210   check-not tmp, "F - test-trace-contains: fail on missing"
- 211 }
- 212 
- 213 # this is super-inefficient, string comparing every trace line
- 214 # against every visible line on every render
- 215 fn trace-contains? _self: (addr trace), label: (addr array byte), data: (addr array byte), start: int -> _/eax: boolean {
- 216   var self/esi: (addr trace) <- copy _self
- 217   var candidates-ah/eax: (addr handle array trace-line) <- get self, data
- 218   var candidates/eax: (addr array trace-line) <- lookup *candidates-ah
- 219   var i/ecx: int <- copy start
- 220   var max/edx: (addr int) <- get self, first-free
- 221   {
- 222     compare i, *max
- 223     break-if->=
- 224     {
- 225       var read-until-index/eax: (addr int) <- get self, first-full
- 226       copy-to *read-until-index, i
- 227     }
- 228     {
- 229       var curr-offset/ecx: (offset trace-line) <- compute-offset candidates, i
- 230       var curr/ecx: (addr trace-line) <- index candidates, curr-offset
- 231       # if curr->label does not match, return false
- 232       var curr-label-ah/eax: (addr handle array byte) <- get curr, label
- 233       var curr-label/eax: (addr array byte) <- lookup *curr-label-ah
- 234       var match?/eax: boolean <- string-equal? curr-label, label
- 235       compare match?, 0/false
- 236       break-if-=
- 237       # if curr->data does not match, return false
- 238       var curr-data-ah/eax: (addr handle array byte) <- get curr, data
- 239       var curr-data/eax: (addr array byte) <- lookup *curr-data-ah
- 240       var match?/eax: boolean <- string-equal? curr-data, data
- 241       compare match?, 0/false
- 242       break-if-=
- 243       return 1/true
- 244     }
- 245     i <- increment
- 246     loop
- 247   }
- 248   return 0/false
- 249 }
- 250 
- 251 fn trace-lines-equal? _a: (addr trace-line), _b: (addr trace-line) -> _/eax: boolean {
- 252   var a/esi: (addr trace-line) <- copy _a
- 253   var b/edi: (addr trace-line) <- copy _b
- 254   var a-depth/ecx: (addr int) <- get a, depth
- 255   var b-depth/edx: (addr int) <- get b, depth
- 256   var benchmark/eax: int <- copy *b-depth
- 257   compare *a-depth, benchmark
- 258   {
- 259     break-if-=
- 260     return 0/false
- 261   }
- 262   var a-label-ah/eax: (addr handle array byte) <- get a, label
- 263   var _a-label/eax: (addr array byte) <- lookup *a-label-ah
- 264   var a-label/ecx: (addr array byte) <- copy _a-label
- 265   var b-label-ah/ebx: (addr handle array byte) <- get b, label
- 266   var b-label/eax: (addr array byte) <- lookup *b-label-ah
- 267   var label-match?/eax: boolean <- string-equal? a-label, b-label
- 268   {
- 269     compare label-match?, 0/false
- 270     break-if-!=
- 271     return 0/false
- 272   }
- 273   var a-data-ah/eax: (addr handle array byte) <- get a, data
- 274   var _a-data/eax: (addr array byte) <- lookup *a-data-ah
- 275   var a-data/ecx: (addr array byte) <- copy _a-data
- 276   var b-data-ah/ebx: (addr handle array byte) <- get b, data
- 277   var b-data/eax: (addr array byte) <- lookup *b-data-ah
- 278   var data-match?/eax: boolean <- string-equal? a-data, b-data
- 279   return data-match?
- 280 }
- 281 
- 282 fn dump-trace _self: (addr trace) {
- 283   var already-hiding-lines?: boolean
- 284   var y/ecx: int <- copy 0
- 285   var self/esi: (addr trace) <- copy _self
- 286   compare self, 0
- 287   {
- 288     break-if-!=
- 289     return
- 290   }
- 291   var trace-ah/eax: (addr handle array trace-line) <- get self, data
- 292   var _trace/eax: (addr array trace-line) <- lookup *trace-ah
- 293   var trace/edi: (addr array trace-line) <- copy _trace
- 294   var i/edx: int <- copy 0
- 295   var max-addr/ebx: (addr int) <- get self, first-free
- 296   var max/ebx: int <- copy *max-addr
- 297   $dump-trace:loop: {
- 298     compare i, max
- 299     break-if->=
- 300     $dump-trace:iter: {
- 301       var offset/ebx: (offset trace-line) <- compute-offset trace, i
- 302       var curr/ebx: (addr trace-line) <- index trace, offset
- 303       y <- render-trace-line 0/screen, curr, 0, y, 0x80/width, 0x30/height, 7/fg, 0/bg
- 304     }
- 305     i <- increment
- 306     loop
- 307   }
- 308 }
- 309 
- 310 fn dump-trace-with-label _self: (addr trace), label: (addr array byte) {
- 311   var already-hiding-lines?: boolean
- 312   var y/ecx: int <- copy 0
- 313   var self/esi: (addr trace) <- copy _self
- 314   compare self, 0
- 315   {
- 316     break-if-!=
- 317     return
- 318   }
- 319   var trace-ah/eax: (addr handle array trace-line) <- get self, data
- 320   var _trace/eax: (addr array trace-line) <- lookup *trace-ah
- 321   var trace/edi: (addr array trace-line) <- copy _trace
- 322   var i/edx: int <- copy 0
- 323   var max-addr/ebx: (addr int) <- get self, first-free
- 324   var max/ebx: int <- copy *max-addr
- 325   $dump-trace:loop: {
- 326     compare i, max
- 327     break-if->=
- 328     $dump-trace:iter: {
- 329       var offset/ebx: (offset trace-line) <- compute-offset trace, i
- 330       var curr/ebx: (addr trace-line) <- index trace, offset
- 331       var curr-label-ah/eax: (addr handle array byte) <- get curr, label
- 332       var curr-label/eax: (addr array byte) <- lookup *curr-label-ah
- 333       var show?/eax: boolean <- string-equal? curr-label, label
- 334       compare show?, 0/false
- 335       break-if-=
- 336       y <- render-trace-line 0/screen, curr, 0, y, 0x80/width, 0x30/height, 7/fg, 0/bg
- 337     }
- 338     i <- increment
- 339     loop
- 340   }
- 341 }
- 342 
- 343 ## UI stuff
- 344 
- 345 fn mark-lines-dirty _self: (addr trace) {
- 346   var self/eax: (addr trace) <- copy _self
- 347   var dest/edx: (addr boolean) <- get self, recompute-visible?
- 348   copy-to *dest, 1/true
- 349 }
- 350 
- 351 fn mark-lines-clean _self: (addr trace) {
- 352   var self/eax: (addr trace) <- copy _self
- 353   var dest/edx: (addr boolean) <- get self, recompute-visible?
- 354   copy-to *dest, 0/false
- 355 }
- 356 
- 357 fn render-trace screen: (addr screen), _self: (addr trace), xmin: int, ymin: int, xmax: int, ymax: int, show-cursor?: boolean -> _/ecx: int {
- 358   var already-hiding-lines?: boolean
- 359   var y/ecx: int <- copy ymin
- 360   var self/esi: (addr trace) <- copy _self
- 361   compare self, 0
- 362   {
- 363     break-if-!=
- 364     return ymin
- 365   }
- 366   clamp-cursor-to-top self, y
- 367   var trace-ah/eax: (addr handle array trace-line) <- get self, data
- 368   var _trace/eax: (addr array trace-line) <- lookup *trace-ah
- 369   var trace/edi: (addr array trace-line) <- copy _trace
- 370   var i/edx: int <- copy 0
- 371   var max-addr/ebx: (addr int) <- get self, first-free
- 372   var max/ebx: int <- copy *max-addr
- 373   $render-trace:loop: {
- 374     compare i, max
- 375     break-if->=
- 376     $render-trace:iter: {
- 377       var offset/ebx: (offset trace-line) <- compute-offset trace, i
- 378       var curr/ebx: (addr trace-line) <- index trace, offset
- 379       var curr-label-ah/eax: (addr handle array byte) <- get curr, label
- 380       var curr-label/eax: (addr array byte) <- lookup *curr-label-ah
- 381       var bg/edi: int <- copy 0xc5/bg=blue-bg
- 382       compare show-cursor?, 0/false
- 383       {
- 384         break-if-=
- 385         var cursor-y/eax: (addr int) <- get self, cursor-y
- 386         compare *cursor-y, y
- 387         break-if-!=
- 388         bg <- copy 7/cursor-line-bg
- 389         var cursor-line-index/eax: (addr int) <- get self, cursor-line-index
- 390         copy-to *cursor-line-index, i
- 391       }
- 392       # always display errors
- 393       var error?/eax: boolean <- string-equal? curr-label, "error"
- 394       {
- 395         compare error?, 0/false
- 396         break-if-=
- 397         y <- render-trace-line screen, curr, xmin, y, xmax, ymax, 0xc/fg=trace-error, bg
- 398         copy-to already-hiding-lines?, 0/false
- 399         break $render-trace:iter
- 400       }
- 401       # display expanded lines
- 402       var display?/eax: boolean <- should-render? self, curr
- 403       {
- 404         compare display?, 0/false
- 405         break-if-=
- 406         y <- render-trace-line screen, curr, xmin, y, xmax, ymax, 0x38/fg=trace, bg
- 407         copy-to already-hiding-lines?, 0/false
- 408         break $render-trace:iter
- 409       }
- 410       # ignore the rest
- 411       compare already-hiding-lines?, 0/false
- 412       {
- 413         break-if-!=
- 414         var x/eax: int <- copy xmin
- 415         x, y <- draw-text-wrapping-right-then-down screen, "...", xmin, ymin, xmax, ymax, x, y, 9/fg=trace, bg
- 416         y <- increment
- 417         copy-to already-hiding-lines?, 1/true
- 418       }
- 419     }
- 420     i <- increment
- 421     loop
- 422   }
- 423   # prevent cursor from going too far down
- 424   clamp-cursor-to-bottom self, y, screen, xmin, ymin, xmax, ymax
- 425   mark-lines-clean self
- 426   return y
- 427 }
- 428 
- 429 fn render-trace-line screen: (addr screen), _self: (addr trace-line), xmin: int, ymin: int, xmax: int, ymax: int, fg: int, bg: int -> _/ecx: int {
- 430   var self/esi: (addr trace-line) <- copy _self
- 431   var xsave/edx: int <- copy xmin
- 432   var y/ecx: int <- copy ymin
- 433   var label-ah/eax: (addr handle array byte) <- get self, label
- 434   var _label/eax: (addr array byte) <- lookup *label-ah
- 435   var label/ebx: (addr array byte) <- copy _label
- 436   var error?/eax: boolean <- string-equal? label, "error"
- 437   compare error?, 0/false
- 438   {
- 439     break-if-!=
- 440     var x/eax: int <- copy xsave
- 441     {
- 442       var depth/edx: (addr int) <- get self, depth
- 443       x, y <- draw-int32-decimal-wrapping-right-then-down screen, *depth, xmin, ymin, xmax, ymax, x, y, fg, bg
- 444       x, y <- draw-text-wrapping-right-then-down screen, " ", xmin, ymin, xmax, ymax, x, y, fg, bg
- 445       # don't show label in UI; it's just for tests
- 446     }
- 447     xsave <- copy x
- 448   }
- 449   var data-ah/eax: (addr handle array byte) <- get self, data
- 450   var _data/eax: (addr array byte) <- lookup *data-ah
- 451   var data/ebx: (addr array byte) <- copy _data
- 452   var x/eax: int <- copy xsave
- 453   x, y <- draw-text-wrapping-right-then-down screen, data, xmin, ymin, xmax, ymax, x, y, fg, bg
- 454   y <- increment
- 455   return y
- 456 }
- 457 
- 458 # this is super-inefficient, string comparing every trace line
- 459 # against every visible line on every render
- 460 fn should-render? _self: (addr trace), _line: (addr trace-line) -> _/eax: boolean {
- 461   var self/esi: (addr trace) <- copy _self
- 462   # if visible? is already cached, just return it
- 463   var dest/edx: (addr boolean) <- get self, recompute-visible?
- 464   compare *dest, 0/false
- 465   {
- 466     break-if-!=
- 467     var line/eax: (addr trace-line) <- copy _line
- 468     var result/eax: (addr boolean) <- get line, visible?
- 469     return *result
- 470   }
- 471   # recompute
- 472   var candidates-ah/eax: (addr handle array trace-line) <- get self, visible
- 473   var candidates/eax: (addr array trace-line) <- lookup *candidates-ah
- 474   var i/ecx: int <- copy 0
- 475   var len/edx: int <- length candidates
- 476   {
- 477     compare i, len
- 478     break-if->=
- 479     {
- 480       var curr-offset/ecx: (offset trace-line) <- compute-offset candidates, i
- 481       var curr/ecx: (addr trace-line) <- index candidates, curr-offset
- 482       var match?/eax: boolean <- trace-lines-equal? curr, _line
- 483       compare match?, 0/false
- 484       break-if-=
- 485       var line/eax: (addr trace-line) <- copy _line
- 486       var dest/eax: (addr boolean) <- get line, visible?
- 487       copy-to *dest, 1/true
- 488       return 1/true
- 489     }
- 490     i <- increment
- 491     loop
- 492   }
- 493   var line/eax: (addr trace-line) <- copy _line
- 494   var dest/eax: (addr boolean) <- get line, visible?
- 495   copy-to *dest, 0/false
- 496   return 0/false
- 497 }
- 498 
- 499 fn clamp-cursor-to-top _self: (addr trace), _y: int {
- 500   var y/ecx: int <- copy _y
- 501   var self/esi: (addr trace) <- copy _self
- 502   var cursor-y/eax: (addr int) <- get self, cursor-y
- 503   compare *cursor-y, y
- 504   break-if->=
- 505   copy-to *cursor-y, y
- 506 }
- 507 
- 508 # extremely hacky; consider deleting test-render-trace-empty-3 when you clean this up
- 509 fn clamp-cursor-to-bottom _self: (addr trace), _y: int, screen: (addr screen), xmin: int, ymin: int, xmax: int, ymax: int {
- 510   var y/ebx: int <- copy _y
- 511   compare y, ymin
- 512   {
- 513     break-if->
- 514     return
- 515   }
- 516   y <- decrement
- 517   var self/esi: (addr trace) <- copy _self
- 518   var cursor-y/eax: (addr int) <- get self, cursor-y
- 519   compare *cursor-y, y
- 520   break-if-<=
- 521   copy-to *cursor-y, y
- 522   # redraw cursor-line
- 523   # TODO: ugly duplication
- 524   var trace-ah/eax: (addr handle array trace-line) <- get self, data
- 525   var trace/eax: (addr array trace-line) <- lookup *trace-ah
- 526   var cursor-line-index-addr/ecx: (addr int) <- get self, cursor-line-index
- 527   var cursor-line-index/ecx: int <- copy *cursor-line-index-addr
- 528   var first-free/edx: (addr int) <- get self, first-free
- 529   compare cursor-line-index, *first-free
- 530   {
- 531     break-if-<
- 532     return
- 533   }
- 534   var cursor-offset/ecx: (offset trace-line) <- compute-offset trace, cursor-line-index
- 535   var cursor-line/ecx: (addr trace-line) <- index trace, cursor-offset
- 536   var display?/eax: boolean <- should-render? self, cursor-line
- 537   {
- 538     compare display?, 0/false
- 539     break-if-=
- 540     var dummy/ecx: int <- render-trace-line screen, cursor-line, xmin, y, xmax, ymax, 0x38/fg=trace, 7/cursor-line-bg
- 541     return
- 542   }
- 543   var dummy1/eax: int <- copy 0
- 544   var dummy2/ecx: int <- copy 0
- 545   dummy1, dummy2 <- draw-text-wrapping-right-then-down screen, "...", xmin, ymin, xmax, ymax, xmin, y, 9/fg=trace, 7/cursor-line-bg
- 546 }
- 547 
- 548 fn test-render-trace-empty {
- 549   var t-storage: trace
- 550   var t/esi: (addr trace) <- address t-storage
- 551   initialize-trace t, 0x10, 0x10
- 552   # setup: screen
- 553   var screen-on-stack: screen
- 554   var screen/edi: (addr screen) <- address screen-on-stack
- 555   initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics
- 556   #
- 557   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 5/xmax, 4/ymax, 0/no-cursor
- 558   #
- 559   check-ints-equal y, 0, "F - test-render-trace-empty/cursor"
- 560   check-screen-row screen,                                  0/y, "    ", "F - test-render-trace-empty"
- 561   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "    ", "F - test-render-trace-empty/bg"
- 562 }
- 563 
- 564 fn test-render-trace-empty-2 {
- 565   var t-storage: trace
- 566   var t/esi: (addr trace) <- address t-storage
- 567   initialize-trace t, 0x10, 0x10
- 568   # setup: screen
- 569   var screen-on-stack: screen
- 570   var screen/edi: (addr screen) <- address screen-on-stack
- 571   initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics
- 572   #
- 573   var y/ecx: int <- render-trace screen, t, 0/xmin, 2/ymin, 5/xmax, 4/ymax, 0/no-cursor  # cursor below top row
- 574   #
- 575   check-ints-equal y, 2, "F - test-render-trace-empty-2/cursor"
- 576   check-screen-row screen,                                  2/y, "    ", "F - test-render-trace-empty-2"
- 577   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "    ", "F - test-render-trace-empty-2/bg"
- 578 }
- 579 
- 580 fn test-render-trace-empty-3 {
- 581   var t-storage: trace
- 582   var t/esi: (addr trace) <- address t-storage
- 583   initialize-trace t, 0x10, 0x10
- 584   # setup: screen
- 585   var screen-on-stack: screen
- 586   var screen/edi: (addr screen) <- address screen-on-stack
- 587   initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics
- 588   #
- 589   var y/ecx: int <- render-trace screen, t, 0/xmin, 2/ymin, 5/xmax, 4/ymax, 1/show-cursor  # try show cursor
- 590   # still no cursor to show
- 591   check-ints-equal y, 2, "F - test-render-trace-empty-3/cursor"
- 592   check-screen-row screen,                                  1/y, "    ", "F - test-render-trace-empty-3/line-above-cursor"
- 593   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "    ", "F - test-render-trace-empty-3/bg-for-line-above-cursor"
- 594   check-screen-row screen,                                  2/y, "    ", "F - test-render-trace-empty-3"
- 595   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "    ", "F - test-render-trace-empty-3/bg"
- 596 }
- 597 
- 598 fn test-render-trace-collapsed-by-default {
- 599   var t-storage: trace
- 600   var t/esi: (addr trace) <- address t-storage
- 601   initialize-trace t, 0x10, 0x10
- 602   trace-text t, "l", "data"
- 603   # setup: screen
- 604   var screen-on-stack: screen
- 605   var screen/edi: (addr screen) <- address screen-on-stack
- 606   initialize-screen screen, 5/width, 4/height, 0/no-pixel-graphics
- 607   #
- 608   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 5/xmax, 4/ymax, 0/no-cursor
- 609   #
- 610   check-ints-equal y, 1, "F - test-render-trace-collapsed-by-default/cursor"
- 611   check-screen-row screen, 0/y, "... ", "F - test-render-trace-collapsed-by-default"
- 612 }
- 613 
- 614 fn test-render-trace-error {
- 615   var t-storage: trace
- 616   var t/esi: (addr trace) <- address t-storage
- 617   initialize-trace t, 0x10, 0x10
- 618   error t, "error"
- 619   # setup: screen
- 620   var screen-on-stack: screen
- 621   var screen/edi: (addr screen) <- address screen-on-stack
- 622   initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics
- 623   #
- 624   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor
- 625   #
- 626   check-ints-equal y, 1, "F - test-render-trace-error/cursor"
- 627   check-screen-row screen, 0/y, "error", "F - test-render-trace-error"
- 628 }
- 629 
- 630 fn test-render-trace-error-at-start {
- 631   var t-storage: trace
- 632   var t/esi: (addr trace) <- address t-storage
- 633   initialize-trace t, 0x10, 0x10
- 634   #
- 635   error t, "error"
- 636   trace-text t, "l", "data"
- 637   # setup: screen
- 638   var screen-on-stack: screen
- 639   var screen/edi: (addr screen) <- address screen-on-stack
- 640   initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics
- 641   #
- 642   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor
- 643   #
- 644   check-ints-equal y, 2, "F - test-render-trace-error-at-start/cursor"
- 645   check-screen-row screen, 0/y, "error", "F - test-render-trace-error-at-start/0"
- 646   check-screen-row screen, 1/y, "...  ", "F - test-render-trace-error-at-start/1"
- 647 }
- 648 
- 649 fn test-render-trace-error-at-end {
- 650   var t-storage: trace
- 651   var t/esi: (addr trace) <- address t-storage
- 652   initialize-trace t, 0x10, 0x10
- 653   #
- 654   trace-text t, "l", "data"
- 655   error t, "error"
- 656   # setup: screen
- 657   var screen-on-stack: screen
- 658   var screen/edi: (addr screen) <- address screen-on-stack
- 659   initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics
- 660   #
- 661   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor
- 662   #
- 663   check-ints-equal y, 2, "F - test-render-trace-error-at-end/cursor"
- 664   check-screen-row screen, 0/y, "...  ", "F - test-render-trace-error-at-end/0"
- 665   check-screen-row screen, 1/y, "error", "F - test-render-trace-error-at-end/1"
- 666 }
- 667 
- 668 fn test-render-trace-error-in-the-middle {
- 669   var t-storage: trace
- 670   var t/esi: (addr trace) <- address t-storage
- 671   initialize-trace t, 0x10, 0x10
- 672   #
- 673   trace-text t, "l", "line 1"
- 674   error t, "error"
- 675   trace-text t, "l", "line 3"
- 676   # setup: screen
- 677   var screen-on-stack: screen
- 678   var screen/edi: (addr screen) <- address screen-on-stack
- 679   initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics
- 680   #
- 681   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 0/no-cursor
- 682   #
- 683   check-ints-equal y, 3, "F - test-render-trace-error-in-the-middle/cursor"
- 684   check-screen-row screen, 0/y, "...  ", "F - test-render-trace-error-in-the-middle/0"
- 685   check-screen-row screen, 1/y, "error", "F - test-render-trace-error-in-the-middle/1"
- 686   check-screen-row screen, 2/y, "...  ", "F - test-render-trace-error-in-the-middle/2"
- 687 }
- 688 
- 689 fn test-render-trace-cursor-in-single-line {
- 690   var t-storage: trace
- 691   var t/esi: (addr trace) <- address t-storage
- 692   initialize-trace t, 0x10, 0x10
- 693   #
- 694   trace-text t, "l", "line 1"
- 695   error t, "error"
- 696   trace-text t, "l", "line 3"
- 697   # setup: screen
- 698   var screen-on-stack: screen
- 699   var screen/edi: (addr screen) <- address screen-on-stack
- 700   initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics
- 701   #
- 702   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor
- 703   #
- 704   check-screen-row screen,                                  0/y, "...   ", "F - test-render-trace-cursor-in-single-line/0"
- 705   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||   ", "F - test-render-trace-cursor-in-single-line/0/cursor"
- 706   check-screen-row screen,                                  1/y, "error ", "F - test-render-trace-cursor-in-single-line/1"
- 707   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "      ", "F - test-render-trace-cursor-in-single-line/1/cursor"
- 708   check-screen-row screen,                                  2/y, "...   ", "F - test-render-trace-cursor-in-single-line/2"
- 709   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "      ", "F - test-render-trace-cursor-in-single-line/2/cursor"
- 710 }
- 711 
- 712 fn render-trace-menu screen: (addr screen) {
- 713   var width/eax: int <- copy 0
- 714   var height/ecx: int <- copy 0
- 715   width, height <- screen-size screen
- 716   var y/ecx: int <- copy height
- 717   y <- decrement
- 718   set-cursor-position screen, 0/x, y
- 719   draw-text-rightward-from-cursor screen, " ctrl-r ", width, 0/fg, 0x5c/bg=black
- 720   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0xc5/bg=blue-bg
- 721   draw-text-rightward-from-cursor screen, " ctrl-s ", width, 0/fg, 0x5c/bg=black
- 722   draw-text-rightward-from-cursor screen, " run sandbox  ", width, 7/fg, 0xc5/bg=blue-bg
- 723   draw-text-rightward-from-cursor screen, " ctrl-m ", width, 0/fg, 3/bg=keyboard
- 724   draw-text-rightward-from-cursor screen, " to keyboard  ", width, 7/fg, 0xc5/bg=blue-bg
- 725   draw-text-rightward-from-cursor screen, " j ", width, 0/fg, 0x5c/bg=black
- 726   draw-text-rightward-from-cursor screen, " down  ", width, 7/fg, 0xc5/bg=blue-bg
- 727   draw-text-rightward-from-cursor screen, " k ", width, 0/fg, 0x5c/bg=black
- 728   draw-text-rightward-from-cursor screen, " up  ", width, 7/fg, 0xc5/bg=blue-bg
- 729   draw-text-rightward-from-cursor screen, " enter ", width, 0/fg, 0x5c/bg=black
- 730   draw-text-rightward-from-cursor screen, " expand  ", width, 7/fg, 0xc5/bg=blue-bg
- 731   draw-text-rightward-from-cursor screen, " backspace ", width, 0/fg, 0x5c/bg=black
- 732   draw-text-rightward-from-cursor screen, " collapse  ", width, 7/fg, 0xc5/bg=blue-bg
- 733 }
- 734 
- 735 fn edit-trace _self: (addr trace), key: grapheme {
- 736   var self/esi: (addr trace) <- copy _self
- 737   # cursor down
- 738   {
- 739     compare key, 0x6a/j
- 740     break-if-!=
- 741     var cursor-y/eax: (addr int) <- get self, cursor-y
- 742     increment *cursor-y
- 743     return
- 744   }
- 745   {
- 746     compare key, 0x81/down-arrow
- 747     break-if-!=
- 748     var cursor-y/eax: (addr int) <- get self, cursor-y
- 749     increment *cursor-y
- 750     return
- 751   }
- 752   # cursor up
- 753   {
- 754     compare key, 0x6b/k
- 755     break-if-!=
- 756     var cursor-y/eax: (addr int) <- get self, cursor-y
- 757     decrement *cursor-y
- 758     return
- 759   }
- 760   {
- 761     compare key, 0x82/up-arrow
- 762     break-if-!=
- 763     var cursor-y/eax: (addr int) <- get self, cursor-y
- 764     decrement *cursor-y
- 765     return
- 766   }
- 767   # enter = expand
- 768   {
- 769     compare key, 0xa/newline
- 770     break-if-!=
- 771     expand self
- 772     return
- 773   }
- 774   # backspace = collapse
- 775   {
- 776     compare key, 8/backspace
- 777     break-if-!=
- 778     collapse self
- 779     return
- 780   }
- 781 }
- 782 
- 783 fn expand _self: (addr trace) {
- 784   var self/esi: (addr trace) <- copy _self
- 785   var trace-ah/eax: (addr handle array trace-line) <- get self, data
- 786   var _trace/eax: (addr array trace-line) <- lookup *trace-ah
- 787   var trace/edi: (addr array trace-line) <- copy _trace
- 788   var cursor-line-index-addr/ecx: (addr int) <- get self, cursor-line-index
- 789   var cursor-line-index/ecx: int <- copy *cursor-line-index-addr
- 790   var cursor-line-offset/eax: (offset trace-line) <- compute-offset trace, cursor-line-index
- 791   var cursor-line/edx: (addr trace-line) <- index trace, cursor-line-offset
- 792   var cursor-line-visible?/eax: (addr boolean) <- get cursor-line, visible?
- 793   var cursor-line-depth/ebx: (addr int) <- get cursor-line, depth
- 794   var target-depth/ebx: int <- copy *cursor-line-depth
- 795   # if cursor-line is already visible, increment target-depth
- 796   compare *cursor-line-visible?, 0/false
- 797   {
- 798     break-if-=
- 799     target-depth <- increment
- 800   }
- 801   # reveal the run of lines starting at cursor-line-index with depth target-depth
- 802   var i/ecx: int <- copy cursor-line-index
- 803   var max/edx: (addr int) <- get self, first-free
- 804   {
- 805     compare i, *max
- 806     break-if->=
- 807     var curr-line-offset/eax: (offset trace-line) <- compute-offset trace, i
- 808     var curr-line/edx: (addr trace-line) <- index trace, curr-line-offset
- 809     var curr-line-depth/eax: (addr int) <- get curr-line, depth
- 810     compare *curr-line-depth, target-depth
- 811     break-if-<
- 812     {
- 813       break-if-!=
- 814       var curr-line-visible?/eax: (addr boolean) <- get curr-line, visible?
- 815       copy-to *curr-line-visible?, 1/true
- 816       reveal-trace-line self, curr-line
- 817     }
- 818     i <- increment
- 819     loop
- 820   }
- 821 }
- 822 
- 823 fn collapse _self: (addr trace) {
- 824   var self/esi: (addr trace) <- copy _self
- 825   var trace-ah/eax: (addr handle array trace-line) <- get self, data
- 826   var _trace/eax: (addr array trace-line) <- lookup *trace-ah
- 827   var trace/edi: (addr array trace-line) <- copy _trace
- 828   var cursor-line-index-addr/ecx: (addr int) <- get self, cursor-line-index
- 829   var cursor-line-index/ecx: int <- copy *cursor-line-index-addr
- 830   var cursor-line-offset/eax: (offset trace-line) <- compute-offset trace, cursor-line-index
- 831   var cursor-line/edx: (addr trace-line) <- index trace, cursor-line-offset
- 832   var cursor-line-visible?/eax: (addr boolean) <- get cursor-line, visible?
- 833   # if cursor-line is not visible, do nothing
- 834   compare *cursor-line-visible?, 0/false
- 835   {
- 836     break-if-!=
- 837     return
- 838   }
- 839   # hide all lines between previous and next line with a lower depth
- 840   var cursor-line-depth/ebx: (addr int) <- get cursor-line, depth
- 841   var cursor-y/edx: (addr int) <- get self, cursor-y
- 842   var target-depth/ebx: int <- copy *cursor-line-depth
- 843   var i/ecx: int <- copy cursor-line-index
- 844   $collapse:loop1: {
- 845     compare i, 0
- 846     break-if-<
- 847     var curr-line-offset/eax: (offset trace-line) <- compute-offset trace, i
- 848     var curr-line/eax: (addr trace-line) <- index trace, curr-line-offset
- 849     {
- 850       var curr-line-depth/eax: (addr int) <- get curr-line, depth
- 851       compare *curr-line-depth, target-depth
- 852       break-if-< $collapse:loop1
- 853     }
- 854     # if cursor-line is visible, decrement cursor-y
- 855     {
- 856       var curr-line-visible?/eax: (addr boolean) <- get curr-line, visible?
- 857       compare *curr-line-visible?, 0/false
- 858       break-if-=
- 859       decrement *cursor-y
- 860     }
- 861     i <- decrement
- 862     loop
- 863   }
- 864   i <- increment
- 865   var max/edx: (addr int) <- get self, first-free
- 866   $collapse:loop2: {
- 867     compare i, *max
- 868     break-if->=
- 869     var curr-line-offset/eax: (offset trace-line) <- compute-offset trace, i
- 870     var curr-line/edx: (addr trace-line) <- index trace, curr-line-offset
- 871     var curr-line-depth/eax: (addr int) <- get curr-line, depth
- 872     compare *curr-line-depth, target-depth
- 873     break-if-<
- 874     {
- 875       hide-trace-line self, curr-line
- 876       var curr-line-visible?/eax: (addr boolean) <- get curr-line, visible?
- 877       copy-to *curr-line-visible?, 0/false
- 878     }
- 879     i <- increment
- 880     loop
- 881   }
- 882 }
- 883 
- 884 # the 'visible' array is not required to be in order
- 885 # elements can also be deleted out of order
- 886 # so it can have holes
- 887 # however, lines in it always have visible? set
- 888 # we'll use visible? being unset as a sign of emptiness
- 889 fn reveal-trace-line _self: (addr trace), line: (addr trace-line) {
- 890   var self/esi: (addr trace) <- copy _self
- 891   var visible-ah/eax: (addr handle array trace-line) <- get self, visible
- 892   var visible/eax: (addr array trace-line) <- lookup *visible-ah
- 893   var i/ecx: int <- copy 0
- 894   var len/edx: int <- length visible
- 895   {
- 896     compare i, len
- 897     break-if->=
- 898     var curr-offset/edx: (offset trace-line) <- compute-offset visible, i
- 899     var curr/edx: (addr trace-line) <- index visible, curr-offset
- 900     var curr-visible?/eax: (addr boolean) <- get curr, visible?
- 901     compare *curr-visible?, 0/false
- 902     {
- 903       break-if-!=
- 904       # empty slot found
- 905       copy-object line, curr
- 906       return
- 907     }
- 908     i <- increment
- 909     loop
- 910   }
- 911   abort "too many visible lines; increase size of array trace.visible"
- 912 }
- 913 
- 914 fn hide-trace-line _self: (addr trace), line: (addr trace-line) {
- 915   var self/esi: (addr trace) <- copy _self
- 916   var visible-ah/eax: (addr handle array trace-line) <- get self, visible
- 917   var visible/eax: (addr array trace-line) <- lookup *visible-ah
- 918   var i/ecx: int <- copy 0
- 919   var len/edx: int <- length visible
- 920   {
- 921     compare i, len
- 922     break-if->=
- 923     var curr-offset/edx: (offset trace-line) <- compute-offset visible, i
- 924     var curr/edx: (addr trace-line) <- index visible, curr-offset
- 925     var found?/eax: boolean <- trace-lines-equal? curr, line
- 926     compare found?, 0/false
- 927     {
- 928       break-if-=
- 929       clear-object curr
- 930     }
- 931     i <- increment
- 932     loop
- 933   }
- 934 }
- 935 
- 936 fn test-cursor-down-and-up-within-trace {
- 937   var t-storage: trace
- 938   var t/esi: (addr trace) <- address t-storage
- 939   initialize-trace t, 0x10, 0x10
- 940   #
- 941   trace-text t, "l", "line 1"
- 942   error t, "error"
- 943   trace-text t, "l", "line 3"
- 944   # setup: screen
- 945   var screen-on-stack: screen
- 946   var screen/edi: (addr screen) <- address screen-on-stack
- 947   initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics
- 948   #
- 949   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor
- 950   #
- 951   check-screen-row screen,                                  0/y, "...   ", "F - test-cursor-down-and-up-within-trace/pre-0"
- 952   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||   ", "F - test-cursor-down-and-up-within-trace/pre-0/cursor"
- 953   check-screen-row screen,                                  1/y, "error ", "F - test-cursor-down-and-up-within-trace/pre-1"
- 954   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "      ", "F - test-cursor-down-and-up-within-trace/pre-1/cursor"
- 955   check-screen-row screen,                                  2/y, "...   ", "F - test-cursor-down-and-up-within-trace/pre-2"
- 956   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "      ", "F - test-cursor-down-and-up-within-trace/pre-2/cursor"
- 957   # cursor down
- 958   edit-trace t, 0x6a/j
- 959   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor
- 960   #
- 961   check-screen-row screen,                                  0/y, "...   ", "F - test-cursor-down-and-up-within-trace/down-0"
- 962   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "      ", "F - test-cursor-down-and-up-within-trace/down-0/cursor"
- 963   check-screen-row screen,                                  1/y, "error ", "F - test-cursor-down-and-up-within-trace/down-1"
- 964   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "||||| ", "F - test-cursor-down-and-up-within-trace/down-1/cursor"
- 965   check-screen-row screen,                                  2/y, "...   ", "F - test-cursor-down-and-up-within-trace/down-2"
- 966   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "      ", "F - test-cursor-down-and-up-within-trace/down-2/cursor"
- 967   # cursor up
- 968   edit-trace t, 0x6b/k
- 969   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor
- 970   #
- 971   check-screen-row screen,                                  0/y, "...   ", "F - test-cursor-down-and-up-within-trace/up-0"
- 972   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||   ", "F - test-cursor-down-and-up-within-trace/up-0/cursor"
- 973   check-screen-row screen,                                  1/y, "error ", "F - test-cursor-down-and-up-within-trace/up-1"
- 974   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "      ", "F - test-cursor-down-and-up-within-trace/up-1/cursor"
- 975   check-screen-row screen,                                  2/y, "...   ", "F - test-cursor-down-and-up-within-trace/up-2"
- 976   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "      ", "F - test-cursor-down-and-up-within-trace/up-2/cursor"
- 977 }
- 978 
- 979 fn test-cursor-down-past-bottom-of-trace {
- 980   var t-storage: trace
- 981   var t/esi: (addr trace) <- address t-storage
- 982   initialize-trace t, 0x10, 0x10
- 983   #
- 984   trace-text t, "l", "line 1"
- 985   error t, "error"
- 986   trace-text t, "l", "line 3"
- 987   # setup: screen
- 988   var screen-on-stack: screen
- 989   var screen/edi: (addr screen) <- address screen-on-stack
- 990   initialize-screen screen, 0xa/width, 4/height, 0/no-pixel-graphics
- 991   #
- 992   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor
- 993   #
- 994   check-screen-row screen,                                  0/y, "...   ", "F - test-cursor-down-past-bottom-of-trace/pre-0"
- 995   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||   ", "F - test-cursor-down-past-bottom-of-trace/pre-0/cursor"
- 996   check-screen-row screen,                                  1/y, "error ", "F - test-cursor-down-past-bottom-of-trace/pre-1"
- 997   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "      ", "F - test-cursor-down-past-bottom-of-trace/pre-1/cursor"
- 998   check-screen-row screen,                                  2/y, "...   ", "F - test-cursor-down-past-bottom-of-trace/pre-2"
- 999   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "      ", "F - test-cursor-down-past-bottom-of-trace/pre-2/cursor"
-1000   # cursor down several times
-1001   edit-trace t, 0x6a/j
-1002   edit-trace t, 0x6a/j
-1003   edit-trace t, 0x6a/j
-1004   edit-trace t, 0x6a/j
-1005   edit-trace t, 0x6a/j
-1006   # hack: we do need to render to make this test pass; we're mixing state management with rendering
-1007   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0xa/xmax, 4/ymax, 1/show-cursor
-1008   # cursor clamps at bottom
-1009   check-screen-row screen,                                  0/y, "...   ", "F - test-cursor-down-past-bottom-of-trace/down-0"
-1010   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "      ", "F - test-cursor-down-past-bottom-of-trace/down-0/cursor"
-1011   check-screen-row screen,                                  1/y, "error ", "F - test-cursor-down-past-bottom-of-trace/down-1"
-1012   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "      ", "F - test-cursor-down-past-bottom-of-trace/down-1/cursor"
-1013   check-screen-row screen,                                  2/y, "...   ", "F - test-cursor-down-past-bottom-of-trace/down-2"
-1014   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "|||   ", "F - test-cursor-down-past-bottom-of-trace/down-2/cursor"
-1015 }
-1016 
-1017 fn test-expand-within-trace {
-1018   var t-storage: trace
-1019   var t/esi: (addr trace) <- address t-storage
-1020   initialize-trace t, 0x10, 0x10
-1021   #
-1022   trace-text t, "l", "line 1"
-1023   trace-text t, "l", "line 2"
-1024   # setup: screen
-1025   var screen-on-stack: screen
-1026   var screen/edi: (addr screen) <- address screen-on-stack
-1027   initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics
-1028   #
-1029   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1030   #
-1031   check-screen-row screen,                                  0/y, "...      ", "F - test-expand-within-trace/pre-0"
-1032   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||      ", "F - test-expand-within-trace/pre-0/cursor"
-1033   check-screen-row screen,                                  1/y, "         ", "F - test-expand-within-trace/pre-1"
-1034   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "         ", "F - test-expand-within-trace/pre-1/cursor"
-1035   # expand
-1036   edit-trace t, 0xa/enter
-1037   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1038   #
-1039   check-screen-row screen,                                  0/y, "0 line 1 ", "F - test-expand-within-trace/expand-0"
-1040   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-expand-within-trace/expand-0/cursor"
-1041   check-screen-row screen,                                  1/y, "0 line 2 ", "F - test-expand-within-trace/expand-1"
-1042   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "         ", "F - test-expand-within-trace/expand-1/cursor"
-1043   check-screen-row screen,                                  2/y, "         ", "F - test-expand-within-trace/expand-2"
-1044   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "         ", "F - test-expand-within-trace/expand-2/cursor"
-1045 }
-1046 
-1047 fn test-trace-expand-skips-lower-depth {
-1048   var t-storage: trace
-1049   var t/esi: (addr trace) <- address t-storage
-1050   initialize-trace t, 0x10, 0x10
-1051   #
-1052   trace-text t, "l", "line 1"
-1053   trace-lower t
-1054   trace-text t, "l", "line 2"
-1055   # setup: screen
-1056   var screen-on-stack: screen
-1057   var screen/edi: (addr screen) <- address screen-on-stack
-1058   initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics
-1059   #
-1060   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1061   #
-1062   check-screen-row screen,                                  0/y, "...      ", "F - test-trace-expand-skips-lower-depth/pre-0"
-1063   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||      ", "F - test-trace-expand-skips-lower-depth/pre-0/cursor"
-1064   check-screen-row screen,                                  1/y, "         ", "F - test-trace-expand-skips-lower-depth/pre-1"
-1065   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "         ", "F - test-trace-expand-skips-lower-depth/pre-1/cursor"
-1066   # expand
-1067   edit-trace t, 0xa/enter
-1068   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1069   #
-1070   check-screen-row screen,                                  0/y, "0 line 1 ", "F - test-trace-expand-skips-lower-depth/expand-0"
-1071   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-expand-skips-lower-depth/expand-0/cursor"
-1072   check-screen-row screen,                                  1/y, "...      ", "F - test-trace-expand-skips-lower-depth/expand-1"
-1073   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "         ", "F - test-trace-expand-skips-lower-depth/expand-1/cursor"
-1074   check-screen-row screen,                                  2/y, "         ", "F - test-trace-expand-skips-lower-depth/expand-2"
-1075   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "         ", "F - test-trace-expand-skips-lower-depth/expand-2/cursor"
-1076 }
-1077 
-1078 fn test-trace-expand-continues-past-lower-depth {
-1079   var t-storage: trace
-1080   var t/esi: (addr trace) <- address t-storage
-1081   initialize-trace t, 0x10, 0x10
-1082   #
-1083   trace-text t, "l", "line 1"
-1084   trace-lower t
-1085   trace-text t, "l", "line 1.1"
-1086   trace-higher t
-1087   trace-text t, "l", "line 2"
-1088   # setup: screen
-1089   var screen-on-stack: screen
-1090   var screen/edi: (addr screen) <- address screen-on-stack
-1091   initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics
-1092   #
-1093   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1094   #
-1095   check-screen-row screen,                                  0/y, "...      ", "F - test-trace-expand-continues-past-lower-depth/pre-0"
-1096   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||      ", "F - test-trace-expand-continues-past-lower-depth/pre-0/cursor"
-1097   check-screen-row screen,                                  1/y, "         ", "F - test-trace-expand-continues-past-lower-depth/pre-1"
-1098   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "         ", "F - test-trace-expand-continues-past-lower-depth/pre-1/cursor"
-1099   # expand
-1100   edit-trace t, 0xa/enter
-1101   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1102   #
-1103   check-screen-row screen,                                  0/y, "0 line 1 ", "F - test-trace-expand-continues-past-lower-depth/expand-0"
-1104   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||| ", "F - test-trace-expand-continues-past-lower-depth/expand-0/cursor"
-1105   # TODO: might be too wasteful to show every place where lines are hidden
-1106   check-screen-row screen,                                  1/y, "...      ", "F - test-trace-expand-continues-past-lower-depth/expand-1"
-1107   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "         ", "F - test-trace-expand-continues-past-lower-depth/expand-1/cursor"
-1108   check-screen-row screen,                                  2/y, "0 line 2 ", "F - test-trace-expand-continues-past-lower-depth/expand-2"
-1109   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "         ", "F - test-trace-expand-continues-past-lower-depth/expand-2/cursor"
-1110 }
-1111 
-1112 fn test-trace-expand-stops-at-higher-depth {
-1113   var t-storage: trace
-1114   var t/esi: (addr trace) <- address t-storage
-1115   initialize-trace t, 0x10, 0x10
-1116   #
-1117   trace-text t, "l", "line 1.1"
-1118   trace-lower t
-1119   trace-text t, "l", "line 1.1.1"
-1120   trace-higher t
-1121   trace-text t, "l", "line 1.2"
-1122   trace-higher t
-1123   trace-text t, "l", "line 2"
-1124   trace-lower t
-1125   trace-text t, "l", "line 2.1"
-1126   # setup: screen
-1127   var screen-on-stack: screen
-1128   var screen/edi: (addr screen) <- address screen-on-stack
-1129   initialize-screen screen, 0x10/width, 8/height, 0/no-pixel-graphics
-1130   #
-1131   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor
-1132   #
-1133   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-expand-stops-at-higher-depth/pre-0"
-1134   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-expand-stops-at-higher-depth/pre-0/cursor"
-1135   check-screen-row screen,                                  1/y, "           ", "F - test-trace-expand-stops-at-higher-depth/pre-1"
-1136   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-expand-stops-at-higher-depth/pre-1/cursor"
-1137   # expand
-1138   edit-trace t, 0xa/enter
-1139   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor
-1140   #
-1141   check-screen-row screen,                                  0/y, "0 line 1.1 ", "F - test-trace-expand-stops-at-higher-depth/expand-0"
-1142   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||||||||| ", "F - test-trace-expand-stops-at-higher-depth/expand-0/cursor"
-1143   check-screen-row screen,                                  1/y, "...        ", "F - test-trace-expand-stops-at-higher-depth/expand-1"
-1144   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-expand-stops-at-higher-depth/expand-1/cursor"
-1145   check-screen-row screen,                                  2/y, "0 line 1.2 ", "F - test-trace-expand-stops-at-higher-depth/expand-2"
-1146   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "           ", "F - test-trace-expand-stops-at-higher-depth/expand-2/cursor"
-1147   check-screen-row screen,                                  3/y, "...        ", "F - test-trace-expand-stops-at-higher-depth/expand-3"
-1148   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "           ", "F - test-trace-expand-stops-at-higher-depth/expand-3/cursor"
-1149   check-screen-row screen,                                  4/y, "           ", "F - test-trace-expand-stops-at-higher-depth/expand-4"
-1150   check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, "           ", "F - test-trace-expand-stops-at-higher-depth/expand-4/cursor"
-1151 }
-1152 
-1153 fn test-trace-expand-twice {
-1154   var t-storage: trace
-1155   var t/esi: (addr trace) <- address t-storage
-1156   initialize-trace t, 0x10, 0x10
-1157   #
-1158   trace-text t, "l", "line 1"
-1159   trace-lower t
-1160   trace-text t, "l", "line 1.1"
-1161   trace-higher t
-1162   trace-text t, "l", "line 2"
-1163   # setup: screen
-1164   var screen-on-stack: screen
-1165   var screen/edi: (addr screen) <- address screen-on-stack
-1166   initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics
-1167   #
-1168   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1169   #
-1170   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-expand-twice/pre-0"
-1171   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-expand-twice/pre-0/cursor"
-1172   check-screen-row screen,                                  1/y, "           ", "F - test-trace-expand-twice/pre-1"
-1173   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-expand-twice/pre-1/cursor"
-1174   # expand
-1175   edit-trace t, 0xa/enter
-1176   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1177   #
-1178   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-expand-twice/expand-0"
-1179   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||||||||   ", "F - test-trace-expand-twice/expand-0/cursor"
-1180   check-screen-row screen,                                  1/y, "...        ", "F - test-trace-expand-twice/expand-1"
-1181   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-expand-twice/expand-1/cursor"
-1182   check-screen-row screen,                                  2/y, "0 line 2   ", "F - test-trace-expand-twice/expand-2"
-1183   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "           ", "F - test-trace-expand-twice/expand-2/cursor"
-1184   # cursor down
-1185   edit-trace t, 0x6a/j
-1186   # hack: we need to render here to make this test pass; we're mixing state management with rendering
-1187   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1188   #
-1189   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-expand-twice/down-0"
-1190   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "           ", "F - test-trace-expand-twice/down-0/cursor"
-1191   check-screen-row screen,                                  1/y, "...        ", "F - test-trace-expand-twice/down-1"
-1192   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "|||        ", "F - test-trace-expand-twice/down-1/cursor"
-1193   check-screen-row screen,                                  2/y, "0 line 2   ", "F - test-trace-expand-twice/down-2"
-1194   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "           ", "F - test-trace-expand-twice/down-2/cursor"
-1195   # expand again
-1196   edit-trace t, 0xa/enter
-1197   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1198   #
-1199   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-expand-twice/expand2-0"
-1200   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "           ", "F - test-trace-expand-twice/expand2-0/cursor"
-1201   check-screen-row screen,                                  1/y, "1 line 1.1 ", "F - test-trace-expand-twice/expand2-1"
-1202   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "|||||||||| ", "F - test-trace-expand-twice/expand2-1/cursor"
-1203   check-screen-row screen,                                  2/y, "0 line 2   ", "F - test-trace-expand-twice/expand2-2"
-1204   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "           ", "F - test-trace-expand-twice/expand2-2/cursor"
-1205 }
-1206 
-1207 fn test-trace-refresh-cursor {
-1208   var t-storage: trace
-1209   var t/esi: (addr trace) <- address t-storage
-1210   initialize-trace t, 0x10, 0x10
+   2 # Traces are useful for:
+   3 #   error-handling
+   4 #   testing
+   5 #   auditing
+   6 #   debugging
+   7 #   learning
+   8 #
+   9 # An integral part of the Mu computer is facilities for browsing traces.
+  10 
+  11 type trace {
+  12   max-depth: int
+  13   curr-depth: int  # depth that will be assigned to next line appended
+  14   data: (handle array trace-line)
+  15   first-free: int
+  16   first-full: int  # used only by check-trace-scan
+  17 
+  18   # steady-state life cycle of a trace:
+  19   #   reload loop:
+  20   #     there are already some visible lines
+  21   #     append a bunch of new trace lines to the trace
+  22   #     recreate trace caches
+  23   #     render loop:
+  24   #       rendering displays trace lines that match visible lines
+  25   #         (caching in each line)
+  26   #         (caching top-line)
+  27   #       rendering computes cursor-line based on the cursor-y coordinate
+  28   #       edit-trace updates cursor-y coordinate
+  29   #       edit-trace might add/remove lines to visible
+  30   #       edit-trace might update top-line
+  31   visible: (handle array trace-line)
+  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
+  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
+  39 }
+  40 
+  41 type trace-line {
+  42   depth: int
+  43   label: (handle array byte)
+  44   data: (handle array byte)
+  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
+ 237 }
+ 238 
+ 239 fn trace-higher _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
+ 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
+ 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"
+ 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
+ 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
+ 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?
+ 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
+ 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
+ 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
+ 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
+ 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
+ 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
+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   trace-text t, "l", "line 1"
-1213   trace-text t, "l", "line 2"
-1214   trace-text t, "l", "line 3"
-1215   # setup: screen
-1216   var screen-on-stack: screen
-1217   var screen/edi: (addr screen) <- address screen-on-stack
-1218   initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics
-1219   #
-1220   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1221   #
-1222   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-refresh-cursor/pre-0"
-1223   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-refresh-cursor/pre-0/cursor"
-1224   check-screen-row screen,                                  1/y, "           ", "F - test-trace-refresh-cursor/pre-1"
-1225   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-refresh-cursor/pre-1/cursor"
-1226   # expand
-1227   edit-trace t, 0xa/enter
-1228   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1229   #
-1230   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-refresh-cursor/expand-0"
-1231   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||||||||   ", "F - test-trace-refresh-cursor/expand-0/cursor"
-1232   check-screen-row screen,                                  1/y, "0 line 2   ", "F - test-trace-refresh-cursor/expand-1"
-1233   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-refresh-cursor/expand-1/cursor"
-1234   check-screen-row screen,                                  2/y, "0 line 3   ", "F - test-trace-refresh-cursor/expand-2"
-1235   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "           ", "F - test-trace-refresh-cursor/expand-2/cursor"
-1236   # cursor down
-1237   edit-trace t, 0x6a/j
-1238   edit-trace t, 0x6a/j
-1239   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1240   #
-1241   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-refresh-cursor/down-0"
-1242   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "           ", "F - test-trace-refresh-cursor/down-0/cursor"
-1243   check-screen-row screen,                                  1/y, "0 line 2   ", "F - test-trace-refresh-cursor/down-1"
-1244   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-refresh-cursor/down-1/cursor"
-1245   check-screen-row screen,                                  2/y, "0 line 3   ", "F - test-trace-refresh-cursor/down-2"
-1246   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "||||||||   ", "F - test-trace-refresh-cursor/down-2/cursor"
-1247   # recreate trace
-1248   clear-trace t
-1249   trace-text t, "l", "line 1"
-1250   trace-text t, "l", "line 2"
-1251   trace-text t, "l", "line 3"
-1252   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1253   # cursor remains unchanged
-1254   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-refresh-cursor/refresh-0"
-1255   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "           ", "F - test-trace-refresh-cursor/refresh-0/cursor"
-1256   check-screen-row screen,                                  1/y, "0 line 2   ", "F - test-trace-refresh-cursor/refresh-1"
-1257   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-refresh-cursor/refresh-1/cursor"
-1258   check-screen-row screen,                                  2/y, "0 line 3   ", "F - test-trace-refresh-cursor/refresh-2"
-1259   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "||||||||   ", "F - test-trace-refresh-cursor/refresh-2/cursor"
-1260 }
-1261 
-1262 fn test-trace-preserve-cursor-on-refresh {
-1263   var t-storage: trace
-1264   var t/esi: (addr trace) <- address t-storage
-1265   initialize-trace t, 0x10, 0x10
-1266   #
-1267   trace-text t, "l", "line 1"
-1268   trace-text t, "l", "line 2"
-1269   trace-text t, "l", "line 3"
-1270   # setup: screen
-1271   var screen-on-stack: screen
-1272   var screen/edi: (addr screen) <- address screen-on-stack
-1273   initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics
-1274   #
-1275   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1276   #
-1277   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-preserve-cursor-on-refresh/pre-0"
-1278   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-preserve-cursor-on-refresh/pre-0/cursor"
-1279   check-screen-row screen,                                  1/y, "           ", "F - test-trace-preserve-cursor-on-refresh/pre-1"
-1280   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-preserve-cursor-on-refresh/pre-1/cursor"
-1281   # expand
-1282   edit-trace t, 0xa/enter
-1283   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1284   #
-1285   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-preserve-cursor-on-refresh/expand-0"
-1286   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||||||||   ", "F - test-trace-preserve-cursor-on-refresh/expand-0/cursor"
-1287   check-screen-row screen,                                  1/y, "0 line 2   ", "F - test-trace-preserve-cursor-on-refresh/expand-1"
-1288   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-preserve-cursor-on-refresh/expand-1/cursor"
-1289   check-screen-row screen,                                  2/y, "0 line 3   ", "F - test-trace-preserve-cursor-on-refresh/expand-2"
-1290   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "              ", "F - test-trace-preserve-cursor-on-refresh/expand-2/cursor"
-1291   # cursor down
-1292   edit-trace t, 0x6a/j
-1293   edit-trace t, 0x6a/j
-1294   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1295   #
-1296   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-preserve-cursor-on-refresh/down-0"
-1297   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "           ", "F - test-trace-preserve-cursor-on-refresh/down-0/cursor"
-1298   check-screen-row screen,                                  1/y, "0 line 2   ", "F - test-trace-preserve-cursor-on-refresh/down-1"
-1299   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-preserve-cursor-on-refresh/down-1/cursor"
-1300   check-screen-row screen,                                  2/y, "0 line 3   ", "F - test-trace-preserve-cursor-on-refresh/down-2"
-1301   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "||||||||   ", "F - test-trace-preserve-cursor-on-refresh/down-2/cursor"
-1302   # recreate trace with slightly different lines
-1303   clear-trace t
-1304   trace-text t, "l", "line 4"
-1305   trace-text t, "l", "line 5"
-1306   trace-text t, "l", "line 3"  # cursor line is unchanged
-1307   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1308   # cursor remains unchanged
-1309   check-screen-row screen,                                  0/y, "0 line 4   ", "F - test-trace-preserve-cursor-on-refresh/refresh-0"
-1310   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "           ", "F - test-trace-preserve-cursor-on-refresh/refresh-0/cursor"
-1311   check-screen-row screen,                                  1/y, "0 line 5   ", "F - test-trace-preserve-cursor-on-refresh/refresh-1"
-1312   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-preserve-cursor-on-refresh/refresh-1/cursor"
-1313   check-screen-row screen,                                  2/y, "0 line 3   ", "F - test-trace-preserve-cursor-on-refresh/refresh-2"
-1314   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "||||||||   ", "F - test-trace-preserve-cursor-on-refresh/refresh-2/cursor"
-1315 }
-1316 
-1317 fn test-trace-keep-cursor-visible-on-refresh {
-1318   var t-storage: trace
-1319   var t/esi: (addr trace) <- address t-storage
-1320   initialize-trace t, 0x10, 0x10
-1321   #
-1322   trace-text t, "l", "line 1"
-1323   trace-text t, "l", "line 2"
-1324   trace-text t, "l", "line 3"
-1325   # setup: screen
-1326   var screen-on-stack: screen
-1327   var screen/edi: (addr screen) <- address screen-on-stack
-1328   initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics
-1329   #
-1330   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1331   #
-1332   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-keep-cursor-visible-on-refresh/pre-0"
-1333   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-keep-cursor-visible-on-refresh/pre-0/cursor"
-1334   check-screen-row screen,                                  1/y, "           ", "F - test-trace-keep-cursor-visible-on-refresh/pre-1"
-1335   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-keep-cursor-visible-on-refresh/pre-1/cursor"
-1336   # expand
-1337   edit-trace t, 0xa/enter
-1338   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1339   #
-1340   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-keep-cursor-visible-on-refresh/expand-0"
-1341   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||||||||   ", "F - test-trace-keep-cursor-visible-on-refresh/expand-0/cursor"
-1342   check-screen-row screen,                                  1/y, "0 line 2   ", "F - test-trace-keep-cursor-visible-on-refresh/expand-1"
-1343   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-keep-cursor-visible-on-refresh/expand-1/cursor"
-1344   check-screen-row screen,                                  2/y, "0 line 3   ", "F - test-trace-keep-cursor-visible-on-refresh/expand-2"
-1345   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "              ", "F - test-trace-keep-cursor-visible-on-refresh/expand-2/cursor"
-1346   # cursor down
-1347   edit-trace t, 0x6a/j
-1348   edit-trace t, 0x6a/j
-1349   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1350   #
-1351   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-keep-cursor-visible-on-refresh/down-0"
-1352   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "           ", "F - test-trace-keep-cursor-visible-on-refresh/down-0/cursor"
-1353   check-screen-row screen,                                  1/y, "0 line 2   ", "F - test-trace-keep-cursor-visible-on-refresh/down-1"
-1354   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-keep-cursor-visible-on-refresh/down-1/cursor"
-1355   check-screen-row screen,                                  2/y, "0 line 3   ", "F - test-trace-keep-cursor-visible-on-refresh/down-2"
-1356   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "||||||||   ", "F - test-trace-keep-cursor-visible-on-refresh/down-2/cursor"
-1357   # recreate trace with entirely different lines
-1358   clear-trace t
-1359   trace-text t, "l", "line 4"
-1360   trace-text t, "l", "line 5"
-1361   trace-text t, "l", "line 6"
-1362   mark-lines-dirty t
-1363   clear-screen screen
-1364   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1365   # trace collapses, and cursor bumps up
-1366   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-0"
-1367   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-0/cursor"
-1368   check-screen-row screen,                                  1/y, "           ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-1"
-1369   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-1/cursor"
-1370   check-screen-row screen,                                  2/y, "           ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-2"
-1371   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "           ", "F - test-trace-keep-cursor-visible-on-refresh/refresh-2/cursor"
+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
+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-collapse-at-top {
+1374 fn test-trace-expand-twice {
 1375   var t-storage: trace
 1376   var t/esi: (addr trace) <- address t-storage
-1377   initialize-trace t, 0x10, 0x10
+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"
+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
+1389   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
 1390   #
-1391   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-collapse-at-top/pre-0"
-1392   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-collapse-at-top/pre-0/cursor"
-1393   check-screen-row screen,                                  1/y, "           ", "F - test-trace-collapse-at-top/pre-1"
-1394   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse-at-top/pre-1/cursor"
+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
+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, "0 line 1   ", "F - test-trace-collapse-at-top/expand-0"
-1400   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||||||||   ", "F - test-trace-collapse-at-top/expand-0/cursor"
-1401   check-screen-row screen,                                  1/y, "...        ", "F - test-trace-collapse-at-top/expand-1"
-1402   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse-at-top/expand-1/cursor"
-1403   check-screen-row screen,                                  2/y, "0 line 2   ", "F - test-trace-collapse-at-top/expand-2"
-1404   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "           ", "F - test-trace-collapse-at-top/expand-2/cursor"
-1405   # collapse
-1406   edit-trace t, 8/backspace
+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   clear-screen screen
-1409   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1410   #
-1411   check-ints-equal y, 1, "F - test-trace-collapse-at-top/post-0/y"
-1412   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-collapse-at-top/post-0"
-1413   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-collapse-at-top/post-0/cursor"
-1414   check-screen-row screen,                                  1/y, "           ", "F - test-trace-collapse-at-top/post-1"
-1415   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse-at-top/post-1/cursor"
-1416 }
-1417 
-1418 fn test-trace-collapse {
-1419   var t-storage: trace
-1420   var t/esi: (addr trace) <- address t-storage
-1421   initialize-trace t, 0x10, 0x10
-1422   #
-1423   trace-text t, "l", "line 1"
-1424   trace-text t, "l", "line 2"
-1425   # setup: screen
-1426   var screen-on-stack: screen
-1427   var screen/edi: (addr screen) <- address screen-on-stack
-1428   initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics
-1429   #
-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, "...        ", "F - test-trace-collapse/pre-0"
-1433   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-collapse/pre-0/cursor"
-1434   check-screen-row screen,                                  1/y, "           ", "F - test-trace-collapse/pre-1"
-1435   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse/pre-1/cursor"
-1436   # expand
-1437   edit-trace t, 0xa/enter
-1438   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1439   #
-1440   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-collapse/expand-0"
-1441   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||||||||   ", "F - test-trace-collapse/expand-0/cursor"
-1442   check-screen-row screen,                                  1/y, "0 line 2   ", "F - test-trace-collapse/expand-1"
-1443   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse/expand-1/cursor"
-1444   # cursor down
-1445   edit-trace t, 0x6a/j
-1446   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1447   # collapse
-1448   edit-trace t, 8/backspace
-1449   clear-screen screen
-1450   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1451   #
-1452   check-ints-equal y, 1, "F - test-trace-collapse/post-0/y"
-1453   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-collapse/post-0"
-1454   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-collapse/post-0/cursor"
-1455   check-screen-row screen,                                  1/y, "           ", "F - test-trace-collapse/post-1"
-1456   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse/post-1/cursor"
-1457 }
-1458 
-1459 fn test-trace-collapse-skips-invisible-lines {
-1460   var t-storage: trace
-1461   var t/esi: (addr trace) <- address t-storage
-1462   initialize-trace t, 0x10, 0x10
-1463   #
-1464   trace-text t, "l", "line 1"
-1465   trace-lower t
-1466   trace-text t, "l", "line 1.1"
-1467   trace-higher t
-1468   trace-text t, "l", "line 2"
-1469   # setup: screen
-1470   var screen-on-stack: screen
-1471   var screen/edi: (addr screen) <- address screen-on-stack
-1472   initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics
-1473   #
-1474   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1475   #
-1476   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-collapse-skips-invisible-lines/pre-0"
-1477   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-collapse-skips-invisible-lines/pre-0/cursor"
-1478   check-screen-row screen,                                  1/y, "           ", "F - test-trace-collapse-skips-invisible-lines/pre-1"
-1479   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse-skips-invisible-lines/pre-1/cursor"
-1480   # expand
-1481   edit-trace t, 0xa/enter
-1482   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1483   # two visible lines with an invisible line in between
-1484   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-collapse-skips-invisible-lines/expand-0"
-1485   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||||||||   ", "F - test-trace-collapse-skips-invisible-lines/expand-0/cursor"
-1486   check-screen-row screen,                                  1/y, "...        ", "F - test-trace-collapse-skips-invisible-lines/expand-1"
-1487   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse-skips-invisible-lines/expand-1/cursor"
-1488   check-screen-row screen,                                  2/y, "0 line 2   ", "F - test-trace-collapse-skips-invisible-lines/expand-2"
-1489   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "           ", "F - test-trace-collapse-skips-invisible-lines/expand-2/cursor"
-1490   # cursor down to second visible line
-1491   edit-trace t, 0x6a/j
-1492   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1493   edit-trace t, 0x6a/j
-1494   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1495   # collapse
-1496   edit-trace t, 8/backspace
-1497   clear-screen screen
-1498   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1499   #
-1500   check-ints-equal y, 1, "F - test-trace-collapse-skips-invisible-lines/post-0/y"
-1501   var cursor-y/eax: (addr int) <- get t, cursor-y
-1502   check-ints-equal *cursor-y, 0, "F - test-trace-collapse-skips-invisible-lines/post-0/cursor-y"
-1503   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-collapse-skips-invisible-lines/post-0"
-1504   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-collapse-skips-invisible-lines/post-0/cursor"
-1505   check-screen-row screen,                                  1/y, "           ", "F - test-trace-collapse-skips-invisible-lines/post-1"
-1506   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse-skips-invisible-lines/post-1/cursor"
-1507 }
-1508 
-1509 fn test-trace-collapse-two-levels {
-1510   var t-storage: trace
-1511   var t/esi: (addr trace) <- address t-storage
-1512   initialize-trace t, 0x10, 0x10
-1513   #
-1514   trace-text t, "l", "line 1"
-1515   trace-lower t
-1516   trace-text t, "l", "line 1.1"
-1517   trace-higher t
-1518   trace-text t, "l", "line 2"
-1519   # setup: screen
-1520   var screen-on-stack: screen
-1521   var screen/edi: (addr screen) <- address screen-on-stack
-1522   initialize-screen screen, 0x10/width, 4/height, 0/no-pixel-graphics
-1523   #
-1524   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1525   #
-1526   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-collapse-two-levels/pre-0"
-1527   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-collapse-two-levels/pre-0/cursor"
-1528   check-screen-row screen,                                  1/y, "           ", "F - test-trace-collapse-two-levels/pre-1"
-1529   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse-two-levels/pre-1/cursor"
-1530   # expand
-1531   edit-trace t, 0xa/enter
-1532   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1533   # two visible lines with an invisible line in between
-1534   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-collapse-two-levels/expand-0"
-1535   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||||||||   ", "F - test-trace-collapse-two-levels/expand-0/cursor"
-1536   check-screen-row screen,                                  1/y, "...        ", "F - test-trace-collapse-two-levels/expand-1"
-1537   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse-two-levels/expand-1/cursor"
-1538   check-screen-row screen,                                  2/y, "0 line 2   ", "F - test-trace-collapse-two-levels/expand-2"
-1539   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "           ", "F - test-trace-collapse-two-levels/expand-2/cursor"
-1540   # cursor down to ellipses
-1541   edit-trace t, 0x6a/j
-1542   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1543   # expand
-1544   edit-trace t, 0xa/enter
-1545   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1546   # two visible lines with an invisible line in between
-1547   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-collapse-two-levels/expand2-0"
-1548   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "           ", "F - test-trace-collapse-two-levels/expand2-0/cursor"
-1549   check-screen-row screen,                                  1/y, "1 line 1.1 ", "F - test-trace-collapse-two-levels/expand2-1"
-1550   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "|||||||||| ", "F - test-trace-collapse-two-levels/expand2-1/cursor"
-1551   check-screen-row screen,                                  2/y, "0 line 2   ", "F - test-trace-collapse-two-levels/expand2-2"
-1552   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "           ", "F - test-trace-collapse-two-levels/expand2-2/cursor"
-1553   # cursor down to second visible line
-1554   edit-trace t, 0x6a/j
-1555   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
-1556   # collapse
-1557   edit-trace t, 8/backspace
-1558   clear-screen screen
-1559   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 4/ymax, 1/show-cursor
+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-ints-equal y, 1, "F - test-trace-collapse-two-levels/post-0/y"
-1562   var cursor-y/eax: (addr int) <- get t, cursor-y
-1563   check-ints-equal *cursor-y, 0, "F - test-trace-collapse-two-levels/post-0/cursor-y"
-1564   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-collapse-two-levels/post-0"
-1565   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-collapse-two-levels/post-0/cursor"
-1566   check-screen-row screen,                                  1/y, "           ", "F - test-trace-collapse-two-levels/post-1"
-1567   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse-two-levels/post-1/cursor"
-1568 }
-1569 
-1570 fn test-trace-collapse-nested-level {
-1571   var t-storage: trace
-1572   var t/esi: (addr trace) <- address t-storage
-1573   initialize-trace t, 0x10, 0x10
-1574   #
-1575   trace-text t, "l", "line 1"
-1576   trace-lower t
-1577   trace-text t, "l", "line 1.1"
-1578   trace-higher t
-1579   trace-text t, "l", "line 2"
-1580   trace-lower t
-1581   trace-text t, "l", "line 2.1"
-1582   trace-text t, "l", "line 2.2"
-1583   trace-higher t
-1584   # setup: screen
-1585   var screen-on-stack: screen
-1586   var screen/edi: (addr screen) <- address screen-on-stack
-1587   initialize-screen screen, 0x10/width, 8/height, 0/no-pixel-graphics
-1588   #
-1589   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor
-1590   #
-1591   check-screen-row screen,                                  0/y, "...        ", "F - test-trace-collapse-nested-level/pre-0"
-1592   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "|||        ", "F - test-trace-collapse-nested-level/pre-0/cursor"
-1593   check-screen-row screen,                                  1/y, "           ", "F - test-trace-collapse-nested-level/pre-1"
-1594   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse-nested-level/pre-1/cursor"
-1595   # expand
-1596   edit-trace t, 0xa/enter
-1597   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor
-1598   # two visible lines with an invisible line in between
-1599   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-collapse-nested-level/expand-0"
-1600   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "||||||||   ", "F - test-trace-collapse-nested-level/expand-0/cursor"
-1601   check-screen-row screen,                                  1/y, "...        ", "F - test-trace-collapse-nested-level/expand-1"
-1602   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse-nested-level/expand-1/cursor"
-1603   check-screen-row screen,                                  2/y, "0 line 2   ", "F - test-trace-collapse-nested-level/expand-2"
-1604   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "           ", "F - test-trace-collapse-nested-level/expand-2/cursor"
-1605   check-screen-row screen,                                  3/y, "...        ", "F - test-trace-collapse-nested-level/expand-3"
-1606   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "           ", "F - test-trace-collapse-nested-level/expand-3/cursor"
-1607   # cursor down to bottom
-1608   edit-trace t, 0x6a/j
-1609   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor
-1610   edit-trace t, 0x6a/j
-1611   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor
-1612   edit-trace t, 0x6a/j
-1613   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor
-1614   # expand
-1615   edit-trace t, 0xa/enter
-1616   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor
-1617   # two visible lines with an invisible line in between
-1618   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-collapse-nested-level/expand2-0"
-1619   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "           ", "F - test-trace-collapse-nested-level/expand2-0/cursor"
-1620   check-screen-row screen,                                  1/y, "...        ", "F - test-trace-collapse-nested-level/expand2-1"
-1621   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse-nested-level/expand2-1/cursor"
-1622   check-screen-row screen,                                  2/y, "0 line 2   ", "F - test-trace-collapse-nested-level/expand2-2"
-1623   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "           ", "F - test-trace-collapse-nested-level/expand2-2/cursor"
-1624   check-screen-row screen,                                  3/y, "1 line 2.1 ", "F - test-trace-collapse-nested-level/expand2-3"
-1625   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "|||||||||| ", "F - test-trace-collapse-nested-level/expand2-3/cursor"
-1626   check-screen-row screen,                                  4/y, "1 line 2.2 ", "F - test-trace-collapse-nested-level/expand2-4"
-1627   check-background-color-in-screen-row screen, 7/bg=cursor, 4/y, "           ", "F - test-trace-collapse-nested-level/expand2-4/cursor"
-1628   # collapse
-1629   edit-trace t, 8/backspace
-1630   clear-screen screen
-1631   var y/ecx: int <- render-trace screen, t, 0/xmin, 0/ymin, 0x10/xmax, 8/ymax, 1/show-cursor
-1632   #
-1633   check-ints-equal y, 4, "F - test-trace-collapse-nested-level/post-0/y"
-1634   var cursor-y/eax: (addr int) <- get t, cursor-y
-1635   check-ints-equal *cursor-y, 2, "F - test-trace-collapse-nested-level/post-0/cursor-y"
-1636   check-screen-row screen,                                  0/y, "0 line 1   ", "F - test-trace-collapse-nested-level/post-0"
-1637   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "           ", "F - test-trace-collapse-nested-level/post-0/cursor"
-1638   check-screen-row screen,                                  1/y, "...        ", "F - test-trace-collapse-nested-level/post-1"
-1639   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "           ", "F - test-trace-collapse-nested-level/post-1/cursor"
-1640   check-screen-row screen,                                  2/y, "0 line 2   ", "F - test-trace-collapse-nested-level/post-2"
-1641   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "||||||||   ", "F - test-trace-collapse-nested-level/post-2/cursor"
-1642   check-screen-row screen,                                  3/y, "...        ", "F - test-trace-collapse-nested-level/post-3"
-1643   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "           ", "F - test-trace-collapse-nested-level/post-3/cursor"
-1644 }
+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
+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
+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
+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
+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
+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
+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
+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"
+2033   # scroll down
+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"
+2045   # scroll down
+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"
+2070   # scroll up
+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 }