diff --git a/shell/cell.mu b/shell/cell.mu index 6ca1fcb3..85596d64 100644 --- a/shell/cell.mu +++ b/shell/cell.mu @@ -13,7 +13,7 @@ type cell { # type 5: screen screen-data: (handle screen) # type 6: keyboard - keyboard-data: (handle stream byte) + keyboard-data: (handle gap-buffer) # TODO: array, (associative) table, stream } @@ -151,12 +151,21 @@ fn clear-screen-cell _self-ah: (addr handle cell) { clear-screen screen } -fn allocate-keyboard _out: (addr handle cell), capacity: int { +fn allocate-keyboard _out: (addr handle cell) { var out/eax: (addr handle cell) <- copy _out allocate out var out-addr/eax: (addr cell) <- lookup *out - var dest-ah/ecx: (addr handle stream byte) <- get out-addr, keyboard-data - populate-stream dest-ah, capacity + var dest-ah/ecx: (addr handle gap-buffer) <- get out-addr, keyboard-data + allocate dest-ah var type/ecx: (addr int) <- get out-addr, type copy-to *type, 6/keyboard } + +fn new-keyboard _out: (addr handle cell), capacity: int { + var out/eax: (addr handle cell) <- copy _out + allocate-keyboard out + var out-addr/eax: (addr cell) <- lookup *out + var dest-ah/eax: (addr handle gap-buffer) <- get out-addr, keyboard-data + var dest-addr/eax: (addr gap-buffer) <- lookup *dest-ah + initialize-gap-buffer dest-addr, capacity +} diff --git a/shell/evaluate.mu b/shell/evaluate.mu index 2966751e..ba13b494 100644 --- a/shell/evaluate.mu +++ b/shell/evaluate.mu @@ -1,7 +1,7 @@ # env is an alist of ((sym . val) (sym . val) ...) # we never modify `in` or `env` # ignore 'screen-cell' on a first reading; it's a hack for sandboxes -fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) { +fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { var in/esi: (addr handle cell) <- copy _in #? dump-cell in #? { @@ -47,7 +47,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel { break-if-!= trace-text trace, "eval", "symbol" - lookup-symbol in-addr, out, env-h, globals, trace, screen-cell + lookup-symbol in-addr, out, env-h, globals, trace, screen-cell, keyboard-cell trace-higher trace return } @@ -121,7 +121,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel rest-ah <- get rest, right rest <- lookup *rest-ah var second-arg-ah/edx: (addr handle cell) <- get rest, left - evaluate second-arg-ah, out, env-h, globals, trace, screen-cell + evaluate second-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell trace-text trace, "eval", "saving global binding" var first-arg/eax: (addr cell) <- lookup *first-arg-ah var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data @@ -158,7 +158,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel var first-arg-ah/ecx: (addr handle cell) <- get rest, left var guard-h: (handle cell) var guard-ah/esi: (addr handle cell) <- address guard-h - evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell + evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell rest-ah <- get rest, right rest <- lookup *rest-ah var branch-ah/edi: (addr handle cell) <- get rest, left @@ -173,7 +173,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel rest <- lookup *rest-ah branch-ah <- get rest, left } - evaluate branch-ah, out, env-h, globals, trace, screen-cell + evaluate branch-ah, out, env-h, globals, trace, screen-cell, keyboard-cell trace-higher trace return } @@ -192,7 +192,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel var curr-out/eax: (addr cell) <- lookup *curr-out-ah var left-out-ah/edi: (addr handle cell) <- get curr-out, left var left-ah/esi: (addr handle cell) <- get curr, left - evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell + evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell, keyboard-cell # curr-out-ah <- get curr-out, right var right-ah/eax: (addr handle cell) <- get curr, right @@ -205,7 +205,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel var args-ah/edx: (addr handle cell) <- get evaluated-list, right #? dump-cell args-ah #? abort "aaa" - apply function-ah, args-ah, out, env-h, globals, trace, screen-cell + apply function-ah, args-ah, out, env-h, globals, trace, screen-cell, keyboard-cell trace-higher trace # trace "=> " out {{{ { @@ -218,7 +218,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel # }}} } -fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) { +fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { var f-ah/eax: (addr handle cell) <- copy _f-ah var _f/eax: (addr cell) <- lookup *f-ah var f/esi: (addr cell) <- copy _f @@ -257,14 +257,14 @@ fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr hand var rest/eax: (addr cell) <- lookup *rest-ah var params-ah/ecx: (addr handle cell) <- get rest, left var body-ah/eax: (addr handle cell) <- get rest, right - apply-function params-ah, args-ah, body-ah, out, env-h, globals, trace, screen-cell + apply-function params-ah, args-ah, body-ah, out, env-h, globals, trace, screen-cell, keyboard-cell trace-higher trace return } error trace, "unknown function" } -fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), _body-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) { +fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), _body-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { # push bindings for params to env var new-env-storage: (handle cell) var new-env-ah/esi: (addr handle cell) <- address new-env-storage @@ -282,7 +282,7 @@ fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), _b # evaluate each expression, writing result to `out` { var curr-ah/eax: (addr handle cell) <- get body, left - evaluate curr-ah, out, *new-env-ah, globals, trace, screen-cell + evaluate curr-ah, out, *new-env-ah, globals, trace, screen-cell, keyboard-cell } # body-ah <- get body, right @@ -375,7 +375,7 @@ fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), o trace-higher trace } -fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) { +fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { # trace sym { var stream-storage: (stream byte 0x40) @@ -408,7 +408,7 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell) var env-nil?/eax: boolean <- nil? env compare env-nil?, 0/false break-if-= - lookup-symbol-in-globals sym, out, globals, trace, screen-cell + lookup-symbol-in-globals sym, out, globals, trace, screen-cell, keyboard-cell trace-higher trace # trace "=> " out " (global)" {{{ { @@ -480,7 +480,7 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell) var env-tail-storage: (handle cell) var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage cdr env, env-tail-ah, trace - lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell + lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell, keyboard-cell trace-higher trace # trace "=> " out " (recurse)" {{{ { @@ -518,7 +518,7 @@ fn test-lookup-symbol-in-env { var tmp-ah/edx: (addr handle cell) <- address tmp-storage new-symbol tmp-ah, "a" var in/eax: (addr cell) <- lookup *tmp-ah - lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen + lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard var result/eax: (addr cell) <- lookup *tmp-ah var result-type/edx: (addr int) <- get result, type check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0" @@ -540,7 +540,7 @@ fn test-lookup-symbol-in-globals { var tmp-ah/ebx: (addr handle cell) <- address tmp-storage new-symbol tmp-ah, "+" var in/eax: (addr cell) <- lookup *tmp-ah - lookup-symbol in, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen + lookup-symbol in, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard var result/eax: (addr cell) <- lookup *tmp-ah var result-type/edx: (addr int) <- get result, type check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0" @@ -755,7 +755,7 @@ fn test-evaluate-is-well-behaved { var tmp-storage: (handle cell) var tmp-ah/edx: (addr handle cell) <- address tmp-storage new-symbol tmp-ah, "a" - evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen + evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard # doesn't die check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved" } @@ -769,7 +769,7 @@ fn test-evaluate-number { var tmp-storage: (handle cell) var tmp-ah/edx: (addr handle cell) <- address tmp-storage new-integer tmp-ah, 3 - evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen + evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard # var result/eax: (addr cell) <- lookup *tmp-ah var result-type/edx: (addr int) <- get result, type @@ -799,7 +799,7 @@ fn test-evaluate-symbol { var tmp-storage: (handle cell) var tmp-ah/edx: (addr handle cell) <- address tmp-storage new-symbol tmp-ah, "a" - evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen + evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard var result/eax: (addr cell) <- lookup *tmp-ah var result-type/edx: (addr int) <- get result, type check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0" @@ -821,7 +821,7 @@ fn test-evaluate-primitive-function { # eval +, nil env var tmp-storage: (handle cell) var tmp-ah/esi: (addr handle cell) <- address tmp-storage - evaluate add-ah, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen + evaluate add-ah, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard # var result/eax: (addr cell) <- lookup *tmp-ah var result-type/edx: (addr int) <- get result, type @@ -856,7 +856,7 @@ fn test-evaluate-primitive-function-call { var globals/edx: (addr global-table) <- address globals-storage initialize-globals globals # - evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen + evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard #? dump-trace t # var result/eax: (addr cell) <- lookup *tmp-ah diff --git a/shell/global.mu b/shell/global.mu index 68b584ea..f5d513c5 100644 --- a/shell/global.mu +++ b/shell/global.mu @@ -130,7 +130,7 @@ fn append-global _self: (addr global-table), name: (addr array byte), value: (ha copy-handle value, curr-value-ah } -fn lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) { +fn lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { var sym/eax: (addr cell) <- copy _sym var sym-name-ah/eax: (addr handle stream byte) <- get sym, text-data var _sym-name/eax: (addr stream byte) <- lookup *sym-name-ah @@ -160,6 +160,16 @@ fn lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals copy-object screen-cell, out return } + # if sym is "keyboard" and keyboard-cell exists, return it + { + var sym-is-keyboard?/eax: boolean <- stream-data-equal? sym-name, "keyboard" + compare sym-is-keyboard?, 0/false + break-if-= + compare keyboard-cell, 0 + break-if-= + copy-object keyboard-cell, out + return + } # otherwise error "unbound symbol: ", sym var stream-storage: (stream byte 0x40) var stream/ecx: (addr stream byte) <- address stream-storage diff --git a/shell/sandbox.mu b/shell/sandbox.mu index e40f4ab6..c58d49a3 100644 --- a/shell/sandbox.mu +++ b/shell/sandbox.mu @@ -5,6 +5,7 @@ type sandbox { keyboard-var: (handle cell) trace: (handle trace) cursor-in-trace?: boolean + cursor-in-keyboard?: boolean } fn initialize-sandbox _self: (addr sandbox), screen-and-keyboard?: boolean { @@ -23,7 +24,7 @@ fn initialize-sandbox _self: (addr sandbox), screen-and-keyboard?: boolean { var screen-ah/eax: (addr handle cell) <- get self, screen-var new-screen screen-ah, 5/width, 4/height var keyboard-ah/eax: (addr handle cell) <- get self, keyboard-var - allocate-keyboard keyboard-ah, 5/capacity + new-keyboard keyboard-ah, 0x10/keyboard-capacity } # var trace-ah/eax: (addr handle trace) <- get self, trace @@ -61,6 +62,7 @@ fn render-sandbox screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: var x/eax: int <- copy xmin var y/ecx: int <- copy ymin y <- maybe-render-empty-screen screen, self, xmin, y + y <- maybe-render-keyboard screen, self, xmin, y var cursor-in-sandbox?/ebx: boolean <- copy 0/false { var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace? @@ -282,6 +284,79 @@ fn render-screen screen: (addr screen), _target-screen: (addr screen), xmin: int return screen-y } +fn maybe-render-keyboard screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int { + var self/esi: (addr sandbox) <- copy _self + var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var + var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah + compare keyboard-obj-cell, 0 + { + break-if-!= + return ymin + } + var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type + compare *keyboard-obj-cell-type, 6/keyboard + { + break-if-= + return ymin # silently give up on rendering the keyboard + } + var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data + var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah + var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj + var x/eax: int <- draw-text-rightward screen, "keyboard: ", xmin, 0x99/xmax, ymin, 7/fg, 0/bg + var y/ecx: int <- copy ymin + var cursor-in-keyboard?/esi: (addr boolean) <- get self, cursor-in-keyboard? + y <- render-keyboard screen, keyboard-obj, x, y, *cursor-in-keyboard? + return y +} + +# draw an evocative shape +fn render-keyboard screen: (addr screen), _keyboard: (addr gap-buffer), xmin: int, ymin: int, render-cursor?: boolean -> _/ecx: int { + var keyboard/esi: (addr gap-buffer) <- copy _keyboard + var width/edx: int <- copy 0x10/keyboard-capacity + var y/edi: int <- copy ymin + # top border + { + set-cursor-position screen, xmin, y + move-cursor-right screen + var x/ebx: int <- copy 0 + { + compare x, width + break-if->= + draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg + move-cursor-right screen + x <- increment + loop + } + y <- increment + } + # keyboard + var x/eax: int <- copy xmin + draw-code-point screen, 0x7c/vertical-bar, x, y, 0x18/fg, 0/bg + x <- increment + x <- render-gap-buffer screen, keyboard, x, y, render-cursor? + x <- copy xmin + x <- add 1 # for left bar + x <- add 0x10/keyboard-capacity + draw-code-point screen, 0x7c/vertical-bar, x, y, 0x18/fg, 0/bg + y <- increment + # bottom border + { + set-cursor-position screen, xmin, y + move-cursor-right screen + var x/ebx: int <- copy 0 + { + compare x, width + break-if->= + draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg + move-cursor-right screen + x <- increment + loop + } + y <- increment + } + return y +} + fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), x: int, y: int { var target/ecx: (addr screen) <- copy _target var data-ah/eax: (addr handle array screen-cell) <- get target, data @@ -349,7 +424,9 @@ fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table), clear-trace trace var screen-cell/eax: (addr handle cell) <- get self, screen-var clear-screen-cell screen-cell - run data, value, globals, trace, screen-cell + var keyboard-cell/esi: (addr handle cell) <- get self, keyboard-var + # don't clear + run data, value, globals, trace, screen-cell, keyboard-cell return } # tab @@ -384,7 +461,7 @@ fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table), return } -fn run in: (addr gap-buffer), out: (addr stream byte), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) { +fn run in: (addr gap-buffer), out: (addr stream byte), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { var read-result-storage: (handle cell) var read-result/esi: (addr handle cell) <- address read-result-storage read-cell in, read-result, trace @@ -399,7 +476,7 @@ fn run in: (addr gap-buffer), out: (addr stream byte), globals: (addr global-tab allocate-pair nil-ah var eval-result-storage: (handle cell) var eval-result/edi: (addr handle cell) <- address eval-result-storage - evaluate read-result, eval-result, *nil-ah, globals, trace, screen-cell + evaluate read-result, eval-result, *nil-ah, globals, trace, screen-cell, keyboard-cell var error?/eax: boolean <- has-errors? trace { compare error?, 0/false @@ -414,7 +491,7 @@ fn run in: (addr gap-buffer), out: (addr stream byte), globals: (addr global-tab fn test-run-integer { var sandbox-storage: sandbox var sandbox/esi: (addr sandbox) <- address sandbox-storage - initialize-sandbox sandbox, 0/no-screen + initialize-sandbox sandbox, 0/no-screen-or-keyboard # type "1" edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk # eval @@ -433,7 +510,7 @@ fn test-run-integer { fn test-run-with-spaces { var sandbox-storage: sandbox var sandbox/esi: (addr sandbox) <- address sandbox-storage - initialize-sandbox sandbox, 0/no-screen + initialize-sandbox sandbox, 0/no-screen-or-keyboard # type input with whitespace before and after edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk @@ -456,7 +533,7 @@ fn test-run-with-spaces { fn test-run-quote { var sandbox-storage: sandbox var sandbox/esi: (addr sandbox) <- address sandbox-storage - initialize-sandbox sandbox, 0/no-screen + initialize-sandbox sandbox, 0/no-screen-or-keyboard # type "'a" edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk @@ -476,7 +553,7 @@ fn test-run-quote { fn test-run-error-invalid-integer { var sandbox-storage: sandbox var sandbox/esi: (addr sandbox) <- address sandbox-storage - initialize-sandbox sandbox, 0/no-screen + initialize-sandbox sandbox, 0/no-screen-or-keyboard # type "1a" edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk @@ -496,7 +573,7 @@ fn test-run-error-invalid-integer { fn test-run-move-cursor-into-trace { var sandbox-storage: sandbox var sandbox/esi: (addr sandbox) <- address sandbox-storage - initialize-sandbox sandbox, 0/no-screen + initialize-sandbox sandbox, 0/no-screen-or-keyboard # type "12" edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk edit-sandbox sandbox, 0x32/2, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk