diff options
author | Kartik K. Agaram <vc@akkartik.com> | 2021-04-16 20:40:02 -0700 |
---|---|---|
committer | Kartik K. Agaram <vc@akkartik.com> | 2021-04-16 20:40:02 -0700 |
commit | 33f5eb632ae68a5ae88c599b13969275315c1be7 (patch) | |
tree | db8cacf140446d44ae2043d7b0479d5e438e66ea | |
parent | f774677854ca2f0affcccb362fb2c6b1c407df44 (diff) | |
download | mu-33f5eb632ae68a5ae88c599b13969275315c1be7.tar.gz |
new primitives: abs, sgn
-rw-r--r-- | shell/global.mu | 101 |
1 files changed, 100 insertions, 1 deletions
diff --git a/shell/global.mu b/shell/global.mu index 46c43234..f6f24003 100644 --- a/shell/global.mu +++ b/shell/global.mu @@ -20,6 +20,8 @@ fn initialize-globals _self: (addr global-table) { append-primitive self, "*" append-primitive self, "/" append-primitive self, "sqrt" + append-primitive self, "abs" + append-primitive self, "sgn" append-primitive self, "<" append-primitive self, ">" append-primitive self, "<=" @@ -213,7 +215,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, 7/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 abs sgn = < > <= >= ", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black tmpx <- draw-text-rightward screen, "pairs: ", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black tmpx <- draw-text-rightward screen, "car cdr cons", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black } @@ -411,6 +413,20 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand return } { + var is-abs?/eax: boolean <- string-equal? f-name, "abs" + compare is-abs?, 0/false + break-if-= + apply-abs args-ah, out, trace + return + } + { + var is-sgn?/eax: boolean <- string-equal? f-name, "sgn" + compare is-sgn?, 0/false + break-if-= + apply-sgn args-ah, out, trace + return + } + { var is-car?/eax: boolean <- string-equal? f-name, "car" compare is-car?, 0/false break-if-= @@ -781,6 +797,89 @@ fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trac new-float out, result } +fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + trace-text trace, "eval", "apply abs" + 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, "abs needs 1 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, "arg for abs is not a number" + return + } + var first-value/ecx: (addr float) <- get first, number-data + # + var result/xmm0: float <- copy *first-value + var zero: float + compare result, zero + { + break-if-float>= + var neg1/eax: int <- copy -1 + var neg1-f/xmm1: float <- convert neg1 + result <- multiply neg1-f + } + new-float out, result +} + +fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + trace-text trace, "eval", "apply sgn" + 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, "sgn needs 1 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, "arg for sgn is not a number" + return + } + var first-value/ecx: (addr float) <- get first, number-data + # + var result/xmm0: float <- copy *first-value + var zero: float + $apply-sgn:core: { + compare result, zero + break-if-= + { + break-if-float> + var neg1/eax: int <- copy -1 + result <- convert neg1 + break $apply-sgn:core + } + { + break-if-float< + var one/eax: int <- copy 1 + result <- convert one + break $apply-sgn:core + } + } + new-float out, result +} + fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { trace-text trace, "eval", "apply car" var args-ah/eax: (addr handle cell) <- copy _args-ah |