From dd60caa3f51c5117c0193f8f3272e1c7f5230eb7 Mon Sep 17 00:00:00 2001 From: Kartik Agaram Date: Tue, 15 Jun 2021 21:50:13 -0700 Subject: . --- html/shell/primitives.mu.html | 3412 +++++++++++++++++++++++------------------ 1 file changed, 1960 insertions(+), 1452 deletions(-) (limited to 'html/shell/primitives.mu.html') diff --git a/html/shell/primitives.mu.html b/html/shell/primitives.mu.html index b050cfba..851a30c5 100644 --- a/html/shell/primitives.mu.html +++ b/html/shell/primitives.mu.html @@ -16,18 +16,19 @@ a { color:inherit; } * { font-size:12pt; font-size: 1em; } .LineNr { } .Delimiter { color: #c000c0; } -.muFunction { color: #af5f00; text-decoration: underline; } +.CommentedCode { color: #8a8a8a; } +.muRegEdx { color: #878700; } .muRegEbx { color: #8787af; } .muRegEsi { color: #87d787; } .muRegEdi { color: #87ffd7; } .Constant { color: #008787; } .Special { color: #ff6060; } .PreProc { color: #c000c0; } -.CommentedCode { color: #8a8a8a; } +.muFunction { color: #af5f00; text-decoration: underline; } +.muTest { color: #5f8700; } .muComment { color: #005faf; } .muRegEax { color: #875f00; } .muRegEcx { color: #af875f; } -.muRegEdx { color: #878700; } --> @@ -66,1603 +67,2110 @@ if ('onhashchange' in window) { 1 fn initialize-primitives _self: (addr global-table) { 2 var self/esi: (addr global-table) <- copy _self 3 # for numbers - 4 append-primitive self, "+" - 5 append-primitive self, "-" - 6 append-primitive self, "*" - 7 append-primitive self, "/" - 8 append-primitive self, "sqrt" - 9 append-primitive self, "abs" - 10 append-primitive self, "sgn" - 11 append-primitive self, "<" - 12 append-primitive self, ">" - 13 append-primitive self, "<=" - 14 append-primitive self, ">=" - 15 # generic - 16 append-primitive self, "=" - 17 append-primitive self, "no" - 18 append-primitive self, "not" - 19 append-primitive self, "dbg" - 20 # for pairs - 21 append-primitive self, "car" - 22 append-primitive self, "cdr" - 23 append-primitive self, "cons" - 24 # for screens - 25 append-primitive self, "print" - 26 append-primitive self, "clear" - 27 append-primitive self, "lines" - 28 append-primitive self, "columns" - 29 append-primitive self, "up" - 30 append-primitive self, "down" - 31 append-primitive self, "left" - 32 append-primitive self, "right" - 33 append-primitive self, "cr" - 34 append-primitive self, "pixel" - 35 append-primitive self, "width" - 36 append-primitive self, "height" - 37 # for keyboards - 38 append-primitive self, "key" - 39 # for streams - 40 append-primitive self, "stream" - 41 append-primitive self, "write" - 42 # misc - 43 append-primitive self, "abort" - 44 # keep sync'd with render-primitives - 45 } - 46 - 47 fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int { - 48 var y/ecx: int <- copy ymax - 49 y <- subtract 0x10 - 50 clear-rect screen, xmin, y, xmax, ymax, 0xdc/bg=green-bg - 51 y <- increment - 52 var tmpx/eax: int <- copy xmin - 53 tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 54 y <- increment - 55 var tmpx/eax: int <- copy xmin - 56 tmpx <- draw-text-rightward screen, " print", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg - 57 tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 58 y <- increment - 59 var tmpx/eax: int <- copy xmin - 60 tmpx <- draw-text-rightward screen, " lines columns", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg - 61 tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 62 y <- increment - 63 var tmpx/eax: int <- copy xmin - 64 tmpx <- draw-text-rightward screen, " up down left right", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg - 65 tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 66 y <- increment - 67 var tmpx/eax: int <- copy xmin - 68 tmpx <- draw-text-rightward screen, " cr", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg - 69 tmpx <- draw-text-rightward screen, ": screen ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 70 tmpx <- draw-text-rightward screen, "# move cursor down and to left margin", tmpx, xmax, y, 0x38/fg=trace, 0xdc/bg=green-bg - 71 y <- increment - 72 var tmpx/eax: int <- copy xmin - 73 tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 74 y <- increment - 75 var tmpx/eax: int <- copy xmin - 76 tmpx <- draw-text-rightward screen, " width height", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg - 77 tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 78 y <- increment - 79 var tmpx/eax: int <- copy xmin - 80 tmpx <- draw-text-rightward screen, " pixel", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg - 81 tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 82 y <- increment - 83 var tmpx/eax: int <- copy xmin - 84 tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 85 y <- increment - 86 var tmpx/eax: int <- copy xmin - 87 tmpx <- draw-text-rightward screen, " clear", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg - 88 tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 89 y <- increment - 90 var tmpx/eax: int <- copy xmin - 91 tmpx <- draw-text-rightward screen, " key", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg - 92 tmpx <- draw-text-rightward screen, ": () -> grapheme?", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 93 y <- increment - 94 var tmpx/eax: int <- copy xmin - 95 tmpx <- draw-text-rightward screen, "streams", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 96 y <- increment - 97 var tmpx/eax: int <- copy xmin - 98 tmpx <- draw-text-rightward screen, " stream", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg - 99 tmpx <- draw-text-rightward screen, ": () -> stream ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 100 y <- increment - 101 var tmpx/eax: int <- copy xmin - 102 tmpx <- draw-text-rightward screen, " write", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg - 103 tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 104 y <- increment - 105 var tmpx/eax: int <- copy xmin - 106 tmpx <- draw-text-rightward screen, "fn def set if while = no(t) car cdr cons ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg - 107 tmpx <- draw-text-rightward screen, "num: ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg - 108 tmpx <- draw-text-rightward screen, "+ - * / sqrt abs sgn < > <= >= ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg - 109 } - 110 - 111 fn primitive-global? _x: (addr global) -> _/eax: boolean { - 112 var x/eax: (addr global) <- copy _x - 113 var value-ah/eax: (addr handle cell) <- get x, value - 114 var value/eax: (addr cell) <- lookup *value-ah - 115 compare value, 0/null - 116 { - 117 break-if-!= - 118 return 0/false - 119 } - 120 var value-type/eax: (addr int) <- get value, type - 121 compare *value-type, 4/primitive - 122 { - 123 break-if-= - 124 return 0/false - 125 } - 126 return 1/true - 127 } - 128 - 129 fn append-primitive _self: (addr global-table), name: (addr array byte) { - 130 var self/esi: (addr global-table) <- copy _self - 131 compare self, 0 - 132 { - 133 break-if-!= - 134 abort "append primitive" - 135 return - 136 } - 137 var final-index-addr/ecx: (addr int) <- get self, final-index - 138 increment *final-index-addr - 139 var curr-index/ecx: int <- copy *final-index-addr - 140 var data-ah/eax: (addr handle array global) <- get self, data - 141 var data/eax: (addr array global) <- lookup *data-ah - 142 var curr-offset/esi: (offset global) <- compute-offset data, curr-index - 143 var curr/esi: (addr global) <- index data, curr-offset - 144 var curr-name-ah/eax: (addr handle array byte) <- get curr, name - 145 copy-array-object name, curr-name-ah - 146 var curr-value-ah/eax: (addr handle cell) <- get curr, value - 147 new-primitive-function curr-value-ah, curr-index - 148 } - 149 - 150 # a little strange; goes from value to name and selects primitive based on name - 151 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) { - 152 var f/esi: (addr cell) <- copy _f - 153 var f-index-a/ecx: (addr int) <- get f, index-data - 154 var f-index/ecx: int <- copy *f-index-a - 155 var globals/eax: (addr global-table) <- copy _globals - 156 compare globals, 0 - 157 { - 158 break-if-!= - 159 abort "apply primitive" - 160 return - 161 } - 162 var global-data-ah/eax: (addr handle array global) <- get globals, data - 163 var global-data/eax: (addr array global) <- lookup *global-data-ah - 164 var f-offset/ecx: (offset global) <- compute-offset global-data, f-index - 165 var f-value/ecx: (addr global) <- index global-data, f-offset - 166 var f-name-ah/ecx: (addr handle array byte) <- get f-value, name - 167 var f-name/eax: (addr array byte) <- lookup *f-name-ah - 168 { - 169 var add?/eax: boolean <- string-equal? f-name, "+" - 170 compare add?, 0/false - 171 break-if-= - 172 apply-add args-ah, out, trace - 173 return - 174 } - 175 { - 176 var subtract?/eax: boolean <- string-equal? f-name, "-" - 177 compare subtract?, 0/false - 178 break-if-= - 179 apply-subtract args-ah, out, trace - 180 return - 181 } - 182 { - 183 var multiply?/eax: boolean <- string-equal? f-name, "*" - 184 compare multiply?, 0/false - 185 break-if-= - 186 apply-multiply args-ah, out, trace - 187 return - 188 } - 189 { - 190 var divide?/eax: boolean <- string-equal? f-name, "/" - 191 compare divide?, 0/false - 192 break-if-= - 193 apply-divide args-ah, out, trace - 194 return - 195 } - 196 { - 197 var square-root?/eax: boolean <- string-equal? f-name, "sqrt" - 198 compare square-root?, 0/false - 199 break-if-= - 200 apply-square-root args-ah, out, trace - 201 return - 202 } + 4 append-primitive self, "+" + 5 append-primitive self, "-" + 6 append-primitive self, "*" + 7 append-primitive self, "/" + 8 append-primitive self, "%" + 9 append-primitive self, "sqrt" + 10 append-primitive self, "abs" + 11 append-primitive self, "sgn" + 12 append-primitive self, "<" + 13 append-primitive self, ">" + 14 append-primitive self, "<=" + 15 append-primitive self, ">=" + 16 # generic + 17 append-primitive self, "=" + 18 append-primitive self, "no" + 19 append-primitive self, "not" + 20 append-primitive self, "dbg" + 21 # for pairs + 22 append-primitive self, "car" + 23 append-primitive self, "cdr" + 24 append-primitive self, "cons" + 25 # for screens + 26 append-primitive self, "print" + 27 append-primitive self, "clear" + 28 append-primitive self, "lines" + 29 append-primitive self, "columns" + 30 append-primitive self, "up" + 31 append-primitive self, "down" + 32 append-primitive self, "left" + 33 append-primitive self, "right" + 34 append-primitive self, "cr" + 35 append-primitive self, "pixel" + 36 append-primitive self, "width" + 37 append-primitive self, "height" + 38 # for keyboards + 39 append-primitive self, "key" + 40 # for streams + 41 append-primitive self, "stream" + 42 append-primitive self, "write" + 43 # misc + 44 append-primitive self, "abort" + 45 # keep sync'd with render-primitives + 46 } + 47 + 48 fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int { + 49 var y/ecx: int <- copy ymax + 50 y <- subtract 0x10 + 51 clear-rect screen, xmin, y, xmax, ymax, 0xdc/bg=green-bg + 52 y <- increment + 53 var tmpx/eax: int <- copy xmin + 54 tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 55 y <- increment + 56 var tmpx/eax: int <- copy xmin + 57 tmpx <- draw-text-rightward screen, " print", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + 58 tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 59 y <- increment + 60 var tmpx/eax: int <- copy xmin + 61 tmpx <- draw-text-rightward screen, " lines columns", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + 62 tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 63 y <- increment + 64 var tmpx/eax: int <- copy xmin + 65 tmpx <- draw-text-rightward screen, " up down left right", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + 66 tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 67 y <- increment + 68 var tmpx/eax: int <- copy xmin + 69 tmpx <- draw-text-rightward screen, " cr", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + 70 tmpx <- draw-text-rightward screen, ": screen ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 71 tmpx <- draw-text-rightward screen, "# move cursor down and to left margin", tmpx, xmax, y, 0x38/fg=trace, 0xdc/bg=green-bg + 72 y <- increment + 73 var tmpx/eax: int <- copy xmin + 74 tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 75 y <- increment + 76 var tmpx/eax: int <- copy xmin + 77 tmpx <- draw-text-rightward screen, " width height", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + 78 tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 79 y <- increment + 80 var tmpx/eax: int <- copy xmin + 81 tmpx <- draw-text-rightward screen, " pixel", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + 82 tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 83 y <- increment + 84 var tmpx/eax: int <- copy xmin + 85 tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 86 y <- increment + 87 var tmpx/eax: int <- copy xmin + 88 tmpx <- draw-text-rightward screen, " clear", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + 89 tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 90 y <- increment + 91 var tmpx/eax: int <- copy xmin + 92 tmpx <- draw-text-rightward screen, " key", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + 93 tmpx <- draw-text-rightward screen, ": () -> grapheme?", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 94 y <- increment + 95 var tmpx/eax: int <- copy xmin + 96 tmpx <- draw-text-rightward screen, "streams", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 97 y <- increment + 98 var tmpx/eax: int <- copy xmin + 99 tmpx <- draw-text-rightward screen, " stream", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + 100 tmpx <- draw-text-rightward screen, ": () -> stream ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 101 y <- increment + 102 var tmpx/eax: int <- copy xmin + 103 tmpx <- draw-text-rightward screen, " write", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + 104 tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + 105 y <- increment + 106 var tmpx/eax: int <- copy xmin + 107 tmpx <- draw-text-rightward screen, "fn set if while cons car cdr no not and or = ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + 108 # numbers + 109 tmpx <- draw-text-rightward screen, "< > <= >= + - * / % sqrt abs sgn", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + 110 } + 111 + 112 fn primitive-global? _x: (addr global) -> _/eax: boolean { + 113 var x/eax: (addr global) <- copy _x + 114 var value-ah/eax: (addr handle cell) <- get x, value + 115 var value/eax: (addr cell) <- lookup *value-ah + 116 compare value, 0/null + 117 { + 118 break-if-!= + 119 return 0/false + 120 } + 121 var value-type/eax: (addr int) <- get value, type + 122 compare *value-type, 4/primitive + 123 { + 124 break-if-= + 125 return 0/false + 126 } + 127 return 1/true + 128 } + 129 + 130 fn append-primitive _self: (addr global-table), name: (addr array byte) { + 131 var self/esi: (addr global-table) <- copy _self + 132 compare self, 0 + 133 { + 134 break-if-!= + 135 abort "append primitive" + 136 return + 137 } + 138 var final-index-addr/ecx: (addr int) <- get self, final-index + 139 increment *final-index-addr + 140 var curr-index/ecx: int <- copy *final-index-addr + 141 var data-ah/eax: (addr handle array global) <- get self, data + 142 var data/eax: (addr array global) <- lookup *data-ah + 143 var curr-offset/esi: (offset global) <- compute-offset data, curr-index + 144 var curr/esi: (addr global) <- index data, curr-offset + 145 var curr-name-ah/eax: (addr handle array byte) <- get curr, name + 146 copy-array-object name, curr-name-ah + 147 var curr-value-ah/eax: (addr handle cell) <- get curr, value + 148 new-primitive-function curr-value-ah, curr-index + 149 } + 150 + 151 # a little strange; goes from value to name and selects primitive based on name + 152 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) { + 153 var f/esi: (addr cell) <- copy _f + 154 var f-index-a/ecx: (addr int) <- get f, index-data + 155 var f-index/ecx: int <- copy *f-index-a + 156 var globals/eax: (addr global-table) <- copy _globals + 157 compare globals, 0 + 158 { + 159 break-if-!= + 160 abort "apply primitive" + 161 return + 162 } + 163 var global-data-ah/eax: (addr handle array global) <- get globals, data + 164 var global-data/eax: (addr array global) <- lookup *global-data-ah + 165 var f-offset/ecx: (offset global) <- compute-offset global-data, f-index + 166 var f-value/ecx: (addr global) <- index global-data, f-offset + 167 var f-name-ah/ecx: (addr handle array byte) <- get f-value, name + 168 var f-name/eax: (addr array byte) <- lookup *f-name-ah + 169 { + 170 var add?/eax: boolean <- string-equal? f-name, "+" + 171 compare add?, 0/false + 172 break-if-= + 173 apply-add args-ah, out, trace + 174 return + 175 } + 176 { + 177 var subtract?/eax: boolean <- string-equal? f-name, "-" + 178 compare subtract?, 0/false + 179 break-if-= + 180 apply-subtract args-ah, out, trace + 181 return + 182 } + 183 { + 184 var multiply?/eax: boolean <- string-equal? f-name, "*" + 185 compare multiply?, 0/false + 186 break-if-= + 187 apply-multiply args-ah, out, trace + 188 return + 189 } + 190 { + 191 var divide?/eax: boolean <- string-equal? f-name, "/" + 192 compare divide?, 0/false + 193 break-if-= + 194 apply-divide args-ah, out, trace + 195 return + 196 } + 197 # '%' is the remainder operator, because modulo isn't really meaningful for + 198 # non-integers + 199 # + 200 # I considered calling this operator 'rem', but I want to follow Arc in + 201 # using 'rem' for filtering out elements from lists. + 202 # https://arclanguage.github.io/ref/list.html#rem 203 { - 204 var abs?/eax: boolean <- string-equal? f-name, "abs" - 205 compare abs?, 0/false + 204 var remainder?/eax: boolean <- string-equal? f-name, "%" + 205 compare remainder?, 0/false 206 break-if-= - 207 apply-abs args-ah, out, trace + 207 apply-remainder args-ah, out, trace 208 return 209 } 210 { - 211 var sgn?/eax: boolean <- string-equal? f-name, "sgn" - 212 compare sgn?, 0/false + 211 var square-root?/eax: boolean <- string-equal? f-name, "sqrt" + 212 compare square-root?, 0/false 213 break-if-= - 214 apply-sgn args-ah, out, trace + 214 apply-square-root args-ah, out, trace 215 return 216 } 217 { - 218 var car?/eax: boolean <- string-equal? f-name, "car" - 219 compare car?, 0/false + 218 var abs?/eax: boolean <- string-equal? f-name, "abs" + 219 compare abs?, 0/false 220 break-if-= - 221 apply-car args-ah, out, trace + 221 apply-abs args-ah, out, trace 222 return 223 } 224 { - 225 var cdr?/eax: boolean <- string-equal? f-name, "cdr" - 226 compare cdr?, 0/false + 225 var sgn?/eax: boolean <- string-equal? f-name, "sgn" + 226 compare sgn?, 0/false 227 break-if-= - 228 apply-cdr args-ah, out, trace + 228 apply-sgn args-ah, out, trace 229 return 230 } 231 { - 232 var cons?/eax: boolean <- string-equal? f-name, "cons" - 233 compare cons?, 0/false + 232 var car?/eax: boolean <- string-equal? f-name, "car" + 233 compare car?, 0/false 234 break-if-= - 235 apply-cons args-ah, out, trace + 235 apply-car args-ah, out, trace 236 return 237 } 238 { - 239 var structurally-equal?/eax: boolean <- string-equal? f-name, "=" - 240 compare structurally-equal?, 0/false + 239 var cdr?/eax: boolean <- string-equal? f-name, "cdr" + 240 compare cdr?, 0/false 241 break-if-= - 242 apply-structurally-equal args-ah, out, trace + 242 apply-cdr args-ah, out, trace 243 return 244 } 245 { - 246 var not?/eax: boolean <- string-equal? f-name, "no" - 247 compare not?, 0/false + 246 var cons?/eax: boolean <- string-equal? f-name, "cons" + 247 compare cons?, 0/false 248 break-if-= - 249 apply-not args-ah, out, trace + 249 apply-cons args-ah, out, trace 250 return 251 } 252 { - 253 var not?/eax: boolean <- string-equal? f-name, "not" - 254 compare not?, 0/false + 253 var structurally-equal?/eax: boolean <- string-equal? f-name, "=" + 254 compare structurally-equal?, 0/false 255 break-if-= - 256 apply-not args-ah, out, trace + 256 apply-structurally-equal args-ah, out, trace 257 return 258 } 259 { - 260 var debug?/eax: boolean <- string-equal? f-name, "dbg" - 261 compare debug?, 0/false + 260 var not?/eax: boolean <- string-equal? f-name, "no" + 261 compare not?, 0/false 262 break-if-= - 263 apply-debug args-ah, out, trace + 263 apply-not args-ah, out, trace 264 return 265 } 266 { - 267 var lesser?/eax: boolean <- string-equal? f-name, "<" - 268 compare lesser?, 0/false + 267 var not?/eax: boolean <- string-equal? f-name, "not" + 268 compare not?, 0/false 269 break-if-= - 270 apply-< args-ah, out, trace + 270 apply-not args-ah, out, trace 271 return 272 } 273 { - 274 var greater?/eax: boolean <- string-equal? f-name, ">" - 275 compare greater?, 0/false + 274 var debug?/eax: boolean <- string-equal? f-name, "dbg" + 275 compare debug?, 0/false 276 break-if-= - 277 apply-> args-ah, out, trace + 277 apply-debug args-ah, out, trace 278 return 279 } 280 { - 281 var lesser-or-equal?/eax: boolean <- string-equal? f-name, "<=" - 282 compare lesser-or-equal?, 0/false + 281 var lesser?/eax: boolean <- string-equal? f-name, "<" + 282 compare lesser?, 0/false 283 break-if-= - 284 apply-<= args-ah, out, trace + 284 apply-< args-ah, out, trace 285 return 286 } 287 { - 288 var greater-or-equal?/eax: boolean <- string-equal? f-name, ">=" - 289 compare greater-or-equal?, 0/false + 288 var greater?/eax: boolean <- string-equal? f-name, ">" + 289 compare greater?, 0/false 290 break-if-= - 291 apply->= args-ah, out, trace + 291 apply-> args-ah, out, trace 292 return 293 } 294 { - 295 var print?/eax: boolean <- string-equal? f-name, "print" - 296 compare print?, 0/false + 295 var lesser-or-equal?/eax: boolean <- string-equal? f-name, "<=" + 296 compare lesser-or-equal?, 0/false 297 break-if-= - 298 apply-print args-ah, out, trace + 298 apply-<= args-ah, out, trace 299 return 300 } 301 { - 302 var clear?/eax: boolean <- string-equal? f-name, "clear" - 303 compare clear?, 0/false + 302 var greater-or-equal?/eax: boolean <- string-equal? f-name, ">=" + 303 compare greater-or-equal?, 0/false 304 break-if-= - 305 apply-clear args-ah, out, trace + 305 apply->= args-ah, out, trace 306 return 307 } 308 { - 309 var lines?/eax: boolean <- string-equal? f-name, "lines" - 310 compare lines?, 0/false + 309 var print?/eax: boolean <- string-equal? f-name, "print" + 310 compare print?, 0/false 311 break-if-= - 312 apply-lines args-ah, out, trace + 312 apply-print args-ah, out, trace 313 return 314 } 315 { - 316 var columns?/eax: boolean <- string-equal? f-name, "columns" - 317 compare columns?, 0/false + 316 var clear?/eax: boolean <- string-equal? f-name, "clear" + 317 compare clear?, 0/false 318 break-if-= - 319 apply-columns args-ah, out, trace + 319 apply-clear args-ah, out, trace 320 return 321 } 322 { - 323 var up?/eax: boolean <- string-equal? f-name, "up" - 324 compare up?, 0/false + 323 var lines?/eax: boolean <- string-equal? f-name, "lines" + 324 compare lines?, 0/false 325 break-if-= - 326 apply-up args-ah, out, trace + 326 apply-lines args-ah, out, trace 327 return 328 } 329 { - 330 var down?/eax: boolean <- string-equal? f-name, "down" - 331 compare down?, 0/false + 330 var columns?/eax: boolean <- string-equal? f-name, "columns" + 331 compare columns?, 0/false 332 break-if-= - 333 apply-down args-ah, out, trace + 333 apply-columns args-ah, out, trace 334 return 335 } 336 { - 337 var left?/eax: boolean <- string-equal? f-name, "left" - 338 compare left?, 0/false + 337 var up?/eax: boolean <- string-equal? f-name, "up" + 338 compare up?, 0/false 339 break-if-= - 340 apply-left args-ah, out, trace + 340 apply-up args-ah, out, trace 341 return 342 } 343 { - 344 var right?/eax: boolean <- string-equal? f-name, "right" - 345 compare right?, 0/false + 344 var down?/eax: boolean <- string-equal? f-name, "down" + 345 compare down?, 0/false 346 break-if-= - 347 apply-right args-ah, out, trace + 347 apply-down args-ah, out, trace 348 return 349 } 350 { - 351 var cr?/eax: boolean <- string-equal? f-name, "cr" - 352 compare cr?, 0/false + 351 var left?/eax: boolean <- string-equal? f-name, "left" + 352 compare left?, 0/false 353 break-if-= - 354 apply-cr args-ah, out, trace + 354 apply-left args-ah, out, trace 355 return 356 } 357 { - 358 var pixel?/eax: boolean <- string-equal? f-name, "pixel" - 359 compare pixel?, 0/false + 358 var right?/eax: boolean <- string-equal? f-name, "right" + 359 compare right?, 0/false 360 break-if-= - 361 apply-pixel args-ah, out, trace + 361 apply-right args-ah, out, trace 362 return 363 } 364 { - 365 var width?/eax: boolean <- string-equal? f-name, "width" - 366 compare width?, 0/false + 365 var cr?/eax: boolean <- string-equal? f-name, "cr" + 366 compare cr?, 0/false 367 break-if-= - 368 apply-width args-ah, out, trace + 368 apply-cr args-ah, out, trace 369 return 370 } 371 { - 372 var height?/eax: boolean <- string-equal? f-name, "height" - 373 compare height?, 0/false + 372 var pixel?/eax: boolean <- string-equal? f-name, "pixel" + 373 compare pixel?, 0/false 374 break-if-= - 375 apply-height args-ah, out, trace + 375 apply-pixel args-ah, out, trace 376 return 377 } 378 { - 379 var wait-for-key?/eax: boolean <- string-equal? f-name, "key" - 380 compare wait-for-key?, 0/false + 379 var width?/eax: boolean <- string-equal? f-name, "width" + 380 compare width?, 0/false 381 break-if-= - 382 apply-wait-for-key args-ah, out, trace + 382 apply-width args-ah, out, trace 383 return 384 } 385 { - 386 var stream?/eax: boolean <- string-equal? f-name, "stream" - 387 compare stream?, 0/false + 386 var height?/eax: boolean <- string-equal? f-name, "height" + 387 compare height?, 0/false 388 break-if-= - 389 apply-stream args-ah, out, trace + 389 apply-height args-ah, out, trace 390 return 391 } 392 { - 393 var write?/eax: boolean <- string-equal? f-name, "write" - 394 compare write?, 0/false + 393 var wait-for-key?/eax: boolean <- string-equal? f-name, "key" + 394 compare wait-for-key?, 0/false 395 break-if-= - 396 apply-write args-ah, out, trace + 396 apply-wait-for-key args-ah, out, trace 397 return 398 } 399 { - 400 var abort?/eax: boolean <- string-equal? f-name, "abort" - 401 compare abort?, 0/false + 400 var stream?/eax: boolean <- string-equal? f-name, "stream" + 401 compare stream?, 0/false 402 break-if-= - 403 apply-abort args-ah, out, trace + 403 apply-stream args-ah, out, trace 404 return 405 } - 406 abort "unknown primitive function" - 407 } - 408 - 409 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 410 trace-text trace, "eval", "apply +" - 411 var args-ah/eax: (addr handle cell) <- copy _args-ah - 412 var _args/eax: (addr cell) <- lookup *args-ah - 413 var args/esi: (addr cell) <- copy _args - 414 # TODO: check that args is a pair - 415 var empty-args?/eax: boolean <- nil? args - 416 compare empty-args?, 0/false - 417 { - 418 break-if-= - 419 error trace, "+ needs 2 args but got 0" - 420 return - 421 } - 422 # args->left->value - 423 var first-ah/eax: (addr handle cell) <- get args, left - 424 var first/eax: (addr cell) <- lookup *first-ah - 425 var first-type/ecx: (addr int) <- get first, type - 426 compare *first-type, 1/number - 427 { - 428 break-if-= - 429 error trace, "first arg for + is not a number" - 430 return - 431 } - 432 var first-value/ecx: (addr float) <- get first, number-data - 433 # args->right->left->value - 434 var right-ah/eax: (addr handle cell) <- get args, right - 435 #? dump-cell right-ah - 436 #? abort "aaa" - 437 var right/eax: (addr cell) <- lookup *right-ah - 438 # TODO: check that right is a pair - 439 var second-ah/eax: (addr handle cell) <- get right, left - 440 var second/eax: (addr cell) <- lookup *second-ah - 441 var second-type/edx: (addr int) <- get second, type - 442 compare *second-type, 1/number - 443 { - 444 break-if-= - 445 error trace, "second arg for + is not a number" - 446 return - 447 } - 448 var second-value/edx: (addr float) <- get second, number-data - 449 # add - 450 var result/xmm0: float <- copy *first-value - 451 result <- add *second-value - 452 new-float out, result - 453 } - 454 - 455 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 456 trace-text trace, "eval", "apply -" - 457 var args-ah/eax: (addr handle cell) <- copy _args-ah - 458 var _args/eax: (addr cell) <- lookup *args-ah - 459 var args/esi: (addr cell) <- copy _args - 460 # TODO: check that args is a pair - 461 var empty-args?/eax: boolean <- nil? args - 462 compare empty-args?, 0/false + 406 { + 407 var write?/eax: boolean <- string-equal? f-name, "write" + 408 compare write?, 0/false + 409 break-if-= + 410 apply-write args-ah, out, trace + 411 return + 412 } + 413 { + 414 var abort?/eax: boolean <- string-equal? f-name, "abort" + 415 compare abort?, 0/false + 416 break-if-= + 417 apply-abort args-ah, out, trace + 418 return + 419 } + 420 abort "unknown primitive function" + 421 } + 422 + 423 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + 424 trace-text trace, "eval", "apply +" + 425 var args-ah/eax: (addr handle cell) <- copy _args-ah + 426 var _args/eax: (addr cell) <- lookup *args-ah + 427 var args/esi: (addr cell) <- copy _args + 428 { + 429 var args-type/ecx: (addr int) <- get args, type + 430 compare *args-type, 0/pair + 431 break-if-= + 432 error trace, "args to + are not a list" + 433 return + 434 } + 435 var empty-args?/eax: boolean <- nil? args + 436 compare empty-args?, 0/false + 437 { + 438 break-if-= + 439 error trace, "+ needs 2 args but got 0" + 440 return + 441 } + 442 # args->left->value + 443 var first-ah/eax: (addr handle cell) <- get args, left + 444 var first/eax: (addr cell) <- lookup *first-ah + 445 var first-type/ecx: (addr int) <- get first, type + 446 compare *first-type, 1/number + 447 { + 448 break-if-= + 449 error trace, "first arg for + is not a number" + 450 return + 451 } + 452 var first-value/ecx: (addr float) <- get first, number-data + 453 # args->right->left->value + 454 var right-ah/eax: (addr handle cell) <- get args, right + 455 var right/eax: (addr cell) <- lookup *right-ah + 456 { + 457 var right-type/ecx: (addr int) <- get right, type + 458 compare *right-type, 0/pair + 459 break-if-= + 460 error trace, "+ encountered non-pair" + 461 return + 462 } 463 { - 464 break-if-= - 465 error trace, "- needs 2 args but got 0" - 466 return - 467 } - 468 # args->left->value - 469 var first-ah/eax: (addr handle cell) <- get args, left - 470 var first/eax: (addr cell) <- lookup *first-ah - 471 var first-type/ecx: (addr int) <- get first, type - 472 compare *first-type, 1/number - 473 { - 474 break-if-= - 475 error trace, "first arg for - is not a number" - 476 return - 477 } - 478 var first-value/ecx: (addr float) <- get first, number-data - 479 # args->right->left->value - 480 var right-ah/eax: (addr handle cell) <- get args, right - 481 var right/eax: (addr cell) <- lookup *right-ah - 482 # TODO: check that right is a pair - 483 var second-ah/eax: (addr handle cell) <- get right, left - 484 var second/eax: (addr cell) <- lookup *second-ah - 485 var second-type/edx: (addr int) <- get second, type - 486 compare *second-type, 1/number - 487 { - 488 break-if-= - 489 error trace, "second arg for - is not a number" - 490 return - 491 } - 492 var second-value/edx: (addr float) <- get second, number-data - 493 # subtract - 494 var result/xmm0: float <- copy *first-value - 495 result <- subtract *second-value - 496 new-float out, result - 497 } - 498 - 499 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 500 trace-text trace, "eval", "apply *" - 501 var args-ah/eax: (addr handle cell) <- copy _args-ah - 502 var _args/eax: (addr cell) <- lookup *args-ah - 503 var args/esi: (addr cell) <- copy _args - 504 # TODO: check that args is a pair - 505 var empty-args?/eax: boolean <- nil? args - 506 compare empty-args?, 0/false - 507 { - 508 break-if-= - 509 error trace, "* needs 2 args but got 0" - 510 return - 511 } - 512 # args->left->value - 513 var first-ah/eax: (addr handle cell) <- get args, left - 514 var first/eax: (addr cell) <- lookup *first-ah - 515 var first-type/ecx: (addr int) <- get first, type - 516 compare *first-type, 1/number - 517 { - 518 break-if-= - 519 error trace, "first arg for * is not a number" - 520 return - 521 } - 522 var first-value/ecx: (addr float) <- get first, number-data - 523 # args->right->left->value - 524 var right-ah/eax: (addr handle cell) <- get args, right - 525 var right/eax: (addr cell) <- lookup *right-ah - 526 # TODO: check that right is a pair - 527 var second-ah/eax: (addr handle cell) <- get right, left - 528 var second/eax: (addr cell) <- lookup *second-ah - 529 var second-type/edx: (addr int) <- get second, type - 530 compare *second-type, 1/number - 531 { - 532 break-if-= - 533 error trace, "second arg for * is not a number" - 534 return - 535 } - 536 var second-value/edx: (addr float) <- get second, number-data - 537 # multiply - 538 var result/xmm0: float <- copy *first-value - 539 result <- multiply *second-value - 540 new-float out, result - 541 } - 542 - 543 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 544 trace-text trace, "eval", "apply /" - 545 var args-ah/eax: (addr handle cell) <- copy _args-ah - 546 var _args/eax: (addr cell) <- lookup *args-ah - 547 var args/esi: (addr cell) <- copy _args - 548 # TODO: check that args is a pair - 549 var empty-args?/eax: boolean <- nil? args - 550 compare empty-args?, 0/false - 551 { - 552 break-if-= - 553 error trace, "/ needs 2 args but got 0" - 554 return - 555 } - 556 # args->left->value - 557 var first-ah/eax: (addr handle cell) <- get args, left - 558 var first/eax: (addr cell) <- lookup *first-ah - 559 var first-type/ecx: (addr int) <- get first, type - 560 compare *first-type, 1/number - 561 { - 562 break-if-= - 563 error trace, "first arg for / is not a number" - 564 return - 565 } - 566 var first-value/ecx: (addr float) <- get first, number-data - 567 # args->right->left->value - 568 var right-ah/eax: (addr handle cell) <- get args, right - 569 var right/eax: (addr cell) <- lookup *right-ah - 570 # TODO: check that right is a pair - 571 var second-ah/eax: (addr handle cell) <- get right, left - 572 var second/eax: (addr cell) <- lookup *second-ah - 573 var second-type/edx: (addr int) <- get second, type - 574 compare *second-type, 1/number - 575 { - 576 break-if-= - 577 error trace, "second arg for / is not a number" - 578 return - 579 } - 580 var second-value/edx: (addr float) <- get second, number-data - 581 # divide - 582 var result/xmm0: float <- copy *first-value - 583 result <- divide *second-value - 584 new-float out, result - 585 } - 586 - 587 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 588 trace-text trace, "eval", "apply sqrt" - 589 var args-ah/eax: (addr handle cell) <- copy _args-ah - 590 var _args/eax: (addr cell) <- lookup *args-ah - 591 var args/esi: (addr cell) <- copy _args - 592 # TODO: check that args is a pair - 593 var empty-args?/eax: boolean <- nil? args - 594 compare empty-args?, 0/false - 595 { - 596 break-if-= - 597 error trace, "sqrt needs 1 arg but got 0" - 598 return - 599 } - 600 # args->left->value - 601 var first-ah/eax: (addr handle cell) <- get args, left - 602 var first/eax: (addr cell) <- lookup *first-ah - 603 var first-type/ecx: (addr int) <- get first, type - 604 compare *first-type, 1/number - 605 { - 606 break-if-= - 607 error trace, "arg for sqrt is not a number" - 608 return - 609 } - 610 var first-value/ecx: (addr float) <- get first, number-data - 611 # square-root - 612 var result/xmm0: float <- square-root *first-value - 613 new-float out, result - 614 } - 615 - 616 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 617 trace-text trace, "eval", "apply abs" - 618 var args-ah/eax: (addr handle cell) <- copy _args-ah - 619 var _args/eax: (addr cell) <- lookup *args-ah - 620 var args/esi: (addr cell) <- copy _args - 621 # TODO: check that args is a pair - 622 var empty-args?/eax: boolean <- nil? args - 623 compare empty-args?, 0/false - 624 { - 625 break-if-= - 626 error trace, "abs needs 1 arg but got 0" - 627 return - 628 } - 629 # args->left->value - 630 var first-ah/eax: (addr handle cell) <- get args, left - 631 var first/eax: (addr cell) <- lookup *first-ah - 632 var first-type/ecx: (addr int) <- get first, type - 633 compare *first-type, 1/number - 634 { - 635 break-if-= - 636 error trace, "arg for abs is not a number" - 637 return - 638 } - 639 var first-value/ecx: (addr float) <- get first, number-data - 640 # - 641 var result/xmm0: float <- copy *first-value - 642 var zero: float - 643 compare result, zero - 644 { - 645 break-if-float>= - 646 var neg1/eax: int <- copy -1 - 647 var neg1-f/xmm1: float <- convert neg1 - 648 result <- multiply neg1-f - 649 } - 650 new-float out, result - 651 } - 652 - 653 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 654 trace-text trace, "eval", "apply sgn" - 655 var args-ah/eax: (addr handle cell) <- copy _args-ah - 656 var _args/eax: (addr cell) <- lookup *args-ah - 657 var args/esi: (addr cell) <- copy _args - 658 # TODO: check that args is a pair - 659 var empty-args?/eax: boolean <- nil? args - 660 compare empty-args?, 0/false - 661 { - 662 break-if-= - 663 error trace, "sgn needs 1 arg but got 0" - 664 return - 665 } - 666 # args->left->value - 667 var first-ah/eax: (addr handle cell) <- get args, left - 668 var first/eax: (addr cell) <- lookup *first-ah - 669 var first-type/ecx: (addr int) <- get first, type - 670 compare *first-type, 1/number - 671 { - 672 break-if-= - 673 error trace, "arg for sgn is not a number" - 674 return - 675 } - 676 var first-value/ecx: (addr float) <- get first, number-data - 677 # - 678 var result/xmm0: float <- copy *first-value - 679 var zero: float - 680 $apply-sgn:core: { - 681 compare result, zero - 682 break-if-= - 683 { - 684 break-if-float> - 685 var neg1/eax: int <- copy -1 - 686 result <- convert neg1 - 687 break $apply-sgn:core - 688 } - 689 { - 690 break-if-float< - 691 var one/eax: int <- copy 1 - 692 result <- convert one - 693 break $apply-sgn:core - 694 } - 695 } - 696 new-float out, result - 697 } - 698 - 699 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 700 trace-text trace, "eval", "apply car" - 701 var args-ah/eax: (addr handle cell) <- copy _args-ah - 702 var _args/eax: (addr cell) <- lookup *args-ah - 703 var args/esi: (addr cell) <- copy _args - 704 # TODO: check that args is a pair - 705 var empty-args?/eax: boolean <- nil? args - 706 compare empty-args?, 0/false - 707 { - 708 break-if-= - 709 error trace, "car needs 1 arg but got 0" - 710 return - 711 } - 712 # args->left - 713 var first-ah/eax: (addr handle cell) <- get args, left - 714 var first/eax: (addr cell) <- lookup *first-ah - 715 var first-type/ecx: (addr int) <- get first, type - 716 compare *first-type, 0/pair - 717 { - 718 break-if-= - 719 error trace, "arg for car is not a pair" - 720 return - 721 } - 722 # car - 723 var result/eax: (addr handle cell) <- get first, left - 724 copy-object result, out - 725 } - 726 - 727 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 728 trace-text trace, "eval", "apply cdr" - 729 var args-ah/eax: (addr handle cell) <- copy _args-ah - 730 var _args/eax: (addr cell) <- lookup *args-ah - 731 var args/esi: (addr cell) <- copy _args - 732 # TODO: check that args is a pair - 733 var empty-args?/eax: boolean <- nil? args - 734 compare empty-args?, 0/false - 735 { - 736 break-if-= - 737 error trace, "cdr needs 1 arg but got 0" - 738 return - 739 } - 740 # args->left - 741 var first-ah/eax: (addr handle cell) <- get args, left - 742 var first/eax: (addr cell) <- lookup *first-ah - 743 var first-type/ecx: (addr int) <- get first, type - 744 compare *first-type, 0/pair - 745 { - 746 break-if-= - 747 error trace, "arg for cdr is not a pair" - 748 return - 749 } - 750 # cdr - 751 var result/eax: (addr handle cell) <- get first, right - 752 copy-object result, out - 753 } - 754 - 755 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 756 trace-text trace, "eval", "apply cons" - 757 var args-ah/eax: (addr handle cell) <- copy _args-ah - 758 var _args/eax: (addr cell) <- lookup *args-ah - 759 var args/esi: (addr cell) <- copy _args - 760 # TODO: check that args is a pair - 761 var empty-args?/eax: boolean <- nil? args - 762 compare empty-args?, 0/false - 763 { - 764 break-if-= - 765 error trace, "cons needs 2 args but got 0" - 766 return - 767 } - 768 # args->left - 769 var first-ah/ecx: (addr handle cell) <- get args, left - 770 # args->right->left - 771 var right-ah/eax: (addr handle cell) <- get args, right - 772 var right/eax: (addr cell) <- lookup *right-ah - 773 # TODO: check that right is a pair - 774 var second-ah/eax: (addr handle cell) <- get right, left - 775 # cons - 776 new-pair out, *first-ah, *second-ah - 777 } - 778 - 779 fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 780 trace-text trace, "eval", "apply '='" - 781 var args-ah/eax: (addr handle cell) <- copy _args-ah - 782 var _args/eax: (addr cell) <- lookup *args-ah - 783 var args/esi: (addr cell) <- copy _args - 784 # TODO: check that args is a pair + 464 var nil?/eax: boolean <- nil? right + 465 compare nil?, 0/false + 466 break-if-= + 467 error trace, "+ needs 2 args but got 1" + 468 return + 469 } + 470 var second-ah/eax: (addr handle cell) <- get right, left + 471 var second/eax: (addr cell) <- lookup *second-ah + 472 var second-type/edx: (addr int) <- get second, type + 473 compare *second-type, 1/number + 474 { + 475 break-if-= + 476 error trace, "second arg for + is not a number" + 477 return + 478 } + 479 var second-value/edx: (addr float) <- get second, number-data + 480 # add + 481 var result/xmm0: float <- copy *first-value + 482 result <- add *second-value + 483 new-float out, result + 484 } + 485 + 486 fn test-evaluate-missing-arg-in-add { + 487 var t-storage: trace + 488 var t/edi: (addr trace) <- address t-storage + 489 initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible # we don't use trace UI + 490 # + 491 var nil-storage: (handle cell) + 492 var nil-ah/ecx: (addr handle cell) <- address nil-storage + 493 allocate-pair nil-ah + 494 var one-storage: (handle cell) + 495 var one-ah/edx: (addr handle cell) <- address one-storage + 496 new-integer one-ah, 1 + 497 var add-storage: (handle cell) + 498 var add-ah/ebx: (addr handle cell) <- address add-storage + 499 new-symbol add-ah, "+" + 500 # input is (+ 1) + 501 var tmp-storage: (handle cell) + 502 var tmp-ah/esi: (addr handle cell) <- address tmp-storage + 503 new-pair tmp-ah, *one-ah, *nil-ah + 504 new-pair tmp-ah, *add-ah, *tmp-ah + 505 #? dump-cell tmp-ah + 506 # + 507 var globals-storage: global-table + 508 var globals/edx: (addr global-table) <- address globals-storage + 509 initialize-globals globals + 510 # + 511 evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number + 512 # no crash + 513 } + 514 + 515 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + 516 trace-text trace, "eval", "apply -" + 517 var args-ah/eax: (addr handle cell) <- copy _args-ah + 518 var _args/eax: (addr cell) <- lookup *args-ah + 519 var args/esi: (addr cell) <- copy _args + 520 { + 521 var args-type/ecx: (addr int) <- get args, type + 522 compare *args-type, 0/pair + 523 break-if-= + 524 error trace, "args to - are not a list" + 525 return + 526 } + 527 var empty-args?/eax: boolean <- nil? args + 528 compare empty-args?, 0/false + 529 { + 530 break-if-= + 531 error trace, "- needs 2 args but got 0" + 532 return + 533 } + 534 # args->left->value + 535 var first-ah/eax: (addr handle cell) <- get args, left + 536 var first/eax: (addr cell) <- lookup *first-ah + 537 var first-type/ecx: (addr int) <- get first, type + 538 compare *first-type, 1/number + 539 { + 540 break-if-= + 541 error trace, "first arg for - is not a number" + 542 return + 543 } + 544 var first-value/ecx: (addr float) <- get first, number-data + 545 # args->right->left->value + 546 var right-ah/eax: (addr handle cell) <- get args, right + 547 var right/eax: (addr cell) <- lookup *right-ah + 548 { + 549 var right-type/ecx: (addr int) <- get right, type + 550 compare *right-type, 0/pair + 551 break-if-= + 552 error trace, "- encountered non-pair" + 553 return + 554 } + 555 { + 556 var nil?/eax: boolean <- nil? right + 557 compare nil?, 0/false + 558 break-if-= + 559 error trace, "- needs 2 args but got 1" + 560 return + 561 } + 562 var second-ah/eax: (addr handle cell) <- get right, left + 563 var second/eax: (addr cell) <- lookup *second-ah + 564 var second-type/edx: (addr int) <- get second, type + 565 compare *second-type, 1/number + 566 { + 567 break-if-= + 568 error trace, "second arg for - is not a number" + 569 return + 570 } + 571 var second-value/edx: (addr float) <- get second, number-data + 572 # subtract + 573 var result/xmm0: float <- copy *first-value + 574 result <- subtract *second-value + 575 new-float out, result + 576 } + 577 + 578 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + 579 trace-text trace, "eval", "apply *" + 580 var args-ah/eax: (addr handle cell) <- copy _args-ah + 581 var _args/eax: (addr cell) <- lookup *args-ah + 582 var args/esi: (addr cell) <- copy _args + 583 { + 584 var args-type/ecx: (addr int) <- get args, type + 585 compare *args-type, 0/pair + 586 break-if-= + 587 error trace, "args to * are not a list" + 588 return + 589 } + 590 var empty-args?/eax: boolean <- nil? args + 591 compare empty-args?, 0/false + 592 { + 593 break-if-= + 594 error trace, "* needs 2 args but got 0" + 595 return + 596 } + 597 # args->left->value + 598 var first-ah/eax: (addr handle cell) <- get args, left + 599 var first/eax: (addr cell) <- lookup *first-ah + 600 var first-type/ecx: (addr int) <- get first, type + 601 compare *first-type, 1/number + 602 { + 603 break-if-= + 604 error trace, "first arg for * is not a number" + 605 return + 606 } + 607 var first-value/ecx: (addr float) <- get first, number-data + 608 # args->right->left->value + 609 var right-ah/eax: (addr handle cell) <- get args, right + 610 var right/eax: (addr cell) <- lookup *right-ah + 611 { + 612 var right-type/ecx: (addr int) <- get right, type + 613 compare *right-type, 0/pair + 614 break-if-= + 615 error trace, "* encountered non-pair" + 616 return + 617 } + 618 { + 619 var nil?/eax: boolean <- nil? right + 620 compare nil?, 0/false + 621 break-if-= + 622 error trace, "* needs 2 args but got 1" + 623 return + 624 } + 625 var second-ah/eax: (addr handle cell) <- get right, left + 626 var second/eax: (addr cell) <- lookup *second-ah + 627 var second-type/edx: (addr int) <- get second, type + 628 compare *second-type, 1/number + 629 { + 630 break-if-= + 631 error trace, "second arg for * is not a number" + 632 return + 633 } + 634 var second-value/edx: (addr float) <- get second, number-data + 635 # multiply + 636 var result/xmm0: float <- copy *first-value + 637 result <- multiply *second-value + 638 new-float out, result + 639 } + 640 + 641 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + 642 trace-text trace, "eval", "apply /" + 643 var args-ah/eax: (addr handle cell) <- copy _args-ah + 644 var _args/eax: (addr cell) <- lookup *args-ah + 645 var args/esi: (addr cell) <- copy _args + 646 { + 647 var args-type/ecx: (addr int) <- get args, type + 648 compare *args-type, 0/pair + 649 break-if-= + 650 error trace, "args to / are not a list" + 651 return + 652 } + 653 var empty-args?/eax: boolean <- nil? args + 654 compare empty-args?, 0/false + 655 { + 656 break-if-= + 657 error trace, "/ needs 2 args but got 0" + 658 return + 659 } + 660 # args->left->value + 661 var first-ah/eax: (addr handle cell) <- get args, left + 662 var first/eax: (addr cell) <- lookup *first-ah + 663 var first-type/ecx: (addr int) <- get first, type + 664 compare *first-type, 1/number + 665 { + 666 break-if-= + 667 error trace, "first arg for / is not a number" + 668 return + 669 } + 670 var first-value/ecx: (addr float) <- get first, number-data + 671 # args->right->left->value + 672 var right-ah/eax: (addr handle cell) <- get args, right + 673 var right/eax: (addr cell) <- lookup *right-ah + 674 { + 675 var right-type/ecx: (addr int) <- get right, type + 676 compare *right-type, 0/pair + 677 break-if-= + 678 error trace, "/ encountered non-pair" + 679 return + 680 } + 681 { + 682 var nil?/eax: boolean <- nil? right + 683 compare nil?, 0/false + 684 break-if-= + 685 error trace, "/ needs 2 args but got 1" + 686 return + 687 } + 688 var second-ah/eax: (addr handle cell) <- get right, left + 689 var second/eax: (addr cell) <- lookup *second-ah + 690 var second-type/edx: (addr int) <- get second, type + 691 compare *second-type, 1/number + 692 { + 693 break-if-= + 694 error trace, "second arg for / is not a number" + 695 return + 696 } + 697 var second-value/edx: (addr float) <- get second, number-data + 698 # divide + 699 var result/xmm0: float <- copy *first-value + 700 result <- divide *second-value + 701 new-float out, result + 702 } + 703 + 704 fn apply-remainder _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + 705 trace-text trace, "eval", "apply %" + 706 var args-ah/eax: (addr handle cell) <- copy _args-ah + 707 var _args/eax: (addr cell) <- lookup *args-ah + 708 var args/esi: (addr cell) <- copy _args + 709 { + 710 var args-type/ecx: (addr int) <- get args, type + 711 compare *args-type, 0/pair + 712 break-if-= + 713 error trace, "args to % are not a list" + 714 return + 715 } + 716 var empty-args?/eax: boolean <- nil? args + 717 compare empty-args?, 0/false + 718 { + 719 break-if-= + 720 error trace, "% needs 2 args but got 0" + 721 return + 722 } + 723 # args->left->value + 724 var first-ah/eax: (addr handle cell) <- get args, left + 725 var first/eax: (addr cell) <- lookup *first-ah + 726 var first-type/ecx: (addr int) <- get first, type + 727 compare *first-type, 1/number + 728 { + 729 break-if-= + 730 error trace, "first arg for % is not a number" + 731 return + 732 } + 733 var first-value/ecx: (addr float) <- get first, number-data + 734 # args->right->left->value + 735 var right-ah/eax: (addr handle cell) <- get args, right + 736 var right/eax: (addr cell) <- lookup *right-ah + 737 { + 738 var right-type/ecx: (addr int) <- get right, type + 739 compare *right-type, 0/pair + 740 break-if-= + 741 error trace, "% encountered non-pair" + 742 return + 743 } + 744 { + 745 var nil?/eax: boolean <- nil? right + 746 compare nil?, 0/false + 747 break-if-= + 748 error trace, "% needs 2 args but got 1" + 749 return + 750 } + 751 var second-ah/eax: (addr handle cell) <- get right, left + 752 var second/eax: (addr cell) <- lookup *second-ah + 753 var second-type/edx: (addr int) <- get second, type + 754 compare *second-type, 1/number + 755 { + 756 break-if-= + 757 error trace, "second arg for % is not a number" + 758 return + 759 } + 760 var second-value/edx: (addr float) <- get second, number-data + 761 # divide + 762 var quotient/xmm0: float <- copy *first-value + 763 quotient <- divide *second-value + 764 var quotient-int/eax: int <- truncate quotient + 765 quotient <- convert quotient-int + 766 var sub-result/xmm1: float <- copy quotient + 767 sub-result <- multiply *second-value + 768 var result/xmm0: float <- copy *first-value + 769 result <- subtract sub-result + 770 new-float out, result + 771 } + 772 + 773 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + 774 trace-text trace, "eval", "apply sqrt" + 775 var args-ah/eax: (addr handle cell) <- copy _args-ah + 776 var _args/eax: (addr cell) <- lookup *args-ah + 777 var args/esi: (addr cell) <- copy _args + 778 { + 779 var args-type/ecx: (addr int) <- get args, type + 780 compare *args-type, 0/pair + 781 break-if-= + 782 error trace, "args to sqrt are not a list" + 783 return + 784 } 785 var empty-args?/eax: boolean <- nil? args 786 compare empty-args?, 0/false 787 { 788 break-if-= - 789 error trace, "'=' needs 2 args but got 0" + 789 error trace, "sqrt needs 1 arg but got 0" 790 return 791 } - 792 # args->left - 793 var first-ah/ecx: (addr handle cell) <- get args, left - 794 # args->right->left - 795 var right-ah/eax: (addr handle cell) <- get args, right - 796 var right/eax: (addr cell) <- lookup *right-ah - 797 # TODO: check that right is a pair - 798 var second-ah/edx: (addr handle cell) <- get right, left - 799 # compare - 800 var _first/eax: (addr cell) <- lookup *first-ah - 801 var first/ecx: (addr cell) <- copy _first - 802 var second/eax: (addr cell) <- lookup *second-ah - 803 var match?/eax: boolean <- cell-isomorphic? first, second, trace - 804 compare match?, 0/false - 805 { - 806 break-if-!= - 807 nil out - 808 return - 809 } - 810 new-integer out, 1/true - 811 } - 812 - 813 fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 814 trace-text trace, "eval", "apply not" - 815 var args-ah/eax: (addr handle cell) <- copy _args-ah - 816 var _args/eax: (addr cell) <- lookup *args-ah - 817 var args/esi: (addr cell) <- copy _args - 818 # TODO: check that args is a pair - 819 var empty-args?/eax: boolean <- nil? args - 820 compare empty-args?, 0/false - 821 { - 822 break-if-= - 823 error trace, "not needs 1 arg but got 0" - 824 return - 825 } - 826 # args->left - 827 var first-ah/eax: (addr handle cell) <- get args, left - 828 var first/eax: (addr cell) <- lookup *first-ah - 829 # not - 830 var nil?/eax: boolean <- nil? first - 831 compare nil?, 0/false + 792 # args->left->value + 793 var first-ah/eax: (addr handle cell) <- get args, left + 794 var first/eax: (addr cell) <- lookup *first-ah + 795 var first-type/ecx: (addr int) <- get first, type + 796 compare *first-type, 1/number + 797 { + 798 break-if-= + 799 error trace, "arg for sqrt is not a number" + 800 return + 801 } + 802 var first-value/ecx: (addr float) <- get first, number-data + 803 # square-root + 804 var result/xmm0: float <- square-root *first-value + 805 new-float out, result + 806 } + 807 + 808 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + 809 trace-text trace, "eval", "apply abs" + 810 var args-ah/eax: (addr handle cell) <- copy _args-ah + 811 var _args/eax: (addr cell) <- lookup *args-ah + 812 var args/esi: (addr cell) <- copy _args + 813 { + 814 var args-type/ecx: (addr int) <- get args, type + 815 compare *args-type, 0/pair + 816 break-if-= + 817 error trace, "args to abs are not a list" + 818 return + 819 } + 820 var empty-args?/eax: boolean <- nil? args + 821 compare empty-args?, 0/false + 822 { + 823 break-if-= + 824 error trace, "abs needs 1 arg but got 0" + 825 return + 826 } + 827 # args->left->value + 828 var first-ah/eax: (addr handle cell) <- get args, left + 829 var first/eax: (addr cell) <- lookup *first-ah + 830 var first-type/ecx: (addr int) <- get first, type + 831 compare *first-type, 1/number 832 { - 833 break-if-!= - 834 nil out + 833 break-if-= + 834 error trace, "arg for abs is not a number" 835 return 836 } - 837 new-integer out, 1 - 838 } - 839 - 840 fn apply-debug _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 841 trace-text trace, "eval", "apply debug" - 842 var args-ah/eax: (addr handle cell) <- copy _args-ah - 843 var _args/eax: (addr cell) <- lookup *args-ah - 844 var args/esi: (addr cell) <- copy _args - 845 # TODO: check that args is a pair - 846 var empty-args?/eax: boolean <- nil? args - 847 compare empty-args?, 0/false - 848 { - 849 break-if-= - 850 error trace, "not needs 1 arg but got 0" - 851 return - 852 } - 853 # dump args->left uglily to screen and wait for a keypress - 854 var first-ah/eax: (addr handle cell) <- get args, left - 855 dump-cell-from-cursor-over-full-screen first-ah + 837 var first-value/ecx: (addr float) <- get first, number-data + 838 # + 839 var result/xmm0: float <- copy *first-value + 840 var zero: float + 841 compare result, zero + 842 { + 843 break-if-float>= + 844 var neg1/eax: int <- copy -1 + 845 var neg1-f/xmm1: float <- convert neg1 + 846 result <- multiply neg1-f + 847 } + 848 new-float out, result + 849 } + 850 + 851 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + 852 trace-text trace, "eval", "apply sgn" + 853 var args-ah/eax: (addr handle cell) <- copy _args-ah + 854 var _args/eax: (addr cell) <- lookup *args-ah + 855 var args/esi: (addr cell) <- copy _args 856 { - 857 var foo/eax: byte <- read-key 0/keyboard - 858 compare foo, 0 - 859 loop-if-= - 860 } - 861 # return nothing - 862 } - 863 - 864 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 865 trace-text trace, "eval", "apply '<'" - 866 var args-ah/eax: (addr handle cell) <- copy _args-ah - 867 var _args/eax: (addr cell) <- lookup *args-ah - 868 var args/esi: (addr cell) <- copy _args - 869 # TODO: check that args is a pair - 870 var empty-args?/eax: boolean <- nil? args - 871 compare empty-args?, 0/false - 872 { - 873 break-if-= - 874 error trace, "'<' needs 2 args but got 0" - 875 return - 876 } - 877 # args->left - 878 var first-ah/ecx: (addr handle cell) <- get args, left - 879 # args->right->left - 880 var right-ah/eax: (addr handle cell) <- get args, right - 881 var right/eax: (addr cell) <- lookup *right-ah - 882 # TODO: check that right is a pair - 883 var second-ah/edx: (addr handle cell) <- get right, left - 884 # compare - 885 var _first/eax: (addr cell) <- lookup *first-ah - 886 var first/ecx: (addr cell) <- copy _first - 887 var first-type/eax: (addr int) <- get first, type - 888 compare *first-type, 1/number - 889 { - 890 break-if-= - 891 error trace, "first arg for '<' is not a number" - 892 return - 893 } - 894 var first-value/ecx: (addr float) <- get first, number-data - 895 var first-float/xmm0: float <- copy *first-value - 896 var second/eax: (addr cell) <- lookup *second-ah - 897 var second-type/edx: (addr int) <- get second, type - 898 compare *second-type, 1/number - 899 { - 900 break-if-= - 901 error trace, "first arg for '<' is not a number" - 902 return - 903 } - 904 var second-value/eax: (addr float) <- get second, number-data - 905 compare first-float, *second-value - 906 { - 907 break-if-float< - 908 nil out - 909 return - 910 } - 911 new-integer out, 1/true - 912 } - 913 - 914 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 915 trace-text trace, "eval", "apply '>'" - 916 var args-ah/eax: (addr handle cell) <- copy _args-ah - 917 var _args/eax: (addr cell) <- lookup *args-ah - 918 var args/esi: (addr cell) <- copy _args - 919 # TODO: check that args is a pair - 920 var empty-args?/eax: boolean <- nil? args - 921 compare empty-args?, 0/false - 922 { - 923 break-if-= - 924 error trace, "'>' needs 2 args but got 0" - 925 return - 926 } - 927 # args->left - 928 var first-ah/ecx: (addr handle cell) <- get args, left - 929 # args->right->left - 930 var right-ah/eax: (addr handle cell) <- get args, right - 931 var right/eax: (addr cell) <- lookup *right-ah - 932 # TODO: check that right is a pair - 933 var second-ah/edx: (addr handle cell) <- get right, left - 934 # compare - 935 var _first/eax: (addr cell) <- lookup *first-ah - 936 var first/ecx: (addr cell) <- copy _first - 937 var first-type/eax: (addr int) <- get first, type - 938 compare *first-type, 1/number - 939 { - 940 break-if-= - 941 error trace, "first arg for '>' is not a number" - 942 return - 943 } - 944 var first-value/ecx: (addr float) <- get first, number-data - 945 var first-float/xmm0: float <- copy *first-value - 946 var second/eax: (addr cell) <- lookup *second-ah - 947 var second-type/edx: (addr int) <- get second, type - 948 compare *second-type, 1/number - 949 { - 950 break-if-= - 951 error trace, "first arg for '>' is not a number" - 952 return - 953 } - 954 var second-value/eax: (addr float) <- get second, number-data - 955 compare first-float, *second-value - 956 { - 957 break-if-float> - 958 nil out - 959 return - 960 } - 961 new-integer out, 1/true - 962 } - 963 - 964 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { - 965 trace-text trace, "eval", "apply '<='" - 966 var args-ah/eax: (addr handle cell) <- copy _args-ah - 967 var _args/eax: (addr cell) <- lookup *args-ah - 968 var args/esi: (addr cell) <- copy _args - 969 # TODO: check that args is a pair - 970 var empty-args?/eax: boolean <- nil? args - 971 compare empty-args?, 0/false - 972 { - 973 break-if-= - 974 error trace, "'<=' needs 2 args but got 0" - 975 return - 976 } - 977 # args->left - 978 var first-ah/ecx: (addr handle cell) <- get args, left - 979 # args->right->left - 980 var right-ah/eax: (addr handle cell) <- get args, right - 981 var right/eax: (addr cell) <- lookup *right-ah - 982 # TODO: check that right is a pair - 983 var second-ah/edx: (addr handle cell) <- get right, left - 984 # compare - 985 var _first/eax: (addr cell) <- lookup *first-ah - 986 var first/ecx: (addr cell) <- copy _first - 987 var first-type/eax: (addr int) <- get first, type - 988 compare *first-type, 1/number - 989 { - 990 break-if-= - 991 error trace, "first arg for '<=' is not a number" - 992 return - 993 } - 994 var first-value/ecx: (addr float) <- get first, number-data - 995 var first-float/xmm0: float <- copy *first-value - 996 var second/eax: (addr cell) <- lookup *second-ah - 997 var second-type/edx: (addr int) <- get second, type - 998 compare *second-type, 1/number - 999 { -1000 break-if-= -1001 error trace, "first arg for '<=' is not a number" -1002 return -1003 } -1004 var second-value/eax: (addr float) <- get second, number-data -1005 compare first-float, *second-value -1006 { -1007 break-if-float<= -1008 nil out -1009 return -1010 } -1011 new-integer out, 1/true -1012 } -1013 -1014 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1015 trace-text trace, "eval", "apply '>='" -1016 var args-ah/eax: (addr handle cell) <- copy _args-ah -1017 var _args/eax: (addr cell) <- lookup *args-ah -1018 var args/esi: (addr cell) <- copy _args -1019 # TODO: check that args is a pair -1020 var empty-args?/eax: boolean <- nil? args -1021 compare empty-args?, 0/false -1022 { -1023 break-if-= -1024 error trace, "'>=' needs 2 args but got 0" -1025 return -1026 } -1027 # args->left -1028 var first-ah/ecx: (addr handle cell) <- get args, left -1029 # args->right->left -1030 var right-ah/eax: (addr handle cell) <- get args, right -1031 var right/eax: (addr cell) <- lookup *right-ah -1032 # TODO: check that right is a pair -1033 var second-ah/edx: (addr handle cell) <- get right, left -1034 # compare -1035 var _first/eax: (addr cell) <- lookup *first-ah -1036 var first/ecx: (addr cell) <- copy _first -1037 var first-type/eax: (addr int) <- get first, type -1038 compare *first-type, 1/number -1039 { -1040 break-if-= -1041 error trace, "first arg for '>=' is not a number" -1042 return -1043 } -1044 var first-value/ecx: (addr float) <- get first, number-data -1045 var first-float/xmm0: float <- copy *first-value -1046 var second/eax: (addr cell) <- lookup *second-ah -1047 var second-type/edx: (addr int) <- get second, type -1048 compare *second-type, 1/number -1049 { -1050 break-if-= -1051 error trace, "first arg for '>=' is not a number" -1052 return -1053 } -1054 var second-value/eax: (addr float) <- get second, number-data -1055 compare first-float, *second-value -1056 { -1057 break-if-float>= -1058 nil out + 857 var args-type/ecx: (addr int) <- get args, type + 858 compare *args-type, 0/pair + 859 break-if-= + 860 error trace, "args to sgn are not a list" + 861 return + 862 } + 863 var empty-args?/eax: boolean <- nil? args + 864 compare empty-args?, 0/false + 865 { + 866 break-if-= + 867 error trace, "sgn needs 1 arg but got 0" + 868 return + 869 } + 870 # args->left->value + 871 var first-ah/eax: (addr handle cell) <- get args, left + 872 var first/eax: (addr cell) <- lookup *first-ah + 873 var first-type/ecx: (addr int) <- get first, type + 874 compare *first-type, 1/number + 875 { + 876 break-if-= + 877 error trace, "arg for sgn is not a number" + 878 return + 879 } + 880 var first-value/ecx: (addr float) <- get first, number-data + 881 # + 882 var result/xmm0: float <- copy *first-value + 883 var zero: float + 884 $apply-sgn:core: { + 885 compare result, zero + 886 break-if-= + 887 { + 888 break-if-float> + 889 var neg1/eax: int <- copy -1 + 890 result <- convert neg1 + 891 break $apply-sgn:core + 892 } + 893 { + 894 break-if-float< + 895 var one/eax: int <- copy 1 + 896 result <- convert one + 897 break $apply-sgn:core + 898 } + 899 } + 900 new-float out, result + 901 } + 902 + 903 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + 904 trace-text trace, "eval", "apply car" + 905 var args-ah/eax: (addr handle cell) <- copy _args-ah + 906 var _args/eax: (addr cell) <- lookup *args-ah + 907 var args/esi: (addr cell) <- copy _args + 908 { + 909 var args-type/ecx: (addr int) <- get args, type + 910 compare *args-type, 0/pair + 911 break-if-= + 912 error trace, "args to car are not a list" + 913 return + 914 } + 915 var empty-args?/eax: boolean <- nil? args + 916 compare empty-args?, 0/false + 917 { + 918 break-if-= + 919 error trace, "car needs 1 arg but got 0" + 920 return + 921 } + 922 # args->left + 923 var first-ah/edx: (addr handle cell) <- get args, left + 924 var first/eax: (addr cell) <- lookup *first-ah + 925 var first-type/ecx: (addr int) <- get first, type + 926 compare *first-type, 0/pair + 927 { + 928 break-if-= + 929 error trace, "arg for car is not a pair" + 930 return + 931 } + 932 # nil? return nil + 933 { + 934 var nil?/eax: boolean <- nil? first + 935 compare nil?, 0/false + 936 break-if-= + 937 copy-object first-ah, out + 938 return + 939 } + 940 # car + 941 var result/eax: (addr handle cell) <- get first, left + 942 copy-object result, out + 943 } + 944 + 945 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + 946 trace-text trace, "eval", "apply cdr" + 947 var args-ah/eax: (addr handle cell) <- copy _args-ah + 948 var _args/eax: (addr cell) <- lookup *args-ah + 949 var args/esi: (addr cell) <- copy _args + 950 { + 951 var args-type/ecx: (addr int) <- get args, type + 952 compare *args-type, 0/pair + 953 break-if-= + 954 error trace, "args to cdr are not a list" + 955 return + 956 } + 957 var empty-args?/eax: boolean <- nil? args + 958 compare empty-args?, 0/false + 959 { + 960 break-if-= + 961 error trace, "cdr needs 1 arg but got 0" + 962 return + 963 } + 964 # args->left + 965 var first-ah/edx: (addr handle cell) <- get args, left + 966 var first/eax: (addr cell) <- lookup *first-ah + 967 var first-type/ecx: (addr int) <- get first, type + 968 compare *first-type, 0/pair + 969 { + 970 break-if-= + 971 error trace, "arg for cdr is not a pair" + 972 return + 973 } + 974 # nil? return nil + 975 { + 976 var nil?/eax: boolean <- nil? first + 977 compare nil?, 0/false + 978 break-if-= + 979 copy-object first-ah, out + 980 return + 981 } + 982 # cdr + 983 var result/eax: (addr handle cell) <- get first, right + 984 copy-object result, out + 985 } + 986 + 987 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + 988 trace-text trace, "eval", "apply cons" + 989 var args-ah/eax: (addr handle cell) <- copy _args-ah + 990 var _args/eax: (addr cell) <- lookup *args-ah + 991 var args/esi: (addr cell) <- copy _args + 992 { + 993 var args-type/ecx: (addr int) <- get args, type + 994 compare *args-type, 0/pair + 995 break-if-= + 996 error trace, "args to 'cons' are not a list" + 997 return + 998 } + 999 var empty-args?/eax: boolean <- nil? args +1000 compare empty-args?, 0/false +1001 { +1002 break-if-= +1003 error trace, "cons needs 2 args but got 0" +1004 return +1005 } +1006 # args->left +1007 var first-ah/ecx: (addr handle cell) <- get args, left +1008 # args->right->left +1009 var right-ah/eax: (addr handle cell) <- get args, right +1010 var right/eax: (addr cell) <- lookup *right-ah +1011 { +1012 var right-type/ecx: (addr int) <- get right, type +1013 compare *right-type, 0/pair +1014 break-if-= +1015 error trace, "'cons' encountered non-pair" +1016 return +1017 } +1018 { +1019 var nil?/eax: boolean <- nil? right +1020 compare nil?, 0/false +1021 break-if-= +1022 error trace, "'cons' needs 2 args but got 1" +1023 return +1024 } +1025 var second-ah/eax: (addr handle cell) <- get right, left +1026 # cons +1027 new-pair out, *first-ah, *second-ah +1028 } +1029 +1030 fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1031 trace-text trace, "eval", "apply '='" +1032 var args-ah/eax: (addr handle cell) <- copy _args-ah +1033 var _args/eax: (addr cell) <- lookup *args-ah +1034 var args/esi: (addr cell) <- copy _args +1035 { +1036 var args-type/ecx: (addr int) <- get args, type +1037 compare *args-type, 0/pair +1038 break-if-= +1039 error trace, "args to '=' are not a list" +1040 return +1041 } +1042 var empty-args?/eax: boolean <- nil? args +1043 compare empty-args?, 0/false +1044 { +1045 break-if-= +1046 error trace, "'=' needs 2 args but got 0" +1047 return +1048 } +1049 # args->left +1050 var first-ah/ecx: (addr handle cell) <- get args, left +1051 # args->right->left +1052 var right-ah/eax: (addr handle cell) <- get args, right +1053 var right/eax: (addr cell) <- lookup *right-ah +1054 { +1055 var right-type/ecx: (addr int) <- get right, type +1056 compare *right-type, 0/pair +1057 break-if-= +1058 error trace, "'=' encountered non-pair" 1059 return 1060 } -1061 new-integer out, 1/true -1062 } -1063 -1064 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1065 trace-text trace, "eval", "apply print" -1066 var args-ah/eax: (addr handle cell) <- copy _args-ah -1067 var _args/eax: (addr cell) <- lookup *args-ah -1068 var args/esi: (addr cell) <- copy _args -1069 # TODO: check that args is a pair -1070 var empty-args?/eax: boolean <- nil? args -1071 compare empty-args?, 0/false -1072 { -1073 break-if-= -1074 error trace, "print needs 2 args but got 0" -1075 return -1076 } -1077 # screen = args->left -1078 var first-ah/eax: (addr handle cell) <- get args, left -1079 var first/eax: (addr cell) <- lookup *first-ah -1080 var first-type/ecx: (addr int) <- get first, type -1081 compare *first-type, 5/screen -1082 { -1083 break-if-= -1084 error trace, "first arg for 'print' is not a screen" -1085 return -1086 } -1087 var screen-ah/eax: (addr handle screen) <- get first, screen-data -1088 var _screen/eax: (addr screen) <- lookup *screen-ah -1089 var screen/ecx: (addr screen) <- copy _screen -1090 # args->right->left -1091 var right-ah/eax: (addr handle cell) <- get args, right -1092 var right/eax: (addr cell) <- lookup *right-ah -1093 # TODO: check that right is a pair -1094 var second-ah/eax: (addr handle cell) <- get right, left -1095 var stream-storage: (stream byte 0x100) -1096 var stream/edi: (addr stream byte) <- address stream-storage -1097 print-cell second-ah, stream, trace -1098 draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg -1099 # return what was printed -1100 copy-object second-ah, out -1101 } -1102 -1103 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1104 trace-text trace, "eval", "apply clear" -1105 var args-ah/eax: (addr handle cell) <- copy _args-ah -1106 var _args/eax: (addr cell) <- lookup *args-ah -1107 var args/esi: (addr cell) <- copy _args -1108 # TODO: check that args is a pair -1109 var empty-args?/eax: boolean <- nil? args -1110 compare empty-args?, 0/false -1111 { -1112 break-if-= -1113 error trace, "'clear' needs 1 arg but got 0" -1114 return -1115 } -1116 # screen = args->left -1117 var first-ah/eax: (addr handle cell) <- get args, left -1118 var first/eax: (addr cell) <- lookup *first-ah -1119 var first-type/ecx: (addr int) <- get first, type -1120 compare *first-type, 5/screen +1061 { +1062 var nil?/eax: boolean <- nil? right +1063 compare nil?, 0/false +1064 break-if-= +1065 error trace, "'=' needs 2 args but got 1" +1066 return +1067 } +1068 var second-ah/edx: (addr handle cell) <- get right, left +1069 # compare +1070 var _first/eax: (addr cell) <- lookup *first-ah +1071 var first/ecx: (addr cell) <- copy _first +1072 var second/eax: (addr cell) <- lookup *second-ah +1073 var match?/eax: boolean <- cell-isomorphic? first, second, trace +1074 compare match?, 0/false +1075 { +1076 break-if-!= +1077 nil out +1078 return +1079 } +1080 new-integer out, 1/true +1081 } +1082 +1083 fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1084 trace-text trace, "eval", "apply 'not'" +1085 var args-ah/eax: (addr handle cell) <- copy _args-ah +1086 var _args/eax: (addr cell) <- lookup *args-ah +1087 var args/esi: (addr cell) <- copy _args +1088 { +1089 var args-type/ecx: (addr int) <- get args, type +1090 compare *args-type, 0/pair +1091 break-if-= +1092 error trace, "args to 'not' are not a list" +1093 return +1094 } +1095 var empty-args?/eax: boolean <- nil? args +1096 compare empty-args?, 0/false +1097 { +1098 break-if-= +1099 error trace, "'not' needs 1 arg but got 0" +1100 return +1101 } +1102 # args->left +1103 var first-ah/eax: (addr handle cell) <- get args, left +1104 var first/eax: (addr cell) <- lookup *first-ah +1105 # not +1106 var nil?/eax: boolean <- nil? first +1107 compare nil?, 0/false +1108 { +1109 break-if-!= +1110 nil out +1111 return +1112 } +1113 new-integer out, 1 +1114 } +1115 +1116 fn apply-debug _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1117 trace-text trace, "eval", "apply 'debug'" +1118 var args-ah/eax: (addr handle cell) <- copy _args-ah +1119 var _args/eax: (addr cell) <- lookup *args-ah +1120 var args/esi: (addr cell) <- copy _args 1121 { -1122 break-if-= -1123 error trace, "first arg for 'clear' is not a screen" -1124 return -1125 } -1126 var screen-ah/eax: (addr handle screen) <- get first, screen-data -1127 var _screen/eax: (addr screen) <- lookup *screen-ah -1128 var screen/ecx: (addr screen) <- copy _screen -1129 # -1130 clear-screen screen -1131 } -1132 -1133 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1134 trace-text trace, "eval", "apply up" -1135 var args-ah/eax: (addr handle cell) <- copy _args-ah -1136 var _args/eax: (addr cell) <- lookup *args-ah -1137 var args/esi: (addr cell) <- copy _args -1138 # TODO: check that args is a pair -1139 var empty-args?/eax: boolean <- nil? args -1140 compare empty-args?, 0/false -1141 { -1142 break-if-= -1143 error trace, "'up' needs 1 arg but got 0" -1144 return -1145 } -1146 # screen = args->left -1147 var first-ah/eax: (addr handle cell) <- get args, left -1148 var first/eax: (addr cell) <- lookup *first-ah -1149 var first-type/ecx: (addr int) <- get first, type -1150 compare *first-type, 5/screen +1122 var args-type/ecx: (addr int) <- get args, type +1123 compare *args-type, 0/pair +1124 break-if-= +1125 error trace, "args to 'debug' are not a list" +1126 return +1127 } +1128 var empty-args?/eax: boolean <- nil? args +1129 compare empty-args?, 0/false +1130 { +1131 break-if-= +1132 error trace, "'debug' needs 1 arg but got 0" +1133 return +1134 } +1135 # dump args->left uglily to screen and wait for a keypress +1136 var first-ah/eax: (addr handle cell) <- get args, left +1137 dump-cell-from-cursor-over-full-screen first-ah +1138 { +1139 var foo/eax: byte <- read-key 0/keyboard +1140 compare foo, 0 +1141 loop-if-= +1142 } +1143 # return nothing +1144 } +1145 +1146 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1147 trace-text trace, "eval", "apply '<'" +1148 var args-ah/eax: (addr handle cell) <- copy _args-ah +1149 var _args/eax: (addr cell) <- lookup *args-ah +1150 var args/esi: (addr cell) <- copy _args 1151 { -1152 break-if-= -1153 error trace, "first arg for 'up' is not a screen" -1154 return -1155 } -1156 var screen-ah/eax: (addr handle screen) <- get first, screen-data -1157 var _screen/eax: (addr screen) <- lookup *screen-ah -1158 var screen/ecx: (addr screen) <- copy _screen -1159 # -1160 move-cursor-up screen -1161 } -1162 -1163 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1164 trace-text trace, "eval", "apply 'down'" -1165 var args-ah/eax: (addr handle cell) <- copy _args-ah -1166 var _args/eax: (addr cell) <- lookup *args-ah -1167 var args/esi: (addr cell) <- copy _args -1168 # TODO: check that args is a pair -1169 var empty-args?/eax: boolean <- nil? args -1170 compare empty-args?, 0/false -1171 { -1172 break-if-= -1173 error trace, "'down' needs 1 arg but got 0" -1174 return -1175 } -1176 # screen = args->left -1177 var first-ah/eax: (addr handle cell) <- get args, left -1178 var first/eax: (addr cell) <- lookup *first-ah -1179 var first-type/ecx: (addr int) <- get first, type -1180 compare *first-type, 5/screen -1181 { -1182 break-if-= -1183 error trace, "first arg for 'down' is not a screen" -1184 return -1185 } -1186 var screen-ah/eax: (addr handle screen) <- get first, screen-data -1187 var _screen/eax: (addr screen) <- lookup *screen-ah -1188 var screen/ecx: (addr screen) <- copy _screen -1189 # -1190 move-cursor-down screen -1191 } -1192 -1193 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1194 trace-text trace, "eval", "apply 'left'" -1195 var args-ah/eax: (addr handle cell) <- copy _args-ah -1196 var _args/eax: (addr cell) <- lookup *args-ah -1197 var args/esi: (addr cell) <- copy _args -1198 # TODO: check that args is a pair -1199 var empty-args?/eax: boolean <- nil? args -1200 compare empty-args?, 0/false -1201 { -1202 break-if-= -1203 error trace, "'left' needs 1 arg but got 0" -1204 return -1205 } -1206 # screen = args->left -1207 var first-ah/eax: (addr handle cell) <- get args, left -1208 var first/eax: (addr cell) <- lookup *first-ah -1209 var first-type/ecx: (addr int) <- get first, type -1210 compare *first-type, 5/screen -1211 { -1212 break-if-= -1213 error trace, "first arg for 'left' is not a screen" -1214 return -1215 } -1216 var screen-ah/eax: (addr handle screen) <- get first, screen-data -1217 var _screen/eax: (addr screen) <- lookup *screen-ah -1218 var screen/ecx: (addr screen) <- copy _screen -1219 # -1220 move-cursor-left screen -1221 } -1222 -1223 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1224 trace-text trace, "eval", "apply 'right'" -1225 var args-ah/eax: (addr handle cell) <- copy _args-ah -1226 var _args/eax: (addr cell) <- lookup *args-ah -1227 var args/esi: (addr cell) <- copy _args -1228 # TODO: check that args is a pair -1229 var empty-args?/eax: boolean <- nil? args -1230 compare empty-args?, 0/false -1231 { -1232 break-if-= -1233 error trace, "'right' needs 1 arg but got 0" -1234 return -1235 } -1236 # screen = args->left -1237 var first-ah/eax: (addr handle cell) <- get args, left -1238 var first/eax: (addr cell) <- lookup *first-ah -1239 var first-type/ecx: (addr int) <- get first, type -1240 compare *first-type, 5/screen -1241 { +1152 var args-type/ecx: (addr int) <- get args, type +1153 compare *args-type, 0/pair +1154 break-if-= +1155 error trace, "args to '<' are not a list" +1156 return +1157 } +1158 var empty-args?/eax: boolean <- nil? args +1159 compare empty-args?, 0/false +1160 { +1161 break-if-= +1162 error trace, "'<' needs 2 args but got 0" +1163 return +1164 } +1165 # args->left +1166 var first-ah/ecx: (addr handle cell) <- get args, left +1167 # args->right->left +1168 var right-ah/eax: (addr handle cell) <- get args, right +1169 var right/eax: (addr cell) <- lookup *right-ah +1170 { +1171 var right-type/ecx: (addr int) <- get right, type +1172 compare *right-type, 0/pair +1173 break-if-= +1174 error trace, "'<' encountered non-pair" +1175 return +1176 } +1177 { +1178 var nil?/eax: boolean <- nil? right +1179 compare nil?, 0/false +1180 break-if-= +1181 error trace, "'<' needs 2 args but got 1" +1182 return +1183 } +1184 var second-ah/edx: (addr handle cell) <- get right, left +1185 # compare +1186 var _first/eax: (addr cell) <- lookup *first-ah +1187 var first/ecx: (addr cell) <- copy _first +1188 var first-type/eax: (addr int) <- get first, type +1189 compare *first-type, 1/number +1190 { +1191 break-if-= +1192 error trace, "first arg for '<' is not a number" +1193 return +1194 } +1195 var first-value/ecx: (addr float) <- get first, number-data +1196 var first-float/xmm0: float <- copy *first-value +1197 var second/eax: (addr cell) <- lookup *second-ah +1198 var second-type/edx: (addr int) <- get second, type +1199 compare *second-type, 1/number +1200 { +1201 break-if-= +1202 error trace, "second arg for '<' is not a number" +1203 return +1204 } +1205 var second-value/eax: (addr float) <- get second, number-data +1206 compare first-float, *second-value +1207 { +1208 break-if-float< +1209 nil out +1210 return +1211 } +1212 new-integer out, 1/true +1213 } +1214 +1215 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1216 trace-text trace, "eval", "apply '>'" +1217 var args-ah/eax: (addr handle cell) <- copy _args-ah +1218 var _args/eax: (addr cell) <- lookup *args-ah +1219 var args/esi: (addr cell) <- copy _args +1220 { +1221 var args-type/ecx: (addr int) <- get args, type +1222 compare *args-type, 0/pair +1223 break-if-= +1224 error trace, "args to '>' are not a list" +1225 return +1226 } +1227 var empty-args?/eax: boolean <- nil? args +1228 compare empty-args?, 0/false +1229 { +1230 break-if-= +1231 error trace, "'>' needs 2 args but got 0" +1232 return +1233 } +1234 # args->left +1235 var first-ah/ecx: (addr handle cell) <- get args, left +1236 # args->right->left +1237 var right-ah/eax: (addr handle cell) <- get args, right +1238 var right/eax: (addr cell) <- lookup *right-ah +1239 { +1240 var right-type/ecx: (addr int) <- get right, type +1241 compare *right-type, 0/pair 1242 break-if-= -1243 error trace, "first arg for 'right' is not a screen" +1243 error trace, "'>' encountered non-pair" 1244 return 1245 } -1246 var screen-ah/eax: (addr handle screen) <- get first, screen-data -1247 var _screen/eax: (addr screen) <- lookup *screen-ah -1248 var screen/ecx: (addr screen) <- copy _screen -1249 # -1250 move-cursor-right screen -1251 } -1252 -1253 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1254 trace-text trace, "eval", "apply 'cr'" -1255 var args-ah/eax: (addr handle cell) <- copy _args-ah -1256 var _args/eax: (addr cell) <- lookup *args-ah -1257 var args/esi: (addr cell) <- copy _args -1258 # TODO: check that args is a pair -1259 var empty-args?/eax: boolean <- nil? args -1260 compare empty-args?, 0/false -1261 { -1262 break-if-= -1263 error trace, "'cr' needs 1 arg but got 0" -1264 return -1265 } -1266 # screen = args->left -1267 var first-ah/eax: (addr handle cell) <- get args, left -1268 var first/eax: (addr cell) <- lookup *first-ah -1269 var first-type/ecx: (addr int) <- get first, type -1270 compare *first-type, 5/screen -1271 { -1272 break-if-= -1273 error trace, "first arg for 'cr' is not a screen" -1274 return -1275 } -1276 var screen-ah/eax: (addr handle screen) <- get first, screen-data -1277 var _screen/eax: (addr screen) <- lookup *screen-ah -1278 var screen/ecx: (addr screen) <- copy _screen -1279 # -1280 move-cursor-to-left-margin-of-next-line screen -1281 } -1282 -1283 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1284 trace-text trace, "eval", "apply pixel" -1285 var args-ah/eax: (addr handle cell) <- copy _args-ah -1286 var _args/eax: (addr cell) <- lookup *args-ah -1287 var args/esi: (addr cell) <- copy _args -1288 # TODO: check that args is a pair -1289 var empty-args?/eax: boolean <- nil? args -1290 compare empty-args?, 0/false -1291 { +1246 { +1247 var nil?/eax: boolean <- nil? right +1248 compare nil?, 0/false +1249 break-if-= +1250 error trace, "'>' needs 2 args but got 1" +1251 return +1252 } +1253 var second-ah/edx: (addr handle cell) <- get right, left +1254 # compare +1255 var _first/eax: (addr cell) <- lookup *first-ah +1256 var first/ecx: (addr cell) <- copy _first +1257 var first-type/eax: (addr int) <- get first, type +1258 compare *first-type, 1/number +1259 { +1260 break-if-= +1261 error trace, "first arg for '>' is not a number" +1262 return +1263 } +1264 var first-value/ecx: (addr float) <- get first, number-data +1265 var first-float/xmm0: float <- copy *first-value +1266 var second/eax: (addr cell) <- lookup *second-ah +1267 var second-type/edx: (addr int) <- get second, type +1268 compare *second-type, 1/number +1269 { +1270 break-if-= +1271 error trace, "second arg for '>' is not a number" +1272 return +1273 } +1274 var second-value/eax: (addr float) <- get second, number-data +1275 compare first-float, *second-value +1276 { +1277 break-if-float> +1278 nil out +1279 return +1280 } +1281 new-integer out, 1/true +1282 } +1283 +1284 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1285 trace-text trace, "eval", "apply '<='" +1286 var args-ah/eax: (addr handle cell) <- copy _args-ah +1287 var _args/eax: (addr cell) <- lookup *args-ah +1288 var args/esi: (addr cell) <- copy _args +1289 { +1290 var args-type/ecx: (addr int) <- get args, type +1291 compare *args-type, 0/pair 1292 break-if-= -1293 error trace, "pixel needs 4 args but got 0" +1293 error trace, "args to '<=' are not a list" 1294 return 1295 } -1296 # screen = args->left -1297 var first-ah/eax: (addr handle cell) <- get args, left -1298 var first/eax: (addr cell) <- lookup *first-ah -1299 var first-type/ecx: (addr int) <- get first, type -1300 compare *first-type, 5/screen -1301 { -1302 break-if-= -1303 error trace, "first arg for 'pixel' is not a screen" -1304 return -1305 } -1306 var screen-ah/eax: (addr handle screen) <- get first, screen-data -1307 var _screen/eax: (addr screen) <- lookup *screen-ah -1308 var screen/edi: (addr screen) <- copy _screen -1309 # x = args->right->left->value -1310 var rest-ah/eax: (addr handle cell) <- get args, right -1311 var _rest/eax: (addr cell) <- lookup *rest-ah -1312 var rest/esi: (addr cell) <- copy _rest -1313 # TODO: check that rest is a pair -1314 var second-ah/eax: (addr handle cell) <- get rest, left -1315 var second/eax: (addr cell) <- lookup *second-ah -1316 var second-type/ecx: (addr int) <- get second, type -1317 compare *second-type, 1/number -1318 { -1319 break-if-= -1320 error trace, "second arg for 'pixel' is not an int (x coordinate)" -1321 return -1322 } -1323 var second-value/eax: (addr float) <- get second, number-data -1324 var x/edx: int <- convert *second-value -1325 # y = rest->right->left->value -1326 var rest-ah/eax: (addr handle cell) <- get rest, right -1327 var _rest/eax: (addr cell) <- lookup *rest-ah -1328 rest <- copy _rest -1329 # TODO: check that rest is a pair -1330 var third-ah/eax: (addr handle cell) <- get rest, left -1331 var third/eax: (addr cell) <- lookup *third-ah -1332 var third-type/ecx: (addr int) <- get third, type -1333 compare *third-type, 1/number -1334 { -1335 break-if-= -1336 error trace, "third arg for 'pixel' is not an int (y coordinate)" -1337 return -1338 } -1339 var third-value/eax: (addr float) <- get third, number-data -1340 var y/ebx: int <- convert *third-value -1341 # color = rest->right->left->value -1342 var rest-ah/eax: (addr handle cell) <- get rest, right -1343 var _rest/eax: (addr cell) <- lookup *rest-ah -1344 rest <- copy _rest -1345 # TODO: check that rest is a pair -1346 var fourth-ah/eax: (addr handle cell) <- get rest, left -1347 var fourth/eax: (addr cell) <- lookup *fourth-ah -1348 var fourth-type/ecx: (addr int) <- get fourth, type -1349 compare *fourth-type, 1/number -1350 { -1351 break-if-= -1352 error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)" -1353 return -1354 } -1355 var fourth-value/eax: (addr float) <- get fourth, number-data -1356 var color/eax: int <- convert *fourth-value -1357 pixel screen, x, y, color -1358 # return nothing -1359 } -1360 -1361 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1362 trace-text trace, "eval", "apply key" -1363 var args-ah/eax: (addr handle cell) <- copy _args-ah -1364 var _args/eax: (addr cell) <- lookup *args-ah -1365 var args/esi: (addr cell) <- copy _args -1366 # TODO: check that args is a pair -1367 var empty-args?/eax: boolean <- nil? args -1368 compare empty-args?, 0/false -1369 { -1370 break-if-= -1371 error trace, "key needs 1 arg but got 0" -1372 return -1373 } -1374 # keyboard = args->left -1375 var first-ah/eax: (addr handle cell) <- get args, left -1376 var first/eax: (addr cell) <- lookup *first-ah -1377 var first-type/ecx: (addr int) <- get first, type -1378 compare *first-type, 6/keyboard -1379 { +1296 var empty-args?/eax: boolean <- nil? args +1297 compare empty-args?, 0/false +1298 { +1299 break-if-= +1300 error trace, "'<=' needs 2 args but got 0" +1301 return +1302 } +1303 # args->left +1304 var first-ah/ecx: (addr handle cell) <- get args, left +1305 # args->right->left +1306 var right-ah/eax: (addr handle cell) <- get args, right +1307 var right/eax: (addr cell) <- lookup *right-ah +1308 { +1309 var right-type/ecx: (addr int) <- get right, type +1310 compare *right-type, 0/pair +1311 break-if-= +1312 error trace, "'<=' encountered non-pair" +1313 return +1314 } +1315 { +1316 var nil?/eax: boolean <- nil? right +1317 compare nil?, 0/false +1318 break-if-= +1319 error trace, "'<=' needs 2 args but got 1" +1320 return +1321 } +1322 var second-ah/edx: (addr handle cell) <- get right, left +1323 # compare +1324 var _first/eax: (addr cell) <- lookup *first-ah +1325 var first/ecx: (addr cell) <- copy _first +1326 var first-type/eax: (addr int) <- get first, type +1327 compare *first-type, 1/number +1328 { +1329 break-if-= +1330 error trace, "first arg for '<=' is not a number" +1331 return +1332 } +1333 var first-value/ecx: (addr float) <- get first, number-data +1334 var first-float/xmm0: float <- copy *first-value +1335 var second/eax: (addr cell) <- lookup *second-ah +1336 var second-type/edx: (addr int) <- get second, type +1337 compare *second-type, 1/number +1338 { +1339 break-if-= +1340 error trace, "second arg for '<=' is not a number" +1341 return +1342 } +1343 var second-value/eax: (addr float) <- get second, number-data +1344 compare first-float, *second-value +1345 { +1346 break-if-float<= +1347 nil out +1348 return +1349 } +1350 new-integer out, 1/true +1351 } +1352 +1353 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1354 trace-text trace, "eval", "apply '>='" +1355 var args-ah/eax: (addr handle cell) <- copy _args-ah +1356 var _args/eax: (addr cell) <- lookup *args-ah +1357 var args/esi: (addr cell) <- copy _args +1358 { +1359 var args-type/ecx: (addr int) <- get args, type +1360 compare *args-type, 0/pair +1361 break-if-= +1362 error trace, "args to '>=' are not a list" +1363 return +1364 } +1365 var empty-args?/eax: boolean <- nil? args +1366 compare empty-args?, 0/false +1367 { +1368 break-if-= +1369 error trace, "'>=' needs 2 args but got 0" +1370 return +1371 } +1372 # args->left +1373 var first-ah/ecx: (addr handle cell) <- get args, left +1374 # args->right->left +1375 var right-ah/eax: (addr handle cell) <- get args, right +1376 var right/eax: (addr cell) <- lookup *right-ah +1377 { +1378 var right-type/ecx: (addr int) <- get right, type +1379 compare *right-type, 0/pair 1380 break-if-= -1381 error trace, "first arg for 'key' is not a keyboard" +1381 error trace, "'>=' encountered non-pair" 1382 return 1383 } -1384 var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data -1385 var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah -1386 var keyboard/ecx: (addr gap-buffer) <- copy _keyboard -1387 var result/eax: int <- wait-for-key keyboard -1388 # return key typed -1389 new-integer out, result -1390 } -1391 -1392 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int { -1393 # if keyboard is 0, use real keyboard -1394 { -1395 compare keyboard, 0/real-keyboard -1396 break-if-!= -1397 var key/eax: byte <- read-key 0/real-keyboard -1398 var result/eax: int <- copy key -1399 return result -1400 } -1401 # otherwise read from fake keyboard -1402 var g/eax: grapheme <- read-from-gap-buffer keyboard -1403 var result/eax: int <- copy g -1404 return result -1405 } -1406 -1407 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1408 trace-text trace, "eval", "apply stream" -1409 allocate-stream out -1410 } -1411 -1412 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1413 trace-text trace, "eval", "apply write" -1414 var args-ah/eax: (addr handle cell) <- copy _args-ah -1415 var _args/eax: (addr cell) <- lookup *args-ah -1416 var args/esi: (addr cell) <- copy _args -1417 # TODO: check that args is a pair -1418 var empty-args?/eax: boolean <- nil? args -1419 compare empty-args?, 0/false -1420 { -1421 break-if-= -1422 error trace, "write needs 2 args but got 0" -1423 return -1424 } -1425 # stream = args->left -1426 var first-ah/edx: (addr handle cell) <- get args, left -1427 var first/eax: (addr cell) <- lookup *first-ah -1428 var first-type/ecx: (addr int) <- get first, type -1429 compare *first-type, 3/stream -1430 { -1431 break-if-= -1432 error trace, "first arg for 'write' is not a stream" -1433 return -1434 } -1435 var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data -1436 var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah -1437 var stream-data/ebx: (addr stream byte) <- copy _stream-data -1438 # args->right->left -1439 var right-ah/eax: (addr handle cell) <- get args, right -1440 var right/eax: (addr cell) <- lookup *right-ah -1441 # TODO: check that right is a pair -1442 var second-ah/eax: (addr handle cell) <- get right, left -1443 var second/eax: (addr cell) <- lookup *second-ah -1444 var second-type/ecx: (addr int) <- get second, type -1445 compare *second-type, 1/number +1384 { +1385 var nil?/eax: boolean <- nil? right +1386 compare nil?, 0/false +1387 break-if-= +1388 error trace, "'>=' needs 2 args but got 1" +1389 return +1390 } +1391 var second-ah/edx: (addr handle cell) <- get right, left +1392 # compare +1393 var _first/eax: (addr cell) <- lookup *first-ah +1394 var first/ecx: (addr cell) <- copy _first +1395 var first-type/eax: (addr int) <- get first, type +1396 compare *first-type, 1/number +1397 { +1398 break-if-= +1399 error trace, "first arg for '>=' is not a number" +1400 return +1401 } +1402 var first-value/ecx: (addr float) <- get first, number-data +1403 var first-float/xmm0: float <- copy *first-value +1404 var second/eax: (addr cell) <- lookup *second-ah +1405 var second-type/edx: (addr int) <- get second, type +1406 compare *second-type, 1/number +1407 { +1408 break-if-= +1409 error trace, "second arg for '>=' is not a number" +1410 return +1411 } +1412 var second-value/eax: (addr float) <- get second, number-data +1413 compare first-float, *second-value +1414 { +1415 break-if-float>= +1416 nil out +1417 return +1418 } +1419 new-integer out, 1/true +1420 } +1421 +1422 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1423 trace-text trace, "eval", "apply 'print'" +1424 var args-ah/eax: (addr handle cell) <- copy _args-ah +1425 var _args/eax: (addr cell) <- lookup *args-ah +1426 var args/esi: (addr cell) <- copy _args +1427 { +1428 var args-type/ecx: (addr int) <- get args, type +1429 compare *args-type, 0/pair +1430 break-if-= +1431 error trace, "args to 'print' are not a list" +1432 return +1433 } +1434 var empty-args?/eax: boolean <- nil? args +1435 compare empty-args?, 0/false +1436 { +1437 break-if-= +1438 error trace, "'print' needs 2 args but got 0" +1439 return +1440 } +1441 # screen = args->left +1442 var first-ah/eax: (addr handle cell) <- get args, left +1443 var first/eax: (addr cell) <- lookup *first-ah +1444 var first-type/ecx: (addr int) <- get first, type +1445 compare *first-type, 5/screen 1446 { 1447 break-if-= -1448 error trace, "second arg for stream is not a number/grapheme" +1448 error trace, "first arg for 'print' is not a screen" 1449 return 1450 } -1451 var second-value/eax: (addr float) <- get second, number-data -1452 var x-float/xmm0: float <- copy *second-value -1453 var x/eax: int <- convert x-float -1454 var x-grapheme/eax: grapheme <- copy x -1455 write-grapheme stream-data, x-grapheme -1456 # return the stream -1457 copy-object first-ah, out -1458 } -1459 -1460 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1461 trace-text trace, "eval", "apply lines" -1462 var args-ah/eax: (addr handle cell) <- copy _args-ah -1463 var _args/eax: (addr cell) <- lookup *args-ah -1464 var args/esi: (addr cell) <- copy _args -1465 # TODO: check that args is a pair -1466 var empty-args?/eax: boolean <- nil? args -1467 compare empty-args?, 0/false -1468 { -1469 break-if-= -1470 error trace, "lines needs 1 arg but got 0" -1471 return -1472 } -1473 # screen = args->left -1474 var first-ah/eax: (addr handle cell) <- get args, left -1475 var first/eax: (addr cell) <- lookup *first-ah -1476 var first-type/ecx: (addr int) <- get first, type -1477 compare *first-type, 5/screen -1478 { -1479 break-if-= -1480 error trace, "first arg for 'lines' is not a screen" -1481 return -1482 } -1483 var screen-ah/eax: (addr handle screen) <- get first, screen-data -1484 var _screen/eax: (addr screen) <- lookup *screen-ah -1485 var screen/edx: (addr screen) <- copy _screen -1486 # compute dimensions -1487 var dummy/eax: int <- copy 0 -1488 var height/ecx: int <- copy 0 -1489 dummy, height <- screen-size screen -1490 var result/xmm0: float <- convert height -1491 new-float out, result -1492 } -1493 -1494 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1495 abort "aa" -1496 } -1497 -1498 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1499 trace-text trace, "eval", "apply columns" -1500 var args-ah/eax: (addr handle cell) <- copy _args-ah -1501 var _args/eax: (addr cell) <- lookup *args-ah -1502 var args/esi: (addr cell) <- copy _args -1503 # TODO: check that args is a pair -1504 var empty-args?/eax: boolean <- nil? args -1505 compare empty-args?, 0/false -1506 { -1507 break-if-= -1508 error trace, "columns needs 1 arg but got 0" -1509 return -1510 } -1511 # screen = args->left -1512 var first-ah/eax: (addr handle cell) <- get args, left -1513 var first/eax: (addr cell) <- lookup *first-ah -1514 var first-type/ecx: (addr int) <- get first, type -1515 compare *first-type, 5/screen -1516 { -1517 break-if-= -1518 error trace, "first arg for 'columns' is not a screen" -1519 return -1520 } -1521 var screen-ah/eax: (addr handle screen) <- get first, screen-data -1522 var _screen/eax: (addr screen) <- lookup *screen-ah -1523 var screen/edx: (addr screen) <- copy _screen -1524 # compute dimensions -1525 var width/eax: int <- copy 0 -1526 var dummy/ecx: int <- copy 0 -1527 width, dummy <- screen-size screen -1528 var result/xmm0: float <- convert width -1529 new-float out, result -1530 } -1531 -1532 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1533 trace-text trace, "eval", "apply width" -1534 var args-ah/eax: (addr handle cell) <- copy _args-ah -1535 var _args/eax: (addr cell) <- lookup *args-ah -1536 var args/esi: (addr cell) <- copy _args -1537 # TODO: check that args is a pair -1538 var empty-args?/eax: boolean <- nil? args -1539 compare empty-args?, 0/false +1451 var screen-ah/eax: (addr handle screen) <- get first, screen-data +1452 var _screen/eax: (addr screen) <- lookup *screen-ah +1453 var screen/ecx: (addr screen) <- copy _screen +1454 # args->right->left +1455 var right-ah/eax: (addr handle cell) <- get args, right +1456 var right/eax: (addr cell) <- lookup *right-ah +1457 { +1458 var right-type/ecx: (addr int) <- get right, type +1459 compare *right-type, 0/pair +1460 break-if-= +1461 error trace, "'print' encountered non-pair" +1462 return +1463 } +1464 { +1465 var nil?/eax: boolean <- nil? right +1466 compare nil?, 0/false +1467 break-if-= +1468 error trace, "'print' needs 2 args but got 1" +1469 return +1470 } +1471 var second-ah/eax: (addr handle cell) <- get right, left +1472 var stream-storage: (stream byte 0x100) +1473 var stream/edi: (addr stream byte) <- address stream-storage +1474 print-cell second-ah, stream, trace +1475 draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg +1476 # return what was printed +1477 copy-object second-ah, out +1478 } +1479 +1480 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1481 trace-text trace, "eval", "apply 'clear'" +1482 var args-ah/eax: (addr handle cell) <- copy _args-ah +1483 var _args/eax: (addr cell) <- lookup *args-ah +1484 var args/esi: (addr cell) <- copy _args +1485 { +1486 var args-type/ecx: (addr int) <- get args, type +1487 compare *args-type, 0/pair +1488 break-if-= +1489 error trace, "args to 'clear' are not a list" +1490 return +1491 } +1492 var empty-args?/eax: boolean <- nil? args +1493 compare empty-args?, 0/false +1494 { +1495 break-if-= +1496 error trace, "'clear' needs 1 arg but got 0" +1497 return +1498 } +1499 # screen = args->left +1500 var first-ah/eax: (addr handle cell) <- get args, left +1501 var first/eax: (addr cell) <- lookup *first-ah +1502 var first-type/ecx: (addr int) <- get first, type +1503 compare *first-type, 5/screen +1504 { +1505 break-if-= +1506 error trace, "first arg for 'clear' is not a screen" +1507 return +1508 } +1509 var screen-ah/eax: (addr handle screen) <- get first, screen-data +1510 var _screen/eax: (addr screen) <- lookup *screen-ah +1511 var screen/ecx: (addr screen) <- copy _screen +1512 # +1513 clear-screen screen +1514 } +1515 +1516 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1517 trace-text trace, "eval", "apply 'up'" +1518 var args-ah/eax: (addr handle cell) <- copy _args-ah +1519 var _args/eax: (addr cell) <- lookup *args-ah +1520 var args/esi: (addr cell) <- copy _args +1521 { +1522 var args-type/ecx: (addr int) <- get args, type +1523 compare *args-type, 0/pair +1524 break-if-= +1525 error trace, "args to 'up' are not a list" +1526 return +1527 } +1528 var empty-args?/eax: boolean <- nil? args +1529 compare empty-args?, 0/false +1530 { +1531 break-if-= +1532 error trace, "'up' needs 1 arg but got 0" +1533 return +1534 } +1535 # screen = args->left +1536 var first-ah/eax: (addr handle cell) <- get args, left +1537 var first/eax: (addr cell) <- lookup *first-ah +1538 var first-type/ecx: (addr int) <- get first, type +1539 compare *first-type, 5/screen 1540 { 1541 break-if-= -1542 error trace, "width needs 1 arg but got 0" +1542 error trace, "first arg for 'up' is not a screen" 1543 return 1544 } -1545 # screen = args->left -1546 var first-ah/eax: (addr handle cell) <- get args, left -1547 var first/eax: (addr cell) <- lookup *first-ah -1548 var first-type/ecx: (addr int) <- get first, type -1549 compare *first-type, 5/screen -1550 { -1551 break-if-= -1552 error trace, "first arg for 'width' is not a screen" -1553 return -1554 } -1555 var screen-ah/eax: (addr handle screen) <- get first, screen-data -1556 var _screen/eax: (addr screen) <- lookup *screen-ah -1557 var screen/edx: (addr screen) <- copy _screen -1558 # compute dimensions -1559 var width/eax: int <- copy 0 -1560 var dummy/ecx: int <- copy 0 -1561 width, dummy <- screen-size screen -1562 width <- shift-left 3/log2-font-width -1563 var result/xmm0: float <- convert width -1564 new-float out, result -1565 } -1566 -1567 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { -1568 trace-text trace, "eval", "apply height" -1569 var args-ah/eax: (addr handle cell) <- copy _args-ah -1570 var _args/eax: (addr cell) <- lookup *args-ah -1571 var args/esi: (addr cell) <- copy _args -1572 # TODO: check that args is a pair -1573 var empty-args?/eax: boolean <- nil? args -1574 compare empty-args?, 0/false -1575 { -1576 break-if-= -1577 error trace, "height needs 1 arg but got 0" -1578 return -1579 } -1580 # screen = args->left -1581 var first-ah/eax: (addr handle cell) <- get args, left -1582 var first/eax: (addr cell) <- lookup *first-ah -1583 var first-type/ecx: (addr int) <- get first, type -1584 compare *first-type, 5/screen -1585 { -1586 break-if-= -1587 error trace, "first arg for 'height' is not a screen" -1588 return -1589 } -1590 var screen-ah/eax: (addr handle screen) <- get first, screen-data -1591 var _screen/eax: (addr screen) <- lookup *screen-ah -1592 var screen/edx: (addr screen) <- copy _screen -1593 # compute dimensions -1594 var dummy/eax: int <- copy 0 -1595 var height/ecx: int <- copy 0 -1596 dummy, height <- screen-size screen -1597 height <- shift-left 4/log2-font-height -1598 var result/xmm0: float <- convert height -1599 new-float out, result -1600 } +1545 var screen-ah/eax: (addr handle screen) <- get first, screen-data +1546 var _screen/eax: (addr screen) <- lookup *screen-ah +1547 var screen/ecx: (addr screen) <- copy _screen +1548 # +1549 move-cursor-up screen +1550 } +1551 +1552 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1553 trace-text trace, "eval", "apply 'down'" +1554 var args-ah/eax: (addr handle cell) <- copy _args-ah +1555 var _args/eax: (addr cell) <- lookup *args-ah +1556 var args/esi: (addr cell) <- copy _args +1557 { +1558 var args-type/ecx: (addr int) <- get args, type +1559 compare *args-type, 0/pair +1560 break-if-= +1561 error trace, "args to 'down' are not a list" +1562 return +1563 } +1564 var empty-args?/eax: boolean <- nil? args +1565 compare empty-args?, 0/false +1566 { +1567 break-if-= +1568 error trace, "'down' needs 1 arg but got 0" +1569 return +1570 } +1571 # screen = args->left +1572 var first-ah/eax: (addr handle cell) <- get args, left +1573 var first/eax: (addr cell) <- lookup *first-ah +1574 var first-type/ecx: (addr int) <- get first, type +1575 compare *first-type, 5/screen +1576 { +1577 break-if-= +1578 error trace, "first arg for 'down' is not a screen" +1579 return +1580 } +1581 var screen-ah/eax: (addr handle screen) <- get first, screen-data +1582 var _screen/eax: (addr screen) <- lookup *screen-ah +1583 var screen/ecx: (addr screen) <- copy _screen +1584 # +1585 move-cursor-down screen +1586 } +1587 +1588 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1589 trace-text trace, "eval", "apply 'left'" +1590 var args-ah/eax: (addr handle cell) <- copy _args-ah +1591 var _args/eax: (addr cell) <- lookup *args-ah +1592 var args/esi: (addr cell) <- copy _args +1593 { +1594 var args-type/ecx: (addr int) <- get args, type +1595 compare *args-type, 0/pair +1596 break-if-= +1597 error trace, "args to 'left' are not a list" +1598 return +1599 } +1600 var empty-args?/eax: boolean <- nil? args +1601 compare empty-args?, 0/false +1602 { +1603 break-if-= +1604 error trace, "'left' needs 1 arg but got 0" +1605 return +1606 } +1607 # screen = args->left +1608 var first-ah/eax: (addr handle cell) <- get args, left +1609 var first/eax: (addr cell) <- lookup *first-ah +1610 var first-type/ecx: (addr int) <- get first, type +1611 compare *first-type, 5/screen +1612 { +1613 break-if-= +1614 error trace, "first arg for 'left' is not a screen" +1615 return +1616 } +1617 var screen-ah/eax: (addr handle screen) <- get first, screen-data +1618 var _screen/eax: (addr screen) <- lookup *screen-ah +1619 var screen/ecx: (addr screen) <- copy _screen +1620 # +1621 move-cursor-left screen +1622 } +1623 +1624 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1625 trace-text trace, "eval", "apply 'right'" +1626 var args-ah/eax: (addr handle cell) <- copy _args-ah +1627 var _args/eax: (addr cell) <- lookup *args-ah +1628 var args/esi: (addr cell) <- copy _args +1629 { +1630 var args-type/ecx: (addr int) <- get args, type +1631 compare *args-type, 0/pair +1632 break-if-= +1633 error trace, "args to 'right' are not a list" +1634 return +1635 } +1636 var empty-args?/eax: boolean <- nil? args +1637 compare empty-args?, 0/false +1638 { +1639 break-if-= +1640 error trace, "'right' needs 1 arg but got 0" +1641 return +1642 } +1643 # screen = args->left +1644 var first-ah/eax: (addr handle cell) <- get args, left +1645 var first/eax: (addr cell) <- lookup *first-ah +1646 var first-type/ecx: (addr int) <- get first, type +1647 compare *first-type, 5/screen +1648 { +1649 break-if-= +1650 error trace, "first arg for 'right' is not a screen" +1651 return +1652 } +1653 var screen-ah/eax: (addr handle screen) <- get first, screen-data +1654 var _screen/eax: (addr screen) <- lookup *screen-ah +1655 var screen/ecx: (addr screen) <- copy _screen +1656 # +1657 move-cursor-right screen +1658 } +1659 +1660 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1661 trace-text trace, "eval", "apply 'cr'" +1662 var args-ah/eax: (addr handle cell) <- copy _args-ah +1663 var _args/eax: (addr cell) <- lookup *args-ah +1664 var args/esi: (addr cell) <- copy _args +1665 { +1666 var args-type/ecx: (addr int) <- get args, type +1667 compare *args-type, 0/pair +1668 break-if-= +1669 error trace, "args to 'cr' are not a list" +1670 return +1671 } +1672 var empty-args?/eax: boolean <- nil? args +1673 compare empty-args?, 0/false +1674 { +1675 break-if-= +1676 error trace, "'cr' needs 1 arg but got 0" +1677 return +1678 } +1679 # screen = args->left +1680 var first-ah/eax: (addr handle cell) <- get args, left +1681 var first/eax: (addr cell) <- lookup *first-ah +1682 var first-type/ecx: (addr int) <- get first, type +1683 compare *first-type, 5/screen +1684 { +1685 break-if-= +1686 error trace, "first arg for 'cr' is not a screen" +1687 return +1688 } +1689 var screen-ah/eax: (addr handle screen) <- get first, screen-data +1690 var _screen/eax: (addr screen) <- lookup *screen-ah +1691 var screen/ecx: (addr screen) <- copy _screen +1692 # +1693 move-cursor-to-left-margin-of-next-line screen +1694 } +1695 +1696 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1697 trace-text trace, "eval", "apply 'pixel'" +1698 var args-ah/eax: (addr handle cell) <- copy _args-ah +1699 var _args/eax: (addr cell) <- lookup *args-ah +1700 var args/esi: (addr cell) <- copy _args +1701 { +1702 var args-type/ecx: (addr int) <- get args, type +1703 compare *args-type, 0/pair +1704 break-if-= +1705 error trace, "args to 'pixel' are not a list" +1706 return +1707 } +1708 var empty-args?/eax: boolean <- nil? args +1709 compare empty-args?, 0/false +1710 { +1711 break-if-= +1712 error trace, "'pixel' needs 4 args but got 0" +1713 return +1714 } +1715 # screen = args->left +1716 var first-ah/eax: (addr handle cell) <- get args, left +1717 var first/eax: (addr cell) <- lookup *first-ah +1718 var first-type/ecx: (addr int) <- get first, type +1719 compare *first-type, 5/screen +1720 { +1721 break-if-= +1722 error trace, "first arg for 'pixel' is not a screen" +1723 return +1724 } +1725 var screen-ah/eax: (addr handle screen) <- get first, screen-data +1726 var _screen/eax: (addr screen) <- lookup *screen-ah +1727 var screen/edi: (addr screen) <- copy _screen +1728 # x = args->right->left->value +1729 var rest-ah/eax: (addr handle cell) <- get args, right +1730 var _rest/eax: (addr cell) <- lookup *rest-ah +1731 var rest/esi: (addr cell) <- copy _rest +1732 { +1733 var rest-type/ecx: (addr int) <- get rest, type +1734 compare *rest-type, 0/pair +1735 break-if-= +1736 error trace, "'pixel' encountered non-pair" +1737 return +1738 } +1739 { +1740 var rest-nil?/eax: boolean <- nil? rest +1741 compare rest-nil?, 0/false +1742 break-if-= +1743 error trace, "'pixel' needs 4 args but got 1" +1744 return +1745 } +1746 var second-ah/eax: (addr handle cell) <- get rest, left +1747 var second/eax: (addr cell) <- lookup *second-ah +1748 var second-type/ecx: (addr int) <- get second, type +1749 compare *second-type, 1/number +1750 { +1751 break-if-= +1752 error trace, "second arg for 'pixel' is not an int (x coordinate)" +1753 return +1754 } +1755 var second-value/eax: (addr float) <- get second, number-data +1756 var x/edx: int <- convert *second-value +1757 # y = rest->right->left->value +1758 var rest-ah/eax: (addr handle cell) <- get rest, right +1759 var _rest/eax: (addr cell) <- lookup *rest-ah +1760 rest <- copy _rest +1761 { +1762 var rest-type/ecx: (addr int) <- get rest, type +1763 compare *rest-type, 0/pair +1764 break-if-= +1765 error trace, "'pixel' encountered non-pair" +1766 return +1767 } +1768 { +1769 var rest-nil?/eax: boolean <- nil? rest +1770 compare rest-nil?, 0/false +1771 break-if-= +1772 error trace, "'pixel' needs 4 args but got 2" +1773 return +1774 } +1775 var third-ah/eax: (addr handle cell) <- get rest, left +1776 var third/eax: (addr cell) <- lookup *third-ah +1777 var third-type/ecx: (addr int) <- get third, type +1778 compare *third-type, 1/number +1779 { +1780 break-if-= +1781 error trace, "third arg for 'pixel' is not an int (y coordinate)" +1782 return +1783 } +1784 var third-value/eax: (addr float) <- get third, number-data +1785 var y/ebx: int <- convert *third-value +1786 # color = rest->right->left->value +1787 var rest-ah/eax: (addr handle cell) <- get rest, right +1788 var _rest/eax: (addr cell) <- lookup *rest-ah +1789 rest <- copy _rest +1790 { +1791 var rest-type/ecx: (addr int) <- get rest, type +1792 compare *rest-type, 0/pair +1793 break-if-= +1794 error trace, "'pixel' encountered non-pair" +1795 return +1796 } +1797 { +1798 var rest-nil?/eax: boolean <- nil? rest +1799 compare rest-nil?, 0/false +1800 break-if-= +1801 error trace, "'pixel' needs 4 args but got 3" +1802 return +1803 } +1804 var fourth-ah/eax: (addr handle cell) <- get rest, left +1805 var fourth/eax: (addr cell) <- lookup *fourth-ah +1806 var fourth-type/ecx: (addr int) <- get fourth, type +1807 compare *fourth-type, 1/number +1808 { +1809 break-if-= +1810 error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)" +1811 return +1812 } +1813 var fourth-value/eax: (addr float) <- get fourth, number-data +1814 var color/eax: int <- convert *fourth-value +1815 pixel screen, x, y, color +1816 # return nothing +1817 } +1818 +1819 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1820 trace-text trace, "eval", "apply 'key'" +1821 var args-ah/eax: (addr handle cell) <- copy _args-ah +1822 var _args/eax: (addr cell) <- lookup *args-ah +1823 var args/esi: (addr cell) <- copy _args +1824 { +1825 var args-type/ecx: (addr int) <- get args, type +1826 compare *args-type, 0/pair +1827 break-if-= +1828 error trace, "args to 'key' are not a list" +1829 return +1830 } +1831 var empty-args?/eax: boolean <- nil? args +1832 compare empty-args?, 0/false +1833 { +1834 break-if-= +1835 error trace, "'key' needs 1 arg but got 0" +1836 return +1837 } +1838 # keyboard = args->left +1839 var first-ah/eax: (addr handle cell) <- get args, left +1840 var first/eax: (addr cell) <- lookup *first-ah +1841 var first-type/ecx: (addr int) <- get first, type +1842 compare *first-type, 6/keyboard +1843 { +1844 break-if-= +1845 error trace, "first arg for 'key' is not a keyboard" +1846 return +1847 } +1848 var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data +1849 var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah +1850 var keyboard/ecx: (addr gap-buffer) <- copy _keyboard +1851 var result/eax: int <- wait-for-key keyboard +1852 # return key typed +1853 new-integer out, result +1854 } +1855 +1856 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int { +1857 # if keyboard is 0, use real keyboard +1858 { +1859 compare keyboard, 0/real-keyboard +1860 break-if-!= +1861 var key/eax: byte <- read-key 0/real-keyboard +1862 var result/eax: int <- copy key +1863 return result +1864 } +1865 # otherwise read from fake keyboard +1866 var g/eax: grapheme <- read-from-gap-buffer keyboard +1867 var result/eax: int <- copy g +1868 return result +1869 } +1870 +1871 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1872 trace-text trace, "eval", "apply stream" +1873 allocate-stream out +1874 } +1875 +1876 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1877 trace-text trace, "eval", "apply 'write'" +1878 var args-ah/eax: (addr handle cell) <- copy _args-ah +1879 var _args/eax: (addr cell) <- lookup *args-ah +1880 var args/esi: (addr cell) <- copy _args +1881 { +1882 var args-type/ecx: (addr int) <- get args, type +1883 compare *args-type, 0/pair +1884 break-if-= +1885 error trace, "args to 'write' are not a list" +1886 return +1887 } +1888 var empty-args?/eax: boolean <- nil? args +1889 compare empty-args?, 0/false +1890 { +1891 break-if-= +1892 error trace, "'write' needs 2 args but got 0" +1893 return +1894 } +1895 # stream = args->left +1896 var first-ah/edx: (addr handle cell) <- get args, left +1897 var first/eax: (addr cell) <- lookup *first-ah +1898 var first-type/ecx: (addr int) <- get first, type +1899 compare *first-type, 3/stream +1900 { +1901 break-if-= +1902 error trace, "first arg for 'write' is not a stream" +1903 return +1904 } +1905 var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data +1906 var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah +1907 var stream-data/ebx: (addr stream byte) <- copy _stream-data +1908 # args->right->left +1909 var right-ah/eax: (addr handle cell) <- get args, right +1910 var right/eax: (addr cell) <- lookup *right-ah +1911 { +1912 var right-type/ecx: (addr int) <- get right, type +1913 compare *right-type, 0/pair +1914 break-if-= +1915 error trace, "'write' encountered non-pair" +1916 return +1917 } +1918 { +1919 var nil?/eax: boolean <- nil? right +1920 compare nil?, 0/false +1921 break-if-= +1922 error trace, "'write' needs 2 args but got 1" +1923 return +1924 } +1925 var second-ah/eax: (addr handle cell) <- get right, left +1926 var second/eax: (addr cell) <- lookup *second-ah +1927 var second-type/ecx: (addr int) <- get second, type +1928 compare *second-type, 1/number +1929 { +1930 break-if-= +1931 error trace, "second arg for 'write' is not a number/grapheme" +1932 return +1933 } +1934 var second-value/eax: (addr float) <- get second, number-data +1935 var x-float/xmm0: float <- copy *second-value +1936 var x/eax: int <- convert x-float +1937 var x-grapheme/eax: grapheme <- copy x +1938 write-grapheme stream-data, x-grapheme +1939 # return the stream +1940 copy-object first-ah, out +1941 } +1942 +1943 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1944 trace-text trace, "eval", "apply 'lines'" +1945 var args-ah/eax: (addr handle cell) <- copy _args-ah +1946 var _args/eax: (addr cell) <- lookup *args-ah +1947 var args/esi: (addr cell) <- copy _args +1948 { +1949 var args-type/ecx: (addr int) <- get args, type +1950 compare *args-type, 0/pair +1951 break-if-= +1952 error trace, "args to 'lines' are not a list" +1953 return +1954 } +1955 var empty-args?/eax: boolean <- nil? args +1956 compare empty-args?, 0/false +1957 { +1958 break-if-= +1959 error trace, "'lines' needs 1 arg but got 0" +1960 return +1961 } +1962 # screen = args->left +1963 var first-ah/eax: (addr handle cell) <- get args, left +1964 var first/eax: (addr cell) <- lookup *first-ah +1965 var first-type/ecx: (addr int) <- get first, type +1966 compare *first-type, 5/screen +1967 { +1968 break-if-= +1969 error trace, "first arg for 'lines' is not a screen" +1970 return +1971 } +1972 var screen-ah/eax: (addr handle screen) <- get first, screen-data +1973 var _screen/eax: (addr screen) <- lookup *screen-ah +1974 var screen/edx: (addr screen) <- copy _screen +1975 # compute dimensions +1976 var dummy/eax: int <- copy 0 +1977 var height/ecx: int <- copy 0 +1978 dummy, height <- screen-size screen +1979 var result/xmm0: float <- convert height +1980 new-float out, result +1981 } +1982 +1983 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1984 abort "aa" +1985 } +1986 +1987 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +1988 trace-text trace, "eval", "apply 'columns'" +1989 var args-ah/eax: (addr handle cell) <- copy _args-ah +1990 var _args/eax: (addr cell) <- lookup *args-ah +1991 var args/esi: (addr cell) <- copy _args +1992 { +1993 var args-type/ecx: (addr int) <- get args, type +1994 compare *args-type, 0/pair +1995 break-if-= +1996 error trace, "args to 'columns' are not a list" +1997 return +1998 } +1999 var empty-args?/eax: boolean <- nil? args +2000 compare empty-args?, 0/false +2001 { +2002 break-if-= +2003 error trace, "'columns' needs 1 arg but got 0" +2004 return +2005 } +2006 # screen = args->left +2007 var first-ah/eax: (addr handle cell) <- get args, left +2008 var first/eax: (addr cell) <- lookup *first-ah +2009 var first-type/ecx: (addr int) <- get first, type +2010 compare *first-type, 5/screen +2011 { +2012 break-if-= +2013 error trace, "first arg for 'columns' is not a screen" +2014 return +2015 } +2016 var screen-ah/eax: (addr handle screen) <- get first, screen-data +2017 var _screen/eax: (addr screen) <- lookup *screen-ah +2018 var screen/edx: (addr screen) <- copy _screen +2019 # compute dimensions +2020 var width/eax: int <- copy 0 +2021 var dummy/ecx: int <- copy 0 +2022 width, dummy <- screen-size screen +2023 var result/xmm0: float <- convert width +2024 new-float out, result +2025 } +2026 +2027 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +2028 trace-text trace, "eval", "apply 'width'" +2029 var args-ah/eax: (addr handle cell) <- copy _args-ah +2030 var _args/eax: (addr cell) <- lookup *args-ah +2031 var args/esi: (addr cell) <- copy _args +2032 { +2033 var args-type/ecx: (addr int) <- get args, type +2034 compare *args-type, 0/pair +2035 break-if-= +2036 error trace, "args to 'width' are not a list" +2037 return +2038 } +2039 var empty-args?/eax: boolean <- nil? args +2040 compare empty-args?, 0/false +2041 { +2042 break-if-= +2043 error trace, "'width' needs 1 arg but got 0" +2044 return +2045 } +2046 # screen = args->left +2047 var first-ah/eax: (addr handle cell) <- get args, left +2048 var first/eax: (addr cell) <- lookup *first-ah +2049 var first-type/ecx: (addr int) <- get first, type +2050 compare *first-type, 5/screen +2051 { +2052 break-if-= +2053 error trace, "first arg for 'width' is not a screen" +2054 return +2055 } +2056 var screen-ah/eax: (addr handle screen) <- get first, screen-data +2057 var _screen/eax: (addr screen) <- lookup *screen-ah +2058 var screen/edx: (addr screen) <- copy _screen +2059 # compute dimensions +2060 var width/eax: int <- copy 0 +2061 var dummy/ecx: int <- copy 0 +2062 width, dummy <- screen-size screen +2063 width <- shift-left 3/log2-font-width +2064 var result/xmm0: float <- convert width +2065 new-float out, result +2066 } +2067 +2068 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { +2069 trace-text trace, "eval", "apply 'height'" +2070 var args-ah/eax: (addr handle cell) <- copy _args-ah +2071 var _args/eax: (addr cell) <- lookup *args-ah +2072 var args/esi: (addr cell) <- copy _args +2073 { +2074 var args-type/ecx: (addr int) <- get args, type +2075 compare *args-type, 0/pair +2076 break-if-= +2077 error trace, "args to 'height' are not a list" +2078 return +2079 } +2080 var empty-args?/eax: boolean <- nil? args +2081 compare empty-args?, 0/false +2082 { +2083 break-if-= +2084 error trace, "'height' needs 1 arg but got 0" +2085 return +2086 } +2087 # screen = args->left +2088 var first-ah/eax: (addr handle cell) <- get args, left +2089 var first/eax: (addr cell) <- lookup *first-ah +2090 var first-type/ecx: (addr int) <- get first, type +2091 compare *first-type, 5/screen +2092 { +2093 break-if-= +2094 error trace, "first arg for 'height' is not a screen" +2095 return +2096 } +2097 var screen-ah/eax: (addr handle screen) <- get first, screen-data +2098 var _screen/eax: (addr screen) <- lookup *screen-ah +2099 var screen/edx: (addr screen) <- copy _screen +2100 # compute dimensions +2101 var dummy/eax: int <- copy 0 +2102 var height/ecx: int <- copy 0 +2103 dummy, height <- screen-size screen +2104 height <- shift-left 4/log2-font-height +2105 var result/xmm0: float <- convert height +2106 new-float out, result +2107 } -- cgit 1.4.1-2-gfad0