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