From 2c56af2d8f791902f5ff59754c0277eddeb27a3e Mon Sep 17 00:00:00 2001 From: Kartik Agaram Date: Wed, 11 Nov 2020 23:43:04 -0800 Subject: 7227 --- html/apps/tile/box.mu.html | 12 +- html/apps/tile/data.mu.html | 1309 ++++++++--------- html/apps/tile/environment.mu.html | 2716 ++++++++++++++++++------------------ html/apps/tile/main.mu.html | 129 +- html/apps/tile/rpn.mu.html | 1469 +++++++++++-------- html/apps/tile/surface.mu.html | 42 +- html/apps/tile/table.mu.html | 257 ++-- html/apps/tile/value-stack.mu.html | 360 ++--- html/apps/tile/value.mu.html | 487 +++++++ 9 files changed, 3748 insertions(+), 3033 deletions(-) create mode 100644 html/apps/tile/value.mu.html (limited to 'html/apps/tile') diff --git a/html/apps/tile/box.mu.html b/html/apps/tile/box.mu.html index cfb3da04..88d29001 100644 --- a/html/apps/tile/box.mu.html +++ b/html/apps/tile/box.mu.html @@ -87,7 +87,7 @@ if ('onhashchange' in window) { 29 { 30 compare col, col2 31 break-if->= - 32 print-code-point screen, 0x2500 + 32 print-code-point screen, 0x2500 33 col <- increment 34 loop 35 } @@ -99,7 +99,7 @@ if ('onhashchange' in window) { 41 compare row, row2 42 break-if->= 43 move-cursor screen, row, col - 44 print-code-point screen, 0x2502 + 44 print-code-point screen, 0x2502 45 row <- increment 46 loop 47 } @@ -107,22 +107,22 @@ if ('onhashchange' in window) { 49 50 fn draw-top-left-corner screen: (addr screen), row: int, col: int { 51 move-cursor screen, row, col - 52 print-code-point screen, 0x250c + 52 print-code-point screen, 0x250c 53 } 54 55 fn draw-top-right-corner screen: (addr screen), row: int, col: int { 56 move-cursor screen, row, col - 57 print-code-point screen, 0x2510 + 57 print-code-point screen, 0x2510 58 } 59 60 fn draw-bottom-left-corner screen: (addr screen), row: int, col: int { 61 move-cursor screen, row, col - 62 print-code-point screen, 0x2514 + 62 print-code-point screen, 0x2514 63 } 64 65 fn draw-bottom-right-corner screen: (addr screen), row: int, col: int { 66 move-cursor screen, row, col - 67 print-code-point screen, 0x2518 + 67 print-code-point screen, 0x2518 68 } 69 70 # erase parts of screen the slow way diff --git a/html/apps/tile/data.mu.html b/html/apps/tile/data.mu.html index 5d932cb3..3e3eacd4 100644 --- a/html/apps/tile/data.mu.html +++ b/html/apps/tile/data.mu.html @@ -61,8 +61,8 @@ if ('onhashchange' in window) { 2 setup: (handle line) 3 data: (handle line) 4 # display data - 5 cursor-call-path: (handle call-path-element) - 6 expanded-words: (handle call-path) + 5 cursor-call-path: (handle call-path-element) + 6 expanded-words: (handle call-path) 7 partial-name-for-cursor-word: (handle word) # only when renaming word 8 partial-name-for-function: (handle word) # only when defining function 9 # @@ -81,7 +81,7 @@ if ('onhashchange' in window) { 22 type line { 23 name: (handle array byte) 24 data: (handle word) - 25 result: (handle result) # might be cached + 25 result: (handle result) # might be cached 26 next: (handle line) 27 prev: (handle line) 28 } @@ -92,656 +92,659 @@ if ('onhashchange' in window) { 33 prev: (handle word) 34 } 35 - 36 type value { - 37 type: int - 38 int-data: int # if type = 0 - 39 text-data: (handle array byte) # if type = 1 - 40 array-data: (handle array value) # if type = 2 - 41 file-data: (handle buffered-file) # if type = 3 - 42 } - 43 - 44 type table { - 45 data: (handle array bind) - 46 next: (handle table) - 47 } - 48 - 49 type bind { - 50 key: (handle array byte) - 51 value: (handle value) # I'd inline this but we sometimes want to return a specific value from a table - 52 } - 53 - 54 # A call-path is a data structure that can unambiguously refer to any specific - 55 # call arbitrarily deep inside the call hierarchy of a program. - 56 type call-path { - 57 data: (handle call-path-element) - 58 next: (handle call-path) - 59 } - 60 - 61 # A call-path element is a list of elements, each of which corresponds to some call. - 62 type call-path-element { - 63 word: (handle word) - 64 next: (handle call-path-element) - 65 } - 66 - 67 type result { - 68 data: value-stack - 69 error: (handle array byte) # single error message for now - 70 } - 71 - 72 fn initialize-sandbox _sandbox: (addr sandbox) { - 73 var sandbox/esi: (addr sandbox) <- copy _sandbox - 74 var line-ah/eax: (addr handle line) <- get sandbox, data - 75 allocate line-ah - 76 var line/eax: (addr line) <- lookup *line-ah - 77 initialize-line line - 78 var word-ah/ecx: (addr handle word) <- get line, data - 79 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - 80 allocate cursor-call-path-ah - 81 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - 82 var dest/eax: (addr handle word) <- get cursor-call-path, word - 83 copy-object word-ah, dest - 84 } - 85 - 86 # initialize line with a single empty word - 87 fn initialize-line _line: (addr line) { - 88 var line/esi: (addr line) <- copy _line - 89 var word-ah/eax: (addr handle word) <- get line, data - 90 allocate word-ah - 91 var word/eax: (addr word) <- lookup *word-ah - 92 initialize-word word - 93 } - 94 - 95 fn create-primitive-functions _self: (addr handle function) { - 96 # x 2* = x 2 * - 97 var self/esi: (addr handle function) <- copy _self - 98 allocate self - 99 var _f/eax: (addr function) <- lookup *self -100 var f/esi: (addr function) <- copy _f -101 var name-ah/eax: (addr handle array byte) <- get f, name -102 populate-text-with name-ah, "2*" -103 var args-ah/eax: (addr handle word) <- get f, args -104 allocate args-ah -105 var args/eax: (addr word) <- lookup *args-ah -106 initialize-word-with args, "x" -107 var body-ah/eax: (addr handle line) <- get f, body -108 allocate body-ah -109 var body/eax: (addr line) <- lookup *body-ah -110 initialize-line body -111 var curr-word-ah/ecx: (addr handle word) <- get body, data -112 # *curr-word = "x" -113 allocate curr-word-ah -114 var tmp/eax: (addr word) <- lookup *curr-word-ah -115 var curr-word/edx: (addr word) <- copy tmp -116 initialize-word-with curr-word, "x" -117 # *curr-word->next = "2" -118 var next-word-ah/ebx: (addr handle word) <- get curr-word, next -119 allocate next-word-ah -120 tmp <- lookup *next-word-ah -121 initialize-word-with tmp, "2" -122 # *curr-word->next->prev = curr-word -123 var prev-word-ah/edi: (addr handle word) <- get tmp, prev -124 copy-object curr-word-ah, prev-word-ah -125 # curr-word = curr-word->next -126 curr-word-ah <- copy next-word-ah -127 curr-word <- copy tmp -128 # *curr-word->next = "*" -129 next-word-ah <- get curr-word, next -130 allocate next-word-ah -131 tmp <- lookup *next-word-ah -132 initialize-word-with tmp, "*" -133 # *curr-word->next->prev = curr-word -134 prev-word-ah <- get tmp, prev -135 copy-object curr-word-ah, prev-word-ah -136 tmp <- lookup *prev-word-ah -137 # x 1+ = x 1 + -138 var next/esi: (addr handle function) <- get f, next -139 allocate next -140 var _f/eax: (addr function) <- lookup *next -141 var f/esi: (addr function) <- copy _f -142 var name-ah/eax: (addr handle array byte) <- get f, name -143 populate-text-with name-ah, "1+" -144 var args-ah/eax: (addr handle word) <- get f, args -145 allocate args-ah -146 var args/eax: (addr word) <- lookup *args-ah -147 initialize-word-with args, "x" -148 var body-ah/eax: (addr handle line) <- get f, body -149 allocate body-ah -150 var body/eax: (addr line) <- lookup *body-ah -151 initialize-line body -152 var curr-word-ah/ecx: (addr handle word) <- get body, data -153 # *curr-word = "x" -154 allocate curr-word-ah -155 var tmp/eax: (addr word) <- lookup *curr-word-ah -156 curr-word <- copy tmp -157 initialize-word-with curr-word, "x" -158 # *curr-word->next = "1" -159 next-word-ah <- get curr-word, next -160 allocate next-word-ah -161 tmp <- lookup *next-word-ah -162 initialize-word-with tmp, "1" -163 # *curr-word->next->prev = curr-word -164 prev-word-ah <- get tmp, prev -165 copy-object curr-word-ah, prev-word-ah -166 # curr-word = curr-word->next -167 curr-word-ah <- copy next-word-ah -168 curr-word <- copy tmp -169 # *curr-word->next = "+" -170 next-word-ah <- get curr-word, next -171 allocate next-word-ah -172 tmp <- lookup *next-word-ah -173 initialize-word-with tmp, "+" -174 # *curr-word->next->prev = curr-word -175 prev-word-ah <- get tmp, prev -176 copy-object curr-word-ah, prev-word-ah -177 tmp <- lookup *prev-word-ah -178 # x 2+ = x 1+ 1+ -179 var next/esi: (addr handle function) <- get f, next -180 allocate next -181 var _f/eax: (addr function) <- lookup *next -182 var f/esi: (addr function) <- copy _f -183 var name-ah/eax: (addr handle array byte) <- get f, name -184 populate-text-with name-ah, "2+" -185 var args-ah/eax: (addr handle word) <- get f, args -186 allocate args-ah -187 var args/eax: (addr word) <- lookup *args-ah -188 initialize-word-with args, "x" -189 var body-ah/eax: (addr handle line) <- get f, body -190 allocate body-ah -191 var body/eax: (addr line) <- lookup *body-ah -192 initialize-line body -193 var curr-word-ah/ecx: (addr handle word) <- get body, data -194 # *curr-word = "x" -195 allocate curr-word-ah -196 var tmp/eax: (addr word) <- lookup *curr-word-ah -197 curr-word <- copy tmp -198 initialize-word-with curr-word, "x" -199 # *curr-word->next = "1+" -200 next-word-ah <- get curr-word, next -201 allocate next-word-ah -202 tmp <- lookup *next-word-ah -203 initialize-word-with tmp, "1+" -204 # *curr-word->next->prev = curr-word -205 prev-word-ah <- get tmp, prev -206 copy-object curr-word-ah, prev-word-ah -207 # curr-word = curr-word->next -208 curr-word-ah <- copy next-word-ah -209 curr-word <- copy tmp -210 # *curr-word->next = "1+" -211 next-word-ah <- get curr-word, next -212 allocate next-word-ah -213 tmp <- lookup *next-word-ah -214 initialize-word-with tmp, "1+" -215 # *curr-word->next->prev = curr-word -216 prev-word-ah <- get tmp, prev -217 copy-object curr-word-ah, prev-word-ah -218 tmp <- lookup *prev-word-ah -219 # x square = x x * -220 var next/esi: (addr handle function) <- get f, next -221 allocate next -222 var _f/eax: (addr function) <- lookup *next -223 var f/esi: (addr function) <- copy _f -224 var name-ah/eax: (addr handle array byte) <- get f, name -225 populate-text-with name-ah, "square" -226 var args-ah/eax: (addr handle word) <- get f, args -227 allocate args-ah -228 var args/eax: (addr word) <- lookup *args-ah -229 initialize-word-with args, "x" -230 var body-ah/eax: (addr handle line) <- get f, body -231 allocate body-ah -232 var body/eax: (addr line) <- lookup *body-ah -233 initialize-line body -234 var curr-word-ah/ecx: (addr handle word) <- get body, data -235 # *curr-word = "x" -236 allocate curr-word-ah -237 var tmp/eax: (addr word) <- lookup *curr-word-ah -238 var curr-word/edx: (addr word) <- copy tmp -239 initialize-word-with curr-word, "x" -240 # *curr-word->next = "x" -241 var next-word-ah/ebx: (addr handle word) <- get curr-word, next -242 allocate next-word-ah -243 tmp <- lookup *next-word-ah -244 initialize-word-with tmp, "x" -245 # *curr-word->next->prev = curr-word -246 var prev-word-ah/edi: (addr handle word) <- get tmp, prev -247 copy-object curr-word-ah, prev-word-ah -248 # curr-word = curr-word->next -249 curr-word-ah <- copy next-word-ah -250 curr-word <- copy tmp -251 # *curr-word->next = "*" -252 next-word-ah <- get curr-word, next -253 allocate next-word-ah -254 tmp <- lookup *next-word-ah -255 initialize-word-with tmp, "*" -256 # *curr-word->next->prev = curr-word -257 prev-word-ah <- get tmp, prev -258 copy-object curr-word-ah, prev-word-ah -259 tmp <- lookup *prev-word-ah -260 # x 1- = x 1 - -261 var next/esi: (addr handle function) <- get f, next -262 allocate next -263 var _f/eax: (addr function) <- lookup *next -264 var f/esi: (addr function) <- copy _f -265 var name-ah/eax: (addr handle array byte) <- get f, name -266 populate-text-with name-ah, "1-" -267 var args-ah/eax: (addr handle word) <- get f, args -268 allocate args-ah -269 var args/eax: (addr word) <- lookup *args-ah -270 initialize-word-with args, "x" -271 var body-ah/eax: (addr handle line) <- get f, body -272 allocate body-ah -273 var body/eax: (addr line) <- lookup *body-ah -274 initialize-line body -275 var curr-word-ah/ecx: (addr handle word) <- get body, data -276 # *curr-word = "x" -277 allocate curr-word-ah -278 var tmp/eax: (addr word) <- lookup *curr-word-ah -279 curr-word <- copy tmp -280 initialize-word-with curr-word, "x" -281 # *curr-word->next = "1" -282 next-word-ah <- get curr-word, next -283 allocate next-word-ah -284 tmp <- lookup *next-word-ah -285 initialize-word-with tmp, "1" -286 # *curr-word->next->prev = curr-word -287 prev-word-ah <- get tmp, prev -288 copy-object curr-word-ah, prev-word-ah -289 # curr-word = curr-word->next -290 curr-word-ah <- copy next-word-ah -291 curr-word <- copy tmp -292 # *curr-word->next = "-" -293 next-word-ah <- get curr-word, next -294 allocate next-word-ah -295 tmp <- lookup *next-word-ah -296 initialize-word-with tmp, "-" -297 # *curr-word->next->prev = curr-word -298 prev-word-ah <- get tmp, prev -299 copy-object curr-word-ah, prev-word-ah -300 tmp <- lookup *prev-word-ah -301 # x y sub = x y - -302 var next/esi: (addr handle function) <- get f, next -303 allocate next -304 var _f/eax: (addr function) <- lookup *next -305 var f/esi: (addr function) <- copy _f -306 var name-ah/eax: (addr handle array byte) <- get f, name -307 populate-text-with name-ah, "sub" -308 # critical lesson: args are stored in reverse order -309 var args-ah/eax: (addr handle word) <- get f, args -310 allocate args-ah -311 var args/eax: (addr word) <- lookup *args-ah -312 initialize-word-with args, "y" -313 var next-arg-ah/eax: (addr handle word) <- get args, next -314 allocate next-arg-ah -315 var next-arg/eax: (addr word) <- lookup *next-arg-ah -316 initialize-word-with next-arg, "x" -317 var body-ah/eax: (addr handle line) <- get f, body -318 allocate body-ah -319 var body/eax: (addr line) <- lookup *body-ah -320 initialize-line body -321 var curr-word-ah/ecx: (addr handle word) <- get body, data -322 # *curr-word = "x" -323 allocate curr-word-ah -324 var tmp/eax: (addr word) <- lookup *curr-word-ah -325 curr-word <- copy tmp -326 initialize-word-with curr-word, "x" -327 # *curr-word->next = "y" -328 next-word-ah <- get curr-word, next -329 allocate next-word-ah -330 tmp <- lookup *next-word-ah -331 initialize-word-with tmp, "y" -332 # *curr-word->next->prev = curr-word -333 prev-word-ah <- get tmp, prev -334 copy-object curr-word-ah, prev-word-ah -335 # curr-word = curr-word->next -336 curr-word-ah <- copy next-word-ah -337 curr-word <- copy tmp -338 # *curr-word->next = "-" -339 next-word-ah <- get curr-word, next -340 allocate next-word-ah -341 tmp <- lookup *next-word-ah -342 initialize-word-with tmp, "-" -343 # *curr-word->next->prev = curr-word -344 prev-word-ah <- get tmp, prev -345 copy-object curr-word-ah, prev-word-ah -346 tmp <- lookup *prev-word-ah -347 } -348 -349 fn function-body functions: (addr handle function), _word: (addr handle word), out: (addr handle line) { -350 var function-name-storage: (handle array byte) -351 var function-name-ah/ecx: (addr handle array byte) <- address function-name-storage -352 var word-ah/esi: (addr handle word) <- copy _word -353 var word/eax: (addr word) <- lookup *word-ah -354 var gap-ah/eax: (addr handle gap-buffer) <- get word, scalar-data -355 var gap/eax: (addr gap-buffer) <- lookup *gap-ah -356 gap-buffer-to-string gap, function-name-ah -357 var _function-name/eax: (addr array byte) <- lookup *function-name-ah -358 var function-name/esi: (addr array byte) <- copy _function-name -359 var curr-ah/ecx: (addr handle function) <- copy functions -360 $function-body:loop: { -361 var _curr/eax: (addr function) <- lookup *curr-ah -362 var curr/edx: (addr function) <- copy _curr -363 compare curr, 0 -364 break-if-= -365 var curr-name-ah/eax: (addr handle array byte) <- get curr, name -366 var curr-name/eax: (addr array byte) <- lookup *curr-name-ah -367 var found?/eax: boolean <- string-equal? curr-name, function-name -368 compare found?, 0 # false -369 { -370 break-if-= -371 var src/eax: (addr handle line) <- get curr, body -372 copy-object src, out -373 break $function-body:loop -374 } -375 curr-ah <- get curr, next -376 loop -377 } -378 } -379 -380 fn body-length functions: (addr handle function), function-name: (addr handle word) -> _/eax: int { -381 var body-storage: (handle line) -382 var body-ah/edi: (addr handle line) <- address body-storage -383 function-body functions, function-name, body-ah -384 var body/eax: (addr line) <- lookup *body-ah -385 var result/eax: int <- line-length body -386 return result -387 } -388 -389 fn line-length _in: (addr line) -> _/eax: int { -390 var in/esi: (addr line) <- copy _in -391 var curr-ah/ecx: (addr handle word) <- get in, data -392 var result/edi: int <- copy 0 -393 { -394 var curr/eax: (addr word) <- lookup *curr-ah -395 compare curr, 0 -396 break-if-= -397 curr-ah <- get curr, next -398 result <- increment -399 loop -400 } -401 return result -402 } -403 -404 fn populate-text-with _out: (addr handle array byte), _in: (addr array byte) { -405 var in/esi: (addr array byte) <- copy _in -406 var n/ecx: int <- length in -407 var out/edx: (addr handle array byte) <- copy _out -408 populate out, n -409 var _out-addr/eax: (addr array byte) <- lookup *out -410 var out-addr/edx: (addr array byte) <- copy _out-addr -411 var i/eax: int <- copy 0 -412 { -413 compare i, n -414 break-if->= -415 var src/esi: (addr byte) <- index in, i -416 var val/ecx: byte <- copy-byte *src -417 var dest/edi: (addr byte) <- index out-addr, i -418 copy-byte-to *dest, val -419 i <- increment -420 loop -421 } -422 } -423 -424 fn initialize-path-from-sandbox _in: (addr sandbox), _out: (addr handle call-path-element) { -425 var sandbox/esi: (addr sandbox) <- copy _in -426 var line-ah/eax: (addr handle line) <- get sandbox, data -427 var line/eax: (addr line) <- lookup *line-ah -428 var src/esi: (addr handle word) <- get line, data -429 var out-ah/edi: (addr handle call-path-element) <- copy _out -430 var out/eax: (addr call-path-element) <- lookup *out-ah -431 var dest/edi: (addr handle word) <- get out, word -432 copy-object src, dest -433 } -434 -435 fn initialize-path-from-line _line: (addr line), _out: (addr handle call-path-element) { -436 var line/eax: (addr line) <- copy _line -437 var src/esi: (addr handle word) <- get line, data -438 var out-ah/edi: (addr handle call-path-element) <- copy _out -439 var out/eax: (addr call-path-element) <- lookup *out-ah -440 var dest/edi: (addr handle word) <- get out, word -441 copy-object src, dest -442 } -443 -444 fn find-in-call-paths call-paths: (addr handle call-path), needle: (addr handle call-path-element) -> _/eax: boolean { -445 var curr-ah/esi: (addr handle call-path) <- copy call-paths -446 $find-in-call-path:loop: { -447 var curr/eax: (addr call-path) <- lookup *curr-ah -448 compare curr, 0 -449 break-if-= -450 { -451 var curr-data/eax: (addr handle call-path-element) <- get curr, data -452 var match?/eax: boolean <- call-path-element-match? curr-data, needle -453 compare match?, 0 # false -454 { -455 break-if-= -456 return 1 # true -457 } -458 } -459 curr-ah <- get curr, next -460 loop -461 } -462 return 0 # false -463 } -464 -465 fn call-path-element-match? _x: (addr handle call-path-element), _y: (addr handle call-path-element) -> _/eax: boolean { -466 var x-ah/eax: (addr handle call-path-element) <- copy _x -467 var x-a/eax: (addr call-path-element) <- lookup *x-ah -468 var x/esi: (addr call-path-element) <- copy x-a -469 var y-ah/eax: (addr handle call-path-element) <- copy _y -470 var y-a/eax: (addr call-path-element) <- lookup *y-ah -471 var y/edi: (addr call-path-element) <- copy y-a -472 compare x, y -473 { -474 break-if-!= -475 return 1 # true -476 } -477 compare x, 0 -478 { -479 break-if-!= -480 return 0 # false -481 } -482 compare y, 0 -483 { -484 break-if-!= -485 return 0 # false -486 } -487 # compare word addresses, not contents -488 var x-data-ah/ecx: (addr handle word) <- get x, word -489 var x-data-a/eax: (addr word) <- lookup *x-data-ah -490 var x-data/ecx: int <- copy x-data-a -491 var y-data-ah/eax: (addr handle word) <- get y, word -492 var y-data-a/eax: (addr word) <- lookup *y-data-ah -493 var y-data/eax: int <- copy y-data-a -494 #? print-string 0, "match? " -495 #? print-int32-hex 0, x-data -496 #? print-string 0, " vs " -497 #? print-int32-hex 0, y-data -498 #? print-string 0, "\n" -499 compare x-data, y-data -500 { -501 break-if-= -502 return 0 # false -503 } -504 var x-next/ecx: (addr handle call-path-element) <- get x, next -505 var y-next/eax: (addr handle call-path-element) <- get y, next -506 var result/eax: boolean <- call-path-element-match? x-next, y-next -507 return result -508 } -509 -510 # order is irrelevant -511 fn insert-in-call-path list: (addr handle call-path), new: (addr handle call-path-element) { -512 var new-path-storage: (handle call-path) -513 var new-path-ah/edi: (addr handle call-path) <- address new-path-storage -514 allocate new-path-ah -515 var new-path/eax: (addr call-path) <- lookup *new-path-ah -516 var next/ecx: (addr handle call-path) <- get new-path, next -517 copy-object list, next -518 var dest/ecx: (addr handle call-path-element) <- get new-path, data -519 deep-copy-call-path-element new, dest -520 copy-object new-path-ah, list -521 } -522 -523 # assumes dest is initially clear -524 fn deep-copy-call-path-element _src: (addr handle call-path-element), _dest: (addr handle call-path-element) { -525 var src/esi: (addr handle call-path-element) <- copy _src -526 # if src is null, return -527 var _src-addr/eax: (addr call-path-element) <- lookup *src -528 compare _src-addr, 0 -529 break-if-= -530 # allocate -531 var src-addr/esi: (addr call-path-element) <- copy _src-addr -532 var dest/eax: (addr handle call-path-element) <- copy _dest -533 allocate dest -534 # copy data -535 var dest-addr/eax: (addr call-path-element) <- lookup *dest -536 { -537 var dest-data-addr/ecx: (addr handle word) <- get dest-addr, word -538 var src-data-addr/eax: (addr handle word) <- get src-addr, word -539 copy-object src-data-addr, dest-data-addr -540 } -541 # recurse -542 var src-next/esi: (addr handle call-path-element) <- get src-addr, next -543 var dest-next/eax: (addr handle call-path-element) <- get dest-addr, next -544 deep-copy-call-path-element src-next, dest-next -545 } -546 -547 fn delete-in-call-path list: (addr handle call-path), needle: (addr handle call-path-element) { -548 var curr-ah/esi: (addr handle call-path) <- copy list -549 $delete-in-call-path:loop: { -550 var _curr/eax: (addr call-path) <- lookup *curr-ah -551 var curr/ecx: (addr call-path) <- copy _curr -552 compare curr, 0 -553 break-if-= -554 { -555 var curr-data/eax: (addr handle call-path-element) <- get curr, data -556 var match?/eax: boolean <- call-path-element-match? curr-data, needle -557 compare match?, 0 # false -558 { -559 break-if-= -560 var next-ah/ecx: (addr handle call-path) <- get curr, next -561 copy-object next-ah, curr-ah -562 loop $delete-in-call-path:loop -563 } -564 } -565 curr-ah <- get curr, next -566 loop -567 } -568 } -569 -570 fn increment-final-element list: (addr handle call-path-element) { -571 var final-ah/eax: (addr handle call-path-element) <- copy list -572 var final/eax: (addr call-path-element) <- lookup *final-ah -573 var val-ah/ecx: (addr handle word) <- get final, word -574 var val/eax: (addr word) <- lookup *val-ah -575 var new-ah/edx: (addr handle word) <- get val, next -576 var target/eax: (addr word) <- lookup *new-ah -577 compare target, 0 -578 break-if-= -579 copy-object new-ah, val-ah -580 } -581 -582 fn decrement-final-element list: (addr handle call-path-element) { -583 var final-ah/eax: (addr handle call-path-element) <- copy list -584 var final/eax: (addr call-path-element) <- lookup *final-ah -585 var val-ah/ecx: (addr handle word) <- get final, word -586 var val/eax: (addr word) <- lookup *val-ah -587 #? print-string 0, "replacing " -588 #? { -589 #? var foo/eax: int <- copy val -590 #? print-int32-hex 0, foo -591 #? } -592 var new-ah/edx: (addr handle word) <- get val, prev -593 var target/eax: (addr word) <- lookup *new-ah -594 compare target, 0 -595 break-if-= -596 # val = val->prev -597 #? print-string 0, " with " -598 #? { -599 #? var foo/eax: int <- copy target -600 #? print-int32-hex 0, foo -601 #? } -602 #? print-string 0, "\n" -603 copy-object new-ah, val-ah -604 } -605 -606 fn move-final-element-to-start-of-line list: (addr handle call-path-element) { -607 var final-ah/eax: (addr handle call-path-element) <- copy list -608 var final/eax: (addr call-path-element) <- lookup *final-ah -609 var val-ah/ecx: (addr handle word) <- get final, word -610 var val/eax: (addr word) <- lookup *val-ah -611 var new-ah/edx: (addr handle word) <- get val, prev -612 var target/eax: (addr word) <- lookup *new-ah -613 compare target, 0 -614 break-if-= -615 copy-object new-ah, val-ah -616 move-final-element-to-start-of-line list -617 } -618 -619 fn push-to-call-path-element list: (addr handle call-path-element), new: (addr handle word) { -620 var new-element-storage: (handle call-path-element) -621 var new-element-ah/edi: (addr handle call-path-element) <- address new-element-storage -622 allocate new-element-ah -623 var new-element/eax: (addr call-path-element) <- lookup *new-element-ah -624 # save word -625 var dest/ecx: (addr handle word) <- get new-element, word -626 copy-object new, dest -627 # save next -628 var dest2/ecx: (addr handle call-path-element) <- get new-element, next -629 copy-object list, dest2 -630 # return -631 copy-object new-element-ah, list -632 } -633 -634 fn drop-from-call-path-element _list: (addr handle call-path-element) { -635 var list-ah/esi: (addr handle call-path-element) <- copy _list -636 var list/eax: (addr call-path-element) <- lookup *list-ah -637 var next/eax: (addr handle call-path-element) <- get list, next -638 copy-object next, _list -639 } -640 -641 fn drop-nested-calls _list: (addr handle call-path-element) { -642 var list-ah/esi: (addr handle call-path-element) <- copy _list -643 var list/eax: (addr call-path-element) <- lookup *list-ah -644 var next-ah/edi: (addr handle call-path-element) <- get list, next -645 var next/eax: (addr call-path-element) <- lookup *next-ah -646 compare next, 0 -647 break-if-= -648 copy-object next-ah, _list -649 drop-nested-calls _list -650 } -651 -652 fn dump-call-path-element screen: (addr screen), _x-ah: (addr handle call-path-element) { -653 var x-ah/ecx: (addr handle call-path-element) <- copy _x-ah -654 var _x/eax: (addr call-path-element) <- lookup *x-ah -655 var x/esi: (addr call-path-element) <- copy _x -656 var word-ah/eax: (addr handle word) <- get x, word -657 var word/eax: (addr word) <- lookup *word-ah -658 print-word screen, word -659 var next-ah/ecx: (addr handle call-path-element) <- get x, next -660 var next/eax: (addr call-path-element) <- lookup *next-ah -661 compare next, 0 -662 { -663 break-if-= -664 print-string screen, " " -665 dump-call-path-element screen, next-ah -666 return -667 } -668 print-string screen, "\n" -669 } -670 -671 fn dump-call-paths screen: (addr screen), _x-ah: (addr handle call-path) { -672 var x-ah/ecx: (addr handle call-path) <- copy _x-ah -673 var x/eax: (addr call-path) <- lookup *x-ah -674 compare x, 0 -675 break-if-= -676 var src/ecx: (addr handle call-path-element) <- get x, data -677 dump-call-path-element screen, src -678 var next-ah/ecx: (addr handle call-path) <- get x, next -679 var next/eax: (addr call-path) <- lookup *next-ah -680 compare next, 0 -681 { -682 break-if-= -683 dump-call-paths screen, next-ah -684 } -685 } + 36 # todo: turn this into a sum type + 37 type value { + 38 type: int + 39 int-data: int # if type = 0 + 40 text-data: (handle array byte) # if type = 1 + 41 array-data: (handle array value) # if type = 2 + 42 file-data: (handle buffered-file) # if type = 3 + 43 filename: (handle array byte) # if type = 3 + 44 screen-data: (handle screen) # if type = 4 + 45 } + 46 + 47 type table { + 48 data: (handle array bind) + 49 next: (handle table) + 50 } + 51 + 52 type bind { + 53 key: (handle array byte) + 54 value: (handle value) # I'd inline this but we sometimes want to return a specific value from a table + 55 } + 56 + 57 # A call-path is a data structure that can unambiguously refer to any specific + 58 # call arbitrarily deep inside the call hierarchy of a program. + 59 type call-path { + 60 data: (handle call-path-element) + 61 next: (handle call-path) + 62 } + 63 + 64 # A call-path element is a list of elements, each of which corresponds to some call. + 65 type call-path-element { + 66 word: (handle word) + 67 next: (handle call-path-element) + 68 } + 69 + 70 type result { + 71 data: value-stack + 72 error: (handle array byte) # single error message for now + 73 } + 74 + 75 fn initialize-sandbox _sandbox: (addr sandbox) { + 76 var sandbox/esi: (addr sandbox) <- copy _sandbox + 77 var line-ah/eax: (addr handle line) <- get sandbox, data + 78 allocate line-ah + 79 var line/eax: (addr line) <- lookup *line-ah + 80 initialize-line line + 81 var word-ah/ecx: (addr handle word) <- get line, data + 82 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 83 allocate cursor-call-path-ah + 84 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah + 85 var dest/eax: (addr handle word) <- get cursor-call-path, word + 86 copy-object word-ah, dest + 87 } + 88 + 89 # initialize line with a single empty word + 90 fn initialize-line _line: (addr line) { + 91 var line/esi: (addr line) <- copy _line + 92 var word-ah/eax: (addr handle word) <- get line, data + 93 allocate word-ah + 94 var word/eax: (addr word) <- lookup *word-ah + 95 initialize-word word + 96 } + 97 + 98 fn create-primitive-functions _self: (addr handle function) { + 99 # x 2* = x 2 * +100 var self/esi: (addr handle function) <- copy _self +101 allocate self +102 var _f/eax: (addr function) <- lookup *self +103 var f/esi: (addr function) <- copy _f +104 var name-ah/eax: (addr handle array byte) <- get f, name +105 populate-text-with name-ah, "2*" +106 var args-ah/eax: (addr handle word) <- get f, args +107 allocate args-ah +108 var args/eax: (addr word) <- lookup *args-ah +109 initialize-word-with args, "x" +110 var body-ah/eax: (addr handle line) <- get f, body +111 allocate body-ah +112 var body/eax: (addr line) <- lookup *body-ah +113 initialize-line body +114 var curr-word-ah/ecx: (addr handle word) <- get body, data +115 # *curr-word = "x" +116 allocate curr-word-ah +117 var tmp/eax: (addr word) <- lookup *curr-word-ah +118 var curr-word/edx: (addr word) <- copy tmp +119 initialize-word-with curr-word, "x" +120 # *curr-word->next = "2" +121 var next-word-ah/ebx: (addr handle word) <- get curr-word, next +122 allocate next-word-ah +123 tmp <- lookup *next-word-ah +124 initialize-word-with tmp, "2" +125 # *curr-word->next->prev = curr-word +126 var prev-word-ah/edi: (addr handle word) <- get tmp, prev +127 copy-object curr-word-ah, prev-word-ah +128 # curr-word = curr-word->next +129 curr-word-ah <- copy next-word-ah +130 curr-word <- copy tmp +131 # *curr-word->next = "*" +132 next-word-ah <- get curr-word, next +133 allocate next-word-ah +134 tmp <- lookup *next-word-ah +135 initialize-word-with tmp, "*" +136 # *curr-word->next->prev = curr-word +137 prev-word-ah <- get tmp, prev +138 copy-object curr-word-ah, prev-word-ah +139 tmp <- lookup *prev-word-ah +140 # x 1+ = x 1 + +141 var next/esi: (addr handle function) <- get f, next +142 allocate next +143 var _f/eax: (addr function) <- lookup *next +144 var f/esi: (addr function) <- copy _f +145 var name-ah/eax: (addr handle array byte) <- get f, name +146 populate-text-with name-ah, "1+" +147 var args-ah/eax: (addr handle word) <- get f, args +148 allocate args-ah +149 var args/eax: (addr word) <- lookup *args-ah +150 initialize-word-with args, "x" +151 var body-ah/eax: (addr handle line) <- get f, body +152 allocate body-ah +153 var body/eax: (addr line) <- lookup *body-ah +154 initialize-line body +155 var curr-word-ah/ecx: (addr handle word) <- get body, data +156 # *curr-word = "x" +157 allocate curr-word-ah +158 var tmp/eax: (addr word) <- lookup *curr-word-ah +159 curr-word <- copy tmp +160 initialize-word-with curr-word, "x" +161 # *curr-word->next = "1" +162 next-word-ah <- get curr-word, next +163 allocate next-word-ah +164 tmp <- lookup *next-word-ah +165 initialize-word-with tmp, "1" +166 # *curr-word->next->prev = curr-word +167 prev-word-ah <- get tmp, prev +168 copy-object curr-word-ah, prev-word-ah +169 # curr-word = curr-word->next +170 curr-word-ah <- copy next-word-ah +171 curr-word <- copy tmp +172 # *curr-word->next = "+" +173 next-word-ah <- get curr-word, next +174 allocate next-word-ah +175 tmp <- lookup *next-word-ah +176 initialize-word-with tmp, "+" +177 # *curr-word->next->prev = curr-word +178 prev-word-ah <- get tmp, prev +179 copy-object curr-word-ah, prev-word-ah +180 tmp <- lookup *prev-word-ah +181 # x 2+ = x 1+ 1+ +182 var next/esi: (addr handle function) <- get f, next +183 allocate next +184 var _f/eax: (addr function) <- lookup *next +185 var f/esi: (addr function) <- copy _f +186 var name-ah/eax: (addr handle array byte) <- get f, name +187 populate-text-with name-ah, "2+" +188 var args-ah/eax: (addr handle word) <- get f, args +189 allocate args-ah +190 var args/eax: (addr word) <- lookup *args-ah +191 initialize-word-with args, "x" +192 var body-ah/eax: (addr handle line) <- get f, body +193 allocate body-ah +194 var body/eax: (addr line) <- lookup *body-ah +195 initialize-line body +196 var curr-word-ah/ecx: (addr handle word) <- get body, data +197 # *curr-word = "x" +198 allocate curr-word-ah +199 var tmp/eax: (addr word) <- lookup *curr-word-ah +200 curr-word <- copy tmp +201 initialize-word-with curr-word, "x" +202 # *curr-word->next = "1+" +203 next-word-ah <- get curr-word, next +204 allocate next-word-ah +205 tmp <- lookup *next-word-ah +206 initialize-word-with tmp, "1+" +207 # *curr-word->next->prev = curr-word +208 prev-word-ah <- get tmp, prev +209 copy-object curr-word-ah, prev-word-ah +210 # curr-word = curr-word->next +211 curr-word-ah <- copy next-word-ah +212 curr-word <- copy tmp +213 # *curr-word->next = "1+" +214 next-word-ah <- get curr-word, next +215 allocate next-word-ah +216 tmp <- lookup *next-word-ah +217 initialize-word-with tmp, "1+" +218 # *curr-word->next->prev = curr-word +219 prev-word-ah <- get tmp, prev +220 copy-object curr-word-ah, prev-word-ah +221 tmp <- lookup *prev-word-ah +222 # x square = x x * +223 var next/esi: (addr handle function) <- get f, next +224 allocate next +225 var _f/eax: (addr function) <- lookup *next +226 var f/esi: (addr function) <- copy _f +227 var name-ah/eax: (addr handle array byte) <- get f, name +228 populate-text-with name-ah, "square" +229 var args-ah/eax: (addr handle word) <- get f, args +230 allocate args-ah +231 var args/eax: (addr word) <- lookup *args-ah +232 initialize-word-with args, "x" +233 var body-ah/eax: (addr handle line) <- get f, body +234 allocate body-ah +235 var body/eax: (addr line) <- lookup *body-ah +236 initialize-line body +237 var curr-word-ah/ecx: (addr handle word) <- get body, data +238 # *curr-word = "x" +239 allocate curr-word-ah +240 var tmp/eax: (addr word) <- lookup *curr-word-ah +241 var curr-word/edx: (addr word) <- copy tmp +242 initialize-word-with curr-word, "x" +243 # *curr-word->next = "x" +244 var next-word-ah/ebx: (addr handle word) <- get curr-word, next +245 allocate next-word-ah +246 tmp <- lookup *next-word-ah +247 initialize-word-with tmp, "x" +248 # *curr-word->next->prev = curr-word +249 var prev-word-ah/edi: (addr handle word) <- get tmp, prev +250 copy-object curr-word-ah, prev-word-ah +251 # curr-word = curr-word->next +252 curr-word-ah <- copy next-word-ah +253 curr-word <- copy tmp +254 # *curr-word->next = "*" +255 next-word-ah <- get curr-word, next +256 allocate next-word-ah +257 tmp <- lookup *next-word-ah +258 initialize-word-with tmp, "*" +259 # *curr-word->next->prev = curr-word +260 prev-word-ah <- get tmp, prev +261 copy-object curr-word-ah, prev-word-ah +262 tmp <- lookup *prev-word-ah +263 # x 1- = x 1 - +264 var next/esi: (addr handle function) <- get f, next +265 allocate next +266 var _f/eax: (addr function) <- lookup *next +267 var f/esi: (addr function) <- copy _f +268 var name-ah/eax: (addr handle array byte) <- get f, name +269 populate-text-with name-ah, "1-" +270 var args-ah/eax: (addr handle word) <- get f, args +271 allocate args-ah +272 var args/eax: (addr word) <- lookup *args-ah +273 initialize-word-with args, "x" +274 var body-ah/eax: (addr handle line) <- get f, body +275 allocate body-ah +276 var body/eax: (addr line) <- lookup *body-ah +277 initialize-line body +278 var curr-word-ah/ecx: (addr handle word) <- get body, data +279 # *curr-word = "x" +280 allocate curr-word-ah +281 var tmp/eax: (addr word) <- lookup *curr-word-ah +282 curr-word <- copy tmp +283 initialize-word-with curr-word, "x" +284 # *curr-word->next = "1" +285 next-word-ah <- get curr-word, next +286 allocate next-word-ah +287 tmp <- lookup *next-word-ah +288 initialize-word-with tmp, "1" +289 # *curr-word->next->prev = curr-word +290 prev-word-ah <- get tmp, prev +291 copy-object curr-word-ah, prev-word-ah +292 # curr-word = curr-word->next +293 curr-word-ah <- copy next-word-ah +294 curr-word <- copy tmp +295 # *curr-word->next = "-" +296 next-word-ah <- get curr-word, next +297 allocate next-word-ah +298 tmp <- lookup *next-word-ah +299 initialize-word-with tmp, "-" +300 # *curr-word->next->prev = curr-word +301 prev-word-ah <- get tmp, prev +302 copy-object curr-word-ah, prev-word-ah +303 tmp <- lookup *prev-word-ah +304 # x y sub = x y - +305 var next/esi: (addr handle function) <- get f, next +306 allocate next +307 var _f/eax: (addr function) <- lookup *next +308 var f/esi: (addr function) <- copy _f +309 var name-ah/eax: (addr handle array byte) <- get f, name +310 populate-text-with name-ah, "sub" +311 # critical lesson: args are stored in reverse order +312 var args-ah/eax: (addr handle word) <- get f, args +313 allocate args-ah +314 var args/eax: (addr word) <- lookup *args-ah +315 initialize-word-with args, "y" +316 var next-arg-ah/eax: (addr handle word) <- get args, next +317 allocate next-arg-ah +318 var next-arg/eax: (addr word) <- lookup *next-arg-ah +319 initialize-word-with next-arg, "x" +320 var body-ah/eax: (addr handle line) <- get f, body +321 allocate body-ah +322 var body/eax: (addr line) <- lookup *body-ah +323 initialize-line body +324 var curr-word-ah/ecx: (addr handle word) <- get body, data +325 # *curr-word = "x" +326 allocate curr-word-ah +327 var tmp/eax: (addr word) <- lookup *curr-word-ah +328 curr-word <- copy tmp +329 initialize-word-with curr-word, "x" +330 # *curr-word->next = "y" +331 next-word-ah <- get curr-word, next +332 allocate next-word-ah +333 tmp <- lookup *next-word-ah +334 initialize-word-with tmp, "y" +335 # *curr-word->next->prev = curr-word +336 prev-word-ah <- get tmp, prev +337 copy-object curr-word-ah, prev-word-ah +338 # curr-word = curr-word->next +339 curr-word-ah <- copy next-word-ah +340 curr-word <- copy tmp +341 # *curr-word->next = "-" +342 next-word-ah <- get curr-word, next +343 allocate next-word-ah +344 tmp <- lookup *next-word-ah +345 initialize-word-with tmp, "-" +346 # *curr-word->next->prev = curr-word +347 prev-word-ah <- get tmp, prev +348 copy-object curr-word-ah, prev-word-ah +349 tmp <- lookup *prev-word-ah +350 } +351 +352 fn function-body functions: (addr handle function), _word: (addr handle word), out: (addr handle line) { +353 var function-name-storage: (handle array byte) +354 var function-name-ah/ecx: (addr handle array byte) <- address function-name-storage +355 var word-ah/esi: (addr handle word) <- copy _word +356 var word/eax: (addr word) <- lookup *word-ah +357 var gap-ah/eax: (addr handle gap-buffer) <- get word, scalar-data +358 var gap/eax: (addr gap-buffer) <- lookup *gap-ah +359 gap-buffer-to-string gap, function-name-ah +360 var _function-name/eax: (addr array byte) <- lookup *function-name-ah +361 var function-name/esi: (addr array byte) <- copy _function-name +362 var curr-ah/ecx: (addr handle function) <- copy functions +363 $function-body:loop: { +364 var _curr/eax: (addr function) <- lookup *curr-ah +365 var curr/edx: (addr function) <- copy _curr +366 compare curr, 0 +367 break-if-= +368 var curr-name-ah/eax: (addr handle array byte) <- get curr, name +369 var curr-name/eax: (addr array byte) <- lookup *curr-name-ah +370 var found?/eax: boolean <- string-equal? curr-name, function-name +371 compare found?, 0 # false +372 { +373 break-if-= +374 var src/eax: (addr handle line) <- get curr, body +375 copy-object src, out +376 break $function-body:loop +377 } +378 curr-ah <- get curr, next +379 loop +380 } +381 } +382 +383 fn body-length functions: (addr handle function), function-name: (addr handle word) -> _/eax: int { +384 var body-storage: (handle line) +385 var body-ah/edi: (addr handle line) <- address body-storage +386 function-body functions, function-name, body-ah +387 var body/eax: (addr line) <- lookup *body-ah +388 var result/eax: int <- line-length body +389 return result +390 } +391 +392 fn line-length _in: (addr line) -> _/eax: int { +393 var in/esi: (addr line) <- copy _in +394 var curr-ah/ecx: (addr handle word) <- get in, data +395 var result/edi: int <- copy 0 +396 { +397 var curr/eax: (addr word) <- lookup *curr-ah +398 compare curr, 0 +399 break-if-= +400 curr-ah <- get curr, next +401 result <- increment +402 loop +403 } +404 return result +405 } +406 +407 fn populate-text-with _out: (addr handle array byte), _in: (addr array byte) { +408 var in/esi: (addr array byte) <- copy _in +409 var n/ecx: int <- length in +410 var out/edx: (addr handle array byte) <- copy _out +411 populate out, n +412 var _out-addr/eax: (addr array byte) <- lookup *out +413 var out-addr/edx: (addr array byte) <- copy _out-addr +414 var i/eax: int <- copy 0 +415 { +416 compare i, n +417 break-if->= +418 var src/esi: (addr byte) <- index in, i +419 var val/ecx: byte <- copy-byte *src +420 var dest/edi: (addr byte) <- index out-addr, i +421 copy-byte-to *dest, val +422 i <- increment +423 loop +424 } +425 } +426 +427 fn initialize-path-from-sandbox _in: (addr sandbox), _out: (addr handle call-path-element) { +428 var sandbox/esi: (addr sandbox) <- copy _in +429 var line-ah/eax: (addr handle line) <- get sandbox, data +430 var line/eax: (addr line) <- lookup *line-ah +431 var src/esi: (addr handle word) <- get line, data +432 var out-ah/edi: (addr handle call-path-element) <- copy _out +433 var out/eax: (addr call-path-element) <- lookup *out-ah +434 var dest/edi: (addr handle word) <- get out, word +435 copy-object src, dest +436 } +437 +438 fn initialize-path-from-line _line: (addr line), _out: (addr handle call-path-element) { +439 var line/eax: (addr line) <- copy _line +440 var src/esi: (addr handle word) <- get line, data +441 var out-ah/edi: (addr handle call-path-element) <- copy _out +442 var out/eax: (addr call-path-element) <- lookup *out-ah +443 var dest/edi: (addr handle word) <- get out, word +444 copy-object src, dest +445 } +446 +447 fn find-in-call-paths call-paths: (addr handle call-path), needle: (addr handle call-path-element) -> _/eax: boolean { +448 var curr-ah/esi: (addr handle call-path) <- copy call-paths +449 $find-in-call-path:loop: { +450 var curr/eax: (addr call-path) <- lookup *curr-ah +451 compare curr, 0 +452 break-if-= +453 { +454 var curr-data/eax: (addr handle call-path-element) <- get curr, data +455 var match?/eax: boolean <- call-path-element-match? curr-data, needle +456 compare match?, 0 # false +457 { +458 break-if-= +459 return 1 # true +460 } +461 } +462 curr-ah <- get curr, next +463 loop +464 } +465 return 0 # false +466 } +467 +468 fn call-path-element-match? _x: (addr handle call-path-element), _y: (addr handle call-path-element) -> _/eax: boolean { +469 var x-ah/eax: (addr handle call-path-element) <- copy _x +470 var x-a/eax: (addr call-path-element) <- lookup *x-ah +471 var x/esi: (addr call-path-element) <- copy x-a +472 var y-ah/eax: (addr handle call-path-element) <- copy _y +473 var y-a/eax: (addr call-path-element) <- lookup *y-ah +474 var y/edi: (addr call-path-element) <- copy y-a +475 compare x, y +476 { +477 break-if-!= +478 return 1 # true +479 } +480 compare x, 0 +481 { +482 break-if-!= +483 return 0 # false +484 } +485 compare y, 0 +486 { +487 break-if-!= +488 return 0 # false +489 } +490 # compare word addresses, not contents +491 var x-data-ah/ecx: (addr handle word) <- get x, word +492 var x-data-a/eax: (addr word) <- lookup *x-data-ah +493 var x-data/ecx: int <- copy x-data-a +494 var y-data-ah/eax: (addr handle word) <- get y, word +495 var y-data-a/eax: (addr word) <- lookup *y-data-ah +496 var y-data/eax: int <- copy y-data-a +497 #? print-string 0, "match? " +498 #? print-int32-hex 0, x-data +499 #? print-string 0, " vs " +500 #? print-int32-hex 0, y-data +501 #? print-string 0, "\n" +502 compare x-data, y-data +503 { +504 break-if-= +505 return 0 # false +506 } +507 var x-next/ecx: (addr handle call-path-element) <- get x, next +508 var y-next/eax: (addr handle call-path-element) <- get y, next +509 var result/eax: boolean <- call-path-element-match? x-next, y-next +510 return result +511 } +512 +513 # order is irrelevant +514 fn insert-in-call-path list: (addr handle call-path), new: (addr handle call-path-element) { +515 var new-path-storage: (handle call-path) +516 var new-path-ah/edi: (addr handle call-path) <- address new-path-storage +517 allocate new-path-ah +518 var new-path/eax: (addr call-path) <- lookup *new-path-ah +519 var next/ecx: (addr handle call-path) <- get new-path, next +520 copy-object list, next +521 var dest/ecx: (addr handle call-path-element) <- get new-path, data +522 deep-copy-call-path-element new, dest +523 copy-object new-path-ah, list +524 } +525 +526 # assumes dest is initially clear +527 fn deep-copy-call-path-element _src: (addr handle call-path-element), _dest: (addr handle call-path-element) { +528 var src/esi: (addr handle call-path-element) <- copy _src +529 # if src is null, return +530 var _src-addr/eax: (addr call-path-element) <- lookup *src +531 compare _src-addr, 0 +532 break-if-= +533 # allocate +534 var src-addr/esi: (addr call-path-element) <- copy _src-addr +535 var dest/eax: (addr handle call-path-element) <- copy _dest +536 allocate dest +537 # copy data +538 var dest-addr/eax: (addr call-path-element) <- lookup *dest +539 { +540 var dest-data-addr/ecx: (addr handle word) <- get dest-addr, word +541 var src-data-addr/eax: (addr handle word) <- get src-addr, word +542 copy-object src-data-addr, dest-data-addr +543 } +544 # recurse +545 var src-next/esi: (addr handle call-path-element) <- get src-addr, next +546 var dest-next/eax: (addr handle call-path-element) <- get dest-addr, next +547 deep-copy-call-path-element src-next, dest-next +548 } +549 +550 fn delete-in-call-path list: (addr handle call-path), needle: (addr handle call-path-element) { +551 var curr-ah/esi: (addr handle call-path) <- copy list +552 $delete-in-call-path:loop: { +553 var _curr/eax: (addr call-path) <- lookup *curr-ah +554 var curr/ecx: (addr call-path) <- copy _curr +555 compare curr, 0 +556 break-if-= +557 { +558 var curr-data/eax: (addr handle call-path-element) <- get curr, data +559 var match?/eax: boolean <- call-path-element-match? curr-data, needle +560 compare match?, 0 # false +561 { +562 break-if-= +563 var next-ah/ecx: (addr handle call-path) <- get curr, next +564 copy-object next-ah, curr-ah +565 loop $delete-in-call-path:loop +566 } +567 } +568 curr-ah <- get curr, next +569 loop +570 } +571 } +572 +573 fn increment-final-element list: (addr handle call-path-element) { +574 var final-ah/eax: (addr handle call-path-element) <- copy list +575 var final/eax: (addr call-path-element) <- lookup *final-ah +576 var val-ah/ecx: (addr handle word) <- get final, word +577 var val/eax: (addr word) <- lookup *val-ah +578 var new-ah/edx: (addr handle word) <- get val, next +579 var target/eax: (addr word) <- lookup *new-ah +580 compare target, 0 +581 break-if-= +582 copy-object new-ah, val-ah +583 } +584 +585 fn decrement-final-element list: (addr handle call-path-element) { +586 var final-ah/eax: (addr handle call-path-element) <- copy list +587 var final/eax: (addr call-path-element) <- lookup *final-ah +588 var val-ah/ecx: (addr handle word) <- get final, word +589 var val/eax: (addr word) <- lookup *val-ah +590 #? print-string 0, "replacing " +591 #? { +592 #? var foo/eax: int <- copy val +593 #? print-int32-hex 0, foo +594 #? } +595 var new-ah/edx: (addr handle word) <- get val, prev +596 var target/eax: (addr word) <- lookup *new-ah +597 compare target, 0 +598 break-if-= +599 # val = val->prev +600 #? print-string 0, " with " +601 #? { +602 #? var foo/eax: int <- copy target +603 #? print-int32-hex 0, foo +604 #? } +605 #? print-string 0, "\n" +606 copy-object new-ah, val-ah +607 } +608 +609 fn move-final-element-to-start-of-line list: (addr handle call-path-element) { +610 var final-ah/eax: (addr handle call-path-element) <- copy list +611 var final/eax: (addr call-path-element) <- lookup *final-ah +612 var val-ah/ecx: (addr handle word) <- get final, word +613 var val/eax: (addr word) <- lookup *val-ah +614 var new-ah/edx: (addr handle word) <- get val, prev +615 var target/eax: (addr word) <- lookup *new-ah +616 compare target, 0 +617 break-if-= +618 copy-object new-ah, val-ah +619 move-final-element-to-start-of-line list +620 } +621 +622 fn push-to-call-path-element list: (addr handle call-path-element), new: (addr handle word) { +623 var new-element-storage: (handle call-path-element) +624 var new-element-ah/edi: (addr handle call-path-element) <- address new-element-storage +625 allocate new-element-ah +626 var new-element/eax: (addr call-path-element) <- lookup *new-element-ah +627 # save word +628 var dest/ecx: (addr handle word) <- get new-element, word +629 copy-object new, dest +630 # save next +631 var dest2/ecx: (addr handle call-path-element) <- get new-element, next +632 copy-object list, dest2 +633 # return +634 copy-object new-element-ah, list +635 } +636 +637 fn drop-from-call-path-element _list: (addr handle call-path-element) { +638 var list-ah/esi: (addr handle call-path-element) <- copy _list +639 var list/eax: (addr call-path-element) <- lookup *list-ah +640 var next/eax: (addr handle call-path-element) <- get list, next +641 copy-object next, _list +642 } +643 +644 fn drop-nested-calls _list: (addr handle call-path-element) { +645 var list-ah/esi: (addr handle call-path-element) <- copy _list +646 var list/eax: (addr call-path-element) <- lookup *list-ah +647 var next-ah/edi: (addr handle call-path-element) <- get list, next +648 var next/eax: (addr call-path-element) <- lookup *next-ah +649 compare next, 0 +650 break-if-= +651 copy-object next-ah, _list +652 drop-nested-calls _list +653 } +654 +655 fn dump-call-path-element screen: (addr screen), _x-ah: (addr handle call-path-element) { +656 var x-ah/ecx: (addr handle call-path-element) <- copy _x-ah +657 var _x/eax: (addr call-path-element) <- lookup *x-ah +658 var x/esi: (addr call-path-element) <- copy _x +659 var word-ah/eax: (addr handle word) <- get x, word +660 var word/eax: (addr word) <- lookup *word-ah +661 print-word screen, word +662 var next-ah/ecx: (addr handle call-path-element) <- get x, next +663 var next/eax: (addr call-path-element) <- lookup *next-ah +664 compare next, 0 +665 { +666 break-if-= +667 print-string screen, " " +668 dump-call-path-element screen, next-ah +669 return +670 } +671 print-string screen, "\n" +672 } +673 +674 fn dump-call-paths screen: (addr screen), _x-ah: (addr handle call-path) { +675 var x-ah/ecx: (addr handle call-path) <- copy _x-ah +676 var x/eax: (addr call-path) <- lookup *x-ah +677 compare x, 0 +678 break-if-= +679 var src/ecx: (addr handle call-path-element) <- get x, data +680 dump-call-path-element screen, src +681 var next-ah/ecx: (addr handle call-path) <- get x, next +682 var next/eax: (addr call-path) <- lookup *next-ah +683 compare next, 0 +684 { +685 break-if-= +686 dump-call-paths screen, next-ah +687 } +688 } diff --git a/html/apps/tile/environment.mu.html b/html/apps/tile/environment.mu.html index e11ef11a..a2080d59 100644 --- a/html/apps/tile/environment.mu.html +++ b/html/apps/tile/environment.mu.html @@ -101,7 +101,7 @@ if ('onhashchange' in window) { 41 var screen/edi: (addr screen) <- copy _screen 42 var dest/edx: (addr int) <- get env, code-separator-col 43 var tmp/eax: int <- copy *dest - 44 clear-canvas env + 44 clear-canvas env 45 tmp <- add 2 # repl-margin-left 46 move-cursor screen, 3, tmp # input-row 47 } @@ -131,7 +131,7 @@ if ('onhashchange' in window) { 71 { 72 break-if-= 73 #? print-string 0, "processing sandbox rename\n" - 74 process-sandbox-rename sandbox, key + 74 process-sandbox-rename sandbox, key 75 break $process:body 76 } 77 var define-function-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-function @@ -141,7 +141,7 @@ if ('onhashchange' in window) { 81 break-if-= 82 #? print-string 0, "processing function definition\n" 83 var functions/ecx: (addr handle function) <- get self, functions - 84 process-sandbox-define sandbox, functions, key + 84 process-sandbox-define sandbox, functions, key 85 break $process:body 86 } 87 #? print-string 0, "processing sandbox\n" @@ -307,9 +307,9 @@ if ('onhashchange' in window) { 247 var callee-h: (handle function) 248 var callee-ah/edx: (addr handle function) <- address callee-h 249 var functions/ebx: (addr handle function) <- get self, functions - 250 callee functions, next-word, callee-ah - 251 var callee/eax: (addr function) <- lookup *callee-ah - 252 var callee-body-ah/eax: (addr handle line) <- get callee, body + 250 callee functions, next-word, callee-ah + 251 var callee/eax: (addr function) <- lookup *callee-ah + 252 var callee-body-ah/eax: (addr handle line) <- get callee, body 253 var callee-body/eax: (addr line) <- lookup *callee-body-ah 254 var callee-body-first-word/edx: (addr handle word) <- get callee-body, data 255 push-to-call-path-element cursor-call-path, callee-body-first-word @@ -329,1404 +329,1338 @@ if ('onhashchange' in window) { 269 { 270 break-if-!= 271 # toggle display of subsidiary stack - 272 toggle-cursor-word sandbox + 272 toggle-cursor-word sandbox 273 break $process-sandbox:body 274 } - 275 # word-based motions - 276 compare key, 2 # ctrl-b - 277 $process-sandbox:prev-word: { - 278 break-if-!= - 279 # jump to previous word at same level - 280 var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev - 281 var prev-word/eax: (addr word) <- lookup *prev-word-ah - 282 { - 283 compare prev-word, 0 - 284 break-if-= - 285 cursor-to-end prev-word - 286 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - 287 decrement-final-element cursor-call-path - 288 break $process-sandbox:body - 289 } - 290 # if previous word doesn't exist, try to bump up one level - 291 { - 292 var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path - 293 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - 294 var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next - 295 var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah - 296 compare caller-cursor-element, 0 - 297 break-if-= - 298 # check if previous word exists in caller - 299 var caller-word-ah/eax: (addr handle word) <- get caller-cursor-element, word - 300 var caller-word/eax: (addr word) <- lookup *caller-word-ah - 301 var word-before-caller-ah/eax: (addr handle word) <- get caller-word, prev - 302 var word-before-caller/eax: (addr word) <- lookup *word-before-caller-ah - 303 compare word-before-caller, 0 + 275 compare key, 0xc # ctrl-l + 276 $process-sandbox:new-line: { + 277 break-if-!= + 278 # new line in sandbox + 279 append-line sandbox + 280 break $process-sandbox:body + 281 } + 282 # word-based motions + 283 compare key, 2 # ctrl-b + 284 $process-sandbox:prev-word: { + 285 break-if-!= + 286 # jump to previous word at same level + 287 var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev + 288 var prev-word/eax: (addr word) <- lookup *prev-word-ah + 289 { + 290 compare prev-word, 0 + 291 break-if-= + 292 cursor-to-end prev-word + 293 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 294 decrement-final-element cursor-call-path + 295 break $process-sandbox:body + 296 } + 297 # if previous word doesn't exist, try to bump up one level + 298 { + 299 var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path + 300 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah + 301 var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next + 302 var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah + 303 compare caller-cursor-element, 0 304 break-if-= - 305 # if so jump to it - 306 drop-from-call-path-element cursor-call-path-ah - 307 decrement-final-element cursor-call-path-ah - 308 break $process-sandbox:body - 309 } - 310 } - 311 compare key, 6 # ctrl-f - 312 $process-sandbox:next-word: { - 313 break-if-!= - 314 #? print-string 0, "AA\n" - 315 # jump to previous word at same level - 316 var next-word-ah/edx: (addr handle word) <- get cursor-word, next - 317 var next-word/eax: (addr word) <- lookup *next-word-ah - 318 { - 319 compare next-word, 0 - 320 break-if-= - 321 #? print-string 0, "BB\n" - 322 cursor-to-end next-word - 323 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - 324 increment-final-element cursor-call-path - 325 break $process-sandbox:body - 326 } - 327 # if next word doesn't exist, try to bump up one level - 328 #? print-string 0, "CC\n" - 329 var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path - 330 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - 331 var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next - 332 var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah - 333 compare caller-cursor-element, 0 - 334 break-if-= - 335 #? print-string 0, "DD\n" - 336 copy-object caller-cursor-element-ah, cursor-call-path-ah - 337 break $process-sandbox:body - 338 } - 339 # line-based motions - 340 compare key, 1 # ctrl-a - 341 $process-sandbox:start-of-line: { - 342 break-if-!= - 343 # move cursor up past all calls and to start of line - 344 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - 345 drop-nested-calls cursor-call-path-ah - 346 move-final-element-to-start-of-line cursor-call-path-ah - 347 # move cursor to start of initial word - 348 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - 349 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word - 350 var cursor-word/eax: (addr word) <- lookup *cursor-word-ah - 351 cursor-to-start cursor-word - 352 # this works as long as the first word isn't expanded - 353 # but we don't expect to see zero-arg functions first-up - 354 break $process-sandbox:body - 355 } - 356 compare key, 5 # ctrl-e - 357 $process-sandbox:end-of-line: { - 358 break-if-!= - 359 # move cursor to final word of sandbox - 360 var cursor-call-path-ah/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path - 361 initialize-path-from-sandbox sandbox, cursor-call-path-ah - 362 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - 363 var dest/eax: (addr handle word) <- get cursor-call-path, word - 364 final-word dest, dest - 365 # move cursor to end of final word - 366 var cursor-word/eax: (addr word) <- lookup *cursor-word-ah - 367 cursor-to-end cursor-word - 368 # this works because expanded words lie to the right of their bodies - 369 # so the final word is always guaranteed to be at the top-level - 370 break $process-sandbox:body - 371 } - 372 compare key, 0x15 # ctrl-u - 373 $process-sandbox:clear-line: { - 374 break-if-!= - 375 # clear line in sandbox - 376 initialize-sandbox sandbox + 305 # check if previous word exists in caller + 306 var caller-word-ah/eax: (addr handle word) <- get caller-cursor-element, word + 307 var caller-word/eax: (addr word) <- lookup *caller-word-ah + 308 var word-before-caller-ah/eax: (addr handle word) <- get caller-word, prev + 309 var word-before-caller/eax: (addr word) <- lookup *word-before-caller-ah + 310 compare word-before-caller, 0 + 311 break-if-= + 312 # if so jump to it + 313 drop-from-call-path-element cursor-call-path-ah + 314 decrement-final-element cursor-call-path-ah + 315 break $process-sandbox:body + 316 } + 317 } + 318 compare key, 6 # ctrl-f + 319 $process-sandbox:next-word: { + 320 break-if-!= + 321 #? print-string 0, "AA\n" + 322 # jump to previous word at same level + 323 var next-word-ah/edx: (addr handle word) <- get cursor-word, next + 324 var next-word/eax: (addr word) <- lookup *next-word-ah + 325 { + 326 compare next-word, 0 + 327 break-if-= + 328 #? print-string 0, "BB\n" + 329 cursor-to-end next-word + 330 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 331 increment-final-element cursor-call-path + 332 break $process-sandbox:body + 333 } + 334 # if next word doesn't exist, try to bump up one level + 335 #? print-string 0, "CC\n" + 336 var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path + 337 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah + 338 var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next + 339 var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah + 340 compare caller-cursor-element, 0 + 341 break-if-= + 342 #? print-string 0, "DD\n" + 343 copy-object caller-cursor-element-ah, cursor-call-path-ah + 344 break $process-sandbox:body + 345 } + 346 # line-based motions + 347 compare key, 1 # ctrl-a + 348 $process-sandbox:start-of-line: { + 349 break-if-!= + 350 # move cursor up past all calls and to start of line + 351 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 352 drop-nested-calls cursor-call-path-ah + 353 move-final-element-to-start-of-line cursor-call-path-ah + 354 # move cursor to start of initial word + 355 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah + 356 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word + 357 var cursor-word/eax: (addr word) <- lookup *cursor-word-ah + 358 cursor-to-start cursor-word + 359 # this works as long as the first word isn't expanded + 360 # but we don't expect to see zero-arg functions first-up + 361 break $process-sandbox:body + 362 } + 363 compare key, 5 # ctrl-e + 364 $process-sandbox:end-of-line: { + 365 break-if-!= + 366 # move cursor to final word of sandbox + 367 var cursor-call-path-ah/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path + 368 initialize-path-from-sandbox sandbox, cursor-call-path-ah + 369 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah + 370 var dest/eax: (addr handle word) <- get cursor-call-path, word + 371 final-word dest, dest + 372 # move cursor to end of final word + 373 var cursor-word/eax: (addr word) <- lookup *cursor-word-ah + 374 cursor-to-end cursor-word + 375 # this works because expanded words lie to the right of their bodies + 376 # so the final word is always guaranteed to be at the top-level 377 break $process-sandbox:body 378 } - 379 # if cursor is within a call, disable editing hotkeys below - 380 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - 381 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - 382 var next-cursor-element-ah/eax: (addr handle call-path-element) <- get cursor-call-path, next - 383 var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah - 384 compare next-cursor-element, 0 - 385 break-if-!= $process-sandbox:body - 386 # - remaining keys only work at the top row outside any function calls - 387 compare key, 0x7f # del (backspace on Macs) - 388 $process-sandbox:backspace: { - 389 break-if-!= - 390 # if not at start of some word, delete grapheme before cursor within current word - 391 var at-start?/eax: boolean <- cursor-at-start? cursor-word - 392 compare at-start?, 0 # false - 393 { - 394 break-if-!= - 395 delete-before-cursor cursor-word - 396 break $process-sandbox:body - 397 } - 398 # otherwise delete current word and move to end of prev word - 399 var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev - 400 var prev-word/eax: (addr word) <- lookup *prev-word-ah - 401 { - 402 compare prev-word, 0 - 403 break-if-= - 404 cursor-to-end prev-word - 405 delete-next prev-word - 406 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - 407 decrement-final-element cursor-call-path - 408 } - 409 break $process-sandbox:body - 410 } - 411 compare key, 0x20 # space - 412 $process-sandbox:space: { - 413 break-if-!= - 414 #? print-string 0, "space\n" - 415 # if cursor is at start of word, insert word before - 416 { - 417 var at-start?/eax: boolean <- cursor-at-start? cursor-word - 418 compare at-start?, 0 # false - 419 break-if-= - 420 var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev - 421 append-word prev-word-ah - 422 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - 423 decrement-final-element cursor-call-path - 424 break $process-sandbox:body - 425 } - 426 # if start of word is quote and grapheme before cursor is not, just insert it as usual - 427 # TODO: support string escaping - 428 { - 429 var first-grapheme/eax: grapheme <- first-grapheme cursor-word - 430 compare first-grapheme, 0x22 # double quote - 431 break-if-!= - 432 var final-grapheme/eax: grapheme <- grapheme-before-cursor cursor-word - 433 compare final-grapheme, 0x22 # double quote - 434 break-if-= - 435 break $process-sandbox:space - 436 } - 437 # if start of word is '[' and grapheme before cursor is not ']', just insert it as usual - 438 # TODO: support nested arrays - 439 { - 440 var first-grapheme/eax: grapheme <- first-grapheme cursor-word - 441 compare first-grapheme, 0x5b # '[' - 442 break-if-!= - 443 var final-grapheme/eax: grapheme <- grapheme-before-cursor cursor-word - 444 compare final-grapheme, 0x5d # ']' - 445 break-if-= - 446 break $process-sandbox:space - 447 } - 448 # otherwise insert word after and move cursor to it for the next key - 449 # (but we'll continue to track the current cursor-word for the rest of this function) - 450 append-word cursor-word-ah - 451 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - 452 increment-final-element cursor-call-path - 453 # if cursor is at end of word, that's all - 454 var at-end?/eax: boolean <- cursor-at-end? cursor-word - 455 compare at-end?, 0 # false - 456 break-if-!= $process-sandbox:body - 457 # otherwise we're in the middle of a word - 458 # move everything after cursor to the (just created) next word - 459 var next-word-ah/eax: (addr handle word) <- get cursor-word, next - 460 var _next-word/eax: (addr word) <- lookup *next-word-ah - 461 var next-word/ebx: (addr word) <- copy _next-word - 462 { - 463 var at-end?/eax: boolean <- cursor-at-end? cursor-word - 464 compare at-end?, 0 # false - 465 break-if-!= - 466 var g/eax: grapheme <- pop-after-cursor cursor-word - 467 add-grapheme-to-word next-word, g - 468 loop - 469 } - 470 cursor-to-start next-word - 471 break $process-sandbox:body - 472 } - 473 compare key, 0xe # ctrl-n - 474 $process:rename-word: { - 475 break-if-!= - 476 # TODO: ensure current word is not a function - 477 # rename word at cursor - 478 var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-cursor-word - 479 allocate new-name-ah - 480 var new-name/eax: (addr word) <- lookup *new-name-ah - 481 initialize-word new-name - 482 break $process-sandbox:body - 483 } - 484 compare key, 4 # ctrl-d - 485 $process:define-function: { - 486 break-if-!= - 487 # define function out of line at cursor - 488 var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-function - 489 allocate new-name-ah - 490 var new-name/eax: (addr word) <- lookup *new-name-ah - 491 initialize-word new-name - 492 break $process-sandbox:body - 493 } - 494 # otherwise insert key within current word - 495 var g/edx: grapheme <- copy key - 496 var print?/eax: boolean <- real-grapheme? key - 497 $process-sandbox:real-grapheme: { - 498 compare print?, 0 # false - 499 break-if-= - 500 add-grapheme-to-word cursor-word, g - 501 break $process-sandbox:body - 502 } - 503 # silently ignore other hotkeys - 504 } - 505 } - 506 - 507 # collect new name in partial-name-for-cursor-word, and then rename the word - 508 # at cursor to it - 509 # Precondition: cursor-call-path is a singleton (not within a call) - 510 fn process-sandbox-rename _sandbox: (addr sandbox), key: grapheme { - 511 $process-sandbox-rename:body: { - 512 var sandbox/esi: (addr sandbox) <- copy _sandbox - 513 var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-cursor-word - 514 # if 'esc' pressed, cancel rename - 515 compare key, 0x1b # esc - 516 $process-sandbox-rename:cancel: { - 517 break-if-!= - 518 var empty: (handle word) - 519 copy-handle empty, new-name-ah - 520 break $process-sandbox-rename:body - 521 } - 522 # if 'enter' pressed, perform rename - 523 compare key, 0xa # enter - 524 $process-sandbox-rename:commit: { - 525 break-if-!= - 526 #? print-string 0, "rename\n" - 527 # new line - 528 var new-line-h: (handle line) - 529 var new-line-ah/eax: (addr handle line) <- address new-line-h - 530 allocate new-line-ah - 531 var new-line/eax: (addr line) <- lookup *new-line-ah - 532 initialize-line new-line - 533 var new-line-word-ah/ecx: (addr handle word) <- get new-line, data - 534 { - 535 # move word at cursor to new line - 536 var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - 537 var cursor/eax: (addr call-path-element) <- lookup *cursor-ah - 538 var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word - 539 #? print-string 0, "cursor before at word " - 540 #? { - 541 #? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah - 542 #? print-word 0, cursor-word - 543 #? print-string 0, "\n" - 544 #? } - 545 move-word-contents word-at-cursor-ah, new-line-word-ah - 546 # copy name to word at cursor - 547 copy-word-contents-before-cursor new-name-ah, word-at-cursor-ah - 548 #? print-string 0, "cursor after at word " - 549 #? { - 550 #? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah - 551 #? print-word 0, cursor-word - 552 #? print-string 0, "\n" - 553 #? var foo/eax: int <- copy cursor-word - 554 #? print-int32-hex 0, foo - 555 #? print-string 0, "\n" - 556 #? } - 557 #? print-string 0, "new name word " - 558 #? { - 559 #? var new-name/eax: (addr word) <- lookup *new-name-ah - 560 #? print-word 0, new-name - 561 #? print-string 0, "\n" - 562 #? var foo/eax: int <- copy new-name - 563 #? print-int32-hex 0, foo - 564 #? print-string 0, "\n" - 565 #? } - 566 } - 567 # prepend '=' to name - 568 { - 569 var new-name/eax: (addr word) <- lookup *new-name-ah - 570 cursor-to-start new-name - 571 add-grapheme-to-word new-name, 0x3d # '=' - 572 } - 573 # append name to new line - 574 chain-words new-line-word-ah, new-name-ah - 575 # new-line->next = sandbox->data - 576 var new-line-next/ecx: (addr handle line) <- get new-line, next - 577 var sandbox-slot/edx: (addr handle line) <- get sandbox, data - 578 copy-object sandbox-slot, new-line-next - 579 # sandbox->data = new-line - 580 copy-handle new-line-h, sandbox-slot - 581 # clear partial-name-for-cursor-word - 582 var empty: (handle word) - 583 copy-handle empty, new-name-ah - 584 #? # XXX - 585 #? var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - 586 #? var cursor/eax: (addr call-path-element) <- lookup *cursor-ah - 587 #? var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word - 588 #? print-string 0, "cursor after rename: " - 589 #? { - 590 #? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah - 591 #? print-word 0, cursor-word - 592 #? print-string 0, " -- " - 593 #? var foo/eax: int <- copy cursor-word - 594 #? print-int32-hex 0, foo - 595 #? print-string 0, "\n" - 596 #? } - 597 break $process-sandbox-rename:body - 598 } - 599 # - 600 compare key, 0x7f # del (backspace on Macs) - 601 $process-sandbox-rename:backspace: { - 602 break-if-!= - 603 # if not at start, delete grapheme before cursor - 604 var new-name/eax: (addr word) <- lookup *new-name-ah - 605 var at-start?/eax: boolean <- cursor-at-start? new-name - 606 compare at-start?, 0 # false - 607 { - 608 break-if-!= - 609 var new-name/eax: (addr word) <- lookup *new-name-ah - 610 delete-before-cursor new-name - 611 } - 612 break $process-sandbox-rename:body - 613 } - 614 # otherwise insert key within current word - 615 var print?/eax: boolean <- real-grapheme? key - 616 $process-sandbox-rename:real-grapheme: { - 617 compare print?, 0 # false - 618 break-if-= - 619 var new-name/eax: (addr word) <- lookup *new-name-ah - 620 add-grapheme-to-word new-name, key - 621 break $process-sandbox-rename:body - 622 } - 623 # silently ignore other hotkeys - 624 } - 625 } - 626 - 627 # collect new name in partial-name-for-function, and then define the last line - 628 # of the sandbox to be a new function with that name. Replace the last line - 629 # with a call to the appropriate function. - 630 # Precondition: cursor-call-path is a singleton (not within a call) - 631 fn process-sandbox-define _sandbox: (addr sandbox), functions: (addr handle function), key: grapheme { - 632 $process-sandbox-define:body: { - 633 var sandbox/esi: (addr sandbox) <- copy _sandbox - 634 var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-function - 635 # if 'esc' pressed, cancel define - 636 compare key, 0x1b # esc - 637 $process-sandbox-define:cancel: { - 638 break-if-!= - 639 var empty: (handle word) - 640 copy-handle empty, new-name-ah - 641 break $process-sandbox-define:body - 642 } - 643 # if 'enter' pressed, perform define - 644 compare key, 0xa # enter - 645 $process-sandbox-define:commit: { - 646 break-if-!= - 647 #? print-string 0, "define\n" - 648 # create new function - 649 var new-function: (handle function) - 650 var new-function-ah/ecx: (addr handle function) <- address new-function - 651 allocate new-function-ah - 652 var _new-function/eax: (addr function) <- lookup *new-function-ah - 653 var new-function/ebx: (addr function) <- copy _new-function - 654 var dest/edx: (addr handle function) <- get new-function, next - 655 copy-object functions, dest - 656 copy-object new-function-ah, functions - 657 # set function name to new-name - 658 var new-name/eax: (addr word) <- lookup *new-name-ah - 659 var dest/edx: (addr handle array byte) <- get new-function, name - 660 word-to-string new-name, dest - 661 # move final line to body - 662 var body-ah/eax: (addr handle line) <- get new-function, body - 663 allocate body-ah - 664 var body/eax: (addr line) <- lookup *body-ah - 665 var body-contents/ecx: (addr handle word) <- get body, data - 666 var final-line-storage: (handle line) - 667 var final-line-ah/eax: (addr handle line) <- address final-line-storage - 668 final-line sandbox, final-line-ah - 669 var final-line/eax: (addr line) <- lookup *final-line-ah - 670 var final-line-contents/eax: (addr handle word) <- get final-line, data - 671 copy-object final-line-contents, body-contents - 672 # - 673 copy-unbound-words-to-args functions - 674 # - 675 var empty-word: (handle word) - 676 copy-handle empty-word, final-line-contents - 677 construct-call functions, final-line-contents - 678 # clear partial-name-for-function - 679 var empty-word: (handle word) - 680 copy-handle empty-word, new-name-ah - 681 # update cursor - 682 var final-line/eax: (addr line) <- lookup final-line-storage - 683 var cursor-call-path-ah/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path - 684 allocate cursor-call-path-ah # leak - 685 initialize-path-from-line final-line, cursor-call-path-ah - 686 break $process-sandbox-define:body - 687 } - 688 # - 689 compare key, 0x7f # del (backspace on Macs) - 690 $process-sandbox-define:backspace: { - 691 break-if-!= - 692 # if not at start, delete grapheme before cursor - 693 var new-name/eax: (addr word) <- lookup *new-name-ah - 694 var at-start?/eax: boolean <- cursor-at-start? new-name - 695 compare at-start?, 0 # false - 696 { - 697 break-if-!= - 698 var new-name/eax: (addr word) <- lookup *new-name-ah - 699 delete-before-cursor new-name - 700 } - 701 break $process-sandbox-define:body - 702 } - 703 # otherwise insert key within current word - 704 var print?/eax: boolean <- real-grapheme? key - 705 $process-sandbox-define:real-grapheme: { - 706 compare print?, 0 # false - 707 break-if-= - 708 var new-name/eax: (addr word) <- lookup *new-name-ah - 709 add-grapheme-to-word new-name, key - 710 break $process-sandbox-define:body - 711 } - 712 # silently ignore other hotkeys - 713 } - 714 } - 715 - 716 # extract from the body of the first function in 'functions' all words that - 717 # aren't defined in the rest of 'functions'. Prepend them in reverse order. - 718 # Assumes function body is a single line for now. - 719 fn copy-unbound-words-to-args _functions: (addr handle function) { - 720 # target - 721 var target-ah/eax: (addr handle function) <- copy _functions - 722 var _target/eax: (addr function) <- lookup *target-ah - 723 var target/esi: (addr function) <- copy _target - 724 var dest-ah/edi: (addr handle word) <- get target, args - 725 # next - 726 var functions-ah/edx: (addr handle function) <- get target, next - 727 # src - 728 var line-ah/eax: (addr handle line) <- get target, body - 729 var line/eax: (addr line) <- lookup *line-ah - 730 var curr-ah/eax: (addr handle word) <- get line, data - 731 var curr/eax: (addr word) <- lookup *curr-ah - 732 { - 733 compare curr, 0 - 734 break-if-= - 735 $copy-unbound-words-to-args:loop-iter: { - 736 # is it a number? - 737 { - 738 var is-int?/eax: boolean <- word-is-decimal-integer? curr - 739 compare is-int?, 0 # false - 740 break-if-!= $copy-unbound-words-to-args:loop-iter - 741 } - 742 # is it a pre-existing function? - 743 var bound?/ebx: boolean <- bound-function? curr, functions-ah - 744 compare bound?, 0 # false - 745 break-if-!= - 746 # is it already bound as an arg? - 747 var dup?/ebx: boolean <- arg-exists? _functions, curr # _functions = target-ah - 748 compare dup?, 0 # false - 749 break-if-!= $copy-unbound-words-to-args:loop-iter - 750 # push copy of curr before dest-ah - 751 var rest-h: (handle word) - 752 var rest-ah/ecx: (addr handle word) <- address rest-h - 753 copy-object dest-ah, rest-ah - 754 copy-word curr, dest-ah - 755 chain-words dest-ah, rest-ah - 756 } - 757 var next-ah/ecx: (addr handle word) <- get curr, next - 758 curr <- lookup *next-ah - 759 loop - 760 } - 761 } - 762 - 763 fn bound-function? w: (addr word), functions-ah: (addr handle function) -> _/ebx: boolean { - 764 var result/ebx: boolean <- copy 1 # true - 765 { - 766 # if w == "+" return true - 767 var subresult/eax: boolean <- word-equal? w, "+" - 768 compare subresult, 0 # false - 769 break-if-!= - 770 # if w == "-" return true - 771 subresult <- word-equal? w, "-" - 772 compare subresult, 0 # false - 773 break-if-!= - 774 # if w == "*" return true - 775 subresult <- word-equal? w, "*" + 379 compare key, 0x15 # ctrl-u + 380 $process-sandbox:clear-line: { + 381 break-if-!= + 382 # clear line in sandbox + 383 initialize-sandbox sandbox + 384 break $process-sandbox:body + 385 } + 386 # if cursor is within a call, disable editing hotkeys below + 387 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 388 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah + 389 var next-cursor-element-ah/eax: (addr handle call-path-element) <- get cursor-call-path, next + 390 var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah + 391 compare next-cursor-element, 0 + 392 break-if-!= $process-sandbox:body + 393 # - remaining keys only work at the top row outside any function calls + 394 compare key, 0x7f # del (backspace on Macs) + 395 $process-sandbox:backspace: { + 396 break-if-!= + 397 # if not at start of some word, delete grapheme before cursor within current word + 398 var at-start?/eax: boolean <- cursor-at-start? cursor-word + 399 compare at-start?, 0 # false + 400 { + 401 break-if-!= + 402 delete-before-cursor cursor-word + 403 break $process-sandbox:body + 404 } + 405 # otherwise delete current word and move to end of prev word + 406 var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev + 407 var prev-word/eax: (addr word) <- lookup *prev-word-ah + 408 { + 409 compare prev-word, 0 + 410 break-if-= + 411 cursor-to-end prev-word + 412 delete-next prev-word + 413 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 414 decrement-final-element cursor-call-path + 415 } + 416 break $process-sandbox:body + 417 } + 418 compare key, 0x20 # space + 419 $process-sandbox:space: { + 420 break-if-!= + 421 #? print-string 0, "space\n" + 422 # if cursor is at start of word, insert word before + 423 { + 424 var at-start?/eax: boolean <- cursor-at-start? cursor-word + 425 compare at-start?, 0 # false + 426 break-if-= + 427 var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev + 428 append-word prev-word-ah + 429 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 430 decrement-final-element cursor-call-path + 431 break $process-sandbox:body + 432 } + 433 # if start of word is quote and grapheme before cursor is not, just insert it as usual + 434 # TODO: support string escaping + 435 { + 436 var first-grapheme/eax: grapheme <- first-grapheme cursor-word + 437 compare first-grapheme, 0x22 # double quote + 438 break-if-!= + 439 var final-grapheme/eax: grapheme <- grapheme-before-cursor cursor-word + 440 compare final-grapheme, 0x22 # double quote + 441 break-if-= + 442 break $process-sandbox:space + 443 } + 444 # if start of word is '[' and grapheme before cursor is not ']', just insert it as usual + 445 # TODO: support nested arrays + 446 { + 447 var first-grapheme/eax: grapheme <- first-grapheme cursor-word + 448 compare first-grapheme, 0x5b # '[' + 449 break-if-!= + 450 var final-grapheme/eax: grapheme <- grapheme-before-cursor cursor-word + 451 compare final-grapheme, 0x5d # ']' + 452 break-if-= + 453 break $process-sandbox:space + 454 } + 455 # otherwise insert word after and move cursor to it for the next key + 456 # (but we'll continue to track the current cursor-word for the rest of this function) + 457 append-word cursor-word-ah + 458 var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 459 increment-final-element cursor-call-path + 460 # if cursor is at end of word, that's all + 461 var at-end?/eax: boolean <- cursor-at-end? cursor-word + 462 compare at-end?, 0 # false + 463 break-if-!= $process-sandbox:body + 464 # otherwise we're in the middle of a word + 465 # move everything after cursor to the (just created) next word + 466 var next-word-ah/eax: (addr handle word) <- get cursor-word, next + 467 var _next-word/eax: (addr word) <- lookup *next-word-ah + 468 var next-word/ebx: (addr word) <- copy _next-word + 469 { + 470 var at-end?/eax: boolean <- cursor-at-end? cursor-word + 471 compare at-end?, 0 # false + 472 break-if-!= + 473 var g/eax: grapheme <- pop-after-cursor cursor-word + 474 add-grapheme-to-word next-word, g + 475 loop + 476 } + 477 cursor-to-start next-word + 478 break $process-sandbox:body + 479 } + 480 compare key, 0xe # ctrl-n + 481 $process:rename-word: { + 482 break-if-!= + 483 # TODO: ensure current word is not a function + 484 # rename word at cursor + 485 var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-cursor-word + 486 allocate new-name-ah + 487 var new-name/eax: (addr word) <- lookup *new-name-ah + 488 initialize-word new-name + 489 break $process-sandbox:body + 490 } + 491 compare key, 4 # ctrl-d + 492 $process:define-function: { + 493 break-if-!= + 494 # define function out of line at cursor + 495 var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-function + 496 allocate new-name-ah + 497 var new-name/eax: (addr word) <- lookup *new-name-ah + 498 initialize-word new-name + 499 break $process-sandbox:body + 500 } + 501 # otherwise insert key within current word + 502 var g/edx: grapheme <- copy key + 503 var print?/eax: boolean <- real-grapheme? key + 504 $process-sandbox:real-grapheme: { + 505 compare print?, 0 # false + 506 break-if-= + 507 add-grapheme-to-word cursor-word, g + 508 break $process-sandbox:body + 509 } + 510 # silently ignore other hotkeys + 511 } + 512 } + 513 + 514 # collect new name in partial-name-for-cursor-word, and then rename the word + 515 # at cursor to it + 516 # Precondition: cursor-call-path is a singleton (not within a call) + 517 fn process-sandbox-rename _sandbox: (addr sandbox), key: grapheme { + 518 $process-sandbox-rename:body: { + 519 var sandbox/esi: (addr sandbox) <- copy _sandbox + 520 var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-cursor-word + 521 # if 'esc' pressed, cancel rename + 522 compare key, 0x1b # esc + 523 $process-sandbox-rename:cancel: { + 524 break-if-!= + 525 var empty: (handle word) + 526 copy-handle empty, new-name-ah + 527 break $process-sandbox-rename:body + 528 } + 529 # if 'enter' pressed, perform rename + 530 compare key, 0xa # enter + 531 $process-sandbox-rename:commit: { + 532 break-if-!= + 533 #? print-string 0, "rename\n" + 534 # new line + 535 var new-line-h: (handle line) + 536 var new-line-ah/eax: (addr handle line) <- address new-line-h + 537 allocate new-line-ah + 538 var new-line/eax: (addr line) <- lookup *new-line-ah + 539 initialize-line new-line + 540 var new-line-word-ah/ecx: (addr handle word) <- get new-line, data + 541 { + 542 # move word at cursor to new line + 543 var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 544 var cursor/eax: (addr call-path-element) <- lookup *cursor-ah + 545 var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word + 546 #? print-string 0, "cursor before at word " + 547 #? { + 548 #? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah + 549 #? print-word 0, cursor-word + 550 #? print-string 0, "\n" + 551 #? } + 552 move-word-contents word-at-cursor-ah, new-line-word-ah + 553 # copy name to word at cursor + 554 copy-word-contents-before-cursor new-name-ah, word-at-cursor-ah + 555 #? print-string 0, "cursor after at word " + 556 #? { + 557 #? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah + 558 #? print-word 0, cursor-word + 559 #? print-string 0, "\n" + 560 #? var foo/eax: int <- copy cursor-word + 561 #? print-int32-hex 0, foo + 562 #? print-string 0, "\n" + 563 #? } + 564 #? print-string 0, "new name word " + 565 #? { + 566 #? var new-name/eax: (addr word) <- lookup *new-name-ah + 567 #? print-word 0, new-name + 568 #? print-string 0, "\n" + 569 #? var foo/eax: int <- copy new-name + 570 #? print-int32-hex 0, foo + 571 #? print-string 0, "\n" + 572 #? } + 573 } + 574 # prepend '=' to name + 575 { + 576 var new-name/eax: (addr word) <- lookup *new-name-ah + 577 cursor-to-start new-name + 578 add-grapheme-to-word new-name, 0x3d # '=' + 579 } + 580 # append name to new line + 581 chain-words new-line-word-ah, new-name-ah + 582 # new-line->next = sandbox->data + 583 var new-line-next/ecx: (addr handle line) <- get new-line, next + 584 var sandbox-slot/edx: (addr handle line) <- get sandbox, data + 585 copy-object sandbox-slot, new-line-next + 586 # sandbox->data = new-line + 587 copy-handle new-line-h, sandbox-slot + 588 # clear partial-name-for-cursor-word + 589 var empty: (handle word) + 590 copy-handle empty, new-name-ah + 591 #? # XXX + 592 #? var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 593 #? var cursor/eax: (addr call-path-element) <- lookup *cursor-ah + 594 #? var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word + 595 #? print-string 0, "cursor after rename: " + 596 #? { + 597 #? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah + 598 #? print-word 0, cursor-word + 599 #? print-string 0, " -- " + 600 #? var foo/eax: int <- copy cursor-word + 601 #? print-int32-hex 0, foo + 602 #? print-string 0, "\n" + 603 #? } + 604 break $process-sandbox-rename:body + 605 } + 606 # + 607 compare key, 0x7f # del (backspace on Macs) + 608 $process-sandbox-rename:backspace: { + 609 break-if-!= + 610 # if not at start, delete grapheme before cursor + 611 var new-name/eax: (addr word) <- lookup *new-name-ah + 612 var at-start?/eax: boolean <- cursor-at-start? new-name + 613 compare at-start?, 0 # false + 614 { + 615 break-if-!= + 616 var new-name/eax: (addr word) <- lookup *new-name-ah + 617 delete-before-cursor new-name + 618 } + 619 break $process-sandbox-rename:body + 620 } + 621 # otherwise insert key within current word + 622 var print?/eax: boolean <- real-grapheme? key + 623 $process-sandbox-rename:real-grapheme: { + 624 compare print?, 0 # false + 625 break-if-= + 626 var new-name/eax: (addr word) <- lookup *new-name-ah + 627 add-grapheme-to-word new-name, key + 628 break $process-sandbox-rename:body + 629 } + 630 # silently ignore other hotkeys + 631 } + 632 } + 633 + 634 # collect new name in partial-name-for-function, and then define the last line + 635 # of the sandbox to be a new function with that name. Replace the last line + 636 # with a call to the appropriate function. + 637 # Precondition: cursor-call-path is a singleton (not within a call) + 638 fn process-sandbox-define _sandbox: (addr sandbox), functions: (addr handle function), key: grapheme { + 639 $process-sandbox-define:body: { + 640 var sandbox/esi: (addr sandbox) <- copy _sandbox + 641 var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-function + 642 # if 'esc' pressed, cancel define + 643 compare key, 0x1b # esc + 644 $process-sandbox-define:cancel: { + 645 break-if-!= + 646 var empty: (handle word) + 647 copy-handle empty, new-name-ah + 648 break $process-sandbox-define:body + 649 } + 650 # if 'enter' pressed, perform define + 651 compare key, 0xa # enter + 652 $process-sandbox-define:commit: { + 653 break-if-!= + 654 #? print-string 0, "define\n" + 655 # create new function + 656 var new-function: (handle function) + 657 var new-function-ah/ecx: (addr handle function) <- address new-function + 658 allocate new-function-ah + 659 var _new-function/eax: (addr function) <- lookup *new-function-ah + 660 var new-function/ebx: (addr function) <- copy _new-function + 661 var dest/edx: (addr handle function) <- get new-function, next + 662 copy-object functions, dest + 663 copy-object new-function-ah, functions + 664 # set function name to new-name + 665 var new-name/eax: (addr word) <- lookup *new-name-ah + 666 var dest/edx: (addr handle array byte) <- get new-function, name + 667 word-to-string new-name, dest + 668 # move final line to body + 669 var body-ah/eax: (addr handle line) <- get new-function, body + 670 allocate body-ah + 671 var body/eax: (addr line) <- lookup *body-ah + 672 var body-contents/ecx: (addr handle word) <- get body, data + 673 var final-line-storage: (handle line) + 674 var final-line-ah/eax: (addr handle line) <- address final-line-storage + 675 final-line sandbox, final-line-ah + 676 var final-line/eax: (addr line) <- lookup *final-line-ah + 677 var final-line-contents/eax: (addr handle word) <- get final-line, data + 678 copy-object final-line-contents, body-contents + 679 # + 680 copy-unbound-words-to-args functions + 681 # + 682 var empty-word: (handle word) + 683 copy-handle empty-word, final-line-contents + 684 construct-call functions, final-line-contents + 685 # clear partial-name-for-function + 686 var empty-word: (handle word) + 687 copy-handle empty-word, new-name-ah + 688 # update cursor + 689 var final-line/eax: (addr line) <- lookup final-line-storage + 690 var cursor-call-path-ah/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path + 691 allocate cursor-call-path-ah # leak + 692 initialize-path-from-line final-line, cursor-call-path-ah + 693 break $process-sandbox-define:body + 694 } + 695 # + 696 compare key, 0x7f # del (backspace on Macs) + 697 $process-sandbox-define:backspace: { + 698 break-if-!= + 699 # if not at start, delete grapheme before cursor + 700 var new-name/eax: (addr word) <- lookup *new-name-ah + 701 var at-start?/eax: boolean <- cursor-at-start? new-name + 702 compare at-start?, 0 # false + 703 { + 704 break-if-!= + 705 var new-name/eax: (addr word) <- lookup *new-name-ah + 706 delete-before-cursor new-name + 707 } + 708 break $process-sandbox-define:body + 709 } + 710 # otherwise insert key within current word + 711 var print?/eax: boolean <- real-grapheme? key + 712 $process-sandbox-define:real-grapheme: { + 713 compare print?, 0 # false + 714 break-if-= + 715 var new-name/eax: (addr word) <- lookup *new-name-ah + 716 add-grapheme-to-word new-name, key + 717 break $process-sandbox-define:body + 718 } + 719 # silently ignore other hotkeys + 720 } + 721 } + 722 + 723 # extract from the body of the first function in 'functions' all words that + 724 # aren't defined in the rest of 'functions'. Prepend them in reverse order. + 725 # Assumes function body is a single line for now. + 726 fn copy-unbound-words-to-args _functions: (addr handle function) { + 727 # target + 728 var target-ah/eax: (addr handle function) <- copy _functions + 729 var _target/eax: (addr function) <- lookup *target-ah + 730 var target/esi: (addr function) <- copy _target + 731 var dest-ah/edi: (addr handle word) <- get target, args + 732 # next + 733 var functions-ah/edx: (addr handle function) <- get target, next + 734 # src + 735 var line-ah/eax: (addr handle line) <- get target, body + 736 var line/eax: (addr line) <- lookup *line-ah + 737 var curr-ah/eax: (addr handle word) <- get line, data + 738 var curr/eax: (addr word) <- lookup *curr-ah + 739 { + 740 compare curr, 0 + 741 break-if-= + 742 $copy-unbound-words-to-args:loop-iter: { + 743 # is it a number? + 744 { + 745 var is-int?/eax: boolean <- word-is-decimal-integer? curr + 746 compare is-int?, 0 # false + 747 break-if-!= $copy-unbound-words-to-args:loop-iter + 748 } + 749 # is it a pre-existing function? + 750 var bound?/ebx: boolean <- bound-function? curr, functions-ah + 751 compare bound?, 0 # false + 752 break-if-!= + 753 # is it already bound as an arg? + 754 var dup?/ebx: boolean <- arg-exists? _functions, curr # _functions = target-ah + 755 compare dup?, 0 # false + 756 break-if-!= $copy-unbound-words-to-args:loop-iter + 757 # push copy of curr before dest-ah + 758 var rest-h: (handle word) + 759 var rest-ah/ecx: (addr handle word) <- address rest-h + 760 copy-object dest-ah, rest-ah + 761 copy-word curr, dest-ah + 762 chain-words dest-ah, rest-ah + 763 } + 764 var next-ah/ecx: (addr handle word) <- get curr, next + 765 curr <- lookup *next-ah + 766 loop + 767 } + 768 } + 769 + 770 fn bound-function? w: (addr word), functions-ah: (addr handle function) -> _/ebx: boolean { + 771 var result/ebx: boolean <- copy 1 # true + 772 { + 773 ## numbers + 774 # if w == "+" return true + 775 var subresult/eax: boolean <- word-equal? w, "+" 776 compare subresult, 0 # false 777 break-if-!= - 778 # if w == "len" return true - 779 subresult <- word-equal? w, "len" + 778 # if w == "-" return true + 779 subresult <- word-equal? w, "-" 780 compare subresult, 0 # false 781 break-if-!= - 782 # if w == "open" return true - 783 subresult <- word-equal? w, "open" + 782 # if w == "*" return true + 783 subresult <- word-equal? w, "*" 784 compare subresult, 0 # false 785 break-if-!= - 786 # if w == "read" return true - 787 subresult <- word-equal? w, "read" - 788 compare subresult, 0 # false - 789 break-if-!= - 790 # if w == "slurp" return true - 791 subresult <- word-equal? w, "slurp" - 792 compare subresult, 0 # false - 793 break-if-!= - 794 # if w == "lines" return true - 795 subresult <- word-equal? w, "lines" - 796 compare subresult, 0 # false - 797 break-if-!= - 798 # if w == "dup" return true - 799 subresult <- word-equal? w, "dup" - 800 compare subresult, 0 # false - 801 break-if-!= - 802 # if w == "swap" return true - 803 subresult <- word-equal? w, "swap" - 804 compare subresult, 0 # false - 805 break-if-!= - 806 # return w in functions - 807 var out-h: (handle function) - 808 var out/eax: (addr handle function) <- address out-h - 809 callee functions-ah, w, out - 810 var found?/eax: (addr function) <- lookup *out - 811 result <- copy found? - 812 } - 813 return result - 814 } - 815 - 816 fn arg-exists? _f-ah: (addr handle function), arg: (addr word) -> _/ebx: boolean { - 817 var f-ah/eax: (addr handle function) <- copy _f-ah - 818 var f/eax: (addr function) <- lookup *f-ah - 819 var args-ah/eax: (addr handle word) <- get f, args - 820 var result/ebx: boolean <- word-exists? args-ah, arg - 821 return result - 822 } - 823 - 824 # construct a call to `f` with copies of exactly its args - 825 fn construct-call _f-ah: (addr handle function), _dest-ah: (addr handle word) { - 826 var f-ah/eax: (addr handle function) <- copy _f-ah - 827 var _f/eax: (addr function) <- lookup *f-ah - 828 var f/esi: (addr function) <- copy _f - 829 # append args in reverse - 830 var args-ah/eax: (addr handle word) <- get f, args - 831 var dest-ah/edi: (addr handle word) <- copy _dest-ah - 832 copy-words-in-reverse args-ah, dest-ah - 833 # append name - 834 var name-ah/eax: (addr handle array byte) <- get f, name - 835 var name/eax: (addr array byte) <- lookup *name-ah - 836 append-word-at-end-with dest-ah, name - 837 } - 838 - 839 fn word-index _words: (addr handle word), _n: int, out: (addr handle word) { - 840 $word-index:body: { - 841 var n/ecx: int <- copy _n - 842 { - 843 compare n, 0 - 844 break-if-!= - 845 copy-object _words, out - 846 break $word-index:body - 847 } - 848 var words-ah/eax: (addr handle word) <- copy _words - 849 var words/eax: (addr word) <- lookup *words-ah - 850 var next/eax: (addr handle word) <- get words, next - 851 n <- decrement - 852 word-index next, n, out - 853 } + 786 ## strings/arrays + 787 # if w == "len" return true + 788 subresult <- word-equal? w, "len" + 789 compare subresult, 0 # false + 790 break-if-!= + 791 ## files + 792 # if w == "open" return true + 793 subresult <- word-equal? w, "open" + 794 compare subresult, 0 # false + 795 break-if-!= + 796 # if w == "read" return true + 797 subresult <- word-equal? w, "read" + 798 compare subresult, 0 # false + 799 break-if-!= + 800 # if w == "slurp" return true + 801 subresult <- word-equal? w, "slurp" + 802 compare subresult, 0 # false + 803 break-if-!= + 804 # if w == "lines" return true + 805 subresult <- word-equal? w, "lines" + 806 compare subresult, 0 # false + 807 break-if-!= + 808 ## screens + 809 # if w == "fake-screen" return true + 810 subresult <- word-equal? w, "fake-screen" + 811 compare subresult, 0 # false + 812 break-if-!= + 813 # if w == "print" return true + 814 subresult <- word-equal? w, "print" + 815 compare subresult, 0 # false + 816 break-if-!= + 817 # if w == "move" return true + 818 subresult <- word-equal? w, "move" + 819 compare subresult, 0 # false + 820 break-if-!= + 821 # if w == "up" return true + 822 subresult <- word-equal? w, "up" + 823 compare subresult, 0 # false + 824 break-if-!= + 825 # if w == "down" return true + 826 subresult <- word-equal? w, "down" + 827 compare subresult, 0 # false + 828 break-if-!= + 829 # if w == "left" return true + 830 subresult <- word-equal? w, "left" + 831 compare subresult, 0 # false + 832 break-if-!= + 833 # if w == "right" return true + 834 subresult <- word-equal? w, "right" + 835 compare subresult, 0 # false + 836 break-if-!= + 837 ## hacks + 838 # if w == "dup" return true + 839 subresult <- word-equal? w, "dup" + 840 compare subresult, 0 # false + 841 break-if-!= + 842 # if w == "swap" return true + 843 subresult <- word-equal? w, "swap" + 844 compare subresult, 0 # false + 845 break-if-!= + 846 # return w in functions + 847 var out-h: (handle function) + 848 var out/eax: (addr handle function) <- address out-h + 849 callee functions-ah, w, out + 850 var found?/eax: (addr function) <- lookup *out + 851 result <- copy found? + 852 } + 853 return result 854 } 855 - 856 fn toggle-cursor-word _sandbox: (addr sandbox) { - 857 $toggle-cursor-word:body: { - 858 var sandbox/esi: (addr sandbox) <- copy _sandbox - 859 var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words - 860 var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path - 861 #? print-string 0, "cursor call path: " - 862 #? dump-call-path-element 0, cursor-call-path - 863 #? print-string 0, "expanded words:\n" - 864 #? dump-call-paths 0, expanded-words - 865 var already-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path - 866 compare already-expanded?, 0 # false - 867 { - 868 break-if-!= - 869 #? print-string 0, "expand\n" - 870 # if not already-expanded, insert - 871 insert-in-call-path expanded-words cursor-call-path - 872 #? print-string 0, "expanded words now:\n" - 873 #? dump-call-paths 0, expanded-words - 874 break $toggle-cursor-word:body - 875 } - 876 { - 877 break-if-= - 878 # otherwise delete - 879 delete-in-call-path expanded-words cursor-call-path - 880 } - 881 } - 882 } - 883 - 884 ############# - 885 # Visualize - 886 ############# - 887 - 888 fn evaluate-environment _env: (addr environment), stack: (addr value-stack) { - 889 var env/esi: (addr environment) <- copy _env - 890 # functions - 891 var functions/edx: (addr handle function) <- get env, functions - 892 # line - 893 var sandbox-ah/esi: (addr handle sandbox) <- get env, sandboxes - 894 var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah - 895 var line-ah/eax: (addr handle line) <- get sandbox, data - 896 var _line/eax: (addr line) <- lookup *line-ah - 897 var line/esi: (addr line) <- copy _line - 898 evaluate functions, 0, line, 0, stack - 899 } - 900 - 901 fn render _env: (addr environment) { - 902 #? print-string 0, "==\n" - 903 var env/esi: (addr environment) <- copy _env - 904 clear-canvas env - 905 # screen - 906 var screen-ah/eax: (addr handle screen) <- get env, screen - 907 var _screen/eax: (addr screen) <- lookup *screen-ah - 908 var screen/edi: (addr screen) <- copy _screen - 909 # repl-col - 910 var _repl-col/eax: (addr int) <- get env, code-separator-col - 911 var repl-col/ecx: int <- copy *_repl-col - 912 repl-col <- add 2 # repl-margin-left - 913 # functions - 914 var functions/edx: (addr handle function) <- get env, functions - 915 # sandbox - 916 var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes - 917 var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah - 918 #? { - 919 #? var line-ah/eax: (addr handle line) <- get sandbox, data - 920 #? var line/eax: (addr line) <- lookup *line-ah - 921 #? var first-word-ah/eax: (addr handle word) <- get line, data - 922 #? var curr-word/eax: (addr word) <- lookup *first-word-ah - 923 #? print-word 0, curr-word - 924 #? print-string 0, "\n" - 925 #? } - 926 # bindings - 927 var bindings-storage: table - 928 var bindings/ebx: (addr table) <- address bindings-storage - 929 initialize-table bindings, 0x10 - 930 render-sandbox screen, functions, bindings, sandbox, 3, repl-col - 931 } - 932 - 933 fn render-sandbox screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int { - 934 var sandbox/esi: (addr sandbox) <- copy _sandbox - 935 # line - 936 var curr-line-ah/eax: (addr handle line) <- get sandbox, data - 937 var _curr-line/eax: (addr line) <- lookup *curr-line-ah - 938 var curr-line/ecx: (addr line) <- copy _curr-line - 939 # - 940 var curr-row/edx: int <- copy top-row - 941 # cursor row, col - 942 var cursor-row: int - 943 var cursor-row-addr: (addr int) - 944 var tmp/eax: (addr int) <- address cursor-row - 945 copy-to cursor-row-addr, tmp - 946 var cursor-col: int - 947 var cursor-col-addr: (addr int) - 948 tmp <- address cursor-col - 949 copy-to cursor-col-addr, tmp - 950 # render all but final line without stack - 951 #? print-string 0, "render all but final line\n" - 952 { - 953 var next-line-ah/eax: (addr handle line) <- get curr-line, next - 954 var next-line/eax: (addr line) <- lookup *next-line-ah - 955 compare next-line, 0 - 956 break-if-= - 957 { - 958 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - 959 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - 960 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word - 961 var cursor-word/eax: (addr word) <- lookup *cursor-word-ah - 962 #? print-string 0, "cursor 2: " - 963 #? { - 964 #? print-word 0, cursor-word - 965 #? print-string 0, " -- " - 966 #? var foo/eax: int <- copy cursor-word - 967 #? print-int32-hex 0, foo - 968 #? print-string 0, "\n" - 969 #? } - 970 # it's enough to pass in the first word of the path, because if the path isn't a singleton the word is guaranteed to be unique - 971 render-line-without-stack screen, curr-line, curr-row, left-col, cursor-word, cursor-row-addr, cursor-col-addr - 972 } - 973 curr-line <- copy next-line - 974 curr-row <- add 2 - 975 loop - 976 } - 977 # - 978 #? print-string 0, "render final line\n" - 979 render-final-line-with-stack screen, functions, bindings, sandbox, curr-row, left-col, cursor-row-addr, cursor-col-addr - 980 # at most one of the following dialogs will be rendered - 981 render-rename-dialog screen, sandbox, cursor-row, cursor-col - 982 render-define-dialog screen, sandbox, cursor-row, cursor-col - 983 move-cursor screen, cursor-row, cursor-col - 984 } - 985 - 986 fn render-final-line-with-stack screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int, cursor-row-addr: (addr int), cursor-col-addr: (addr int) { - 987 var sandbox/esi: (addr sandbox) <- copy _sandbox - 988 # expanded-words - 989 var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words - 990 # cursor-word - 991 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - 992 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - 993 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word - 994 var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah - 995 var cursor-word/ebx: (addr word) <- copy _cursor-word - 996 #? print-string 0, "word at cursor: " - 997 #? print-word 0, cursor-word - 998 #? print-string 0, "\n" - 999 # cursor-call-path -1000 var cursor-call-path: (addr handle call-path-element) -1001 { -1002 var src/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path -1003 copy-to cursor-call-path, src -1004 } -1005 # first line -1006 var first-line-ah/eax: (addr handle line) <- get sandbox, data -1007 var _first-line/eax: (addr line) <- lookup *first-line-ah -1008 var first-line/edx: (addr line) <- copy _first-line -1009 # final line -1010 var final-line-storage: (handle line) -1011 var final-line-ah/eax: (addr handle line) <- address final-line-storage -1012 final-line sandbox, final-line-ah -1013 var final-line/eax: (addr line) <- lookup *final-line-ah -1014 # curr-path -1015 var curr-path-storage: (handle call-path-element) -1016 var curr-path/ecx: (addr handle call-path-element) <- address curr-path-storage -1017 allocate curr-path # leak -1018 initialize-path-from-line final-line, curr-path -1019 # -1020 var dummy/ecx: int <- render-line screen, functions, bindings, first-line, final-line, expanded-words, top-row, left-col, curr-path, cursor-word, cursor-call-path, cursor-row-addr, cursor-col-addr -1021 } -1022 -1023 fn final-line _sandbox: (addr sandbox), out: (addr handle line) { -1024 var sandbox/esi: (addr sandbox) <- copy _sandbox -1025 var curr-line-ah/ecx: (addr handle line) <- get sandbox, data -1026 { -1027 var curr-line/eax: (addr line) <- lookup *curr-line-ah -1028 var next-line-ah/edx: (addr handle line) <- get curr-line, next -1029 var next-line/eax: (addr line) <- lookup *next-line-ah -1030 compare next-line, 0 -1031 break-if-= -1032 curr-line-ah <- copy next-line-ah -1033 loop -1034 } -1035 copy-object curr-line-ah, out -1036 } -1037 -1038 fn render-rename-dialog screen: (addr screen), _sandbox: (addr sandbox), cursor-row: int, cursor-col: int { -1039 var sandbox/edi: (addr sandbox) <- copy _sandbox -1040 var rename-word-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-cursor-word -1041 var rename-word-mode?/eax: (addr word) <- lookup *rename-word-mode-ah? -1042 compare rename-word-mode?, 0 -1043 break-if-= -1044 # clear a space for the dialog -1045 var top-row/eax: int <- copy cursor-row -1046 top-row <- subtract 3 -1047 var bottom-row/ecx: int <- copy cursor-row -1048 bottom-row <- add 3 -1049 var left-col/edx: int <- copy cursor-col -1050 left-col <- subtract 0x10 -1051 var right-col/ebx: int <- copy cursor-col -1052 right-col <- add 0x10 -1053 clear-rect screen, top-row, left-col, bottom-row, right-col -1054 draw-box screen, top-row, left-col, bottom-row, right-col -1055 # render a little menu for the dialog -1056 var menu-row/ecx: int <- copy bottom-row -1057 menu-row <- decrement -1058 var menu-col/edx: int <- copy left-col -1059 menu-col <- add 2 -1060 move-cursor screen, menu-row, menu-col -1061 start-reverse-video screen -1062 print-string screen, " esc " -1063 reset-formatting screen -1064 print-string screen, " cancel " -1065 start-reverse-video screen -1066 print-string screen, " enter " -1067 reset-formatting screen -1068 print-string screen, " rename " -1069 # draw the word, positioned appropriately around the cursor -1070 var start-col/ecx: int <- copy cursor-col -1071 var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-cursor-word -1072 var word/eax: (addr word) <- lookup *word-ah? -1073 var cursor-index/eax: int <- cursor-index word -1074 start-col <- subtract cursor-index -1075 move-cursor screen, cursor-row, start-col -1076 var word/eax: (addr word) <- lookup *word-ah? -1077 print-word screen, word -1078 } -1079 -1080 fn render-define-dialog screen: (addr screen), _sandbox: (addr sandbox), cursor-row: int, cursor-col: int { -1081 var sandbox/edi: (addr sandbox) <- copy _sandbox -1082 var define-function-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-function -1083 var define-function-mode?/eax: (addr word) <- lookup *define-function-mode-ah? -1084 compare define-function-mode?, 0 -1085 break-if-= -1086 # clear a space for the dialog -1087 var top-row/eax: int <- copy cursor-row -1088 top-row <- subtract 3 -1089 var bottom-row/ecx: int <- copy cursor-row -1090 bottom-row <- add 3 -1091 var left-col/edx: int <- copy cursor-col -1092 left-col <- subtract 0x10 -1093 var right-col/ebx: int <- copy cursor-col -1094 right-col <- add 0x10 -1095 clear-rect screen, top-row, left-col, bottom-row, right-col -1096 draw-box screen, top-row, left-col, bottom-row, right-col -1097 # render a little menu for the dialog -1098 var menu-row/ecx: int <- copy bottom-row -1099 menu-row <- decrement -1100 var menu-col/edx: int <- copy left-col -1101 menu-col <- add 2 -1102 move-cursor screen, menu-row, menu-col -1103 start-reverse-video screen -1104 print-string screen, " esc " -1105 reset-formatting screen -1106 print-string screen, " cancel " -1107 start-reverse-video screen -1108 print-string screen, " enter " -1109 reset-formatting screen -1110 print-string screen, " define " -1111 # draw the word, positioned appropriately around the cursor -1112 var start-col/ecx: int <- copy cursor-col -1113 var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-function -1114 var word/eax: (addr word) <- lookup *word-ah? -1115 var cursor-index/eax: int <- cursor-index word -1116 start-col <- subtract cursor-index -1117 move-cursor screen, cursor-row, start-col -1118 var word/eax: (addr word) <- lookup *word-ah? -1119 print-word screen, word -1120 } -1121 -1122 # Render just the words in 'line'. -1123 fn render-line-without-stack screen: (addr screen), _line: (addr line), curr-row: int, left-col: int, cursor-word: (addr word), cursor-row-addr: (addr int), cursor-col-addr: (addr int) { -1124 # curr-word -1125 var line/eax: (addr line) <- copy _line -1126 var first-word-ah/eax: (addr handle word) <- get line, data -1127 var _curr-word/eax: (addr word) <- lookup *first-word-ah -1128 var curr-word/esi: (addr word) <- copy _curr-word -1129 # -1130 # loop-carried dependency -1131 var curr-col/ecx: int <- copy left-col -1132 # -1133 { -1134 compare curr-word, 0 -1135 break-if-= -1136 #? print-string 0, "-- word in penultimate lines: " -1137 #? { -1138 #? var foo/eax: int <- copy curr-word -1139 #? print-int32-hex 0, foo -1140 #? } -1141 #? print-string 0, "\n" -1142 var old-col/edx: int <- copy curr-col -1143 reset-formatting screen -1144 move-cursor screen, curr-row, curr-col -1145 print-word screen, curr-word -1146 { -1147 var max-width/eax: int <- word-length curr-word -1148 curr-col <- add max-width -1149 curr-col <- add 1 # margin-right -1150 } -1151 # cache cursor column if necessary -1152 { -1153 compare curr-word, cursor-word -1154 break-if-!= -1155 #? print-string 0, "Cursor at " -1156 #? print-int32-decimal 0, curr-row -1157 #? print-string 0, ", " -1158 #? print-int32-decimal 0, old-col -1159 #? print-string 0, "\n" -1160 #? print-string 0, "contents: " -1161 #? print-word 0, cursor-word -1162 #? print-string 0, "\n" -1163 #? { -1164 #? var foo/eax: int <- copy cursor-word -1165 #? print-int32-hex 0, foo -1166 #? print-string 0, "\n" -1167 #? } -1168 var dest/ecx: (addr int) <- copy cursor-row-addr -1169 var src/eax: int <- copy curr-row -1170 copy-to *dest, src -1171 dest <- copy cursor-col-addr -1172 copy-to *dest, old-col -1173 var cursor-index-in-word/eax: int <- cursor-index curr-word -1174 add-to *dest, cursor-index-in-word -1175 } -1176 # loop update -1177 var next-word-ah/edx: (addr handle word) <- get curr-word, next -1178 var _curr-word/eax: (addr word) <- lookup *next-word-ah -1179 curr-word <- copy _curr-word -1180 loop -1181 } -1182 } -1183 -1184 fn call-depth-at-cursor _sandbox: (addr sandbox) -> _/eax: int { -1185 var sandbox/esi: (addr sandbox) <- copy _sandbox -1186 var cursor-call-path/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path -1187 var result/eax: int <- call-path-element-length cursor-call-path -1188 result <- add 2 # input-row - 1 -1189 return result -1190 } -1191 -1192 fn call-path-element-length _x: (addr handle call-path-element) -> _/eax: int { -1193 var curr-ah/ecx: (addr handle call-path-element) <- copy _x -1194 var result/edi: int <- copy 0 -1195 { -1196 var curr/eax: (addr call-path-element) <- lookup *curr-ah -1197 compare curr, 0 -1198 break-if-= -1199 curr-ah <- get curr, next -1200 result <- increment -1201 loop -1202 } -1203 return result -1204 } -1205 -1206 # Render the line of words in line, along with the state of the stack under each word. -1207 # Also render any expanded function calls using recursive calls. -1208 # -1209 # Along the way, compute the column the cursor should be positioned at (cursor-col-addr). -1210 fn render-line screen: (addr screen), functions: (addr handle function), bindings: (addr table), first-line: (addr line), _line: (addr line), expanded-words: (addr handle call-path), top-row: int, left-col: int, curr-path: (addr handle call-path-element), cursor-word: (addr word), cursor-call-path: (addr handle call-path-element), cursor-row-addr: (addr int), cursor-col-addr: (addr int) -> _/ecx: int { -1211 #? print-string 0, "--\n" -1212 # curr-word -1213 var line/esi: (addr line) <- copy _line -1214 var first-word-ah/eax: (addr handle word) <- get line, data -1215 var curr-word/eax: (addr word) <- lookup *first-word-ah -1216 var debug-row: int -1217 copy-to debug-row, 0x20 -1218 # -1219 # loop-carried dependency -1220 var curr-col/ecx: int <- copy left-col -1221 # -1222 { -1223 compare curr-word, 0 -1224 break-if-= -1225 #? print-string 0, "-- word in final line: " -1226 #? { -1227 #? var foo/eax: int <- copy curr-word -1228 #? print-int32-hex 0, foo -1229 #? } -1230 #? print-string 0, "\n" -1231 # if necessary, first render columns for subsidiary stack -1232 $render-line:subsidiary: { -1233 { -1234 #? print-string 0, "check sub\n" -1235 var display-subsidiary-stack?/eax: boolean <- find-in-call-paths expanded-words, curr-path -1236 compare display-subsidiary-stack?, 0 # false -1237 break-if-= $render-line:subsidiary -1238 } -1239 #? print-string 0, "render subsidiary stack\n" -1240 # does function exist? -1241 var callee/edi: (addr function) <- copy 0 -1242 { -1243 var callee-h: (handle function) -1244 var callee-ah/ecx: (addr handle function) <- address callee-h -1245 callee functions, curr-word, callee-ah -1246 var _callee/eax: (addr function) <- lookup *callee-ah -1247 callee <- copy _callee -1248 compare callee, 0 -1249 break-if-= $render-line:subsidiary -1250 } -1251 move-cursor screen, top-row, curr-col -1252 start-color screen, 8, 7 -1253 print-word screen, curr-word -1254 { -1255 var word-len/eax: int <- word-length curr-word -1256 curr-col <- add word-len -1257 curr-col <- add 2 -1258 increment top-row -1259 } -1260 # obtain stack at call site -1261 var stack-storage: value-stack -1262 var stack/edx: (addr value-stack) <- address stack-storage -1263 initialize-value-stack stack, 0x10 -1264 { -1265 var prev-word-ah/eax: (addr handle word) <- get curr-word, prev -1266 var prev-word/eax: (addr word) <- lookup *prev-word-ah -1267 compare prev-word, 0 -1268 break-if-= -1269 evaluate functions, bindings, line, prev-word, stack -1270 } -1271 # construct new bindings -1272 var callee-bindings-storage: table -1273 var callee-bindings/esi: (addr table) <- address callee-bindings-storage -1274 initialize-table callee-bindings, 0x10 -1275 bind-args callee, stack, callee-bindings -1276 # obtain body -1277 var callee-body-ah/eax: (addr handle line) <- get callee, body -1278 var callee-body/eax: (addr line) <- lookup *callee-body-ah -1279 var callee-body-first-word/edx: (addr handle word) <- get callee-body, data -1280 # - render subsidiary stack -1281 push-to-call-path-element curr-path, callee-body-first-word # leak -1282 curr-col <- render-line screen, functions, callee-bindings, callee-body, callee-body, expanded-words, top-row, curr-col, curr-path, cursor-word, cursor-call-path, cursor-row-addr, cursor-col-addr -1283 drop-from-call-path-element curr-path -1284 # -1285 move-cursor screen, top-row, curr-col -1286 print-code-point screen, 0x21d7 # ⇗ -1287 # -1288 curr-col <- add 2 -1289 decrement top-row -1290 } -1291 # render main column -1292 var old-col/edx: int <- copy curr-col -1293 #? move-cursor 0, debug-row, 1 -1294 #? increment debug-row -1295 #? print-string 0, "rendering column from " -1296 #? print-int32-decimal 0, curr-col -1297 #? print-string 0, "\n" -1298 curr-col <- render-column screen, functions, bindings, first-line, line, curr-word, top-row, curr-col -1299 # cache cursor column if necessary -1300 $render-line:cache-cursor-column: { -1301 #? print-string 0, "cache cursor? " -1302 #? { -1303 #? var foo/eax: int <- copy curr-word -1304 #? print-int32-hex 0, foo -1305 #? } -1306 #? print-string 0, "\n" -1307 { -1308 var found?/eax: boolean <- call-path-element-match? curr-path, cursor-call-path -1309 compare found?, 0 # false -1310 break-if-= $render-line:cache-cursor-column -1311 } -1312 #? print-string 0, "cursor at " -1313 #? print-int32-decimal 0, top-row -1314 #? print-string 0, ", " -1315 #? print-int32-decimal 0, old-col -1316 #? print-string 0, "\n" -1317 var dest/edi: (addr int) <- copy cursor-row-addr -1318 { -1319 var src/eax: int <- copy top-row -1320 copy-to *dest, src -1321 } -1322 dest <- copy cursor-col-addr -1323 copy-to *dest, old-col -1324 var cursor-index-in-word/eax: int <- cursor-index curr-word -1325 add-to *dest, cursor-index-in-word -1326 } -1327 # loop update -1328 #? print-string 0, "next word\n" -1329 var next-word-ah/edx: (addr handle word) <- get curr-word, next -1330 curr-word <- lookup *next-word-ah -1331 #? { -1332 #? var foo/eax: int <- copy curr-word -1333 #? print-int32-hex 0, foo -1334 #? print-string 0, "\n" -1335 #? } -1336 increment-final-element curr-path -1337 loop -1338 } -1339 return curr-col -1340 } -1341 -1342 fn callee functions: (addr handle function), word: (addr word), out: (addr handle function) { -1343 var stream-storage: (stream byte 0x10) -1344 var stream/esi: (addr stream byte) <- address stream-storage -1345 emit-word word, stream -1346 find-function functions, stream, out -1347 } -1348 -1349 # Render: -1350 # - starting at top-row, left-col: final-word -1351 # - starting somewhere below at left-col: the stack result from interpreting first-world to final-word (inclusive) -1352 # -1353 # Return the farthest column written. -1354 fn render-column screen: (addr screen), functions: (addr handle function), bindings: (addr table), first-line: (addr line), line: (addr line), final-word: (addr word), top-row: int, left-col: int -> _/ecx: int { -1355 #? print-string 0, "render-column\n" -1356 var max-width/esi: int <- copy 0 -1357 { -1358 # indent stack -1359 var indented-col/ebx: int <- copy left-col -1360 indented-col <- add 1 # margin-right -1361 # compute stack -1362 var stack: value-stack -1363 var stack-addr/edi: (addr value-stack) <- address stack -1364 initialize-value-stack stack-addr, 0x10 # max-words -1365 evaluate functions, bindings, first-line, final-word, stack-addr -1366 # render stack -1367 var curr-row/edx: int <- copy top-row -1368 curr-row <- add 2 # stack-margin-top -1369 var _max-width/eax: int <- value-stack-max-width stack-addr -1370 max-width <- copy _max-width -1371 { -1372 var top-addr/ecx: (addr int) <- get stack-addr, top -1373 compare *top-addr, 0 -1374 break-if-<= -1375 decrement *top-addr -1376 move-cursor screen, curr-row, indented-col -1377 { -1378 var data-ah/eax: (addr handle array value) <- get stack-addr, data -1379 var data/eax: (addr array value) <- lookup *data-ah -1380 var top/edx: int <- copy *top-addr -1381 var dest-offset/edx: (offset value) <- compute-offset data, top -1382 var val/eax: (addr value) <- index data, dest-offset -1383 render-value screen, val, max-width -1384 } -1385 curr-row <- increment -1386 loop -1387 } -1388 } -1389 -1390 max-width <- add 2 # spaces on either side of items on the stack -1391 -1392 # render word, initialize result -1393 reset-formatting screen -1394 move-cursor screen, top-row, left-col -1395 print-word screen, final-word -1396 { -1397 var size/eax: int <- word-length final-word -1398 compare size, max-width -1399 break-if-<= -1400 max-width <- copy size -1401 } -1402 -1403 # post-process right-col -1404 var right-col/ecx: int <- copy left-col -1405 right-col <- add max-width -1406 right-col <- add 1 # margin-right -1407 #? print-int32-decimal 0, left-col -1408 #? print-string 0, " => " -1409 #? print-int32-decimal 0, right-col -1410 #? print-string 0, "\n" -1411 return right-col -1412 } -1413 -1414 fn render-value screen: (addr screen), _val: (addr value), max-width: int { -1415 $render-value:body: { -1416 var val/esi: (addr value) <- copy _val -1417 var val-type/ecx: (addr int) <- get val, type -1418 # per-type rendering logic goes here -1419 compare *val-type, 1 # string -1420 { -1421 break-if-!= -1422 var val-ah/eax: (addr handle array byte) <- get val, text-data -1423 var val-string/eax: (addr array byte) <- lookup *val-ah -1424 compare val-string, 0 -1425 break-if-= -1426 var orig-len/ecx: int <- length val-string -1427 var truncated: (handle array byte) -1428 var truncated-ah/esi: (addr handle array byte) <- address truncated -1429 substring val-string, 0, 0xc, truncated-ah -1430 var truncated-string/eax: (addr array byte) <- lookup *truncated-ah -1431 #? { -1432 #? var foo/eax: int <- copy truncated-string -1433 #? print-int32-hex 0, foo -1434 #? print-string 0, "\n" -1435 #? } -1436 var len/edx: int <- length truncated-string -1437 start-color screen, 0xf2, 7 -1438 print-code-point screen, 0x275d # open-quote -1439 print-string screen, truncated-string -1440 compare len, orig-len -1441 { -1442 break-if-= -1443 print-code-point screen, 0x2026 # ellipses -1444 } -1445 print-code-point screen, 0x275e # close-quote -1446 reset-formatting screen -1447 break $render-value:body -1448 } -1449 compare *val-type, 2 # array -1450 { -1451 break-if-!= -1452 var val-ah/eax: (addr handle array value) <- get val, array-data -1453 var val-array/eax: (addr array value) <- lookup *val-ah -1454 render-array screen, val-array -1455 break $render-value:body -1456 } -1457 compare *val-type, 3 # file -1458 { -1459 break-if-!= -1460 var val-ah/eax: (addr handle buffered-file) <- get val, file-data -1461 var val-file/eax: (addr buffered-file) <- lookup *val-ah -1462 start-color screen, 0, 7 -1463 # TODO -1464 print-string screen, " FILE " -1465 break $render-value:body -1466 } -1467 # render ints by default for now -1468 var val-int/eax: (addr int) <- get val, int-data -1469 render-integer screen, *val-int, max-width -1470 } -1471 } -1472 -1473 # synaesthesia -1474 fn render-integer screen: (addr screen), val: int, max-width: int { -1475 $render-integer:body: { -1476 # if max-width is 0, we're inside an array. No coloring. -1477 compare max-width, 0 -1478 { -1479 break-if-!= -1480 print-int32-decimal screen, val -1481 break $render-integer:body -1482 } -1483 var bg/eax: int <- hash-color val -1484 var fg/ecx: int <- copy 7 -1485 { -1486 compare bg, 2 -1487 break-if-!= -1488 fg <- copy 0 -1489 } -1490 { -1491 compare bg, 3 -1492 break-if-!= -1493 fg <- copy 0 -1494 } -1495 { -1496 compare bg, 6 -1497 break-if-!= -1498 fg <- copy 0 -1499 } -1500 start-color screen, fg, bg -1501 print-grapheme screen, 0x20 # space -1502 print-int32-decimal-right-justified screen, val, max-width -1503 print-grapheme screen, 0x20 # space -1504 } -1505 } -1506 -1507 fn render-array screen: (addr screen), _a: (addr array value) { -1508 start-color screen, 0xf2, 7 -1509 # don't surround in spaces -1510 print-grapheme screen, 0x5b # '[' -1511 var a/esi: (addr array value) <- copy _a -1512 var max/ecx: int <- length a -1513 var i/eax: int <- copy 0 -1514 { -1515 compare i, max -1516 break-if->= -1517 { -1518 compare i, 0 -1519 break-if-= -1520 print-string screen, " " -1521 } -1522 var off/ecx: (offset value) <- compute-offset a, i -1523 var x/ecx: (addr value) <- index a, off -1524 render-value screen, x, 0 -1525 i <- increment -1526 loop -1527 } -1528 print-grapheme screen, 0x5d # ']' -1529 } -1530 -1531 fn hash-color val: int -> _/eax: int { -1532 var result/eax: int <- try-modulo val, 7 # assumes that 7 is always the background color -1533 return result -1534 } -1535 -1536 fn clear-canvas _env: (addr environment) { -1537 var env/esi: (addr environment) <- copy _env -1538 var screen-ah/edi: (addr handle screen) <- get env, screen -1539 var _screen/eax: (addr screen) <- lookup *screen-ah -1540 var screen/edi: (addr screen) <- copy _screen -1541 clear-screen screen -1542 var nrows/eax: (addr int) <- get env, nrows -1543 var _repl-col/ecx: (addr int) <- get env, code-separator-col -1544 var repl-col/ecx: int <- copy *_repl-col -1545 draw-vertical-line screen, 1, *nrows, repl-col -1546 # wordstar-style cheatsheet of shortcuts -1547 move-cursor screen, *nrows, 0 -1548 start-reverse-video screen -1549 print-string screen, " ctrl-q " -1550 reset-formatting screen -1551 print-string screen, " quit " -1552 var menu-start/ebx: int <- copy repl-col -1553 menu-start <- subtract 0x40 # 64 = half the size of the menu -1554 move-cursor screen, *nrows, menu-start -1555 start-reverse-video screen -1556 print-string screen, " ctrl-a " -1557 reset-formatting screen -1558 print-string screen, " ⏮ " -1559 start-reverse-video screen -1560 print-string screen, " ctrl-b " -1561 reset-formatting screen -1562 print-string screen, " ◀ word " -1563 start-reverse-video screen -1564 print-string screen, " ctrl-f " -1565 reset-formatting screen -1566 print-string screen, " word ▶ " -1567 start-reverse-video screen -1568 print-string screen, " ctrl-e " -1569 reset-formatting screen -1570 print-string screen, " ⏭ " -1571 start-reverse-video screen -1572 print-string screen, " ctrl-u " -1573 reset-formatting screen -1574 print-string screen, " clear line " -1575 start-reverse-video screen -1576 print-string screen, " ctrl-n " -1577 reset-formatting screen -1578 print-string screen, " name value " -1579 start-reverse-video screen -1580 print-string screen, " ctrl-d " -1581 reset-formatting screen -1582 print-string screen, " define function " -1583 # primitives -1584 var start-col/ecx: int <- copy repl-col -1585 start-col <- subtract 0x20 -1586 move-cursor screen, 1, start-col -1587 print-string screen, "primitives:" -1588 start-col <- add 2 -1589 move-cursor screen, 2, start-col -1590 print-string screen, "+ - * len" -1591 move-cursor screen, 3, start-col -1592 print-string screen, "open read slurp lines" -1593 move-cursor screen, 4, start-col -1594 print-string screen, "dup swap" -1595 # currently defined functions -1596 start-col <- subtract 2 -1597 move-cursor screen, 6, start-col -1598 print-string screen, "functions:" -1599 start-col <- add 2 -1600 var row/ebx: int <- copy 7 -1601 var functions/esi: (addr handle function) <- get env, functions -1602 { -1603 var curr/eax: (addr function) <- lookup *functions -1604 compare curr, 0 -1605 break-if-= -1606 row <- render-function screen, row, start-col, curr -1607 functions <- get curr, next -1608 row <- increment -1609 loop -1610 } -1611 } -1612 -1613 # only single-line functions supported for now -1614 fn render-function screen: (addr screen), row: int, col: int, _f: (addr function) -> _/ebx: int { -1615 var f/esi: (addr function) <- copy _f -1616 var args/ecx: (addr handle word) <- get f, args -1617 move-cursor screen, row, col -1618 print-words-in-reverse screen, args -1619 var name-ah/eax: (addr handle array byte) <- get f, name -1620 var name/eax: (addr array byte) <- lookup *name-ah -1621 start-bold screen -1622 print-string screen, name -1623 reset-formatting screen -1624 increment row -1625 add-to col, 2 -1626 move-cursor screen, row, col -1627 print-string screen, "= " -1628 var body-ah/eax: (addr handle line) <- get f, body -1629 var body/eax: (addr line) <- lookup *body-ah -1630 var body-words-ah/eax: (addr handle word) <- get body, data -1631 print-words screen, body-words-ah -1632 return row -1633 } -1634 -1635 fn real-grapheme? g: grapheme -> _/eax: boolean { -1636 # if g == newline return true -1637 compare g, 0xa -1638 { -1639 break-if-!= -1640 return 1 # true -1641 } -1642 # if g == tab return true -1643 compare g, 9 -1644 { -1645 break-if-!= -1646 return 1 # true -1647 } -1648 # if g < 32 return false -1649 compare g, 0x20 -1650 { -1651 break-if->= -1652 return 0 # false -1653 } -1654 # if g <= 255 return true -1655 compare g, 0xff -1656 { -1657 break-if-> -1658 return 1 # true -1659 } -1660 # if (g&0xff == Esc) it's an escape sequence -1661 and-with g, 0xff -1662 compare g, 0x1b # Esc -1663 { -1664 break-if-!= -1665 return 0 # false -1666 } -1667 # otherwise return true -1668 return 1 # true -1669 } + 856 fn arg-exists? _f-ah: (addr handle function), arg: (addr word) -> _/ebx: boolean { + 857 var f-ah/eax: (addr handle function) <- copy _f-ah + 858 var f/eax: (addr function) <- lookup *f-ah + 859 var args-ah/eax: (addr handle word) <- get f, args + 860 var result/ebx: boolean <- word-exists? args-ah, arg + 861 return result + 862 } + 863 + 864 # construct a call to `f` with copies of exactly its args + 865 fn construct-call _f-ah: (addr handle function), _dest-ah: (addr handle word) { + 866 var f-ah/eax: (addr handle function) <- copy _f-ah + 867 var _f/eax: (addr function) <- lookup *f-ah + 868 var f/esi: (addr function) <- copy _f + 869 # append args in reverse + 870 var args-ah/eax: (addr handle word) <- get f, args + 871 var dest-ah/edi: (addr handle word) <- copy _dest-ah + 872 copy-words-in-reverse args-ah, dest-ah + 873 # append name + 874 var name-ah/eax: (addr handle array byte) <- get f, name + 875 var name/eax: (addr array byte) <- lookup *name-ah + 876 append-word-at-end-with dest-ah, name + 877 } + 878 + 879 fn word-index _words: (addr handle word), _n: int, out: (addr handle word) { + 880 $word-index:body: { + 881 var n/ecx: int <- copy _n + 882 { + 883 compare n, 0 + 884 break-if-!= + 885 copy-object _words, out + 886 break $word-index:body + 887 } + 888 var words-ah/eax: (addr handle word) <- copy _words + 889 var words/eax: (addr word) <- lookup *words-ah + 890 var next/eax: (addr handle word) <- get words, next + 891 n <- decrement + 892 word-index next, n, out + 893 } + 894 } + 895 + 896 fn toggle-cursor-word _sandbox: (addr sandbox) { + 897 $toggle-cursor-word:body: { + 898 var sandbox/esi: (addr sandbox) <- copy _sandbox + 899 var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words + 900 var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path + 901 #? print-string 0, "cursor call path: " + 902 #? dump-call-path-element 0, cursor-call-path + 903 #? print-string 0, "expanded words:\n" + 904 #? dump-call-paths 0, expanded-words + 905 var already-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path + 906 compare already-expanded?, 0 # false + 907 { + 908 break-if-!= + 909 #? print-string 0, "expand\n" + 910 # if not already-expanded, insert + 911 insert-in-call-path expanded-words cursor-call-path + 912 #? print-string 0, "expanded words now:\n" + 913 #? dump-call-paths 0, expanded-words + 914 break $toggle-cursor-word:body + 915 } + 916 { + 917 break-if-= + 918 # otherwise delete + 919 delete-in-call-path expanded-words cursor-call-path + 920 } + 921 } + 922 } + 923 + 924 fn append-line _sandbox: (addr sandbox) { + 925 var sandbox/esi: (addr sandbox) <- copy _sandbox + 926 var line-ah/ecx: (addr handle line) <- get sandbox, data + 927 { + 928 var line/eax: (addr line) <- lookup *line-ah + 929 var next-line-ah/edx: (addr handle line) <- get line, next + 930 var next-line/eax: (addr line) <- lookup *next-line-ah + 931 compare next-line, 0 + 932 break-if-= + 933 line-ah <- copy next-line-ah + 934 loop + 935 } + 936 var line/eax: (addr line) <- lookup *line-ah + 937 var final-line-ah/edx: (addr handle line) <- get line, next + 938 allocate final-line-ah + 939 var final-line/eax: (addr line) <- lookup *final-line-ah + 940 initialize-line final-line + 941 var final-prev/eax: (addr handle line) <- get final-line, prev + 942 copy-object line-ah, final-prev + 943 # clear cursor + 944 var final-line/eax: (addr line) <- lookup *final-line-ah + 945 var word-ah/ecx: (addr handle word) <- get final-line, data + 946 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path + 947 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah + 948 var dest/eax: (addr handle word) <- get cursor-call-path, word + 949 copy-object word-ah, dest + 950 } + 951 + 952 ############# + 953 # Visualize + 954 ############# + 955 + 956 fn evaluate-environment _env: (addr environment), stack: (addr value-stack) { + 957 var env/esi: (addr environment) <- copy _env + 958 # functions + 959 var functions/edx: (addr handle function) <- get env, functions + 960 # line + 961 var sandbox-ah/esi: (addr handle sandbox) <- get env, sandboxes + 962 var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah + 963 var line-ah/eax: (addr handle line) <- get sandbox, data + 964 var _line/eax: (addr line) <- lookup *line-ah + 965 var line/esi: (addr line) <- copy _line + 966 evaluate functions, 0, line, 0, stack + 967 } + 968 + 969 fn render _env: (addr environment) { + 970 #? print-string 0, "== render\n" + 971 var env/esi: (addr environment) <- copy _env + 972 clear-canvas env + 973 # screen + 974 var screen-ah/eax: (addr handle screen) <- get env, screen + 975 var _screen/eax: (addr screen) <- lookup *screen-ah + 976 var screen/edi: (addr screen) <- copy _screen + 977 # repl-col + 978 var _repl-col/eax: (addr int) <- get env, code-separator-col + 979 var repl-col/ecx: int <- copy *_repl-col + 980 repl-col <- add 2 # repl-margin-left + 981 # functions + 982 var functions/edx: (addr handle function) <- get env, functions + 983 # sandbox + 984 var sandbox-ah/eax: (addr handle sandbox) <- get env, sandboxes + 985 var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah + 986 # bindings + 987 var bindings-storage: table + 988 var bindings/ebx: (addr table) <- address bindings-storage + 989 initialize-table bindings, 0x10 + 990 #? print-string 0, "render-sandbox {\n" + 991 render-sandbox screen, functions, bindings, sandbox, 3, repl-col + 992 #? print-string 0, "render-sandbox }\n" + 993 } + 994 + 995 fn render-sandbox screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int { + 996 var sandbox/esi: (addr sandbox) <- copy _sandbox + 997 # line + 998 var curr-line-ah/eax: (addr handle line) <- get sandbox, data + 999 var _curr-line/eax: (addr line) <- lookup *curr-line-ah +1000 var curr-line/ecx: (addr line) <- copy _curr-line +1001 # +1002 var curr-row/edx: int <- copy top-row +1003 # cursor row, col +1004 var cursor-row: int +1005 var cursor-row-addr: (addr int) +1006 var tmp/eax: (addr int) <- address cursor-row +1007 copy-to cursor-row-addr, tmp +1008 var cursor-col: int +1009 var cursor-col-addr: (addr int) +1010 tmp <- address cursor-col +1011 copy-to cursor-col-addr, tmp +1012 # render all but final line without stack +1013 #? print-string 0, "render all but final line\n" +1014 { +1015 var next-line-ah/eax: (addr handle line) <- get curr-line, next +1016 var next-line/eax: (addr line) <- lookup *next-line-ah +1017 compare next-line, 0 +1018 break-if-= +1019 { +1020 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path +1021 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah +1022 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word +1023 var cursor-word/eax: (addr word) <- lookup *cursor-word-ah +1024 # it's enough to pass in the first word of the path, because if the path isn't a singleton the word is guaranteed to be unique +1025 render-line-without-stack screen, curr-line, curr-row, left-col, cursor-word, cursor-row-addr, cursor-col-addr +1026 } +1027 curr-line <- copy next-line +1028 curr-row <- add 2 +1029 loop +1030 } +1031 # +1032 render-final-line-with-stack screen, functions, bindings, sandbox, curr-row, left-col, cursor-row-addr, cursor-col-addr +1033 # at most one of the following dialogs will be rendered +1034 render-rename-dialog screen, sandbox, cursor-row, cursor-col +1035 render-define-dialog screen, sandbox, cursor-row, cursor-col +1036 move-cursor screen, cursor-row, cursor-col +1037 } +1038 +1039 fn render-final-line-with-stack screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int, cursor-row-addr: (addr int), cursor-col-addr: (addr int) { +1040 var sandbox/esi: (addr sandbox) <- copy _sandbox +1041 # expanded-words +1042 var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words +1043 # cursor-word +1044 var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path +1045 var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah +1046 var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word +1047 var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah +1048 var cursor-word/ebx: (addr word) <- copy _cursor-word +1049 #? print-string 0, "word at cursor: " +1050 #? print-word 0, cursor-word +1051 #? print-string 0, "\n" +1052 # cursor-call-path +1053 var cursor-call-path: (addr handle call-path-element) +1054 { +1055 var src/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path +1056 copy-to cursor-call-path, src +1057 } +1058 # first line +1059 var first-line-ah/eax: (addr handle line) <- get sandbox, data +1060 var _first-line/eax: (addr line) <- lookup *first-line-ah +1061 var first-line/edx: (addr line) <- copy _first-line +1062 # final line +1063 var final-line-storage: (handle line) +1064 var final-line-ah/eax: (addr handle line) <- address final-line-storage +1065 final-line sandbox, final-line-ah +1066 var final-line/eax: (addr line) <- lookup *final-line-ah +1067 # curr-path +1068 var curr-path-storage: (handle call-path-element) +1069 var curr-path/ecx: (addr handle call-path-element) <- address curr-path-storage +1070 allocate curr-path # leak +1071 initialize-path-from-line final-line, curr-path +1072 # +1073 var dummy/ecx: int <- render-line screen, functions, bindings, first-line, final-line, expanded-words, top-row, left-col, curr-path, cursor-word, cursor-call-path, cursor-row-addr, cursor-col-addr +1074 } +1075 +1076 fn final-line _sandbox: (addr sandbox), out: (addr handle line) { +1077 var sandbox/esi: (addr sandbox) <- copy _sandbox +1078 var curr-line-ah/ecx: (addr handle line) <- get sandbox, data +1079 { +1080 var curr-line/eax: (addr line) <- lookup *curr-line-ah +1081 var next-line-ah/edx: (addr handle line) <- get curr-line, next +1082 var next-line/eax: (addr line) <- lookup *next-line-ah +1083 compare next-line, 0 +1084 break-if-= +1085 curr-line-ah <- copy next-line-ah +1086 loop +1087 } +1088 copy-object curr-line-ah, out +1089 } +1090 +1091 fn render-rename-dialog screen: (addr screen), _sandbox: (addr sandbox), cursor-row: int, cursor-col: int { +1092 var sandbox/edi: (addr sandbox) <- copy _sandbox +1093 var rename-word-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-cursor-word +1094 var rename-word-mode?/eax: (addr word) <- lookup *rename-word-mode-ah? +1095 compare rename-word-mode?, 0 +1096 break-if-= +1097 # clear a space for the dialog +1098 var top-row/eax: int <- copy cursor-row +1099 top-row <- subtract 3 +1100 var bottom-row/ecx: int <- copy cursor-row +1101 bottom-row <- add 3 +1102 var left-col/edx: int <- copy cursor-col +1103 left-col <- subtract 0x10 +1104 var right-col/ebx: int <- copy cursor-col +1105 right-col <- add 0x10 +1106 clear-rect screen, top-row, left-col, bottom-row, right-col +1107 draw-box screen, top-row, left-col, bottom-row, right-col +1108 # render a little menu for the dialog +1109 var menu-row/ecx: int <- copy bottom-row +1110 menu-row <- decrement +1111 var menu-col/edx: int <- copy left-col +1112 menu-col <- add 2 +1113 move-cursor screen, menu-row, menu-col +1114 start-reverse-video screen +1115 print-string screen, " esc " +1116 reset-formatting screen +1117 print-string screen, " cancel " +1118 start-reverse-video screen +1119 print-string screen, " enter " +1120 reset-formatting screen +1121 print-string screen, " rename " +1122 # draw the word, positioned appropriately around the cursor +1123 var start-col/ecx: int <- copy cursor-col +1124 var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-cursor-word +1125 var word/eax: (addr word) <- lookup *word-ah? +1126 var cursor-index/eax: int <- cursor-index word +1127 start-col <- subtract cursor-index +1128 move-cursor screen, cursor-row, start-col +1129 var word/eax: (addr word) <- lookup *word-ah? +1130 print-word screen, word +1131 } +1132 +1133 fn render-define-dialog screen: (addr screen), _sandbox: (addr sandbox), cursor-row: int, cursor-col: int { +1134 var sandbox/edi: (addr sandbox) <- copy _sandbox +1135 var define-function-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-function +1136 var define-function-mode?/eax: (addr word) <- lookup *define-function-mode-ah? +1137 compare define-function-mode?, 0 +1138 break-if-= +1139 # clear a space for the dialog +1140 var top-row/eax: int <- copy cursor-row +1141 top-row <- subtract 3 +1142 var bottom-row/ecx: int <- copy cursor-row +1143 bottom-row <- add 3 +1144 var left-col/edx: int <- copy cursor-col +1145 left-col <- subtract 0x10 +1146 var right-col/ebx: int <- copy cursor-col +1147 right-col <- add 0x10 +1148 clear-rect screen, top-row, left-col, bottom-row, right-col +1149 draw-box screen, top-row, left-col, bottom-row, right-col +1150 # render a little menu for the dialog +1151 var menu-row/ecx: int <- copy bottom-row +1152 menu-row <- decrement +1153 var menu-col/edx: int <- copy left-col +1154 menu-col <- add 2 +1155 move-cursor screen, menu-row, menu-col +1156 start-reverse-video screen +1157 print-string screen, " esc " +1158 reset-formatting screen +1159 print-string screen, " cancel " +1160 start-reverse-video screen +1161 print-string screen, " enter " +1162 reset-formatting screen +1163 print-string screen, " define " +1164 # draw the word, positioned appropriately around the cursor +1165 var start-col/ecx: int <- copy cursor-col +1166 var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-function +1167 var word/eax: (addr word) <- lookup *word-ah? +1168 var cursor-index/eax: int <- cursor-index word +1169 start-col <- subtract cursor-index +1170 move-cursor screen, cursor-row, start-col +1171 var word/eax: (addr word) <- lookup *word-ah? +1172 print-word screen, word +1173 } +1174 +1175 # Render just the words in 'line'. +1176 fn render-line-without-stack screen: (addr screen), _line: (addr line), curr-row: int, left-col: int, cursor-word: (addr word), cursor-row-addr: (addr int), cursor-col-addr: (addr int) { +1177 # curr-word +1178 var line/eax: (addr line) <- copy _line +1179 var first-word-ah/eax: (addr handle word) <- get line, data +1180 var _curr-word/eax: (addr word) <- lookup *first-word-ah +1181 var curr-word/esi: (addr word) <- copy _curr-word +1182 # +1183 # loop-carried dependency +1184 var curr-col/ecx: int <- copy left-col +1185 # +1186 { +1187 compare curr-word, 0 +1188 break-if-= +1189 #? print-string 0, "-- word in penultimate lines: " +1190 #? { +1191 #? var foo/eax: int <- copy curr-word +1192 #? print-int32-hex 0, foo +1193 #? } +1194 #? print-string 0, "\n" +1195 var old-col/edx: int <- copy curr-col +1196 reset-formatting screen +1197 move-cursor screen, curr-row, curr-col +1198 print-word screen, curr-word +1199 { +1200 var max-width/eax: int <- word-length curr-word +1201 curr-col <- add max-width +1202 curr-col <- add 1 # margin-right +1203 } +1204 # cache cursor column if necessary +1205 { +1206 compare curr-word, cursor-word +1207 break-if-!= +1208 #? print-string 0, "Cursor at " +1209 #? print-int32-decimal 0, curr-row +1210 #? print-string 0, ", " +1211 #? print-int32-decimal 0, old-col +1212 #? print-string 0, "\n" +1213 #? print-string 0, "contents: " +1214 #? print-word 0, cursor-word +1215 #? print-string 0, "\n" +1216 #? { +1217 #? var foo/eax: int <- copy cursor-word +1218 #? print-int32-hex 0, foo +1219 #? print-string 0, "\n" +1220 #? } +1221 var dest/ecx: (addr int) <- copy cursor-row-addr +1222 var src/eax: int <- copy curr-row +1223 copy-to *dest, src +1224 dest <- copy cursor-col-addr +1225 copy-to *dest, old-col +1226 var cursor-index-in-word/eax: int <- cursor-index curr-word +1227 add-to *dest, cursor-index-in-word +1228 } +1229 # loop update +1230 var next-word-ah/edx: (addr handle word) <- get curr-word, next +1231 var _curr-word/eax: (addr word) <- lookup *next-word-ah +1232 curr-word <- copy _curr-word +1233 loop +1234 } +1235 } +1236 +1237 fn call-depth-at-cursor _sandbox: (addr sandbox) -> _/eax: int { +1238 var sandbox/esi: (addr sandbox) <- copy _sandbox +1239 var cursor-call-path/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path +1240 var result/eax: int <- call-path-element-length cursor-call-path +1241 result <- add 2 # input-row - 1 +1242 return result +1243 } +1244 +1245 fn call-path-element-length _x: (addr handle call-path-element) -> _/eax: int { +1246 var curr-ah/ecx: (addr handle call-path-element) <- copy _x +1247 var result/edi: int <- copy 0 +1248 { +1249 var curr/eax: (addr call-path-element) <- lookup *curr-ah +1250 compare curr, 0 +1251 break-if-= +1252 curr-ah <- get curr, next +1253 result <- increment +1254 loop +1255 } +1256 return result +1257 } +1258 +1259 # Render the line of words in line, along with the state of the stack under each word. +1260 # Also render any expanded function calls using recursive calls. +1261 # +1262 # Along the way, compute the column the cursor should be positioned at (cursor-col-addr). +1263 fn render-line screen: (addr screen), functions: (addr handle function), bindings: (addr table), first-line: (addr line), _line: (addr line), expanded-words: (addr handle call-path), top-row: int, left-col: int, curr-path: (addr handle call-path-element), cursor-word: (addr word), cursor-call-path: (addr handle call-path-element), cursor-row-addr: (addr int), cursor-col-addr: (addr int) -> _/ecx: int { +1264 #? print-string 0, "render-line\n" +1265 #? dump-table bindings +1266 # curr-word +1267 var line/esi: (addr line) <- copy _line +1268 var first-word-ah/eax: (addr handle word) <- get line, data +1269 var curr-word/eax: (addr word) <- lookup *first-word-ah +1270 # +1271 # loop-carried dependency +1272 var curr-col/ecx: int <- copy left-col +1273 # +1274 { +1275 compare curr-word, 0 +1276 break-if-= +1277 #? print-string 0, "-- word " +1278 #? print-word 0, curr-word +1279 #? print-string 0, "\n" +1280 # if necessary, first render columns for subsidiary stack +1281 $render-line:subsidiary: { +1282 { +1283 #? print-string 0, "check sub\n" +1284 var display-subsidiary-stack?/eax: boolean <- find-in-call-paths expanded-words, curr-path +1285 compare display-subsidiary-stack?, 0 # false +1286 break-if-= $render-line:subsidiary +1287 } +1288 #? print-string 0, "render subsidiary stack\n" +1289 # does function exist? +1290 var callee/edi: (addr function) <- copy 0 +1291 { +1292 var callee-h: (handle function) +1293 var callee-ah/ecx: (addr handle function) <- address callee-h +1294 callee functions, curr-word, callee-ah +1295 var _callee/eax: (addr function) <- lookup *callee-ah +1296 callee <- copy _callee +1297 compare callee, 0 +1298 break-if-= $render-line:subsidiary +1299 } +1300 move-cursor screen, top-row, curr-col +1301 start-color screen, 8, 7 +1302 print-word screen, curr-word +1303 { +1304 var word-len/eax: int <- word-length curr-word +1305 curr-col <- add word-len +1306 curr-col <- add 2 +1307 increment top-row +1308 } +1309 # obtain stack at call site +1310 var stack-storage: value-stack +1311 var stack/edx: (addr value-stack) <- address stack-storage +1312 initialize-value-stack stack, 0x10 +1313 { +1314 var prev-word-ah/eax: (addr handle word) <- get curr-word, prev +1315 var prev-word/eax: (addr word) <- lookup *prev-word-ah +1316 compare prev-word, 0 +1317 break-if-= +1318 var bindings2-storage: table +1319 var bindings2/ebx: (addr table) <- address bindings2-storage +1320 deep-copy-table bindings, bindings2 +1321 evaluate functions, bindings2, first-line, prev-word, stack +1322 } +1323 # construct new bindings +1324 var callee-bindings-storage: table +1325 var callee-bindings/esi: (addr table) <- address callee-bindings-storage +1326 initialize-table callee-bindings, 0x10 +1327 bind-args callee, stack, callee-bindings +1328 # obtain body +1329 var callee-body-ah/eax: (addr handle line) <- get callee, body +1330 var callee-body/eax: (addr line) <- lookup *callee-body-ah +1331 var callee-body-first-word/edx: (addr handle word) <- get callee-body, data +1332 # - render subsidiary stack +1333 push-to-call-path-element curr-path, callee-body-first-word # leak +1334 #? print-string 0, "subsidiary {\n" +1335 #? dump-table callee-bindings +1336 #? syscall_exit +1337 curr-col <- render-line screen, functions, callee-bindings, callee-body, callee-body, expanded-words, top-row, curr-col, curr-path, cursor-word, cursor-call-path, cursor-row-addr, cursor-col-addr +1338 #? print-string 0, "}\n" +1339 drop-from-call-path-element curr-path +1340 # +1341 move-cursor screen, top-row, curr-col +1342 print-code-point screen, 0x21d7 # ⇗ +1343 # +1344 curr-col <- add 2 +1345 decrement top-row +1346 } +1347 # render main column +1348 var old-col/edx: int <- copy curr-col +1349 var bindings2-storage: table +1350 var bindings2/ebx: (addr table) <- address bindings2-storage +1351 #? print-string 0, "deep-copy {\n" +1352 deep-copy-table bindings, bindings2 +1353 #? print-string 0, "}\n" +1354 #? print-string 0, "render column {\n" +1355 curr-col <- render-column screen, functions, bindings2, first-line, line, curr-word, top-row, curr-col +1356 #? print-string 0, "}\n" +1357 # cache cursor column if necessary +1358 $render-line:cache-cursor-column: { +1359 { +1360 var found?/eax: boolean <- call-path-element-match? curr-path, cursor-call-path +1361 compare found?, 0 # false +1362 break-if-= $render-line:cache-cursor-column +1363 } +1364 var dest/edi: (addr int) <- copy cursor-row-addr +1365 { +1366 var src/eax: int <- copy top-row +1367 copy-to *dest, src +1368 } +1369 dest <- copy cursor-col-addr +1370 copy-to *dest, old-col +1371 var cursor-index-in-word/eax: int <- cursor-index curr-word +1372 add-to *dest, cursor-index-in-word +1373 } +1374 # loop update +1375 #? print-string 0, "next word\n" +1376 var next-word-ah/edx: (addr handle word) <- get curr-word, next +1377 curr-word <- lookup *next-word-ah +1378 #? { +1379 #? var foo/eax: int <- copy curr-word +1380 #? print-int32-hex 0, foo +1381 #? print-string 0, "\n" +1382 #? } +1383 increment-final-element curr-path +1384 loop +1385 } +1386 return curr-col +1387 } +1388 +1389 fn callee functions: (addr handle function), word: (addr word), out: (addr handle function) { +1390 var stream-storage: (stream byte 0x10) +1391 var stream/esi: (addr stream byte) <- address stream-storage +1392 emit-word word, stream +1393 find-function functions, stream, out +1394 } +1395 +1396 # Render: +1397 # - starting at top-row, left-col: final-word +1398 # - starting somewhere below at left-col: the stack result from interpreting first-world to final-word (inclusive) +1399 # +1400 # Return the farthest column written. +1401 fn render-column screen: (addr screen), functions: (addr handle function), bindings: (addr table), first-line: (addr line), line: (addr line), final-word: (addr word), top-row: int, left-col: int -> _/ecx: int { +1402 #? print-string 0, "render-column\n" +1403 #? dump-table bindings +1404 var max-width/esi: int <- copy 0 +1405 { +1406 # compute stack +1407 var stack: value-stack +1408 var stack-addr/edi: (addr value-stack) <- address stack +1409 initialize-value-stack stack-addr, 0x10 # max-words +1410 # copy bindings +1411 var bindings2-storage: table +1412 var bindings2/ebx: (addr table) <- address bindings2-storage +1413 #? print-string 0, "deep copy table {\n" +1414 deep-copy-table bindings, bindings2 +1415 #? print-string 0, "}\n" +1416 evaluate functions, bindings2, first-line, final-word, stack-addr +1417 # indent stack +1418 var indented-col/ebx: int <- copy left-col +1419 indented-col <- add 1 # margin-right +1420 # render stack +1421 var curr-row/edx: int <- copy top-row +1422 curr-row <- add 2 # stack-margin-top +1423 var _max-width/eax: int <- value-stack-max-width stack-addr +1424 max-width <- copy _max-width +1425 { +1426 var top-addr/ecx: (addr int) <- get stack-addr, top +1427 compare *top-addr, 0 +1428 break-if-<= +1429 decrement *top-addr +1430 var data-ah/eax: (addr handle array value) <- get stack-addr, data +1431 var data/eax: (addr array value) <- lookup *data-ah +1432 var top/ecx: int <- copy *top-addr +1433 var dest-offset/ecx: (offset value) <- compute-offset data, top +1434 var val/eax: (addr value) <- index data, dest-offset +1435 render-value-at screen, curr-row, indented-col, val, max-width +1436 var height/eax: int <- value-height val +1437 curr-row <- add height +1438 loop +1439 } +1440 } +1441 +1442 max-width <- add 2 # spaces on either side of items on the stack +1443 +1444 # render word, initialize result +1445 reset-formatting screen +1446 move-cursor screen, top-row, left-col +1447 print-word screen, final-word +1448 { +1449 var size/eax: int <- word-length final-word +1450 compare size, max-width +1451 break-if-<= +1452 max-width <- copy size +1453 } +1454 +1455 # post-process right-col +1456 var right-col/ecx: int <- copy left-col +1457 right-col <- add max-width +1458 right-col <- add 1 # margin-right +1459 #? print-int32-decimal 0, left-col +1460 #? print-string 0, " => " +1461 #? print-int32-decimal 0, right-col +1462 #? print-string 0, "\n" +1463 return right-col +1464 } +1465 +1466 fn clear-canvas _env: (addr environment) { +1467 var env/esi: (addr environment) <- copy _env +1468 var screen-ah/edi: (addr handle screen) <- get env, screen +1469 var _screen/eax: (addr screen) <- lookup *screen-ah +1470 var screen/edi: (addr screen) <- copy _screen +1471 clear-screen screen +1472 var nrows/eax: (addr int) <- get env, nrows +1473 var _repl-col/ecx: (addr int) <- get env, code-separator-col +1474 var repl-col/ecx: int <- copy *_repl-col +1475 draw-vertical-line screen, 1, *nrows, repl-col +1476 # wordstar-style cheatsheet of shortcuts +1477 move-cursor screen, *nrows, 0 +1478 start-reverse-video screen +1479 print-string screen, " ctrl-q " +1480 reset-formatting screen +1481 print-string screen, " quit " +1482 var menu-start/ebx: int <- copy repl-col +1483 menu-start <- subtract 0x40 # 64 = half the size of the menu +1484 move-cursor screen, *nrows, menu-start +1485 start-reverse-video screen +1486 print-string screen, " ctrl-a " +1487 reset-formatting screen +1488 print-string screen, " ⏮ " +1489 start-reverse-video screen +1490 print-string screen, " ctrl-b " +1491 reset-formatting screen +1492 print-string screen, " ◀ word " +1493 start-reverse-video screen +1494 print-string screen, " ctrl-f " +1495 reset-formatting screen +1496 print-string screen, " word ▶ " +1497 start-reverse-video screen +1498 print-string screen, " ctrl-e " +1499 reset-formatting screen +1500 print-string screen, " ⏭ " +1501 start-reverse-video screen +1502 print-string screen, " ctrl-u " +1503 reset-formatting screen +1504 print-string screen, " clear line " +1505 start-reverse-video screen +1506 print-string screen, " ctrl-n " +1507 reset-formatting screen +1508 print-string screen, " name value " +1509 start-reverse-video screen +1510 print-string screen, " ctrl-d " +1511 reset-formatting screen +1512 print-string screen, " define function " +1513 # primitives +1514 var start-col/ecx: int <- copy repl-col +1515 start-col <- subtract 0x28 +1516 move-cursor screen, 1, start-col +1517 print-string screen, "primitives:" +1518 start-col <- add 2 +1519 move-cursor screen, 2, start-col +1520 print-string screen, "+ - * len" +1521 move-cursor screen, 3, start-col +1522 print-string screen, "open read slurp lines" +1523 move-cursor screen, 4, start-col +1524 print-string screen, "fake-screen print move" +1525 move-cursor screen, 5, start-col +1526 print-string screen, "up down left right" +1527 move-cursor screen, 6, start-col +1528 print-string screen, "dup swap" +1529 # currently defined functions +1530 start-col <- subtract 2 +1531 move-cursor screen, 8, start-col +1532 print-string screen, "functions:" +1533 start-col <- add 2 +1534 var row/ebx: int <- copy 9 +1535 var functions/esi: (addr handle function) <- get env, functions +1536 { +1537 var curr/eax: (addr function) <- lookup *functions +1538 compare curr, 0 +1539 break-if-= +1540 row <- render-function screen, row, start-col, curr +1541 functions <- get curr, next +1542 row <- increment +1543 loop +1544 } +1545 } +1546 +1547 # only single-line functions supported for now +1548 fn render-function screen: (addr screen), row: int, col: int, _f: (addr function) -> _/ebx: int { +1549 var f/esi: (addr function) <- copy _f +1550 var args/ecx: (addr handle word) <- get f, args +1551 move-cursor screen, row, col +1552 print-words-in-reverse screen, args +1553 var name-ah/eax: (addr handle array byte) <- get f, name +1554 var name/eax: (addr array byte) <- lookup *name-ah +1555 start-bold screen +1556 print-string screen, name +1557 reset-formatting screen +1558 increment row +1559 add-to col, 2 +1560 move-cursor screen, row, col +1561 print-string screen, "= " +1562 var body-ah/eax: (addr handle line) <- get f, body +1563 var body/eax: (addr line) <- lookup *body-ah +1564 var body-words-ah/eax: (addr handle word) <- get body, data +1565 print-words screen, body-words-ah +1566 return row +1567 } +1568 +1569 fn real-grapheme? g: grapheme -> _/eax: boolean { +1570 # if g == newline return true +1571 compare g, 0xa +1572 { +1573 break-if-!= +1574 return 1 # true +1575 } +1576 # if g == tab return true +1577 compare g, 9 +1578 { +1579 break-if-!= +1580 return 1 # true +1581 } +1582 # if g < 32 return false +1583 compare g, 0x20 +1584 { +1585 break-if->= +1586 return 0 # false +1587 } +1588 # if g <= 255 return true +1589 compare g, 0xff +1590 { +1591 break-if-> +1592 return 1 # true +1593 } +1594 # if (g&0xff == Esc) it's an escape sequence +1595 and-with g, 0xff +1596 compare g, 0x1b # Esc +1597 { +1598 break-if-!= +1599 return 0 # false +1600 } +1601 # otherwise return true +1602 return 1 # true +1603 } diff --git a/html/apps/tile/main.mu.html b/html/apps/tile/main.mu.html index 745ba507..1629a012 100644 --- a/html/apps/tile/main.mu.html +++ b/html/apps/tile/main.mu.html @@ -85,7 +85,7 @@ if ('onhashchange' in window) { 26 compare tmp2, 0 # false 27 { 28 break-if-= - 29 repl + 29 repl 30 return 0 31 } 32 # if single arg is 'test' ... @@ -125,61 +125,78 @@ if ('onhashchange' in window) { 66 } 67 68 fn test { - 69 test-surface-pin-at-origin - 70 #? var env-storage: environment - 71 #? var env/esi: (addr environment) <- address env-storage - 72 #? initialize-environment-with-fake-screen env, 5, 0xa - 73 #? var g/eax: grapheme <- copy 0x22 # '"' - 74 #? process env, g - 75 #? g <- copy 0x61 # 'a' - 76 #? process env, g - 77 #? g <- copy 0x22 # '"' - 78 #? process env, g - 79 #? render env - 80 } - 81 - 82 fn repl { - 83 { - 84 # prompt - 85 print-string-to-real-screen "> " - 86 # read - 87 var line-storage: (stream byte 0x100) - 88 var line/ecx: (addr stream byte) <- address line-storage - 89 clear-stream line - 90 read-line-from-real-keyboard line - 91 var done?/eax: boolean <- stream-empty? line - 92 compare done?, 0 # false - 93 break-if-!= - 94 # parse - 95 var env-storage: environment - 96 var env/esi: (addr environment) <- address env-storage - 97 initialize-environment env - 98 { - 99 var done?/eax: boolean <- stream-empty? line -100 compare done?, 0 # false -101 break-if-!= -102 var g/eax: grapheme <- read-grapheme line -103 process env, g -104 loop -105 } -106 # eval -107 var stack-storage: value-stack -108 var stack/edi: (addr value-stack) <- address stack-storage -109 initialize-value-stack stack, 0x10 -110 evaluate-environment env, stack -111 # print -112 var empty?/eax: boolean <- value-stack-empty? stack -113 { -114 compare empty?, 0 # false -115 break-if-!= -116 var result/eax: int <- pop-int-from-value-stack stack -117 print-int32-decimal-to-real-screen result -118 print-string-to-real-screen "\n" -119 } -120 # -121 loop -122 } -123 } + 69 var env-storage: environment + 70 var env/esi: (addr environment) <- address env-storage + 71 initialize-environment-with-fake-screen env, 0x20, 0xa0 + 72 process-all env, "3 3 fake-screen =s" + 73 process env, 0xc # ctrl-l + 74 process-all env, "s 1 down 1 right" + 75 process env, 4 # ctrl-d: start defining function + 76 process-all env, "foo" + 77 process env, 0xa # newline: define function + 78 process env, 0x435b1b # right-arrow + 79 #? process env, 5 # ctrl-e: end of line + 80 print-string 0, "==\n" + 81 process env, 0xa # newline: expand + 82 render env + 83 } + 84 + 85 fn process-all env: (addr environment), cmds: (addr array byte) { + 86 var cmds-stream: (stream byte 0x100) + 87 var cmds-stream-a/esi: (addr stream byte) <- address cmds-stream + 88 write cmds-stream-a, cmds + 89 { + 90 var done?/eax: boolean <- stream-empty? cmds-stream-a + 91 compare done?, 0 # false + 92 break-if-!= + 93 var g/eax: grapheme <- read-grapheme cmds-stream-a + 94 process env, g + 95 loop + 96 } + 97 } + 98 + 99 fn repl { +100 { +101 # prompt +102 print-string-to-real-screen "> " +103 # read +104 var line-storage: (stream byte 0x100) +105 var line/ecx: (addr stream byte) <- address line-storage +106 clear-stream line +107 read-line-from-real-keyboard line +108 var done?/eax: boolean <- stream-empty? line +109 compare done?, 0 # false +110 break-if-!= +111 # parse +112 var env-storage: environment +113 var env/esi: (addr environment) <- address env-storage +114 initialize-environment env +115 { +116 var done?/eax: boolean <- stream-empty? line +117 compare done?, 0 # false +118 break-if-!= +119 var g/eax: grapheme <- read-grapheme line +120 process env, g +121 loop +122 } +123 # eval +124 var stack-storage: value-stack +125 var stack/edi: (addr value-stack) <- address stack-storage +126 initialize-value-stack stack, 0x10 +127 evaluate-environment env, stack +128 # print +129 var empty?/eax: boolean <- value-stack-empty? stack +130 { +131 compare empty?, 0 # false +132 break-if-!= +133 var result/eax: int <- pop-int-from-value-stack stack +134 print-int32-decimal-to-real-screen result +135 print-string-to-real-screen "\n" +136 } +137 # +138 loop +139 } +140 } diff --git a/html/apps/tile/rpn.mu.html b/html/apps/tile/rpn.mu.html index 54af3e40..c67a5d75 100644 --- a/html/apps/tile/rpn.mu.html +++ b/html/apps/tile/rpn.mu.html @@ -71,603 +71,884 @@ if ('onhashchange' in window) { 11 break-if-= 12 # update curr-stream 13 emit-word curr, curr-stream - 14 #? print-stream-to-real-screen curr-stream - 15 #? print-string-to-real-screen "\n" - 16 $evaluate:process-word: { - 17 # if curr-stream is an operator, perform it - 18 { - 19 var is-add?/eax: boolean <- stream-data-equal? curr-stream, "+" - 20 compare is-add?, 0 - 21 break-if-= - 22 var _b/eax: int <- pop-int-from-value-stack out - 23 var b/edx: int <- copy _b - 24 var a/eax: int <- pop-int-from-value-stack out - 25 a <- add b - 26 push-int-to-value-stack out, a - 27 break $evaluate:process-word - 28 } - 29 { - 30 var is-sub?/eax: boolean <- stream-data-equal? curr-stream, "-" - 31 compare is-sub?, 0 - 32 break-if-= - 33 var _b/eax: int <- pop-int-from-value-stack out - 34 var b/edx: int <- copy _b - 35 var a/eax: int <- pop-int-from-value-stack out - 36 a <- subtract b - 37 push-int-to-value-stack out, a - 38 break $evaluate:process-word - 39 } - 40 { - 41 var is-mul?/eax: boolean <- stream-data-equal? curr-stream, "*" - 42 compare is-mul?, 0 - 43 break-if-= - 44 var _b/eax: int <- pop-int-from-value-stack out - 45 var b/edx: int <- copy _b - 46 var a/eax: int <- pop-int-from-value-stack out - 47 a <- multiply b - 48 push-int-to-value-stack out, a - 49 break $evaluate:process-word - 50 } - 51 { - 52 var is-len?/eax: boolean <- stream-data-equal? curr-stream, "len" - 53 compare is-len?, 0 - 54 break-if-= - 55 #? print-string 0, "is len\n" - 56 # pop target-val from out - 57 var out2/esi: (addr value-stack) <- copy out - 58 var top-addr/ecx: (addr int) <- get out2, top - 59 compare *top-addr, 0 - 60 break-if-<= - 61 #? print-string 0, "stack has stuff\n" - 62 var data-ah/eax: (addr handle array value) <- get out2, data - 63 var data/eax: (addr array value) <- lookup *data-ah - 64 var top/edx: int <- copy *top-addr - 65 top <- decrement - 66 var dest-offset/edx: (offset value) <- compute-offset data, top - 67 var target-val/edx: (addr value) <- index data, dest-offset - 68 # check target-val is a string or array - 69 var target-type-addr/eax: (addr int) <- get target-val, type - 70 compare *target-type-addr, 1 # string - 71 { - 72 break-if-!= - 73 # compute length - 74 var src-ah/eax: (addr handle array byte) <- get target-val, text-data - 75 var src/eax: (addr array byte) <- lookup *src-ah - 76 var result/ebx: int <- length src - 77 # save result into target-val - 78 var type-addr/eax: (addr int) <- get target-val, type - 79 copy-to *type-addr, 0 # int - 80 var target-string-ah/eax: (addr handle array byte) <- get target-val, text-data - 81 var empty: (handle array byte) - 82 copy-handle empty, target-string-ah - 83 var target/eax: (addr int) <- get target-val, int-data - 84 copy-to *target, result - 85 break $evaluate:process-word - 86 } - 87 compare *target-type-addr, 2 # array of ints - 88 { - 89 break-if-!= - 90 # compute length - 91 var src-ah/eax: (addr handle array value) <- get target-val, array-data - 92 var src/eax: (addr array value) <- lookup *src-ah - 93 var result/ebx: int <- length src - 94 # save result into target-val - 95 var type-addr/eax: (addr int) <- get target-val, type - 96 copy-to *type-addr, 0 # int - 97 var target-array-ah/eax: (addr handle array value) <- get target-val, array-data - 98 var empty: (handle array value) - 99 copy-handle empty, target-array-ah -100 var target/eax: (addr int) <- get target-val, int-data -101 copy-to *target, result -102 break $evaluate:process-word -103 } -104 } -105 { -106 var is-open?/eax: boolean <- stream-data-equal? curr-stream, "open" -107 compare is-open?, 0 -108 break-if-= -109 # pop target-val from out -110 var out2/esi: (addr value-stack) <- copy out -111 var top-addr/ecx: (addr int) <- get out2, top -112 compare *top-addr, 0 -113 break-if-<= -114 var data-ah/eax: (addr handle array value) <- get out2, data -115 var data/eax: (addr array value) <- lookup *data-ah -116 var top/edx: int <- copy *top-addr -117 top <- decrement -118 var dest-offset/edx: (offset value) <- compute-offset data, top -119 var target-val/edx: (addr value) <- index data, dest-offset -120 # check target-val is a string -121 var target-type-addr/eax: (addr int) <- get target-val, type -122 compare *target-type-addr, 1 # string -123 break-if-!= -124 # open target-val as a filename and save the handle in target-val -125 var src-ah/eax: (addr handle array byte) <- get target-val, text-data -126 var src/eax: (addr array byte) <- lookup *src-ah -127 var result-ah/ecx: (addr handle buffered-file) <- get target-val, file-data -128 open src, 0, result-ah # write? = false -129 # save result into target-val -130 var type-addr/eax: (addr int) <- get target-val, type -131 copy-to *type-addr, 3 # file -132 var target-string-ah/eax: (addr handle array byte) <- get target-val, text-data -133 var empty: (handle array byte) -134 copy-handle empty, target-string-ah -135 break $evaluate:process-word -136 } -137 { -138 var is-read?/eax: boolean <- stream-data-equal? curr-stream, "read" -139 compare is-read?, 0 -140 break-if-= -141 # pop target-val from out -142 var out2/esi: (addr value-stack) <- copy out -143 var top-addr/ecx: (addr int) <- get out2, top -144 compare *top-addr, 0 -145 break-if-<= -146 var data-ah/eax: (addr handle array value) <- get out2, data -147 var data/eax: (addr array value) <- lookup *data-ah -148 var top/edx: int <- copy *top-addr -149 top <- decrement -150 var dest-offset/edx: (offset value) <- compute-offset data, top -151 var target-val/edx: (addr value) <- index data, dest-offset -152 # check target-val is a file -153 var target-type-addr/eax: (addr int) <- get target-val, type -154 compare *target-type-addr, 3 # file -155 break-if-!= -156 # read a line from the file and save in target-val -157 # read target-val as a filename and save the handle in target-val -158 var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data -159 var file/eax: (addr buffered-file) <- lookup *file-ah -160 var s: (stream byte 0x100) -161 var s-addr/ecx: (addr stream byte) <- address s -162 read-line-buffered file, s-addr -163 var target/eax: (addr handle array byte) <- get target-val, text-data -164 stream-to-array s-addr, target -165 # save result into target-val -166 var type-addr/eax: (addr int) <- get target-val, type -167 copy-to *type-addr, 1 # string -168 var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data -169 var empty: (handle buffered-file) -170 copy-handle empty, target-file-ah -171 break $evaluate:process-word -172 } -173 { -174 var is-slurp?/eax: boolean <- stream-data-equal? curr-stream, "slurp" -175 compare is-slurp?, 0 -176 break-if-= -177 # pop target-val from out -178 var out2/esi: (addr value-stack) <- copy out -179 var top-addr/ecx: (addr int) <- get out2, top -180 compare *top-addr, 0 -181 break-if-<= -182 var data-ah/eax: (addr handle array value) <- get out2, data -183 var data/eax: (addr array value) <- lookup *data-ah -184 var top/edx: int <- copy *top-addr -185 top <- decrement -186 var dest-offset/edx: (offset value) <- compute-offset data, top -187 var target-val/edx: (addr value) <- index data, dest-offset -188 # check target-val is a file -189 var target-type-addr/eax: (addr int) <- get target-val, type -190 compare *target-type-addr, 3 # file -191 break-if-!= -192 # slurp all contents from file and save in target-val -193 # read target-val as a filename and save the handle in target-val -194 var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data -195 var file/eax: (addr buffered-file) <- lookup *file-ah -196 var s: (stream byte 0x100) -197 var s-addr/ecx: (addr stream byte) <- address s -198 slurp file, s-addr -199 var target/eax: (addr handle array byte) <- get target-val, text-data -200 stream-to-array s-addr, target -201 # save result into target-val -202 var type-addr/eax: (addr int) <- get target-val, type -203 copy-to *type-addr, 1 # string -204 var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data -205 var empty: (handle buffered-file) -206 copy-handle empty, target-file-ah -207 break $evaluate:process-word -208 } -209 { -210 var is-lines?/eax: boolean <- stream-data-equal? curr-stream, "lines" -211 compare is-lines?, 0 -212 break-if-= -213 # pop target-val from out -214 var out2/esi: (addr value-stack) <- copy out -215 var top-addr/ecx: (addr int) <- get out2, top -216 compare *top-addr, 0 -217 break-if-<= -218 var data-ah/eax: (addr handle array value) <- get out2, data -219 var data/eax: (addr array value) <- lookup *data-ah -220 var top/edx: int <- copy *top-addr -221 top <- decrement -222 var dest-offset/edx: (offset value) <- compute-offset data, top -223 var target-val/edx: (addr value) <- index data, dest-offset -224 # check target-val is a file -225 var target-type-addr/eax: (addr int) <- get target-val, type -226 compare *target-type-addr, 3 # file -227 break-if-!= -228 # read all lines from file and save as an array of strings in target-val -229 # read target-val as a filename and save the handle in target-val -230 var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data -231 var file/eax: (addr buffered-file) <- lookup *file-ah -232 var s: (stream byte 0x100) -233 var s-addr/ecx: (addr stream byte) <- address s -234 slurp file, s-addr -235 var tmp-ah/eax: (addr handle array byte) <- get target-val, text-data -236 stream-to-array s-addr, tmp-ah -237 var tmp/eax: (addr array byte) <- lookup *tmp-ah -238 #? enable-screen-type-mode -239 #? print-string 0, tmp -240 var h: (handle array (handle array byte)) -241 { -242 var ah/edx: (addr handle array (handle array byte)) <- address h -243 split-string tmp, 0xa, ah -244 } -245 var target/eax: (addr handle array value) <- get target-val, array-data -246 save-lines h, target -247 # save result into target-val -248 var type-addr/eax: (addr int) <- get target-val, type -249 copy-to *type-addr, 2 # array -250 var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data -251 var empty-file: (handle buffered-file) -252 copy-handle empty-file, target-file-ah -253 var target-text-ah/eax: (addr handle array byte) <- get target-val, text-data -254 var empty-text: (handle array byte) -255 copy-handle empty-text, target-text-ah -256 break $evaluate:process-word -257 } -258 # if curr-stream defines a binding, save top of stack to bindings -259 { -260 var done?/eax: boolean <- stream-empty? curr-stream -261 compare done?, 0 # false -262 break-if-!= -263 var new-byte/eax: byte <- read-byte curr-stream -264 compare new-byte, 0x3d # '=' -265 break-if-!= -266 # pop target-val from out -267 var out2/esi: (addr value-stack) <- copy out -268 var top-addr/ecx: (addr int) <- get out2, top -269 compare *top-addr, 0 -270 break-if-<= -271 var data-ah/eax: (addr handle array value) <- get out2, data -272 var data/eax: (addr array value) <- lookup *data-ah -273 var top/edx: int <- copy *top-addr -274 top <- decrement -275 var dest-offset/edx: (offset value) <- compute-offset data, top -276 var target-val/edx: (addr value) <- index data, dest-offset -277 # create binding from curr-stream to target-val -278 var key-h: (handle array byte) -279 var key/ecx: (addr handle array byte) <- address key-h -280 stream-to-array curr-stream, key -281 bind-in-table bindings, key, target-val -282 break $evaluate:process-word -283 } -284 rewind-stream curr-stream -285 # if curr-stream is a known function name, call it appropriately -286 { -287 var callee-h: (handle function) -288 var callee-ah/eax: (addr handle function) <- address callee-h -289 find-function functions, curr-stream, callee-ah -290 var callee/eax: (addr function) <- lookup *callee-ah -291 compare callee, 0 -292 break-if-= -293 perform-call callee, out, functions -294 break $evaluate:process-word -295 } -296 # HACKS: we're trying to avoid turning this into Forth + 14 #? print-string-to-real-screen "eval: " + 15 #? print-stream-to-real-screen curr-stream + 16 #? print-string-to-real-screen "\n" + 17 $evaluate:process-word: { + 18 ### if curr-stream is an operator, perform it + 19 ## numbers + 20 { + 21 var is-add?/eax: boolean <- stream-data-equal? curr-stream, "+" + 22 compare is-add?, 0 + 23 break-if-= + 24 var _b/eax: int <- pop-int-from-value-stack out + 25 var b/edx: int <- copy _b + 26 var a/eax: int <- pop-int-from-value-stack out + 27 a <- add b + 28 push-int-to-value-stack out, a + 29 break $evaluate:process-word + 30 } + 31 { + 32 var is-sub?/eax: boolean <- stream-data-equal? curr-stream, "-" + 33 compare is-sub?, 0 + 34 break-if-= + 35 var _b/eax: int <- pop-int-from-value-stack out + 36 var b/edx: int <- copy _b + 37 var a/eax: int <- pop-int-from-value-stack out + 38 a <- subtract b + 39 push-int-to-value-stack out, a + 40 break $evaluate:process-word + 41 } + 42 { + 43 var is-mul?/eax: boolean <- stream-data-equal? curr-stream, "*" + 44 compare is-mul?, 0 + 45 break-if-= + 46 var _b/eax: int <- pop-int-from-value-stack out + 47 var b/edx: int <- copy _b + 48 var a/eax: int <- pop-int-from-value-stack out + 49 a <- multiply b + 50 push-int-to-value-stack out, a + 51 break $evaluate:process-word + 52 } + 53 ## strings/arrays + 54 { + 55 var is-len?/eax: boolean <- stream-data-equal? curr-stream, "len" + 56 compare is-len?, 0 + 57 break-if-= + 58 #? print-string 0, "is len\n" + 59 # pop target-val from out + 60 var out2/esi: (addr value-stack) <- copy out + 61 var top-addr/ecx: (addr int) <- get out2, top + 62 compare *top-addr, 0 + 63 break-if-<= + 64 #? print-string 0, "stack has stuff\n" + 65 var data-ah/eax: (addr handle array value) <- get out2, data + 66 var data/eax: (addr array value) <- lookup *data-ah + 67 var top/edx: int <- copy *top-addr + 68 top <- decrement + 69 var dest-offset/edx: (offset value) <- compute-offset data, top + 70 var target-val/edx: (addr value) <- index data, dest-offset + 71 # check target-val is a string or array + 72 var target-type-addr/eax: (addr int) <- get target-val, type + 73 compare *target-type-addr, 1 # string + 74 { + 75 break-if-!= + 76 # compute length + 77 var src-ah/eax: (addr handle array byte) <- get target-val, text-data + 78 var src/eax: (addr array byte) <- lookup *src-ah + 79 var result/ebx: int <- length src + 80 # save result into target-val + 81 var type-addr/eax: (addr int) <- get target-val, type + 82 copy-to *type-addr, 0 # int + 83 var target-string-ah/eax: (addr handle array byte) <- get target-val, text-data + 84 var empty: (handle array byte) + 85 copy-handle empty, target-string-ah + 86 var target/eax: (addr int) <- get target-val, int-data + 87 copy-to *target, result + 88 break $evaluate:process-word + 89 } + 90 compare *target-type-addr, 2 # array of ints + 91 { + 92 break-if-!= + 93 # compute length + 94 var src-ah/eax: (addr handle array value) <- get target-val, array-data + 95 var src/eax: (addr array value) <- lookup *src-ah + 96 var result/ebx: int <- length src + 97 # save result into target-val + 98 var type-addr/eax: (addr int) <- get target-val, type + 99 copy-to *type-addr, 0 # int +100 var target-array-ah/eax: (addr handle array value) <- get target-val, array-data +101 var empty: (handle array value) +102 copy-handle empty, target-array-ah +103 var target/eax: (addr int) <- get target-val, int-data +104 copy-to *target, result +105 break $evaluate:process-word +106 } +107 } +108 ## files +109 { +110 var is-open?/eax: boolean <- stream-data-equal? curr-stream, "open" +111 compare is-open?, 0 +112 break-if-= +113 # pop target-val from out +114 var out2/esi: (addr value-stack) <- copy out +115 var top-addr/ecx: (addr int) <- get out2, top +116 compare *top-addr, 0 +117 break-if-<= +118 var data-ah/eax: (addr handle array value) <- get out2, data +119 var data/eax: (addr array value) <- lookup *data-ah +120 var top/edx: int <- copy *top-addr +121 top <- decrement +122 var dest-offset/edx: (offset value) <- compute-offset data, top +123 var target-val/edx: (addr value) <- index data, dest-offset +124 # check target-val is a string +125 var target-type-addr/eax: (addr int) <- get target-val, type +126 compare *target-type-addr, 1 # string +127 break-if-!= +128 # open target-val as a filename and save the handle in target-val +129 var src-ah/eax: (addr handle array byte) <- get target-val, text-data +130 var src/eax: (addr array byte) <- lookup *src-ah +131 var result-ah/ecx: (addr handle buffered-file) <- get target-val, file-data +132 open src, 0, result-ah # write? = false +133 # save result into target-val +134 var type-addr/eax: (addr int) <- get target-val, type +135 copy-to *type-addr, 3 # file +136 var target-string-ah/eax: (addr handle array byte) <- get target-val, text-data +137 var filename-ah/ecx: (addr handle array byte) <- get target-val, filename +138 copy-object target-string-ah, filename-ah +139 var empty: (handle array byte) +140 copy-handle empty, target-string-ah +141 break $evaluate:process-word +142 } +143 { +144 var is-read?/eax: boolean <- stream-data-equal? curr-stream, "read" +145 compare is-read?, 0 +146 break-if-= +147 # pop target-val from out +148 var out2/esi: (addr value-stack) <- copy out +149 var top-addr/ecx: (addr int) <- get out2, top +150 compare *top-addr, 0 +151 break-if-<= +152 var data-ah/eax: (addr handle array value) <- get out2, data +153 var data/eax: (addr array value) <- lookup *data-ah +154 var top/edx: int <- copy *top-addr +155 top <- decrement +156 var dest-offset/edx: (offset value) <- compute-offset data, top +157 var target-val/edx: (addr value) <- index data, dest-offset +158 # check target-val is a file +159 var target-type-addr/eax: (addr int) <- get target-val, type +160 compare *target-type-addr, 3 # file +161 break-if-!= +162 # read a line from the file and save in target-val +163 # read target-val as a filename and save the handle in target-val +164 var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data +165 var file/eax: (addr buffered-file) <- lookup *file-ah +166 var s: (stream byte 0x100) +167 var s-addr/ecx: (addr stream byte) <- address s +168 read-line-buffered file, s-addr +169 var target/eax: (addr handle array byte) <- get target-val, text-data +170 stream-to-array s-addr, target +171 # save result into target-val +172 var type-addr/eax: (addr int) <- get target-val, type +173 copy-to *type-addr, 1 # string +174 var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data +175 var empty: (handle buffered-file) +176 copy-handle empty, target-file-ah +177 break $evaluate:process-word +178 } +179 { +180 var is-slurp?/eax: boolean <- stream-data-equal? curr-stream, "slurp" +181 compare is-slurp?, 0 +182 break-if-= +183 # pop target-val from out +184 var out2/esi: (addr value-stack) <- copy out +185 var top-addr/ecx: (addr int) <- get out2, top +186 compare *top-addr, 0 +187 break-if-<= +188 var data-ah/eax: (addr handle array value) <- get out2, data +189 var data/eax: (addr array value) <- lookup *data-ah +190 var top/edx: int <- copy *top-addr +191 top <- decrement +192 var dest-offset/edx: (offset value) <- compute-offset data, top +193 var target-val/edx: (addr value) <- index data, dest-offset +194 # check target-val is a file +195 var target-type-addr/eax: (addr int) <- get target-val, type +196 compare *target-type-addr, 3 # file +197 break-if-!= +198 # slurp all contents from file and save in target-val +199 # read target-val as a filename and save the handle in target-val +200 var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data +201 var file/eax: (addr buffered-file) <- lookup *file-ah +202 var s: (stream byte 0x100) +203 var s-addr/ecx: (addr stream byte) <- address s +204 slurp file, s-addr +205 var target/eax: (addr handle array byte) <- get target-val, text-data +206 stream-to-array s-addr, target +207 # save result into target-val +208 var type-addr/eax: (addr int) <- get target-val, type +209 copy-to *type-addr, 1 # string +210 var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data +211 var empty: (handle buffered-file) +212 copy-handle empty, target-file-ah +213 break $evaluate:process-word +214 } +215 { +216 var is-lines?/eax: boolean <- stream-data-equal? curr-stream, "lines" +217 compare is-lines?, 0 +218 break-if-= +219 # pop target-val from out +220 var out2/esi: (addr value-stack) <- copy out +221 var top-addr/ecx: (addr int) <- get out2, top +222 compare *top-addr, 0 +223 break-if-<= +224 var data-ah/eax: (addr handle array value) <- get out2, data +225 var data/eax: (addr array value) <- lookup *data-ah +226 var top/edx: int <- copy *top-addr +227 top <- decrement +228 var dest-offset/edx: (offset value) <- compute-offset data, top +229 var target-val/edx: (addr value) <- index data, dest-offset +230 # check target-val is a file +231 var target-type-addr/eax: (addr int) <- get target-val, type +232 compare *target-type-addr, 3 # file +233 break-if-!= +234 # read all lines from file and save as an array of strings in target-val +235 # read target-val as a filename and save the handle in target-val +236 var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data +237 var file/eax: (addr buffered-file) <- lookup *file-ah +238 var s: (stream byte 0x100) +239 var s-addr/ecx: (addr stream byte) <- address s +240 slurp file, s-addr +241 var tmp-ah/eax: (addr handle array byte) <- get target-val, text-data +242 stream-to-array s-addr, tmp-ah +243 var tmp/eax: (addr array byte) <- lookup *tmp-ah +244 #? enable-screen-type-mode +245 #? print-string 0, tmp +246 var h: (handle array (handle array byte)) +247 { +248 var ah/edx: (addr handle array (handle array byte)) <- address h +249 split-string tmp, 0xa, ah +250 } +251 var target/eax: (addr handle array value) <- get target-val, array-data +252 save-lines h, target +253 # save result into target-val +254 var type-addr/eax: (addr int) <- get target-val, type +255 copy-to *type-addr, 2 # array +256 var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data +257 var empty-file: (handle buffered-file) +258 copy-handle empty-file, target-file-ah +259 var target-text-ah/eax: (addr handle array byte) <- get target-val, text-data +260 var empty-text: (handle array byte) +261 copy-handle empty-text, target-text-ah +262 break $evaluate:process-word +263 } +264 ## screens +265 { +266 var is-fake-screen?/eax: boolean <- stream-data-equal? curr-stream, "fake-screen" +267 compare is-fake-screen?, 0 +268 break-if-= +269 var out2/esi: (addr value-stack) <- copy out +270 var top-addr/ecx: (addr int) <- get out2, top +271 compare *top-addr, 0 +272 break-if-<= +273 # pop width and height from out +274 var _nrows/eax: int <- pop-int-from-value-stack out2 +275 var nrows/edx: int <- copy _nrows +276 var _ncols/eax: int <- pop-int-from-value-stack out2 +277 var ncols/ebx: int <- copy _ncols +278 # define a new screen with those dimensions +279 var screen-h: (handle screen) +280 var screen-ah/eax: (addr handle screen) <- address screen-h +281 allocate screen-ah +282 var screen/eax: (addr screen) <- lookup screen-h +283 initialize-screen screen, nrows, ncols +284 # push screen to stack +285 var data-ah/eax: (addr handle array value) <- get out2, data +286 var data/eax: (addr array value) <- lookup *data-ah +287 var top/edx: int <- copy *top-addr +288 increment *top-addr +289 var dest-offset/edx: (offset value) <- compute-offset data, top +290 var target-val/edx: (addr value) <- index data, dest-offset +291 var type/eax: (addr int) <- get target-val, type +292 copy-to *type, 4 # screen +293 var dest/eax: (addr handle screen) <- get target-val, screen-data +294 copy-handle screen-h, dest +295 break $evaluate:process-word +296 } 297 { -298 var is-dup?/eax: boolean <- stream-data-equal? curr-stream, "dup" -299 compare is-dup?, 0 +298 var is-print?/eax: boolean <- stream-data-equal? curr-stream, "print" +299 compare is-print?, 0 300 break-if-= -301 # read src-val from out -302 var out2/esi: (addr value-stack) <- copy out -303 var top-addr/ecx: (addr int) <- get out2, top -304 compare *top-addr, 0 -305 break-if-<= -306 var data-ah/eax: (addr handle array value) <- get out2, data -307 var data/eax: (addr array value) <- lookup *data-ah -308 var top/ecx: int <- copy *top-addr -309 top <- decrement -310 var offset/edx: (offset value) <- compute-offset data, top -311 var src-val/edx: (addr value) <- index data, offset -312 # push a copy of it -313 top <- increment -314 var offset/ebx: (offset value) <- compute-offset data, top -315 var target-val/ebx: (addr value) <- index data, offset -316 copy-object src-val, target-val -317 # commit -318 var top-addr/ecx: (addr int) <- get out2, top -319 increment *top-addr -320 break $evaluate:process-word -321 } -322 { -323 var is-swap?/eax: boolean <- stream-data-equal? curr-stream, "swap" -324 compare is-swap?, 0 -325 break-if-= -326 # read top-val from out -327 var out2/esi: (addr value-stack) <- copy out -328 var top-addr/ecx: (addr int) <- get out2, top -329 compare *top-addr, 0 -330 break-if-<= -331 var data-ah/eax: (addr handle array value) <- get out2, data -332 var data/eax: (addr array value) <- lookup *data-ah -333 var top/ecx: int <- copy *top-addr -334 top <- decrement -335 var offset/edx: (offset value) <- compute-offset data, top -336 var top-val/edx: (addr value) <- index data, offset -337 # read next val from out -338 top <- decrement -339 var offset/ebx: (offset value) <- compute-offset data, top -340 var pen-top-val/ebx: (addr value) <- index data, offset -341 # swap -342 var tmp: value -343 var tmp-a/eax: (addr value) <- address tmp -344 copy-object top-val, tmp-a -345 copy-object pen-top-val, top-val -346 copy-object tmp-a, pen-top-val -347 break $evaluate:process-word -348 } -349 # END HACKS -350 # if it's a name, push its value -351 { -352 compare bindings, 0 -353 break-if-= -354 var tmp: (handle array byte) -355 var curr-string-ah/edx: (addr handle array byte) <- address tmp -356 stream-to-array curr-stream, curr-string-ah # unfortunate leak -357 var curr-string/eax: (addr array byte) <- lookup *curr-string-ah -358 var val-storage: (handle value) -359 var val-ah/edi: (addr handle value) <- address val-storage -360 lookup-binding bindings, curr-string, val-ah -361 var val/eax: (addr value) <- lookup *val-ah -362 compare val, 0 -363 break-if-= -364 push-value-stack out, val -365 break $evaluate:process-word -366 } -367 # if the word starts with a quote and ends with a quote, turn it into a string -368 { -369 var start/eax: byte <- stream-first curr-stream -370 compare start, 0x22 # double-quote -371 break-if-!= -372 var end/eax: byte <- stream-final curr-stream -373 compare end, 0x22 # double-quote -374 break-if-!= -375 var h: (handle array byte) -376 var s/eax: (addr handle array byte) <- address h -377 unquote-stream-to-array curr-stream, s # leak -378 push-string-to-value-stack out, *s -379 break $evaluate:process-word -380 } -381 # if the word starts with a '[' and ends with a ']', turn it into an array -382 { -383 var start/eax: byte <- stream-first curr-stream -384 compare start, 0x5b # '[' -385 break-if-!= -386 var end/eax: byte <- stream-final curr-stream -387 compare end, 0x5d # ']' -388 break-if-!= -389 # wastefully create a new input string to strip quotes -390 var h: (handle array value) -391 var input-ah/eax: (addr handle array byte) <- address h -392 unquote-stream-to-array curr-stream, input-ah # leak -393 # wastefully parse input into int-array -394 # TODO: support parsing arrays of other types -395 var input/eax: (addr array byte) <- lookup *input-ah -396 var h2: (handle array int) -397 var int-array-ah/esi: (addr handle array int) <- address h2 -398 parse-array-of-decimal-ints input, int-array-ah # leak -399 var _int-array/eax: (addr array int) <- lookup *int-array-ah -400 var int-array/esi: (addr array int) <- copy _int-array -401 var len/ebx: int <- length int-array -402 # push value-array of same size as int-array -403 var h3: (handle array value) -404 var value-array-ah/eax: (addr handle array value) <- address h3 -405 populate value-array-ah, len -406 push-array-to-value-stack out, *value-array-ah -407 # copy int-array into value-array -408 var _value-array/eax: (addr array value) <- lookup *value-array-ah -409 var value-array/edi: (addr array value) <- copy _value-array -410 var i/eax: int <- copy 0 -411 { -412 compare i, len -413 break-if->= -414 var src-addr/ecx: (addr int) <- index int-array, i -415 var src/ecx: int <- copy *src-addr -416 var dest-offset/edx: (offset value) <- compute-offset value-array, i -417 var dest-val/edx: (addr value) <- index value-array, dest-offset -418 var dest/edx: (addr int) <- get dest-val, int-data -419 copy-to *dest, src -420 i <- increment -421 loop -422 } -423 break $evaluate:process-word -424 } -425 # otherwise assume it's a literal int and push it -426 { -427 var n/eax: int <- parse-decimal-int-from-stream curr-stream -428 push-int-to-value-stack out, n -429 } -430 } -431 # termination check -432 compare curr, end -433 break-if-= -434 # update -435 var next-word-ah/edx: (addr handle word) <- get curr, next -436 curr <- lookup *next-word-ah -437 # -438 loop -439 } -440 # process next line if necessary -441 var line/eax: (addr line) <- copy scratch -442 var next-line-ah/eax: (addr handle line) <- get line, next -443 var next-line/eax: (addr line) <- lookup *next-line-ah -444 compare next-line, 0 -445 break-if-= -446 evaluate functions, bindings, next-line, end, out -447 } -448 -449 fn test-evaluate { -450 var line-storage: line -451 var line/esi: (addr line) <- address line-storage -452 var first-word-ah/eax: (addr handle word) <- get line-storage, data -453 allocate-word-with first-word-ah, "3" -454 append-word-with *first-word-ah, "=a" -455 var next-line-ah/eax: (addr handle line) <- get line-storage, next -456 allocate next-line-ah -457 var next-line/eax: (addr line) <- lookup *next-line-ah -458 var first-word-ah/eax: (addr handle word) <- get next-line, data -459 allocate-word-with first-word-ah, "a" -460 var functions-storage: (handle function) -461 var functions/ecx: (addr handle function) <- address functions-storage -462 var table-storage: table -463 var table/ebx: (addr table) <- address table-storage -464 initialize-table table, 0x10 -465 var stack-storage: value-stack -466 var stack/edi: (addr value-stack) <- address stack-storage -467 initialize-value-stack stack, 0x10 -468 evaluate functions, table, line, 0, stack -469 var x/eax: int <- pop-int-from-value-stack stack -470 check-ints-equal x, 3, "F - test-evaluate" -471 } -472 -473 fn find-function first: (addr handle function), name: (addr stream byte), out: (addr handle function) { -474 var curr/esi: (addr handle function) <- copy first -475 $find-function:loop: { -476 var _f/eax: (addr function) <- lookup *curr -477 var f/ecx: (addr function) <- copy _f -478 compare f, 0 -479 break-if-= -480 var curr-name-ah/eax: (addr handle array byte) <- get f, name -481 var curr-name/eax: (addr array byte) <- lookup *curr-name-ah -482 var done?/eax: boolean <- stream-data-equal? name, curr-name -483 compare done?, 0 # false -484 { -485 break-if-= -486 copy-handle *curr, out -487 break $find-function:loop -488 } -489 curr <- get f, next -490 loop -491 } -492 } -493 -494 fn perform-call _callee: (addr function), caller-stack: (addr value-stack), functions: (addr handle function) { -495 var callee/ecx: (addr function) <- copy _callee -496 # create bindings for args -497 var table-storage: table -498 var table/esi: (addr table) <- address table-storage -499 initialize-table table, 0x10 -500 bind-args callee, caller-stack, table -501 # obtain body -502 var body-ah/eax: (addr handle line) <- get callee, body -503 var body/eax: (addr line) <- lookup *body-ah -504 # perform call -505 var stack-storage: value-stack -506 var stack/edi: (addr value-stack) <- address stack-storage -507 initialize-value-stack stack, 0x10 -508 #? print-string-to-real-screen "about to enter recursive eval\n" -509 evaluate functions, table, body, 0, stack -510 #? print-string-to-real-screen "exited recursive eval\n" -511 # pop target-val from out -512 var top-addr/ecx: (addr int) <- get stack, top -513 compare *top-addr, 0 -514 break-if-<= -515 var data-ah/eax: (addr handle array value) <- get stack, data -516 var data/eax: (addr array value) <- lookup *data-ah -517 var top/edx: int <- copy *top-addr -518 top <- decrement -519 var dest-offset/edx: (offset value) <- compute-offset data, top -520 var target-val/edx: (addr value) <- index data, dest-offset -521 # stitch target-val into caller-stack -522 push-value-stack caller-stack, target-val -523 } -524 -525 # pop args from the caller-stack and bind them to successive args -526 # implies: function args are stored in reverse order -527 fn bind-args _callee: (addr function), _caller-stack: (addr value-stack), table: (addr table) { -528 var callee/ecx: (addr function) <- copy _callee -529 var curr-arg-ah/eax: (addr handle word) <- get callee, args -530 var curr-arg/eax: (addr word) <- lookup *curr-arg-ah -531 # -532 var curr-key-storage: (handle array byte) -533 var curr-key/edx: (addr handle array byte) <- address curr-key-storage -534 { -535 compare curr-arg, 0 -536 break-if-= -537 # create binding -538 word-to-string curr-arg, curr-key -539 { -540 # pop target-val from caller-stack -541 var caller-stack/esi: (addr value-stack) <- copy _caller-stack -542 var top-addr/ecx: (addr int) <- get caller-stack, top -543 compare *top-addr, 0 -544 break-if-<= -545 decrement *top-addr -546 var data-ah/eax: (addr handle array value) <- get caller-stack, data -547 var data/eax: (addr array value) <- lookup *data-ah -548 var top/ebx: int <- copy *top-addr -549 var dest-offset/ebx: (offset value) <- compute-offset data, top -550 var target-val/ebx: (addr value) <- index data, dest-offset -551 # create binding from curr-key to target-val -552 bind-in-table table, curr-key, target-val -553 } -554 # -555 var next-arg-ah/edx: (addr handle word) <- get curr-arg, next -556 curr-arg <- lookup *next-arg-ah -557 loop -558 } -559 } -560 -561 # Copy of 'simplify' that just tracks the maximum stack depth needed -562 # Doesn't actually need to simulate the stack, since every word has a predictable effect. -563 fn max-stack-depth first-word: (addr word), final-word: (addr word) -> _/edi: int { -564 var curr-word/eax: (addr word) <- copy first-word -565 var curr-depth/ecx: int <- copy 0 -566 var result/edi: int <- copy 0 -567 $max-stack-depth:loop: { -568 $max-stack-depth:process-word: { -569 # handle operators -570 { -571 var is-add?/eax: boolean <- word-equal? curr-word, "+" -572 compare is-add?, 0 -573 break-if-= -574 curr-depth <- decrement -575 break $max-stack-depth:process-word -576 } -577 { -578 var is-sub?/eax: boolean <- word-equal? curr-word, "-" -579 compare is-sub?, 0 -580 break-if-= -581 curr-depth <- decrement -582 break $max-stack-depth:process-word -583 } -584 { -585 var is-mul?/eax: boolean <- word-equal? curr-word, "*" -586 compare is-mul?, 0 -587 break-if-= -588 curr-depth <- decrement -589 break $max-stack-depth:process-word -590 } -591 # otherwise it's an int (do we need error-checking?) -592 curr-depth <- increment -593 # update max depth if necessary +301 var out2/esi: (addr value-stack) <- copy out +302 var top-addr/ecx: (addr int) <- get out2, top +303 compare *top-addr, 0 +304 break-if-<= +305 # pop string from out +306 var top-addr/ecx: (addr int) <- get out2, top +307 compare *top-addr, 0 +308 break-if-<= +309 decrement *top-addr +310 var data-ah/eax: (addr handle array value) <- get out2, data +311 var _data/eax: (addr array value) <- lookup *data-ah +312 var data/edi: (addr array value) <- copy _data +313 var top/eax: int <- copy *top-addr +314 var dest-offset/edx: (offset value) <- compute-offset data, top +315 var s/esi: (addr value) <- index data, dest-offset +316 # select target screen from top of out (but don't pop it) +317 compare *top-addr, 0 +318 break-if-<= +319 var top/eax: int <- copy *top-addr +320 top <- decrement +321 var dest-offset/edx: (offset value) <- compute-offset data, top +322 var target-val/edx: (addr value) <- index data, dest-offset +323 var type/eax: (addr int) <- get target-val, type +324 compare *type, 4 # screen +325 break-if-!= +326 # print string to target screen +327 var dest-ah/eax: (addr handle screen) <- get target-val, screen-data +328 var dest/eax: (addr screen) <- lookup *dest-ah +329 var r/ecx: (addr int) <- get dest, cursor-row +330 var c/edx: (addr int) <- get dest, cursor-col +331 render-value-at dest, *r, *c, s, 0 +332 break $evaluate:process-word +333 } +334 { +335 var is-move?/eax: boolean <- stream-data-equal? curr-stream, "move" +336 compare is-move?, 0 +337 break-if-= +338 var out2/esi: (addr value-stack) <- copy out +339 # pop args +340 var _r/eax: int <- pop-int-from-value-stack out2 +341 var r/ecx: int <- copy _r +342 var _c/eax: int <- pop-int-from-value-stack out2 +343 var c/edx: int <- copy _c +344 # select screen from top of out (but don't pop it) +345 var top-addr/ebx: (addr int) <- get out2, top +346 compare *top-addr, 0 +347 break-if-<= +348 var data-ah/eax: (addr handle array value) <- get out2, data +349 var _data/eax: (addr array value) <- lookup *data-ah +350 var data/edi: (addr array value) <- copy _data +351 var top/eax: int <- copy *top-addr +352 top <- decrement +353 var target-offset/eax: (offset value) <- compute-offset data, top +354 var target-val/ebx: (addr value) <- index data, target-offset +355 var type/eax: (addr int) <- get target-val, type +356 compare *type, 4 # screen +357 break-if-!= +358 var target-ah/eax: (addr handle screen) <- get target-val, screen-data +359 var target/eax: (addr screen) <- lookup *target-ah +360 move-cursor target, r, c +361 break $evaluate:process-word +362 } +363 { +364 var is-up?/eax: boolean <- stream-data-equal? curr-stream, "up" +365 compare is-up?, 0 +366 break-if-= +367 var out2/esi: (addr value-stack) <- copy out +368 var top-addr/ebx: (addr int) <- get out2, top +369 compare *top-addr, 0 +370 break-if-<= +371 # pop args +372 var _d/eax: int <- pop-int-from-value-stack out2 +373 var d/ecx: int <- copy _d +374 # select screen from top of out (but don't pop it) +375 compare *top-addr, 0 +376 break-if-<= +377 var data-ah/eax: (addr handle array value) <- get out2, data +378 var _data/eax: (addr array value) <- lookup *data-ah +379 var data/edi: (addr array value) <- copy _data +380 var top/eax: int <- copy *top-addr +381 top <- decrement +382 var target-offset/eax: (offset value) <- compute-offset data, top +383 var target-val/ebx: (addr value) <- index data, target-offset +384 var type/eax: (addr int) <- get target-val, type +385 compare *type, 4 # screen +386 break-if-!= +387 var target-ah/eax: (addr handle screen) <- get target-val, screen-data +388 var _target/eax: (addr screen) <- lookup *target-ah +389 var target/edi: (addr screen) <- copy _target +390 var r/edx: (addr int) <- get target, cursor-row +391 var c/eax: (addr int) <- get target, cursor-col +392 var col/eax: int <- copy *c +393 { +394 compare d, 0 +395 break-if-<= +396 compare *r, 1 +397 break-if-<= +398 print-string target "│" +399 decrement *r +400 move-cursor target, *r, col +401 d <- decrement +402 loop +403 } +404 break $evaluate:process-word +405 } +406 { +407 var is-down?/eax: boolean <- stream-data-equal? curr-stream, "down" +408 compare is-down?, 0 +409 break-if-= +410 var out2/esi: (addr value-stack) <- copy out +411 var top-addr/ebx: (addr int) <- get out2, top +412 compare *top-addr, 0 +413 break-if-<= +414 # pop args +415 var _d/eax: int <- pop-int-from-value-stack out2 +416 var d/ecx: int <- copy _d +417 # select screen from top of out (but don't pop it) +418 compare *top-addr, 0 +419 break-if-<= +420 var data-ah/eax: (addr handle array value) <- get out2, data +421 var _data/eax: (addr array value) <- lookup *data-ah +422 var data/edi: (addr array value) <- copy _data +423 var top/eax: int <- copy *top-addr +424 top <- decrement +425 var target-offset/eax: (offset value) <- compute-offset data, top +426 var target-val/ebx: (addr value) <- index data, target-offset +427 var type/eax: (addr int) <- get target-val, type +428 compare *type, 4 # screen +429 break-if-!= +430 var target-ah/eax: (addr handle screen) <- get target-val, screen-data +431 var _target/eax: (addr screen) <- lookup *target-ah +432 var target/edi: (addr screen) <- copy _target +433 var bound-a/ebx: (addr int) <- get target, num-rows +434 var bound/ebx: int <- copy *bound-a +435 var r/edx: (addr int) <- get target, cursor-row +436 var c/eax: (addr int) <- get target, cursor-col +437 var col/eax: int <- copy *c +438 { +439 compare d, 0 +440 break-if-<= +441 compare *r, bound +442 break-if->= +443 print-string target "│" +444 increment *r +445 move-cursor target, *r, col +446 d <- decrement +447 loop +448 } +449 break $evaluate:process-word +450 } +451 { +452 var is-left?/eax: boolean <- stream-data-equal? curr-stream, "left" +453 compare is-left?, 0 +454 break-if-= +455 var out2/esi: (addr value-stack) <- copy out +456 var top-addr/ebx: (addr int) <- get out2, top +457 compare *top-addr, 0 +458 break-if-<= +459 # pop args +460 var _d/eax: int <- pop-int-from-value-stack out2 +461 var d/ecx: int <- copy _d +462 # select screen from top of out (but don't pop it) +463 compare *top-addr, 0 +464 break-if-<= +465 var data-ah/eax: (addr handle array value) <- get out2, data +466 var _data/eax: (addr array value) <- lookup *data-ah +467 var data/edi: (addr array value) <- copy _data +468 var top/eax: int <- copy *top-addr +469 top <- decrement +470 var target-offset/eax: (offset value) <- compute-offset data, top +471 var target-val/ebx: (addr value) <- index data, target-offset +472 var type/eax: (addr int) <- get target-val, type +473 compare *type, 4 # screen +474 break-if-!= +475 var target-ah/eax: (addr handle screen) <- get target-val, screen-data +476 var _target/eax: (addr screen) <- lookup *target-ah +477 var target/edi: (addr screen) <- copy _target +478 var c/edx: (addr int) <- get target, cursor-col +479 var r/eax: (addr int) <- get target, cursor-row +480 var row/eax: int <- copy *r +481 { +482 compare d, 0 +483 break-if-<= +484 compare *c, 1 +485 break-if-<= +486 print-string target "─" +487 decrement *c +488 decrement *c # second one to undo the print above +489 move-cursor target, row, *c +490 d <- decrement +491 loop +492 } +493 break $evaluate:process-word +494 } +495 { +496 var is-right?/eax: boolean <- stream-data-equal? curr-stream, "right" +497 compare is-right?, 0 +498 break-if-= +499 var out2/esi: (addr value-stack) <- copy out +500 var top-addr/ebx: (addr int) <- get out2, top +501 compare *top-addr, 0 +502 break-if-<= +503 # pop args +504 var _d/eax: int <- pop-int-from-value-stack out2 +505 var d/ecx: int <- copy _d +506 # select screen from top of out (but don't pop it) +507 compare *top-addr, 0 +508 break-if-<= +509 var data-ah/eax: (addr handle array value) <- get out2, data +510 var _data/eax: (addr array value) <- lookup *data-ah +511 var data/edi: (addr array value) <- copy _data +512 var top/eax: int <- copy *top-addr +513 top <- decrement +514 var target-offset/eax: (offset value) <- compute-offset data, top +515 var target-val/ebx: (addr value) <- index data, target-offset +516 var type/eax: (addr int) <- get target-val, type +517 compare *type, 4 # screen +518 break-if-!= +519 var target-ah/eax: (addr handle screen) <- get target-val, screen-data +520 var _target/eax: (addr screen) <- lookup *target-ah +521 var target/edi: (addr screen) <- copy _target +522 var bound-a/ebx: (addr int) <- get target, num-rows +523 var bound/ebx: int <- copy *bound-a +524 var c/edx: (addr int) <- get target, cursor-col +525 var r/eax: (addr int) <- get target, cursor-row +526 var row/eax: int <- copy *r +527 { +528 compare d, 0 +529 break-if-<= +530 compare *c, bound +531 break-if->= +532 print-string target "─" +533 # no increment; the print took care of it +534 move-cursor target, row, *c +535 d <- decrement +536 loop +537 } +538 break $evaluate:process-word +539 } +540 ## HACKS: we're trying to avoid turning this into Forth +541 { +542 var is-dup?/eax: boolean <- stream-data-equal? curr-stream, "dup" +543 compare is-dup?, 0 +544 break-if-= +545 # read src-val from out +546 var out2/esi: (addr value-stack) <- copy out +547 var top-addr/ecx: (addr int) <- get out2, top +548 compare *top-addr, 0 +549 break-if-<= +550 var data-ah/eax: (addr handle array value) <- get out2, data +551 var data/eax: (addr array value) <- lookup *data-ah +552 var top/ecx: int <- copy *top-addr +553 top <- decrement +554 var offset/edx: (offset value) <- compute-offset data, top +555 var src-val/edx: (addr value) <- index data, offset +556 # push a copy of it +557 top <- increment +558 var offset/ebx: (offset value) <- compute-offset data, top +559 var target-val/ebx: (addr value) <- index data, offset +560 copy-object src-val, target-val +561 # commit +562 var top-addr/ecx: (addr int) <- get out2, top +563 increment *top-addr +564 break $evaluate:process-word +565 } +566 { +567 var is-swap?/eax: boolean <- stream-data-equal? curr-stream, "swap" +568 compare is-swap?, 0 +569 break-if-= +570 # read top-val from out +571 var out2/esi: (addr value-stack) <- copy out +572 var top-addr/ecx: (addr int) <- get out2, top +573 compare *top-addr, 0 +574 break-if-<= +575 var data-ah/eax: (addr handle array value) <- get out2, data +576 var data/eax: (addr array value) <- lookup *data-ah +577 var top/ecx: int <- copy *top-addr +578 top <- decrement +579 var offset/edx: (offset value) <- compute-offset data, top +580 var top-val/edx: (addr value) <- index data, offset +581 # read next val from out +582 top <- decrement +583 var offset/ebx: (offset value) <- compute-offset data, top +584 var pen-top-val/ebx: (addr value) <- index data, offset +585 # swap +586 var tmp: value +587 var tmp-a/eax: (addr value) <- address tmp +588 copy-object top-val, tmp-a +589 copy-object pen-top-val, top-val +590 copy-object tmp-a, pen-top-val +591 break $evaluate:process-word +592 } +593 ### if curr-stream defines a binding, save top of stack to bindings 594 { -595 compare curr-depth, result -596 break-if-<= -597 result <- copy curr-depth -598 } -599 } -600 # if curr-word == final-word break -601 compare curr-word, final-word -602 break-if-= -603 # curr-word = curr-word->next -604 var next-word-ah/edx: (addr handle word) <- get curr-word, next -605 curr-word <- lookup *next-word-ah -606 # -607 loop -608 } -609 return result -610 } +595 var done?/eax: boolean <- stream-empty? curr-stream +596 compare done?, 0 # false +597 break-if-!= +598 var new-byte/eax: byte <- read-byte curr-stream +599 compare new-byte, 0x3d # '=' +600 break-if-!= +601 # pop target-val from out +602 var out2/esi: (addr value-stack) <- copy out +603 var top-addr/ecx: (addr int) <- get out2, top +604 compare *top-addr, 0 +605 break-if-<= +606 var data-ah/eax: (addr handle array value) <- get out2, data +607 var data/eax: (addr array value) <- lookup *data-ah +608 var top/edx: int <- copy *top-addr +609 top <- decrement +610 var dest-offset/edx: (offset value) <- compute-offset data, top +611 var target-val/edx: (addr value) <- index data, dest-offset +612 # create binding from curr-stream to target-val +613 var key-h: (handle array byte) +614 var key/ecx: (addr handle array byte) <- address key-h +615 stream-to-array curr-stream, key +616 bind-in-table bindings, key, target-val +617 break $evaluate:process-word +618 } +619 rewind-stream curr-stream +620 ### if curr-stream is a known function name, call it appropriately +621 { +622 var callee-h: (handle function) +623 var callee-ah/eax: (addr handle function) <- address callee-h +624 find-function functions, curr-stream, callee-ah +625 var callee/eax: (addr function) <- lookup *callee-ah +626 compare callee, 0 +627 break-if-= +628 perform-call callee, out, functions +629 break $evaluate:process-word +630 } +631 ### if it's a name, push its value +632 { +633 compare bindings, 0 +634 break-if-= +635 var tmp: (handle array byte) +636 var curr-string-ah/edx: (addr handle array byte) <- address tmp +637 stream-to-array curr-stream, curr-string-ah # unfortunate leak +638 var curr-string/eax: (addr array byte) <- lookup *curr-string-ah +639 var val-storage: (handle value) +640 var val-ah/edi: (addr handle value) <- address val-storage +641 lookup-binding bindings, curr-string, val-ah +642 var val/eax: (addr value) <- lookup *val-ah +643 compare val, 0 +644 break-if-= +645 push-value-stack out, val +646 break $evaluate:process-word +647 } +648 ### if the word starts with a quote and ends with a quote, turn it into a string +649 { +650 var start/eax: byte <- stream-first curr-stream +651 compare start, 0x22 # double-quote +652 break-if-!= +653 var end/eax: byte <- stream-final curr-stream +654 compare end, 0x22 # double-quote +655 break-if-!= +656 var h: (handle array byte) +657 var s/eax: (addr handle array byte) <- address h +658 unquote-stream-to-array curr-stream, s # leak +659 push-string-to-value-stack out, *s +660 break $evaluate:process-word +661 } +662 ### if the word starts with a '[' and ends with a ']', turn it into an array +663 { +664 var start/eax: byte <- stream-first curr-stream +665 compare start, 0x5b # '[' +666 break-if-!= +667 var end/eax: byte <- stream-final curr-stream +668 compare end, 0x5d # ']' +669 break-if-!= +670 # wastefully create a new input string to strip quotes +671 var h: (handle array value) +672 var input-ah/eax: (addr handle array byte) <- address h +673 unquote-stream-to-array curr-stream, input-ah # leak +674 # wastefully parse input into int-array +675 # TODO: support parsing arrays of other types +676 var input/eax: (addr array byte) <- lookup *input-ah +677 var h2: (handle array int) +678 var int-array-ah/esi: (addr handle array int) <- address h2 +679 parse-array-of-decimal-ints input, int-array-ah # leak +680 var _int-array/eax: (addr array int) <- lookup *int-array-ah +681 var int-array/esi: (addr array int) <- copy _int-array +682 var len/ebx: int <- length int-array +683 # push value-array of same size as int-array +684 var h3: (handle array value) +685 var value-array-ah/eax: (addr handle array value) <- address h3 +686 populate value-array-ah, len +687 push-array-to-value-stack out, *value-array-ah +688 # copy int-array into value-array +689 var _value-array/eax: (addr array value) <- lookup *value-array-ah +690 var value-array/edi: (addr array value) <- copy _value-array +691 var i/eax: int <- copy 0 +692 { +693 compare i, len +694 break-if->= +695 var src-addr/ecx: (addr int) <- index int-array, i +696 var src/ecx: int <- copy *src-addr +697 var dest-offset/edx: (offset value) <- compute-offset value-array, i +698 var dest-val/edx: (addr value) <- index value-array, dest-offset +699 var dest/edx: (addr int) <- get dest-val, int-data +700 copy-to *dest, src +701 i <- increment +702 loop +703 } +704 break $evaluate:process-word +705 } +706 ### otherwise assume it's a literal number and push it +707 { +708 var n/eax: int <- parse-decimal-int-from-stream curr-stream +709 push-int-to-value-stack out, n +710 } +711 } +712 # termination check +713 compare curr, end +714 break-if-= +715 # update +716 var next-word-ah/edx: (addr handle word) <- get curr, next +717 curr <- lookup *next-word-ah +718 # +719 loop +720 } +721 # process next line if necessary +722 var line/eax: (addr line) <- copy scratch +723 var next-line-ah/eax: (addr handle line) <- get line, next +724 var next-line/eax: (addr line) <- lookup *next-line-ah +725 compare next-line, 0 +726 break-if-= +727 evaluate functions, bindings, next-line, end, out +728 } +729 +730 fn test-evaluate { +731 var line-storage: line +732 var line/esi: (addr line) <- address line-storage +733 var first-word-ah/eax: (addr handle word) <- get line-storage, data +734 allocate-word-with first-word-ah, "3" +735 append-word-with *first-word-ah, "=a" +736 var next-line-ah/eax: (addr handle line) <- get line-storage, next +737 allocate next-line-ah +738 var next-line/eax: (addr line) <- lookup *next-line-ah +739 var first-word-ah/eax: (addr handle word) <- get next-line, data +740 allocate-word-with first-word-ah, "a" +741 var functions-storage: (handle function) +742 var functions/ecx: (addr handle function) <- address functions-storage +743 var table-storage: table +744 var table/ebx: (addr table) <- address table-storage +745 initialize-table table, 0x10 +746 var stack-storage: value-stack +747 var stack/edi: (addr value-stack) <- address stack-storage +748 initialize-value-stack stack, 0x10 +749 evaluate functions, table, line, 0, stack +750 var x/eax: int <- pop-int-from-value-stack stack +751 check-ints-equal x, 3, "F - test-evaluate" +752 } +753 +754 fn find-function first: (addr handle function), name: (addr stream byte), out: (addr handle function) { +755 var curr/esi: (addr handle function) <- copy first +756 $find-function:loop: { +757 var _f/eax: (addr function) <- lookup *curr +758 var f/ecx: (addr function) <- copy _f +759 compare f, 0 +760 break-if-= +761 var curr-name-ah/eax: (addr handle array byte) <- get f, name +762 var curr-name/eax: (addr array byte) <- lookup *curr-name-ah +763 var done?/eax: boolean <- stream-data-equal? name, curr-name +764 compare done?, 0 # false +765 { +766 break-if-= +767 copy-handle *curr, out +768 break $find-function:loop +769 } +770 curr <- get f, next +771 loop +772 } +773 } +774 +775 fn perform-call _callee: (addr function), caller-stack: (addr value-stack), functions: (addr handle function) { +776 var callee/ecx: (addr function) <- copy _callee +777 # create bindings for args +778 var table-storage: table +779 var table/esi: (addr table) <- address table-storage +780 initialize-table table, 0x10 +781 bind-args callee, caller-stack, table +782 # obtain body +783 var body-ah/eax: (addr handle line) <- get callee, body +784 var body/eax: (addr line) <- lookup *body-ah +785 # perform call +786 var stack-storage: value-stack +787 var stack/edi: (addr value-stack) <- address stack-storage +788 initialize-value-stack stack, 0x10 +789 #? print-string-to-real-screen "about to enter recursive eval\n" +790 evaluate functions, table, body, 0, stack +791 #? print-string-to-real-screen "exited recursive eval\n" +792 # pop target-val from out +793 var top-addr/ecx: (addr int) <- get stack, top +794 compare *top-addr, 0 +795 break-if-<= +796 var data-ah/eax: (addr handle array value) <- get stack, data +797 var data/eax: (addr array value) <- lookup *data-ah +798 var top/edx: int <- copy *top-addr +799 top <- decrement +800 var dest-offset/edx: (offset value) <- compute-offset data, top +801 var target-val/edx: (addr value) <- index data, dest-offset +802 # stitch target-val into caller-stack +803 push-value-stack caller-stack, target-val +804 } +805 +806 # pop args from the caller-stack and bind them to successive args +807 # implies: function args are stored in reverse order +808 fn bind-args _callee: (addr function), _caller-stack: (addr value-stack), table: (addr table) { +809 var callee/ecx: (addr function) <- copy _callee +810 var curr-arg-ah/eax: (addr handle word) <- get callee, args +811 var curr-arg/eax: (addr word) <- lookup *curr-arg-ah +812 # +813 var curr-key-storage: (handle array byte) +814 var curr-key/edx: (addr handle array byte) <- address curr-key-storage +815 { +816 compare curr-arg, 0 +817 break-if-= +818 # create binding +819 word-to-string curr-arg, curr-key +820 { +821 # pop target-val from caller-stack +822 var caller-stack/esi: (addr value-stack) <- copy _caller-stack +823 var top-addr/ecx: (addr int) <- get caller-stack, top +824 compare *top-addr, 0 +825 break-if-<= +826 decrement *top-addr +827 var data-ah/eax: (addr handle array value) <- get caller-stack, data +828 var data/eax: (addr array value) <- lookup *data-ah +829 var top/ebx: int <- copy *top-addr +830 var dest-offset/ebx: (offset value) <- compute-offset data, top +831 var target-val/ebx: (addr value) <- index data, dest-offset +832 # create binding from curr-key to target-val +833 bind-in-table table, curr-key, target-val +834 } +835 # +836 var next-arg-ah/edx: (addr handle word) <- get curr-arg, next +837 curr-arg <- lookup *next-arg-ah +838 loop +839 } +840 } +841 +842 # Copy of 'simplify' that just tracks the maximum stack depth needed +843 # Doesn't actually need to simulate the stack, since every word has a predictable effect. +844 fn max-stack-depth first-word: (addr word), final-word: (addr word) -> _/edi: int { +845 var curr-word/eax: (addr word) <- copy first-word +846 var curr-depth/ecx: int <- copy 0 +847 var result/edi: int <- copy 0 +848 $max-stack-depth:loop: { +849 $max-stack-depth:process-word: { +850 # handle operators +851 { +852 var is-add?/eax: boolean <- word-equal? curr-word, "+" +853 compare is-add?, 0 +854 break-if-= +855 curr-depth <- decrement +856 break $max-stack-depth:process-word +857 } +858 { +859 var is-sub?/eax: boolean <- word-equal? curr-word, "-" +860 compare is-sub?, 0 +861 break-if-= +862 curr-depth <- decrement +863 break $max-stack-depth:process-word +864 } +865 { +866 var is-mul?/eax: boolean <- word-equal? curr-word, "*" +867 compare is-mul?, 0 +868 break-if-= +869 curr-depth <- decrement +870 break $max-stack-depth:process-word +871 } +872 # otherwise it's an int (do we need error-checking?) +873 curr-depth <- increment +874 # update max depth if necessary +875 { +876 compare curr-depth, result +877 break-if-<= +878 result <- copy curr-depth +879 } +880 } +881 # if curr-word == final-word break +882 compare curr-word, final-word +883 break-if-= +884 # curr-word = curr-word->next +885 var next-word-ah/edx: (addr handle word) <- get curr-word, next +886 curr-word <- lookup *next-word-ah +887 # +888 loop +889 } +890 return result +891 } diff --git a/html/apps/tile/surface.mu.html b/html/apps/tile/surface.mu.html index 16332221..21a13126 100644 --- a/html/apps/tile/surface.mu.html +++ b/html/apps/tile/surface.mu.html @@ -190,33 +190,33 @@ if ('onhashchange' in window) { 130 # print a cell with all its formatting at the cursor location 131 fn print-screen-cell screen: (addr screen), _cell: (addr screen-cell) { 132 var cell/esi: (addr screen-cell) <- copy _cell -133 reset-formatting screen +133 reset-formatting screen 134 var fg/eax: (addr int) <- get cell, color 135 var bg/ecx: (addr int) <- get cell, background-color -136 start-color screen, *fg, *bg +136 start-color screen, *fg, *bg 137 var tmp/eax: (addr boolean) <- get cell, bold? 138 { 139 compare *tmp, 0 140 break-if-= -141 start-bold screen +141 start-bold screen 142 } 143 { 144 tmp <- get cell, underline? 145 compare *tmp, 0 146 break-if-= -147 start-underline screen +147 start-underline screen 148 } 149 { 150 tmp <- get cell, reverse? 151 compare *tmp, 0 152 break-if-= -153 start-reverse-video screen +153 start-reverse-video screen 154 } 155 { 156 tmp <- get cell, blink? 157 compare *tmp, 0 158 break-if-= -159 start-blinking screen +159 start-blinking screen 160 } 161 var g/eax: (addr grapheme) <- get cell, data 162 print-grapheme screen, *g @@ -387,9 +387,9 @@ if ('onhashchange' in window) { 327 render-surface s-addr 328 var screen-ah/eax: (addr handle screen) <- get s-addr, screen 329 var screen-addr/eax: (addr screen) <- lookup *screen-ah -330 check-screen-row screen-addr, 1, "abcd", "F - test-surface-pin-at-origin" -331 check-screen-row screen-addr, 2, "ghij", "F - test-surface-pin-at-origin" -332 check-screen-row screen-addr, 3, "mnop", "F - test-surface-pin-at-origin" +330 check-screen-row screen-addr, 1, "abcd", "F - test-surface-pin-at-origin" +331 check-screen-row screen-addr, 2, "ghij", "F - test-surface-pin-at-origin" +332 check-screen-row screen-addr, 3, "mnop", "F - test-surface-pin-at-origin" 333 } 334 335 # pin (1, 1) to (2, 1) on screen; screen goes past edge of the universe @@ -405,9 +405,9 @@ if ('onhashchange' in window) { 345 var screen-ah/eax: (addr handle screen) <- get s-addr, screen 346 var screen-addr/eax: (addr screen) <- lookup *screen-ah 347 # surface edge reached (should seldom happen in the app) -348 check-screen-row screen-addr, 1, " ", "F - test-surface-pin-2" -349 check-screen-row screen-addr, 2, "abcd", "F - test-surface-pin-2" -350 check-screen-row screen-addr, 3, "ghij", "F - test-surface-pin-2" +348 check-screen-row screen-addr, 1, " ", "F - test-surface-pin-2" +349 check-screen-row screen-addr, 2, "abcd", "F - test-surface-pin-2" +350 check-screen-row screen-addr, 3, "ghij", "F - test-surface-pin-2" 351 } 352 353 # pin (2, 1) to (1, 1) on screen @@ -422,9 +422,9 @@ if ('onhashchange' in window) { 362 render-surface s-addr 363 var screen-ah/eax: (addr handle screen) <- get s-addr, screen 364 var screen-addr/eax: (addr screen) <- lookup *screen-ah -365 check-screen-row screen-addr, 1, "ghij", "F - test-surface-pin-3" -366 check-screen-row screen-addr, 2, "mnop", "F - test-surface-pin-3" -367 check-screen-row screen-addr, 3, "stuv", "F - test-surface-pin-3" +365 check-screen-row screen-addr, 1, "ghij", "F - test-surface-pin-3" +366 check-screen-row screen-addr, 2, "mnop", "F - test-surface-pin-3" +367 check-screen-row screen-addr, 3, "stuv", "F - test-surface-pin-3" 368 } 369 370 # pin (1, 1) to (1, 2) on screen; screen goes past edge of the universe @@ -440,9 +440,9 @@ if ('onhashchange' in window) { 380 var screen-ah/eax: (addr handle screen) <- get s-addr, screen 381 var screen-addr/eax: (addr screen) <- lookup *screen-ah 382 # surface edge reached (should seldom happen in the app) -383 check-screen-row screen-addr, 1, " abc", "F - test-surface-pin-4" -384 check-screen-row screen-addr, 2, " ghi", "F - test-surface-pin-4" -385 check-screen-row screen-addr, 3, " mno", "F - test-surface-pin-4" +383 check-screen-row screen-addr, 1, " abc", "F - test-surface-pin-4" +384 check-screen-row screen-addr, 2, " ghi", "F - test-surface-pin-4" +385 check-screen-row screen-addr, 3, " mno", "F - test-surface-pin-4" 386 } 387 388 # pin (1, 2) to (1, 1) on screen @@ -457,9 +457,9 @@ if ('onhashchange' in window) { 397 render-surface s-addr 398 var screen-ah/eax: (addr handle screen) <- get s-addr, screen 399 var screen-addr/eax: (addr screen) <- lookup *screen-ah -400 check-screen-row screen-addr, 1, "bcde", "F - test-surface-pin-5" -401 check-screen-row screen-addr, 2, "hijk", "F - test-surface-pin-5" -402 check-screen-row screen-addr, 3, "nopq", "F - test-surface-pin-5" +400 check-screen-row screen-addr, 1, "bcde", "F - test-surface-pin-5" +401 check-screen-row screen-addr, 2, "hijk", "F - test-surface-pin-5" +402 check-screen-row screen-addr, 3, "nopq", "F - test-surface-pin-5" 403 } 404 405 fn initialize-surface-with-fake-screen _self: (addr surface), nrows: int, ncols: int, in: (addr array byte) { diff --git a/html/apps/tile/table.mu.html b/html/apps/tile/table.mu.html index 88a51f9d..5a924e7e 100644 --- a/html/apps/tile/table.mu.html +++ b/html/apps/tile/table.mu.html @@ -14,6 +14,7 @@ pre { white-space: pre-wrap; font-family: monospace; color: #000000; background- body { font-size:12pt; font-family: monospace; color: #000000; background-color: #c6c6c6; } a { color:inherit; } * { font-size:12pt; font-size: 1em; } +.CommentedCode { color: #8a8a8a; } .muComment { color: #005faf; } .LineNr { } .SpecialChar { color: #d70000; } @@ -56,97 +57,171 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/master/apps/tile/table.mu 
- 1 fn initialize-table _self: (addr table), n: int {
- 2   var self/esi: (addr table) <- copy _self
- 3   var data-ah/eax: (addr handle array bind) <- get self, data
- 4   populate data-ah, n
- 5 }
- 6 
- 7 fn bind-in-table _self: (addr table), key: (addr handle array byte), val: (addr value) {
- 8   var self/esi: (addr table) <- copy _self
- 9   var data-ah/esi: (addr handle array bind) <- get self, data
-10   var _data/eax: (addr array bind) <- lookup *data-ah
-11   var data/esi: (addr array bind) <- copy _data
-12   var next-empty-slot-index/eax: (offset bind) <- next-empty-slot data, key
-13   var dest/eax: (addr bind) <- index data, next-empty-slot-index
-14   make-binding dest, key, val
-15 }
-16 
-17 # manual test: full array of binds
-18 fn next-empty-slot _data: (addr array bind), key: (addr handle array byte) -> _/eax: (offset bind) {
-19   var data/esi: (addr array bind) <- copy _data
-20   var len/ecx: int <- length data
-21   var i/edx: int <- copy 0
-22   var result/eax: (offset bind) <- copy 0
-23   $next-empty-slot:loop: {
-24     result <- compute-offset data, i
-25     compare i, len
-26     break-if->=
-27     {
-28       var target/esi: (addr bind) <- index data, result
-29       var target2/esi: (addr handle array byte) <- get target, key
-30       var target3/eax: (addr array byte) <- lookup *target2
-31       compare target3, 0
-32       break-if-= $next-empty-slot:loop
-33       # TODO: how to indicate that key already exists? we don't want to permit rebinding
-34     }
-35     i <- increment
-36     loop
-37   }
-38   return result
-39 }
-40 
-41 fn make-int-binding _self: (addr bind), key: (addr handle array byte), _val: int {
-42   var self/esi: (addr bind) <- copy _self
-43   var dest/eax: (addr handle array byte) <- get self, key
-44   copy-object key, dest
-45   var dest2/eax: (addr handle value) <- get self, value
-46   allocate dest2
-47   var dest3/eax: (addr value) <- lookup *dest2
-48   var dest4/eax: (addr int) <- get dest3, int-data
-49   var val/ecx: int <- copy _val
-50   copy-to *dest4, val
-51 }
-52 
-53 fn make-binding _self: (addr bind), key: (addr handle array byte), val: (addr value) {
-54   var self/esi: (addr bind) <- copy _self
-55   var dest/eax: (addr handle array byte) <- get self, key
-56   copy-object key, dest
-57   var dest2/eax: (addr handle value) <- get self, value
-58   allocate dest2
-59   var dest3/eax: (addr value) <- lookup *dest2
-60   copy-object val, dest3
-61 }
-62 
-63 fn lookup-binding _self: (addr table), key: (addr array byte), out: (addr handle value) {
-64   var self/esi: (addr table) <- copy _self
-65   var data-ah/esi: (addr handle array bind) <- get self, data
-66   var _data/eax: (addr array bind) <- lookup *data-ah
-67   var data/esi: (addr array bind) <- copy _data
-68   var len/edx: int <- length data
-69   var i/ebx: int <- copy 0
-70   $lookup-binding:loop: {
-71     compare i, len
-72     break-if->=
-73     {
-74       var offset/edx: (offset bind) <- compute-offset data, i
-75       var target-bind/esi: (addr bind) <- index data, offset
-76       var target2/edx: (addr handle array byte) <- get target-bind, key
-77       var target3/eax: (addr array byte) <- lookup *target2
-78       compare target3, 0
-79       break-if-= $lookup-binding:loop
-80       var is-match?/eax: boolean <- string-equal? target3, key
-81       compare is-match?, 0  # false
-82       break-if-=
-83       # found
-84       var target/eax: (addr handle value) <- get target-bind, value
-85       copy-object target, out
-86       break $lookup-binding:loop
-87     }
-88     i <- increment
-89     loop
-90   }
-91 }
+  1 fn initialize-table _self: (addr table), n: int {
+  2   var self/esi: (addr table) <- copy _self
+  3   var data-ah/eax: (addr handle array bind) <- get self, data
+  4   populate data-ah, n
+  5 }
+  6 
+  7 fn deep-copy-table _src: (addr table), _dest: (addr table) {
+  8 #?   print-string 0, "deep-copy-table\n"
+  9   var src/eax: (addr table) <- copy _src
+ 10   var src-data-ah/eax: (addr handle array bind) <- get src, data
+ 11   var _src-data/eax: (addr array bind) <- lookup *src-data-ah
+ 12   var src-data/esi: (addr array bind) <- copy _src-data
+ 13   var n/ecx: int <- length src-data
+ 14   var dest/eax: (addr table) <- copy _dest
+ 15   initialize-table dest, n
+ 16   var dest-data-ah/eax: (addr handle array bind) <- get dest, data
+ 17   var _dest-data/eax: (addr array bind) <- lookup *dest-data-ah
+ 18   var dest-data/edi: (addr array bind) <- copy _dest-data
+ 19   var i/eax: int <- copy 0
+ 20   {
+ 21     compare i, n
+ 22     break-if->=
+ 23 #?     print-string 0, "iter\n"
+ 24     $deep-copy:element: {
+ 25       var offset/edx: (offset bind) <- compute-offset src-data, i
+ 26       var src-bind/ecx: (addr bind) <- index src-data, offset
+ 27       var dest-bind/edx: (addr bind) <- index dest-data, offset
+ 28       var src-key-ah/ebx: (addr handle array byte) <- get src-bind, key
+ 29       var src-key/eax: (addr array byte) <- lookup *src-key-ah
+ 30       compare src-key, 0
+ 31       break-if-=
+ 32       # copy key
+ 33       var dest-key-ah/eax: (addr handle array byte) <- get dest-bind, key
+ 34       copy-object src-key-ah, dest-key-ah
+ 35       # deep copy value
+ 36       var src-val-ah/eax: (addr handle value) <- get src-bind, value
+ 37       var _src-val/eax: (addr value) <- lookup *src-val-ah
+ 38       var src-val/ecx: (addr value) <- copy _src-val
+ 39       var dest-val-ah/eax: (addr handle value) <- get dest-bind, value
+ 40       allocate dest-val-ah
+ 41       var dest-val/eax: (addr value) <- lookup *dest-val-ah
+ 42 #?       print-string 0, "deep copy value {\n"
+ 43       deep-copy-value src-val, dest-val
+ 44 #?       print-string 0, "}\n"
+ 45     }
+ 46     i <- increment
+ 47     loop
+ 48   }
+ 49 #?   print-string 0, "end deep-copy-table\n"
+ 50 }
+ 51 
+ 52 fn bind-in-table _self: (addr table), key: (addr handle array byte), val: (addr value) {
+ 53   var self/esi: (addr table) <- copy _self
+ 54   var data-ah/esi: (addr handle array bind) <- get self, data
+ 55   var _data/eax: (addr array bind) <- lookup *data-ah
+ 56   var data/esi: (addr array bind) <- copy _data
+ 57   var next-empty-slot-index/eax: (offset bind) <- next-empty-slot data, key
+ 58   var dest/eax: (addr bind) <- index data, next-empty-slot-index
+ 59   make-binding dest, key, val
+ 60 }
+ 61 
+ 62 # manual test: full array of binds
+ 63 fn next-empty-slot _data: (addr array bind), key: (addr handle array byte) -> _/eax: (offset bind) {
+ 64   var data/esi: (addr array bind) <- copy _data
+ 65   var len/ecx: int <- length data
+ 66   var i/edx: int <- copy 0
+ 67   var result/eax: (offset bind) <- copy 0
+ 68   $next-empty-slot:loop: {
+ 69     result <- compute-offset data, i
+ 70     compare i, len
+ 71     break-if->=
+ 72     {
+ 73       var target/esi: (addr bind) <- index data, result
+ 74       var target2/esi: (addr handle array byte) <- get target, key
+ 75       var target3/eax: (addr array byte) <- lookup *target2
+ 76       compare target3, 0
+ 77       break-if-= $next-empty-slot:loop
+ 78       # TODO: how to indicate that key already exists? we don't want to permit rebinding
+ 79     }
+ 80     i <- increment
+ 81     loop
+ 82   }
+ 83   return result
+ 84 }
+ 85 
+ 86 fn make-int-binding _self: (addr bind), key: (addr handle array byte), _val: int {
+ 87   var self/esi: (addr bind) <- copy _self
+ 88   var dest/eax: (addr handle array byte) <- get self, key
+ 89   copy-object key, dest
+ 90   var dest2/eax: (addr handle value) <- get self, value
+ 91   allocate dest2
+ 92   var dest3/eax: (addr value) <- lookup *dest2
+ 93   var dest4/eax: (addr int) <- get dest3, int-data
+ 94   var val/ecx: int <- copy _val
+ 95   copy-to *dest4, val
+ 96 }
+ 97 
+ 98 fn make-binding _self: (addr bind), key: (addr handle array byte), val: (addr value) {
+ 99   var self/esi: (addr bind) <- copy _self
+100   var dest/eax: (addr handle array byte) <- get self, key
+101   copy-object key, dest
+102   var dest2/eax: (addr handle value) <- get self, value
+103   allocate dest2
+104   var dest3/eax: (addr value) <- lookup *dest2
+105   copy-object val, dest3
+106 }
+107 
+108 fn lookup-binding _self: (addr table), key: (addr array byte), out: (addr handle value) {
+109   var self/esi: (addr table) <- copy _self
+110   var data-ah/esi: (addr handle array bind) <- get self, data
+111   var _data/eax: (addr array bind) <- lookup *data-ah
+112   var data/esi: (addr array bind) <- copy _data
+113   var len/edx: int <- length data
+114   var i/ebx: int <- copy 0
+115   $lookup-binding:loop: {
+116     compare i, len
+117     break-if->=
+118     {
+119       var offset/edx: (offset bind) <- compute-offset data, i
+120       var target-bind/esi: (addr bind) <- index data, offset
+121       var target2/edx: (addr handle array byte) <- get target-bind, key
+122       var target3/eax: (addr array byte) <- lookup *target2
+123       compare target3, 0
+124       break-if-= $lookup-binding:loop
+125       var is-match?/eax: boolean <- string-equal? target3, key
+126       compare is-match?, 0  # false
+127       break-if-=
+128       # found
+129       var target/eax: (addr handle value) <- get target-bind, value
+130       copy-object target, out
+131       break $lookup-binding:loop
+132     }
+133     i <- increment
+134     loop
+135   }
+136 }
+137 
+138 fn dump-table _self: (addr table) {
+139   var self/esi: (addr table) <- copy _self
+140   var data-ah/esi: (addr handle array bind) <- get self, data
+141   var _data/eax: (addr array bind) <- lookup *data-ah
+142   var data/esi: (addr array bind) <- copy _data
+143   var len/edx: int <- length data
+144   var i/ebx: int <- copy 0
+145   {
+146     compare i, len
+147     break-if->=
+148     var offset/edx: (offset bind) <- compute-offset data, i
+149     var target-bind/esi: (addr bind) <- index data, offset
+150     var key-ah/edx: (addr handle array byte) <- get target-bind, key
+151     var key/eax: (addr array byte) <- lookup *key-ah
+152     compare key, 0
+153     break-if-=
+154     print-string 0, key
+155     print-string 0, ": "
+156     var val-ah/eax: (addr handle value) <- get target-bind, value
+157     var val/eax: (addr value) <- lookup *val-ah
+158     var type/eax: (addr int) <- get val, type
+159     print-int32-hex 0, *type
+160     print-string 0, "\n"
+161     i <- increment
+162     loop
+163   }
+164   print-string 0, "\n"
+165 }
diff --git a/html/apps/tile/value-stack.mu.html b/html/apps/tile/value-stack.mu.html index 50db3d41..532df190 100644 --- a/html/apps/tile/value-stack.mu.html +++ b/html/apps/tile/value-stack.mu.html @@ -91,227 +91,145 @@ if ('onhashchange' in window) { 32 #? print-int32-hex-to-real-screen val 33 copy-to *dest-addr2, val 34 increment *top-addr - 35 } - 36 - 37 fn push-string-to-value-stack _self: (addr value-stack), val: (handle array byte) { - 38 var self/esi: (addr value-stack) <- copy _self - 39 var top-addr/ecx: (addr int) <- get self, top - 40 var data-ah/edx: (addr handle array value) <- get self, data - 41 var data/eax: (addr array value) <- lookup *data-ah - 42 var top/edx: int <- copy *top-addr - 43 var dest-offset/edx: (offset value) <- compute-offset data, top - 44 var dest-addr/edx: (addr value) <- index data, dest-offset - 45 var dest-addr2/eax: (addr handle array byte) <- get dest-addr, text-data - 46 copy-handle val, dest-addr2 - 47 var dest-addr3/eax: (addr int) <- get dest-addr, type - 48 #? print-string 0, "setting type to 1: " - 49 #? { - 50 #? var foo/eax: int <- copy dest-addr3 - 51 #? print-int32-hex 0, foo - 52 #? } - 53 #? print-string 0, "\n" - 54 copy-to *dest-addr3, 1 # type string - 55 increment *top-addr - 56 } - 57 - 58 fn push-array-to-value-stack _self: (addr value-stack), val: (handle array value) { - 59 var self/esi: (addr value-stack) <- copy _self - 60 var top-addr/ecx: (addr int) <- get self, top - 61 var data-ah/edx: (addr handle array value) <- get self, data - 62 var data/eax: (addr array value) <- lookup *data-ah - 63 var top/edx: int <- copy *top-addr - 64 var dest-offset/edx: (offset value) <- compute-offset data, top - 65 var dest-addr/edx: (addr value) <- index data, dest-offset - 66 var dest-addr2/eax: (addr handle array value) <- get dest-addr, array-data - 67 copy-handle val, dest-addr2 - 68 # update type - 69 var dest-addr3/eax: (addr int) <- get dest-addr, type - 70 copy-to *dest-addr3, 2 # type array - 71 increment *top-addr - 72 } - 73 - 74 fn push-value-stack _self: (addr value-stack), val: (addr value) { - 75 var self/esi: (addr value-stack) <- copy _self - 76 var top-addr/ecx: (addr int) <- get self, top - 77 var data-ah/edx: (addr handle array value) <- get self, data - 78 var data/eax: (addr array value) <- lookup *data-ah - 79 var top/edx: int <- copy *top-addr - 80 var dest-offset/edx: (offset value) <- compute-offset data, top - 81 var dest-addr/edx: (addr value) <- index data, dest-offset - 82 copy-object val, dest-addr - 83 increment *top-addr - 84 } - 85 - 86 fn pop-int-from-value-stack _self: (addr value-stack) -> _/eax: int { - 87 var self/esi: (addr value-stack) <- copy _self - 88 var top-addr/ecx: (addr int) <- get self, top - 89 { - 90 compare *top-addr, 0 - 91 break-if-> - 92 return -1 - 93 } - 94 decrement *top-addr - 95 var data-ah/edx: (addr handle array value) <- get self, data - 96 var data/eax: (addr array value) <- lookup *data-ah - 97 var top/edx: int <- copy *top-addr - 98 var dest-offset/edx: (offset value) <- compute-offset data, top - 99 var result-addr/eax: (addr value) <- index data, dest-offset -100 var result-addr2/eax: (addr int) <- get result-addr, int-data -101 return *result-addr2 -102 } -103 -104 fn value-stack-empty? _self: (addr value-stack) -> _/eax: boolean { -105 var self/esi: (addr value-stack) <- copy _self -106 var top/eax: (addr int) <- get self, top -107 compare *top, 0 -108 { -109 break-if-!= -110 return 1 # true -111 } -112 return 0 # false -113 } -114 -115 fn value-stack-length _self: (addr value-stack) -> _/eax: int { -116 var self/esi: (addr value-stack) <- copy _self -117 var top-addr/eax: (addr int) <- get self, top -118 return *top-addr -119 } -120 -121 fn value-stack-max-width _self: (addr value-stack) -> _/eax: int { -122 var self/esi: (addr value-stack) <- copy _self -123 var data-ah/edi: (addr handle array value) <- get self, data -124 var _data/eax: (addr array value) <- lookup *data-ah -125 var data/edi: (addr array value) <- copy _data -126 var top-addr/ecx: (addr int) <- get self, top -127 var i/ebx: int <- copy 0 -128 var result: int -129 { -130 compare i, *top-addr -131 break-if->= -132 var o/edx: (offset value) <- compute-offset data, i -133 var v/edx: (addr value) <- index data, o -134 var w/eax: int <- value-width v, 1 # top-level=true -135 # if (w > result) w = result -136 { -137 compare w, result -138 break-if-<= -139 copy-to result, w -140 } -141 i <- increment -142 loop -143 } -144 return result -145 } -146 -147 fn value-width _v: (addr value), top-level: boolean -> _/eax: int { -148 var v/esi: (addr value) <- copy _v -149 var type/eax: (addr int) <- get v, type -150 { -151 compare *type, 0 # int -152 break-if-!= -153 var v-int/edx: (addr int) <- get v, int-data -154 var result/eax: int <- decimal-size *v-int -155 return result -156 } -157 { -158 compare *type, 1 # string -159 break-if-!= -160 var s-ah/eax: (addr handle array byte) <- get v, text-data -161 var s/eax: (addr array byte) <- lookup *s-ah -162 compare s, 0 -163 break-if-= -164 var result/eax: int <- length s -165 compare result, 0xd # max string size -166 { -167 break-if-<= -168 result <- copy 0xd -169 } -170 # if it's a nested string, include space for quotes -171 # we don't do this for the top-level, where the quotes will overflow -172 # into surrounding padding. -173 compare top-level, 0 # false -174 { -175 break-if-!= -176 result <- add 2 -177 } -178 return result -179 } -180 { -181 compare *type, 2 # array -182 break-if-!= -183 var a-ah/eax: (addr handle array value) <- get v, array-data -184 var a/eax: (addr array value) <- lookup *a-ah -185 compare a, 0 -186 break-if-= -187 var result/eax: int <- array-width a -188 return result -189 } -190 { -191 compare *type, 3 # file handle -192 break-if-!= -193 var f-ah/eax: (addr handle buffered-file) <- get v, file-data -194 var f/eax: (addr buffered-file) <- lookup *f-ah -195 compare f, 0 -196 break-if-= -197 # TODO: visualizing file handles -198 return 4 -199 } -200 return 0 -201 } -202 -203 # keep sync'd with render-array -204 fn array-width _a: (addr array value) -> _/eax: int { -205 var a/esi: (addr array value) <- copy _a -206 var max/ecx: int <- length a -207 var i/eax: int <- copy 0 -208 var result/edi: int <- copy 0 -209 { -210 compare i, max -211 break-if->= -212 { -213 compare i, 0 -214 break-if-= -215 result <- increment # for space -216 } -217 var off/ecx: (offset value) <- compute-offset a, i -218 var x/ecx: (addr value) <- index a, off -219 { -220 var w/eax: int <- value-width x, 0 -221 result <- add w -222 } -223 i <- increment -224 loop -225 } -226 # we won't add 2 for surrounding brackets since we don't surround arrays in -227 # spaces like other value types -228 return result -229 } -230 -231 fn save-lines in-h: (handle array (handle array byte)), _out-ah: (addr handle array value) { -232 var _in/eax: (addr array (handle array byte)) <- lookup in-h -233 var in/esi: (addr array (handle array byte)) <- copy _in -234 var len/ecx: int <- length in -235 var out-ah/edi: (addr handle array value) <- copy _out-ah -236 populate out-ah, len -237 var out/eax: (addr array value) <- lookup *out-ah -238 # copy in into out -239 var i/ebx: int <- copy 0 -240 { -241 compare i, len -242 break-if->= -243 #? print-int32-hex 0, i -244 #? print-string 0, "\n" -245 var src/ecx: (addr handle array byte) <- index in, i -246 var dest-offset/edx: (offset value) <- compute-offset out, i -247 var dest-val/edx: (addr value) <- index out, dest-offset -248 var dest/eax: (addr handle array byte) <- get dest-val, text-data -249 copy-object src, dest -250 var type/edx: (addr int) <- get dest-val, type -251 copy-to *type, 1 # string -252 i <- increment -253 loop -254 } -255 } + 35 dest-addr2 <- get dest-addr, type + 36 copy-to *dest-addr2, 0 # int + 37 } + 38 + 39 fn push-string-to-value-stack _self: (addr value-stack), val: (handle array byte) { + 40 var self/esi: (addr value-stack) <- copy _self + 41 var top-addr/ecx: (addr int) <- get self, top + 42 var data-ah/edx: (addr handle array value) <- get self, data + 43 var data/eax: (addr array value) <- lookup *data-ah + 44 var top/edx: int <- copy *top-addr + 45 var dest-offset/edx: (offset value) <- compute-offset data, top + 46 var dest-addr/edx: (addr value) <- index data, dest-offset + 47 var dest-addr2/eax: (addr handle array byte) <- get dest-addr, text-data + 48 copy-handle val, dest-addr2 + 49 var dest-addr3/eax: (addr int) <- get dest-addr, type + 50 #? print-string 0, "setting type to 1: " + 51 #? { + 52 #? var foo/eax: int <- copy dest-addr3 + 53 #? print-int32-hex 0, foo + 54 #? } + 55 #? print-string 0, "\n" + 56 copy-to *dest-addr3, 1 # type string + 57 increment *top-addr + 58 } + 59 + 60 fn push-array-to-value-stack _self: (addr value-stack), val: (handle array value) { + 61 var self/esi: (addr value-stack) <- copy _self + 62 var top-addr/ecx: (addr int) <- get self, top + 63 var data-ah/edx: (addr handle array value) <- get self, data + 64 var data/eax: (addr array value) <- lookup *data-ah + 65 var top/edx: int <- copy *top-addr + 66 var dest-offset/edx: (offset value) <- compute-offset data, top + 67 var dest-addr/edx: (addr value) <- index data, dest-offset + 68 var dest-addr2/eax: (addr handle array value) <- get dest-addr, array-data + 69 copy-handle val, dest-addr2 + 70 # update type + 71 var dest-addr3/eax: (addr int) <- get dest-addr, type + 72 copy-to *dest-addr3, 2 # type array + 73 increment *top-addr + 74 } + 75 + 76 fn push-value-stack _self: (addr value-stack), val: (addr value) { + 77 var self/esi: (addr value-stack) <- copy _self + 78 var top-addr/ecx: (addr int) <- get self, top + 79 var data-ah/edx: (addr handle array value) <- get self, data + 80 var data/eax: (addr array value) <- lookup *data-ah + 81 var top/edx: int <- copy *top-addr + 82 var dest-offset/edx: (offset value) <- compute-offset data, top + 83 var dest-addr/edx: (addr value) <- index data, dest-offset + 84 copy-object val, dest-addr + 85 increment *top-addr + 86 } + 87 + 88 fn pop-int-from-value-stack _self: (addr value-stack) -> _/eax: int { + 89 var self/esi: (addr value-stack) <- copy _self + 90 var top-addr/ecx: (addr int) <- get self, top + 91 { + 92 compare *top-addr, 0 + 93 break-if-> + 94 return -1 + 95 } + 96 decrement *top-addr + 97 var data-ah/edx: (addr handle array value) <- get self, data + 98 var data/eax: (addr array value) <- lookup *data-ah + 99 var top/edx: int <- copy *top-addr +100 var dest-offset/edx: (offset value) <- compute-offset data, top +101 var result-addr/eax: (addr value) <- index data, dest-offset +102 var result-addr2/eax: (addr int) <- get result-addr, int-data +103 return *result-addr2 +104 } +105 +106 fn value-stack-empty? _self: (addr value-stack) -> _/eax: boolean { +107 var self/esi: (addr value-stack) <- copy _self +108 var top/eax: (addr int) <- get self, top +109 compare *top, 0 +110 { +111 break-if-!= +112 return 1 # true +113 } +114 return 0 # false +115 } +116 +117 fn value-stack-length _self: (addr value-stack) -> _/eax: int { +118 var self/esi: (addr value-stack) <- copy _self +119 var top-addr/eax: (addr int) <- get self, top +120 return *top-addr +121 } +122 +123 fn value-stack-max-width _self: (addr value-stack) -> _/eax: int { +124 var self/esi: (addr value-stack) <- copy _self +125 var data-ah/edi: (addr handle array value) <- get self, data +126 var _data/eax: (addr array value) <- lookup *data-ah +127 var data/edi: (addr array value) <- copy _data +128 var top-addr/ecx: (addr int) <- get self, top +129 var i/ebx: int <- copy 0 +130 var result: int +131 { +132 compare i, *top-addr +133 break-if->= +134 var o/edx: (offset value) <- compute-offset data, i +135 var v/edx: (addr value) <- index data, o +136 var w/eax: int <- value-width v, 1 # top-level=true +137 # if (w > result) w = result +138 { +139 compare w, result +140 break-if-<= +141 copy-to result, w +142 } +143 i <- increment +144 loop +145 } +146 return result +147 } +148 +149 fn save-lines in-h: (handle array (handle array byte)), _out-ah: (addr handle array value) { +150 var _in/eax: (addr array (handle array byte)) <- lookup in-h +151 var in/esi: (addr array (handle array byte)) <- copy _in +152 var len/ecx: int <- length in +153 var out-ah/edi: (addr handle array value) <- copy _out-ah +154 populate out-ah, len +155 var out/eax: (addr array value) <- lookup *out-ah +156 # copy in into out +157 var i/ebx: int <- copy 0 +158 { +159 compare i, len +160 break-if->= +161 #? print-int32-hex 0, i +162 #? print-string 0, "\n" +163 var src/ecx: (addr handle array byte) <- index in, i +164 var dest-offset/edx: (offset value) <- compute-offset out, i +165 var dest-val/edx: (addr value) <- index out, dest-offset +166 var dest/eax: (addr handle array byte) <- get dest-val, text-data +167 copy-object src, dest +168 var type/edx: (addr int) <- get dest-val, type +169 copy-to *type, 1 # string +170 i <- increment +171 loop +172 } +173 } diff --git a/html/apps/tile/value.mu.html b/html/apps/tile/value.mu.html new file mode 100644 index 00000000..6da9cb3d --- /dev/null +++ b/html/apps/tile/value.mu.html @@ -0,0 +1,487 @@ + + + + +Mu - apps/tile/value.mu + + + + + + + + + + +https://github.com/akkartik/mu/blob/master/apps/tile/value.mu +
+  1 fn render-value-at screen: (addr screen), row: int, col: int, _val: (addr value), max-width: int {
+  2   move-cursor screen, row, col
+  3   var val/esi: (addr value) <- copy _val
+  4   var val-type/ecx: (addr int) <- get val, type
+  5   # per-type rendering logic goes here
+  6   compare *val-type, 1  # string
+  7   {
+  8     break-if-!=
+  9     var val-ah/eax: (addr handle array byte) <- get val, text-data
+ 10     var val-string/eax: (addr array byte) <- lookup *val-ah
+ 11     compare val-string, 0
+ 12     break-if-=
+ 13     var orig-len/ecx: int <- length val-string
+ 14     var truncated: (handle array byte)
+ 15     var truncated-ah/esi: (addr handle array byte) <- address truncated
+ 16     substring val-string, 0, 0xc, truncated-ah
+ 17     var truncated-string/eax: (addr array byte) <- lookup *truncated-ah
+ 18     var len/edx: int <- length truncated-string
+ 19     start-color screen, 0xf2, 7
+ 20     print-code-point screen, 0x275d  # open-quote
+ 21     print-string screen, truncated-string
+ 22     compare len, orig-len
+ 23     {
+ 24       break-if-=
+ 25       print-code-point screen, 0x2026  # ellipses
+ 26     }
+ 27     print-code-point screen, 0x275e  # close-quote
+ 28     reset-formatting screen
+ 29     return
+ 30   }
+ 31   compare *val-type, 2  # array
+ 32   {
+ 33     break-if-!=
+ 34     var val-ah/eax: (addr handle array value) <- get val, array-data
+ 35     var val-array/eax: (addr array value) <- lookup *val-ah
+ 36     render-array-at screen, row, col, val-array
+ 37     return
+ 38   }
+ 39   compare *val-type, 3  # file
+ 40   {
+ 41     break-if-!=
+ 42     var val-ah/eax: (addr handle buffered-file) <- get val, file-data
+ 43     var val-file/eax: (addr buffered-file) <- lookup *val-ah
+ 44     start-color screen, 0, 7
+ 45     # TODO
+ 46     print-string screen, " FILE "
+ 47     return
+ 48   }
+ 49   compare *val-type, 4  # screen
+ 50   {
+ 51     break-if-!=
+ 52 #?     print-string 0, "render-screen"
+ 53     var val-ah/eax: (addr handle screen) <- get val, screen-data
+ 54     var val-screen/eax: (addr screen) <- lookup *val-ah
+ 55     render-screen screen, row, col, val-screen
+ 56 #?     print-string 0, "}\n"
+ 57     return
+ 58   }
+ 59   # render ints by default for now
+ 60   var val-int/eax: (addr int) <- get val, int-data
+ 61   render-integer screen, *val-int, max-width
+ 62 }
+ 63 
+ 64 # synaesthesia
+ 65 fn render-integer screen: (addr screen), val: int, max-width: int {
+ 66 $render-integer:body: {
+ 67   # if max-width is 0, we're inside an array. No coloring.
+ 68   compare max-width, 0
+ 69   {
+ 70     break-if-!=
+ 71     print-int32-decimal screen, val
+ 72     break $render-integer:body
+ 73   }
+ 74   var bg/eax: int <- hash-color val
+ 75   var fg/ecx: int <- copy 7
+ 76   {
+ 77     compare bg, 2
+ 78     break-if-!=
+ 79     fg <- copy 0
+ 80   }
+ 81   {
+ 82     compare bg, 3
+ 83     break-if-!=
+ 84     fg <- copy 0
+ 85   }
+ 86   {
+ 87     compare bg, 6
+ 88     break-if-!=
+ 89     fg <- copy 0
+ 90   }
+ 91   start-color screen, fg, bg
+ 92   print-grapheme screen, 0x20  # space
+ 93   print-int32-decimal-right-justified screen, val, max-width
+ 94   print-grapheme screen, 0x20  # space
+ 95 }
+ 96 }
+ 97 
+ 98 fn render-array-at screen: (addr screen), row: int, col: int, _a: (addr array value) {
+ 99   start-color screen, 0xf2, 7
+100   # don't surround in spaces
+101   print-grapheme screen, 0x5b  # '['
+102   increment col
+103   var a/esi: (addr array value) <- copy _a
+104   var max/ecx: int <- length a
+105   var i/eax: int <- copy 0
+106   {
+107     compare i, max
+108     break-if->=
+109     {
+110       compare i, 0
+111       break-if-=
+112       print-string screen, " "
+113     }
+114     var off/ecx: (offset value) <- compute-offset a, i
+115     var x/ecx: (addr value) <- index a, off
+116     render-value-at screen, row, col, x, 0
+117     {
+118       var w/eax: int <- value-width x, 0
+119       add-to col, w
+120       increment col
+121     }
+122     i <- increment
+123     loop
+124   }
+125   print-grapheme screen, 0x5d  # ']'
+126 }
+127 
+128 fn render-screen screen: (addr screen), row: int, col: int, _target-screen: (addr screen) {
+129   reset-formatting screen
+130   start-color screen, 0xf2, 7
+131   move-cursor screen, row, col
+132   var target-screen/esi: (addr screen) <- copy _target-screen
+133   var ncols-a/ecx: (addr int) <- get target-screen, num-cols
+134   print-upper-border screen, *ncols-a
+135   var r/edx: int <- copy 1
+136   var nrows-a/ebx: (addr int) <- get target-screen, num-rows
+137   {
+138     compare r, *nrows-a
+139     break-if->
+140     increment row  # mutate arg
+141     move-cursor screen, row, col
+142     print-string screen, " "
+143     var c/edi: int <- copy 1
+144     {
+145       compare c, *ncols-a
+146       break-if->
+147       print-screen-cell-of-fake-screen screen, target-screen, r, c
+148       c <- increment
+149       loop
+150     }
+151     print-string screen, " "
+152     r <- increment
+153     loop
+154   }
+155   increment row  # mutate arg
+156   move-cursor screen, row, col
+157   start-color screen, 0xf2, 7
+158   print-lower-border screen, *ncols-a
+159 }
+160 
+161 fn hash-color val: int -> _/eax: int {
+162   var result/eax: int <- try-modulo val, 7  # assumes that 7 is always the background color
+163   return result
+164 }
+165 
+166 fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), _row: int, _col: int {
+167   start-color screen, 0, 0xf6
+168   var target/esi: (addr screen) <- copy _target
+169   var row/ecx: int <- copy _row
+170   var col/edx: int <- copy _col
+171   # if cursor is at screen-cell, add some fancy
+172   {
+173     var cursor-row/eax: (addr int) <- get target, cursor-row
+174     compare *cursor-row, row
+175     break-if-!=
+176     var cursor-col/eax: (addr int) <- get target, cursor-col
+177     compare *cursor-col, col
+178     break-if-!=
+179     start-blinking screen
+180     start-color screen, 0, 1
+181   }
+182   var g/eax: grapheme <- screen-grapheme-at target, row, col
+183   {
+184     compare g, 0
+185     break-if-!=
+186     g <- copy 0x20  # space
+187   }
+188   print-grapheme screen, g
+189   reset-formatting screen
+190 }
+191 
+192 fn print-upper-border screen: (addr screen), width: int {
+193   print-code-point screen, 0x250c  # top-left corner
+194   var i/eax: int <- copy 0
+195   {
+196     compare i, width
+197     break-if->=
+198     print-code-point screen, 0x2500  # horizontal line
+199     i <- increment
+200     loop
+201   }
+202   print-code-point screen, 0x2510  # top-right corner
+203 }
+204 
+205 fn print-lower-border screen: (addr screen), width: int {
+206   print-code-point screen, 0x2514  # bottom-left corner
+207   var i/eax: int <- copy 0
+208   {
+209     compare i, width
+210     break-if->=
+211     print-code-point screen, 0x2500  # horizontal line
+212     i <- increment
+213     loop
+214   }
+215   print-code-point screen, 0x2518  # bottom-right corner
+216 }
+217 
+218 fn value-width _v: (addr value), top-level: boolean -> _/eax: int {
+219   var v/esi: (addr value) <- copy _v
+220   var type/eax: (addr int) <- get v, type
+221   {
+222     compare *type, 0  # int
+223     break-if-!=
+224     var v-int/edx: (addr int) <- get v, int-data
+225     var result/eax: int <- decimal-size *v-int
+226     return result
+227   }
+228   {
+229     compare *type, 1  # string
+230     break-if-!=
+231     var s-ah/eax: (addr handle array byte) <- get v, text-data
+232     var s/eax: (addr array byte) <- lookup *s-ah
+233     compare s, 0
+234     break-if-=
+235     var result/eax: int <- length s
+236     compare result, 0xd  # max string size
+237     {
+238       break-if-<=
+239       result <- copy 0xd
+240     }
+241     # if it's a nested string, include space for quotes
+242     # we don't do this for the top-level, where the quotes will overflow
+243     # into surrounding padding.
+244     compare top-level, 0  # false
+245     {
+246       break-if-!=
+247       result <- add 2
+248     }
+249     return result
+250   }
+251   {
+252     compare *type, 2  # array
+253     break-if-!=
+254     var a-ah/eax: (addr handle array value) <- get v, array-data
+255     var a/eax: (addr array value) <- lookup *a-ah
+256     compare a, 0
+257     break-if-=
+258     var result/eax: int <- array-width a
+259     return result
+260   }
+261   {
+262     compare *type, 3  # file handle
+263     break-if-!=
+264     var f-ah/eax: (addr handle buffered-file) <- get v, file-data
+265     var f/eax: (addr buffered-file) <- lookup *f-ah
+266     compare f, 0
+267     break-if-=
+268     # TODO: visualizing file handles
+269     return 4
+270   }
+271   {
+272     compare *type, 4  # screen
+273     break-if-!=
+274     var screen-ah/eax: (addr handle screen) <- get v, screen-data
+275     var screen/eax: (addr screen) <- lookup *screen-ah
+276     compare screen, 0
+277     break-if-=
+278     var ncols/ecx: (addr int) <- get screen, num-cols
+279     var result/eax: int <- copy *ncols
+280     result <- add 2  # left/right margins
+281     return *ncols
+282   }
+283   return 0
+284 }
+285 
+286 # keep sync'd with render-array-at
+287 fn array-width _a: (addr array value) -> _/eax: int {
+288   var a/esi: (addr array value) <- copy _a
+289   var max/ecx: int <- length a
+290   var i/eax: int <- copy 0
+291   var result/edi: int <- copy 0
+292   {
+293     compare i, max
+294     break-if->=
+295     {
+296       compare i, 0
+297       break-if-=
+298       result <- increment  # for space
+299     }
+300     var off/ecx: (offset value) <- compute-offset a, i
+301     var x/ecx: (addr value) <- index a, off
+302     {
+303       var w/eax: int <- value-width x, 0
+304       result <- add w
+305     }
+306     i <- increment
+307     loop
+308   }
+309   # we won't add 2 for surrounding brackets since we don't surround arrays in
+310   # spaces like other value types
+311   return result
+312 }
+313 
+314 fn value-height _v: (addr value) -> _/eax: int {
+315   var v/esi: (addr value) <- copy _v
+316   var type/eax: (addr int) <- get v, type
+317   {
+318     compare *type, 3  # file handle
+319     break-if-!=
+320     # TODO: visualizing file handles
+321     return 1
+322   }
+323   {
+324     compare *type, 4  # screen
+325     break-if-!=
+326     var screen-ah/eax: (addr handle screen) <- get v, screen-data
+327     var screen/eax: (addr screen) <- lookup *screen-ah
+328     compare screen, 0
+329     break-if-=
+330     var nrows/ecx: (addr int) <- get screen, num-rows
+331     var result/eax: int <- copy *nrows
+332     result <- add 2  # top and bottom border
+333     return result
+334   }
+335   return 1
+336 }
+337 
+338 fn deep-copy-value _src: (addr value), _dest: (addr value) {
+339 #?   print-string 0, "deep-copy-value\n"
+340   var src/esi: (addr value) <- copy _src
+341   var dest/edi: (addr value) <- copy _dest
+342   var type/ebx: (addr int) <- get src, type
+343   var y/ecx: (addr int) <- get dest, type
+344   copy-object type, y
+345   compare *type, 0   # int
+346   {
+347     break-if-!=
+348 #?     print-string 0, "int value\n"
+349     var x/eax: (addr int) <- get src, int-data
+350     y <- get dest, int-data
+351     copy-object x, y
+352     return
+353   }
+354   compare *type, 1  # string
+355   {
+356     break-if-!=
+357 #?     print-string 0, "string value\n"
+358     var src-ah/eax: (addr handle array byte) <- get src, text-data
+359     var src/eax: (addr array byte) <- lookup *src-ah
+360     var dest-ah/edx: (addr handle array byte) <- get dest, text-data
+361     copy-array-object src, dest-ah
+362     return
+363   }
+364   compare *type, 2  # array
+365   {
+366     break-if-!=
+367 #?     print-string 0, "array value\n"
+368     var src-ah/eax: (addr handle array value) <- get src, array-data
+369     var _src/eax: (addr array value) <- lookup *src-ah
+370     var src/esi: (addr array value) <- copy _src
+371     var n/ecx: int <- length src
+372     var dest-ah/edx: (addr handle array value) <- get dest, array-data
+373     populate dest-ah, n
+374     var _dest/eax: (addr array value) <- lookup *dest-ah
+375     var dest/edi: (addr array value) <- copy _dest
+376     var i/eax: int <- copy 0
+377     {
+378       compare i, n
+379       break-if->=
+380       {
+381         var offset/edx: (offset value) <- compute-offset src, i
+382         var src-element/eax: (addr value) <- index src, offset
+383         var dest-element/ecx: (addr value) <- index dest, offset
+384         deep-copy-value src-element, dest-element
+385       }
+386       i <- increment
+387       loop
+388     }
+389     copy-array-object src, dest-ah
+390     return
+391   }
+392   compare *type, 3  # file
+393   {
+394     break-if-!=
+395 #?     print-string 0, "file value\n"
+396     var src-filename-ah/eax: (addr handle array byte) <- get src, filename
+397     var _src-filename/eax: (addr array byte) <- lookup *src-filename-ah
+398     var src-filename/ecx: (addr array byte) <- copy _src-filename
+399     var dest-filename-ah/ebx: (addr handle array byte) <- get dest, filename
+400     copy-array-object src-filename, dest-filename-ah
+401     var src-file-ah/eax: (addr handle buffered-file) <- get src, file-data
+402     var src-file/eax: (addr buffered-file) <- lookup *src-file-ah
+403     var dest-file-ah/edx: (addr handle buffered-file) <- get dest, file-data
+404     copy-file src-file, dest-file-ah, src-filename
+405     return
+406   }
+407   compare *type, 4  # screen
+408   {
+409     break-if-!=
+410 #?     print-string 0, "screen value\n"
+411     var src-screen-ah/eax: (addr handle screen) <- get src, screen-data
+412     var _src-screen/eax: (addr screen) <- lookup *src-screen-ah
+413     var src-screen/ecx: (addr screen) <- copy _src-screen
+414     var dest-screen-ah/eax: (addr handle screen) <- get dest, screen-data
+415     allocate dest-screen-ah
+416     var dest-screen/eax: (addr screen) <- lookup *dest-screen-ah
+417     copy-object src-screen, dest-screen
+418     var dest-screen-data-ah/ebx: (addr handle array screen-cell) <- get dest-screen, data
+419     var src-screen-data-ah/eax: (addr handle array screen-cell) <- get src-screen, data
+420     var src-screen-data/eax: (addr array screen-cell) <- lookup *src-screen-data-ah
+421     copy-array-object src-screen-data, dest-screen-data-ah
+422     return
+423   }
+424 }
+
+ + + -- cgit 1.4.1-2-gfad0