diff options
Diffstat (limited to 'shell/global.mu')
| -rw-r--r-- | shell/global.mu | 449 |
1 files changed, 439 insertions, 10 deletions
diff --git a/shell/global.mu b/shell/global.mu index bd55e001..3acdde1f 100644 --- a/shell/global.mu +++ b/shell/global.mu @@ -11,7 +11,7 @@ type global-table { 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 + populate data-ah, 0x40 # generic append-primitive self, "=" # for numbers @@ -20,13 +20,21 @@ fn initialize-globals _self: (addr global-table) { append-primitive self, "*" append-primitive self, "/" append-primitive self, "sqrt" + append-primitive self, "<" + append-primitive self, ">" + append-primitive self, "<=" + append-primitive self, ">=" # for pairs append-primitive self, "car" append-primitive self, "cdr" append-primitive self, "cons" # for screens append-primitive self, "print" - append-primitive self, "pixel" + append-primitive self, "up" + append-primitive self, "down" + append-primitive self, "left" + append-primitive self, "right" + append-primitive self, "cr" # for keyboards append-primitive self, "key" # for streams @@ -84,7 +92,7 @@ fn render-globals screen: (addr screen), _self: (addr global-table), xmin: int, fn render-primitives screen: (addr screen), xmin: int, ymin: int, xmax: int, ymax: int { var y/ecx: int <- copy ymax - y <- subtract 0xa + y <- subtract 0xc var tmpx/eax: int <- copy xmin tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, xmax, y, 0x7/fg=grey, 0x12/bg=almost-black y <- increment @@ -93,6 +101,14 @@ fn render-primitives screen: (addr screen), xmin: int, ymin: int, xmax: int, yma tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, xmax, y, 0x7/fg=grey, 0x12/bg=almost-black y <- increment var tmpx/eax: int <- copy xmin + tmpx <- draw-text-rightward screen, " up down left right", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black + tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 0x7/fg=grey, 0x12/bg=almost-black + y <- increment + var tmpx/eax: int <- copy xmin + tmpx <- draw-text-rightward screen, " cr", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black + tmpx <- draw-text-rightward screen, ": screen # move cursor down and to left margin", tmpx, xmax, y, 0x7/fg=grey, 0x12/bg=almost-black + y <- increment + var tmpx/eax: int <- copy xmin tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, xmax, y, 0x7/fg=grey, 0x12/bg=almost-black y <- increment var tmpx/eax: int <- copy xmin @@ -119,7 +135,7 @@ fn render-primitives screen: (addr screen), xmin: int, ymin: int, xmax: int, yma y <- increment var tmpx/eax: int <- copy xmin tmpx <- draw-text-rightward screen, "numbers: ", tmpx, xmax, y, 0x7/fg=grey, 0x12/bg=almost-black - tmpx <- draw-text-rightward screen, "+ - * / sqrt ", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black + tmpx <- draw-text-rightward screen, "+ - * / sqrt = < > <= >= ", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black tmpx <- draw-text-rightward screen, "pairs: ", tmpx, xmax, y, 0x7/fg=grey, 0x12/bg=almost-black tmpx <- draw-text-rightward screen, "car cdr cons", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black } @@ -322,10 +338,38 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand return } { - var is-compare?/eax: boolean <- string-equal? f-name, "=" - compare is-compare?, 0/false + var is-structurally-equal?/eax: boolean <- string-equal? f-name, "=" + compare is-structurally-equal?, 0/false break-if-= - apply-compare args-ah, out, trace + apply-structurally-equal args-ah, out, trace + return + } + { + var is-lesser?/eax: boolean <- string-equal? f-name, "<" + compare is-lesser?, 0/false + break-if-= + apply-< args-ah, out, trace + return + } + { + var is-greater?/eax: boolean <- string-equal? f-name, ">" + compare is-greater?, 0/false + break-if-= + apply-> args-ah, out, trace + return + } + { + var is-lesser-or-equal?/eax: boolean <- string-equal? f-name, "<=" + compare is-lesser-or-equal?, 0/false + break-if-= + apply-<= args-ah, out, trace + return + } + { + var is-greater-or-equal?/eax: boolean <- string-equal? f-name, ">=" + compare is-greater-or-equal?, 0/false + break-if-= + apply->= args-ah, out, trace return } { @@ -336,6 +380,41 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand return } { + var is-up?/eax: boolean <- string-equal? f-name, "up" + compare is-up?, 0/false + break-if-= + apply-up args-ah, out, trace + return + } + { + var is-down?/eax: boolean <- string-equal? f-name, "down" + compare is-down?, 0/false + break-if-= + apply-down args-ah, out, trace + return + } + { + var is-left?/eax: boolean <- string-equal? f-name, "left" + compare is-left?, 0/false + break-if-= + apply-left args-ah, out, trace + return + } + { + var is-right?/eax: boolean <- string-equal? f-name, "right" + compare is-right?, 0/false + break-if-= + apply-right args-ah, out, trace + return + } + { + var is-cr?/eax: boolean <- string-equal? f-name, "cr" + compare is-cr?, 0/false + break-if-= + apply-cr args-ah, out, trace + return + } + { var is-pixel?/eax: boolean <- string-equal? f-name, "pixel" compare is-pixel?, 0/false break-if-= @@ -653,8 +732,8 @@ fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (add new-pair out, *first-ah, *second-ah } -fn apply-compare _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - trace-text trace, "eval", "apply =" +fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr 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 @@ -663,7 +742,7 @@ fn apply-compare _args-ah: (addr handle cell), out: (addr handle cell), trace: ( compare empty-args?, 0/false { break-if-= - error trace, "cons needs 2 args but got 0" + error trace, "'=' needs 2 args but got 0" return } # args->left @@ -687,6 +766,206 @@ fn apply-compare _args-ah: (addr handle cell), out: (addr handle cell), trace: ( new-integer out, 1/true } +fn apply-< _args-ah: (addr handle cell), out: (addr 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 + # 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 + var first-ah/ecx: (addr handle cell) <- get args, left + # args->right->left + var right-ah/eax: (addr handle cell) <- get args, right + var right/eax: (addr cell) <- lookup *right-ah + # TODO: check that right is a pair + var second-ah/edx: (addr handle cell) <- get right, left + # compare + var _first/eax: (addr cell) <- lookup *first-ah + var first/ecx: (addr cell) <- copy _first + var first-type/eax: (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 + var first-float/xmm0: float <- copy *first-value + 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, "first arg for '<' is not a number" + return + } + var second-value/eax: (addr float) <- get second, number-data + compare first-float, *second-value + { + break-if-float< + nil out + return + } + new-integer out, 1/true +} + +fn apply-> _args-ah: (addr handle cell), out: (addr 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 + # 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 + var first-ah/ecx: (addr handle cell) <- get args, left + # args->right->left + var right-ah/eax: (addr handle cell) <- get args, right + var right/eax: (addr cell) <- lookup *right-ah + # TODO: check that right is a pair + var second-ah/edx: (addr handle cell) <- get right, left + # compare + var _first/eax: (addr cell) <- lookup *first-ah + var first/ecx: (addr cell) <- copy _first + var first-type/eax: (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 + var first-float/xmm0: float <- copy *first-value + 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, "first arg for '>' is not a number" + return + } + var second-value/eax: (addr float) <- get second, number-data + compare first-float, *second-value + { + break-if-float> + nil out + return + } + new-integer out, 1/true +} + +fn apply-<= _args-ah: (addr handle cell), out: (addr 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 + # 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 + var first-ah/ecx: (addr handle cell) <- get args, left + # args->right->left + var right-ah/eax: (addr handle cell) <- get args, right + var right/eax: (addr cell) <- lookup *right-ah + # TODO: check that right is a pair + var second-ah/edx: (addr handle cell) <- get right, left + # compare + var _first/eax: (addr cell) <- lookup *first-ah + var first/ecx: (addr cell) <- copy _first + var first-type/eax: (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 + var first-float/xmm0: float <- copy *first-value + 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, "first arg for '<=' is not a number" + return + } + var second-value/eax: (addr float) <- get second, number-data + compare first-float, *second-value + { + break-if-float<= + nil out + return + } + new-integer out, 1/true +} + +fn apply->= _args-ah: (addr handle cell), out: (addr 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 + # 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 + var first-ah/ecx: (addr handle cell) <- get args, left + # args->right->left + var right-ah/eax: (addr handle cell) <- get args, right + var right/eax: (addr cell) <- lookup *right-ah + # TODO: check that right is a pair + var second-ah/edx: (addr handle cell) <- get right, left + # compare + var _first/eax: (addr cell) <- lookup *first-ah + var first/ecx: (addr cell) <- copy _first + var first-type/eax: (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 + var first-float/xmm0: float <- copy *first-value + 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, "first arg for '>=' is not a number" + return + } + var second-value/eax: (addr float) <- get second, number-data + compare first-float, *second-value + { + break-if-float>= + nil out + return + } + new-integer out, 1/true +} + fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { trace-text trace, "eval", "apply print" var args-ah/eax: (addr handle cell) <- copy _args-ah @@ -726,6 +1005,156 @@ fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (ad copy-object second-ah, out } +fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + trace-text trace, "eval", "apply up" + 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 + # TODO: check that args is a pair + var empty-args?/eax: boolean <- nil? args + compare empty-args?, 0/false + { + break-if-= + error trace, "'up' needs 1 arg but got 0" + return + } + # screen = args->left + 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, 5/screen + { + break-if-= + error trace, "first arg for 'up' is not a screen" + return + } + var screen-ah/eax: (addr handle screen) <- get first, screen-data + var _screen/eax: (addr screen) <- lookup *screen-ah + var screen/ecx: (addr screen) <- copy _screen + # + move-cursor-up screen +} + +fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + trace-text trace, "eval", "apply 'down'" + 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 + # TODO: check that args is a pair + var empty-args?/eax: boolean <- nil? args + compare empty-args?, 0/false + { + break-if-= + error trace, "'down' needs 1 arg but got 0" + return + } + # screen = args->left + 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, 5/screen + { + break-if-= + error trace, "first arg for 'down' is not a screen" + return + } + var screen-ah/eax: (addr handle screen) <- get first, screen-data + var _screen/eax: (addr screen) <- lookup *screen-ah + var screen/ecx: (addr screen) <- copy _screen + # + move-cursor-down screen +} + +fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + trace-text trace, "eval", "apply 'left'" + 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 + # TODO: check that args is a pair + var empty-args?/eax: boolean <- nil? args + compare empty-args?, 0/false + { + break-if-= + error trace, "'left' needs 1 arg but got 0" + return + } + # screen = args->left + 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, 5/screen + { + break-if-= + error trace, "first arg for 'left' is not a screen" + return + } + var screen-ah/eax: (addr handle screen) <- get first, screen-data + var _screen/eax: (addr screen) <- lookup *screen-ah + var screen/ecx: (addr screen) <- copy _screen + # + move-cursor-left screen +} + +fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + trace-text trace, "eval", "apply 'right'" + 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 + # TODO: check that args is a pair + var empty-args?/eax: boolean <- nil? args + compare empty-args?, 0/false + { + break-if-= + error trace, "'right' needs 1 arg but got 0" + return + } + # screen = args->left + 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, 5/screen + { + break-if-= + error trace, "first arg for 'right' is not a screen" + return + } + var screen-ah/eax: (addr handle screen) <- get first, screen-data + var _screen/eax: (addr screen) <- lookup *screen-ah + var screen/ecx: (addr screen) <- copy _screen + # + move-cursor-right screen +} + +fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + trace-text trace, "eval", "apply 'cr'" + 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 + # TODO: check that args is a pair + var empty-args?/eax: boolean <- nil? args + compare empty-args?, 0/false + { + break-if-= + error trace, "'cr' needs 1 arg but got 0" + return + } + # screen = args->left + 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, 5/screen + { + break-if-= + error trace, "first arg for 'cr' is not a screen" + return + } + var screen-ah/eax: (addr handle screen) <- get first, screen-data + var _screen/eax: (addr screen) <- lookup *screen-ah + var screen/ecx: (addr screen) <- copy _screen + # + move-cursor-to-left-margin-of-next-line screen +} + fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { trace-text trace, "eval", "apply pixel" var args-ah/eax: (addr handle cell) <- copy _args-ah |