diff options
Diffstat (limited to 'shell')
| -rw-r--r-- | shell/evaluate.mu | 96 | ||||
| -rw-r--r-- | shell/global.mu | 105 | ||||
| -rw-r--r-- | shell/main.mu | 7 | ||||
| -rw-r--r-- | shell/sandbox.mu | 38 |
4 files changed, 151 insertions, 95 deletions
diff --git a/shell/evaluate.mu b/shell/evaluate.mu index e1fc3c50..00fb36f9 100644 --- a/shell/evaluate.mu +++ b/shell/evaluate.mu @@ -1,6 +1,6 @@ # env is an alist of ((sym . val) (sym . val) ...) # we never modify `in` or `env` -fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) { +fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace) { var in/esi: (addr handle cell) <- copy _in # trace "evaluate " in " in environment " env {{{ { @@ -75,7 +75,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, trace + evaluate left-ah, left-out-ah, env-h, globals, trace # curr-out-ah <- get curr-out, right var right-ah/eax: (addr handle cell) <- get curr, right @@ -88,7 +88,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, trace + apply function-ah, args-ah, out, env-h, globals, trace trace-higher trace # trace "=> " out {{{ { @@ -101,7 +101,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), trace: (addr trace) { +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) { 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 @@ -110,7 +110,7 @@ fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr hand var f-type/eax: (addr int) <- get f, type compare *f-type, 4/primitive-function break-if-!= - apply-primitive f, args-ah, out, env-h, trace + apply-primitive f, args-ah, out, env-h, globals, trace return } # if it's not a primitive function it must be an anonymous function @@ -140,14 +140,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, trace + apply-function params-ah, args-ah, body-ah, out, env-h, globals, trace 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), trace: (addr trace) { +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) { # push bindings for params to env var new-env-storage: (handle cell) var new-env-ah/esi: (addr handle cell) <- address new-env-storage @@ -165,7 +165,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, trace + evaluate curr-ah, out, *new-env-ah, globals, trace } # body-ah <- get body, right @@ -258,66 +258,6 @@ fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), o trace-higher trace } -fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) { - var f/esi: (addr cell) <- copy _f - var f-index/eax: (addr int) <- get f, index-data - { - compare *f-index, 1/add - break-if-!= - apply-add args-ah, out, env-h, trace - return - } - abort "unknown primitive function" -} - -fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) { - trace-text trace, "eval", "apply +" - var args-ah/eax: (addr handle cell) <- copy _args-ah - var _args/eax: (addr cell) <- lookup *args-ah - var args/esi: (addr cell) <- copy _args - var _env/eax: (addr cell) <- lookup env-h - var env/edi: (addr cell) <- copy _env - # TODO: check that args is a pair - var empty-args?/eax: boolean <- nil? args - compare empty-args?, 0/false - { - break-if-= - error trace, "+ needs 2 args but got 0" - return - } - # args->left->value - var first-ah/eax: (addr handle cell) <- get args, left - var first/eax: (addr cell) <- lookup *first-ah - var first-type/ecx: (addr int) <- get first, type - compare *first-type, 1/number - { - break-if-= - error trace, "first arg for + is not a number" - return - } - var first-value/ecx: (addr float) <- get first, number-data - # args->right->left->value - var right-ah/eax: (addr handle cell) <- get args, right -#? dump-cell right-ah -#? abort "aaa" - var right/eax: (addr cell) <- lookup *right-ah - # TODO: check that right is a pair - var second-ah/eax: (addr handle cell) <- get right, left - var second/eax: (addr cell) <- lookup *second-ah - var second-type/edx: (addr int) <- get second, type - compare *second-type, 1/number - { - break-if-= - error trace, "second arg for + is not a number" - return - } - var second-value/edx: (addr float) <- get second, number-data - # add - var result/xmm0: float <- copy *first-value - result <- add *second-value - new-float out, result -} - fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) { # trace sym { @@ -717,7 +657,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, t + evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t # doesn't die check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved" } @@ -731,7 +671,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-trace + evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace # var result/eax: (addr cell) <- lookup *tmp-ah var result-type/edx: (addr int) <- get result, type @@ -761,7 +701,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-trace + evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace 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" @@ -771,6 +711,9 @@ fn test-evaluate-symbol { } fn test-evaluate-primitive-function { + var globals-storage: global-table + var globals/edi: (addr global-table) <- address globals-storage + initialize-globals globals var nil-storage: (handle cell) var nil-ah/ecx: (addr handle cell) <- address nil-storage allocate-pair nil-ah @@ -780,7 +723,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, 0/no-trace + evaluate add-ah, tmp-ah, *nil-ah, globals, 0/no-trace # var result/eax: (addr cell) <- lookup *tmp-ah var result-type/edx: (addr int) <- get result, type @@ -803,14 +746,19 @@ fn test-evaluate-primitive-function-call { var add-storage: (handle cell) var add-ah/ebx: (addr handle cell) <- address add-storage new-symbol add-ah, "+" - # eval (+ 1 1), nil env + # input is (+ 1 1) var tmp-storage: (handle cell) var tmp-ah/esi: (addr handle cell) <- address tmp-storage new-pair tmp-ah, *one-ah, *nil-ah new-pair tmp-ah, *one-ah, *tmp-ah new-pair tmp-ah, *add-ah, *tmp-ah #? dump-cell tmp-ah - evaluate tmp-ah, tmp-ah, *nil-ah, t + # + var globals-storage: global-table + var globals/edx: (addr global-table) <- address globals-storage + initialize-globals globals + # + evaluate tmp-ah, tmp-ah, *nil-ah, globals, t #? dump-trace t # var result/eax: (addr cell) <- lookup *tmp-ah diff --git a/shell/global.mu b/shell/global.mu new file mode 100644 index 00000000..5aa1e22c --- /dev/null +++ b/shell/global.mu @@ -0,0 +1,105 @@ +type global { + name: (handle array byte) + value: (handle cell) +} + +type global-table { + data: (handle array global) + final-index: int +} + +fn initialize-globals _self: (addr global-table) { + var self/esi: (addr global-table) <- copy _self + var data-ah/eax: (addr handle array global) <- get self, data + populate data-ah, 0x10 + append-primitive self, "+" + append-primitive self, "-" + append-primitive self, "*" + append-primitive self, "/" +} + +fn append-primitive _self: (addr global-table), name: (addr array byte) { + var self/esi: (addr global-table) <- copy _self + var final-index-addr/ecx: (addr int) <- get self, final-index + increment *final-index-addr + var curr-index/ecx: int <- copy *final-index-addr + var data-ah/eax: (addr handle array global) <- get self, data + var data/eax: (addr array global) <- lookup *data-ah + var curr-offset/esi: (offset global) <- compute-offset data, curr-index + var curr/esi: (addr global) <- index data, curr-offset + var curr-name-ah/eax: (addr handle array byte) <- get curr, name + copy-array-object name, curr-name-ah + var curr-value-ah/eax: (addr handle cell) <- get curr, value + new-primitive-function curr-value-ah, curr-index +} + +# a little strange; goes from value to name and selects primitive based on name +fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), _globals: (addr global-table), trace: (addr trace) { + var f/esi: (addr cell) <- copy _f + var f-index-a/ecx: (addr int) <- get f, index-data + var f-index/ecx: int <- copy *f-index-a + var globals/eax: (addr global-table) <- copy _globals + var global-data-ah/eax: (addr handle array global) <- get globals, data + var global-data/eax: (addr array global) <- lookup *global-data-ah + var f-offset/ecx: (offset global) <- compute-offset global-data, f-index + var f-value/ecx: (addr global) <- index global-data, f-offset + var f-name-ah/ecx: (addr handle array byte) <- get f-value, name + var f-name/eax: (addr array byte) <- lookup *f-name-ah + { + var is-add?/eax: boolean <- string-equal? f-name, "+" + compare is-add?, 0/false + break-if-= + apply-add args-ah, out, env-h, trace + return + } + abort "unknown primitive function" +} + +fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) { + trace-text trace, "eval", "apply +" + var args-ah/eax: (addr handle cell) <- copy _args-ah + var _args/eax: (addr cell) <- lookup *args-ah + var args/esi: (addr cell) <- copy _args + var _env/eax: (addr cell) <- lookup env-h + var env/edi: (addr cell) <- copy _env + # TODO: check that args is a pair + var empty-args?/eax: boolean <- nil? args + compare empty-args?, 0/false + { + break-if-= + error trace, "+ needs 2 args but got 0" + return + } + # args->left->value + var first-ah/eax: (addr handle cell) <- get args, left + var first/eax: (addr cell) <- lookup *first-ah + var first-type/ecx: (addr int) <- get first, type + compare *first-type, 1/number + { + break-if-= + error trace, "first arg for + is not a number" + return + } + var first-value/ecx: (addr float) <- get first, number-data + # args->right->left->value + var right-ah/eax: (addr handle cell) <- get args, right +#? dump-cell right-ah +#? abort "aaa" + var right/eax: (addr cell) <- lookup *right-ah + # TODO: check that right is a pair + var second-ah/eax: (addr handle cell) <- get right, left + var second/eax: (addr cell) <- lookup *second-ah + var second-type/edx: (addr int) <- get second, type + compare *second-type, 1/number + { + break-if-= + error trace, "second arg for + is not a number" + return + } + var second-value/edx: (addr float) <- get second, number-data + # add + var result/xmm0: float <- copy *first-value + result <- add *second-value + new-float out, result +} + diff --git a/shell/main.mu b/shell/main.mu index 62298a18..29c815dc 100644 --- a/shell/main.mu +++ b/shell/main.mu @@ -2,6 +2,9 @@ # A Lisp with indent-sensitivity and infix, no macros. fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) { + var globals-storage: global-table + var globals/edi: (addr global-table) <- address globals-storage + initialize-globals globals var sandbox-storage: sandbox var sandbox/esi: (addr sandbox) <- address sandbox-storage initialize-sandbox sandbox @@ -16,7 +19,7 @@ fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) compare key, 0 loop-if-= # no way to quit right now; just reboot - edit-sandbox sandbox, key, screen, keyboard, data-disk + edit-sandbox sandbox, key, globals, screen, keyboard, data-disk } loop } @@ -36,7 +39,7 @@ fn load-sandbox data-disk: (addr disk), _self: (addr sandbox) { var key/eax: byte <- read-byte s compare key, 0/null break-if-= - edit-sandbox self, key, 0/no-screen, 0/no-keyboard, 0/no-disk + edit-sandbox self, key, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk loop } } diff --git a/shell/sandbox.mu b/shell/sandbox.mu index dec1cc94..255098da 100644 --- a/shell/sandbox.mu +++ b/shell/sandbox.mu @@ -100,7 +100,7 @@ fn render-sandbox-menu screen: (addr screen) { draw-text-rightward-from-cursor screen, " move to trace ", width, 7/fg, 0/bg } -fn edit-sandbox _self: (addr sandbox), key: byte, real-screen: (addr screen), real-keyboard: (addr keyboard), data-disk: (addr disk) { +fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table), real-screen: (addr screen), real-keyboard: (addr keyboard), data-disk: (addr disk) { var self/esi: (addr sandbox) <- copy _self var g/edx: grapheme <- copy key # ctrl-r @@ -135,7 +135,7 @@ fn edit-sandbox _self: (addr sandbox), key: byte, real-screen: (addr screen), re var trace-ah/eax: (addr handle trace) <- get self, trace var trace/eax: (addr trace) <- lookup *trace-ah clear-trace trace - run data, value, trace + run data, value, globals, trace return } # tab @@ -170,7 +170,7 @@ fn edit-sandbox _self: (addr sandbox), key: byte, real-screen: (addr screen), re return } -fn run in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { +fn run in: (addr gap-buffer), out: (addr stream byte), globals: (addr global-table), trace: (addr trace) { var read-result-storage: (handle cell) var read-result/esi: (addr handle cell) <- address read-result-storage read-cell in, read-result, trace @@ -185,7 +185,7 @@ fn run in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { 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, trace + evaluate read-result, eval-result, *nil-ah, globals, trace var error?/eax: boolean <- has-errors? trace { compare error?, 0/false @@ -202,9 +202,9 @@ fn test-run-integer { var sandbox/esi: (addr sandbox) <- address sandbox-storage initialize-sandbox sandbox # type "1" - edit-sandbox sandbox, 0x31/1, 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 # eval - edit-sandbox sandbox, 0x13/ctrl-s, 0/no-screen, 0/no-keyboard, 0/no-disk + edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk # setup: screen var screen-on-stack: screen var screen/edi: (addr screen) <- address screen-on-stack @@ -221,12 +221,12 @@ fn test-run-with-spaces { var sandbox/esi: (addr sandbox) <- address sandbox-storage initialize-sandbox sandbox # type input with whitespace before and after - edit-sandbox sandbox, 0x20/space, 0/no-screen, 0/no-keyboard, 0/no-disk - edit-sandbox sandbox, 0x31/1, 0/no-screen, 0/no-keyboard, 0/no-disk - edit-sandbox sandbox, 0x20/space, 0/no-screen, 0/no-keyboard, 0/no-disk - edit-sandbox sandbox, 0xa/newline, 0/no-screen, 0/no-keyboard, 0/no-disk + 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 + edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk + edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk # eval - edit-sandbox sandbox, 0x13/ctrl-s, 0/no-screen, 0/no-keyboard, 0/no-disk + edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk # setup: screen var screen-on-stack: screen var screen/edi: (addr screen) <- address screen-on-stack @@ -244,10 +244,10 @@ fn test-run-error-invalid-integer { var sandbox/esi: (addr sandbox) <- address sandbox-storage initialize-sandbox sandbox # type "1a" - edit-sandbox sandbox, 0x31/1, 0/no-screen, 0/no-keyboard, 0/no-disk - edit-sandbox sandbox, 0x61/a, 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 + edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk # eval - edit-sandbox sandbox, 0x13/ctrl-s, 0/no-screen, 0/no-keyboard, 0/no-disk + edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk # setup: screen var screen-on-stack: screen var screen/edi: (addr screen) <- address screen-on-stack @@ -264,10 +264,10 @@ fn test-run-move-cursor-into-trace { var sandbox/esi: (addr sandbox) <- address sandbox-storage initialize-sandbox sandbox # type "12" - edit-sandbox sandbox, 0x31/1, 0/no-screen, 0/no-keyboard, 0/no-disk - edit-sandbox sandbox, 0x32/2, 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 + edit-sandbox sandbox, 0x32/2, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk # eval - edit-sandbox sandbox, 0x13/ctrl-s, 0/no-screen, 0/no-keyboard, 0/no-disk + edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk # setup: screen var screen-on-stack: screen var screen/edi: (addr screen) <- address screen-on-stack @@ -281,7 +281,7 @@ fn test-run-move-cursor-into-trace { check-screen-row screen, 2/y, "=> 12 ", "F - test-run-move-cursor-into-trace/pre-2" check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-move-cursor-into-trace/pre-2/cursor" # move cursor into trace - edit-sandbox sandbox, 9/tab, 0/no-screen, 0/no-keyboard, 0/no-disk + edit-sandbox sandbox, 9/tab, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk # render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height check-screen-row screen, 0/y, "12 ", "F - test-run-move-cursor-into-trace/trace-0" @@ -291,7 +291,7 @@ fn test-run-move-cursor-into-trace { check-screen-row screen, 2/y, "=> 12 ", "F - test-run-move-cursor-into-trace/trace-2" check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " ", "F - test-run-move-cursor-into-trace/trace-2/cursor" # move cursor into input - edit-sandbox sandbox, 9/tab, 0/no-screen, 0/no-keyboard, 0/no-disk + edit-sandbox sandbox, 9/tab, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk # render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height check-screen-row screen, 0/y, "12 ", "F - test-run-move-cursor-into-trace/input-0" |