From f0e146fc7b947bae526657d8c858a95319abf204 Mon Sep 17 00:00:00 2001 From: Kartik Agaram Date: Sat, 1 May 2021 23:52:28 -0700 Subject: . --- html/120allocate.subx.html | 4 +- html/315stack-debug.subx.html | 2 +- html/316colors.subx.html | 390 ++++ html/400.mu.html | 185 +- html/505colors.mu.html | 297 +++ html/boot.subx.html | 10 +- html/colors.mu.html | 298 +++ html/mu-init.subx.html | 42 +- html/rpn.mu.html | 251 ++- html/shell/cell.mu.html | 302 +-- html/shell/evaluate.mu.html | 2158 +++++++++++----------- html/shell/gap-buffer.mu.html | 2265 ++++++++++++----------- html/shell/global.mu.html | 3685 +++++++++++++++++++------------------ html/shell/grapheme-stack.mu.html | 914 ++++----- html/shell/main.mu.html | 283 +-- html/shell/parse.mu.html | 141 +- html/shell/print.mu.html | 50 +- html/shell/sandbox.mu.html | 1896 +++++++++---------- html/shell/tokenize.mu.html | 1378 ++++++++------ html/shell/trace.mu.html | 38 +- 20 files changed, 7949 insertions(+), 6640 deletions(-) create mode 100644 html/316colors.subx.html create mode 100644 html/505colors.mu.html create mode 100644 html/colors.mu.html (limited to 'html') diff --git a/html/120allocate.subx.html b/html/120allocate.subx.html index 7f280d61..cd7568b7 100644 --- a/html/120allocate.subx.html +++ b/html/120allocate.subx.html @@ -87,9 +87,9 @@ if ('onhashchange' in window) { 26 # A default allocation descriptor for programs to use. 27 Heap: # allocation-descriptor 28 # curr - 29 0x01000000/imm32 # 16 MB + 29 0x02000000/imm32 # 32 MB 30 # limit - 31 0x02000000/imm32 # 32 MB + 31 0x80000000/imm32 # 2 GB 32 33 Next-alloc-id: # int 34 0x100/imm32 # save a few alloc ids for fake handles diff --git a/html/315stack-debug.subx.html b/html/315stack-debug.subx.html index ead6ca23..c2155ae5 100644 --- a/html/315stack-debug.subx.html +++ b/html/315stack-debug.subx.html @@ -68,7 +68,7 @@ if ('onhashchange' in window) { 10 50/push-eax 11 # 12 89/<- %eax 4/r32/esp - 13 81 7/subop/compare %eax 0x48600/imm32 + 13 81 7/subop/compare %eax 0x01000000/imm32 14 { 15 7f/jump-if-> break/disp8 16 (abort "stack overflow") diff --git a/html/316colors.subx.html b/html/316colors.subx.html new file mode 100644 index 00000000..6c62b26c --- /dev/null +++ b/html/316colors.subx.html @@ -0,0 +1,390 @@ + + + + +Mu - 316colors.subx + + + + + + + + + + +https://github.com/akkartik/mu/blob/main/316colors.subx +
+  1 # Some information about the default palette of 256 colors provided by the
+  2 # BIOS on x86 computers.
+  3 
+  4 == code
+  5 
+  6 # Return the r/g/b for color [0, 256) in ecx/edx/ebx respectively.
+  7 color-rgb:  # color: int -> _/ecx: int, _/edx: int, _/ebx: int
+  8     # . prologue
+  9     55/push-ebp
+ 10     89/<- %ebp 4/r32/esp
+ 11     # . save registers
+ 12     50/push-eax
+ 13     56/push-esi
+ 14     # esi = color
+ 15     8b/-> *(ebp+8) 6/r32/esi
+ 16     #
+ 17     81 7/subop/compare %esi 0x100/imm32
+ 18     {
+ 19       7c/jump-if-< break/disp8
+ 20       (abort "invalid color")
+ 21     }
+ 22     # var color/esi: int = Colors-rgb[color]
+ 23     b8/copy-to-eax Colors-rgb/imm32
+ 24     8b/-> *(eax+esi<<2+4) 6/r32/esi
+ 25     # var red/ecx: int = color & 0xff
+ 26     89/<- %eax 6/r32/esi
+ 27     25/and-eax-with 0xff/imm32
+ 28     89/<- %ecx 0/r32/eax
+ 29     # var green/edx: int = (color >> 8) & 0xff
+ 30     89/<- %eax 6/r32/esi
+ 31     c1 5/subop/shift-right-logical %eax 8/imm8
+ 32     25/and-eax-with 0xff/imm32
+ 33     89/<- %edx 0/r32/eax
+ 34     # var blue/ebx: int = (color >> 16)
+ 35     89/<- %eax 6/r32/esi
+ 36     c1 5/subop/shift-right-logical %eax 0x10/imm8
+ 37     89/<- %ebx 0/r32/eax
+ 38 $colors-rgb:end:
+ 39     # . restore registers
+ 40     5e/pop-to-esi
+ 41     58/pop-to-eax
+ 42     # . epilogue
+ 43     89/<- %esp 5/r32/ebp
+ 44     5d/pop-to-ebp
+ 45     c3/return
+ 46 
+ 47 test-color-rgb:
+ 48     # . prologue
+ 49     55/push-ebp
+ 50     89/<- %ebp 4/r32/esp
+ 51     #
+ 52     (color-rgb 0x10)  # => eax ecx edx
+ 53     (check-ints-equal %ecx 0 "F - test-color-rgb/0x10/r")
+ 54     (check-ints-equal %edx 0 "F - test-color-rgb/0x10/g")
+ 55     (check-ints-equal %ebx 0 "F - test-color-rgb/0x10/b")
+ 56     (color-rgb 1)  # => eax ecx edx
+ 57     (check-ints-equal %ecx 0 "F - test-color-rgb/1/r")
+ 58     (check-ints-equal %edx 0 "F - test-color-rgb/1/g")
+ 59     (check-ints-equal %ebx 0xaa "F - test-color-rgb/1/b")
+ 60     (color-rgb 0xf)  # => eax ecx edx
+ 61     (check-ints-equal %ecx 0xff "F - test-color-rgb/0xf/r")
+ 62     (check-ints-equal %edx 0xff "F - test-color-rgb/0xf/g")
+ 63     (check-ints-equal %ebx 0xff "F - test-color-rgb/0xf/b")
+ 64     # . epilogue
+ 65     89/<- %esp 5/r32/ebp
+ 66     5d/pop-to-ebp
+ 67     c3/return
+ 68 
+ 69 == data
+ 70 
+ 71 Colors-rgb:
+ 72   0x400/imm32
+ 73   00 00 00 00
+ 74   00 00 aa 00
+ 75   00 aa 00 00
+ 76   00 aa aa 00
+ 77   aa 00 00 00
+ 78   aa 00 aa 00
+ 79   aa 55 00 00
+ 80   aa aa aa 00
+ 81   55 55 55 00
+ 82   55 55 ff 00
+ 83   55 ff 55 00
+ 84   55 ff ff 00
+ 85   ff 55 55 00
+ 86   ff 55 ff 00
+ 87   ff ff 55 00
+ 88   ff ff ff 00
+ 89   00 00 00 00
+ 90   14 14 14 00
+ 91   20 20 20 00
+ 92   2c 2c 2c 00
+ 93   38 38 38 00
+ 94   45 45 45 00
+ 95   51 51 51 00
+ 96   61 61 61 00
+ 97   71 71 71 00
+ 98   82 82 82 00
+ 99   92 92 92 00
+100   a2 a2 a2 00
+101   b6 b6 b6 00
+102   cb cb cb 00
+103   e3 e3 e3 00
+104   ff ff ff 00
+105   00 00 ff 00
+106   41 00 ff 00
+107   7d 00 ff 00
+108   be 00 ff 00
+109   ff 00 ff 00
+110   ff 00 be 00
+111   ff 00 7d 00
+112   ff 00 41 00
+113   ff 00 00 00
+114   ff 41 00 00
+115   ff 7d 00 00
+116   ff be 00 00
+117   ff ff 00 00
+118   be ff 00 00
+119   7d ff 00 00
+120   41 ff 00 00
+121   00 ff 00 00
+122   00 ff 41 00
+123   00 ff 7d 00
+124   00 ff be 00
+125   00 ff ff 00
+126   00 be ff 00
+127   00 7d ff 00
+128   00 41 ff 00
+129   7d 7d ff 00
+130   9e 7d ff 00
+131   be 7d ff 00
+132   df 7d ff 00
+133   ff 7d ff 00
+134   ff 7d df 00
+135   ff 7d be 00
+136   ff 7d 9e 00
+137   ff 7d 7d 00
+138   ff 9e 7d 00
+139   ff be 7d 00
+140   ff df 7d 00
+141   ff ff 7d 00
+142   df ff 7d 00
+143   be ff 7d 00
+144   9e ff 7d 00
+145   7d ff 7d 00
+146   7d ff 9e 00
+147   7d ff be 00
+148   7d ff df 00
+149   7d ff ff 00
+150   7d df ff 00
+151   7d be ff 00
+152   7d 9e ff 00
+153   b6 b6 ff 00
+154   c7 b6 ff 00
+155   db b6 ff 00
+156   eb b6 ff 00
+157   ff b6 ff 00
+158   ff b6 eb 00
+159   ff b6 db 00
+160   ff b6 c7 00
+161   ff b6 b6 00
+162   ff c7 b6 00
+163   ff db b6 00
+164   ff eb b6 00
+165   ff ff b6 00
+166   eb ff b6 00
+167   db ff b6 00
+168   c7 ff b6 00
+169   b6 ff b6 00
+170   b6 ff c7 00
+171   b6 ff db 00
+172   b6 ff eb 00
+173   b6 ff ff 00
+174   b6 eb ff 00
+175   b6 db ff 00
+176   b6 c7 ff 00
+177   00 00 71 00
+178   1c 00 71 00
+179   38 00 71 00
+180   55 00 71 00
+181   71 00 71 00
+182   71 00 55 00
+183   71 00 38 00
+184   71 00 1c 00
+185   71 00 00 00
+186   71 1c 00 00
+187   71 38 00 00
+188   71 55 00 00
+189   71 71 00 00
+190   55 71 00 00
+191   38 71 00 00
+192   1c 71 00 00
+193   00 71 00 00
+194   00 71 1c 00
+195   00 71 38 00
+196   00 71 55 00
+197   00 71 71 00
+198   00 55 71 00
+199   00 38 71 00
+200   00 1c 71 00
+201   38 38 71 00
+202   45 38 71 00
+203   55 38 71 00
+204   61 38 71 00
+205   71 38 71 00
+206   71 38 61 00
+207   71 38 55 00
+208   71 38 45 00
+209   71 38 38 00
+210   71 45 38 00
+211   71 55 38 00
+212   71 61 38 00
+213   71 71 38 00
+214   61 71 38 00
+215   55 71 38 00
+216   45 71 38 00
+217   38 71 38 00
+218   38 71 45 00
+219   38 71 55 00
+220   38 71 61 00
+221   38 71 71 00
+222   38 61 71 00
+223   38 55 71 00
+224   38 45 71 00
+225   51 51 71 00
+226   59 51 71 00
+227   61 51 71 00
+228   69 51 71 00
+229   71 51 71 00
+230   71 51 69 00
+231   71 51 61 00
+232   71 51 59 00
+233   71 51 51 00
+234   71 59 51 00
+235   71 61 51 00
+236   71 69 51 00
+237   71 71 51 00
+238   69 71 51 00
+239   61 71 51 00
+240   59 71 51 00
+241   51 71 51 00
+242   51 71 59 00
+243   51 71 61 00
+244   51 71 69 00
+245   51 71 71 00
+246   51 69 71 00
+247   51 61 71 00
+248   51 59 71 00
+249   00 00 41 00
+250   10 00 41 00
+251   20 00 41 00
+252   30 00 41 00
+253   41 00 41 00
+254   41 00 30 00
+255   41 00 20 00
+256   41 00 10 00
+257   41 00 00 00
+258   41 10 00 00
+259   41 20 00 00
+260   41 30 00 00
+261   41 41 00 00
+262   30 41 00 00
+263   20 41 00 00
+264   10 41 00 00
+265   00 41 00 00
+266   00 41 10 00
+267   00 41 20 00
+268   00 41 30 00
+269   00 41 41 00
+270   00 30 41 00
+271   00 20 41 00
+272   00 10 41 00
+273   20 20 41 00
+274   28 20 41 00
+275   30 20 41 00
+276   38 20 41 00
+277   41 20 41 00
+278   41 20 38 00
+279   41 20 30 00
+280   41 20 28 00
+281   41 20 20 00
+282   41 28 20 00
+283   41 30 20 00
+284   41 38 20 00
+285   41 41 20 00
+286   38 41 20 00
+287   30 41 20 00
+288   28 41 20 00
+289   20 41 20 00
+290   20 41 28 00
+291   20 41 30 00
+292   20 41 38 00
+293   20 41 41 00
+294   20 38 41 00
+295   20 30 41 00
+296   20 28 41 00
+297   2c 2c 41 00
+298   30 2c 41 00
+299   34 2c 41 00
+300   3c 2c 41 00
+301   41 2c 41 00
+302   41 2c 3c 00
+303   41 2c 34 00
+304   41 2c 30 00
+305   41 2c 2c 00
+306   41 30 2c 00
+307   41 34 2c 00
+308   41 3c 2c 00
+309   41 41 2c 00
+310   3c 41 2c 00
+311   34 41 2c 00
+312   30 41 2c 00
+313   2c 41 2c 00
+314   2c 41 30 00
+315   2c 41 34 00
+316   2c 41 3c 00
+317   2c 41 41 00
+318   2c 3c 41 00
+319   2c 34 41 00
+320   2c 30 41 00
+321   00 00 00 00
+322   00 00 00 00
+323   00 00 00 00
+324   00 00 00 00
+325   00 00 00 00
+326   00 00 00 00
+327   00 00 00 00
+328   00 00 00 00
+
+ + + diff --git a/html/400.mu.html b/html/400.mu.html index 0eb81c4a..4f4888fa 100644 --- a/html/400.mu.html +++ b/html/400.mu.html @@ -59,98 +59,99 @@ if ('onhashchange' in window) { 4 sig cursor-position-on-real-screen -> _/eax: int, _/ecx: int 5 sig set-cursor-position-on-real-screen x: int, y: int 6 sig draw-cursor-on-real-screen g: grapheme - 7 - 8 # keyboard - 9 sig read-key kbd: (addr keyboard) -> _/eax: byte -10 -11 # disk -12 sig load-sectors disk: (addr disk), lba: int, n: int, out: (addr stream byte) -13 sig store-sectors disk: (addr disk), lba: int, n: int, out: (addr stream byte) -14 -15 # mouse -16 sig read-mouse-event -> _/eax: int, _/ecx: int -17 -18 # tests -19 sig count-test-failure -20 sig num-test-failures -> _/eax: int -21 -22 sig string-equal? s: (addr array byte), benchmark: (addr array byte) -> _/eax: boolean -23 sig string-starts-with? s: (addr array byte), benchmark: (addr array byte) -> _/eax: boolean -24 sig check-strings-equal s: (addr array byte), expected: (addr array byte), msg: (addr array byte) -25 -26 # debugging -27 sig check-stack -28 sig show-stack-state -29 sig debug-print x: (addr array byte), fg: int, bg: int -30 sig debug-print? -> _/eax: boolean -31 sig turn-on-debug-print -32 sig turn-off-debug-print -33 -34 # streams -35 sig clear-stream f: (addr stream _) -36 sig rewind-stream f: (addr stream _) -37 sig stream-data-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean -38 sig streams-data-equal? f: (addr stream byte), s: (addr stream byte) -> _/eax: boolean -39 sig check-stream-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte) -40 sig next-stream-line-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean -41 sig check-next-stream-line-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte) -42 sig write f: (addr stream byte), s: (addr array byte) -43 sig write-stream f: (addr stream byte), s: (addr stream byte) -44 sig read-byte s: (addr stream byte) -> _/eax: byte -45 sig append-byte f: (addr stream byte), n: int # really just a byte, but I want to pass in literal numbers -46 #sig to-hex-char in/eax: int -> out/eax: int -47 sig append-byte-hex f: (addr stream byte), n: int # really just a byte, but I want to pass in literal numbers -48 sig write-int32-hex f: (addr stream byte), n: int -49 sig write-int32-hex-bits f: (addr stream byte), n: int, bits: int -50 sig hex-int? in: (addr slice) -> _/eax: boolean -51 sig parse-hex-int in: (addr array byte) -> _/eax: int -52 sig parse-hex-int-from-slice in: (addr slice) -> _/eax: int -53 #sig parse-hex-int-helper start: (addr byte), end: (addr byte) -> _/eax: int -54 sig hex-digit? c: byte -> _/eax: boolean -55 #sig from-hex-char in/eax: byte -> out/eax: nibble -56 sig parse-decimal-int in: (addr array byte) -> _/eax: int -57 sig parse-decimal-int-from-slice in: (addr slice) -> _/eax: int -58 sig parse-decimal-int-from-stream in: (addr stream byte) -> _/eax: int -59 #sig parse-decimal-int-helper start: (addr byte), end: (addr byte) -> _/eax: int -60 sig decimal-size n: int -> _/eax: int -61 #sig allocate ad: (addr allocation-descriptor), n: int, out: (addr handle _) -62 #sig allocate-raw ad: (addr allocation-descriptor), n: int, out: (addr handle _) -63 sig lookup h: (handle _T) -> _/eax: (addr _T) -64 sig handle-equal? a: (handle _T), b: (handle _T) -> _/eax: boolean -65 sig copy-handle src: (handle _T), dest: (addr handle _T) -66 #sig allocate-region ad: (addr allocation-descriptor), n: int, out: (addr handle allocation-descriptor) -67 #sig allocate-array ad: (addr allocation-descriptor), n: int, out: (addr handle _) -68 sig copy-array ad: (addr allocation-descriptor), src: (addr array _T), out: (addr handle array _T) -69 #sig zero-out start: (addr byte), size: int -70 sig slice-empty? s: (addr slice) -> _/eax: boolean -71 sig slice-equal? s: (addr slice), p: (addr array byte) -> _/eax: boolean -72 sig slice-starts-with? s: (addr slice), head: (addr array byte) -> _/eax: boolean -73 sig write-slice out: (addr stream byte), s: (addr slice) -74 # bad name alert -75 sig slice-to-string ad: (addr allocation-descriptor), in: (addr slice), out: (addr handle array byte) -76 sig write-int32-decimal out: (addr stream byte), n: int -77 sig decimal-digit? c: grapheme -> _/eax: boolean -78 sig to-decimal-digit in: grapheme -> _/eax: int -79 # bad name alert -80 # next-word really tokenizes -81 # next-raw-word really reads whitespace-separated words -82 sig next-word line: (addr stream byte), out: (addr slice) # skips '#' comments -83 sig next-raw-word line: (addr stream byte), out: (addr slice) # does not skip '#' comments -84 sig stream-empty? s: (addr stream _) -> _/eax: boolean -85 sig stream-full? s: (addr stream _) -> _/eax: boolean -86 sig stream-to-array in: (addr stream _), out: (addr handle array _) -87 sig unquote-stream-to-array in: (addr stream _), out: (addr handle array _) -88 sig stream-first s: (addr stream byte) -> _/eax: byte -89 sig stream-final s: (addr stream byte) -> _/eax: byte -90 -91 #sig copy-bytes src: (addr byte), dest: (addr byte), n: int -92 sig copy-array-object src: (addr array _), dest-ah: (addr handle array _) -93 sig array-equal? a: (addr array int), b: (addr array int) -> _/eax: boolean -94 sig parse-array-of-ints s: (addr array byte), out: (addr handle array int) -95 sig parse-array-of-decimal-ints s: (addr array byte), out: (addr handle array int) -96 sig check-array-equal a: (addr array int), expected: (addr string), msg: (addr string) -97 -98 sig integer-divide a: int, b: int -> _/eax: int, _/edx: int + 7 sig color-rgb color: int -> _/ecx: int, _/edx: int, _/ebx: int + 8 + 9 # keyboard +10 sig read-key kbd: (addr keyboard) -> _/eax: byte +11 +12 # disk +13 sig load-sectors disk: (addr disk), lba: int, n: int, out: (addr stream byte) +14 sig store-sectors disk: (addr disk), lba: int, n: int, out: (addr stream byte) +15 +16 # mouse +17 sig read-mouse-event -> _/eax: int, _/ecx: int +18 +19 # tests +20 sig count-test-failure +21 sig num-test-failures -> _/eax: int +22 +23 sig string-equal? s: (addr array byte), benchmark: (addr array byte) -> _/eax: boolean +24 sig string-starts-with? s: (addr array byte), benchmark: (addr array byte) -> _/eax: boolean +25 sig check-strings-equal s: (addr array byte), expected: (addr array byte), msg: (addr array byte) +26 +27 # debugging +28 sig check-stack +29 sig show-stack-state +30 sig debug-print x: (addr array byte), fg: int, bg: int +31 sig debug-print? -> _/eax: boolean +32 sig turn-on-debug-print +33 sig turn-off-debug-print +34 +35 # streams +36 sig clear-stream f: (addr stream _) +37 sig rewind-stream f: (addr stream _) +38 sig stream-data-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean +39 sig streams-data-equal? f: (addr stream byte), s: (addr stream byte) -> _/eax: boolean +40 sig check-stream-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte) +41 sig next-stream-line-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean +42 sig check-next-stream-line-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte) +43 sig write f: (addr stream byte), s: (addr array byte) +44 sig write-stream f: (addr stream byte), s: (addr stream byte) +45 sig read-byte s: (addr stream byte) -> _/eax: byte +46 sig append-byte f: (addr stream byte), n: int # really just a byte, but I want to pass in literal numbers +47 #sig to-hex-char in/eax: int -> out/eax: int +48 sig append-byte-hex f: (addr stream byte), n: int # really just a byte, but I want to pass in literal numbers +49 sig write-int32-hex f: (addr stream byte), n: int +50 sig write-int32-hex-bits f: (addr stream byte), n: int, bits: int +51 sig hex-int? in: (addr slice) -> _/eax: boolean +52 sig parse-hex-int in: (addr array byte) -> _/eax: int +53 sig parse-hex-int-from-slice in: (addr slice) -> _/eax: int +54 #sig parse-hex-int-helper start: (addr byte), end: (addr byte) -> _/eax: int +55 sig hex-digit? c: byte -> _/eax: boolean +56 #sig from-hex-char in/eax: byte -> out/eax: nibble +57 sig parse-decimal-int in: (addr array byte) -> _/eax: int +58 sig parse-decimal-int-from-slice in: (addr slice) -> _/eax: int +59 sig parse-decimal-int-from-stream in: (addr stream byte) -> _/eax: int +60 #sig parse-decimal-int-helper start: (addr byte), end: (addr byte) -> _/eax: int +61 sig decimal-size n: int -> _/eax: int +62 #sig allocate ad: (addr allocation-descriptor), n: int, out: (addr handle _) +63 #sig allocate-raw ad: (addr allocation-descriptor), n: int, out: (addr handle _) +64 sig lookup h: (handle _T) -> _/eax: (addr _T) +65 sig handle-equal? a: (handle _T), b: (handle _T) -> _/eax: boolean +66 sig copy-handle src: (handle _T), dest: (addr handle _T) +67 #sig allocate-region ad: (addr allocation-descriptor), n: int, out: (addr handle allocation-descriptor) +68 #sig allocate-array ad: (addr allocation-descriptor), n: int, out: (addr handle _) +69 sig copy-array ad: (addr allocation-descriptor), src: (addr array _T), out: (addr handle array _T) +70 #sig zero-out start: (addr byte), size: int +71 sig slice-empty? s: (addr slice) -> _/eax: boolean +72 sig slice-equal? s: (addr slice), p: (addr array byte) -> _/eax: boolean +73 sig slice-starts-with? s: (addr slice), head: (addr array byte) -> _/eax: boolean +74 sig write-slice out: (addr stream byte), s: (addr slice) +75 # bad name alert +76 sig slice-to-string ad: (addr allocation-descriptor), in: (addr slice), out: (addr handle array byte) +77 sig write-int32-decimal out: (addr stream byte), n: int +78 sig decimal-digit? c: grapheme -> _/eax: boolean +79 sig to-decimal-digit in: grapheme -> _/eax: int +80 # bad name alert +81 # next-word really tokenizes +82 # next-raw-word really reads whitespace-separated words +83 sig next-word line: (addr stream byte), out: (addr slice) # skips '#' comments +84 sig next-raw-word line: (addr stream byte), out: (addr slice) # does not skip '#' comments +85 sig stream-empty? s: (addr stream _) -> _/eax: boolean +86 sig stream-full? s: (addr stream _) -> _/eax: boolean +87 sig stream-to-array in: (addr stream _), out: (addr handle array _) +88 sig unquote-stream-to-array in: (addr stream _), out: (addr handle array _) +89 sig stream-first s: (addr stream byte) -> _/eax: byte +90 sig stream-final s: (addr stream byte) -> _/eax: byte +91 +92 #sig copy-bytes src: (addr byte), dest: (addr byte), n: int +93 sig copy-array-object src: (addr array _), dest-ah: (addr handle array _) +94 sig array-equal? a: (addr array int), b: (addr array int) -> _/eax: boolean +95 sig parse-array-of-ints s: (addr array byte), out: (addr handle array int) +96 sig parse-array-of-decimal-ints s: (addr array byte), out: (addr handle array int) +97 sig check-array-equal a: (addr array int), expected: (addr string), msg: (addr string) +98 +99 sig integer-divide a: int, b: int -> _/eax: int, _/edx: int diff --git a/html/505colors.mu.html b/html/505colors.mu.html new file mode 100644 index 00000000..ee50c7e7 --- /dev/null +++ b/html/505colors.mu.html @@ -0,0 +1,297 @@ + + + + +Mu - 505colors.mu + + + + + + + + + + +https://github.com/akkartik/mu/blob/main/505colors.mu +
+  1 # Hue/saturation/luminance for an rgb triple.
+  2 # rgb are in [0, 256)
+  3 # hsl are also returned in [0, 256)
+  4 # from https://www.niwa.nu/2013/05/math-behind-colorspace-conversions-rgb-hsl
+  5 fn hsl r: int, g: int, b: int -> _/ecx: int, _/edx: int, _/ebx: int {
+  6   var _max/eax: int <- maximum r, g
+  7   _max <- maximum _max, b
+  8   var max/ecx: int <- copy _max
+  9   var _min/eax: int <- minimum r, g
+ 10   _min <- minimum _min, b
+ 11   var min/edx: int <- copy _min
+ 12   var luminance/ebx: int <- copy min
+ 13   luminance <- add max
+ 14   luminance <- shift-right 1  # TODO: round up instead of down
+ 15   # if rgb are all equal, it's a shade of grey
+ 16   compare min, max
+ 17   {
+ 18     break-if-!=
+ 19     return 0, 0, luminance
+ 20   }
+ 21   # saturation =
+ 22   #   luminance < 128 | 255*(max-min)/         (max+min)
+ 23   #   otherwise       | 255*(max-min)/(2*255 - (max+min))
+ 24   var nr/esi: int <- copy max
+ 25   nr <- subtract min
+ 26   var dr/eax: int <- copy 0
+ 27   compare luminance, 0x80
+ 28   {
+ 29     break-if->=
+ 30     dr <- copy max
+ 31     dr <- add min
+ 32   }
+ 33   {
+ 34     break-if-<
+ 35     dr <- copy 0xff
+ 36     dr <- shift-left 1
+ 37     dr <- subtract max
+ 38     dr <- subtract min
+ 39   }
+ 40   var q/xmm0: float <- convert nr
+ 41   var tmp/xmm1: float <- convert dr
+ 42   q <- divide tmp
+ 43   var int-255/eax: int <- copy 0xff
+ 44   tmp <- convert int-255
+ 45   q <- multiply tmp
+ 46   var saturation/esi: int <- convert q
+ 47   # hue = 
+ 48   #   red is max   | 256.0/6*       (g-b)/(max-min)
+ 49   #   green is max | 256.0/6*(2.0 + (b-r)/(max-min))
+ 50   #   blue is max  | 256.0/6*(4.0 + (r-g)/(max-min))
+ 51   var zero/eax: int <- copy 0
+ 52   var hue-f/xmm0: float <- convert zero
+ 53   var dr/eax: int <- copy max
+ 54   dr <- subtract min
+ 55   var dr-f/xmm1: float <- convert dr
+ 56   $hsl:compute-hue-normalized: {
+ 57     compare r, max
+ 58     {
+ 59       break-if-!=
+ 60       var nr/eax: int <- copy g
+ 61       nr <- subtract b
+ 62       hue-f <- convert nr
+ 63       hue-f <- divide dr-f
+ 64       break $hsl:compute-hue-normalized
+ 65     }
+ 66     compare g, max
+ 67     {
+ 68       break-if-!=
+ 69       var nr/eax: int <- copy b
+ 70       nr <- subtract r
+ 71       var f/xmm2: float <- convert nr
+ 72       f <- divide dr-f
+ 73       var two/ecx: int <- copy 2
+ 74       hue-f <- convert two
+ 75       hue-f <- add f
+ 76       break $hsl:compute-hue-normalized
+ 77     }
+ 78     compare b, max
+ 79     {
+ 80       break-if-!=
+ 81       var nr/eax: int <- copy r
+ 82       nr <- subtract g
+ 83       var f/xmm2: float <- convert nr
+ 84       f <- divide dr-f
+ 85       var two/ecx: int <- copy 4
+ 86       hue-f <- convert two
+ 87       hue-f <- add f
+ 88       break $hsl:compute-hue-normalized
+ 89     }
+ 90   }
+ 91   var int-256/eax: int <- copy 0x100
+ 92   var scaling-factor/xmm1: float <- convert int-256
+ 93   var int-6/eax: int <- copy 6
+ 94   var six-f/xmm2: float <- convert int-6
+ 95   scaling-factor <- divide six-f
+ 96   hue-f <- multiply scaling-factor
+ 97   var hue/eax: int <- convert hue-f
+ 98   # if hue < 0, hue = 256 - hue
+ 99   compare hue, 0
+100   {
+101     break-if->=
+102     var tmp/ecx: int <- copy 0x100
+103     tmp <- subtract hue
+104     hue <- copy tmp
+105   }
+106   return hue, saturation, luminance
+107 }
+108 
+109 fn test-hsl-black {
+110   var h/ecx: int <- copy 0
+111   var s/edx: int <- copy 0
+112   var l/ebx: int <- copy 0
+113   h, s, l <- hsl 0, 0, 0
+114   check-ints-equal h, 0, "F - test-hsl-black/hue"
+115   check-ints-equal s, 0, "F - test-hsl-black/saturation"
+116   check-ints-equal l, 0, "F - test-hsl-black/luminance"
+117 }
+118 
+119 fn test-hsl-white {
+120   var h/ecx: int <- copy 0
+121   var s/edx: int <- copy 0
+122   var l/ebx: int <- copy 0
+123   h, s, l <- hsl 0xff, 0xff, 0xff
+124   check-ints-equal h, 0, "F - test-hsl-white/hue"
+125   check-ints-equal s, 0, "F - test-hsl-white/saturation"
+126   check-ints-equal l, 0xff, "F - test-hsl-white/luminance"
+127 }
+128 
+129 fn test-hsl-grey {
+130   var h/ecx: int <- copy 0
+131   var s/edx: int <- copy 0
+132   var l/ebx: int <- copy 0
+133   h, s, l <- hsl 0x30, 0x30, 0x30
+134   check-ints-equal h, 0, "F - test-hsl-grey/hue"
+135   check-ints-equal s, 0, "F - test-hsl-grey/saturation"
+136   check-ints-equal l, 0x30, "F - test-hsl-grey/luminance"
+137 }
+138 
+139 # red hues: 0-0x54
+140 fn test-hsl-slightly-red {
+141   var h/ecx: int <- copy 0
+142   var s/edx: int <- copy 0
+143   var l/ebx: int <- copy 0
+144   h, s, l <- hsl 0xff, 0xfe, 0xfe
+145   check-ints-equal h, 0, "F - test-hsl-slightly-red/hue"
+146   check-ints-equal s, 0xff, "F - test-hsl-slightly-red/saturation"
+147   check-ints-equal l, 0xfe, "F - test-hsl-slightly-red/luminance"  # TODO: should round up
+148 }
+149 
+150 fn test-hsl-extremely-red {
+151   var h/ecx: int <- copy 0
+152   var s/edx: int <- copy 0
+153   var l/ebx: int <- copy 0
+154   h, s, l <- hsl 0xff, 0, 0
+155   check-ints-equal h, 0, "F - test-hsl-extremely-red/hue"
+156   check-ints-equal s, 0xff, "F - test-hsl-extremely-red/saturation"
+157   check-ints-equal l, 0x7f, "F - test-hsl-extremely-red/luminance"  # TODO: should round up
+158 }
+159 
+160 # green hues: 0x55-0xaa
+161 fn test-hsl-slightly-green {
+162   var h/ecx: int <- copy 0
+163   var s/edx: int <- copy 0
+164   var l/ebx: int <- copy 0
+165   h, s, l <- hsl 0xfe, 0xff, 0xfe
+166   check-ints-equal h, 0x55, "F - test-hsl-slightly-green/hue"
+167   check-ints-equal s, 0xff, "F - test-hsl-slightly-green/saturation"
+168   check-ints-equal l, 0xfe, "F - test-hsl-slightly-green/luminance"  # TODO: should round up
+169 }
+170 
+171 fn test-hsl-extremely-green {
+172   var h/ecx: int <- copy 0
+173   var s/edx: int <- copy 0
+174   var l/ebx: int <- copy 0
+175   h, s, l <- hsl 0, 0xff, 0
+176   check-ints-equal h, 0x55, "F - test-hsl-extremely-green/hue"
+177   check-ints-equal s, 0xff, "F - test-hsl-extremely-green/saturation"
+178   check-ints-equal l, 0x7f, "F - test-hsl-extremely-green/luminance"  # TODO: should round up
+179 }
+180 
+181 # blue hues: 0xab-0xff
+182 fn test-hsl-slightly-blue {
+183   var h/ecx: int <- copy 0
+184   var s/edx: int <- copy 0
+185   var l/ebx: int <- copy 0
+186   h, s, l <- hsl 0xfe, 0xfe, 0xff
+187   check-ints-equal h, 0xab, "F - test-hsl-slightly-blue/hue"
+188   check-ints-equal s, 0xff, "F - test-hsl-slightly-blue/saturation"
+189   check-ints-equal l, 0xfe, "F - test-hsl-slightly-blue/luminance"  # TODO: should round up
+190 }
+191 
+192 fn test-hsl-extremely-blue {
+193   var h/ecx: int <- copy 0
+194   var s/edx: int <- copy 0
+195   var l/ebx: int <- copy 0
+196   h, s, l <- hsl 0, 0, 0xff
+197   check-ints-equal h, 0xab, "F - test-hsl-extremely-blue/hue"
+198   check-ints-equal s, 0xff, "F - test-hsl-extremely-blue/saturation"
+199   check-ints-equal l, 0x7f, "F - test-hsl-extremely-blue/luminance"  # TODO: should round up
+200 }
+201 
+202 # cyan: 0x7f
+203 
+204 fn test-hsl-cyan {
+205   var h/ecx: int <- copy 0
+206   var s/edx: int <- copy 0
+207   var l/ebx: int <- copy 0
+208   h, s, l <- hsl 0, 0xff, 0xff
+209   check-ints-equal h, 0x80, "F - test-hsl-cyan/hue"
+210   check-ints-equal s, 0xff, "F - test-hsl-cyan/saturation"
+211   check-ints-equal l, 0x7f, "F - test-hsl-cyan/luminance"  # TODO: should round up
+212 }
+213 
+214 ###
+215 
+216 fn maximum a: int, b: int -> _/eax: int {
+217   var a2/eax: int <- copy a
+218   compare a2, b
+219   {
+220     break-if-<
+221     return a
+222   }
+223   return b
+224 }
+225 
+226 fn minimum a: int, b: int -> _/eax: int {
+227   var a2/eax: int <- copy a
+228   compare a2, b
+229   {
+230     break-if->
+231     return a
+232   }
+233   return b
+234 }
+
+ + + diff --git a/html/boot.subx.html b/html/boot.subx.html index 6d2560d8..ed9ad698 100644 --- a/html/boot.subx.html +++ b/html/boot.subx.html @@ -76,9 +76,9 @@ if ('onhashchange' in window) { 16 17 # Memory map of a Mu computer: 18 # code: currently 4 tracks loaded from the primary disk to [0x00007c00, 0x00048600) - 19 # stack: grows down from 0x00070000 - 20 # heap: [0x01000000, 0x02000000) - 21 # see 120allocate.subx + 19 # stack: grows down from 0x02000000 to 0x01000000 + 20 # heap: [0x02000000, 0x08000000) + 21 # see 120allocate.subx; Qemu initializes with 128MB RAM by default 22 # Consult https://wiki.osdev.org/Memory_Map_(x86) before modifying any of 23 # this. And don't forget to keep *stack-debug.subx in sync. 24 @@ -101,7 +101,7 @@ if ('onhashchange' in window) { 41 8e/->seg 3/mod/direct 0/rm32/ax 4/r32/fs 42 8e/->seg 3/mod/direct 0/rm32/ax 5/r32/gs 43 - 44 # initialize stack to 0x00070000 + 44 # Temporarily initialize stack to 0x00070000 in real mode. 45 # We don't read or write the stack before we get to 32-bit mode, but BIOS 46 # calls do. We need to move the stack in case BIOS initializes it to some 47 # low address that we want to write code into. @@ -269,7 +269,7 @@ if ('onhashchange' in window) { 209 8e/->seg 3/mod/direct 0/rm32/ax 4/r32/fs 210 8e/->seg 3/mod/direct 0/rm32/ax 5/r32/gs 211 - 212 bc/copy-to-esp 0x00070000/imm32 + 212 bc/copy-to-esp 0x02000000/imm32 213 214 ## load interrupt handlers 215 # We can't refer to the label directly because SubX doesn't do the right diff --git a/html/colors.mu.html b/html/colors.mu.html new file mode 100644 index 00000000..25eb4b07 --- /dev/null +++ b/html/colors.mu.html @@ -0,0 +1,298 @@ + + + + +Mu - colors.mu + + + + + + + + + + +https://github.com/akkartik/mu/blob/main/colors.mu +
+  1 # Return colors 'near' a given r/g/b value (expressed in hex)
+  2 # If we did this rigorously we'd need to implement cosines. So we won't.
+  3 #
+  4 # To build:
+  5 #   $ ./translate colors.mu
+  6 #
+  7 # Example session:
+  8 #   $ qemu-system-i386 code.img
+  9 #   Enter 3 hex bytes for r, g, b (lowercase; no 0x prefix) separated by a single space> aa 0 aa
+ 10 #   5
+ 11 # This means only color 5 in the default palette is similar to #aa00aa.
+ 12 
+ 13 fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) {
+ 14   var in-storage: (stream byte 0x10)
+ 15   var in/esi: (addr stream byte) <- address in-storage
+ 16   {
+ 17     # print prompt
+ 18     var x/eax: int <- draw-text-rightward screen, "Enter 3 hex bytes for r, g, b (lowercase; no 0x prefix) separated by a single space> ", 0x10/x, 0x80/xmax, 0x28/y, 3/fg/cyan, 0/bg
+ 19     # read line from keyboard
+ 20     clear-stream in
+ 21     {
+ 22       draw-cursor screen, 0x20/space
+ 23       var key/eax: byte <- read-key keyboard
+ 24       compare key, 0xa/newline
+ 25       break-if-=
+ 26       compare key, 0
+ 27       loop-if-=
+ 28       var key2/eax: int <- copy key
+ 29       append-byte in, key2
+ 30       var g/eax: grapheme <- copy key2
+ 31       draw-grapheme-at-cursor screen, g, 0xf/fg, 0/bg
+ 32       move-cursor-right 0
+ 33       loop
+ 34     }
+ 35     clear-screen screen
+ 36     # parse
+ 37     var a/ecx: int <- copy 0
+ 38     var b/edx: int <- copy 0
+ 39     var c/ebx: int <- copy 0
+ 40     # a, b, c = r, g, b
+ 41     a, b, c <- parse in
+ 42 #?     set-cursor-position screen, 0x10/x, 0x1a/y
+ 43 #?     draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen, a, 7/fg, 0/bg
+ 44 #?     draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg
+ 45 #?     draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen, b, 7/fg, 0/bg
+ 46 #?     draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg
+ 47 #?     draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen, c, 7/fg, 0/bg
+ 48     a, b, c <- hsl a, b, c
+ 49     # return all colors in the same quadrant in h, s and l
+ 50     print-nearby-colors screen, a, b, c
+ 51     #
+ 52     loop
+ 53   }
+ 54 }
+ 55 
+ 56 # read exactly 3 words in a single line
+ 57 # Each word consists of exactly 1 or 2 hex bytes. No hex prefix.
+ 58 fn parse in: (addr stream byte) -> _/ecx: int, _/edx: int, _/ebx: int {
+ 59   # read first byte of r
+ 60   var tmp/eax: byte <- read-byte in
+ 61   {
+ 62     var valid?/eax: boolean <- hex-digit? tmp
+ 63     compare valid?, 0/false
+ 64     break-if-!=
+ 65     abort "invalid byte 0 of r"
+ 66   }
+ 67   tmp <- fast-hex-digit-value tmp
+ 68   var r/ecx: int <- copy tmp
+ 69 #?   set-cursor-position 0/screen, 0x10/x, 0x10/y
+ 70 #?   draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, r, 7/fg, 0/bg
+ 71   # read second byte of r
+ 72   tmp <- read-byte in
+ 73   {
+ 74     {
+ 75       var valid?/eax: boolean <- hex-digit? tmp
+ 76       compare valid?, 0/false
+ 77     }
+ 78     break-if-=
+ 79     r <- shift-left 4
+ 80     tmp <- fast-hex-digit-value tmp
+ 81 #?     {
+ 82 #?       var foo/eax: int <- copy tmp
+ 83 #?       set-cursor-position 0/screen, 0x10/x, 0x11/y
+ 84 #?       draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, foo, 7/fg, 0/bg
+ 85 #?     }
+ 86     r <- add tmp
+ 87 #?     {
+ 88 #?       set-cursor-position 0/screen, 0x10/x, 0x12/y
+ 89 #?       draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, r, 7/fg, 0/bg
+ 90 #?     }
+ 91     tmp <- read-byte in  # skip space
+ 92   }
+ 93   # read first byte of g
+ 94   var tmp/eax: byte <- read-byte in
+ 95   {
+ 96     var valid?/eax: boolean <- hex-digit? tmp
+ 97     compare valid?, 0/false
+ 98     break-if-!=
+ 99     abort "invalid byte 0 of g"
+100   }
+101   tmp <- fast-hex-digit-value tmp
+102   var g/edx: int <- copy tmp
+103 #?   set-cursor-position 0/screen, 0x10/x, 0x13/y
+104 #?   draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, g, 7/fg, 0/bg
+105   # read second byte of g
+106   tmp <- read-byte in
+107   {
+108     {
+109       var valid?/eax: boolean <- hex-digit? tmp
+110       compare valid?, 0/false
+111     }
+112     break-if-=
+113     g <- shift-left 4
+114     tmp <- fast-hex-digit-value tmp
+115 #?     {
+116 #?       var foo/eax: int <- copy tmp
+117 #?       set-cursor-position 0/screen, 0x10/x, 0x14/y
+118 #?       draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, foo, 7/fg, 0/bg
+119 #?     }
+120     g <- add tmp
+121 #?     {
+122 #?       set-cursor-position 0/screen, 0x10/x, 0x15/y
+123 #?       draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, g, 7/fg, 0/bg
+124 #?     }
+125     tmp <- read-byte in  # skip space
+126   }
+127   # read first byte of b
+128   var tmp/eax: byte <- read-byte in
+129   {
+130     var valid?/eax: boolean <- hex-digit? tmp
+131     compare valid?, 0/false
+132     break-if-!=
+133     abort "invalid byte 0 of b"
+134   }
+135   tmp <- fast-hex-digit-value tmp
+136   var b/ebx: int <- copy tmp
+137 #?   set-cursor-position 0/screen, 0x10/x, 0x16/y
+138 #?   draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, b, 7/fg, 0/bg
+139   # read second byte of b
+140   {
+141     {
+142       var done?/eax: boolean <- stream-empty? in
+143       compare done?, 0/false
+144     }
+145     break-if-!=
+146     tmp <- read-byte in
+147     {
+148       var valid?/eax: boolean <- hex-digit? tmp
+149       compare valid?, 0/false
+150     }
+151     break-if-=
+152     b <- shift-left 4
+153     tmp <- fast-hex-digit-value tmp
+154 #?     {
+155 #?       var foo/eax: int <- copy tmp
+156 #?       set-cursor-position 0/screen, 0x10/x, 0x17/y
+157 #?       draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, foo, 7/fg, 0/bg
+158 #?     }
+159     b <- add tmp
+160 #?     {
+161 #?       set-cursor-position 0/screen, 0x10/x, 0x18/y
+162 #?       draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, b, 7/fg, 0/bg
+163 #?     }
+164   }
+165   return r, g, b
+166 }
+167 
+168 # no error checking
+169 fn fast-hex-digit-value in: byte -> _/eax: byte {
+170   var result/eax: byte <- copy in
+171   compare result, 0x39
+172   {
+173     break-if->
+174     result <- subtract 0x30/0
+175     return result
+176   }
+177   result <- subtract 0x61/a
+178   result <- add 0xa/10
+179   return result
+180 }
+181 
+182 fn print-nearby-colors screen: (addr screen), h: int, s: int, l: int {
+183 #?   set-cursor-position screen, 0x10/x, 0x1c/y
+184 #?   draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen, h, 7/fg, 0/bg
+185 #?   draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg
+186 #?   draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen, s, 7/fg, 0/bg
+187 #?   draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg
+188 #?   draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen, l, 7/fg, 0/bg
+189   # save just top 2 bits of each, so that we narrow down to 1/64th of the volume
+190   shift-right h, 6
+191   shift-right s, 6
+192   shift-right l, 6
+193 #?   set-cursor-position screen, 0x10/x, 0x1/y
+194 #?   draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen, h, 7/fg, 0/bg
+195 #?   draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg
+196 #?   draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen, s, 7/fg, 0/bg
+197 #?   draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg
+198 #?   draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen, l, 7/fg, 0/bg
+199   var a/ecx: int <- copy 0
+200   var b/edx: int <- copy 0
+201   var c/ebx: int <- copy 0
+202   var color/eax: int <- copy 0
+203   var y/esi: int <- copy 2
+204   {
+205     compare color, 0x100
+206     break-if->=
+207     a, b, c <- color-rgb color
+208     a, b, c <- hsl a, b, c
+209     a <- shift-right 6
+210     b <- shift-right 6
+211     c <- shift-right 6
+212     {
+213       compare a, h
+214       break-if-!=
+215       compare b, s
+216       break-if-!=
+217       compare c, l
+218       break-if-!=
+219       set-cursor-position screen, 0x10/x, y
+220       draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen screen, color, 7/fg, 0/bg
+221       set-cursor-position screen, 0x14/x, y
+222       draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg
+223       draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, "               ", 0/fg, color
+224 #?       draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg
+225 #?       draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen, a, 7/fg, 0/bg
+226 #?       draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg
+227 #?       draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen, b, 7/fg, 0/bg
+228 #?       draw-text-wrapping-right-then-down-from-cursor-over-full-screen screen, " ", 7/fg, 0/bg
+229 #?       draw-int32-hex-wrapping-right-then-down-from-cursor-over-full-screen screen, c, 7/fg, 0/bg
+230       y <- increment
+231     }
+232     color <- increment
+233     loop
+234   }
+235 }
+
+ + + diff --git a/html/mu-init.subx.html b/html/mu-init.subx.html index cc77fcce..8aa49531 100644 --- a/html/mu-init.subx.html +++ b/html/mu-init.subx.html @@ -68,24 +68,30 @@ if ('onhashchange' in window) { 12 Entry: 13 # initialize stack 14 bd/copy-to-ebp 0/imm32 -15 #? (main 0 0 Primary-bus-secondary-drive) -16 # always first run tests -17 (run-tests) -18 (num-test-failures) # => eax -19 # call main if tests all passed -20 { -21 3d/compare-eax-and 0/imm32 -22 75/jump-if-!= break/disp8 -23 (clear-real-screen) -24 c7 0/subop/copy *Real-screen-cursor-x 0/imm32 -25 c7 0/subop/copy *Real-screen-cursor-y 0/imm32 -26 (main 0 0 Primary-bus-secondary-drive) -27 } -28 -29 # hang indefinitely -30 { -31 eb/jump loop/disp8 -32 } +15 # Clear memory location 0 to ensure that uninitialized arrays run afoul of +16 # the bounds checker. +17 # TODO: This is utterly bonkers, and does not actually protect us against +18 # all null pointer reads/writes. Create a real page table sometime. +19 b8/copy-to-eax 0/imm32 +20 c7 0/subop/copy *eax 0/imm32 +21 #? (main 0 0 Primary-bus-secondary-drive) +22 # always first run tests +23 (run-tests) +24 (num-test-failures) # => eax +25 # call main if tests all passed +26 { +27 3d/compare-eax-and 0/imm32 +28 75/jump-if-!= break/disp8 +29 (clear-real-screen) +30 c7 0/subop/copy *Real-screen-cursor-x 0/imm32 +31 c7 0/subop/copy *Real-screen-cursor-y 0/imm32 +32 (main 0 0 Primary-bus-secondary-drive) +33 } +34 +35 # hang indefinitely +36 { +37 eb/jump loop/disp8 +38 } diff --git a/html/rpn.mu.html b/html/rpn.mu.html index d1341481..28ba33c3 100644 --- a/html/rpn.mu.html +++ b/html/rpn.mu.html @@ -82,132 +82,131 @@ if ('onhashchange' in window) { 24 { 25 # print prompt 26 var x/eax: int <- draw-text-rightward screen, "> ", 0/x, 0x80/xmax, y, 3/fg/cyan, 0/bg - 27 set-cursor-position screen, x, y - 28 # read line from keyboard - 29 clear-stream in - 30 { - 31 draw-cursor screen, space - 32 var key/eax: byte <- read-key keyboard - 33 compare key, 0xa/newline - 34 break-if-= - 35 compare key, 0 - 36 loop-if-= - 37 var key2/eax: int <- copy key - 38 append-byte in, key2 - 39 var g/eax: grapheme <- copy key2 - 40 draw-grapheme-at-cursor screen, g, 0xf/fg, 0/bg - 41 move-cursor-right 0 - 42 loop - 43 } - 44 # clear cursor - 45 draw-grapheme-at-cursor screen, space, 3/fg/never-used, 0/bg - 46 # parse and eval - 47 var out/eax: int <- simplify in - 48 # print - 49 y <- increment - 50 out, y <- draw-int32-decimal-wrapping-right-then-down screen, out, 0/xmin, y, 0x80/xmax, 0x30/ymax, 0/x, y, 7/fg, 0/bg - 51 # newline - 52 y <- increment - 53 # - 54 loop - 55 } - 56 } - 57 - 58 type int-stack { - 59 data: (handle array int) - 60 top: int - 61 } - 62 - 63 fn simplify in: (addr stream byte) -> _/eax: int { - 64 var word-storage: slice - 65 var word/ecx: (addr slice) <- address word-storage - 66 var stack-storage: int-stack - 67 var stack/esi: (addr int-stack) <- address stack-storage - 68 initialize-int-stack stack, 0x10 - 69 $simplify:word-loop: { - 70 next-word in, word - 71 var done?/eax: boolean <- slice-empty? word - 72 compare done?, 0 - 73 break-if-!= - 74 # if word is an operator, perform it - 75 { - 76 var is-add?/eax: boolean <- slice-equal? word, "+" - 77 compare is-add?, 0 - 78 break-if-= - 79 var _b/eax: int <- pop-int-stack stack - 80 var b/edx: int <- copy _b - 81 var a/eax: int <- pop-int-stack stack - 82 a <- add b - 83 push-int-stack stack, a - 84 loop $simplify:word-loop - 85 } - 86 { - 87 var is-sub?/eax: boolean <- slice-equal? word, "-" - 88 compare is-sub?, 0 - 89 break-if-= - 90 var _b/eax: int <- pop-int-stack stack - 91 var b/edx: int <- copy _b - 92 var a/eax: int <- pop-int-stack stack - 93 a <- subtract b - 94 push-int-stack stack, a - 95 loop $simplify:word-loop - 96 } - 97 { - 98 var is-mul?/eax: boolean <- slice-equal? word, "*" - 99 compare is-mul?, 0 -100 break-if-= -101 var _b/eax: int <- pop-int-stack stack -102 var b/edx: int <- copy _b -103 var a/eax: int <- pop-int-stack stack -104 a <- multiply b -105 push-int-stack stack, a -106 loop $simplify:word-loop -107 } -108 # otherwise it's an int -109 var n/eax: int <- parse-decimal-int-from-slice word -110 push-int-stack stack, n -111 loop -112 } -113 var result/eax: int <- pop-int-stack stack -114 return result -115 } -116 -117 fn initialize-int-stack _self: (addr int-stack), n: int { -118 var self/esi: (addr int-stack) <- copy _self -119 var d/edi: (addr handle array int) <- get self, data -120 populate d, n -121 var top/eax: (addr int) <- get self, top -122 copy-to *top, 0 -123 } -124 -125 fn push-int-stack _self: (addr int-stack), _val: int { -126 var self/esi: (addr int-stack) <- copy _self -127 var top-addr/ecx: (addr int) <- get self, top -128 var data-ah/edx: (addr handle array int) <- get self, data -129 var data/eax: (addr array int) <- lookup *data-ah -130 var top/edx: int <- copy *top-addr -131 var dest-addr/edx: (addr int) <- index data, top -132 var val/eax: int <- copy _val -133 copy-to *dest-addr, val -134 add-to *top-addr, 1 -135 } -136 -137 fn pop-int-stack _self: (addr int-stack) -> _/eax: int { -138 var self/esi: (addr int-stack) <- copy _self -139 var top-addr/ecx: (addr int) <- get self, top -140 { -141 compare *top-addr, 0 -142 break-if-> -143 return 0 -144 } -145 subtract-from *top-addr, 1 -146 var data-ah/edx: (addr handle array int) <- get self, data -147 var data/eax: (addr array int) <- lookup *data-ah -148 var top/edx: int <- copy *top-addr -149 var result-addr/eax: (addr int) <- index data, top -150 var val/eax: int <- copy *result-addr -151 return val -152 } + 27 # read line from keyboard + 28 clear-stream in + 29 { + 30 draw-cursor screen, space + 31 var key/eax: byte <- read-key keyboard + 32 compare key, 0xa/newline + 33 break-if-= + 34 compare key, 0 + 35 loop-if-= + 36 var key2/eax: int <- copy key + 37 append-byte in, key2 + 38 var g/eax: grapheme <- copy key2 + 39 draw-grapheme-at-cursor screen, g, 0xf/fg, 0/bg + 40 move-cursor-right 0 + 41 loop + 42 } + 43 # clear cursor + 44 draw-grapheme-at-cursor screen, space, 3/fg/never-used, 0/bg + 45 # parse and eval + 46 var out/eax: int <- simplify in + 47 # print + 48 y <- increment + 49 out, y <- draw-int32-decimal-wrapping-right-then-down screen, out, 0/xmin, y, 0x80/xmax, 0x30/ymax, 0/x, y, 7/fg, 0/bg + 50 # newline + 51 y <- increment + 52 # + 53 loop + 54 } + 55 } + 56 + 57 type int-stack { + 58 data: (handle array int) + 59 top: int + 60 } + 61 + 62 fn simplify in: (addr stream byte) -> _/eax: int { + 63 var word-storage: slice + 64 var word/ecx: (addr slice) <- address word-storage + 65 var stack-storage: int-stack + 66 var stack/esi: (addr int-stack) <- address stack-storage + 67 initialize-int-stack stack, 0x10 + 68 $simplify:word-loop: { + 69 next-word in, word + 70 var done?/eax: boolean <- slice-empty? word + 71 compare done?, 0 + 72 break-if-!= + 73 # if word is an operator, perform it + 74 { + 75 var is-add?/eax: boolean <- slice-equal? word, "+" + 76 compare is-add?, 0 + 77 break-if-= + 78 var _b/eax: int <- pop-int-stack stack + 79 var b/edx: int <- copy _b + 80 var a/eax: int <- pop-int-stack stack + 81 a <- add b + 82 push-int-stack stack, a + 83 loop $simplify:word-loop + 84 } + 85 { + 86 var is-sub?/eax: boolean <- slice-equal? word, "-" + 87 compare is-sub?, 0 + 88 break-if-= + 89 var _b/eax: int <- pop-int-stack stack + 90 var b/edx: int <- copy _b + 91 var a/eax: int <- pop-int-stack stack + 92 a <- subtract b + 93 push-int-stack stack, a + 94 loop $simplify:word-loop + 95 } + 96 { + 97 var is-mul?/eax: boolean <- slice-equal? word, "*" + 98 compare is-mul?, 0 + 99 break-if-= +100 var _b/eax: int <- pop-int-stack stack +101 var b/edx: int <- copy _b +102 var a/eax: int <- pop-int-stack stack +103 a <- multiply b +104 push-int-stack stack, a +105 loop $simplify:word-loop +106 } +107 # otherwise it's an int +108 var n/eax: int <- parse-decimal-int-from-slice word +109 push-int-stack stack, n +110 loop +111 } +112 var result/eax: int <- pop-int-stack stack +113 return result +114 } +115 +116 fn initialize-int-stack _self: (addr int-stack), n: int { +117 var self/esi: (addr int-stack) <- copy _self +118 var d/edi: (addr handle array int) <- get self, data +119 populate d, n +120 var top/eax: (addr int) <- get self, top +121 copy-to *top, 0 +122 } +123 +124 fn push-int-stack _self: (addr int-stack), _val: int { +125 var self/esi: (addr int-stack) <- copy _self +126 var top-addr/ecx: (addr int) <- get self, top +127 var data-ah/edx: (addr handle array int) <- get self, data +128 var data/eax: (addr array int) <- lookup *data-ah +129 var top/edx: int <- copy *top-addr +130 var dest-addr/edx: (addr int) <- index data, top +131 var val/eax: int <- copy _val +132 copy-to *dest-addr, val +133 add-to *top-addr, 1 +134 } +135 +136 fn pop-int-stack _self: (addr int-stack) -> _/eax: int { +137 var self/esi: (addr int-stack) <- copy _self +138 var top-addr/ecx: (addr int) <- get self, top +139 { +140 compare *top-addr, 0 +141 break-if-> +142 return 0 +143 } +144 subtract-from *top-addr, 1 +145 var data-ah/edx: (addr handle array int) <- get self, data +146 var data/eax: (addr array int) <- lookup *data-ah +147 var top/edx: int <- copy *top-addr +148 var result-addr/eax: (addr int) <- index data, top +149 var val/eax: int <- copy *result-addr +150 return val +151 } diff --git a/html/shell/cell.mu.html b/html/shell/cell.mu.html index c5f1bc69..1b15ee5f 100644 --- a/html/shell/cell.mu.html +++ b/html/shell/cell.mu.html @@ -98,155 +98,169 @@ if ('onhashchange' in window) { 40 initialize-symbol out, val 41 } 42 - 43 fn allocate-stream _out: (addr handle cell) { - 44 var out/eax: (addr handle cell) <- copy _out - 45 allocate out - 46 var out-addr/eax: (addr cell) <- lookup *out - 47 var type/ecx: (addr int) <- get out-addr, type - 48 copy-to *type, 3/stream - 49 var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data - 50 populate-stream dest-ah, 0x40/max-stream-size - 51 } - 52 - 53 fn allocate-number _out: (addr handle cell) { - 54 var out/eax: (addr handle cell) <- copy _out - 55 allocate out - 56 var out-addr/eax: (addr cell) <- lookup *out - 57 var type/ecx: (addr int) <- get out-addr, type - 58 copy-to *type, 1/number - 59 } - 60 - 61 fn initialize-integer _out: (addr handle cell), n: int { - 62 var out/eax: (addr handle cell) <- copy _out - 63 var out-addr/eax: (addr cell) <- lookup *out - 64 var dest-addr/eax: (addr float) <- get out-addr, number-data - 65 var src/xmm0: float <- convert n - 66 copy-to *dest-addr, src - 67 } - 68 - 69 fn new-integer out: (addr handle cell), n: int { - 70 allocate-number out - 71 initialize-integer out, n - 72 } - 73 - 74 fn initialize-float _out: (addr handle cell), n: float { - 75 var out/eax: (addr handle cell) <- copy _out - 76 var out-addr/eax: (addr cell) <- lookup *out - 77 var dest-ah/eax: (addr float) <- get out-addr, number-data - 78 var src/xmm0: float <- copy n - 79 copy-to *dest-ah, src - 80 } - 81 - 82 fn new-float out: (addr handle cell), n: float { - 83 allocate-number out - 84 initialize-float out, n - 85 } - 86 - 87 fn allocate-pair out: (addr handle cell) { - 88 allocate out - 89 # new cells have type pair by default - 90 } - 91 - 92 fn initialize-pair _out: (addr handle cell), left: (handle cell), right: (handle cell) { - 93 var out/eax: (addr handle cell) <- copy _out - 94 var out-addr/eax: (addr cell) <- lookup *out - 95 var dest-ah/ecx: (addr handle cell) <- get out-addr, left - 96 copy-handle left, dest-ah - 97 dest-ah <- get out-addr, right - 98 copy-handle right, dest-ah + 43 fn symbol-equal? _in: (addr cell), name: (addr array byte) -> _/eax: boolean { + 44 var in/esi: (addr cell) <- copy _in + 45 var in-type/eax: (addr int) <- get in, type + 46 compare *in-type, 2/symbol + 47 { + 48 break-if-= + 49 return 0/false + 50 } + 51 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data + 52 var in-data/eax: (addr stream byte) <- lookup *in-data-ah + 53 var result/eax: boolean <- stream-data-equal? in-data, name + 54 return result + 55 } + 56 + 57 fn allocate-stream _out: (addr handle cell) { + 58 var out/eax: (addr handle cell) <- copy _out + 59 allocate out + 60 var out-addr/eax: (addr cell) <- lookup *out + 61 var type/ecx: (addr int) <- get out-addr, type + 62 copy-to *type, 3/stream + 63 var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data + 64 populate-stream dest-ah, 0x40/max-stream-size + 65 } + 66 + 67 fn allocate-number _out: (addr handle cell) { + 68 var out/eax: (addr handle cell) <- copy _out + 69 allocate out + 70 var out-addr/eax: (addr cell) <- lookup *out + 71 var type/ecx: (addr int) <- get out-addr, type + 72 copy-to *type, 1/number + 73 } + 74 + 75 fn initialize-integer _out: (addr handle cell), n: int { + 76 var out/eax: (addr handle cell) <- copy _out + 77 var out-addr/eax: (addr cell) <- lookup *out + 78 var dest-addr/eax: (addr float) <- get out-addr, number-data + 79 var src/xmm0: float <- convert n + 80 copy-to *dest-addr, src + 81 } + 82 + 83 fn new-integer out: (addr handle cell), n: int { + 84 allocate-number out + 85 initialize-integer out, n + 86 } + 87 + 88 fn initialize-float _out: (addr handle cell), n: float { + 89 var out/eax: (addr handle cell) <- copy _out + 90 var out-addr/eax: (addr cell) <- lookup *out + 91 var dest-ah/eax: (addr float) <- get out-addr, number-data + 92 var src/xmm0: float <- copy n + 93 copy-to *dest-ah, src + 94 } + 95 + 96 fn new-float out: (addr handle cell), n: float { + 97 allocate-number out + 98 initialize-float out, n 99 } 100 -101 fn new-pair out: (addr handle cell), left: (handle cell), right: (handle cell) { -102 allocate-pair out -103 initialize-pair out, left, right +101 fn allocate-pair out: (addr handle cell) { +102 allocate out +103 # new cells have type pair by default 104 } 105 -106 fn nil out: (addr handle cell) { -107 allocate-pair out -108 } -109 -110 fn allocate-primitive-function _out: (addr handle cell) { -111 var out/eax: (addr handle cell) <- copy _out -112 allocate out -113 var out-addr/eax: (addr cell) <- lookup *out -114 var type/ecx: (addr int) <- get out-addr, type -115 copy-to *type, 4/primitive-function -116 } -117 -118 fn initialize-primitive-function _out: (addr handle cell), n: int { -119 var out/eax: (addr handle cell) <- copy _out -120 var out-addr/eax: (addr cell) <- lookup *out -121 var dest-addr/eax: (addr int) <- get out-addr, index-data -122 var src/ecx: int <- copy n -123 copy-to *dest-addr, src -124 } -125 -126 fn new-primitive-function out: (addr handle cell), n: int { -127 allocate-primitive-function out -128 initialize-primitive-function out, n -129 } -130 -131 fn allocate-screen _out: (addr handle cell) { -132 var out/eax: (addr handle cell) <- copy _out -133 allocate out +106 fn initialize-pair _out: (addr handle cell), left: (handle cell), right: (handle cell) { +107 var out/eax: (addr handle cell) <- copy _out +108 var out-addr/eax: (addr cell) <- lookup *out +109 var dest-ah/ecx: (addr handle cell) <- get out-addr, left +110 copy-handle left, dest-ah +111 dest-ah <- get out-addr, right +112 copy-handle right, dest-ah +113 } +114 +115 fn new-pair out: (addr handle cell), left: (handle cell), right: (handle cell) { +116 allocate-pair out +117 initialize-pair out, left, right +118 } +119 +120 fn nil out: (addr handle cell) { +121 allocate-pair out +122 } +123 +124 fn allocate-primitive-function _out: (addr handle cell) { +125 var out/eax: (addr handle cell) <- copy _out +126 allocate out +127 var out-addr/eax: (addr cell) <- lookup *out +128 var type/ecx: (addr int) <- get out-addr, type +129 copy-to *type, 4/primitive-function +130 } +131 +132 fn initialize-primitive-function _out: (addr handle cell), n: int { +133 var out/eax: (addr handle cell) <- copy _out 134 var out-addr/eax: (addr cell) <- lookup *out -135 var type/ecx: (addr int) <- get out-addr, type -136 copy-to *type, 5/screen -137 } -138 -139 fn new-fake-screen _out: (addr handle cell), width: int, height: int, pixel-graphics?: boolean { -140 var out/eax: (addr handle cell) <- copy _out -141 allocate-screen out -142 var out-addr/eax: (addr cell) <- lookup *out -143 var dest-ah/eax: (addr handle screen) <- get out-addr, screen-data -144 allocate dest-ah -145 var dest-addr/eax: (addr screen) <- lookup *dest-ah -146 initialize-screen dest-addr, width, height, pixel-graphics? -147 } -148 -149 fn clear-screen-cell _self-ah: (addr handle cell) { -150 var self-ah/eax: (addr handle cell) <- copy _self-ah -151 var self/eax: (addr cell) <- lookup *self-ah -152 compare self, 0 -153 { -154 break-if-!= -155 return -156 } -157 var screen-ah/eax: (addr handle screen) <- get self, screen-data -158 var screen/eax: (addr screen) <- lookup *screen-ah -159 clear-screen screen -160 } -161 -162 fn allocate-keyboard _out: (addr handle cell) { -163 var out/eax: (addr handle cell) <- copy _out -164 allocate out -165 var out-addr/eax: (addr cell) <- lookup *out -166 var type/ecx: (addr int) <- get out-addr, type -167 copy-to *type, 6/keyboard -168 } -169 -170 fn new-fake-keyboard _out: (addr handle cell), capacity: int { -171 var out/eax: (addr handle cell) <- copy _out -172 allocate-keyboard out -173 var out-addr/eax: (addr cell) <- lookup *out -174 var dest-ah/eax: (addr handle gap-buffer) <- get out-addr, keyboard-data -175 allocate dest-ah -176 var dest-addr/eax: (addr gap-buffer) <- lookup *dest-ah -177 initialize-gap-buffer dest-addr, capacity -178 } -179 -180 fn rewind-keyboard-cell _self-ah: (addr handle cell) { -181 var self-ah/eax: (addr handle cell) <- copy _self-ah -182 var self/eax: (addr cell) <- lookup *self-ah -183 compare self, 0 -184 { -185 break-if-!= -186 return -187 } -188 var keyboard-ah/eax: (addr handle gap-buffer) <- get self, keyboard-data -189 var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah -190 rewind-gap-buffer keyboard -191 } +135 var dest-addr/eax: (addr int) <- get out-addr, index-data +136 var src/ecx: int <- copy n +137 copy-to *dest-addr, src +138 } +139 +140 fn new-primitive-function out: (addr handle cell), n: int { +141 allocate-primitive-function out +142 initialize-primitive-function out, n +143 } +144 +145 fn allocate-screen _out: (addr handle cell) { +146 var out/eax: (addr handle cell) <- copy _out +147 allocate out +148 var out-addr/eax: (addr cell) <- lookup *out +149 var type/ecx: (addr int) <- get out-addr, type +150 copy-to *type, 5/screen +151 } +152 +153 fn new-fake-screen _out: (addr handle cell), width: int, height: int, pixel-graphics?: boolean { +154 var out/eax: (addr handle cell) <- copy _out +155 allocate-screen out +156 var out-addr/eax: (addr cell) <- lookup *out +157 var dest-ah/eax: (addr handle screen) <- get out-addr, screen-data +158 allocate dest-ah +159 var dest-addr/eax: (addr screen) <- lookup *dest-ah +160 initialize-screen dest-addr, width, height, pixel-graphics? +161 } +162 +163 fn clear-screen-cell _self-ah: (addr handle cell) { +164 var self-ah/eax: (addr handle cell) <- copy _self-ah +165 var self/eax: (addr cell) <- lookup *self-ah +166 compare self, 0 +167 { +168 break-if-!= +169 return +170 } +171 var screen-ah/eax: (addr handle screen) <- get self, screen-data +172 var screen/eax: (addr screen) <- lookup *screen-ah +173 clear-screen screen +174 } +175 +176 fn allocate-keyboard _out: (addr handle cell) { +177 var out/eax: (addr handle cell) <- copy _out +178 allocate out +179 var out-addr/eax: (addr cell) <- lookup *out +180 var type/ecx: (addr int) <- get out-addr, type +181 copy-to *type, 6/keyboard +182 } +183 +184 fn new-fake-keyboard _out: (addr handle cell), capacity: int { +185 var out/eax: (addr handle cell) <- copy _out +186 allocate-keyboard out +187 var out-addr/eax: (addr cell) <- lookup *out +188 var dest-ah/eax: (addr handle gap-buffer) <- get out-addr, keyboard-data +189 allocate dest-ah +190 var dest-addr/eax: (addr gap-buffer) <- lookup *dest-ah +191 initialize-gap-buffer dest-addr, capacity +192 } +193 +194 fn rewind-keyboard-cell _self-ah: (addr handle cell) { +195 var self-ah/eax: (addr handle cell) <- copy _self-ah +196 var self/eax: (addr cell) <- lookup *self-ah +197 compare self, 0 +198 { +199 break-if-!= +200 return +201 } +202 var keyboard-ah/eax: (addr handle gap-buffer) <- get self, keyboard-data +203 var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah +204 rewind-gap-buffer keyboard +205 } diff --git a/html/shell/evaluate.mu.html b/html/shell/evaluate.mu.html index 41c008d3..f44b87c9 100644 --- a/html/shell/evaluate.mu.html +++ b/html/shell/evaluate.mu.html @@ -63,1060 +63,1134 @@ if ('onhashchange' in window) { 2 # we never modify `in` or `env` 3 # ignore 'screen-cell' on a first reading; it's a hack for sandboxes 4 # 'call-number' is just for showing intermediate progress; this is a _slow_ interpreter - 5 fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int { + 5 fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int { 6 # stack overflow? # disable when enabling Really-debug-print 7 check-stack - 8 show-stack-state - 9 # errors? skip - 10 { - 11 compare trace, 0 - 12 break-if-= - 13 var error?/eax: boolean <- has-errors? trace - 14 compare error?, 0/false - 15 break-if-= - 16 return + 8 { + 9 var screen-cell/eax: (addr handle cell) <- copy screen-cell + 10 compare screen-cell, 0 + 11 break-if-= + 12 var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell + 13 compare screen-cell-addr, 0 + 14 break-if-= + 15 # if screen-cell exists, we're probably not in a test + 16 show-stack-state 17 } - 18 var in/esi: (addr handle cell) <- copy _in - 19 # show intermediate progress on screen if necessary - 20 { - 21 compare screen-cell, 0 - 22 break-if-= - 23 var tmp/eax: int <- copy call-number - 24 tmp <- and 0xf # every 16 calls to evaluate - 25 compare tmp, 0 - 26 break-if-!= - 27 var screen-cell/eax: (addr handle cell) <- copy screen-cell - 28 var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell - 29 compare screen-cell-addr, 0 - 30 break-if-= - 31 var screen-obj-ah/eax: (addr handle screen) <- get screen-cell-addr, screen-data - 32 var screen-obj/eax: (addr screen) <- lookup *screen-obj-ah - 33 compare screen-obj, 0 - 34 break-if-= - 35 var y/ecx: int <- render-screen 0/screen, screen-obj, 0x70/xmin, 2/ymin - 36 } - 37 #? dump-cell in - 38 #? { - 39 #? var foo/eax: byte <- read-key 0/keyboard - 40 #? compare foo, 0 - 41 #? loop-if-= - 42 #? } - 43 +-- 14 lines: # trace "evaluate " in " in environment " env ----------------------------------------------------------------------------------------------------------------------------- - 57 trace-lower trace - 58 var in-addr/eax: (addr cell) <- lookup *in - 59 { - 60 var nil?/eax: boolean <- nil? in-addr - 61 compare nil?, 0/false - 62 break-if-= - 63 # nil is a literal - 64 trace-text trace, "eval", "nil" - 65 copy-object _in, out - 66 trace-higher trace - 67 return - 68 } - 69 var in-type/ecx: (addr int) <- get in-addr, type - 70 compare *in-type, 1/number - 71 { - 72 break-if-!= - 73 # numbers are literals - 74 trace-text trace, "eval", "number" - 75 copy-object _in, out - 76 trace-higher trace - 77 return - 78 } - 79 compare *in-type, 2/symbol + 18 # errors? skip + 19 { + 20 compare trace, 0 + 21 break-if-= + 22 var error?/eax: boolean <- has-errors? trace + 23 compare error?, 0/false + 24 break-if-= + 25 return + 26 } + 27 var in/esi: (addr handle cell) <- copy _in + 28 # show intermediate progress on screen if necessary + 29 { + 30 compare screen-cell, 0 + 31 break-if-= + 32 var tmp/eax: int <- copy call-number + 33 tmp <- and 0xf # every 16 calls to evaluate + 34 compare tmp, 0 + 35 break-if-!= + 36 var screen-cell/eax: (addr handle cell) <- copy screen-cell + 37 var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell + 38 compare screen-cell-addr, 0 + 39 break-if-= + 40 var screen-obj-ah/eax: (addr handle screen) <- get screen-cell-addr, screen-data + 41 var screen-obj/eax: (addr screen) <- lookup *screen-obj-ah + 42 compare screen-obj, 0 + 43 break-if-= + 44 var y/ecx: int <- render-screen 0/screen, screen-obj, 0x70/xmin, 1/ymin + 45 } + 46 #? dump-cell in + 47 #? { + 48 #? var foo/eax: byte <- read-key 0/keyboard + 49 #? compare foo, 0 + 50 #? loop-if-= + 51 #? } + 52 +-- 14 lines: # trace "evaluate " in " in environment " env ----------------------------------------------------------------------------------------------------------------------------- + 66 trace-lower trace + 67 var in-addr/eax: (addr cell) <- lookup *in + 68 { + 69 var nil?/eax: boolean <- nil? in-addr + 70 compare nil?, 0/false + 71 break-if-= + 72 # nil is a literal + 73 trace-text trace, "eval", "nil" + 74 copy-object _in, out + 75 trace-higher trace + 76 return + 77 } + 78 var in-type/ecx: (addr int) <- get in-addr, type + 79 compare *in-type, 1/number 80 { 81 break-if-!= - 82 trace-text trace, "eval", "symbol" - 83 debug-print "a", 7/fg, 0/bg - 84 lookup-symbol in-addr, out, env-h, globals, trace, screen-cell, keyboard-cell - 85 debug-print "z", 7/fg, 0/bg - 86 trace-higher trace - 87 return - 88 } - 89 compare *in-type, 5/screen - 90 { - 91 break-if-!= - 92 trace-text trace, "eval", "screen" + 82 # numbers are literals + 83 trace-text trace, "eval", "number" + 84 copy-object _in, out + 85 trace-higher trace + 86 return + 87 } + 88 compare *in-type, 3/stream + 89 { + 90 break-if-!= + 91 # streams are literals + 92 trace-text trace, "eval", "stream" 93 copy-object _in, out 94 trace-higher trace 95 return 96 } - 97 compare *in-type, 6/keyboard + 97 compare *in-type, 2/symbol 98 { 99 break-if-!= - 100 trace-text trace, "eval", "keyboard" - 101 copy-object _in, out - 102 trace-higher trace - 103 return - 104 } - 105 # in-addr is a syntax tree - 106 $evaluate:anonymous-function: { - 107 # trees starting with "fn" are anonymous functions - 108 var expr/esi: (addr cell) <- copy in-addr - 109 # if its first elem is not "fn", break - 110 var in-addr/edx: (addr cell) <- copy in-addr - 111 var first-ah/ecx: (addr handle cell) <- get in-addr, left - 112 var first/eax: (addr cell) <- lookup *first-ah - 113 var fn?/eax: boolean <- fn? first - 114 compare fn?, 0/false - 115 break-if-= - 116 # turn (fn ...) into (fn env ...) - 117 trace-text trace, "eval", "anonymous function" - 118 var rest-ah/eax: (addr handle cell) <- get in-addr, right - 119 var tmp: (handle cell) - 120 var tmp-ah/edi: (addr handle cell) <- address tmp - 121 new-pair tmp-ah, env-h, *rest-ah - 122 new-pair out, *first-ah, *tmp-ah - 123 trace-higher trace - 124 return - 125 } - 126 # builtins with "special" evaluation rules - 127 $evaluate:quote: { - 128 # trees starting with single quote create literals - 129 var expr/esi: (addr cell) <- copy in-addr - 130 # if its first elem is not "'", break - 131 var first-ah/ecx: (addr handle cell) <- get in-addr, left - 132 var rest-ah/edx: (addr handle cell) <- get in-addr, right - 133 var first/eax: (addr cell) <- lookup *first-ah - 134 var first-type/ecx: (addr int) <- get first, type - 135 compare *first-type, 2/symbol - 136 break-if-!= - 137 var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data - 138 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 139 var quote?/eax: boolean <- stream-data-equal? sym-data, "'" - 140 compare quote?, 0/false - 141 break-if-= - 142 # - 143 trace-text trace, "eval", "quote" - 144 copy-object rest-ah, out - 145 trace-higher trace - 146 return - 147 } - 148 $evaluate:def: { - 149 # trees starting with "def" define globals - 150 var expr/esi: (addr cell) <- copy in-addr - 151 # if its first elem is not "def", break - 152 var first-ah/ecx: (addr handle cell) <- get in-addr, left - 153 var rest-ah/edx: (addr handle cell) <- get in-addr, right - 154 var first/eax: (addr cell) <- lookup *first-ah - 155 var first-type/ecx: (addr int) <- get first, type - 156 compare *first-type, 2/symbol - 157 break-if-!= - 158 var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data - 159 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 160 var def?/eax: boolean <- stream-data-equal? sym-data, "def" - 161 compare def?, 0/false - 162 break-if-= - 163 # - 164 trace-text trace, "eval", "def" - 165 trace-text trace, "eval", "evaluating second arg" - 166 var rest/eax: (addr cell) <- lookup *rest-ah - 167 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 168 { - 169 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 170 var first-arg-type/eax: (addr int) <- get first-arg, type - 171 compare *first-arg-type, 2/symbol - 172 break-if-= - 173 error trace, "first arg to def must be a symbol" - 174 trace-higher trace - 175 return - 176 } - 177 rest-ah <- get rest, right - 178 rest <- lookup *rest-ah - 179 var second-arg-ah/edx: (addr handle cell) <- get rest, left - 180 debug-print "P", 4/fg, 0/bg - 181 increment call-number - 182 evaluate second-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 183 debug-print "Q", 4/fg, 0/bg - 184 trace-text trace, "eval", "saving global binding" - 185 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 186 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data - 187 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah - 188 var tmp-string: (handle array byte) - 189 var tmp-ah/edx: (addr handle array byte) <- address tmp-string - 190 rewind-stream first-arg-data - 191 stream-to-array first-arg-data, tmp-ah - 192 var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah - 193 var out2/edi: (addr handle cell) <- copy out - 194 append-global globals, first-arg-data-string, *out2, trace - 195 trace-higher trace - 196 return - 197 } - 198 $evaluate:set: { - 199 # trees starting with "set" mutate bindings - 200 var expr/esi: (addr cell) <- copy in-addr - 201 # if its first elem is not "set", break - 202 var first-ah/ecx: (addr handle cell) <- get in-addr, left - 203 var rest-ah/edx: (addr handle cell) <- get in-addr, right - 204 var first/eax: (addr cell) <- lookup *first-ah - 205 var first-type/ecx: (addr int) <- get first, type - 206 compare *first-type, 2/symbol - 207 break-if-!= - 208 var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data - 209 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 210 var set?/eax: boolean <- stream-data-equal? sym-data, "set" - 211 compare set?, 0/false - 212 break-if-= - 213 # - 214 trace-text trace, "eval", "set" - 215 trace-text trace, "eval", "evaluating second arg" - 216 var rest/eax: (addr cell) <- lookup *rest-ah - 217 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 218 { - 219 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 220 var first-arg-type/eax: (addr int) <- get first-arg, type - 221 compare *first-arg-type, 2/symbol - 222 break-if-= - 223 error trace, "first arg to set must be a symbol" - 224 trace-higher trace - 225 return - 226 } - 227 rest-ah <- get rest, right - 228 rest <- lookup *rest-ah - 229 var second-arg-ah/edx: (addr handle cell) <- get rest, left - 230 debug-print "P", 4/fg, 0/bg - 231 increment call-number - 232 evaluate second-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 233 debug-print "Q", 4/fg, 0/bg - 234 trace-text trace, "eval", "mutating binding" - 235 var first-arg/eax: (addr cell) <- lookup *first-arg-ah - 236 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data - 237 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah - 238 mutate-binding first-arg-data, out, env-h, globals, trace - 239 trace-higher trace - 240 return - 241 } - 242 $evaluate:if: { - 243 # trees starting with "if" are conditionals - 244 var expr/esi: (addr cell) <- copy in-addr - 245 # if its first elem is not "if", break - 246 var first-ah/ecx: (addr handle cell) <- get in-addr, left - 247 var rest-ah/edx: (addr handle cell) <- get in-addr, right - 248 var first/eax: (addr cell) <- lookup *first-ah - 249 var first-type/ecx: (addr int) <- get first, type - 250 compare *first-type, 2/symbol - 251 break-if-!= - 252 var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data - 253 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 254 var if?/eax: boolean <- stream-data-equal? sym-data, "if" - 255 compare if?, 0/false - 256 break-if-= - 257 # - 258 trace-text trace, "eval", "if" - 259 trace-text trace, "eval", "evaluating first arg" - 260 var rest/eax: (addr cell) <- lookup *rest-ah - 261 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 262 var guard-h: (handle cell) - 263 var guard-ah/esi: (addr handle cell) <- address guard-h - 264 debug-print "R", 4/fg, 0/bg - 265 increment call-number - 266 evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 267 debug-print "S", 4/fg, 0/bg - 268 rest-ah <- get rest, right - 269 rest <- lookup *rest-ah - 270 var branch-ah/edi: (addr handle cell) <- get rest, left - 271 var guard-a/eax: (addr cell) <- lookup *guard-ah - 272 var skip-to-third-arg?/eax: boolean <- nil? guard-a - 273 compare skip-to-third-arg?, 0/false - 274 { - 275 break-if-= - 276 trace-text trace, "eval", "skipping to third arg" - 277 var rest/eax: (addr cell) <- lookup *rest-ah - 278 rest-ah <- get rest, right - 279 rest <- lookup *rest-ah - 280 branch-ah <- get rest, left - 281 } - 282 debug-print "T", 4/fg, 0/bg - 283 increment call-number - 284 evaluate branch-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 285 debug-print "U", 4/fg, 0/bg - 286 trace-higher trace - 287 return - 288 } - 289 $evaluate:while: { - 290 # trees starting with "while" are loops - 291 var expr/esi: (addr cell) <- copy in-addr - 292 # if its first elem is not "while", break - 293 var first-ah/ecx: (addr handle cell) <- get in-addr, left - 294 var rest-ah/edx: (addr handle cell) <- get in-addr, right - 295 var first/eax: (addr cell) <- lookup *first-ah - 296 var first-type/ecx: (addr int) <- get first, type - 297 compare *first-type, 2/symbol - 298 break-if-!= - 299 var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data - 300 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 301 var while?/eax: boolean <- stream-data-equal? sym-data, "while" - 302 compare while?, 0/false - 303 break-if-= - 304 # - 305 trace-text trace, "eval", "while" - 306 var rest/eax: (addr cell) <- lookup *rest-ah - 307 var first-arg-ah/ecx: (addr handle cell) <- get rest, left - 308 rest-ah <- get rest, right - 309 var guard-h: (handle cell) - 310 var guard-ah/esi: (addr handle cell) <- address guard-h - 311 $evaluate:while:loop-execution: { - 312 { - 313 compare trace, 0 - 314 break-if-= - 315 var error?/eax: boolean <- has-errors? trace - 316 compare error?, 0/false - 317 break-if-!= $evaluate:while:loop-execution - 318 } - 319 trace-text trace, "eval", "loop termination check" - 320 debug-print "V", 4/fg, 0/bg - 321 increment call-number - 322 evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 323 debug-print "W", 4/fg, 0/bg - 324 var guard-a/eax: (addr cell) <- lookup *guard-ah - 325 var done?/eax: boolean <- nil? guard-a - 326 compare done?, 0/false - 327 break-if-!= - 328 evaluate-exprs rest-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 329 loop - 330 } - 331 trace-text trace, "eval", "loop terminated" - 332 trace-higher trace - 333 return - 334 } - 335 trace-text trace, "eval", "function call" - 336 trace-text trace, "eval", "evaluating list elements" - 337 trace-lower trace - 338 var evaluated-list-storage: (handle cell) - 339 var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage - 340 var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah - 341 var curr/ecx: (addr cell) <- copy in-addr - 342 $evaluate-list:loop: { - 343 allocate-pair curr-out-ah - 344 var nil?/eax: boolean <- nil? curr - 345 compare nil?, 0/false - 346 break-if-!= - 347 # eval left - 348 var curr-out/eax: (addr cell) <- lookup *curr-out-ah - 349 var left-out-ah/edi: (addr handle cell) <- get curr-out, left - 350 var left-ah/esi: (addr handle cell) <- get curr, left - 351 debug-print "A", 4/fg, 0/bg - 352 increment call-number - 353 evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 354 debug-print "B", 4/fg, 0/bg - 355 # - 356 curr-out-ah <- get curr-out, right - 357 var right-ah/eax: (addr handle cell) <- get curr, right - 358 var right/eax: (addr cell) <- lookup *right-ah - 359 curr <- copy right - 360 loop - 361 } - 362 trace-higher trace - 363 var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah - 364 var function-ah/ecx: (addr handle cell) <- get evaluated-list, left - 365 var args-ah/edx: (addr handle cell) <- get evaluated-list, right - 366 debug-print "C", 4/fg, 0/bg - 367 apply function-ah, args-ah, out, globals, trace, screen-cell, keyboard-cell, call-number - 368 debug-print "Y", 4/fg, 0/bg - 369 trace-higher trace - 370 +-- 11 lines: # trace "=> " out --------------------------------------------------------------------------------------------------------------------------------------------------------- - 381 debug-print "Z", 4/fg, 0/bg - 382 } - 383 - 384 fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int { - 385 var f-ah/eax: (addr handle cell) <- copy _f-ah - 386 var _f/eax: (addr cell) <- lookup *f-ah - 387 var f/esi: (addr cell) <- copy _f - 388 # call primitive functions - 389 { - 390 var f-type/eax: (addr int) <- get f, type - 391 compare *f-type, 4/primitive-function - 392 break-if-!= - 393 apply-primitive f, args-ah, out, globals, trace - 394 return - 395 } - 396 # if it's not a primitive function it must be an anonymous function - 397 +-- 14 lines: # trace "apply anonymous function " f " in environment " env -------------------------------------------------------------------------------------------------------------- + 100 trace-text trace, "eval", "symbol" + 101 debug-print "a", 7/fg, 0xc5/bg=blue-bg + 102 lookup-symbol in-addr, out, env-h, globals, trace, screen-cell, keyboard-cell + 103 debug-print "z", 7/fg, 0xc5/bg=blue-bg + 104 trace-higher trace + 105 return + 106 } + 107 compare *in-type, 5/screen + 108 { + 109 break-if-!= + 110 trace-text trace, "eval", "screen" + 111 copy-object _in, out + 112 trace-higher trace + 113 return + 114 } + 115 compare *in-type, 6/keyboard + 116 { + 117 break-if-!= + 118 trace-text trace, "eval", "keyboard" + 119 copy-object _in, out + 120 trace-higher trace + 121 return + 122 } + 123 # in-addr is a syntax tree + 124 $evaluate:anonymous-function: { + 125 # trees starting with "fn" are anonymous functions + 126 var expr/esi: (addr cell) <- copy in-addr + 127 # if its first elem is not "fn", break + 128 var in-addr/edx: (addr cell) <- copy in-addr + 129 var first-ah/ecx: (addr handle cell) <- get in-addr, left + 130 var first/eax: (addr cell) <- lookup *first-ah + 131 var fn?/eax: boolean <- fn? first + 132 compare fn?, 0/false + 133 break-if-= + 134 # turn (fn ...) into (fn env ...) + 135 trace-text trace, "eval", "anonymous function" + 136 var rest-ah/eax: (addr handle cell) <- get in-addr, right + 137 var tmp: (handle cell) + 138 var tmp-ah/edi: (addr handle cell) <- address tmp + 139 new-pair tmp-ah, env-h, *rest-ah + 140 new-pair out, *first-ah, *tmp-ah + 141 trace-higher trace + 142 return + 143 } + 144 # builtins with "special" evaluation rules + 145 $evaluate:quote: { + 146 # trees starting with single quote create literals + 147 var expr/esi: (addr cell) <- copy in-addr + 148 # if its first elem is not "'", break + 149 var first-ah/ecx: (addr handle cell) <- get in-addr, left + 150 var rest-ah/edx: (addr handle cell) <- get in-addr, right + 151 var first/eax: (addr cell) <- lookup *first-ah + 152 var quote?/eax: boolean <- symbol-equal? first, "'" + 153 compare quote?, 0/false + 154 break-if-= + 155 # + 156 trace-text trace, "eval", "quote" + 157 copy-object rest-ah, out + 158 trace-higher trace + 159 return + 160 } + 161 $evaluate:def: { + 162 # trees starting with "def" define globals + 163 var expr/esi: (addr cell) <- copy in-addr + 164 # if its first elem is not "def", break + 165 var first-ah/ecx: (addr handle cell) <- get in-addr, left + 166 var rest-ah/edx: (addr handle cell) <- get in-addr, right + 167 var first/eax: (addr cell) <- lookup *first-ah + 168 var def?/eax: boolean <- symbol-equal? first, "def" + 169 compare def?, 0/false + 170 break-if-= + 171 # + 172 trace-text trace, "eval", "def" + 173 trace-text trace, "eval", "evaluating second arg" + 174 var rest/eax: (addr cell) <- lookup *rest-ah + 175 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 176 { + 177 var first-arg/eax: (addr cell) <- lookup *first-arg-ah + 178 var first-arg-type/eax: (addr int) <- get first-arg, type + 179 compare *first-arg-type, 2/symbol + 180 break-if-= + 181 error trace, "first arg to def must be a symbol" + 182 trace-higher trace + 183 return + 184 } + 185 rest-ah <- get rest, right + 186 rest <- lookup *rest-ah + 187 var second-arg-ah/edx: (addr handle cell) <- get rest, left + 188 debug-print "P", 4/fg, 0xc5/bg=blue-bg + 189 increment call-number + 190 evaluate second-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number + 191 debug-print "Q", 4/fg, 0xc5/bg=blue-bg + 192 trace-text trace, "eval", "saving global binding" + 193 var first-arg/eax: (addr cell) <- lookup *first-arg-ah + 194 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data + 195 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah + 196 var tmp-string: (handle array byte) + 197 var tmp-ah/edx: (addr handle array byte) <- address tmp-string + 198 rewind-stream first-arg-data + 199 stream-to-array first-arg-data, tmp-ah + 200 var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah + 201 var out2/edi: (addr handle cell) <- copy out + 202 assign-or-create-global globals, first-arg-data-string, *out2, trace + 203 trace-higher trace + 204 return + 205 } + 206 $evaluate:set: { + 207 # trees starting with "set" mutate bindings + 208 var expr/esi: (addr cell) <- copy in-addr + 209 # if its first elem is not "set", break + 210 var first-ah/ecx: (addr handle cell) <- get in-addr, left + 211 var rest-ah/edx: (addr handle cell) <- get in-addr, right + 212 var first/eax: (addr cell) <- lookup *first-ah + 213 var set?/eax: boolean <- symbol-equal? first, "set" + 214 compare set?, 0/false + 215 break-if-= + 216 # + 217 trace-text trace, "eval", "set" + 218 trace-text trace, "eval", "evaluating second arg" + 219 var rest/eax: (addr cell) <- lookup *rest-ah + 220 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 221 { + 222 var first-arg/eax: (addr cell) <- lookup *first-arg-ah + 223 var first-arg-type/eax: (addr int) <- get first-arg, type + 224 compare *first-arg-type, 2/symbol + 225 break-if-= + 226 error trace, "first arg to set must be a symbol" + 227 trace-higher trace + 228 return + 229 } + 230 rest-ah <- get rest, right + 231 rest <- lookup *rest-ah + 232 var second-arg-ah/edx: (addr handle cell) <- get rest, left + 233 debug-print "P", 4/fg, 0xc5/bg=blue-bg + 234 increment call-number + 235 evaluate second-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number + 236 debug-print "Q", 4/fg, 0xc5/bg=blue-bg + 237 trace-text trace, "eval", "mutating binding" + 238 var first-arg/eax: (addr cell) <- lookup *first-arg-ah + 239 var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data + 240 var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah + 241 mutate-binding first-arg-data, out, env-h, globals, trace + 242 trace-higher trace + 243 return + 244 } + 245 $evaluate:and: { + 246 var expr/esi: (addr cell) <- copy in-addr + 247 # if its first elem is not "and", break + 248 var first-ah/ecx: (addr handle cell) <- get in-addr, left + 249 var rest-ah/edx: (addr handle cell) <- get in-addr, right + 250 var first/eax: (addr cell) <- lookup *first-ah + 251 var and?/eax: boolean <- symbol-equal? first, "and" + 252 compare and?, 0/false + 253 break-if-= + 254 # + 255 trace-text trace, "eval", "and" + 256 trace-text trace, "eval", "evaluating first arg" + 257 var rest/eax: (addr cell) <- lookup *rest-ah + 258 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 259 debug-print "R2", 4/fg, 0xc5/bg=blue-bg + 260 increment call-number + 261 evaluate first-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number + 262 debug-print "S2", 4/fg, 0xc5/bg=blue-bg + 263 # if first arg is nil, short-circuit + 264 var out-ah/eax: (addr handle cell) <- copy out + 265 var out-a/eax: (addr cell) <- lookup *out-ah + 266 var nil?/eax: boolean <- nil? out-a + 267 compare nil?, 0/false + 268 { + 269 break-if-= + 270 return + 271 } + 272 var rest/eax: (addr cell) <- lookup *rest-ah + 273 rest-ah <- get rest, right + 274 rest <- lookup *rest-ah + 275 var second-ah/eax: (addr handle cell) <- get rest, left + 276 debug-print "T2", 4/fg, 0xc5/bg=blue-bg + 277 increment call-number + 278 evaluate second-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number + 279 debug-print "U2", 4/fg, 0xc5/bg=blue-bg + 280 trace-higher trace + 281 return + 282 } + 283 $evaluate:or: { + 284 var expr/esi: (addr cell) <- copy in-addr + 285 # if its first elem is not "or", break + 286 var first-ah/ecx: (addr handle cell) <- get in-addr, left + 287 var rest-ah/edx: (addr handle cell) <- get in-addr, right + 288 var first/eax: (addr cell) <- lookup *first-ah + 289 var or?/eax: boolean <- symbol-equal? first, "or" + 290 compare or?, 0/false + 291 break-if-= + 292 # + 293 trace-text trace, "eval", "or" + 294 trace-text trace, "eval", "evaluating first arg" + 295 var rest/eax: (addr cell) <- lookup *rest-ah + 296 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 297 debug-print "R2", 4/fg, 0xc5/bg=blue-bg + 298 increment call-number + 299 evaluate first-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number + 300 debug-print "S2", 4/fg, 0xc5/bg=blue-bg + 301 # if first arg is not nil, short-circuit + 302 var out-ah/eax: (addr handle cell) <- copy out + 303 var out-a/eax: (addr cell) <- lookup *out-ah + 304 var nil?/eax: boolean <- nil? out-a + 305 compare nil?, 0/false + 306 { + 307 break-if-!= + 308 return + 309 } + 310 var rest/eax: (addr cell) <- lookup *rest-ah + 311 rest-ah <- get rest, right + 312 rest <- lookup *rest-ah + 313 var second-ah/eax: (addr handle cell) <- get rest, left + 314 debug-print "T2", 4/fg, 0xc5/bg=blue-bg + 315 increment call-number + 316 evaluate second-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number + 317 debug-print "U2", 4/fg, 0xc5/bg=blue-bg + 318 trace-higher trace + 319 return + 320 } + 321 $evaluate:if: { + 322 # trees starting with "if" are conditionals + 323 var expr/esi: (addr cell) <- copy in-addr + 324 # if its first elem is not "if", break + 325 var first-ah/ecx: (addr handle cell) <- get in-addr, left + 326 var rest-ah/edx: (addr handle cell) <- get in-addr, right + 327 var first/eax: (addr cell) <- lookup *first-ah + 328 var if?/eax: boolean <- symbol-equal? first, "if" + 329 compare if?, 0/false + 330 break-if-= + 331 # + 332 trace-text trace, "eval", "if" + 333 trace-text trace, "eval", "evaluating first arg" + 334 var rest/eax: (addr cell) <- lookup *rest-ah + 335 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 336 var guard-h: (handle cell) + 337 var guard-ah/esi: (addr handle cell) <- address guard-h + 338 debug-print "R", 4/fg, 0xc5/bg=blue-bg + 339 increment call-number + 340 evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number + 341 debug-print "S", 4/fg, 0xc5/bg=blue-bg + 342 rest-ah <- get rest, right + 343 rest <- lookup *rest-ah + 344 var branch-ah/edi: (addr handle cell) <- get rest, left + 345 var guard-a/eax: (addr cell) <- lookup *guard-ah + 346 var skip-to-third-arg?/eax: boolean <- nil? guard-a + 347 compare skip-to-third-arg?, 0/false + 348 { + 349 break-if-= + 350 trace-text trace, "eval", "skipping to third arg" + 351 var rest/eax: (addr cell) <- lookup *rest-ah + 352 rest-ah <- get rest, right + 353 rest <- lookup *rest-ah + 354 branch-ah <- get rest, left + 355 } + 356 debug-print "T", 4/fg, 0xc5/bg=blue-bg + 357 increment call-number + 358 evaluate branch-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number + 359 debug-print "U", 4/fg, 0xc5/bg=blue-bg + 360 trace-higher trace + 361 return + 362 } + 363 $evaluate:while: { + 364 # trees starting with "while" are loops + 365 var expr/esi: (addr cell) <- copy in-addr + 366 # if its first elem is not "while", break + 367 var first-ah/ecx: (addr handle cell) <- get in-addr, left + 368 var rest-ah/edx: (addr handle cell) <- get in-addr, right + 369 var first/eax: (addr cell) <- lookup *first-ah + 370 var first-type/ecx: (addr int) <- get first, type + 371 compare *first-type, 2/symbol + 372 break-if-!= + 373 var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data + 374 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah + 375 var while?/eax: boolean <- stream-data-equal? sym-data, "while" + 376 compare while?, 0/false + 377 break-if-= + 378 # + 379 trace-text trace, "eval", "while" + 380 var rest/eax: (addr cell) <- lookup *rest-ah + 381 var first-arg-ah/ecx: (addr handle cell) <- get rest, left + 382 rest-ah <- get rest, right + 383 var guard-h: (handle cell) + 384 var guard-ah/esi: (addr handle cell) <- address guard-h + 385 $evaluate:while:loop-execution: { + 386 { + 387 compare trace, 0 + 388 break-if-= + 389 var error?/eax: boolean <- has-errors? trace + 390 compare error?, 0/false + 391 break-if-!= $evaluate:while:loop-execution + 392 } + 393 trace-text trace, "eval", "loop termination check" + 394 debug-print "V", 4/fg, 0xc5/bg=blue-bg + 395 increment call-number + 396 evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number + 397 debug-print "W", 4/fg, 0xc5/bg=blue-bg + 398 var guard-a/eax: (addr cell) <- lookup *guard-ah + 399 var done?/eax: boolean <- nil? guard-a + 400 compare done?, 0/false + 401 break-if-!= + 402 evaluate-exprs rest-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number + 403 loop + 404 } + 405 trace-text trace, "eval", "loop terminated" + 406 trace-higher trace + 407 return + 408 } + 409 trace-text trace, "eval", "function call" + 410 trace-text trace, "eval", "evaluating list elements" 411 trace-lower trace - 412 { - 413 var f-type/ecx: (addr int) <- get f, type - 414 compare *f-type, 0/pair - 415 break-if-!= - 416 var first-ah/eax: (addr handle cell) <- get f, left - 417 var first/eax: (addr cell) <- lookup *first-ah - 418 var fn?/eax: boolean <- fn? first - 419 compare fn?, 0/false - 420 break-if-= - 421 var rest-ah/esi: (addr handle cell) <- get f, right - 422 var rest/eax: (addr cell) <- lookup *rest-ah - 423 var callee-env-ah/edx: (addr handle cell) <- get rest, left - 424 rest-ah <- get rest, right - 425 rest <- lookup *rest-ah - 426 var params-ah/ecx: (addr handle cell) <- get rest, left - 427 var body-ah/eax: (addr handle cell) <- get rest, right - 428 debug-print "D", 7/fg, 0/bg - 429 apply-function params-ah, args-ah, body-ah, out, *callee-env-ah, globals, trace, screen-cell, keyboard-cell, call-number - 430 debug-print "Y", 7/fg, 0/bg - 431 trace-higher trace - 432 return - 433 } - 434 error trace, "unknown function" - 435 } - 436 - 437 fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), body-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int { - 438 # push bindings for params to env - 439 var new-env-h: (handle cell) - 440 var new-env-ah/esi: (addr handle cell) <- address new-env-h - 441 push-bindings params-ah, args-ah, env-h, new-env-ah, trace - 442 # - 443 evaluate-exprs body-ah, out, new-env-h, globals, trace, screen-cell, keyboard-cell, call-number - 444 } - 445 - 446 fn evaluate-exprs _exprs-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int { - 447 # eval all exprs, writing result to `out` each time - 448 var exprs-ah/ecx: (addr handle cell) <- copy _exprs-ah - 449 $evaluate-exprs:loop: { - 450 var exprs/eax: (addr cell) <- lookup *exprs-ah - 451 # stop when exprs is nil - 452 { - 453 var exprs-nil?/eax: boolean <- nil? exprs - 454 compare exprs-nil?, 0/false - 455 break-if-!= $evaluate-exprs:loop - 456 } - 457 # evaluate each expression, writing result to `out` - 458 { - 459 var curr-ah/eax: (addr handle cell) <- get exprs, left - 460 debug-print "E", 7/fg, 0/bg - 461 increment call-number - 462 evaluate curr-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number - 463 debug-print "X", 7/fg, 0/bg - 464 } - 465 # - 466 exprs-ah <- get exprs, right - 467 loop - 468 } - 469 # `out` contains result of evaluating final expression - 470 } - 471 - 472 # Bind params to corresponding args and add the bindings to old-env. Return - 473 # the result in env-ah. - 474 # - 475 # We never modify old-env, but we point to it. This way other parts of the - 476 # interpreter can continue using old-env, and everything works harmoniously - 477 # even though no cells are copied around. - 478 # - 479 # env should always be a DAG (ignoring internals of values). It doesn't have - 480 # to be a tree (some values may be shared), but there are also no cycles. - 481 # - 482 # Learn more: https://en.wikipedia.org/wiki/Persistent_data_structure - 483 fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), old-env-h: (handle cell), env-ah: (addr handle cell), trace: (addr trace) { - 484 var params-ah/edx: (addr handle cell) <- copy _params-ah - 485 var args-ah/ebx: (addr handle cell) <- copy _args-ah - 486 var _params/eax: (addr cell) <- lookup *params-ah - 487 var params/esi: (addr cell) <- copy _params - 488 { - 489 var params-nil?/eax: boolean <- nil? params - 490 compare params-nil?, 0/false - 491 break-if-= - 492 # nil is a literal - 493 trace-text trace, "eval", "done with push-bindings" - 494 copy-handle old-env-h, env-ah - 495 return - 496 } - 497 # Params can only be symbols or pairs. Args can be anything. - 498 +-- 16 lines: # trace "pushing bindings from " params " to " args ----------------------------------------------------------------------------------------------------------------------- - 514 trace-lower trace - 515 var params-type/eax: (addr int) <- get params, type - 516 compare *params-type, 2/symbol - 517 { - 518 break-if-!= - 519 trace-text trace, "eval", "symbol; binding to all remaining args" - 520 # create a new binding - 521 var new-binding-storage: (handle cell) - 522 var new-binding-ah/eax: (addr handle cell) <- address new-binding-storage - 523 new-pair new-binding-ah, *params-ah, *args-ah - 524 # push it to env - 525 new-pair env-ah, *new-binding-ah, old-env-h - 526 trace-higher trace - 527 return - 528 } - 529 compare *params-type, 0/pair - 530 { - 531 break-if-= - 532 error trace, "cannot bind a non-symbol" - 533 trace-higher trace - 534 return - 535 } - 536 var _args/eax: (addr cell) <- lookup *args-ah - 537 var args/edi: (addr cell) <- copy _args - 538 # params is now a pair, so args must be also - 539 var args-type/eax: (addr int) <- get args, type - 540 compare *args-type, 0/pair - 541 { - 542 break-if-= - 543 error trace, "args not in a proper list" - 544 trace-higher trace - 545 return - 546 } - 547 var intermediate-env-storage: (handle cell) - 548 var intermediate-env-ah/edx: (addr handle cell) <- address intermediate-env-storage - 549 var first-param-ah/eax: (addr handle cell) <- get params, left - 550 var first-arg-ah/ecx: (addr handle cell) <- get args, left - 551 push-bindings first-param-ah, first-arg-ah, old-env-h, intermediate-env-ah, trace - 552 var remaining-params-ah/eax: (addr handle cell) <- get params, right - 553 var remaining-args-ah/ecx: (addr handle cell) <- get args, right - 554 push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace - 555 trace-higher trace - 556 } - 557 - 558 fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { - 559 # trace sym - 560 { - 561 compare trace, 0 - 562 break-if-= - 563 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` - 564 var stream/ecx: (addr stream byte) <- address stream-storage - 565 write stream, "look up " - 566 var sym2/eax: (addr cell) <- copy sym - 567 var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data - 568 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah - 569 rewind-stream sym-data - 570 write-stream stream, sym-data - 571 write stream, " in " - 572 var env-ah/eax: (addr handle cell) <- address env-h - 573 print-cell env-ah, stream, 0/no-trace - 574 trace trace, "eval", stream - 575 } - 576 trace-lower trace - 577 var _env/eax: (addr cell) <- lookup env-h - 578 var env/ebx: (addr cell) <- copy _env - 579 # if env is not a list, abort - 580 { - 581 var env-type/ecx: (addr int) <- get env, type - 582 compare *env-type, 0/pair - 583 break-if-= - 584 error trace, "eval found a non-list environment" - 585 trace-higher trace - 586 return - 587 } - 588 # if env is nil, look up in globals - 589 { - 590 var env-nil?/eax: boolean <- nil? env - 591 compare env-nil?, 0/false - 592 break-if-= - 593 debug-print "b", 7/fg, 0/bg - 594 lookup-symbol-in-globals sym, out, globals, trace, screen-cell, keyboard-cell - 595 debug-print "x", 7/fg, 0/bg - 596 trace-higher trace - 597 +-- 15 lines: # trace "=> " out " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- - 612 debug-print "y", 7/fg, 0/bg - 613 return - 614 } - 615 # check car - 616 var env-head-storage: (handle cell) - 617 var env-head-ah/eax: (addr handle cell) <- address env-head-storage - 618 car env, env-head-ah, 0/no-trace - 619 var _env-head/eax: (addr cell) <- lookup *env-head-ah - 620 var env-head/ecx: (addr cell) <- copy _env-head - 621 # if car is not a list, abort - 622 { - 623 var env-head-type/eax: (addr int) <- get env-head, type - 624 compare *env-head-type, 0/pair - 625 break-if-= - 626 error trace, "environment is not a list of (key . value) pairs" - 627 trace-higher trace - 628 return - 629 } - 630 # check key - 631 var curr-key-storage: (handle cell) - 632 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage - 633 car env-head, curr-key-ah, trace - 634 var curr-key/eax: (addr cell) <- lookup *curr-key-ah - 635 # if key is not a symbol, abort - 636 { - 637 var curr-key-type/eax: (addr int) <- get curr-key, type - 638 compare *curr-key-type, 2/symbol - 639 break-if-= - 640 error trace, "environment contains a binding for a non-symbol" - 641 trace-higher trace - 642 return - 643 } - 644 # if key matches sym, return val - 645 var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace - 646 compare match?, 0/false - 647 { - 648 break-if-= - 649 cdr env-head, out, 0/no-trace - 650 +-- 15 lines: # trace "=> " out " (match)" ---------------------------------------------------------------------------------------------------------------------------------------------- - 665 trace-higher trace - 666 return - 667 } - 668 # otherwise recurse - 669 var env-tail-storage: (handle cell) - 670 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage - 671 cdr env, env-tail-ah, trace - 672 lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell, keyboard-cell - 673 trace-higher trace - 674 +-- 15 lines: # trace "=> " out " (recurse)" -------------------------------------------------------------------------------------------------------------------------------------------- - 689 } - 690 - 691 fn test-lookup-symbol-in-env { - 692 # tmp = (a . 3) - 693 var val-storage: (handle cell) - 694 var val-ah/ecx: (addr handle cell) <- address val-storage - 695 new-integer val-ah, 3 - 696 var key-storage: (handle cell) - 697 var key-ah/edx: (addr handle cell) <- address key-storage - 698 new-symbol key-ah, "a" - 699 var env-storage: (handle cell) - 700 var env-ah/ebx: (addr handle cell) <- address env-storage - 701 new-pair env-ah, *key-ah, *val-ah - 702 # env = ((a . 3)) - 703 var nil-storage: (handle cell) - 704 var nil-ah/ecx: (addr handle cell) <- address nil-storage - 705 allocate-pair nil-ah - 706 new-pair env-ah, *env-ah, *nil-ah - 707 # lookup sym(a) in env tmp - 708 var tmp-storage: (handle cell) - 709 var tmp-ah/edx: (addr handle cell) <- address tmp-storage - 710 new-symbol tmp-ah, "a" - 711 var in/eax: (addr cell) <- lookup *tmp-ah - 712 lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard - 713 var result/eax: (addr cell) <- lookup *tmp-ah - 714 var result-type/edx: (addr int) <- get result, type - 715 check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0" - 716 var result-value-addr/eax: (addr float) <- get result, number-data - 717 var result-value/eax: int <- convert *result-value-addr - 718 check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1" - 719 } - 720 - 721 fn test-lookup-symbol-in-globals { - 722 var globals-storage: global-table - 723 var globals/edi: (addr global-table) <- address globals-storage - 724 initialize-globals globals - 725 # env = nil - 726 var nil-storage: (handle cell) - 727 var nil-ah/ecx: (addr handle cell) <- address nil-storage - 728 allocate-pair nil-ah - 729 # lookup sym(a), env - 730 var tmp-storage: (handle cell) - 731 var tmp-ah/ebx: (addr handle cell) <- address tmp-storage - 732 new-symbol tmp-ah, "+" - 733 var in/eax: (addr cell) <- lookup *tmp-ah - 734 lookup-symbol in, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard - 735 var result/eax: (addr cell) <- lookup *tmp-ah - 736 var result-type/edx: (addr int) <- get result, type - 737 check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0" - 738 var result-value/eax: (addr int) <- get result, index-data - 739 check-ints-equal *result-value, 2/add, "F - test-lookup-symbol-in-globals/1" - 740 } - 741 - 742 fn mutate-binding name: (addr stream byte), val: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace) { - 743 # trace name - 744 { - 745 compare trace, 0 - 746 break-if-= - 747 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` - 748 var stream/ecx: (addr stream byte) <- address stream-storage - 749 write stream, "bind " - 750 rewind-stream name - 751 write-stream stream, name - 752 write stream, " to " - 753 print-cell val, stream, 0/no-trace - 754 write stream, " in " - 755 var env-ah/eax: (addr handle cell) <- address env-h - 756 print-cell env-ah, stream, 0/no-trace - 757 trace trace, "eval", stream - 758 } - 759 trace-lower trace - 760 var _env/eax: (addr cell) <- lookup env-h - 761 var env/ebx: (addr cell) <- copy _env - 762 # if env is not a list, abort - 763 { - 764 var env-type/ecx: (addr int) <- get env, type - 765 compare *env-type, 0/pair - 766 break-if-= - 767 error trace, "eval found a non-list environment" - 768 trace-higher trace - 769 return - 770 } - 771 # if env is nil, look in globals - 772 { - 773 var env-nil?/eax: boolean <- nil? env - 774 compare env-nil?, 0/false - 775 break-if-= - 776 debug-print "b", 3/fg, 0/bg - 777 mutate-binding-in-globals name, val, globals, trace - 778 debug-print "x", 3/fg, 0/bg - 779 trace-higher trace - 780 +-- 15 lines: # trace "=> " val " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- - 795 debug-print "y", 3/fg, 0/bg - 796 return - 797 } - 798 # check car - 799 var env-head-storage: (handle cell) - 800 var env-head-ah/eax: (addr handle cell) <- address env-head-storage - 801 car env, env-head-ah, 0/no-trace - 802 var _env-head/eax: (addr cell) <- lookup *env-head-ah - 803 var env-head/ecx: (addr cell) <- copy _env-head - 804 # if car is not a list, abort - 805 { - 806 var env-head-type/eax: (addr int) <- get env-head, type - 807 compare *env-head-type, 0/pair - 808 break-if-= - 809 error trace, "environment is not a list of (key . value) pairs" - 810 trace-higher trace - 811 return - 812 } - 813 # check key - 814 var curr-key-storage: (handle cell) - 815 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage - 816 car env-head, curr-key-ah, trace - 817 var curr-key/eax: (addr cell) <- lookup *curr-key-ah - 818 # if key is not a symbol, abort - 819 { - 820 var curr-key-type/eax: (addr int) <- get curr-key, type - 821 compare *curr-key-type, 2/symbol - 822 break-if-= - 823 error trace, "environment contains a binding for a non-symbol" - 824 trace-higher trace - 825 return - 826 } - 827 # if key matches name, return val - 828 var curr-key-data-ah/eax: (addr handle stream byte) <- get curr-key, text-data - 829 var curr-key-data/eax: (addr stream byte) <- lookup *curr-key-data-ah - 830 var match?/eax: boolean <- streams-data-equal? curr-key-data, name - 831 compare match?, 0/false - 832 { - 833 break-if-= - 834 var dest/eax: (addr handle cell) <- get env-head, right - 835 copy-object val, dest - 836 trace-text trace, "eval", "=> done" - 837 trace-higher trace - 838 return - 839 } - 840 # otherwise recurse - 841 var env-tail-storage: (handle cell) - 842 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage - 843 cdr env, env-tail-ah, trace - 844 mutate-binding name, val, *env-tail-ah, globals, trace - 845 trace-higher trace - 846 } - 847 - 848 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) { - 849 trace-text trace, "eval", "car" - 850 trace-lower trace - 851 var in/eax: (addr cell) <- copy _in - 852 # if in is not a list, abort - 853 { - 854 var in-type/ecx: (addr int) <- get in, type - 855 compare *in-type, 0/pair - 856 break-if-= - 857 error trace, "car on a non-list" - 858 trace-higher trace - 859 return - 860 } - 861 # if in is nil, abort - 862 { - 863 var in-nil?/eax: boolean <- nil? in - 864 compare in-nil?, 0/false - 865 break-if-= - 866 error trace, "car on nil" - 867 trace-higher trace - 868 return - 869 } - 870 var in-left/eax: (addr handle cell) <- get in, left - 871 copy-object in-left, out - 872 trace-higher trace - 873 return - 874 } - 875 - 876 fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) { - 877 trace-text trace, "eval", "cdr" - 878 trace-lower trace - 879 var in/eax: (addr cell) <- copy _in - 880 # if in is not a list, abort - 881 { - 882 var in-type/ecx: (addr int) <- get in, type - 883 compare *in-type, 0/pair - 884 break-if-= - 885 error trace, "car on a non-list" - 886 trace-higher trace - 887 return - 888 } - 889 # if in is nil, abort - 890 { - 891 var in-nil?/eax: boolean <- nil? in - 892 compare in-nil?, 0/false - 893 break-if-= - 894 error trace, "car on nil" - 895 trace-higher trace - 896 return - 897 } - 898 var in-right/eax: (addr handle cell) <- get in, right - 899 copy-object in-right, out - 900 trace-higher trace - 901 return - 902 } - 903 - 904 fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean { - 905 trace-text trace, "eval", "cell-isomorphic?" - 906 trace-lower trace - 907 var a/esi: (addr cell) <- copy _a - 908 var b/edi: (addr cell) <- copy _b - 909 # if types don't match, return false - 910 var a-type-addr/eax: (addr int) <- get a, type - 911 var b-type-addr/ecx: (addr int) <- get b, type - 912 var b-type/ecx: int <- copy *b-type-addr - 913 compare b-type, *a-type-addr - 914 { - 915 break-if-= - 916 trace-higher trace - 917 trace-text trace, "eval", "=> false (type)" - 918 return 0/false - 919 } - 920 # if types are number, compare number-data - 921 # TODO: exactly comparing floats is a bad idea - 922 compare b-type, 1/number - 923 { - 924 break-if-!= - 925 var a-val-addr/eax: (addr float) <- get a, number-data - 926 var b-val-addr/ecx: (addr float) <- get b, number-data - 927 var a-val/xmm0: float <- copy *a-val-addr - 928 compare a-val, *b-val-addr - 929 { - 930 break-if-= - 931 trace-higher trace - 932 trace-text trace, "eval", "=> false (numbers)" - 933 return 0/false - 934 } - 935 trace-higher trace - 936 trace-text trace, "eval", "=> true (numbers)" - 937 return 1/true - 938 } - 939 compare b-type, 2/symbol - 940 { - 941 break-if-!= - 942 var b-val-ah/eax: (addr handle stream byte) <- get b, text-data - 943 var _b-val/eax: (addr stream byte) <- lookup *b-val-ah - 944 var b-val/ecx: (addr stream byte) <- copy _b-val - 945 var a-val-ah/eax: (addr handle stream byte) <- get a, text-data - 946 var a-val/eax: (addr stream byte) <- lookup *a-val-ah - 947 var tmp-array: (handle array byte) - 948 var tmp-ah/edx: (addr handle array byte) <- address tmp-array - 949 rewind-stream a-val - 950 stream-to-array a-val, tmp-ah - 951 var tmp/eax: (addr array byte) <- lookup *tmp-ah - 952 var match?/eax: boolean <- stream-data-equal? b-val, tmp - 953 trace-higher trace - 954 { - 955 compare match?, 0/false - 956 break-if-= - 957 trace-text trace, "eval", "=> true (symbols)" - 958 } - 959 { - 960 compare match?, 0/false - 961 break-if-!= - 962 trace-text trace, "eval", "=> false (symbols)" - 963 } - 964 return match? - 965 } - 966 # if a is nil, b should be nil - 967 { - 968 # (assumes nil? returns 0 or 1) - 969 var _b-nil?/eax: boolean <- nil? b - 970 var b-nil?/ecx: boolean <- copy _b-nil? - 971 var a-nil?/eax: boolean <- nil? a - 972 # a == nil and b == nil => return true - 973 { - 974 compare a-nil?, 0/false - 975 break-if-= - 976 compare b-nil?, 0/false - 977 break-if-= - 978 trace-higher trace - 979 trace-text trace, "eval", "=> true (nils)" - 980 return 1/true - 981 } - 982 # a == nil => return false - 983 { - 984 compare a-nil?, 0/false - 985 break-if-= - 986 trace-higher trace - 987 trace-text trace, "eval", "=> false (b != nil)" - 988 return 0/false - 989 } - 990 # b == nil => return false - 991 { - 992 compare b-nil?, 0/false - 993 break-if-= - 994 trace-higher trace - 995 trace-text trace, "eval", "=> false (a != nil)" - 996 return 0/false - 997 } - 998 } - 999 # a and b are pairs -1000 var a-tmp-storage: (handle cell) -1001 var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage -1002 var b-tmp-storage: (handle cell) -1003 var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage -1004 # if cars aren't equal, return false -1005 car a, a-tmp-ah, trace -1006 car b, b-tmp-ah, trace -1007 { -1008 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah -1009 var a-tmp/ecx: (addr cell) <- copy _a-tmp -1010 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah -1011 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace -1012 compare result, 0/false -1013 break-if-!= -1014 trace-higher trace -1015 trace-text trace, "eval", "=> false (car mismatch)" -1016 return 0/false -1017 } -1018 # recurse on cdrs -1019 cdr a, a-tmp-ah, trace -1020 cdr b, b-tmp-ah, trace -1021 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah -1022 var a-tmp/ecx: (addr cell) <- copy _a-tmp -1023 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah -1024 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace -1025 trace-higher trace -1026 return result -1027 } -1028 -1029 fn fn? _x: (addr cell) -> _/eax: boolean { -1030 var x/esi: (addr cell) <- copy _x -1031 var type/eax: (addr int) <- get x, type -1032 compare *type, 2/symbol -1033 { -1034 break-if-= -1035 return 0/false -1036 } -1037 var contents-ah/eax: (addr handle stream byte) <- get x, text-data -1038 var contents/eax: (addr stream byte) <- lookup *contents-ah -1039 var result/eax: boolean <- stream-data-equal? contents, "fn" -1040 return result -1041 } -1042 -1043 fn test-evaluate-is-well-behaved { -1044 var t-storage: trace -1045 var t/esi: (addr trace) <- address t-storage -1046 initialize-trace t, 0x10, 0/visible # we don't use trace UI -1047 # env = nil -1048 var env-storage: (handle cell) -1049 var env-ah/ecx: (addr handle cell) <- address env-storage -1050 allocate-pair env-ah -1051 # eval sym(a), nil env -1052 var tmp-storage: (handle cell) -1053 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1054 new-symbol tmp-ah, "a" -1055 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard, 0/call-number -1056 # doesn't die -1057 check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved" -1058 } -1059 -1060 fn test-evaluate-number { -1061 # env = nil -1062 var env-storage: (handle cell) -1063 var env-ah/ecx: (addr handle cell) <- address env-storage -1064 allocate-pair env-ah -1065 # tmp = 3 -1066 var tmp-storage: (handle cell) -1067 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1068 new-integer tmp-ah, 3 -1069 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number -1070 # -1071 var result/eax: (addr cell) <- lookup *tmp-ah -1072 var result-type/edx: (addr int) <- get result, type -1073 check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0" -1074 var result-value-addr/eax: (addr float) <- get result, number-data -1075 var result-value/eax: int <- convert *result-value-addr -1076 check-ints-equal result-value, 3, "F - test-evaluate-number/1" -1077 } -1078 -1079 fn test-evaluate-symbol { -1080 # tmp = (a . 3) -1081 var val-storage: (handle cell) -1082 var val-ah/ecx: (addr handle cell) <- address val-storage -1083 new-integer val-ah, 3 -1084 var key-storage: (handle cell) -1085 var key-ah/edx: (addr handle cell) <- address key-storage -1086 new-symbol key-ah, "a" -1087 var env-storage: (handle cell) -1088 var env-ah/ebx: (addr handle cell) <- address env-storage -1089 new-pair env-ah, *key-ah, *val-ah -1090 # env = ((a . 3)) -1091 var nil-storage: (handle cell) -1092 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1093 allocate-pair nil-ah -1094 new-pair env-ah, *env-ah, *nil-ah -1095 # eval sym(a), env -1096 var tmp-storage: (handle cell) -1097 var tmp-ah/edx: (addr handle cell) <- address tmp-storage -1098 new-symbol tmp-ah, "a" -1099 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number -1100 var result/eax: (addr cell) <- lookup *tmp-ah -1101 var result-type/edx: (addr int) <- get result, type -1102 check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0" -1103 var result-value-addr/eax: (addr float) <- get result, number-data -1104 var result-value/eax: int <- convert *result-value-addr -1105 check-ints-equal result-value, 3, "F - test-evaluate-symbol/1" -1106 } -1107 -1108 fn test-evaluate-primitive-function { -1109 var globals-storage: global-table -1110 var globals/edi: (addr global-table) <- address globals-storage -1111 initialize-globals globals -1112 var nil-storage: (handle cell) -1113 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1114 allocate-pair nil-ah -1115 var add-storage: (handle cell) -1116 var add-ah/ebx: (addr handle cell) <- address add-storage -1117 new-symbol add-ah, "+" -1118 # eval +, nil env -1119 var tmp-storage: (handle cell) -1120 var tmp-ah/esi: (addr handle cell) <- address tmp-storage -1121 evaluate add-ah, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number -1122 # -1123 var result/eax: (addr cell) <- lookup *tmp-ah -1124 var result-type/edx: (addr int) <- get result, type -1125 check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0" -1126 var result-value/eax: (addr int) <- get result, index-data -1127 check-ints-equal *result-value, 2/add, "F - test-evaluate-primitive-function/1" -1128 } -1129 -1130 fn test-evaluate-primitive-function-call { -1131 var t-storage: trace -1132 var t/edi: (addr trace) <- address t-storage -1133 initialize-trace t, 0x100, 0/visible # we don't use trace UI -1134 # -1135 var nil-storage: (handle cell) -1136 var nil-ah/ecx: (addr handle cell) <- address nil-storage -1137 allocate-pair nil-ah -1138 var one-storage: (handle cell) -1139 var one-ah/edx: (addr handle cell) <- address one-storage -1140 new-integer one-ah, 1 -1141 var add-storage: (handle cell) -1142 var add-ah/ebx: (addr handle cell) <- address add-storage -1143 new-symbol add-ah, "+" -1144 # input is (+ 1 1) -1145 var tmp-storage: (handle cell) -1146 var tmp-ah/esi: (addr handle cell) <- address tmp-storage -1147 new-pair tmp-ah, *one-ah, *nil-ah -1148 new-pair tmp-ah, *one-ah, *tmp-ah -1149 new-pair tmp-ah, *add-ah, *tmp-ah -1150 #? dump-cell tmp-ah -1151 # -1152 var globals-storage: global-table -1153 var globals/edx: (addr global-table) <- address globals-storage -1154 initialize-globals globals -1155 # -1156 evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/call-number -1157 #? dump-trace t -1158 # -1159 var result/eax: (addr cell) <- lookup *tmp-ah -1160 var result-type/edx: (addr int) <- get result, type -1161 check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0" -1162 var result-value-addr/eax: (addr float) <- get result, number-data -1163 var result-value/eax: int <- convert *result-value-addr -1164 check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1" -1165 } + 412 var evaluated-list-storage: (handle cell) + 413 var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage + 414 var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah + 415 var curr/ecx: (addr cell) <- copy in-addr + 416 $evaluate-list:loop: { + 417 allocate-pair curr-out-ah + 418 var nil?/eax: boolean <- nil? curr + 419 compare nil?, 0/false + 420 break-if-!= + 421 # eval left + 422 var curr-out/eax: (addr cell) <- lookup *curr-out-ah + 423 var left-out-ah/edi: (addr handle cell) <- get curr-out, left + 424 var left-ah/esi: (addr handle cell) <- get curr, left + 425 debug-print "A", 4/fg, 0xc5/bg=blue-bg + 426 increment call-number + 427 evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number + 428 debug-print "B", 4/fg, 0xc5/bg=blue-bg + 429 # + 430 curr-out-ah <- get curr-out, right + 431 var right-ah/eax: (addr handle cell) <- get curr, right + 432 var right/eax: (addr cell) <- lookup *right-ah + 433 curr <- copy right + 434 loop + 435 } + 436 trace-higher trace + 437 var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah + 438 var function-ah/ecx: (addr handle cell) <- get evaluated-list, left + 439 var args-ah/edx: (addr handle cell) <- get evaluated-list, right + 440 debug-print "C", 4/fg, 0xc5/bg=blue-bg + 441 apply function-ah, args-ah, out, globals, trace, screen-cell, keyboard-cell, call-number + 442 debug-print "Y", 4/fg, 0xc5/bg=blue-bg + 443 trace-higher trace + 444 +-- 11 lines: # trace "=> " out --------------------------------------------------------------------------------------------------------------------------------------------------------- + 455 debug-print "Z", 4/fg, 0xc5/bg=blue-bg + 456 } + 457 + 458 fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int { + 459 var f-ah/eax: (addr handle cell) <- copy _f-ah + 460 var _f/eax: (addr cell) <- lookup *f-ah + 461 var f/esi: (addr cell) <- copy _f + 462 # call primitive functions + 463 { + 464 var f-type/eax: (addr int) <- get f, type + 465 compare *f-type, 4/primitive-function + 466 break-if-!= + 467 apply-primitive f, args-ah, out, globals, trace + 468 return + 469 } + 470 # if it's not a primitive function it must be an anonymous function + 471 +-- 14 lines: # trace "apply anonymous function " f " in environment " env -------------------------------------------------------------------------------------------------------------- + 485 trace-lower trace + 486 { + 487 var f-type/ecx: (addr int) <- get f, type + 488 compare *f-type, 0/pair + 489 break-if-!= + 490 var first-ah/eax: (addr handle cell) <- get f, left + 491 var first/eax: (addr cell) <- lookup *first-ah + 492 var fn?/eax: boolean <- fn? first + 493 compare fn?, 0/false + 494 break-if-= + 495 var rest-ah/esi: (addr handle cell) <- get f, right + 496 var rest/eax: (addr cell) <- lookup *rest-ah + 497 var callee-env-ah/edx: (addr handle cell) <- get rest, left + 498 rest-ah <- get rest, right + 499 rest <- lookup *rest-ah + 500 var params-ah/ecx: (addr handle cell) <- get rest, left + 501 var body-ah/eax: (addr handle cell) <- get rest, right + 502 debug-print "D", 7/fg, 0xc5/bg=blue-bg + 503 apply-function params-ah, args-ah, body-ah, out, *callee-env-ah, globals, trace, screen-cell, keyboard-cell, call-number + 504 debug-print "Y", 7/fg, 0xc5/bg=blue-bg + 505 trace-higher trace + 506 return + 507 } + 508 error trace, "unknown function" + 509 } + 510 + 511 fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), body-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int { + 512 # push bindings for params to env + 513 var new-env-h: (handle cell) + 514 var new-env-ah/esi: (addr handle cell) <- address new-env-h + 515 push-bindings params-ah, args-ah, env-h, new-env-ah, trace + 516 # + 517 evaluate-exprs body-ah, out, new-env-h, globals, trace, screen-cell, keyboard-cell, call-number + 518 } + 519 + 520 fn evaluate-exprs _exprs-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int { + 521 # eval all exprs, writing result to `out` each time + 522 var exprs-ah/ecx: (addr handle cell) <- copy _exprs-ah + 523 $evaluate-exprs:loop: { + 524 var exprs/eax: (addr cell) <- lookup *exprs-ah + 525 # stop when exprs is nil + 526 { + 527 var exprs-nil?/eax: boolean <- nil? exprs + 528 compare exprs-nil?, 0/false + 529 break-if-!= $evaluate-exprs:loop + 530 } + 531 # evaluate each expression, writing result to `out` + 532 { + 533 var curr-ah/eax: (addr handle cell) <- get exprs, left + 534 debug-print "E", 7/fg, 0xc5/bg=blue-bg + 535 increment call-number + 536 evaluate curr-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number + 537 debug-print "X", 7/fg, 0xc5/bg=blue-bg + 538 } + 539 # + 540 exprs-ah <- get exprs, right + 541 loop + 542 } + 543 # `out` contains result of evaluating final expression + 544 } + 545 + 546 # Bind params to corresponding args and add the bindings to old-env. Return + 547 # the result in env-ah. + 548 # + 549 # We never modify old-env, but we point to it. This way other parts of the + 550 # interpreter can continue using old-env, and everything works harmoniously + 551 # even though no cells are copied around. + 552 # + 553 # env should always be a DAG (ignoring internals of values). It doesn't have + 554 # to be a tree (some values may be shared), but there are also no cycles. + 555 # + 556 # Learn more: https://en.wikipedia.org/wiki/Persistent_data_structure + 557 fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), old-env-h: (handle cell), env-ah: (addr handle cell), trace: (addr trace) { + 558 var params-ah/edx: (addr handle cell) <- copy _params-ah + 559 var args-ah/ebx: (addr handle cell) <- copy _args-ah + 560 var _params/eax: (addr cell) <- lookup *params-ah + 561 var params/esi: (addr cell) <- copy _params + 562 { + 563 var params-nil?/eax: boolean <- nil? params + 564 compare params-nil?, 0/false + 565 break-if-= + 566 # nil is a literal + 567 trace-text trace, "eval", "done with push-bindings" + 568 copy-handle old-env-h, env-ah + 569 return + 570 } + 571 # Params can only be symbols or pairs. Args can be anything. + 572 +-- 16 lines: # trace "pushing bindings from " params " to " args ----------------------------------------------------------------------------------------------------------------------- + 588 trace-lower trace + 589 var params-type/eax: (addr int) <- get params, type + 590 compare *params-type, 2/symbol + 591 { + 592 break-if-!= + 593 trace-text trace, "eval", "symbol; binding to all remaining args" + 594 # create a new binding + 595 var new-binding-storage: (handle cell) + 596 var new-binding-ah/eax: (addr handle cell) <- address new-binding-storage + 597 new-pair new-binding-ah, *params-ah, *args-ah + 598 # push it to env + 599 new-pair env-ah, *new-binding-ah, old-env-h + 600 trace-higher trace + 601 return + 602 } + 603 compare *params-type, 0/pair + 604 { + 605 break-if-= + 606 error trace, "cannot bind a non-symbol" + 607 trace-higher trace + 608 return + 609 } + 610 var _args/eax: (addr cell) <- lookup *args-ah + 611 var args/edi: (addr cell) <- copy _args + 612 # params is now a pair, so args must be also + 613 var args-type/eax: (addr int) <- get args, type + 614 compare *args-type, 0/pair + 615 { + 616 break-if-= + 617 error trace, "args not in a proper list" + 618 trace-higher trace + 619 return + 620 } + 621 var intermediate-env-storage: (handle cell) + 622 var intermediate-env-ah/edx: (addr handle cell) <- address intermediate-env-storage + 623 var first-param-ah/eax: (addr handle cell) <- get params, left + 624 var first-arg-ah/ecx: (addr handle cell) <- get args, left + 625 push-bindings first-param-ah, first-arg-ah, old-env-h, intermediate-env-ah, trace + 626 var remaining-params-ah/eax: (addr handle cell) <- get params, right + 627 var remaining-args-ah/ecx: (addr handle cell) <- get args, right + 628 push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace + 629 trace-higher trace + 630 } + 631 + 632 fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) { + 633 # trace sym + 634 { + 635 compare trace, 0 + 636 break-if-= + 637 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` + 638 var stream/ecx: (addr stream byte) <- address stream-storage + 639 write stream, "look up " + 640 var sym2/eax: (addr cell) <- copy sym + 641 var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data + 642 var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah + 643 rewind-stream sym-data + 644 write-stream stream, sym-data + 645 write stream, " in " + 646 var env-ah/eax: (addr handle cell) <- address env-h + 647 print-cell env-ah, stream, 0/no-trace + 648 trace trace, "eval", stream + 649 } + 650 trace-lower trace + 651 var _env/eax: (addr cell) <- lookup env-h + 652 var env/ebx: (addr cell) <- copy _env + 653 # if env is not a list, abort + 654 { + 655 var env-type/ecx: (addr int) <- get env, type + 656 compare *env-type, 0/pair + 657 break-if-= + 658 error trace, "eval found a non-list environment" + 659 trace-higher trace + 660 return + 661 } + 662 # if env is nil, look up in globals + 663 { + 664 var env-nil?/eax: boolean <- nil? env + 665 compare env-nil?, 0/false + 666 break-if-= + 667 debug-print "b", 7/fg, 0xc5/bg=blue-bg + 668 lookup-symbol-in-globals sym, out, globals, trace, screen-cell, keyboard-cell + 669 debug-print "x", 7/fg, 0xc5/bg=blue-bg + 670 trace-higher trace + 671 +-- 15 lines: # trace "=> " out " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- + 686 debug-print "y", 7/fg, 0xc5/bg=blue-bg + 687 return + 688 } + 689 # check car + 690 var env-head-storage: (handle cell) + 691 var env-head-ah/eax: (addr handle cell) <- address env-head-storage + 692 car env, env-head-ah, 0/no-trace + 693 var _env-head/eax: (addr cell) <- lookup *env-head-ah + 694 var env-head/ecx: (addr cell) <- copy _env-head + 695 # if car is not a list, abort + 696 { + 697 var env-head-type/eax: (addr int) <- get env-head, type + 698 compare *env-head-type, 0/pair + 699 break-if-= + 700 error trace, "environment is not a list of (key . value) pairs" + 701 trace-higher trace + 702 return + 703 } + 704 # check key + 705 var curr-key-storage: (handle cell) + 706 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage + 707 car env-head, curr-key-ah, trace + 708 var curr-key/eax: (addr cell) <- lookup *curr-key-ah + 709 # if key is not a symbol, abort + 710 { + 711 var curr-key-type/eax: (addr int) <- get curr-key, type + 712 compare *curr-key-type, 2/symbol + 713 break-if-= + 714 error trace, "environment contains a binding for a non-symbol" + 715 trace-higher trace + 716 return + 717 } + 718 # if key matches sym, return val + 719 var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace + 720 compare match?, 0/false + 721 { + 722 break-if-= + 723 cdr env-head, out, 0/no-trace + 724 +-- 15 lines: # trace "=> " out " (match)" ---------------------------------------------------------------------------------------------------------------------------------------------- + 739 trace-higher trace + 740 return + 741 } + 742 # otherwise recurse + 743 var env-tail-storage: (handle cell) + 744 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage + 745 cdr env, env-tail-ah, trace + 746 lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell, keyboard-cell + 747 trace-higher trace + 748 +-- 15 lines: # trace "=> " out " (recurse)" -------------------------------------------------------------------------------------------------------------------------------------------- + 763 } + 764 + 765 fn test-lookup-symbol-in-env { + 766 # tmp = (a . 3) + 767 var val-storage: (handle cell) + 768 var val-ah/ecx: (addr handle cell) <- address val-storage + 769 new-integer val-ah, 3 + 770 var key-storage: (handle cell) + 771 var key-ah/edx: (addr handle cell) <- address key-storage + 772 new-symbol key-ah, "a" + 773 var env-storage: (handle cell) + 774 var env-ah/ebx: (addr handle cell) <- address env-storage + 775 new-pair env-ah, *key-ah, *val-ah + 776 # env = ((a . 3)) + 777 var nil-storage: (handle cell) + 778 var nil-ah/ecx: (addr handle cell) <- address nil-storage + 779 allocate-pair nil-ah + 780 new-pair env-ah, *env-ah, *nil-ah + 781 # lookup sym(a) in env tmp + 782 var tmp-storage: (handle cell) + 783 var tmp-ah/edx: (addr handle cell) <- address tmp-storage + 784 new-symbol tmp-ah, "a" + 785 var in/eax: (addr cell) <- lookup *tmp-ah + 786 lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard + 787 var result/eax: (addr cell) <- lookup *tmp-ah + 788 var result-type/edx: (addr int) <- get result, type + 789 check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0" + 790 var result-value-addr/eax: (addr float) <- get result, number-data + 791 var result-value/eax: int <- convert *result-value-addr + 792 check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1" + 793 } + 794 + 795 fn test-lookup-symbol-in-globals { + 796 var globals-storage: global-table + 797 var globals/edi: (addr global-table) <- address globals-storage + 798 initialize-globals globals + 799 # env = nil + 800 var nil-storage: (handle cell) + 801 var nil-ah/ecx: (addr handle cell) <- address nil-storage + 802 allocate-pair nil-ah + 803 # lookup sym(a), env + 804 var tmp-storage: (handle cell) + 805 var tmp-ah/ebx: (addr handle cell) <- address tmp-storage + 806 new-symbol tmp-ah, "+" + 807 var in/eax: (addr cell) <- lookup *tmp-ah + 808 lookup-symbol in, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard + 809 var result/eax: (addr cell) <- lookup *tmp-ah + 810 var result-type/edx: (addr int) <- get result, type + 811 check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0" + 812 var result-value/eax: (addr int) <- get result, index-data + 813 check-ints-equal *result-value, 1/add, "F - test-lookup-symbol-in-globals/1" + 814 } + 815 + 816 fn mutate-binding name: (addr stream byte), val: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace) { + 817 # trace name + 818 { + 819 compare trace, 0 + 820 break-if-= + 821 var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` + 822 var stream/ecx: (addr stream byte) <- address stream-storage + 823 write stream, "bind " + 824 rewind-stream name + 825 write-stream stream, name + 826 write stream, " to " + 827 print-cell val, stream, 0/no-trace + 828 write stream, " in " + 829 var env-ah/eax: (addr handle cell) <- address env-h + 830 print-cell env-ah, stream, 0/no-trace + 831 trace trace, "eval", stream + 832 } + 833 trace-lower trace + 834 var _env/eax: (addr cell) <- lookup env-h + 835 var env/ebx: (addr cell) <- copy _env + 836 # if env is not a list, abort + 837 { + 838 var env-type/ecx: (addr int) <- get env, type + 839 compare *env-type, 0/pair + 840 break-if-= + 841 error trace, "eval found a non-list environment" + 842 trace-higher trace + 843 return + 844 } + 845 # if env is nil, look in globals + 846 { + 847 var env-nil?/eax: boolean <- nil? env + 848 compare env-nil?, 0/false + 849 break-if-= + 850 debug-print "b", 3/fg, 0xc5/bg=blue-bg + 851 mutate-binding-in-globals name, val, globals, trace + 852 debug-print "x", 3/fg, 0xc5/bg=blue-bg + 853 trace-higher trace + 854 +-- 15 lines: # trace "=> " val " (global)" --------------------------------------------------------------------------------------------------------------------------------------------- + 869 debug-print "y", 3/fg, 0xc5/bg=blue-bg + 870 return + 871 } + 872 # check car + 873 var env-head-storage: (handle cell) + 874 var env-head-ah/eax: (addr handle cell) <- address env-head-storage + 875 car env, env-head-ah, 0/no-trace + 876 var _env-head/eax: (addr cell) <- lookup *env-head-ah + 877 var env-head/ecx: (addr cell) <- copy _env-head + 878 # if car is not a list, abort + 879 { + 880 var env-head-type/eax: (addr int) <- get env-head, type + 881 compare *env-head-type, 0/pair + 882 break-if-= + 883 error trace, "environment is not a list of (key . value) pairs" + 884 trace-higher trace + 885 return + 886 } + 887 # check key + 888 var curr-key-storage: (handle cell) + 889 var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage + 890 car env-head, curr-key-ah, trace + 891 var curr-key/eax: (addr cell) <- lookup *curr-key-ah + 892 # if key is not a symbol, abort + 893 { + 894 var curr-key-type/eax: (addr int) <- get curr-key, type + 895 compare *curr-key-type, 2/symbol + 896 break-if-= + 897 error trace, "environment contains a binding for a non-symbol" + 898 trace-higher trace + 899 return + 900 } + 901 # if key matches name, return val + 902 var curr-key-data-ah/eax: (addr handle stream byte) <- get curr-key, text-data + 903 var curr-key-data/eax: (addr stream byte) <- lookup *curr-key-data-ah + 904 var match?/eax: boolean <- streams-data-equal? curr-key-data, name + 905 compare match?, 0/false + 906 { + 907 break-if-= + 908 var dest/eax: (addr handle cell) <- get env-head, right + 909 copy-object val, dest + 910 trace-text trace, "eval", "=> done" + 911 trace-higher trace + 912 return + 913 } + 914 # otherwise recurse + 915 var env-tail-storage: (handle cell) + 916 var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage + 917 cdr env, env-tail-ah, trace + 918 mutate-binding name, val, *env-tail-ah, globals, trace + 919 trace-higher trace + 920 } + 921 + 922 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) { + 923 trace-text trace, "eval", "car" + 924 trace-lower trace + 925 var in/eax: (addr cell) <- copy _in + 926 # if in is not a list, abort + 927 { + 928 var in-type/ecx: (addr int) <- get in, type + 929 compare *in-type, 0/pair + 930 break-if-= + 931 error trace, "car on a non-list" + 932 trace-higher trace + 933 return + 934 } + 935 # if in is nil, abort + 936 { + 937 var in-nil?/eax: boolean <- nil? in + 938 compare in-nil?, 0/false + 939 break-if-= + 940 error trace, "car on nil" + 941 trace-higher trace + 942 return + 943 } + 944 var in-left/eax: (addr handle cell) <- get in, left + 945 copy-object in-left, out + 946 trace-higher trace + 947 return + 948 } + 949 + 950 fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) { + 951 trace-text trace, "eval", "cdr" + 952 trace-lower trace + 953 var in/eax: (addr cell) <- copy _in + 954 # if in is not a list, abort + 955 { + 956 var in-type/ecx: (addr int) <- get in, type + 957 compare *in-type, 0/pair + 958 break-if-= + 959 error trace, "car on a non-list" + 960 trace-higher trace + 961 return + 962 } + 963 # if in is nil, abort + 964 { + 965 var in-nil?/eax: boolean <- nil? in + 966 compare in-nil?, 0/false + 967 break-if-= + 968 error trace, "car on nil" + 969 trace-higher trace + 970 return + 971 } + 972 var in-right/eax: (addr handle cell) <- get in, right + 973 copy-object in-right, out + 974 trace-higher trace + 975 return + 976 } + 977 + 978 fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean { + 979 trace-text trace, "eval", "cell-isomorphic?" + 980 trace-lower trace + 981 var a/esi: (addr cell) <- copy _a + 982 var b/edi: (addr cell) <- copy _b + 983 # if types don't match, return false + 984 var a-type-addr/eax: (addr int) <- get a, type + 985 var b-type-addr/ecx: (addr int) <- get b, type + 986 var b-type/ecx: int <- copy *b-type-addr + 987 compare b-type, *a-type-addr + 988 { + 989 break-if-= + 990 trace-higher trace + 991 trace-text trace, "eval", "=> false (type)" + 992 return 0/false + 993 } + 994 # if types are number, compare number-data + 995 # TODO: exactly comparing floats is a bad idea + 996 compare b-type, 1/number + 997 { + 998 break-if-!= + 999 var a-val-addr/eax: (addr float) <- get a, number-data +1000 var b-val-addr/ecx: (addr float) <- get b, number-data +1001 var a-val/xmm0: float <- copy *a-val-addr +1002 compare a-val, *b-val-addr +1003 { +1004 break-if-= +1005 trace-higher trace +1006 trace-text trace, "eval", "=> false (numbers)" +1007 return 0/false +1008 } +1009 trace-higher trace +1010 trace-text trace, "eval", "=> true (numbers)" +1011 return 1/true +1012 } +1013 compare b-type, 2/symbol +1014 { +1015 break-if-!= +1016 var b-val-ah/eax: (addr handle stream byte) <- get b, text-data +1017 var _b-val/eax: (addr stream byte) <- lookup *b-val-ah +1018 var b-val/ecx: (addr stream byte) <- copy _b-val +1019 var a-val-ah/eax: (addr handle stream byte) <- get a, text-data +1020 var a-val/eax: (addr stream byte) <- lookup *a-val-ah +1021 var tmp-array: (handle array byte) +1022 var tmp-ah/edx: (addr handle array byte) <- address tmp-array +1023 rewind-stream a-val +1024 stream-to-array a-val, tmp-ah +1025 var tmp/eax: (addr array byte) <- lookup *tmp-ah +1026 var match?/eax: boolean <- stream-data-equal? b-val, tmp +1027 trace-higher trace +1028 { +1029 compare match?, 0/false +1030 break-if-= +1031 trace-text trace, "eval", "=> true (symbols)" +1032 } +1033 { +1034 compare match?, 0/false +1035 break-if-!= +1036 trace-text trace, "eval", "=> false (symbols)" +1037 } +1038 return match? +1039 } +1040 # if a is nil, b should be nil +1041 { +1042 # (assumes nil? returns 0 or 1) +1043 var _b-nil?/eax: boolean <- nil? b +1044 var b-nil?/ecx: boolean <- copy _b-nil? +1045 var a-nil?/eax: boolean <- nil? a +1046 # a == nil and b == nil => return true +1047 { +1048 compare a-nil?, 0/false +1049 break-if-= +1050 compare b-nil?, 0/false +1051 break-if-= +1052 trace-higher trace +1053 trace-text trace, "eval", "=> true (nils)" +1054 return 1/true +1055 } +1056 # a == nil => return false +1057 { +1058 compare a-nil?, 0/false +1059 break-if-= +1060 trace-higher trace +1061 trace-text trace, "eval", "=> false (b != nil)" +1062 return 0/false +1063 } +1064 # b == nil => return false +1065 { +1066 compare b-nil?, 0/false +1067 break-if-= +1068 trace-higher trace +1069 trace-text trace, "eval", "=> false (a != nil)" +1070 return 0/false +1071 } +1072 } +1073 # a and b are pairs +1074 var a-tmp-storage: (handle cell) +1075 var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage +1076 var b-tmp-storage: (handle cell) +1077 var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage +1078 # if cars aren't equal, return false +1079 car a, a-tmp-ah, trace +1080 car b, b-tmp-ah, trace +1081 { +1082 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah +1083 var a-tmp/ecx: (addr cell) <- copy _a-tmp +1084 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah +1085 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace +1086 compare result, 0/false +1087 break-if-!= +1088 trace-higher trace +1089 trace-text trace, "eval", "=> false (car mismatch)" +1090 return 0/false +1091 } +1092 # recurse on cdrs +1093 cdr a, a-tmp-ah, trace +1094 cdr b, b-tmp-ah, trace +1095 var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah +1096 var a-tmp/ecx: (addr cell) <- copy _a-tmp +1097 var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah +1098 var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace +1099 trace-higher trace +1100 return result +1101 } +1102 +1103 fn fn? _x: (addr cell) -> _/eax: boolean { +1104 var x/esi: (addr cell) <- copy _x +1105 var type/eax: (addr int) <- get x, type +1106 compare *type, 2/symbol +1107 { +1108 break-if-= +1109 return 0/false +1110 } +1111 var contents-ah/eax: (addr handle stream byte) <- get x, text-data +1112 var contents/eax: (addr stream byte) <- lookup *contents-ah +1113 var result/eax: boolean <- stream-data-equal? contents, "fn" +1114 return result +1115 } +1116 +1117 fn test-evaluate-is-well-behaved { +1118 var t-storage: trace +1119 var t/esi: (addr trace) <- address t-storage +1120 initialize-trace t, 0x10, 0/visible # we don't use trace UI +1121 # env = nil +1122 var env-storage: (handle cell) +1123 var env-ah/ecx: (addr handle cell) <- address env-storage +1124 allocate-pair env-ah +1125 # eval sym(a), nil env +1126 var tmp-storage: (handle cell) +1127 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1128 new-symbol tmp-ah, "a" +1129 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard, 0/call-number +1130 # doesn't die +1131 check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved" +1132 } +1133 +1134 fn test-evaluate-number { +1135 # env = nil +1136 var env-storage: (handle cell) +1137 var env-ah/ecx: (addr handle cell) <- address env-storage +1138 allocate-pair env-ah +1139 # tmp = 3 +1140 var tmp-storage: (handle cell) +1141 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1142 new-integer tmp-ah, 3 +1143 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number +1144 # +1145 var result/eax: (addr cell) <- lookup *tmp-ah +1146 var result-type/edx: (addr int) <- get result, type +1147 check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0" +1148 var result-value-addr/eax: (addr float) <- get result, number-data +1149 var result-value/eax: int <- convert *result-value-addr +1150 check-ints-equal result-value, 3, "F - test-evaluate-number/1" +1151 } +1152 +1153 fn test-evaluate-symbol { +1154 # tmp = (a . 3) +1155 var val-storage: (handle cell) +1156 var val-ah/ecx: (addr handle cell) <- address val-storage +1157 new-integer val-ah, 3 +1158 var key-storage: (handle cell) +1159 var key-ah/edx: (addr handle cell) <- address key-storage +1160 new-symbol key-ah, "a" +1161 var env-storage: (handle cell) +1162 var env-ah/ebx: (addr handle cell) <- address env-storage +1163 new-pair env-ah, *key-ah, *val-ah +1164 # env = ((a . 3)) +1165 var nil-storage: (handle cell) +1166 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1167 allocate-pair nil-ah +1168 new-pair env-ah, *env-ah, *nil-ah +1169 # eval sym(a), env +1170 var tmp-storage: (handle cell) +1171 var tmp-ah/edx: (addr handle cell) <- address tmp-storage +1172 new-symbol tmp-ah, "a" +1173 evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number +1174 var result/eax: (addr cell) <- lookup *tmp-ah +1175 var result-type/edx: (addr int) <- get result, type +1176 check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0" +1177 var result-value-addr/eax: (addr float) <- get result, number-data +1178 var result-value/eax: int <- convert *result-value-addr +1179 check-ints-equal result-value, 3, "F - test-evaluate-symbol/1" +1180 } +1181 +1182 fn test-evaluate-primitive-function { +1183 var globals-storage: global-table +1184 var globals/edi: (addr global-table) <- address globals-storage +1185 initialize-globals globals +1186 var nil-storage: (handle cell) +1187 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1188 allocate-pair nil-ah +1189 var add-storage: (handle cell) +1190 var add-ah/ebx: (addr handle cell) <- address add-storage +1191 new-symbol add-ah, "+" +1192 # eval +, nil env +1193 var tmp-storage: (handle cell) +1194 var tmp-ah/esi: (addr handle cell) <- address tmp-storage +1195 evaluate add-ah, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number +1196 # +1197 var result/eax: (addr cell) <- lookup *tmp-ah +1198 var result-type/edx: (addr int) <- get result, type +1199 check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0" +1200 var result-value/eax: (addr int) <- get result, index-data +1201 check-ints-equal *result-value, 1/add, "F - test-evaluate-primitive-function/1" +1202 } +1203 +1204 fn test-evaluate-primitive-function-call { +1205 var t-storage: trace +1206 var t/edi: (addr trace) <- address t-storage +1207 initialize-trace t, 0x100, 0/visible # we don't use trace UI +1208 # +1209 var nil-storage: (handle cell) +1210 var nil-ah/ecx: (addr handle cell) <- address nil-storage +1211 allocate-pair nil-ah +1212 var one-storage: (handle cell) +1213 var one-ah/edx: (addr handle cell) <- address one-storage +1214 new-integer one-ah, 1 +1215 var add-storage: (handle cell) +1216 var add-ah/ebx: (addr handle cell) <- address add-storage +1217 new-symbol add-ah, "+" +1218 # input is (+ 1 1) +1219 var tmp-storage: (handle cell) +1220 var tmp-ah/esi: (addr handle cell) <- address tmp-storage +1221 new-pair tmp-ah, *one-ah, *nil-ah +1222 new-pair tmp-ah, *one-ah, *tmp-ah +1223 new-pair tmp-ah, *add-ah, *tmp-ah +1224 #? dump-cell tmp-ah +1225 # +1226 var globals-storage: global-table +1227 var globals/edx: (addr global-table) <- address globals-storage +1228 initialize-globals globals +1229 # +1230 evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/call-number +1231 #? dump-trace t +1232 # +1233 var result/eax: (addr cell) <- lookup *tmp-ah +1234 var result-type/edx: (addr int) <- get result, type +1235 check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0" +1236 var result-value-addr/eax: (addr float) <- get result, number-data +1237 var result-value/eax: int <- convert *result-value-addr +1238 check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1" +1239 } diff --git a/html/shell/gap-buffer.mu.html b/html/shell/gap-buffer.mu.html index 9a93902a..9fae1381 100644 --- a/html/shell/gap-buffer.mu.html +++ b/html/shell/gap-buffer.mu.html @@ -83,1150 +83,1167 @@ if ('onhashchange' in window) { 24 clear-grapheme-stack right 25 } 26 - 27 # just for tests - 28 fn initialize-gap-buffer-with self: (addr gap-buffer), s: (addr array byte) { - 29 initialize-gap-buffer self, 0x10/capacity - 30 var stream-storage: (stream byte 0x10/capacity) - 31 var stream/ecx: (addr stream byte) <- address stream-storage - 32 write stream, s - 33 { - 34 var done?/eax: boolean <- stream-empty? stream - 35 compare done?, 0/false - 36 break-if-!= - 37 var g/eax: grapheme <- read-grapheme stream - 38 add-grapheme-at-gap self, g - 39 loop - 40 } - 41 } - 42 - 43 fn load-gap-buffer-from-stream self: (addr gap-buffer), in: (addr stream byte) { - 44 rewind-stream in - 45 { - 46 var done?/eax: boolean <- stream-empty? in - 47 compare done?, 0/false - 48 break-if-!= - 49 var key/eax: byte <- read-byte in - 50 compare key, 0/null - 51 break-if-= - 52 var g/eax: grapheme <- copy key - 53 edit-gap-buffer self, g - 54 loop - 55 } - 56 } - 57 - 58 fn emit-gap-buffer _self: (addr gap-buffer), out: (addr stream byte) { - 59 var self/esi: (addr gap-buffer) <- copy _self - 60 clear-stream out - 61 var left/eax: (addr grapheme-stack) <- get self, left - 62 emit-stack-from-bottom left, out - 63 var right/eax: (addr grapheme-stack) <- get self, right - 64 emit-stack-from-top right, out + 27 fn gap-buffer-capacity _gap: (addr gap-buffer) -> _/ecx: int { + 28 var gap/esi: (addr gap-buffer) <- copy _gap + 29 var left/eax: (addr grapheme-stack) <- get gap, left + 30 var left-data-ah/eax: (addr handle array grapheme) <- get left, data + 31 var left-data/eax: (addr array grapheme) <- lookup *left-data-ah + 32 var result/eax: int <- length left-data + 33 return result + 34 } + 35 + 36 # just for tests + 37 fn initialize-gap-buffer-with self: (addr gap-buffer), s: (addr array byte) { + 38 initialize-gap-buffer self, 0x10/capacity + 39 var stream-storage: (stream byte 0x10/capacity) + 40 var stream/ecx: (addr stream byte) <- address stream-storage + 41 write stream, s + 42 { + 43 var done?/eax: boolean <- stream-empty? stream + 44 compare done?, 0/false + 45 break-if-!= + 46 var g/eax: grapheme <- read-grapheme stream + 47 add-grapheme-at-gap self, g + 48 loop + 49 } + 50 } + 51 + 52 fn load-gap-buffer-from-stream self: (addr gap-buffer), in: (addr stream byte) { + 53 rewind-stream in + 54 { + 55 var done?/eax: boolean <- stream-empty? in + 56 compare done?, 0/false + 57 break-if-!= + 58 var key/eax: byte <- read-byte in + 59 compare key, 0/null + 60 break-if-= + 61 var g/eax: grapheme <- copy key + 62 edit-gap-buffer self, g + 63 loop + 64 } 65 } 66 - 67 fn append-gap-buffer _self: (addr gap-buffer), out: (addr stream byte) { + 67 fn emit-gap-buffer _self: (addr gap-buffer), out: (addr stream byte) { 68 var self/esi: (addr gap-buffer) <- copy _self - 69 var left/eax: (addr grapheme-stack) <- get self, left - 70 emit-stack-from-bottom left, out - 71 var right/eax: (addr grapheme-stack) <- get self, right - 72 emit-stack-from-top right, out - 73 } - 74 - 75 # dump stack from bottom to top - 76 fn emit-stack-from-bottom _self: (addr grapheme-stack), out: (addr stream byte) { - 77 var self/esi: (addr grapheme-stack) <- copy _self - 78 var data-ah/edi: (addr handle array grapheme) <- get self, data - 79 var _data/eax: (addr array grapheme) <- lookup *data-ah - 80 var data/edi: (addr array grapheme) <- copy _data - 81 var top-addr/ecx: (addr int) <- get self, top - 82 var i/eax: int <- copy 0 - 83 { - 84 compare i, *top-addr - 85 break-if->= - 86 var g/edx: (addr grapheme) <- index data, i - 87 write-grapheme out, *g - 88 i <- increment - 89 loop - 90 } - 91 } - 92 - 93 # dump stack from top to bottom - 94 fn emit-stack-from-top _self: (addr grapheme-stack), out: (addr stream byte) { - 95 var self/esi: (addr grapheme-stack) <- copy _self - 96 var data-ah/edi: (addr handle array grapheme) <- get self, data - 97 var _data/eax: (addr array grapheme) <- lookup *data-ah - 98 var data/edi: (addr array grapheme) <- copy _data - 99 var top-addr/ecx: (addr int) <- get self, top - 100 var i/eax: int <- copy *top-addr - 101 i <- decrement - 102 { - 103 compare i, 0 - 104 break-if-< - 105 var g/edx: (addr grapheme) <- index data, i - 106 write-grapheme out, *g - 107 i <- decrement - 108 loop - 109 } - 110 } - 111 - 112 # We implicitly render everything editable in a single color, and assume the - 113 # cursor is a single other color. - 114 fn render-gap-buffer-wrapping-right-then-down screen: (addr screen), _gap: (addr gap-buffer), xmin: int, ymin: int, xmax: int, ymax: int, render-cursor?: boolean -> _/eax: int, _/ecx: int { - 115 var gap/esi: (addr gap-buffer) <- copy _gap - 116 var left/edx: (addr grapheme-stack) <- get gap, left - 117 var highlight-matching-open-paren?/ebx: boolean <- copy 0/false - 118 var matching-open-paren-depth/edi: int <- copy 0 - 119 highlight-matching-open-paren?, matching-open-paren-depth <- highlight-matching-open-paren? gap, render-cursor? - 120 var x2/eax: int <- copy 0 - 121 var y2/ecx: int <- copy 0 - 122 x2, y2 <- render-stack-from-bottom-wrapping-right-then-down screen, left, xmin, ymin, xmax, ymax, xmin, ymin, highlight-matching-open-paren?, matching-open-paren-depth - 123 var right/edx: (addr grapheme-stack) <- get gap, right - 124 x2, y2 <- render-stack-from-top-wrapping-right-then-down screen, right, xmin, ymin, xmax, ymax, x2, y2, render-cursor? - 125 # decide whether we still need to print a cursor - 126 var bg/ebx: int <- copy 0 - 127 compare render-cursor?, 0/false - 128 { - 129 break-if-= - 130 # if the right side is empty, grapheme stack didn't print the cursor - 131 var empty?/eax: boolean <- grapheme-stack-empty? right - 132 compare empty?, 0/false - 133 break-if-= - 134 bg <- copy 7/cursor - 135 } - 136 # print a grapheme either way so that cursor position doesn't affect printed width - 137 var space/edx: grapheme <- copy 0x20 - 138 x2, y2 <- render-grapheme screen, space, xmin, ymin, xmax, ymax, x2, y2, 3/fg=cyan, bg - 139 return x2, y2 - 140 } - 141 - 142 fn render-gap-buffer screen: (addr screen), gap: (addr gap-buffer), x: int, y: int, render-cursor?: boolean -> _/eax: int { - 143 var _width/eax: int <- copy 0 - 144 var _height/ecx: int <- copy 0 - 145 _width, _height <- screen-size screen - 146 var width/edx: int <- copy _width - 147 var height/ebx: int <- copy _height - 148 var x2/eax: int <- copy 0 - 149 var y2/ecx: int <- copy 0 - 150 x2, y2 <- render-gap-buffer-wrapping-right-then-down screen, gap, x, y, width, height, render-cursor? - 151 return x2 # y2? yolo - 152 } - 153 - 154 fn gap-buffer-length _gap: (addr gap-buffer) -> _/eax: int { - 155 var gap/esi: (addr gap-buffer) <- copy _gap - 156 var left/eax: (addr grapheme-stack) <- get gap, left - 157 var tmp/eax: (addr int) <- get left, top - 158 var left-length/ecx: int <- copy *tmp - 159 var right/esi: (addr grapheme-stack) <- get gap, right - 160 tmp <- get right, top - 161 var result/eax: int <- copy *tmp - 162 result <- add left-length - 163 return result - 164 } - 165 - 166 fn add-grapheme-at-gap _self: (addr gap-buffer), g: grapheme { - 167 var self/esi: (addr gap-buffer) <- copy _self - 168 var left/eax: (addr grapheme-stack) <- get self, left - 169 push-grapheme-stack left, g - 170 } - 171 - 172 fn add-code-point-at-gap self: (addr gap-buffer), c: code-point { - 173 var g/eax: grapheme <- copy c - 174 add-grapheme-at-gap self, g - 175 } - 176 - 177 fn gap-to-start self: (addr gap-buffer) { - 178 { - 179 var curr/eax: grapheme <- gap-left self - 180 compare curr, -1 - 181 loop-if-!= - 182 } - 183 } - 184 - 185 fn gap-to-end self: (addr gap-buffer) { - 186 { - 187 var curr/eax: grapheme <- gap-right self - 188 compare curr, -1 - 189 loop-if-!= - 190 } - 191 } - 192 - 193 fn gap-at-start? _self: (addr gap-buffer) -> _/eax: boolean { - 194 var self/esi: (addr gap-buffer) <- copy _self - 195 var left/eax: (addr grapheme-stack) <- get self, left - 196 var result/eax: boolean <- grapheme-stack-empty? left - 197 return result - 198 } - 199 - 200 fn gap-at-end? _self: (addr gap-buffer) -> _/eax: boolean { - 201 var self/esi: (addr gap-buffer) <- copy _self - 202 var right/eax: (addr grapheme-stack) <- get self, right - 203 var result/eax: boolean <- grapheme-stack-empty? right - 204 return result - 205 } - 206 - 207 fn gap-right _self: (addr gap-buffer) -> _/eax: grapheme { - 208 var self/esi: (addr gap-buffer) <- copy _self - 209 var g/eax: grapheme <- copy 0 - 210 var right/ecx: (addr grapheme-stack) <- get self, right - 211 g <- pop-grapheme-stack right - 212 compare g, -1 - 213 { - 214 break-if-= - 215 var left/ecx: (addr grapheme-stack) <- get self, left - 216 push-grapheme-stack left, g - 217 } - 218 return g - 219 } - 220 - 221 fn gap-left _self: (addr gap-buffer) -> _/eax: grapheme { - 222 var self/esi: (addr gap-buffer) <- copy _self - 223 var g/eax: grapheme <- copy 0 - 224 { - 225 var left/ecx: (addr grapheme-stack) <- get self, left - 226 g <- pop-grapheme-stack left - 227 } - 228 compare g, -1 - 229 { - 230 break-if-= - 231 var right/ecx: (addr grapheme-stack) <- get self, right - 232 push-grapheme-stack right, g - 233 } - 234 return g - 235 } - 236 - 237 fn index-of-gap _self: (addr gap-buffer) -> _/eax: int { - 238 var self/eax: (addr gap-buffer) <- copy _self - 239 var left/eax: (addr grapheme-stack) <- get self, left - 240 var top-addr/eax: (addr int) <- get left, top - 241 var result/eax: int <- copy *top-addr - 242 return result - 243 } - 244 - 245 fn first-grapheme-in-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { - 246 var self/esi: (addr gap-buffer) <- copy _self - 247 # try to read from left + 69 clear-stream out + 70 var left/eax: (addr grapheme-stack) <- get self, left + 71 emit-stack-from-bottom left, out + 72 var right/eax: (addr grapheme-stack) <- get self, right + 73 emit-stack-from-top right, out + 74 } + 75 + 76 fn append-gap-buffer _self: (addr gap-buffer), out: (addr stream byte) { + 77 var self/esi: (addr gap-buffer) <- copy _self + 78 var left/eax: (addr grapheme-stack) <- get self, left + 79 emit-stack-from-bottom left, out + 80 var right/eax: (addr grapheme-stack) <- get self, right + 81 emit-stack-from-top right, out + 82 } + 83 + 84 # dump stack from bottom to top + 85 fn emit-stack-from-bottom _self: (addr grapheme-stack), out: (addr stream byte) { + 86 var self/esi: (addr grapheme-stack) <- copy _self + 87 var data-ah/edi: (addr handle array grapheme) <- get self, data + 88 var _data/eax: (addr array grapheme) <- lookup *data-ah + 89 var data/edi: (addr array grapheme) <- copy _data + 90 var top-addr/ecx: (addr int) <- get self, top + 91 var i/eax: int <- copy 0 + 92 { + 93 compare i, *top-addr + 94 break-if->= + 95 var g/edx: (addr grapheme) <- index data, i + 96 write-grapheme out, *g + 97 i <- increment + 98 loop + 99 } + 100 } + 101 + 102 # dump stack from top to bottom + 103 fn emit-stack-from-top _self: (addr grapheme-stack), out: (addr stream byte) { + 104 var self/esi: (addr grapheme-stack) <- copy _self + 105 var data-ah/edi: (addr handle array grapheme) <- get self, data + 106 var _data/eax: (addr array grapheme) <- lookup *data-ah + 107 var data/edi: (addr array grapheme) <- copy _data + 108 var top-addr/ecx: (addr int) <- get self, top + 109 var i/eax: int <- copy *top-addr + 110 i <- decrement + 111 { + 112 compare i, 0 + 113 break-if-< + 114 var g/edx: (addr grapheme) <- index data, i + 115 write-grapheme out, *g + 116 i <- decrement + 117 loop + 118 } + 119 } + 120 + 121 # We implicitly render everything editable in a single color, and assume the + 122 # cursor is a single other color. + 123 fn render-gap-buffer-wrapping-right-then-down screen: (addr screen), _gap: (addr gap-buffer), xmin: int, ymin: int, xmax: int, ymax: int, render-cursor?: boolean, color: int, background-color: int -> _/eax: int, _/ecx: int { + 124 var gap/esi: (addr gap-buffer) <- copy _gap + 125 var left/edx: (addr grapheme-stack) <- get gap, left + 126 var highlight-matching-open-paren?/ebx: boolean <- copy 0/false + 127 var matching-open-paren-depth/edi: int <- copy 0 + 128 highlight-matching-open-paren?, matching-open-paren-depth <- highlight-matching-open-paren? gap, render-cursor? + 129 var x2/eax: int <- copy 0 + 130 var y2/ecx: int <- copy 0 + 131 x2, y2 <- render-stack-from-bottom-wrapping-right-then-down screen, left, xmin, ymin, xmax, ymax, xmin, ymin, highlight-matching-open-paren?, matching-open-paren-depth, color, background-color + 132 var right/edx: (addr grapheme-stack) <- get gap, right + 133 x2, y2 <- render-stack-from-top-wrapping-right-then-down screen, right, xmin, ymin, xmax, ymax, x2, y2, render-cursor?, color, background-color + 134 # decide whether we still need to print a cursor + 135 var bg/ebx: int <- copy background-color + 136 compare render-cursor?, 0/false + 137 { + 138 break-if-= + 139 # if the right side is empty, grapheme stack didn't print the cursor + 140 var empty?/eax: boolean <- grapheme-stack-empty? right + 141 compare empty?, 0/false + 142 break-if-= + 143 bg <- copy 7/cursor + 144 } + 145 # print a grapheme either way so that cursor position doesn't affect printed width + 146 var space/edx: grapheme <- copy 0x20 + 147 x2, y2 <- render-grapheme screen, space, xmin, ymin, xmax, ymax, x2, y2, color, bg + 148 return x2, y2 + 149 } + 150 + 151 fn render-gap-buffer screen: (addr screen), gap: (addr gap-buffer), x: int, y: int, render-cursor?: boolean, color: int, background-color: int -> _/eax: int { + 152 var _width/eax: int <- copy 0 + 153 var _height/ecx: int <- copy 0 + 154 _width, _height <- screen-size screen + 155 var width/edx: int <- copy _width + 156 var height/ebx: int <- copy _height + 157 var x2/eax: int <- copy 0 + 158 var y2/ecx: int <- copy 0 + 159 x2, y2 <- render-gap-buffer-wrapping-right-then-down screen, gap, x, y, width, height, render-cursor?, color, background-color + 160 return x2 # y2? yolo + 161 } + 162 + 163 fn gap-buffer-length _gap: (addr gap-buffer) -> _/eax: int { + 164 var gap/esi: (addr gap-buffer) <- copy _gap + 165 var left/eax: (addr grapheme-stack) <- get gap, left + 166 var tmp/eax: (addr int) <- get left, top + 167 var left-length/ecx: int <- copy *tmp + 168 var right/esi: (addr grapheme-stack) <- get gap, right + 169 tmp <- get right, top + 170 var result/eax: int <- copy *tmp + 171 result <- add left-length + 172 return result + 173 } + 174 + 175 fn add-grapheme-at-gap _self: (addr gap-buffer), g: grapheme { + 176 var self/esi: (addr gap-buffer) <- copy _self + 177 var left/eax: (addr grapheme-stack) <- get self, left + 178 push-grapheme-stack left, g + 179 } + 180 + 181 fn add-code-point-at-gap self: (addr gap-buffer), c: code-point { + 182 var g/eax: grapheme <- copy c + 183 add-grapheme-at-gap self, g + 184 } + 185 + 186 fn gap-to-start self: (addr gap-buffer) { + 187 { + 188 var curr/eax: grapheme <- gap-left self + 189 compare curr, -1 + 190 loop-if-!= + 191 } + 192 } + 193 + 194 fn gap-to-end self: (addr gap-buffer) { + 195 { + 196 var curr/eax: grapheme <- gap-right self + 197 compare curr, -1 + 198 loop-if-!= + 199 } + 200 } + 201 + 202 fn gap-at-start? _self: (addr gap-buffer) -> _/eax: boolean { + 203 var self/esi: (addr gap-buffer) <- copy _self + 204 var left/eax: (addr grapheme-stack) <- get self, left + 205 var result/eax: boolean <- grapheme-stack-empty? left + 206 return result + 207 } + 208 + 209 fn gap-at-end? _self: (addr gap-buffer) -> _/eax: boolean { + 210 var self/esi: (addr gap-buffer) <- copy _self + 211 var right/eax: (addr grapheme-stack) <- get self, right + 212 var result/eax: boolean <- grapheme-stack-empty? right + 213 return result + 214 } + 215 + 216 fn gap-right _self: (addr gap-buffer) -> _/eax: grapheme { + 217 var self/esi: (addr gap-buffer) <- copy _self + 218 var g/eax: grapheme <- copy 0 + 219 var right/ecx: (addr grapheme-stack) <- get self, right + 220 g <- pop-grapheme-stack right + 221 compare g, -1 + 222 { + 223 break-if-= + 224 var left/ecx: (addr grapheme-stack) <- get self, left + 225 push-grapheme-stack left, g + 226 } + 227 return g + 228 } + 229 + 230 fn gap-left _self: (addr gap-buffer) -> _/eax: grapheme { + 231 var self/esi: (addr gap-buffer) <- copy _self + 232 var g/eax: grapheme <- copy 0 + 233 { + 234 var left/ecx: (addr grapheme-stack) <- get self, left + 235 g <- pop-grapheme-stack left + 236 } + 237 compare g, -1 + 238 { + 239 break-if-= + 240 var right/ecx: (addr grapheme-stack) <- get self, right + 241 push-grapheme-stack right, g + 242 } + 243 return g + 244 } + 245 + 246 fn index-of-gap _self: (addr gap-buffer) -> _/eax: int { + 247 var self/eax: (addr gap-buffer) <- copy _self 248 var left/eax: (addr grapheme-stack) <- get self, left - 249 var top-addr/ecx: (addr int) <- get left, top - 250 compare *top-addr, 0 - 251 { - 252 break-if-<= - 253 var data-ah/eax: (addr handle array grapheme) <- get left, data - 254 var data/eax: (addr array grapheme) <- lookup *data-ah - 255 var result-addr/eax: (addr grapheme) <- index data, 0 - 256 return *result-addr - 257 } - 258 # try to read from right - 259 var right/eax: (addr grapheme-stack) <- get self, right - 260 top-addr <- get right, top - 261 compare *top-addr, 0 - 262 { - 263 break-if-<= - 264 var data-ah/eax: (addr handle array grapheme) <- get right, data - 265 var data/eax: (addr array grapheme) <- lookup *data-ah - 266 var top/ecx: int <- copy *top-addr - 267 top <- decrement - 268 var result-addr/eax: (addr grapheme) <- index data, top - 269 return *result-addr - 270 } - 271 # give up - 272 return -1 - 273 } - 274 - 275 fn grapheme-before-cursor-in-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { - 276 var self/esi: (addr gap-buffer) <- copy _self - 277 # try to read from left - 278 var left/ecx: (addr grapheme-stack) <- get self, left - 279 var top-addr/edx: (addr int) <- get left, top - 280 compare *top-addr, 0 - 281 { - 282 break-if-<= - 283 var result/eax: grapheme <- pop-grapheme-stack left - 284 push-grapheme-stack left, result - 285 return result - 286 } - 287 # give up - 288 return -1 - 289 } - 290 - 291 fn delete-before-gap _self: (addr gap-buffer) { - 292 var self/eax: (addr gap-buffer) <- copy _self - 293 var left/eax: (addr grapheme-stack) <- get self, left - 294 var dummy/eax: grapheme <- pop-grapheme-stack left - 295 } - 296 - 297 fn pop-after-gap _self: (addr gap-buffer) -> _/eax: grapheme { - 298 var self/eax: (addr gap-buffer) <- copy _self - 299 var right/eax: (addr grapheme-stack) <- get self, right - 300 var result/eax: grapheme <- pop-grapheme-stack right - 301 return result - 302 } - 303 - 304 fn gap-buffer-equal? _self: (addr gap-buffer), s: (addr array byte) -> _/eax: boolean { - 305 var self/esi: (addr gap-buffer) <- copy _self - 306 # complication: graphemes may be multiple bytes - 307 # so don't rely on length - 308 # instead turn the expected result into a stream and arrange to read from it in order - 309 var stream-storage: (stream byte 0x10/capacity) - 310 var expected-stream/ecx: (addr stream byte) <- address stream-storage - 311 write expected-stream, s - 312 # compare left - 313 var left/edx: (addr grapheme-stack) <- get self, left - 314 var result/eax: boolean <- prefix-match? left, expected-stream - 315 compare result, 0/false - 316 { - 317 break-if-!= - 318 return result - 319 } - 320 # compare right - 321 var right/edx: (addr grapheme-stack) <- get self, right - 322 result <- suffix-match? right, expected-stream - 323 compare result, 0/false - 324 { - 325 break-if-!= - 326 return result - 327 } - 328 # ensure there's nothing left over - 329 result <- stream-empty? expected-stream - 330 return result - 331 } - 332 - 333 fn test-gap-buffer-equal-from-end { - 334 var _g: gap-buffer - 335 var g/esi: (addr gap-buffer) <- address _g - 336 initialize-gap-buffer g, 0x10 - 337 # - 338 add-code-point-at-gap g, 0x61/a - 339 add-code-point-at-gap g, 0x61/a - 340 add-code-point-at-gap g, 0x61/a - 341 # gap is at end (right is empty) - 342 var result/eax: boolean <- gap-buffer-equal? g, "aaa" - 343 check result, "F - test-gap-buffer-equal-from-end" - 344 } - 345 - 346 fn test-gap-buffer-equal-from-middle { - 347 var _g: gap-buffer - 348 var g/esi: (addr gap-buffer) <- address _g - 349 initialize-gap-buffer g, 0x10 - 350 # - 351 add-code-point-at-gap g, 0x61/a - 352 add-code-point-at-gap g, 0x61/a - 353 add-code-point-at-gap g, 0x61/a - 354 var dummy/eax: grapheme <- gap-left g - 355 # gap is in the middle - 356 var result/eax: boolean <- gap-buffer-equal? g, "aaa" - 357 check result, "F - test-gap-buffer-equal-from-middle" - 358 } - 359 - 360 fn test-gap-buffer-equal-from-start { - 361 var _g: gap-buffer - 362 var g/esi: (addr gap-buffer) <- address _g - 363 initialize-gap-buffer g, 0x10 - 364 # - 365 add-code-point-at-gap g, 0x61/a - 366 add-code-point-at-gap g, 0x61/a - 367 add-code-point-at-gap g, 0x61/a - 368 var dummy/eax: grapheme <- gap-left g - 369 dummy <- gap-left g - 370 dummy <- gap-left g - 371 # gap is at the start - 372 var result/eax: boolean <- gap-buffer-equal? g, "aaa" - 373 check result, "F - test-gap-buffer-equal-from-start" - 374 } - 375 - 376 fn test-gap-buffer-equal-fails { - 377 # g = "aaa" - 378 var _g: gap-buffer - 379 var g/esi: (addr gap-buffer) <- address _g - 380 initialize-gap-buffer g, 0x10 - 381 add-code-point-at-gap g, 0x61/a - 382 add-code-point-at-gap g, 0x61/a - 383 add-code-point-at-gap g, 0x61/a - 384 # - 385 var result/eax: boolean <- gap-buffer-equal? g, "aa" - 386 check-not result, "F - test-gap-buffer-equal-fails" - 387 } - 388 - 389 fn gap-buffers-equal? self: (addr gap-buffer), g: (addr gap-buffer) -> _/eax: boolean { - 390 var tmp/eax: int <- gap-buffer-length self - 391 var len/ecx: int <- copy tmp - 392 var leng/eax: int <- gap-buffer-length g - 393 compare len, leng - 394 { - 395 break-if-= - 396 return 0/false - 397 } - 398 var i/edx: int <- copy 0 - 399 { - 400 compare i, len - 401 break-if->= - 402 { - 403 var tmp/eax: grapheme <- gap-index self, i - 404 var curr/ecx: grapheme <- copy tmp - 405 var currg/eax: grapheme <- gap-index g, i - 406 compare curr, currg - 407 break-if-= - 408 return 0/false - 409 } - 410 i <- increment - 411 loop - 412 } - 413 return 1/true - 414 } - 415 - 416 fn gap-index _self: (addr gap-buffer), _n: int -> _/eax: grapheme { - 417 var self/esi: (addr gap-buffer) <- copy _self - 418 var n/ebx: int <- copy _n - 419 # if n < left->length, index into left - 420 var left/edi: (addr grapheme-stack) <- get self, left - 421 var left-len-a/edx: (addr int) <- get left, top - 422 compare n, *left-len-a - 423 { - 424 break-if->= - 425 var data-ah/eax: (addr handle array grapheme) <- get left, data - 426 var data/eax: (addr array grapheme) <- lookup *data-ah - 427 var result/eax: (addr grapheme) <- index data, n - 428 return *result - 429 } - 430 # shrink n - 431 n <- subtract *left-len-a - 432 # if n < right->length, index into right - 433 var right/edi: (addr grapheme-stack) <- get self, right - 434 var right-len-a/edx: (addr int) <- get right, top - 435 compare n, *right-len-a - 436 { - 437 break-if->= - 438 var data-ah/eax: (addr handle array grapheme) <- get right, data - 439 var data/eax: (addr array grapheme) <- lookup *data-ah - 440 # idx = right->len - n - 1 - 441 var idx/ebx: int <- copy n - 442 idx <- subtract *right-len-a - 443 idx <- negate - 444 idx <- subtract 1 - 445 var result/eax: (addr grapheme) <- index data, idx - 446 return *result - 447 } - 448 # error - 449 abort "gap-index: out of bounds" - 450 return 0 - 451 } - 452 - 453 fn test-gap-buffers-equal? { - 454 var _a: gap-buffer - 455 var a/esi: (addr gap-buffer) <- address _a - 456 initialize-gap-buffer-with a, "abc" - 457 var _b: gap-buffer - 458 var b/edi: (addr gap-buffer) <- address _b - 459 initialize-gap-buffer-with b, "abc" - 460 var _c: gap-buffer - 461 var c/ebx: (addr gap-buffer) <- address _c - 462 initialize-gap-buffer-with c, "ab" - 463 var _d: gap-buffer - 464 var d/edx: (addr gap-buffer) <- address _d - 465 initialize-gap-buffer-with d, "abd" - 466 # - 467 var result/eax: boolean <- gap-buffers-equal? a, a - 468 check result, "F - test-gap-buffers-equal? - reflexive" - 469 result <- gap-buffers-equal? a, b - 470 check result, "F - test-gap-buffers-equal? - equal" - 471 # length not equal - 472 result <- gap-buffers-equal? a, c - 473 check-not result, "F - test-gap-buffers-equal? - not equal" - 474 # contents not equal - 475 result <- gap-buffers-equal? a, d - 476 check-not result, "F - test-gap-buffers-equal? - not equal 2" - 477 result <- gap-buffers-equal? d, a - 478 check-not result, "F - test-gap-buffers-equal? - not equal 3" - 479 } - 480 - 481 fn test-gap-buffer-index { - 482 var gap-storage: gap-buffer - 483 var gap/esi: (addr gap-buffer) <- address gap-storage - 484 initialize-gap-buffer-with gap, "abc" - 485 # gap is at end, all contents are in left - 486 var g/eax: grapheme <- gap-index gap, 0 - 487 var x/ecx: int <- copy g - 488 check-ints-equal x, 0x61/a, "F - test-gap-index/left-1" - 489 var g/eax: grapheme <- gap-index gap, 1 - 490 var x/ecx: int <- copy g - 491 check-ints-equal x, 0x62/b, "F - test-gap-index/left-2" - 492 var g/eax: grapheme <- gap-index gap, 2 - 493 var x/ecx: int <- copy g - 494 check-ints-equal x, 0x63/c, "F - test-gap-index/left-3" - 495 # now check when everything is to the right - 496 gap-to-start gap - 497 rewind-gap-buffer gap - 498 var g/eax: grapheme <- gap-index gap, 0 + 249 var top-addr/eax: (addr int) <- get left, top + 250 var result/eax: int <- copy *top-addr + 251 return result + 252 } + 253 + 254 fn first-grapheme-in-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { + 255 var self/esi: (addr gap-buffer) <- copy _self + 256 # try to read from left + 257 var left/eax: (addr grapheme-stack) <- get self, left + 258 var top-addr/ecx: (addr int) <- get left, top + 259 compare *top-addr, 0 + 260 { + 261 break-if-<= + 262 var data-ah/eax: (addr handle array grapheme) <- get left, data + 263 var data/eax: (addr array grapheme) <- lookup *data-ah + 264 var result-addr/eax: (addr grapheme) <- index data, 0 + 265 return *result-addr + 266 } + 267 # try to read from right + 268 var right/eax: (addr grapheme-stack) <- get self, right + 269 top-addr <- get right, top + 270 compare *top-addr, 0 + 271 { + 272 break-if-<= + 273 var data-ah/eax: (addr handle array grapheme) <- get right, data + 274 var data/eax: (addr array grapheme) <- lookup *data-ah + 275 var top/ecx: int <- copy *top-addr + 276 top <- decrement + 277 var result-addr/eax: (addr grapheme) <- index data, top + 278 return *result-addr + 279 } + 280 # give up + 281 return -1 + 282 } + 283 + 284 fn grapheme-before-cursor-in-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { + 285 var self/esi: (addr gap-buffer) <- copy _self + 286 # try to read from left + 287 var left/ecx: (addr grapheme-stack) <- get self, left + 288 var top-addr/edx: (addr int) <- get left, top + 289 compare *top-addr, 0 + 290 { + 291 break-if-<= + 292 var result/eax: grapheme <- pop-grapheme-stack left + 293 push-grapheme-stack left, result + 294 return result + 295 } + 296 # give up + 297 return -1 + 298 } + 299 + 300 fn delete-before-gap _self: (addr gap-buffer) { + 301 var self/eax: (addr gap-buffer) <- copy _self + 302 var left/eax: (addr grapheme-stack) <- get self, left + 303 var dummy/eax: grapheme <- pop-grapheme-stack left + 304 } + 305 + 306 fn pop-after-gap _self: (addr gap-buffer) -> _/eax: grapheme { + 307 var self/eax: (addr gap-buffer) <- copy _self + 308 var right/eax: (addr grapheme-stack) <- get self, right + 309 var result/eax: grapheme <- pop-grapheme-stack right + 310 return result + 311 } + 312 + 313 fn gap-buffer-equal? _self: (addr gap-buffer), s: (addr array byte) -> _/eax: boolean { + 314 var self/esi: (addr gap-buffer) <- copy _self + 315 # complication: graphemes may be multiple bytes + 316 # so don't rely on length + 317 # instead turn the expected result into a stream and arrange to read from it in order + 318 var stream-storage: (stream byte 0x10/capacity) + 319 var expected-stream/ecx: (addr stream byte) <- address stream-storage + 320 write expected-stream, s + 321 # compare left + 322 var left/edx: (addr grapheme-stack) <- get self, left + 323 var result/eax: boolean <- prefix-match? left, expected-stream + 324 compare result, 0/false + 325 { + 326 break-if-!= + 327 return result + 328 } + 329 # compare right + 330 var right/edx: (addr grapheme-stack) <- get self, right + 331 result <- suffix-match? right, expected-stream + 332 compare result, 0/false + 333 { + 334 break-if-!= + 335 return result + 336 } + 337 # ensure there's nothing left over + 338 result <- stream-empty? expected-stream + 339 return result + 340 } + 341 + 342 fn test-gap-buffer-equal-from-end { + 343 var _g: gap-buffer + 344 var g/esi: (addr gap-buffer) <- address _g + 345 initialize-gap-buffer g, 0x10 + 346 # + 347 add-code-point-at-gap g, 0x61/a + 348 add-code-point-at-gap g, 0x61/a + 349 add-code-point-at-gap g, 0x61/a + 350 # gap is at end (right is empty) + 351 var result/eax: boolean <- gap-buffer-equal? g, "aaa" + 352 check result, "F - test-gap-buffer-equal-from-end" + 353 } + 354 + 355 fn test-gap-buffer-equal-from-middle { + 356 var _g: gap-buffer + 357 var g/esi: (addr gap-buffer) <- address _g + 358 initialize-gap-buffer g, 0x10 + 359 # + 360 add-code-point-at-gap g, 0x61/a + 361 add-code-point-at-gap g, 0x61/a + 362 add-code-point-at-gap g, 0x61/a + 363 var dummy/eax: grapheme <- gap-left g + 364 # gap is in the middle + 365 var result/eax: boolean <- gap-buffer-equal? g, "aaa" + 366 check result, "F - test-gap-buffer-equal-from-middle" + 367 } + 368 + 369 fn test-gap-buffer-equal-from-start { + 370 var _g: gap-buffer + 371 var g/esi: (addr gap-buffer) <- address _g + 372 initialize-gap-buffer g, 0x10 + 373 # + 374 add-code-point-at-gap g, 0x61/a + 375 add-code-point-at-gap g, 0x61/a + 376 add-code-point-at-gap g, 0x61/a + 377 var dummy/eax: grapheme <- gap-left g + 378 dummy <- gap-left g + 379 dummy <- gap-left g + 380 # gap is at the start + 381 var result/eax: boolean <- gap-buffer-equal? g, "aaa" + 382 check result, "F - test-gap-buffer-equal-from-start" + 383 } + 384 + 385 fn test-gap-buffer-equal-fails { + 386 # g = "aaa" + 387 var _g: gap-buffer + 388 var g/esi: (addr gap-buffer) <- address _g + 389 initialize-gap-buffer g, 0x10 + 390 add-code-point-at-gap g, 0x61/a + 391 add-code-point-at-gap g, 0x61/a + 392 add-code-point-at-gap g, 0x61/a + 393 # + 394 var result/eax: boolean <- gap-buffer-equal? g, "aa" + 395 check-not result, "F - test-gap-buffer-equal-fails" + 396 } + 397 + 398 fn gap-buffers-equal? self: (addr gap-buffer), g: (addr gap-buffer) -> _/eax: boolean { + 399 var tmp/eax: int <- gap-buffer-length self + 400 var len/ecx: int <- copy tmp + 401 var leng/eax: int <- gap-buffer-length g + 402 compare len, leng + 403 { + 404 break-if-= + 405 return 0/false + 406 } + 407 var i/edx: int <- copy 0 + 408 { + 409 compare i, len + 410 break-if->= + 411 { + 412 var tmp/eax: grapheme <- gap-index self, i + 413 var curr/ecx: grapheme <- copy tmp + 414 var currg/eax: grapheme <- gap-index g, i + 415 compare curr, currg + 416 break-if-= + 417 return 0/false + 418 } + 419 i <- increment + 420 loop + 421 } + 422 return 1/true + 423 } + 424 + 425 fn gap-index _self: (addr gap-buffer), _n: int -> _/eax: grapheme { + 426 var self/esi: (addr gap-buffer) <- copy _self + 427 var n/ebx: int <- copy _n + 428 # if n < left->length, index into left + 429 var left/edi: (addr grapheme-stack) <- get self, left + 430 var left-len-a/edx: (addr int) <- get left, top + 431 compare n, *left-len-a + 432 { + 433 break-if->= + 434 var data-ah/eax: (addr handle array grapheme) <- get left, data + 435 var data/eax: (addr array grapheme) <- lookup *data-ah + 436 var result/eax: (addr grapheme) <- index data, n + 437 return *result + 438 } + 439 # shrink n + 440 n <- subtract *left-len-a + 441 # if n < right->length, index into right + 442 var right/edi: (addr grapheme-stack) <- get self, right + 443 var right-len-a/edx: (addr int) <- get right, top + 444 compare n, *right-len-a + 445 { + 446 break-if->= + 447 var data-ah/eax: (addr handle array grapheme) <- get right, data + 448 var data/eax: (addr array grapheme) <- lookup *data-ah + 449 # idx = right->len - n - 1 + 450 var idx/ebx: int <- copy n + 451 idx <- subtract *right-len-a + 452 idx <- negate + 453 idx <- subtract 1 + 454 var result/eax: (addr grapheme) <- index data, idx + 455 return *result + 456 } + 457 # error + 458 abort "gap-index: out of bounds" + 459 return 0 + 460 } + 461 + 462 fn test-gap-buffers-equal? { + 463 var _a: gap-buffer + 464 var a/esi: (addr gap-buffer) <- address _a + 465 initialize-gap-buffer-with a, "abc" + 466 var _b: gap-buffer + 467 var b/edi: (addr gap-buffer) <- address _b + 468 initialize-gap-buffer-with b, "abc" + 469 var _c: gap-buffer + 470 var c/ebx: (addr gap-buffer) <- address _c + 471 initialize-gap-buffer-with c, "ab" + 472 var _d: gap-buffer + 473 var d/edx: (addr gap-buffer) <- address _d + 474 initialize-gap-buffer-with d, "abd" + 475 # + 476 var result/eax: boolean <- gap-buffers-equal? a, a + 477 check result, "F - test-gap-buffers-equal? - reflexive" + 478 result <- gap-buffers-equal? a, b + 479 check result, "F - test-gap-buffers-equal? - equal" + 480 # length not equal + 481 result <- gap-buffers-equal? a, c + 482 check-not result, "F - test-gap-buffers-equal? - not equal" + 483 # contents not equal + 484 result <- gap-buffers-equal? a, d + 485 check-not result, "F - test-gap-buffers-equal? - not equal 2" + 486 result <- gap-buffers-equal? d, a + 487 check-not result, "F - test-gap-buffers-equal? - not equal 3" + 488 } + 489 + 490 fn test-gap-buffer-index { + 491 var gap-storage: gap-buffer + 492 var gap/esi: (addr gap-buffer) <- address gap-storage + 493 initialize-gap-buffer-with gap, "abc" + 494 # gap is at end, all contents are in left + 495 var g/eax: grapheme <- gap-index gap, 0 + 496 var x/ecx: int <- copy g + 497 check-ints-equal x, 0x61/a, "F - test-gap-index/left-1" + 498 var g/eax: grapheme <- gap-index gap, 1 499 var x/ecx: int <- copy g - 500 check-ints-equal x, 0x61/a, "F - test-gap-index/right-1" - 501 var g/eax: grapheme <- gap-index gap, 1 + 500 check-ints-equal x, 0x62/b, "F - test-gap-index/left-2" + 501 var g/eax: grapheme <- gap-index gap, 2 502 var x/ecx: int <- copy g - 503 check-ints-equal x, 0x62/b, "F - test-gap-index/right-2" - 504 var g/eax: grapheme <- gap-index gap, 2 - 505 var x/ecx: int <- copy g - 506 check-ints-equal x, 0x63/c, "F - test-gap-index/right-3" - 507 } - 508 - 509 fn copy-gap-buffer _src-ah: (addr handle gap-buffer), _dest-ah: (addr handle gap-buffer) { - 510 # obtain src-a, dest-a - 511 var src-ah/eax: (addr handle gap-buffer) <- copy _src-ah - 512 var _src-a/eax: (addr gap-buffer) <- lookup *src-ah - 513 var src-a/esi: (addr gap-buffer) <- copy _src-a - 514 var dest-ah/eax: (addr handle gap-buffer) <- copy _dest-ah - 515 var _dest-a/eax: (addr gap-buffer) <- lookup *dest-ah - 516 var dest-a/edi: (addr gap-buffer) <- copy _dest-a - 517 # copy left grapheme-stack - 518 var src/ecx: (addr grapheme-stack) <- get src-a, left - 519 var dest/edx: (addr grapheme-stack) <- get dest-a, left - 520 copy-grapheme-stack src, dest - 521 # copy right grapheme-stack - 522 src <- get src-a, right - 523 dest <- get dest-a, right - 524 copy-grapheme-stack src, dest - 525 } - 526 - 527 fn gap-buffer-is-decimal-integer? _self: (addr gap-buffer) -> _/eax: boolean { - 528 var self/esi: (addr gap-buffer) <- copy _self - 529 var curr/ecx: (addr grapheme-stack) <- get self, left - 530 var result/eax: boolean <- grapheme-stack-is-decimal-integer? curr - 531 { - 532 compare result, 0/false - 533 break-if-= - 534 curr <- get self, right - 535 result <- grapheme-stack-is-decimal-integer? curr - 536 } - 537 return result - 538 } - 539 - 540 fn test-render-gap-buffer-without-cursor { - 541 # setup - 542 var gap-storage: gap-buffer - 543 var gap/esi: (addr gap-buffer) <- address gap-storage - 544 initialize-gap-buffer-with gap, "abc" - 545 # setup: screen - 546 var screen-on-stack: screen - 547 var screen/edi: (addr screen) <- address screen-on-stack - 548 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 549 # - 550 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 0/no-cursor - 551 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-without-cursor" - 552 check-ints-equal x, 4, "F - test-render-gap-buffer-without-cursor: result" - 553 # abc - 554 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-render-gap-buffer-without-cursor: bg" - 555 } - 556 - 557 fn test-render-gap-buffer-with-cursor-at-end { - 558 # setup - 559 var gap-storage: gap-buffer - 560 var gap/esi: (addr gap-buffer) <- address gap-storage - 561 initialize-gap-buffer-with gap, "abc" - 562 gap-to-end gap - 563 # setup: screen - 564 var screen-on-stack: screen - 565 var screen/edi: (addr screen) <- address screen-on-stack - 566 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 567 # - 568 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor - 569 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-at-end" - 570 # we've drawn one extra grapheme for the cursor - 571 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-at-end: result" - 572 # abc - 573 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " |", "F - test-render-gap-buffer-with-cursor-at-end: bg" - 574 } - 575 - 576 fn test-render-gap-buffer-with-cursor-in-middle { - 577 # setup - 578 var gap-storage: gap-buffer - 579 var gap/esi: (addr gap-buffer) <- address gap-storage - 580 initialize-gap-buffer-with gap, "abc" - 581 gap-to-end gap - 582 var dummy/eax: grapheme <- gap-left gap - 583 # setup: screen - 584 var screen-on-stack: screen - 585 var screen/edi: (addr screen) <- address screen-on-stack - 586 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 587 # - 588 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor - 589 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-in-middle" - 590 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-in-middle: result" - 591 # abc - 592 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-render-gap-buffer-with-cursor-in-middle: bg" - 593 } - 594 - 595 fn test-render-gap-buffer-with-cursor-at-start { - 596 var gap-storage: gap-buffer - 597 var gap/esi: (addr gap-buffer) <- address gap-storage - 598 initialize-gap-buffer-with gap, "abc" - 599 gap-to-start gap - 600 # setup: screen - 601 var screen-on-stack: screen - 602 var screen/edi: (addr screen) <- address screen-on-stack - 603 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 604 # - 605 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor - 606 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-at-start" - 607 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-at-start: result" - 608 # abc - 609 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "| ", "F - test-render-gap-buffer-with-cursor-at-start: bg" - 610 } - 611 - 612 fn test-render-gap-buffer-highlight-matching-close-paren { - 613 var gap-storage: gap-buffer - 614 var gap/esi: (addr gap-buffer) <- address gap-storage - 615 initialize-gap-buffer-with gap, "(a)" - 616 gap-to-start gap - 617 # setup: screen - 618 var screen-on-stack: screen - 619 var screen/edi: (addr screen) <- address screen-on-stack - 620 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 621 # - 622 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor - 623 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-close-paren" - 624 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-close-paren: result" - 625 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "| ", "F - test-render-gap-buffer-highlight-matching-close-paren: cursor" - 626 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, " ) ", "F - test-render-gap-buffer-highlight-matching-close-paren: matching paren" - 627 } - 628 - 629 fn test-render-gap-buffer-highlight-matching-open-paren { - 630 var gap-storage: gap-buffer - 631 var gap/esi: (addr gap-buffer) <- address gap-storage - 632 initialize-gap-buffer-with gap, "(a)" - 633 gap-to-end gap - 634 var dummy/eax: grapheme <- gap-left gap - 635 # setup: screen - 636 var screen-on-stack: screen - 637 var screen/edi: (addr screen) <- address screen-on-stack - 638 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 639 # - 640 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor - 641 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-open-paren" - 642 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-open-paren: result" - 643 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-render-gap-buffer-highlight-matching-open-paren: cursor" - 644 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, "( ", "F - test-render-gap-buffer-highlight-matching-open-paren: matching paren" - 645 } - 646 - 647 fn test-render-gap-buffer-highlight-matching-open-paren-of-end { - 648 var gap-storage: gap-buffer - 649 var gap/esi: (addr gap-buffer) <- address gap-storage - 650 initialize-gap-buffer-with gap, "(a)" - 651 gap-to-end gap - 652 # setup: screen - 653 var screen-on-stack: screen - 654 var screen/edi: (addr screen) <- address screen-on-stack - 655 initialize-screen screen, 5, 4, 0/no-pixel-graphics - 656 # - 657 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor - 658 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end" - 659 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: result" - 660 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " |", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: cursor" - 661 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, "( ", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: matching paren" - 662 } - 663 - 664 # should I highlight a matching open paren? And if so, at what depth from top of left? - 665 # basically there are two cases to disambiguate here: - 666 # Usually the cursor is at top of right. Highlight first '(' at depth 0 from top of left. - 667 # If right is empty, match the ')' _before_ cursor. Highlight first '(' at depth _1_ from top of left. - 668 fn highlight-matching-open-paren? _gap: (addr gap-buffer), render-cursor?: boolean -> _/ebx: boolean, _/edi: int { - 669 # if not rendering cursor, return - 670 compare render-cursor?, 0/false - 671 { - 672 break-if-!= - 673 return 0/false, 0 - 674 } - 675 var gap/esi: (addr gap-buffer) <- copy _gap - 676 var stack/edi: (addr grapheme-stack) <- get gap, right - 677 var top-addr/eax: (addr int) <- get stack, top - 678 var top-index/ecx: int <- copy *top-addr - 679 compare top-index, 0 + 503 check-ints-equal x, 0x63/c, "F - test-gap-index/left-3" + 504 # now check when everything is to the right + 505 gap-to-start gap + 506 rewind-gap-buffer gap + 507 var g/eax: grapheme <- gap-index gap, 0 + 508 var x/ecx: int <- copy g + 509 check-ints-equal x, 0x61/a, "F - test-gap-index/right-1" + 510 var g/eax: grapheme <- gap-index gap, 1 + 511 var x/ecx: int <- copy g + 512 check-ints-equal x, 0x62/b, "F - test-gap-index/right-2" + 513 var g/eax: grapheme <- gap-index gap, 2 + 514 var x/ecx: int <- copy g + 515 check-ints-equal x, 0x63/c, "F - test-gap-index/right-3" + 516 } + 517 + 518 fn copy-gap-buffer _src-ah: (addr handle gap-buffer), _dest-ah: (addr handle gap-buffer) { + 519 # obtain src-a, dest-a + 520 var src-ah/eax: (addr handle gap-buffer) <- copy _src-ah + 521 var _src-a/eax: (addr gap-buffer) <- lookup *src-ah + 522 var src-a/esi: (addr gap-buffer) <- copy _src-a + 523 var dest-ah/eax: (addr handle gap-buffer) <- copy _dest-ah + 524 var _dest-a/eax: (addr gap-buffer) <- lookup *dest-ah + 525 var dest-a/edi: (addr gap-buffer) <- copy _dest-a + 526 # copy left grapheme-stack + 527 var src/ecx: (addr grapheme-stack) <- get src-a, left + 528 var dest/edx: (addr grapheme-stack) <- get dest-a, left + 529 copy-grapheme-stack src, dest + 530 # copy right grapheme-stack + 531 src <- get src-a, right + 532 dest <- get dest-a, right + 533 copy-grapheme-stack src, dest + 534 } + 535 + 536 fn gap-buffer-is-decimal-integer? _self: (addr gap-buffer) -> _/eax: boolean { + 537 var self/esi: (addr gap-buffer) <- copy _self + 538 var curr/ecx: (addr grapheme-stack) <- get self, left + 539 var result/eax: boolean <- grapheme-stack-is-decimal-integer? curr + 540 { + 541 compare result, 0/false + 542 break-if-= + 543 curr <- get self, right + 544 result <- grapheme-stack-is-decimal-integer? curr + 545 } + 546 return result + 547 } + 548 + 549 fn test-render-gap-buffer-without-cursor { + 550 # setup + 551 var gap-storage: gap-buffer + 552 var gap/esi: (addr gap-buffer) <- address gap-storage + 553 initialize-gap-buffer-with gap, "abc" + 554 # setup: screen + 555 var screen-on-stack: screen + 556 var screen/edi: (addr screen) <- address screen-on-stack + 557 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 558 # + 559 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 0/no-cursor, 3/fg, 0xc5/bg=blue-bg + 560 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-without-cursor" + 561 check-ints-equal x, 4, "F - test-render-gap-buffer-without-cursor: result" + 562 # abc + 563 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-render-gap-buffer-without-cursor: bg" + 564 } + 565 + 566 fn test-render-gap-buffer-with-cursor-at-end { + 567 # setup + 568 var gap-storage: gap-buffer + 569 var gap/esi: (addr gap-buffer) <- address gap-storage + 570 initialize-gap-buffer-with gap, "abc" + 571 gap-to-end gap + 572 # setup: screen + 573 var screen-on-stack: screen + 574 var screen/edi: (addr screen) <- address screen-on-stack + 575 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 576 # + 577 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg + 578 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-at-end" + 579 # we've drawn one extra grapheme for the cursor + 580 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-at-end: result" + 581 # abc + 582 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " |", "F - test-render-gap-buffer-with-cursor-at-end: bg" + 583 } + 584 + 585 fn test-render-gap-buffer-with-cursor-in-middle { + 586 # setup + 587 var gap-storage: gap-buffer + 588 var gap/esi: (addr gap-buffer) <- address gap-storage + 589 initialize-gap-buffer-with gap, "abc" + 590 gap-to-end gap + 591 var dummy/eax: grapheme <- gap-left gap + 592 # setup: screen + 593 var screen-on-stack: screen + 594 var screen/edi: (addr screen) <- address screen-on-stack + 595 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 596 # + 597 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg + 598 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-in-middle" + 599 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-in-middle: result" + 600 # abc + 601 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-render-gap-buffer-with-cursor-in-middle: bg" + 602 } + 603 + 604 fn test-render-gap-buffer-with-cursor-at-start { + 605 var gap-storage: gap-buffer + 606 var gap/esi: (addr gap-buffer) <- address gap-storage + 607 initialize-gap-buffer-with gap, "abc" + 608 gap-to-start gap + 609 # setup: screen + 610 var screen-on-stack: screen + 611 var screen/edi: (addr screen) <- address screen-on-stack + 612 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 613 # + 614 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg + 615 check-screen-row screen, 0/y, "abc ", "F - test-render-gap-buffer-with-cursor-at-start" + 616 check-ints-equal x, 4, "F - test-render-gap-buffer-with-cursor-at-start: result" + 617 # abc + 618 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "| ", "F - test-render-gap-buffer-with-cursor-at-start: bg" + 619 } + 620 + 621 fn test-render-gap-buffer-highlight-matching-close-paren { + 622 var gap-storage: gap-buffer + 623 var gap/esi: (addr gap-buffer) <- address gap-storage + 624 initialize-gap-buffer-with gap, "(a)" + 625 gap-to-start gap + 626 # setup: screen + 627 var screen-on-stack: screen + 628 var screen/edi: (addr screen) <- address screen-on-stack + 629 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 630 # + 631 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg + 632 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-close-paren" + 633 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-close-paren: result" + 634 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "| ", "F - test-render-gap-buffer-highlight-matching-close-paren: cursor" + 635 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, " ) ", "F - test-render-gap-buffer-highlight-matching-close-paren: matching paren" + 636 } + 637 + 638 fn test-render-gap-buffer-highlight-matching-open-paren { + 639 var gap-storage: gap-buffer + 640 var gap/esi: (addr gap-buffer) <- address gap-storage + 641 initialize-gap-buffer-with gap, "(a)" + 642 gap-to-end gap + 643 var dummy/eax: grapheme <- gap-left gap + 644 # setup: screen + 645 var screen-on-stack: screen + 646 var screen/edi: (addr screen) <- address screen-on-stack + 647 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 648 # + 649 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg + 650 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-open-paren" + 651 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-open-paren: result" + 652 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-render-gap-buffer-highlight-matching-open-paren: cursor" + 653 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, "( ", "F - test-render-gap-buffer-highlight-matching-open-paren: matching paren" + 654 } + 655 + 656 fn test-render-gap-buffer-highlight-matching-open-paren-of-end { + 657 var gap-storage: gap-buffer + 658 var gap/esi: (addr gap-buffer) <- address gap-storage + 659 initialize-gap-buffer-with gap, "(a)" + 660 gap-to-end gap + 661 # setup: screen + 662 var screen-on-stack: screen + 663 var screen/edi: (addr screen) <- address screen-on-stack + 664 initialize-screen screen, 5, 4, 0/no-pixel-graphics + 665 # + 666 var x/eax: int <- render-gap-buffer screen, gap, 0/x, 0/y, 1/show-cursor, 3/fg, 0xc5/bg=blue-bg + 667 check-screen-row screen, 0/y, "(a) ", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end" + 668 check-ints-equal x, 4, "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: result" + 669 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " |", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: cursor" + 670 check-screen-row-in-color screen, 0xf/fg=highlight, 0/y, "( ", "F - test-render-gap-buffer-highlight-matching-open-paren-of-end: matching paren" + 671 } + 672 + 673 # should I highlight a matching open paren? And if so, at what depth from top of left? + 674 # basically there are two cases to disambiguate here: + 675 # Usually the cursor is at top of right. Highlight first '(' at depth 0 from top of left. + 676 # If right is empty, match the ')' _before_ cursor. Highlight first '(' at depth _1_ from top of left. + 677 fn highlight-matching-open-paren? _gap: (addr gap-buffer), render-cursor?: boolean -> _/ebx: boolean, _/edi: int { + 678 # if not rendering cursor, return + 679 compare render-cursor?, 0/false 680 { - 681 break-if-> - 682 # if cursor at end, return (char before cursor == ')', 1) - 683 stack <- get gap, left - 684 top-addr <- get stack, top - 685 top-index <- copy *top-addr - 686 compare top-index, 0 - 687 { - 688 break-if-> - 689 return 0/false, 0 - 690 } - 691 top-index <- decrement - 692 var data-ah/eax: (addr handle array grapheme) <- get stack, data - 693 var data/eax: (addr array grapheme) <- lookup *data-ah - 694 var g/eax: (addr grapheme) <- index data, top-index - 695 compare *g, 0x29/close-paren + 681 break-if-!= + 682 return 0/false, 0 + 683 } + 684 var gap/esi: (addr gap-buffer) <- copy _gap + 685 var stack/edi: (addr grapheme-stack) <- get gap, right + 686 var top-addr/eax: (addr int) <- get stack, top + 687 var top-index/ecx: int <- copy *top-addr + 688 compare top-index, 0 + 689 { + 690 break-if-> + 691 # if cursor at end, return (char before cursor == ')', 1) + 692 stack <- get gap, left + 693 top-addr <- get stack, top + 694 top-index <- copy *top-addr + 695 compare top-index, 0 696 { - 697 break-if-= + 697 break-if-> 698 return 0/false, 0 699 } - 700 return 1/true, 1 - 701 } - 702 # cursor is not at end; return (char at cursor == ')') - 703 top-index <- decrement - 704 var data-ah/eax: (addr handle array grapheme) <- get stack, data - 705 var data/eax: (addr array grapheme) <- lookup *data-ah - 706 var g/eax: (addr grapheme) <- index data, top-index - 707 compare *g, 0x29/close-paren - 708 { - 709 break-if-= - 710 return 0/false, 0 - 711 } - 712 return 1/true, 0 - 713 } - 714 - 715 fn test-highlight-matching-open-paren { - 716 var gap-storage: gap-buffer - 717 var gap/esi: (addr gap-buffer) <- address gap-storage - 718 initialize-gap-buffer-with gap, "(a)" - 719 gap-to-end gap - 720 var highlight-matching-open-paren?/ebx: boolean <- copy 0/false - 721 var open-paren-depth/edi: int <- copy 0 - 722 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 0/no-cursor - 723 check-not highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: no cursor" - 724 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor - 725 check highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: at end immediately after ')'" - 726 check-ints-equal open-paren-depth, 1, "F - test-highlight-matching-open-paren: depth at end immediately after ')'" - 727 var dummy/eax: grapheme <- gap-left gap - 728 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor - 729 check highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: on ')'" - 730 dummy <- gap-left gap - 731 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor - 732 check-not highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: not on ')'" - 733 } - 734 - 735 ## some primitives for scanning through a gap buffer - 736 # don't modify the gap buffer while scanning - 737 # this includes moving the cursor around - 738 - 739 # restart scan without affecting gap-buffer contents - 740 fn rewind-gap-buffer _self: (addr gap-buffer) { - 741 var self/esi: (addr gap-buffer) <- copy _self - 742 var dest/eax: (addr int) <- get self, left-read-index - 743 copy-to *dest, 0 - 744 dest <- get self, right-read-index - 745 copy-to *dest, 0 - 746 } + 700 top-index <- decrement + 701 var data-ah/eax: (addr handle array grapheme) <- get stack, data + 702 var data/eax: (addr array grapheme) <- lookup *data-ah + 703 var g/eax: (addr grapheme) <- index data, top-index + 704 compare *g, 0x29/close-paren + 705 { + 706 break-if-= + 707 return 0/false, 0 + 708 } + 709 return 1/true, 1 + 710 } + 711 # cursor is not at end; return (char at cursor == ')') + 712 top-index <- decrement + 713 var data-ah/eax: (addr handle array grapheme) <- get stack, data + 714 var data/eax: (addr array grapheme) <- lookup *data-ah + 715 var g/eax: (addr grapheme) <- index data, top-index + 716 compare *g, 0x29/close-paren + 717 { + 718 break-if-= + 719 return 0/false, 0 + 720 } + 721 return 1/true, 0 + 722 } + 723 + 724 fn test-highlight-matching-open-paren { + 725 var gap-storage: gap-buffer + 726 var gap/esi: (addr gap-buffer) <- address gap-storage + 727 initialize-gap-buffer-with gap, "(a)" + 728 gap-to-end gap + 729 var highlight-matching-open-paren?/ebx: boolean <- copy 0/false + 730 var open-paren-depth/edi: int <- copy 0 + 731 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 0/no-cursor + 732 check-not highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: no cursor" + 733 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor + 734 check highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: at end immediately after ')'" + 735 check-ints-equal open-paren-depth, 1, "F - test-highlight-matching-open-paren: depth at end immediately after ')'" + 736 var dummy/eax: grapheme <- gap-left gap + 737 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor + 738 check highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: on ')'" + 739 dummy <- gap-left gap + 740 highlight-matching-open-paren?, open-paren-depth <- highlight-matching-open-paren? gap, 1/render-cursor + 741 check-not highlight-matching-open-paren?, "F - test-highlight-matching-open-paren: not on ')'" + 742 } + 743 + 744 ## some primitives for scanning through a gap buffer + 745 # don't modify the gap buffer while scanning + 746 # this includes moving the cursor around 747 - 748 fn gap-buffer-scan-done? _self: (addr gap-buffer) -> _/eax: boolean { - 749 var self/esi: (addr gap-buffer) <- copy _self - 750 # more in left? - 751 var left/eax: (addr grapheme-stack) <- get self, left - 752 var left-size/eax: int <- grapheme-stack-length left - 753 var left-read-index/ecx: (addr int) <- get self, left-read-index - 754 compare *left-read-index, left-size - 755 { - 756 break-if->= - 757 return 0/false - 758 } - 759 # more in right? - 760 var right/eax: (addr grapheme-stack) <- get self, right - 761 var right-size/eax: int <- grapheme-stack-length right - 762 var right-read-index/ecx: (addr int) <- get self, right-read-index - 763 compare *right-read-index, right-size + 748 # restart scan without affecting gap-buffer contents + 749 fn rewind-gap-buffer _self: (addr gap-buffer) { + 750 var self/esi: (addr gap-buffer) <- copy _self + 751 var dest/eax: (addr int) <- get self, left-read-index + 752 copy-to *dest, 0 + 753 dest <- get self, right-read-index + 754 copy-to *dest, 0 + 755 } + 756 + 757 fn gap-buffer-scan-done? _self: (addr gap-buffer) -> _/eax: boolean { + 758 var self/esi: (addr gap-buffer) <- copy _self + 759 # more in left? + 760 var left/eax: (addr grapheme-stack) <- get self, left + 761 var left-size/eax: int <- grapheme-stack-length left + 762 var left-read-index/ecx: (addr int) <- get self, left-read-index + 763 compare *left-read-index, left-size 764 { 765 break-if->= 766 return 0/false 767 } - 768 # - 769 return 1/true - 770 } - 771 - 772 fn peek-from-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { - 773 var self/esi: (addr gap-buffer) <- copy _self - 774 # more in left? - 775 var left/ecx: (addr grapheme-stack) <- get self, left - 776 var left-size/eax: int <- grapheme-stack-length left - 777 var left-read-index-a/edx: (addr int) <- get self, left-read-index - 778 compare *left-read-index-a, left-size - 779 { - 780 break-if->= - 781 var left-data-ah/eax: (addr handle array grapheme) <- get left, data - 782 var left-data/eax: (addr array grapheme) <- lookup *left-data-ah - 783 var left-read-index/ecx: int <- copy *left-read-index-a - 784 var result/eax: (addr grapheme) <- index left-data, left-read-index - 785 return *result - 786 } - 787 # more in right? - 788 var right/ecx: (addr grapheme-stack) <- get self, right - 789 var _right-size/eax: int <- grapheme-stack-length right - 790 var right-size/ebx: int <- copy _right-size - 791 var right-read-index-a/edx: (addr int) <- get self, right-read-index - 792 compare *right-read-index-a, right-size - 793 { - 794 break-if->= - 795 # read the right from reverse - 796 var right-data-ah/eax: (addr handle array grapheme) <- get right, data - 797 var right-data/eax: (addr array grapheme) <- lookup *right-data-ah - 798 var right-read-index/ebx: int <- copy right-size - 799 right-read-index <- subtract *right-read-index-a - 800 right-read-index <- subtract 1 - 801 var result/eax: (addr grapheme) <- index right-data, right-read-index - 802 return *result - 803 } - 804 # if we get here there's nothing left - 805 return 0/nul - 806 } - 807 - 808 fn read-from-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { - 809 var self/esi: (addr gap-buffer) <- copy _self - 810 # more in left? - 811 var left/ecx: (addr grapheme-stack) <- get self, left - 812 var left-size/eax: int <- grapheme-stack-length left - 813 var left-read-index-a/edx: (addr int) <- get self, left-read-index - 814 compare *left-read-index-a, left-size - 815 { - 816 break-if->= - 817 var left-data-ah/eax: (addr handle array grapheme) <- get left, data - 818 var left-data/eax: (addr array grapheme) <- lookup *left-data-ah - 819 var left-read-index/ecx: int <- copy *left-read-index-a - 820 var result/eax: (addr grapheme) <- index left-data, left-read-index - 821 increment *left-read-index-a - 822 return *result - 823 } - 824 # more in right? - 825 var right/ecx: (addr grapheme-stack) <- get self, right - 826 var _right-size/eax: int <- grapheme-stack-length right - 827 var right-size/ebx: int <- copy _right-size - 828 var right-read-index-a/edx: (addr int) <- get self, right-read-index - 829 compare *right-read-index-a, right-size - 830 { - 831 break-if->= - 832 # read the right from reverse - 833 var right-data-ah/eax: (addr handle array grapheme) <- get right, data - 834 var right-data/eax: (addr array grapheme) <- lookup *right-data-ah - 835 var right-read-index/ebx: int <- copy right-size - 836 right-read-index <- subtract *right-read-index-a - 837 right-read-index <- subtract 1 - 838 var result/eax: (addr grapheme) <- index right-data, right-read-index - 839 increment *right-read-index-a - 840 return *result - 841 } - 842 # if we get here there's nothing left - 843 return 0/nul - 844 } - 845 - 846 fn test-read-from-gap-buffer { - 847 var gap-storage: gap-buffer - 848 var gap/esi: (addr gap-buffer) <- address gap-storage - 849 initialize-gap-buffer-with gap, "abc" - 850 # gap is at end, all contents are in left - 851 var done?/eax: boolean <- gap-buffer-scan-done? gap - 852 check-not done?, "F - test-read-from-gap-buffer/left-1/done" - 853 var g/eax: grapheme <- read-from-gap-buffer gap - 854 var x/ecx: int <- copy g - 855 check-ints-equal x, 0x61/a, "F - test-read-from-gap-buffer/left-1" - 856 var done?/eax: boolean <- gap-buffer-scan-done? gap - 857 check-not done?, "F - test-read-from-gap-buffer/left-2/done" - 858 var g/eax: grapheme <- read-from-gap-buffer gap - 859 var x/ecx: int <- copy g - 860 check-ints-equal x, 0x62/b, "F - test-read-from-gap-buffer/left-2" - 861 var done?/eax: boolean <- gap-buffer-scan-done? gap - 862 check-not done?, "F - test-read-from-gap-buffer/left-3/done" - 863 var g/eax: grapheme <- read-from-gap-buffer gap - 864 var x/ecx: int <- copy g - 865 check-ints-equal x, 0x63/c, "F - test-read-from-gap-buffer/left-3" - 866 var done?/eax: boolean <- gap-buffer-scan-done? gap - 867 check done?, "F - test-read-from-gap-buffer/left-4/done" - 868 var g/eax: grapheme <- read-from-gap-buffer gap - 869 var x/ecx: int <- copy g - 870 check-ints-equal x, 0/nul, "F - test-read-from-gap-buffer/left-4" - 871 # now check when everything is to the right - 872 gap-to-start gap - 873 rewind-gap-buffer gap - 874 var done?/eax: boolean <- gap-buffer-scan-done? gap - 875 check-not done?, "F - test-read-from-gap-buffer/right-1/done" - 876 var g/eax: grapheme <- read-from-gap-buffer gap - 877 var x/ecx: int <- copy g - 878 check-ints-equal x, 0x61/a, "F - test-read-from-gap-buffer/right-1" - 879 var done?/eax: boolean <- gap-buffer-scan-done? gap - 880 check-not done?, "F - test-read-from-gap-buffer/right-2/done" - 881 var g/eax: grapheme <- read-from-gap-buffer gap - 882 var x/ecx: int <- copy g - 883 check-ints-equal x, 0x62/b, "F - test-read-from-gap-buffer/right-2" - 884 var done?/eax: boolean <- gap-buffer-scan-done? gap - 885 check-not done?, "F - test-read-from-gap-buffer/right-3/done" - 886 var g/eax: grapheme <- read-from-gap-buffer gap - 887 var x/ecx: int <- copy g - 888 check-ints-equal x, 0x63/c, "F - test-read-from-gap-buffer/right-3" - 889 var done?/eax: boolean <- gap-buffer-scan-done? gap - 890 check done?, "F - test-read-from-gap-buffer/right-4/done" - 891 var g/eax: grapheme <- read-from-gap-buffer gap - 892 var x/ecx: int <- copy g - 893 check-ints-equal x, 0/nul, "F - test-read-from-gap-buffer/right-4" - 894 } - 895 - 896 fn skip-whitespace-from-gap-buffer self: (addr gap-buffer) { - 897 var done?/eax: boolean <- gap-buffer-scan-done? self - 898 compare done?, 0/false - 899 break-if-!= - 900 var g/eax: grapheme <- peek-from-gap-buffer self - 901 { - 902 compare g, 0x20/space - 903 break-if-= - 904 compare g, 0xa/newline - 905 break-if-= - 906 return - 907 } - 908 g <- read-from-gap-buffer self - 909 loop - 910 } - 911 - 912 fn edit-gap-buffer self: (addr gap-buffer), key: grapheme { - 913 var g/edx: grapheme <- copy key - 914 { - 915 compare g, 8/backspace - 916 break-if-!= - 917 delete-before-gap self - 918 return - 919 } - 920 { - 921 compare g, 0x80/left-arrow - 922 break-if-!= - 923 var dummy/eax: grapheme <- gap-left self - 924 return - 925 } - 926 { - 927 compare g, 0x83/right-arrow - 928 break-if-!= - 929 var dummy/eax: grapheme <- gap-right self - 930 return - 931 } - 932 { - 933 compare g, 6/ctrl-f - 934 break-if-!= - 935 gap-to-start-of-next-word self - 936 return - 937 } - 938 { - 939 compare g, 2/ctrl-b - 940 break-if-!= - 941 gap-to-end-of-previous-word self - 942 return - 943 } - 944 { - 945 compare g, 1/ctrl-a - 946 break-if-!= - 947 gap-to-previous-start-of-line self - 948 return - 949 } - 950 { - 951 compare g, 5/ctrl-e - 952 break-if-!= - 953 gap-to-next-end-of-line self - 954 return - 955 } - 956 { - 957 compare g, 0x81/down-arrow - 958 break-if-!= - 959 gap-down self - 960 return - 961 } - 962 { - 963 compare g, 0x82/up-arrow - 964 break-if-!= - 965 gap-up self - 966 return - 967 } - 968 { - 969 compare g, 0x15/ctrl-u - 970 break-if-!= - 971 clear-gap-buffer self - 972 return - 973 } - 974 # default: insert character - 975 add-grapheme-at-gap self, g - 976 } - 977 - 978 fn gap-to-start-of-next-word self: (addr gap-buffer) { - 979 var curr/eax: grapheme <- copy 0 - 980 # skip to next space - 981 { - 982 curr <- gap-right self - 983 compare curr, -1 - 984 break-if-= - 985 compare curr, 0x20/space - 986 break-if-= - 987 compare curr, 0xa/newline - 988 break-if-= - 989 loop + 768 # more in right? + 769 var right/eax: (addr grapheme-stack) <- get self, right + 770 var right-size/eax: int <- grapheme-stack-length right + 771 var right-read-index/ecx: (addr int) <- get self, right-read-index + 772 compare *right-read-index, right-size + 773 { + 774 break-if->= + 775 return 0/false + 776 } + 777 # + 778 return 1/true + 779 } + 780 + 781 fn peek-from-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { + 782 var self/esi: (addr gap-buffer) <- copy _self + 783 # more in left? + 784 var left/ecx: (addr grapheme-stack) <- get self, left + 785 var left-size/eax: int <- grapheme-stack-length left + 786 var left-read-index-a/edx: (addr int) <- get self, left-read-index + 787 compare *left-read-index-a, left-size + 788 { + 789 break-if->= + 790 var left-data-ah/eax: (addr handle array grapheme) <- get left, data + 791 var left-data/eax: (addr array grapheme) <- lookup *left-data-ah + 792 var left-read-index/ecx: int <- copy *left-read-index-a + 793 var result/eax: (addr grapheme) <- index left-data, left-read-index + 794 return *result + 795 } + 796 # more in right? + 797 var right/ecx: (addr grapheme-stack) <- get self, right + 798 var _right-size/eax: int <- grapheme-stack-length right + 799 var right-size/ebx: int <- copy _right-size + 800 var right-read-index-a/edx: (addr int) <- get self, right-read-index + 801 compare *right-read-index-a, right-size + 802 { + 803 break-if->= + 804 # read the right from reverse + 805 var right-data-ah/eax: (addr handle array grapheme) <- get right, data + 806 var right-data/eax: (addr array grapheme) <- lookup *right-data-ah + 807 var right-read-index/ebx: int <- copy right-size + 808 right-read-index <- subtract *right-read-index-a + 809 right-read-index <- subtract 1 + 810 var result/eax: (addr grapheme) <- index right-data, right-read-index + 811 return *result + 812 } + 813 # if we get here there's nothing left + 814 return 0/nul + 815 } + 816 + 817 fn read-from-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { + 818 var self/esi: (addr gap-buffer) <- copy _self + 819 # more in left? + 820 var left/ecx: (addr grapheme-stack) <- get self, left + 821 var left-size/eax: int <- grapheme-stack-length left + 822 var left-read-index-a/edx: (addr int) <- get self, left-read-index + 823 compare *left-read-index-a, left-size + 824 { + 825 break-if->= + 826 var left-data-ah/eax: (addr handle array grapheme) <- get left, data + 827 var left-data/eax: (addr array grapheme) <- lookup *left-data-ah + 828 var left-read-index/ecx: int <- copy *left-read-index-a + 829 var result/eax: (addr grapheme) <- index left-data, left-read-index + 830 increment *left-read-index-a + 831 return *result + 832 } + 833 # more in right? + 834 var right/ecx: (addr grapheme-stack) <- get self, right + 835 var _right-size/eax: int <- grapheme-stack-length right + 836 var right-size/ebx: int <- copy _right-size + 837 var right-read-index-a/edx: (addr int) <- get self, right-read-index + 838 compare *right-read-index-a, right-size + 839 { + 840 break-if->= + 841 # read the right from reverse + 842 var right-data-ah/eax: (addr handle array grapheme) <- get right, data + 843 var right-data/eax: (addr array grapheme) <- lookup *right-data-ah + 844 var right-read-index/ebx: int <- copy right-size + 845 right-read-index <- subtract *right-read-index-a + 846 right-read-index <- subtract 1 + 847 var result/eax: (addr grapheme) <- index right-data, right-read-index + 848 increment *right-read-index-a + 849 return *result + 850 } + 851 # if we get here there's nothing left + 852 return 0/nul + 853 } + 854 + 855 fn test-read-from-gap-buffer { + 856 var gap-storage: gap-buffer + 857 var gap/esi: (addr gap-buffer) <- address gap-storage + 858 initialize-gap-buffer-with gap, "abc" + 859 # gap is at end, all contents are in left + 860 var done?/eax: boolean <- gap-buffer-scan-done? gap + 861 check-not done?, "F - test-read-from-gap-buffer/left-1/done" + 862 var g/eax: grapheme <- read-from-gap-buffer gap + 863 var x/ecx: int <- copy g + 864 check-ints-equal x, 0x61/a, "F - test-read-from-gap-buffer/left-1" + 865 var done?/eax: boolean <- gap-buffer-scan-done? gap + 866 check-not done?, "F - test-read-from-gap-buffer/left-2/done" + 867 var g/eax: grapheme <- read-from-gap-buffer gap + 868 var x/ecx: int <- copy g + 869 check-ints-equal x, 0x62/b, "F - test-read-from-gap-buffer/left-2" + 870 var done?/eax: boolean <- gap-buffer-scan-done? gap + 871 check-not done?, "F - test-read-from-gap-buffer/left-3/done" + 872 var g/eax: grapheme <- read-from-gap-buffer gap + 873 var x/ecx: int <- copy g + 874 check-ints-equal x, 0x63/c, "F - test-read-from-gap-buffer/left-3" + 875 var done?/eax: boolean <- gap-buffer-scan-done? gap + 876 check done?, "F - test-read-from-gap-buffer/left-4/done" + 877 var g/eax: grapheme <- read-from-gap-buffer gap + 878 var x/ecx: int <- copy g + 879 check-ints-equal x, 0/nul, "F - test-read-from-gap-buffer/left-4" + 880 # now check when everything is to the right + 881 gap-to-start gap + 882 rewind-gap-buffer gap + 883 var done?/eax: boolean <- gap-buffer-scan-done? gap + 884 check-not done?, "F - test-read-from-gap-buffer/right-1/done" + 885 var g/eax: grapheme <- read-from-gap-buffer gap + 886 var x/ecx: int <- copy g + 887 check-ints-equal x, 0x61/a, "F - test-read-from-gap-buffer/right-1" + 888 var done?/eax: boolean <- gap-buffer-scan-done? gap + 889 check-not done?, "F - test-read-from-gap-buffer/right-2/done" + 890 var g/eax: grapheme <- read-from-gap-buffer gap + 891 var x/ecx: int <- copy g + 892 check-ints-equal x, 0x62/b, "F - test-read-from-gap-buffer/right-2" + 893 var done?/eax: boolean <- gap-buffer-scan-done? gap + 894 check-not done?, "F - test-read-from-gap-buffer/right-3/done" + 895 var g/eax: grapheme <- read-from-gap-buffer gap + 896 var x/ecx: int <- copy g + 897 check-ints-equal x, 0x63/c, "F - test-read-from-gap-buffer/right-3" + 898 var done?/eax: boolean <- gap-buffer-scan-done? gap + 899 check done?, "F - test-read-from-gap-buffer/right-4/done" + 900 var g/eax: grapheme <- read-from-gap-buffer gap + 901 var x/ecx: int <- copy g + 902 check-ints-equal x, 0/nul, "F - test-read-from-gap-buffer/right-4" + 903 } + 904 + 905 fn skip-whitespace-from-gap-buffer self: (addr gap-buffer) { + 906 var done?/eax: boolean <- gap-buffer-scan-done? self + 907 compare done?, 0/false + 908 break-if-!= + 909 var g/eax: grapheme <- peek-from-gap-buffer self + 910 { + 911 compare g, 0x20/space + 912 break-if-= + 913 compare g, 0xa/newline + 914 break-if-= + 915 return + 916 } + 917 g <- read-from-gap-buffer self + 918 loop + 919 } + 920 + 921 fn edit-gap-buffer self: (addr gap-buffer), key: grapheme { + 922 var g/edx: grapheme <- copy key + 923 { + 924 compare g, 8/backspace + 925 break-if-!= + 926 delete-before-gap self + 927 return + 928 } + 929 { + 930 compare g, 0x80/left-arrow + 931 break-if-!= + 932 var dummy/eax: grapheme <- gap-left self + 933 return + 934 } + 935 { + 936 compare g, 0x83/right-arrow + 937 break-if-!= + 938 var dummy/eax: grapheme <- gap-right self + 939 return + 940 } + 941 { + 942 compare g, 6/ctrl-f + 943 break-if-!= + 944 gap-to-start-of-next-word self + 945 return + 946 } + 947 { + 948 compare g, 2/ctrl-b + 949 break-if-!= + 950 gap-to-end-of-previous-word self + 951 return + 952 } + 953 { + 954 compare g, 1/ctrl-a + 955 break-if-!= + 956 gap-to-previous-start-of-line self + 957 return + 958 } + 959 { + 960 compare g, 5/ctrl-e + 961 break-if-!= + 962 gap-to-next-end-of-line self + 963 return + 964 } + 965 { + 966 compare g, 0x81/down-arrow + 967 break-if-!= + 968 gap-down self + 969 return + 970 } + 971 { + 972 compare g, 0x82/up-arrow + 973 break-if-!= + 974 gap-up self + 975 return + 976 } + 977 { + 978 compare g, 0x15/ctrl-u + 979 break-if-!= + 980 clear-gap-buffer self + 981 return + 982 } + 983 { + 984 compare g, 9/tab + 985 break-if-!= + 986 # tab = 2 spaces + 987 add-code-point-at-gap self, 0x20/space + 988 add-code-point-at-gap self, 0x20/space + 989 return 990 } - 991 # skip past spaces - 992 { - 993 curr <- gap-right self - 994 compare curr, -1 - 995 break-if-= - 996 compare curr, 0x20/space - 997 loop-if-= - 998 compare curr, 0xa/space - 999 loop-if-= -1000 curr <- gap-left self -1001 break -1002 } -1003 } -1004 -1005 fn gap-to-end-of-previous-word self: (addr gap-buffer) { -1006 var curr/eax: grapheme <- copy 0 -1007 # skip to previous space -1008 { -1009 curr <- gap-left self -1010 compare curr, -1 -1011 break-if-= -1012 compare curr, 0x20/space -1013 break-if-= -1014 compare curr, 0xa/newline -1015 break-if-= -1016 loop -1017 } -1018 # skip past all spaces but one -1019 { -1020 curr <- gap-left self -1021 compare curr, -1 -1022 break-if-= -1023 compare curr, 0x20/space -1024 loop-if-= -1025 compare curr, 0xa/space -1026 loop-if-= -1027 curr <- gap-right self -1028 break -1029 } -1030 } -1031 -1032 fn gap-to-previous-start-of-line self: (addr gap-buffer) { -1033 # skip past immediate newline -1034 var dummy/eax: grapheme <- gap-left self -1035 # skip to previous newline + 991 # default: insert character + 992 add-grapheme-at-gap self, g + 993 } + 994 + 995 fn gap-to-start-of-next-word self: (addr gap-buffer) { + 996 var curr/eax: grapheme <- copy 0 + 997 # skip to next space + 998 { + 999 curr <- gap-right self +1000 compare curr, -1 +1001 break-if-= +1002 compare curr, 0x20/space +1003 break-if-= +1004 compare curr, 0xa/newline +1005 break-if-= +1006 loop +1007 } +1008 # skip past spaces +1009 { +1010 curr <- gap-right self +1011 compare curr, -1 +1012 break-if-= +1013 compare curr, 0x20/space +1014 loop-if-= +1015 compare curr, 0xa/space +1016 loop-if-= +1017 curr <- gap-left self +1018 break +1019 } +1020 } +1021 +1022 fn gap-to-end-of-previous-word self: (addr gap-buffer) { +1023 var curr/eax: grapheme <- copy 0 +1024 # skip to previous space +1025 { +1026 curr <- gap-left self +1027 compare curr, -1 +1028 break-if-= +1029 compare curr, 0x20/space +1030 break-if-= +1031 compare curr, 0xa/newline +1032 break-if-= +1033 loop +1034 } +1035 # skip past all spaces but one 1036 { -1037 dummy <- gap-left self -1038 { -1039 compare dummy, -1 -1040 break-if-!= -1041 return -1042 } -1043 { -1044 compare dummy, 0xa/newline -1045 break-if-!= -1046 dummy <- gap-right self -1047 return -1048 } -1049 loop -1050 } -1051 } -1052 -1053 fn gap-to-next-end-of-line self: (addr gap-buffer) { -1054 # skip past immediate newline -1055 var dummy/eax: grapheme <- gap-right self -1056 # skip to next newline -1057 { -1058 dummy <- gap-right self -1059 { -1060 compare dummy, -1 -1061 break-if-!= -1062 return -1063 } -1064 { -1065 compare dummy, 0xa/newline -1066 break-if-!= -1067 dummy <- gap-left self -1068 return -1069 } -1070 loop -1071 } -1072 } -1073 -1074 fn gap-up self: (addr gap-buffer) { -1075 # compute column -1076 var col/edx: int <- count-columns-to-start-of-line self -1077 # -1078 gap-to-previous-start-of-line self -1079 # skip ahead by up to col on previous line -1080 var i/ecx: int <- copy 0 -1081 { -1082 compare i, col -1083 break-if->= -1084 var curr/eax: grapheme <- gap-right self -1085 { -1086 compare curr, -1 -1087 break-if-!= -1088 return -1089 } -1090 compare curr, 0xa/newline -1091 { -1092 break-if-!= -1093 curr <- gap-left self -1094 return -1095 } -1096 i <- increment -1097 loop -1098 } -1099 } -1100 -1101 fn gap-down self: (addr gap-buffer) { -1102 # compute column -1103 var col/edx: int <- count-columns-to-start-of-line self -1104 # skip to start of next line -1105 gap-to-end-of-line self -1106 var dummy/eax: grapheme <- gap-right self -1107 # skip ahead by up to col on previous line -1108 var i/ecx: int <- copy 0 -1109 { -1110 compare i, col -1111 break-if->= -1112 var curr/eax: grapheme <- gap-right self -1113 { -1114 compare curr, -1 -1115 break-if-!= -1116 return -1117 } -1118 compare curr, 0xa/newline -1119 { -1120 break-if-!= -1121 curr <- gap-left self -1122 return -1123 } -1124 i <- increment -1125 loop -1126 } -1127 } -1128 -1129 fn count-columns-to-start-of-line self: (addr gap-buffer) -> _/edx: int { -1130 var count/edx: int <- copy 0 -1131 var dummy/eax: grapheme <- copy 0 -1132 # skip to previous newline -1133 { -1134 dummy <- gap-left self -1135 { -1136 compare dummy, -1 +1037 curr <- gap-left self +1038 compare curr, -1 +1039 break-if-= +1040 compare curr, 0x20/space +1041 loop-if-= +1042 compare curr, 0xa/space +1043 loop-if-= +1044 curr <- gap-right self +1045 break +1046 } +1047 } +1048 +1049 fn gap-to-previous-start-of-line self: (addr gap-buffer) { +1050 # skip past immediate newline +1051 var dummy/eax: grapheme <- gap-left self +1052 # skip to previous newline +1053 { +1054 dummy <- gap-left self +1055 { +1056 compare dummy, -1 +1057 break-if-!= +1058 return +1059 } +1060 { +1061 compare dummy, 0xa/newline +1062 break-if-!= +1063 dummy <- gap-right self +1064 return +1065 } +1066 loop +1067 } +1068 } +1069 +1070 fn gap-to-next-end-of-line self: (addr gap-buffer) { +1071 # skip past immediate newline +1072 var dummy/eax: grapheme <- gap-right self +1073 # skip to next newline +1074 { +1075 dummy <- gap-right self +1076 { +1077 compare dummy, -1 +1078 break-if-!= +1079 return +1080 } +1081 { +1082 compare dummy, 0xa/newline +1083 break-if-!= +1084 dummy <- gap-left self +1085 return +1086 } +1087 loop +1088 } +1089 } +1090 +1091 fn gap-up self: (addr gap-buffer) { +1092 # compute column +1093 var col/edx: int <- count-columns-to-start-of-line self +1094 # +1095 gap-to-previous-start-of-line self +1096 # skip ahead by up to col on previous line +1097 var i/ecx: int <- copy 0 +1098 { +1099 compare i, col +1100 break-if->= +1101 var curr/eax: grapheme <- gap-right self +1102 { +1103 compare curr, -1 +1104 break-if-!= +1105 return +1106 } +1107 compare curr, 0xa/newline +1108 { +1109 break-if-!= +1110 curr <- gap-left self +1111 return +1112 } +1113 i <- increment +1114 loop +1115 } +1116 } +1117 +1118 fn gap-down self: (addr gap-buffer) { +1119 # compute column +1120 var col/edx: int <- count-columns-to-start-of-line self +1121 # skip to start of next line +1122 gap-to-end-of-line self +1123 var dummy/eax: grapheme <- gap-right self +1124 # skip ahead by up to col on previous line +1125 var i/ecx: int <- copy 0 +1126 { +1127 compare i, col +1128 break-if->= +1129 var curr/eax: grapheme <- gap-right self +1130 { +1131 compare curr, -1 +1132 break-if-!= +1133 return +1134 } +1135 compare curr, 0xa/newline +1136 { 1137 break-if-!= -1138 return count -1139 } -1140 { -1141 compare dummy, 0xa/newline -1142 break-if-!= -1143 dummy <- gap-right self -1144 return count -1145 } -1146 count <- increment -1147 loop -1148 } -1149 return count -1150 } -1151 -1152 fn gap-to-end-of-line self: (addr gap-buffer) { -1153 var dummy/eax: grapheme <- copy 0 -1154 # skip to next newline -1155 { -1156 dummy <- gap-right self +1138 curr <- gap-left self +1139 return +1140 } +1141 i <- increment +1142 loop +1143 } +1144 } +1145 +1146 fn count-columns-to-start-of-line self: (addr gap-buffer) -> _/edx: int { +1147 var count/edx: int <- copy 0 +1148 var dummy/eax: grapheme <- copy 0 +1149 # skip to previous newline +1150 { +1151 dummy <- gap-left self +1152 { +1153 compare dummy, -1 +1154 break-if-!= +1155 return count +1156 } 1157 { -1158 compare dummy, -1 +1158 compare dummy, 0xa/newline 1159 break-if-!= -1160 return -1161 } -1162 { -1163 compare dummy, 0xa/newline -1164 break-if-!= -1165 dummy <- gap-left self -1166 return -1167 } -1168 loop -1169 } -1170 } +1160 dummy <- gap-right self +1161 return count +1162 } +1163 count <- increment +1164 loop +1165 } +1166 return count +1167 } +1168 +1169 fn gap-to-end-of-line self: (addr gap-buffer) { +1170 var dummy/eax: grapheme <- copy 0 +1171 # skip to next newline +1172 { +1173 dummy <- gap-right self +1174 { +1175 compare dummy, -1 +1176 break-if-!= +1177 return +1178 } +1179 { +1180 compare dummy, 0xa/newline +1181 break-if-!= +1182 dummy <- gap-left self +1183 return +1184 } +1185 loop +1186 } +1187 } diff --git a/html/shell/global.mu.html b/html/shell/global.mu.html index e8c2e533..6ddc349d 100644 --- a/html/shell/global.mu.html +++ b/html/shell/global.mu.html @@ -59,1827 +59,1966 @@ if ('onhashchange' in window) { 
    1 type global {
    2   name: (handle array byte)
-   3   value: (handle cell)
-   4 }
-   5 
-   6 type global-table {
-   7   data: (handle array global)
-   8   final-index: int
-   9 }
-  10 
-  11 fn initialize-globals _self: (addr global-table) {
-  12   var self/esi: (addr global-table) <- copy _self
-  13   var data-ah/eax: (addr handle array global) <- get self, data
-  14   populate data-ah, 0x40
-  15   # generic
-  16   append-primitive self, "="
-  17   # for numbers
-  18   append-primitive self, "+"
-  19   append-primitive self, "-"
-  20   append-primitive self, "*"
-  21   append-primitive self, "/"
-  22   append-primitive self, "sqrt"
-  23   append-primitive self, "abs"
-  24   append-primitive self, "sgn"
-  25   append-primitive self, "<"
-  26   append-primitive self, ">"
-  27   append-primitive self, "<="
-  28   append-primitive self, ">="
-  29   # for pairs
-  30   append-primitive self, "car"
-  31   append-primitive self, "cdr"
-  32   append-primitive self, "cons"
-  33   # for screens
-  34   append-primitive self, "print"
-  35   append-primitive self, "clear"
-  36   append-primitive self, "lines"
-  37   append-primitive self, "columns"
-  38   append-primitive self, "up"
-  39   append-primitive self, "down"
-  40   append-primitive self, "left"
-  41   append-primitive self, "right"
-  42   append-primitive self, "cr"
-  43   append-primitive self, "pixel"
-  44   append-primitive self, "width"
-  45   append-primitive self, "height"
-  46   # for keyboards
-  47   append-primitive self, "key"
-  48   # for streams
-  49   append-primitive self, "stream"
-  50   append-primitive self, "write"
-  51   # misc
-  52   append-primitive self, "abort"
-  53   append-primitive self, "life"
-  54   # keep sync'd with render-primitives
-  55 }
-  56 
-  57 fn load-globals in: (addr handle cell), self: (addr global-table) {
-  58   var remaining-ah/esi: (addr handle cell) <- copy in
-  59   {
-  60     var _remaining/eax: (addr cell) <- lookup *remaining-ah
-  61     var remaining/ecx: (addr cell) <- copy _remaining
-  62     var done?/eax: boolean <- nil? remaining
-  63     compare done?, 0/false
-  64     break-if-!=
-  65     var curr-ah/eax: (addr handle cell) <- get remaining, left
-  66     var curr/eax: (addr cell) <- lookup *curr-ah
-  67     remaining-ah <- get remaining, right
-  68     var name-ah/ecx: (addr handle cell) <- get curr, left
-  69     var value-ah/ebx: (addr handle cell) <- get curr, right
-  70     var name/eax: (addr cell) <- lookup *name-ah
-  71     var name-data-ah/eax: (addr handle stream byte) <- get name, text-data
-  72     var name-data/eax: (addr stream byte) <- lookup *name-data-ah
-  73     append-global-binding-of-stream self, name-data, *value-ah
-  74     loop
-  75   }
-  76 }
-  77 
-  78 fn write-globals out: (addr stream byte), _self: (addr global-table) {
-  79   var self/esi: (addr global-table) <- copy _self
-  80   write out, "  (globals . (\n"
-  81   var data-ah/eax: (addr handle array global) <- get self, data
-  82   var data/eax: (addr array global) <- lookup *data-ah
-  83   var final-index/edx: (addr int) <- get self, final-index
-  84   var curr-index/ecx: int <- copy 1/skip-0
-  85   {
-  86     compare curr-index, *final-index
-  87     break-if->
-  88     var curr-offset/ebx: (offset global) <- compute-offset data, curr-index
-  89     var curr/ebx: (addr global) <- index data, curr-offset
-  90     var curr-value-ah/edx: (addr handle cell) <- get curr, value
-  91     var curr-value/eax: (addr cell) <- lookup *curr-value-ah
-  92     var curr-type/eax: (addr int) <- get curr-value, type
-  93     {
-  94       compare *curr-type, 4/primitive-function
-  95       break-if-=
-  96       compare *curr-type, 5/screen
-  97       break-if-=
-  98       compare *curr-type, 6/keyboard
-  99       break-if-=
- 100       compare *curr-type, 3/stream  # not implemented yet
- 101       break-if-=
- 102       write out, "    ("
- 103       var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 104       var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
- 105       write out, curr-name
- 106       write out, " . "
- 107       print-cell curr-value-ah, out, 0/no-trace
- 108       write out, ")\n"
- 109     }
- 110     curr-index <- increment
- 111     loop
- 112   }
- 113   write out, "  ))\n"
- 114 }
- 115 
- 116 fn render-globals screen: (addr screen), _self: (addr global-table), xmin: int, ymin: int, xmax: int, ymax: int {
- 117   clear-rect screen, xmin, ymin, xmax, ymax, 0x12/bg=almost-black
- 118   var self/esi: (addr global-table) <- copy _self
- 119   # render primitives
- 120   render-primitives screen, xmin, ymin, xmax, ymax
- 121   var data-ah/eax: (addr handle array global) <- get self, data
- 122   var data/eax: (addr array global) <- lookup *data-ah
- 123   var curr-index/edx: int <- copy 1
- 124   {
- 125     var curr-offset/ebx: (offset global) <- compute-offset data, curr-index
- 126     var curr/ebx: (addr global) <- index data, curr-offset
- 127     var continue?/eax: boolean <- primitive-global? curr
- 128     compare continue?, 0/false
- 129     break-if-=
- 130     curr-index <- increment
- 131     loop
- 132   }
- 133   var lowest-index/edi: int <- copy curr-index
- 134   var y/ecx: int <- copy ymin
- 135   var final-index/edx: (addr int) <- get self, final-index
- 136   var curr-index/edx: int <- copy *final-index
- 137   {
- 138     compare curr-index, lowest-index
- 139     break-if-<
- 140     compare y, ymax
- 141     break-if->=
- 142     {
- 143       var curr-offset/ebx: (offset global) <- compute-offset data, curr-index
- 144       var curr/ebx: (addr global) <- index data, curr-offset
- 145       var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 146       var _curr-name/eax: (addr array byte) <- lookup *curr-name-ah
- 147       var curr-name/edx: (addr array byte) <- copy _curr-name
- 148       var x/eax: int <- copy xmin
- 149       x, y <- draw-text-wrapping-right-then-down screen, curr-name, xmin, ymin, xmax, ymax, x, y, 0x2a/fg=orange, 0x12/bg=almost-black
- 150       x, y <- draw-text-wrapping-right-then-down screen, " <- ", xmin, ymin, xmax, ymax, x, y, 7/fg=grey, 0x12/bg=almost-black
- 151       var curr-value/edx: (addr handle cell) <- get curr, value
- 152       var s-storage: (stream byte 0x400)
- 153       var s/ebx: (addr stream byte) <- address s-storage
- 154       print-cell curr-value, s, 0/no-trace
- 155       x, y <- draw-stream-wrapping-right-then-down screen, s, xmin, ymin, xmax, ymax, x, y, 3/fg=cyan, 0x12/bg=almost-black
- 156     }
- 157     curr-index <- decrement
- 158     y <- increment
- 159     loop
- 160   }
- 161 }
- 162 
- 163 fn render-primitives screen: (addr screen), xmin: int, ymin: int, xmax: int, ymax: int {
- 164   var y/ecx: int <- copy ymax
- 165   y <- subtract 0xf
- 166   var tmpx/eax: int <- copy xmin
- 167   tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
- 168   y <- increment
- 169   var tmpx/eax: int <- copy xmin
- 170   tmpx <- draw-text-rightward screen, "  print", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
- 171   tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
- 172   y <- increment
- 173   var tmpx/eax: int <- copy xmin
- 174   tmpx <- draw-text-rightward screen, "  lines columns", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
- 175   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
- 176   y <- increment
- 177   var tmpx/eax: int <- copy xmin
- 178   tmpx <- draw-text-rightward screen, "  up down left right", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
- 179   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
- 180   y <- increment
- 181   var tmpx/eax: int <- copy xmin
- 182   tmpx <- draw-text-rightward screen, "  cr", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
- 183   tmpx <- draw-text-rightward screen, ": screen   ", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
- 184   tmpx <- draw-text-rightward screen, "# move cursor down and to left margin", tmpx, xmax, y, 9/fg=blue, 0x12/bg=almost-black
- 185   y <- increment
- 186   var tmpx/eax: int <- copy xmin
- 187   tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
- 188   y <- increment
- 189   var tmpx/eax: int <- copy xmin
- 190   tmpx <- draw-text-rightward screen, "  width height", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
- 191   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
- 192   y <- increment
+   3   input: (handle gap-buffer)
+   4   value: (handle cell)
+   5 }
+   6 
+   7 type global-table {
+   8   data: (handle array global)
+   9   final-index: int
+  10 }
+  11 
+  12 fn initialize-globals _self: (addr global-table) {
+  13   var self/esi: (addr global-table) <- copy _self
+  14   var data-ah/eax: (addr handle array global) <- get self, data
+  15   populate data-ah, 0x40
+  16   # for numbers
+  17   append-primitive self, "+"
+  18   append-primitive self, "-"
+  19   append-primitive self, "*"
+  20   append-primitive self, "/"
+  21   append-primitive self, "sqrt"
+  22   append-primitive self, "abs"
+  23   append-primitive self, "sgn"
+  24   append-primitive self, "<"
+  25   append-primitive self, ">"
+  26   append-primitive self, "<="
+  27   append-primitive self, ">="
+  28   # generic
+  29   append-primitive self, "="
+  30   append-primitive self, "no"
+  31   append-primitive self, "not"
+  32   # for pairs
+  33   append-primitive self, "car"
+  34   append-primitive self, "cdr"
+  35   append-primitive self, "cons"
+  36   # for screens
+  37   append-primitive self, "print"
+  38   append-primitive self, "clear"
+  39   append-primitive self, "lines"
+  40   append-primitive self, "columns"
+  41   append-primitive self, "up"
+  42   append-primitive self, "down"
+  43   append-primitive self, "left"
+  44   append-primitive self, "right"
+  45   append-primitive self, "cr"
+  46   append-primitive self, "pixel"
+  47   append-primitive self, "width"
+  48   append-primitive self, "height"
+  49   # for keyboards
+  50   append-primitive self, "key"
+  51   # for streams
+  52   append-primitive self, "stream"
+  53   append-primitive self, "write"
+  54   # misc
+  55   append-primitive self, "abort"
+  56   # keep sync'd with render-primitives
+  57 }
+  58 
+  59 fn load-globals in: (addr handle cell), self: (addr global-table) {
+  60   var remaining-ah/esi: (addr handle cell) <- copy in
+  61   {
+  62     var _remaining/eax: (addr cell) <- lookup *remaining-ah
+  63     var remaining/ecx: (addr cell) <- copy _remaining
+  64     var done?/eax: boolean <- nil? remaining
+  65     compare done?, 0/false
+  66     break-if-!=
+  67     var curr-ah/eax: (addr handle cell) <- get remaining, left
+  68     var curr/eax: (addr cell) <- lookup *curr-ah
+  69     remaining-ah <- get remaining, right
+  70     var value-ah/eax: (addr handle cell) <- get curr, right
+  71     var value/eax: (addr cell) <- lookup *value-ah
+  72     var value-data-ah/eax: (addr handle stream byte) <- get value, text-data
+  73     var _value-data/eax: (addr stream byte) <- lookup *value-data-ah
+  74     var value-data/ecx: (addr stream byte) <- copy _value-data
+  75     var value-gap-buffer-storage: (handle gap-buffer)
+  76     var value-gap-buffer-ah/edx: (addr handle gap-buffer) <- address value-gap-buffer-storage
+  77     allocate value-gap-buffer-ah
+  78     var value-gap-buffer/eax: (addr gap-buffer) <- lookup *value-gap-buffer-ah
+  79     initialize-gap-buffer value-gap-buffer, 0x1000/4KB
+  80     load-gap-buffer-from-stream value-gap-buffer, value-data
+  81     read-evaluate-and-move-to-globals value-gap-buffer-ah, self
+  82     loop
+  83   }
+  84 }
+  85 
+  86 fn write-globals out: (addr stream byte), _self: (addr global-table) {
+  87   var self/esi: (addr global-table) <- copy _self
+  88   write out, "  (globals . (\n"
+  89   var data-ah/eax: (addr handle array global) <- get self, data
+  90   var data/eax: (addr array global) <- lookup *data-ah
+  91   var final-index/edx: (addr int) <- get self, final-index
+  92   var curr-index/ecx: int <- copy 1/skip-0
+  93   {
+  94     compare curr-index, *final-index
+  95     break-if->
+  96     var curr-offset/ebx: (offset global) <- compute-offset data, curr-index
+  97     var curr/ebx: (addr global) <- index data, curr-offset
+  98     var curr-value-ah/edx: (addr handle cell) <- get curr, value
+  99     var curr-value/eax: (addr cell) <- lookup *curr-value-ah
+ 100     var curr-type/eax: (addr int) <- get curr-value, type
+ 101     {
+ 102       compare *curr-type, 4/primitive-function
+ 103       break-if-=
+ 104       compare *curr-type, 5/screen
+ 105       break-if-=
+ 106       compare *curr-type, 6/keyboard
+ 107       break-if-=
+ 108       compare *curr-type, 3/stream  # not implemented yet
+ 109       break-if-=
+ 110       write out, "    ("
+ 111       var curr-name-ah/eax: (addr handle array byte) <- get curr, name
+ 112       var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
+ 113       write out, curr-name
+ 114       write out, " . ["
+ 115       var curr-input-ah/eax: (addr handle gap-buffer) <- get curr, input
+ 116       var curr-input/eax: (addr gap-buffer) <- lookup *curr-input-ah
+ 117       append-gap-buffer curr-input, out
+ 118       write out, "])\n"
+ 119     }
+ 120     curr-index <- increment
+ 121     loop
+ 122   }
+ 123   write out, "  ))\n"
+ 124 }
+ 125 
+ 126 # globals layout: 1 char padding, 41 code, 1 padding, 41 code, 1 padding =  85 chars
+ 127 fn render-globals screen: (addr screen), _self: (addr global-table) {
+ 128   clear-rect screen, 0/xmin, 0/ymin, 0x55/xmax, 0x2f/ymax=screen-height-without-menu, 0xdc/bg=green-bg
+ 129   var self/esi: (addr global-table) <- copy _self
+ 130   # render primitives
+ 131   render-primitives screen, 1/xmin=padding-left, 0x55/xmax, 0x2f/ymax
+ 132   var data-ah/eax: (addr handle array global) <- get self, data
+ 133   var data/eax: (addr array global) <- lookup *data-ah
+ 134   var curr-index/edx: int <- copy 1
+ 135   {
+ 136     var curr-offset/ebx: (offset global) <- compute-offset data, curr-index
+ 137     var curr/ebx: (addr global) <- index data, curr-offset
+ 138     var continue?/eax: boolean <- primitive-global? curr
+ 139     compare continue?, 0/false
+ 140     break-if-=
+ 141     curr-index <- increment
+ 142     loop
+ 143   }
+ 144   var lowest-index/edi: int <- copy curr-index
+ 145   var final-index/edx: (addr int) <- get self, final-index
+ 146   var curr-index/edx: int <- copy *final-index
+ 147   var y1: int
+ 148   copy-to y1, 1/padding-top
+ 149   var y2: int
+ 150   copy-to y2, 1/padding-top
+ 151   $render-globals:loop: {
+ 152     compare curr-index, lowest-index
+ 153     break-if-<
+ 154     {
+ 155       compare y1, 0x2f/ymax
+ 156       break-if-<
+ 157       compare y2, 0x2f/ymax
+ 158       break-if-<
+ 159       break $render-globals:loop
+ 160     }
+ 161     {
+ 162       var curr-offset/edx: (offset global) <- compute-offset data, curr-index
+ 163       var curr/edx: (addr global) <- index data, curr-offset
+ 164       var curr-input-ah/edx: (addr handle gap-buffer) <- get curr, input
+ 165       var _curr-input/eax: (addr gap-buffer) <- lookup *curr-input-ah
+ 166       var curr-input/ebx: (addr gap-buffer) <- copy _curr-input
+ 167       compare curr-input, 0
+ 168       break-if-=
+ 169       $render-globals:render-global: {
+ 170         var x/eax: int <- copy 0
+ 171         var y/ecx: int <- copy y1
+ 172         compare y, y2
+ 173         {
+ 174           break-if->=
+ 175           x, y <- render-gap-buffer-wrapping-right-then-down screen, curr-input, 1/padding-left, y1, 0x2a/xmax, 0x2f/ymax, 0/no-cursor, 7/fg=definition, 0xc5/bg=blue-bg
+ 176           y <- add 2
+ 177           copy-to y1, y
+ 178           break $render-globals:render-global
+ 179         }
+ 180         x, y <- render-gap-buffer-wrapping-right-then-down screen, curr-input, 0x2b/xmin, y2, 0x54/xmax, 0x2f/ymax, 0/no-cursor, 7/fg=definition, 0xc5/bg=blue-bg
+ 181         y <- add 2
+ 182         copy-to y2, y
+ 183       }
+ 184     }
+ 185     curr-index <- decrement
+ 186     loop
+ 187   }
+ 188 }
+ 189 
+ 190 fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
+ 191   var y/ecx: int <- copy ymax
+ 192   y <- subtract 0xf
  193   var tmpx/eax: int <- copy xmin
- 194   tmpx <- draw-text-rightward screen, "  pixel", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
- 195   tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
- 196   y <- increment
- 197   var tmpx/eax: int <- copy xmin
- 198   tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
+ 194   tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 195   y <- increment
+ 196   var tmpx/eax: int <- copy xmin
+ 197   tmpx <- draw-text-rightward screen, "  print", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 198   tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  199   y <- increment
  200   var tmpx/eax: int <- copy xmin
- 201   tmpx <- draw-text-rightward screen, "  clear", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
- 202   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
+ 201   tmpx <- draw-text-rightward screen, "  lines columns", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 202   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  203   y <- increment
  204   var tmpx/eax: int <- copy xmin
- 205   tmpx <- draw-text-rightward screen, "  key", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
- 206   tmpx <- draw-text-rightward screen, ": () -> grapheme?", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
+ 205   tmpx <- draw-text-rightward screen, "  up down left right", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 206   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  207   y <- increment
  208   var tmpx/eax: int <- copy xmin
- 209   tmpx <- draw-text-rightward screen, "streams", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
- 210   y <- increment
- 211   var tmpx/eax: int <- copy xmin
- 212   tmpx <- draw-text-rightward screen, "  stream", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
- 213   tmpx <- draw-text-rightward screen, ": () -> stream ", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
- 214   y <- increment
- 215   var tmpx/eax: int <- copy xmin
- 216   tmpx <- draw-text-rightward screen, "  write", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
- 217   tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
- 218   y <- increment
- 219   var tmpx/eax: int <- copy xmin
- 220   tmpx <- draw-text-rightward screen, "numbers: ", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
- 221   tmpx <- draw-text-rightward screen, "+ - * / sqrt abs sgn = < > <= >=   ", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
- 222   tmpx <- draw-text-rightward screen, "pairs: ", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
- 223   tmpx <- draw-text-rightward screen, "car cdr cons", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
- 224 }
- 225 
- 226 fn primitive-global? _x: (addr global) -> _/eax: boolean {
- 227   var x/eax: (addr global) <- copy _x
- 228   var value-ah/eax: (addr handle cell) <- get x, value
- 229   var value/eax: (addr cell) <- lookup *value-ah
- 230   compare value, 0/null
- 231   {
- 232     break-if-!=
- 233     return 0/false
- 234   }
- 235   var value-type/eax: (addr int) <- get value, type
- 236   compare *value-type, 4/primitive
- 237   {
- 238     break-if-=
- 239     return 0/false
- 240   }
- 241   return 1/true
- 242 }
- 243 
- 244 fn append-primitive _self: (addr global-table), name: (addr array byte) {
- 245   var self/esi: (addr global-table) <- copy _self
- 246   var final-index-addr/ecx: (addr int) <- get self, final-index
- 247   increment *final-index-addr
- 248   var curr-index/ecx: int <- copy *final-index-addr
- 249   var data-ah/eax: (addr handle array global) <- get self, data
- 250   var data/eax: (addr array global) <- lookup *data-ah
- 251   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
- 252   var curr/esi: (addr global) <- index data, curr-offset
- 253   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 254   copy-array-object name, curr-name-ah
- 255   var curr-value-ah/eax: (addr handle cell) <- get curr, value
- 256   new-primitive-function curr-value-ah, curr-index
- 257 }
- 258 
- 259 fn append-global _self: (addr global-table), name: (addr array byte), value: (handle cell), trace: (addr trace) {
- 260   var self/esi: (addr global-table) <- copy _self
- 261   {
- 262     var curr-index/ecx: int <- find-symbol-name-in-globals self, name
- 263     compare curr-index, -1/not-found
+ 209   tmpx <- draw-text-rightward screen, "  cr", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 210   tmpx <- draw-text-rightward screen, ": screen   ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 211   tmpx <- draw-text-rightward screen, "# move cursor down and to left margin", tmpx, xmax, y, 0x38/fg=trace, 0xdc/bg=green-bg
+ 212   y <- increment
+ 213   var tmpx/eax: int <- copy xmin
+ 214   tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 215   y <- increment
+ 216   var tmpx/eax: int <- copy xmin
+ 217   tmpx <- draw-text-rightward screen, "  width height", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 218   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 219   y <- increment
+ 220   var tmpx/eax: int <- copy xmin
+ 221   tmpx <- draw-text-rightward screen, "  pixel", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 222   tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 223   y <- increment
+ 224   var tmpx/eax: int <- copy xmin
+ 225   tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 226   y <- increment
+ 227   var tmpx/eax: int <- copy xmin
+ 228   tmpx <- draw-text-rightward screen, "  clear", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 229   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 230   y <- increment
+ 231   var tmpx/eax: int <- copy xmin
+ 232   tmpx <- draw-text-rightward screen, "  key", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 233   tmpx <- draw-text-rightward screen, ": () -> grapheme?", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 234   y <- increment
+ 235   var tmpx/eax: int <- copy xmin
+ 236   tmpx <- draw-text-rightward screen, "streams", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 237   y <- increment
+ 238   var tmpx/eax: int <- copy xmin
+ 239   tmpx <- draw-text-rightward screen, "  stream", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 240   tmpx <- draw-text-rightward screen, ": () -> stream ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 241   y <- increment
+ 242   var tmpx/eax: int <- copy xmin
+ 243   tmpx <- draw-text-rightward screen, "  write", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 244   tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 245   y <- increment
+ 246   var tmpx/eax: int <- copy xmin
+ 247   tmpx <- draw-text-rightward screen, "fn def set if while = no(t) car cdr cons  ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 248   tmpx <- draw-text-rightward screen, "num: ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
+ 249   tmpx <- draw-text-rightward screen, "+ - * / sqrt abs sgn < > <= >=   ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+ 250 }
+ 251 
+ 252 fn primitive-global? _x: (addr global) -> _/eax: boolean {
+ 253   var x/eax: (addr global) <- copy _x
+ 254   var value-ah/eax: (addr handle cell) <- get x, value
+ 255   var value/eax: (addr cell) <- lookup *value-ah
+ 256   compare value, 0/null
+ 257   {
+ 258     break-if-!=
+ 259     return 0/false
+ 260   }
+ 261   var value-type/eax: (addr int) <- get value, type
+ 262   compare *value-type, 4/primitive
+ 263   {
  264     break-if-=
- 265     # otherwise error "global already exists: ", sym
- 266     var stream-storage: (stream byte 0x40)
- 267     var stream/ecx: (addr stream byte) <- address stream-storage
- 268     write stream, "global already exists: "
- 269     write stream, name
- 270     trace trace, "error", stream
- 271     return
- 272   }
- 273   var final-index-addr/ecx: (addr int) <- get self, final-index
- 274   increment *final-index-addr
- 275   var curr-index/ecx: int <- copy *final-index-addr
- 276   var data-ah/eax: (addr handle array global) <- get self, data
- 277   var data/eax: (addr array global) <- lookup *data-ah
- 278   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
- 279   var curr/esi: (addr global) <- index data, curr-offset
- 280   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 281   copy-array-object name, curr-name-ah
- 282   var curr-value-ah/eax: (addr handle cell) <- get curr, value
- 283   copy-handle value, curr-value-ah
- 284 }
- 285 
- 286 fn append-global-binding-of-stream _self: (addr global-table), name: (addr stream byte), value: (handle cell) {
- 287   var self/esi: (addr global-table) <- copy _self
- 288   var final-index-addr/ecx: (addr int) <- get self, final-index
- 289   increment *final-index-addr
- 290   var curr-index/ecx: int <- copy *final-index-addr
- 291   var data-ah/eax: (addr handle array global) <- get self, data
- 292   var data/eax: (addr array global) <- lookup *data-ah
- 293   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
- 294   var curr/esi: (addr global) <- index data, curr-offset
- 295   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 296   rewind-stream name
- 297   stream-to-array name, curr-name-ah
- 298   var curr-value-ah/eax: (addr handle cell) <- get curr, value
- 299   copy-handle value, curr-value-ah
- 300 }
- 301 
- 302 fn lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
- 303   var sym/eax: (addr cell) <- copy _sym
- 304   var sym-name-ah/eax: (addr handle stream byte) <- get sym, text-data
- 305   var _sym-name/eax: (addr stream byte) <- lookup *sym-name-ah
- 306   var sym-name/edx: (addr stream byte) <- copy _sym-name
- 307   var globals/esi: (addr global-table) <- copy _globals
- 308   {
- 309     compare globals, 0
- 310     break-if-=
- 311     var curr-index/ecx: int <- find-symbol-in-globals globals, sym-name
- 312     compare curr-index, -1/not-found
+ 265     return 0/false
+ 266   }
+ 267   return 1/true
+ 268 }
+ 269 
+ 270 fn append-primitive _self: (addr global-table), name: (addr array byte) {
+ 271   var self/esi: (addr global-table) <- copy _self
+ 272   var final-index-addr/ecx: (addr int) <- get self, final-index
+ 273   increment *final-index-addr
+ 274   var curr-index/ecx: int <- copy *final-index-addr
+ 275   var data-ah/eax: (addr handle array global) <- get self, data
+ 276   var data/eax: (addr array global) <- lookup *data-ah
+ 277   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
+ 278   var curr/esi: (addr global) <- index data, curr-offset
+ 279   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
+ 280   copy-array-object name, curr-name-ah
+ 281   var curr-value-ah/eax: (addr handle cell) <- get curr, value
+ 282   new-primitive-function curr-value-ah, curr-index
+ 283 }
+ 284 
+ 285 fn assign-or-create-global _self: (addr global-table), name: (addr array byte), value: (handle cell), trace: (addr trace) {
+ 286   var self/esi: (addr global-table) <- copy _self
+ 287   var curr-index/ecx: int <- find-symbol-name-in-globals self, name
+ 288   {
+ 289     compare curr-index, -1/not-found
+ 290     break-if-!=
+ 291     var final-index-addr/eax: (addr int) <- get self, final-index
+ 292     increment *final-index-addr
+ 293     curr-index <- copy *final-index-addr
+ 294   }
+ 295   var data-ah/eax: (addr handle array global) <- get self, data
+ 296   var data/eax: (addr array global) <- lookup *data-ah
+ 297   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
+ 298   var curr/esi: (addr global) <- index data, curr-offset
+ 299   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
+ 300   copy-array-object name, curr-name-ah
+ 301   var curr-value-ah/eax: (addr handle cell) <- get curr, value
+ 302   copy-handle value, curr-value-ah
+ 303 }
+ 304 
+ 305 fn lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
+ 306   var sym/eax: (addr cell) <- copy _sym
+ 307   var sym-name-ah/eax: (addr handle stream byte) <- get sym, text-data
+ 308   var _sym-name/eax: (addr stream byte) <- lookup *sym-name-ah
+ 309   var sym-name/edx: (addr stream byte) <- copy _sym-name
+ 310   var globals/esi: (addr global-table) <- copy _globals
+ 311   {
+ 312     compare globals, 0
  313     break-if-=
- 314     var global-data-ah/eax: (addr handle array global) <- get globals, data
- 315     var global-data/eax: (addr array global) <- lookup *global-data-ah
- 316     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
- 317     var curr/ebx: (addr global) <- index global-data, curr-offset
- 318     var curr-value/eax: (addr handle cell) <- get curr, value
- 319     copy-object curr-value, out
- 320     return
- 321   }
- 322   # if sym is "screen" and screen-cell exists, return it
- 323   {
- 324     var sym-is-screen?/eax: boolean <- stream-data-equal? sym-name, "screen"
- 325     compare sym-is-screen?, 0/false
- 326     break-if-=
- 327     compare screen-cell, 0
- 328     break-if-=
- 329     copy-object screen-cell, out
- 330     return
- 331   }
- 332   # if sym is "keyboard" and keyboard-cell exists, return it
- 333   {
- 334     var sym-is-keyboard?/eax: boolean <- stream-data-equal? sym-name, "keyboard"
- 335     compare sym-is-keyboard?, 0/false
- 336     break-if-=
- 337     compare keyboard-cell, 0
- 338     break-if-=
- 339     copy-object keyboard-cell, out
- 340     return
- 341   }
- 342   # otherwise error "unbound symbol: ", sym
- 343   var stream-storage: (stream byte 0x40)
- 344   var stream/ecx: (addr stream byte) <- address stream-storage
- 345   write stream, "unbound symbol: "
- 346   rewind-stream sym-name
- 347   write-stream stream, sym-name
- 348   trace trace, "error", stream
- 349 }
- 350 
- 351 # return the index in globals containing 'sym'
- 352 # or -1 if not found
- 353 fn find-symbol-in-globals _globals: (addr global-table), sym-name: (addr stream byte) -> _/ecx: int {
- 354   var globals/esi: (addr global-table) <- copy _globals
- 355   compare globals, 0
- 356   {
- 357     break-if-!=
- 358     return -1/not-found
- 359   }
- 360   var global-data-ah/eax: (addr handle array global) <- get globals, data
- 361   var global-data/eax: (addr array global) <- lookup *global-data-ah
- 362   var final-index/ecx: (addr int) <- get globals, final-index
- 363   var curr-index/ecx: int <- copy *final-index
- 364   {
- 365     compare curr-index, 0
- 366     break-if-<
- 367     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
- 368     var curr/ebx: (addr global) <- index global-data, curr-offset
- 369     var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 370     var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
- 371     var found?/eax: boolean <- stream-data-equal? sym-name, curr-name
- 372     compare found?, 0/false
- 373     {
- 374       break-if-=
- 375       return curr-index
- 376     }
- 377     curr-index <- decrement
- 378     loop
- 379   }
- 380   return -1/not-found
- 381 }
- 382 
- 383 # return the index in globals containing 'sym'
- 384 # or -1 if not found
- 385 fn find-symbol-name-in-globals _globals: (addr global-table), sym-name: (addr array byte) -> _/ecx: int {
- 386   var globals/esi: (addr global-table) <- copy _globals
- 387   compare globals, 0
- 388   {
- 389     break-if-!=
- 390     return -1/not-found
- 391   }
- 392   var global-data-ah/eax: (addr handle array global) <- get globals, data
- 393   var global-data/eax: (addr array global) <- lookup *global-data-ah
- 394   var final-index/ecx: (addr int) <- get globals, final-index
- 395   var curr-index/ecx: int <- copy *final-index
- 396   {
- 397     compare curr-index, 0
- 398     break-if-<
- 399     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
- 400     var curr/ebx: (addr global) <- index global-data, curr-offset
- 401     var curr-name-ah/eax: (addr handle array byte) <- get curr, name
- 402     var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
- 403     var found?/eax: boolean <- string-equal? sym-name, curr-name
- 404     compare found?, 0/false
- 405     {
- 406       break-if-=
- 407       return curr-index
- 408     }
- 409     curr-index <- decrement
- 410     loop
- 411   }
- 412   return -1/not-found
- 413 }
- 414 
- 415 fn mutate-binding-in-globals name: (addr stream byte), val: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
- 416   var globals/esi: (addr global-table) <- copy _globals
- 417   {
- 418     compare globals, 0
- 419     break-if-=
- 420     var curr-index/ecx: int <- find-symbol-in-globals globals, name
- 421     compare curr-index, -1/not-found
+ 314     var curr-index/ecx: int <- find-symbol-in-globals globals, sym-name
+ 315     compare curr-index, -1/not-found
+ 316     break-if-=
+ 317     var global-data-ah/eax: (addr handle array global) <- get globals, data
+ 318     var global-data/eax: (addr array global) <- lookup *global-data-ah
+ 319     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
+ 320     var curr/ebx: (addr global) <- index global-data, curr-offset
+ 321     var curr-value/eax: (addr handle cell) <- get curr, value
+ 322     copy-object curr-value, out
+ 323     return
+ 324   }
+ 325   # if sym is "screen" and screen-cell exists, return it
+ 326   {
+ 327     var sym-is-screen?/eax: boolean <- stream-data-equal? sym-name, "screen"
+ 328     compare sym-is-screen?, 0/false
+ 329     break-if-=
+ 330     compare screen-cell, 0
+ 331     break-if-=
+ 332     copy-object screen-cell, out
+ 333     return
+ 334   }
+ 335   # if sym is "keyboard" and keyboard-cell exists, return it
+ 336   {
+ 337     var sym-is-keyboard?/eax: boolean <- stream-data-equal? sym-name, "keyboard"
+ 338     compare sym-is-keyboard?, 0/false
+ 339     break-if-=
+ 340     compare keyboard-cell, 0
+ 341     break-if-=
+ 342     copy-object keyboard-cell, out
+ 343     return
+ 344   }
+ 345   # otherwise error "unbound symbol: ", sym
+ 346   var stream-storage: (stream byte 0x40)
+ 347   var stream/ecx: (addr stream byte) <- address stream-storage
+ 348   write stream, "unbound symbol: "
+ 349   rewind-stream sym-name
+ 350   write-stream stream, sym-name
+ 351   trace trace, "error", stream
+ 352 }
+ 353 
+ 354 # return the index in globals containing 'sym'
+ 355 # or -1 if not found
+ 356 fn find-symbol-in-globals _globals: (addr global-table), sym-name: (addr stream byte) -> _/ecx: int {
+ 357   var globals/esi: (addr global-table) <- copy _globals
+ 358   compare globals, 0
+ 359   {
+ 360     break-if-!=
+ 361     return -1/not-found
+ 362   }
+ 363   var global-data-ah/eax: (addr handle array global) <- get globals, data
+ 364   var global-data/eax: (addr array global) <- lookup *global-data-ah
+ 365   var final-index/ecx: (addr int) <- get globals, final-index
+ 366   var curr-index/ecx: int <- copy *final-index
+ 367   {
+ 368     compare curr-index, 0
+ 369     break-if-<
+ 370     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
+ 371     var curr/ebx: (addr global) <- index global-data, curr-offset
+ 372     var curr-name-ah/eax: (addr handle array byte) <- get curr, name
+ 373     var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
+ 374     var found?/eax: boolean <- stream-data-equal? sym-name, curr-name
+ 375     compare found?, 0/false
+ 376     {
+ 377       break-if-=
+ 378       return curr-index
+ 379     }
+ 380     curr-index <- decrement
+ 381     loop
+ 382   }
+ 383   return -1/not-found
+ 384 }
+ 385 
+ 386 # return the index in globals containing 'sym'
+ 387 # or -1 if not found
+ 388 fn find-symbol-name-in-globals _globals: (addr global-table), sym-name: (addr array byte) -> _/ecx: int {
+ 389   var globals/esi: (addr global-table) <- copy _globals
+ 390   compare globals, 0
+ 391   {
+ 392     break-if-!=
+ 393     return -1/not-found
+ 394   }
+ 395   var global-data-ah/eax: (addr handle array global) <- get globals, data
+ 396   var global-data/eax: (addr array global) <- lookup *global-data-ah
+ 397   var final-index/ecx: (addr int) <- get globals, final-index
+ 398   var curr-index/ecx: int <- copy *final-index
+ 399   {
+ 400     compare curr-index, 0
+ 401     break-if-<
+ 402     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
+ 403     var curr/ebx: (addr global) <- index global-data, curr-offset
+ 404     var curr-name-ah/eax: (addr handle array byte) <- get curr, name
+ 405     var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
+ 406     var found?/eax: boolean <- string-equal? sym-name, curr-name
+ 407     compare found?, 0/false
+ 408     {
+ 409       break-if-=
+ 410       return curr-index
+ 411     }
+ 412     curr-index <- decrement
+ 413     loop
+ 414   }
+ 415   return -1/not-found
+ 416 }
+ 417 
+ 418 fn mutate-binding-in-globals name: (addr stream byte), val: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
+ 419   var globals/esi: (addr global-table) <- copy _globals
+ 420   {
+ 421     compare globals, 0
  422     break-if-=
- 423     var global-data-ah/eax: (addr handle array global) <- get globals, data
- 424     var global-data/eax: (addr array global) <- lookup *global-data-ah
- 425     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
- 426     var curr/ebx: (addr global) <- index global-data, curr-offset
- 427     var dest/eax: (addr handle cell) <- get curr, value
- 428     copy-object val, dest
- 429     return
- 430   }
- 431   # otherwise error "unbound symbol: ", sym
- 432   var stream-storage: (stream byte 0x40)
- 433   var stream/ecx: (addr stream byte) <- address stream-storage
- 434   write stream, "unbound symbol: "
- 435   rewind-stream name
- 436   write-stream stream, name
- 437   trace trace, "error", stream
- 438 }
- 439 
- 440 # a little strange; goes from value to name and selects primitive based on name
- 441 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
- 442   var f/esi: (addr cell) <- copy _f
- 443   var f-index-a/ecx: (addr int) <- get f, index-data
- 444   var f-index/ecx: int <- copy *f-index-a
- 445   var globals/eax: (addr global-table) <- copy _globals
- 446   var global-data-ah/eax: (addr handle array global) <- get globals, data
- 447   var global-data/eax: (addr array global) <- lookup *global-data-ah
- 448   var f-offset/ecx: (offset global) <- compute-offset global-data, f-index
- 449   var f-value/ecx: (addr global) <- index global-data, f-offset
- 450   var f-name-ah/ecx: (addr handle array byte) <- get f-value, name
- 451   var f-name/eax: (addr array byte) <- lookup *f-name-ah
- 452   {
- 453     var is-add?/eax: boolean <- string-equal? f-name, "+"
- 454     compare is-add?, 0/false
- 455     break-if-=
- 456     apply-add args-ah, out, trace
- 457     return
- 458   }
- 459   {
- 460     var is-subtract?/eax: boolean <- string-equal? f-name, "-"
- 461     compare is-subtract?, 0/false
- 462     break-if-=
- 463     apply-subtract args-ah, out, trace
- 464     return
- 465   }
- 466   {
- 467     var is-multiply?/eax: boolean <- string-equal? f-name, "*"
- 468     compare is-multiply?, 0/false
- 469     break-if-=
- 470     apply-multiply args-ah, out, trace
- 471     return
- 472   }
- 473   {
- 474     var is-divide?/eax: boolean <- string-equal? f-name, "/"
- 475     compare is-divide?, 0/false
- 476     break-if-=
- 477     apply-divide args-ah, out, trace
- 478     return
- 479   }
- 480   {
- 481     var is-square-root?/eax: boolean <- string-equal? f-name, "sqrt"
- 482     compare is-square-root?, 0/false
- 483     break-if-=
- 484     apply-square-root args-ah, out, trace
- 485     return
- 486   }
- 487   {
- 488     var is-abs?/eax: boolean <- string-equal? f-name, "abs"
- 489     compare is-abs?, 0/false
- 490     break-if-=
- 491     apply-abs args-ah, out, trace
- 492     return
- 493   }
- 494   {
- 495     var is-sgn?/eax: boolean <- string-equal? f-name, "sgn"
- 496     compare is-sgn?, 0/false
- 497     break-if-=
- 498     apply-sgn args-ah, out, trace
- 499     return
- 500   }
- 501   {
- 502     var is-car?/eax: boolean <- string-equal? f-name, "car"
- 503     compare is-car?, 0/false
- 504     break-if-=
- 505     apply-car args-ah, out, trace
- 506     return
- 507   }
- 508   {
- 509     var is-cdr?/eax: boolean <- string-equal? f-name, "cdr"
- 510     compare is-cdr?, 0/false
- 511     break-if-=
- 512     apply-cdr args-ah, out, trace
- 513     return
- 514   }
- 515   {
- 516     var is-cons?/eax: boolean <- string-equal? f-name, "cons"
- 517     compare is-cons?, 0/false
- 518     break-if-=
- 519     apply-cons args-ah, out, trace
- 520     return
- 521   }
- 522   {
- 523     var is-structurally-equal?/eax: boolean <- string-equal? f-name, "="
- 524     compare is-structurally-equal?, 0/false
- 525     break-if-=
- 526     apply-structurally-equal args-ah, out, trace
- 527     return
- 528   }
- 529   {
- 530     var is-lesser?/eax: boolean <- string-equal? f-name, "<"
- 531     compare is-lesser?, 0/false
- 532     break-if-=
- 533     apply-< args-ah, out, trace
- 534     return
- 535   }
- 536   {
- 537     var is-greater?/eax: boolean <- string-equal? f-name, ">"
- 538     compare is-greater?, 0/false
- 539     break-if-=
- 540     apply-> args-ah, out, trace
- 541     return
- 542   }
- 543   {
- 544     var is-lesser-or-equal?/eax: boolean <- string-equal? f-name, "<="
- 545     compare is-lesser-or-equal?, 0/false
- 546     break-if-=
- 547     apply-<= args-ah, out, trace
- 548     return
- 549   }
- 550   {
- 551     var is-greater-or-equal?/eax: boolean <- string-equal? f-name, ">="
- 552     compare is-greater-or-equal?, 0/false
- 553     break-if-=
- 554     apply->= args-ah, out, trace
- 555     return
- 556   }
- 557   {
- 558     var is-print?/eax: boolean <- string-equal? f-name, "print"
- 559     compare is-print?, 0/false
- 560     break-if-=
- 561     apply-print args-ah, out, trace
- 562     return
- 563   }
- 564   {
- 565     var is-clear?/eax: boolean <- string-equal? f-name, "clear"
- 566     compare is-clear?, 0/false
- 567     break-if-=
- 568     apply-clear args-ah, out, trace
- 569     return
- 570   }
- 571   {
- 572     var is-lines?/eax: boolean <- string-equal? f-name, "lines"
- 573     compare is-lines?, 0/false
- 574     break-if-=
- 575     apply-lines args-ah, out, trace
- 576     return
- 577   }
- 578   {
- 579     var is-columns?/eax: boolean <- string-equal? f-name, "columns"
- 580     compare is-columns?, 0/false
- 581     break-if-=
- 582     apply-columns args-ah, out, trace
- 583     return
- 584   }
- 585   {
- 586     var is-up?/eax: boolean <- string-equal? f-name, "up"
- 587     compare is-up?, 0/false
- 588     break-if-=
- 589     apply-up args-ah, out, trace
- 590     return
- 591   }
- 592   {
- 593     var is-down?/eax: boolean <- string-equal? f-name, "down"
- 594     compare is-down?, 0/false
- 595     break-if-=
- 596     apply-down args-ah, out, trace
- 597     return
- 598   }
- 599   {
- 600     var is-left?/eax: boolean <- string-equal? f-name, "left"
- 601     compare is-left?, 0/false
- 602     break-if-=
- 603     apply-left args-ah, out, trace
- 604     return
- 605   }
- 606   {
- 607     var is-right?/eax: boolean <- string-equal? f-name, "right"
- 608     compare is-right?, 0/false
- 609     break-if-=
- 610     apply-right args-ah, out, trace
- 611     return
- 612   }
- 613   {
- 614     var is-cr?/eax: boolean <- string-equal? f-name, "cr"
- 615     compare is-cr?, 0/false
- 616     break-if-=
- 617     apply-cr args-ah, out, trace
- 618     return
- 619   }
- 620   {
- 621     var is-pixel?/eax: boolean <- string-equal? f-name, "pixel"
- 622     compare is-pixel?, 0/false
- 623     break-if-=
- 624     apply-pixel args-ah, out, trace
- 625     return
- 626   }
- 627   {
- 628     var is-width?/eax: boolean <- string-equal? f-name, "width"
- 629     compare is-width?, 0/false
- 630     break-if-=
- 631     apply-width args-ah, out, trace
- 632     return
- 633   }
- 634   {
- 635     var is-height?/eax: boolean <- string-equal? f-name, "height"
- 636     compare is-height?, 0/false
- 637     break-if-=
- 638     apply-height args-ah, out, trace
- 639     return
- 640   }
- 641   {
- 642     var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
- 643     compare wait-for-key?, 0/false
- 644     break-if-=
- 645     apply-wait-for-key args-ah, out, trace
- 646     return
- 647   }
- 648   {
- 649     var is-stream?/eax: boolean <- string-equal? f-name, "stream"
- 650     compare is-stream?, 0/false
- 651     break-if-=
- 652     apply-stream args-ah, out, trace
- 653     return
- 654   }
- 655   {
- 656     var write?/eax: boolean <- string-equal? f-name, "write"
- 657     compare write?, 0/false
- 658     break-if-=
- 659     apply-write args-ah, out, trace
- 660     return
- 661   }
- 662   {
- 663     var abort?/eax: boolean <- string-equal? f-name, "abort"
- 664     compare abort?, 0/false
- 665     break-if-=
- 666     apply-abort args-ah, out, trace
- 667     return
- 668   }
- 669   {
- 670     var life?/eax: boolean <- string-equal? f-name, "life"
- 671     compare life?, 0/false
- 672     break-if-=
- 673     apply-life args-ah, out, trace
- 674     return
- 675   }
- 676   abort "unknown primitive function"
- 677 }
- 678 
- 679 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 680   trace-text trace, "eval", "apply +"
- 681   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 682   var _args/eax: (addr cell) <- lookup *args-ah
- 683   var args/esi: (addr cell) <- copy _args
- 684   # TODO: check that args is a pair
- 685   var empty-args?/eax: boolean <- nil? args
- 686   compare empty-args?, 0/false
- 687   {
- 688     break-if-=
- 689     error trace, "+ needs 2 args but got 0"
- 690     return
- 691   }
- 692   # args->left->value
- 693   var first-ah/eax: (addr handle cell) <- get args, left
- 694   var first/eax: (addr cell) <- lookup *first-ah
- 695   var first-type/ecx: (addr int) <- get first, type
- 696   compare *first-type, 1/number
+ 423     var curr-index/ecx: int <- find-symbol-in-globals globals, name
+ 424     compare curr-index, -1/not-found
+ 425     break-if-=
+ 426     var global-data-ah/eax: (addr handle array global) <- get globals, data
+ 427     var global-data/eax: (addr array global) <- lookup *global-data-ah
+ 428     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
+ 429     var curr/ebx: (addr global) <- index global-data, curr-offset
+ 430     var dest/eax: (addr handle cell) <- get curr, value
+ 431     copy-object val, dest
+ 432     return
+ 433   }
+ 434   # otherwise error "unbound symbol: ", sym
+ 435   var stream-storage: (stream byte 0x40)
+ 436   var stream/ecx: (addr stream byte) <- address stream-storage
+ 437   write stream, "unbound symbol: "
+ 438   rewind-stream name
+ 439   write-stream stream, name
+ 440   trace trace, "error", stream
+ 441 }
+ 442 
+ 443 # a little strange; goes from value to name and selects primitive based on name
+ 444 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
+ 445   var f/esi: (addr cell) <- copy _f
+ 446   var f-index-a/ecx: (addr int) <- get f, index-data
+ 447   var f-index/ecx: int <- copy *f-index-a
+ 448   var globals/eax: (addr global-table) <- copy _globals
+ 449   var global-data-ah/eax: (addr handle array global) <- get globals, data
+ 450   var global-data/eax: (addr array global) <- lookup *global-data-ah
+ 451   var f-offset/ecx: (offset global) <- compute-offset global-data, f-index
+ 452   var f-value/ecx: (addr global) <- index global-data, f-offset
+ 453   var f-name-ah/ecx: (addr handle array byte) <- get f-value, name
+ 454   var f-name/eax: (addr array byte) <- lookup *f-name-ah
+ 455   {
+ 456     var add?/eax: boolean <- string-equal? f-name, "+"
+ 457     compare add?, 0/false
+ 458     break-if-=
+ 459     apply-add args-ah, out, trace
+ 460     return
+ 461   }
+ 462   {
+ 463     var subtract?/eax: boolean <- string-equal? f-name, "-"
+ 464     compare subtract?, 0/false
+ 465     break-if-=
+ 466     apply-subtract args-ah, out, trace
+ 467     return
+ 468   }
+ 469   {
+ 470     var multiply?/eax: boolean <- string-equal? f-name, "*"
+ 471     compare multiply?, 0/false
+ 472     break-if-=
+ 473     apply-multiply args-ah, out, trace
+ 474     return
+ 475   }
+ 476   {
+ 477     var divide?/eax: boolean <- string-equal? f-name, "/"
+ 478     compare divide?, 0/false
+ 479     break-if-=
+ 480     apply-divide args-ah, out, trace
+ 481     return
+ 482   }
+ 483   {
+ 484     var square-root?/eax: boolean <- string-equal? f-name, "sqrt"
+ 485     compare square-root?, 0/false
+ 486     break-if-=
+ 487     apply-square-root args-ah, out, trace
+ 488     return
+ 489   }
+ 490   {
+ 491     var abs?/eax: boolean <- string-equal? f-name, "abs"
+ 492     compare abs?, 0/false
+ 493     break-if-=
+ 494     apply-abs args-ah, out, trace
+ 495     return
+ 496   }
+ 497   {
+ 498     var sgn?/eax: boolean <- string-equal? f-name, "sgn"
+ 499     compare sgn?, 0/false
+ 500     break-if-=
+ 501     apply-sgn args-ah, out, trace
+ 502     return
+ 503   }
+ 504   {
+ 505     var car?/eax: boolean <- string-equal? f-name, "car"
+ 506     compare car?, 0/false
+ 507     break-if-=
+ 508     apply-car args-ah, out, trace
+ 509     return
+ 510   }
+ 511   {
+ 512     var cdr?/eax: boolean <- string-equal? f-name, "cdr"
+ 513     compare cdr?, 0/false
+ 514     break-if-=
+ 515     apply-cdr args-ah, out, trace
+ 516     return
+ 517   }
+ 518   {
+ 519     var cons?/eax: boolean <- string-equal? f-name, "cons"
+ 520     compare cons?, 0/false
+ 521     break-if-=
+ 522     apply-cons args-ah, out, trace
+ 523     return
+ 524   }
+ 525   {
+ 526     var structurally-equal?/eax: boolean <- string-equal? f-name, "="
+ 527     compare structurally-equal?, 0/false
+ 528     break-if-=
+ 529     apply-structurally-equal args-ah, out, trace
+ 530     return
+ 531   }
+ 532   {
+ 533     var not?/eax: boolean <- string-equal? f-name, "no"
+ 534     compare not?, 0/false
+ 535     break-if-=
+ 536     apply-not args-ah, out, trace
+ 537     return
+ 538   }
+ 539   {
+ 540     var not?/eax: boolean <- string-equal? f-name, "not"
+ 541     compare not?, 0/false
+ 542     break-if-=
+ 543     apply-not args-ah, out, trace
+ 544     return
+ 545   }
+ 546   {
+ 547     var lesser?/eax: boolean <- string-equal? f-name, "<"
+ 548     compare lesser?, 0/false
+ 549     break-if-=
+ 550     apply-< args-ah, out, trace
+ 551     return
+ 552   }
+ 553   {
+ 554     var greater?/eax: boolean <- string-equal? f-name, ">"
+ 555     compare greater?, 0/false
+ 556     break-if-=
+ 557     apply-> args-ah, out, trace
+ 558     return
+ 559   }
+ 560   {
+ 561     var lesser-or-equal?/eax: boolean <- string-equal? f-name, "<="
+ 562     compare lesser-or-equal?, 0/false
+ 563     break-if-=
+ 564     apply-<= args-ah, out, trace
+ 565     return
+ 566   }
+ 567   {
+ 568     var greater-or-equal?/eax: boolean <- string-equal? f-name, ">="
+ 569     compare greater-or-equal?, 0/false
+ 570     break-if-=
+ 571     apply->= args-ah, out, trace
+ 572     return
+ 573   }
+ 574   {
+ 575     var print?/eax: boolean <- string-equal? f-name, "print"
+ 576     compare print?, 0/false
+ 577     break-if-=
+ 578     apply-print args-ah, out, trace
+ 579     return
+ 580   }
+ 581   {
+ 582     var clear?/eax: boolean <- string-equal? f-name, "clear"
+ 583     compare clear?, 0/false
+ 584     break-if-=
+ 585     apply-clear args-ah, out, trace
+ 586     return
+ 587   }
+ 588   {
+ 589     var lines?/eax: boolean <- string-equal? f-name, "lines"
+ 590     compare lines?, 0/false
+ 591     break-if-=
+ 592     apply-lines args-ah, out, trace
+ 593     return
+ 594   }
+ 595   {
+ 596     var columns?/eax: boolean <- string-equal? f-name, "columns"
+ 597     compare columns?, 0/false
+ 598     break-if-=
+ 599     apply-columns args-ah, out, trace
+ 600     return
+ 601   }
+ 602   {
+ 603     var up?/eax: boolean <- string-equal? f-name, "up"
+ 604     compare up?, 0/false
+ 605     break-if-=
+ 606     apply-up args-ah, out, trace
+ 607     return
+ 608   }
+ 609   {
+ 610     var down?/eax: boolean <- string-equal? f-name, "down"
+ 611     compare down?, 0/false
+ 612     break-if-=
+ 613     apply-down args-ah, out, trace
+ 614     return
+ 615   }
+ 616   {
+ 617     var left?/eax: boolean <- string-equal? f-name, "left"
+ 618     compare left?, 0/false
+ 619     break-if-=
+ 620     apply-left args-ah, out, trace
+ 621     return
+ 622   }
+ 623   {
+ 624     var right?/eax: boolean <- string-equal? f-name, "right"
+ 625     compare right?, 0/false
+ 626     break-if-=
+ 627     apply-right args-ah, out, trace
+ 628     return
+ 629   }
+ 630   {
+ 631     var cr?/eax: boolean <- string-equal? f-name, "cr"
+ 632     compare cr?, 0/false
+ 633     break-if-=
+ 634     apply-cr args-ah, out, trace
+ 635     return
+ 636   }
+ 637   {
+ 638     var pixel?/eax: boolean <- string-equal? f-name, "pixel"
+ 639     compare pixel?, 0/false
+ 640     break-if-=
+ 641     apply-pixel args-ah, out, trace
+ 642     return
+ 643   }
+ 644   {
+ 645     var width?/eax: boolean <- string-equal? f-name, "width"
+ 646     compare width?, 0/false
+ 647     break-if-=
+ 648     apply-width args-ah, out, trace
+ 649     return
+ 650   }
+ 651   {
+ 652     var height?/eax: boolean <- string-equal? f-name, "height"
+ 653     compare height?, 0/false
+ 654     break-if-=
+ 655     apply-height args-ah, out, trace
+ 656     return
+ 657   }
+ 658   {
+ 659     var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
+ 660     compare wait-for-key?, 0/false
+ 661     break-if-=
+ 662     apply-wait-for-key args-ah, out, trace
+ 663     return
+ 664   }
+ 665   {
+ 666     var stream?/eax: boolean <- string-equal? f-name, "stream"
+ 667     compare stream?, 0/false
+ 668     break-if-=
+ 669     apply-stream args-ah, out, trace
+ 670     return
+ 671   }
+ 672   {
+ 673     var write?/eax: boolean <- string-equal? f-name, "write"
+ 674     compare write?, 0/false
+ 675     break-if-=
+ 676     apply-write args-ah, out, trace
+ 677     return
+ 678   }
+ 679   {
+ 680     var abort?/eax: boolean <- string-equal? f-name, "abort"
+ 681     compare abort?, 0/false
+ 682     break-if-=
+ 683     apply-abort args-ah, out, trace
+ 684     return
+ 685   }
+ 686   abort "unknown primitive function"
+ 687 }
+ 688 
+ 689 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 690   trace-text trace, "eval", "apply +"
+ 691   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 692   var _args/eax: (addr cell) <- lookup *args-ah
+ 693   var args/esi: (addr cell) <- copy _args
+ 694   # TODO: check that args is a pair
+ 695   var empty-args?/eax: boolean <- nil? args
+ 696   compare empty-args?, 0/false
  697   {
  698     break-if-=
- 699     error trace, "first arg for + is not a number"
+ 699     error trace, "+ needs 2 args but got 0"
  700     return
  701   }
- 702   var first-value/ecx: (addr float) <- get first, number-data
- 703   # args->right->left->value
- 704   var right-ah/eax: (addr handle cell) <- get args, right
- 705 #?   dump-cell right-ah
- 706 #?   abort "aaa"
- 707   var right/eax: (addr cell) <- lookup *right-ah
- 708   # TODO: check that right is a pair
- 709   var second-ah/eax: (addr handle cell) <- get right, left
- 710   var second/eax: (addr cell) <- lookup *second-ah
- 711   var second-type/edx: (addr int) <- get second, type
- 712   compare *second-type, 1/number
- 713   {
- 714     break-if-=
- 715     error trace, "second arg for + is not a number"
- 716     return
- 717   }
- 718   var second-value/edx: (addr float) <- get second, number-data
- 719   # add
- 720   var result/xmm0: float <- copy *first-value
- 721   result <- add *second-value
- 722   new-float out, result
- 723 }
- 724 
- 725 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 726   trace-text trace, "eval", "apply -"
- 727   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 728   var _args/eax: (addr cell) <- lookup *args-ah
- 729   var args/esi: (addr cell) <- copy _args
- 730   # TODO: check that args is a pair
- 731   var empty-args?/eax: boolean <- nil? args
- 732   compare empty-args?, 0/false
- 733   {
- 734     break-if-=
- 735     error trace, "- needs 2 args but got 0"
- 736     return
- 737   }
- 738   # args->left->value
- 739   var first-ah/eax: (addr handle cell) <- get args, left
- 740   var first/eax: (addr cell) <- lookup *first-ah
- 741   var first-type/ecx: (addr int) <- get first, type
- 742   compare *first-type, 1/number
+ 702   # args->left->value
+ 703   var first-ah/eax: (addr handle cell) <- get args, left
+ 704   var first/eax: (addr cell) <- lookup *first-ah
+ 705   var first-type/ecx: (addr int) <- get first, type
+ 706   compare *first-type, 1/number
+ 707   {
+ 708     break-if-=
+ 709     error trace, "first arg for + is not a number"
+ 710     return
+ 711   }
+ 712   var first-value/ecx: (addr float) <- get first, number-data
+ 713   # args->right->left->value
+ 714   var right-ah/eax: (addr handle cell) <- get args, right
+ 715 #?   dump-cell right-ah
+ 716 #?   abort "aaa"
+ 717   var right/eax: (addr cell) <- lookup *right-ah
+ 718   # TODO: check that right is a pair
+ 719   var second-ah/eax: (addr handle cell) <- get right, left
+ 720   var second/eax: (addr cell) <- lookup *second-ah
+ 721   var second-type/edx: (addr int) <- get second, type
+ 722   compare *second-type, 1/number
+ 723   {
+ 724     break-if-=
+ 725     error trace, "second arg for + is not a number"
+ 726     return
+ 727   }
+ 728   var second-value/edx: (addr float) <- get second, number-data
+ 729   # add
+ 730   var result/xmm0: float <- copy *first-value
+ 731   result <- add *second-value
+ 732   new-float out, result
+ 733 }
+ 734 
+ 735 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 736   trace-text trace, "eval", "apply -"
+ 737   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 738   var _args/eax: (addr cell) <- lookup *args-ah
+ 739   var args/esi: (addr cell) <- copy _args
+ 740   # TODO: check that args is a pair
+ 741   var empty-args?/eax: boolean <- nil? args
+ 742   compare empty-args?, 0/false
  743   {
  744     break-if-=
- 745     error trace, "first arg for - is not a number"
+ 745     error trace, "- needs 2 args but got 0"
  746     return
  747   }
- 748   var first-value/ecx: (addr float) <- get first, number-data
- 749   # args->right->left->value
- 750   var right-ah/eax: (addr handle cell) <- get args, right
- 751   var right/eax: (addr cell) <- lookup *right-ah
- 752   # TODO: check that right is a pair
- 753   var second-ah/eax: (addr handle cell) <- get right, left
- 754   var second/eax: (addr cell) <- lookup *second-ah
- 755   var second-type/edx: (addr int) <- get second, type
- 756   compare *second-type, 1/number
- 757   {
- 758     break-if-=
- 759     error trace, "second arg for - is not a number"
- 760     return
- 761   }
- 762   var second-value/edx: (addr float) <- get second, number-data
- 763   # subtract
- 764   var result/xmm0: float <- copy *first-value
- 765   result <- subtract *second-value
- 766   new-float out, result
- 767 }
- 768 
- 769 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 770   trace-text trace, "eval", "apply *"
- 771   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 772   var _args/eax: (addr cell) <- lookup *args-ah
- 773   var args/esi: (addr cell) <- copy _args
- 774   # TODO: check that args is a pair
- 775   var empty-args?/eax: boolean <- nil? args
- 776   compare empty-args?, 0/false
- 777   {
- 778     break-if-=
- 779     error trace, "* needs 2 args but got 0"
- 780     return
- 781   }
- 782   # args->left->value
- 783   var first-ah/eax: (addr handle cell) <- get args, left
- 784   var first/eax: (addr cell) <- lookup *first-ah
- 785   var first-type/ecx: (addr int) <- get first, type
- 786   compare *first-type, 1/number
+ 748   # args->left->value
+ 749   var first-ah/eax: (addr handle cell) <- get args, left
+ 750   var first/eax: (addr cell) <- lookup *first-ah
+ 751   var first-type/ecx: (addr int) <- get first, type
+ 752   compare *first-type, 1/number
+ 753   {
+ 754     break-if-=
+ 755     error trace, "first arg for - is not a number"
+ 756     return
+ 757   }
+ 758   var first-value/ecx: (addr float) <- get first, number-data
+ 759   # args->right->left->value
+ 760   var right-ah/eax: (addr handle cell) <- get args, right
+ 761   var right/eax: (addr cell) <- lookup *right-ah
+ 762   # TODO: check that right is a pair
+ 763   var second-ah/eax: (addr handle cell) <- get right, left
+ 764   var second/eax: (addr cell) <- lookup *second-ah
+ 765   var second-type/edx: (addr int) <- get second, type
+ 766   compare *second-type, 1/number
+ 767   {
+ 768     break-if-=
+ 769     error trace, "second arg for - is not a number"
+ 770     return
+ 771   }
+ 772   var second-value/edx: (addr float) <- get second, number-data
+ 773   # subtract
+ 774   var result/xmm0: float <- copy *first-value
+ 775   result <- subtract *second-value
+ 776   new-float out, result
+ 777 }
+ 778 
+ 779 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 780   trace-text trace, "eval", "apply *"
+ 781   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 782   var _args/eax: (addr cell) <- lookup *args-ah
+ 783   var args/esi: (addr cell) <- copy _args
+ 784   # TODO: check that args is a pair
+ 785   var empty-args?/eax: boolean <- nil? args
+ 786   compare empty-args?, 0/false
  787   {
  788     break-if-=
- 789     error trace, "first arg for * is not a number"
+ 789     error trace, "* needs 2 args but got 0"
  790     return
  791   }
- 792   var first-value/ecx: (addr float) <- get first, number-data
- 793   # args->right->left->value
- 794   var right-ah/eax: (addr handle cell) <- get args, right
- 795   var right/eax: (addr cell) <- lookup *right-ah
- 796   # TODO: check that right is a pair
- 797   var second-ah/eax: (addr handle cell) <- get right, left
- 798   var second/eax: (addr cell) <- lookup *second-ah
- 799   var second-type/edx: (addr int) <- get second, type
- 800   compare *second-type, 1/number
- 801   {
- 802     break-if-=
- 803     error trace, "second arg for * is not a number"
- 804     return
- 805   }
- 806   var second-value/edx: (addr float) <- get second, number-data
- 807   # multiply
- 808   var result/xmm0: float <- copy *first-value
- 809   result <- multiply *second-value
- 810   new-float out, result
- 811 }
- 812 
- 813 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 814   trace-text trace, "eval", "apply /"
- 815   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 816   var _args/eax: (addr cell) <- lookup *args-ah
- 817   var args/esi: (addr cell) <- copy _args
- 818   # TODO: check that args is a pair
- 819   var empty-args?/eax: boolean <- nil? args
- 820   compare empty-args?, 0/false
- 821   {
- 822     break-if-=
- 823     error trace, "/ needs 2 args but got 0"
- 824     return
- 825   }
- 826   # args->left->value
- 827   var first-ah/eax: (addr handle cell) <- get args, left
- 828   var first/eax: (addr cell) <- lookup *first-ah
- 829   var first-type/ecx: (addr int) <- get first, type
- 830   compare *first-type, 1/number
+ 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, "first arg for * is not a number"
+ 800     return
+ 801   }
+ 802   var first-value/ecx: (addr float) <- get first, number-data
+ 803   # args->right->left->value
+ 804   var right-ah/eax: (addr handle cell) <- get args, right
+ 805   var right/eax: (addr cell) <- lookup *right-ah
+ 806   # TODO: check that right is a pair
+ 807   var second-ah/eax: (addr handle cell) <- get right, left
+ 808   var second/eax: (addr cell) <- lookup *second-ah
+ 809   var second-type/edx: (addr int) <- get second, type
+ 810   compare *second-type, 1/number
+ 811   {
+ 812     break-if-=
+ 813     error trace, "second arg for * is not a number"
+ 814     return
+ 815   }
+ 816   var second-value/edx: (addr float) <- get second, number-data
+ 817   # multiply
+ 818   var result/xmm0: float <- copy *first-value
+ 819   result <- multiply *second-value
+ 820   new-float out, result
+ 821 }
+ 822 
+ 823 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 824   trace-text trace, "eval", "apply /"
+ 825   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 826   var _args/eax: (addr cell) <- lookup *args-ah
+ 827   var args/esi: (addr cell) <- copy _args
+ 828   # TODO: check that args is a pair
+ 829   var empty-args?/eax: boolean <- nil? args
+ 830   compare empty-args?, 0/false
  831   {
  832     break-if-=
- 833     error trace, "first arg for / is not a number"
+ 833     error trace, "/ needs 2 args but got 0"
  834     return
  835   }
- 836   var first-value/ecx: (addr float) <- get first, number-data
- 837   # args->right->left->value
- 838   var right-ah/eax: (addr handle cell) <- get args, right
- 839   var right/eax: (addr cell) <- lookup *right-ah
- 840   # TODO: check that right is a pair
- 841   var second-ah/eax: (addr handle cell) <- get right, left
- 842   var second/eax: (addr cell) <- lookup *second-ah
- 843   var second-type/edx: (addr int) <- get second, type
- 844   compare *second-type, 1/number
- 845   {
- 846     break-if-=
- 847     error trace, "second arg for / is not a number"
- 848     return
- 849   }
- 850   var second-value/edx: (addr float) <- get second, number-data
- 851   # divide
- 852   var result/xmm0: float <- copy *first-value
- 853   result <- divide *second-value
- 854   new-float out, result
- 855 }
- 856 
- 857 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 858   trace-text trace, "eval", "apply sqrt"
- 859   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 860   var _args/eax: (addr cell) <- lookup *args-ah
- 861   var args/esi: (addr cell) <- copy _args
- 862   # TODO: check that args is a pair
- 863   var empty-args?/eax: boolean <- nil? args
- 864   compare empty-args?, 0/false
- 865   {
- 866     break-if-=
- 867     error trace, "sqrt needs 1 args 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
+ 836   # args->left->value
+ 837   var first-ah/eax: (addr handle cell) <- get args, left
+ 838   var first/eax: (addr cell) <- lookup *first-ah
+ 839   var first-type/ecx: (addr int) <- get first, type
+ 840   compare *first-type, 1/number
+ 841   {
+ 842     break-if-=
+ 843     error trace, "first arg for / is not a number"
+ 844     return
+ 845   }
+ 846   var first-value/ecx: (addr float) <- get first, number-data
+ 847   # args->right->left->value
+ 848   var right-ah/eax: (addr handle cell) <- get args, right
+ 849   var right/eax: (addr cell) <- lookup *right-ah
+ 850   # TODO: check that right is a pair
+ 851   var second-ah/eax: (addr handle cell) <- get right, left
+ 852   var second/eax: (addr cell) <- lookup *second-ah
+ 853   var second-type/edx: (addr int) <- get second, type
+ 854   compare *second-type, 1/number
+ 855   {
+ 856     break-if-=
+ 857     error trace, "second arg for / is not a number"
+ 858     return
+ 859   }
+ 860   var second-value/edx: (addr float) <- get second, number-data
+ 861   # divide
+ 862   var result/xmm0: float <- copy *first-value
+ 863   result <- divide *second-value
+ 864   new-float out, result
+ 865 }
+ 866 
+ 867 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 868   trace-text trace, "eval", "apply sqrt"
+ 869   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 870   var _args/eax: (addr cell) <- lookup *args-ah
+ 871   var args/esi: (addr cell) <- copy _args
+ 872   # TODO: check that args is a pair
+ 873   var empty-args?/eax: boolean <- nil? args
+ 874   compare empty-args?, 0/false
  875   {
  876     break-if-=
- 877     error trace, "arg for sqrt is not a number"
+ 877     error trace, "sqrt needs 1 args but got 0"
  878     return
  879   }
- 880   var first-value/ecx: (addr float) <- get first, number-data
- 881   # square-root
- 882   var result/xmm0: float <- square-root *first-value
- 883   new-float out, result
- 884 }
- 885 
- 886 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 887   trace-text trace, "eval", "apply abs"
- 888   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 889   var _args/eax: (addr cell) <- lookup *args-ah
- 890   var args/esi: (addr cell) <- copy _args
- 891   # TODO: check that args is a pair
- 892   var empty-args?/eax: boolean <- nil? args
- 893   compare empty-args?, 0/false
- 894   {
- 895     break-if-=
- 896     error trace, "abs needs 1 args but got 0"
- 897     return
- 898   }
- 899   # args->left->value
- 900   var first-ah/eax: (addr handle cell) <- get args, left
- 901   var first/eax: (addr cell) <- lookup *first-ah
- 902   var first-type/ecx: (addr int) <- get first, type
- 903   compare *first-type, 1/number
+ 880   # args->left->value
+ 881   var first-ah/eax: (addr handle cell) <- get args, left
+ 882   var first/eax: (addr cell) <- lookup *first-ah
+ 883   var first-type/ecx: (addr int) <- get first, type
+ 884   compare *first-type, 1/number
+ 885   {
+ 886     break-if-=
+ 887     error trace, "arg for sqrt is not a number"
+ 888     return
+ 889   }
+ 890   var first-value/ecx: (addr float) <- get first, number-data
+ 891   # square-root
+ 892   var result/xmm0: float <- square-root *first-value
+ 893   new-float out, result
+ 894 }
+ 895 
+ 896 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 897   trace-text trace, "eval", "apply abs"
+ 898   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 899   var _args/eax: (addr cell) <- lookup *args-ah
+ 900   var args/esi: (addr cell) <- copy _args
+ 901   # TODO: check that args is a pair
+ 902   var empty-args?/eax: boolean <- nil? args
+ 903   compare empty-args?, 0/false
  904   {
  905     break-if-=
- 906     error trace, "arg for abs is not a number"
+ 906     error trace, "abs needs 1 args but got 0"
  907     return
  908   }
- 909   var first-value/ecx: (addr float) <- get first, number-data
- 910   #
- 911   var result/xmm0: float <- copy *first-value
- 912   var zero: float
- 913   compare result, zero
+ 909   # args->left->value
+ 910   var first-ah/eax: (addr handle cell) <- get args, left
+ 911   var first/eax: (addr cell) <- lookup *first-ah
+ 912   var first-type/ecx: (addr int) <- get first, type
+ 913   compare *first-type, 1/number
  914   {
- 915     break-if-float>=
- 916     var neg1/eax: int <- copy -1
- 917     var neg1-f/xmm1: float <- convert neg1
- 918     result <- multiply neg1-f
- 919   }
- 920   new-float out, result
- 921 }
- 922 
- 923 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 924   trace-text trace, "eval", "apply sgn"
- 925   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 926   var _args/eax: (addr cell) <- lookup *args-ah
- 927   var args/esi: (addr cell) <- copy _args
- 928   # TODO: check that args is a pair
- 929   var empty-args?/eax: boolean <- nil? args
- 930   compare empty-args?, 0/false
- 931   {
- 932     break-if-=
- 933     error trace, "sgn needs 1 args but got 0"
- 934     return
- 935   }
- 936   # args->left->value
- 937   var first-ah/eax: (addr handle cell) <- get args, left
- 938   var first/eax: (addr cell) <- lookup *first-ah
- 939   var first-type/ecx: (addr int) <- get first, type
- 940   compare *first-type, 1/number
+ 915     break-if-=
+ 916     error trace, "arg for abs is not a number"
+ 917     return
+ 918   }
+ 919   var first-value/ecx: (addr float) <- get first, number-data
+ 920   #
+ 921   var result/xmm0: float <- copy *first-value
+ 922   var zero: float
+ 923   compare result, zero
+ 924   {
+ 925     break-if-float>=
+ 926     var neg1/eax: int <- copy -1
+ 927     var neg1-f/xmm1: float <- convert neg1
+ 928     result <- multiply neg1-f
+ 929   }
+ 930   new-float out, result
+ 931 }
+ 932 
+ 933 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 934   trace-text trace, "eval", "apply sgn"
+ 935   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 936   var _args/eax: (addr cell) <- lookup *args-ah
+ 937   var args/esi: (addr cell) <- copy _args
+ 938   # TODO: check that args is a pair
+ 939   var empty-args?/eax: boolean <- nil? args
+ 940   compare empty-args?, 0/false
  941   {
  942     break-if-=
- 943     error trace, "arg for sgn is not a number"
+ 943     error trace, "sgn needs 1 args but got 0"
  944     return
  945   }
- 946   var first-value/ecx: (addr float) <- get first, number-data
- 947   #
- 948   var result/xmm0: float <- copy *first-value
- 949   var zero: float
- 950   $apply-sgn:core: {
- 951     compare result, zero
+ 946   # args->left->value
+ 947   var first-ah/eax: (addr handle cell) <- get args, left
+ 948   var first/eax: (addr cell) <- lookup *first-ah
+ 949   var first-type/ecx: (addr int) <- get first, type
+ 950   compare *first-type, 1/number
+ 951   {
  952     break-if-=
- 953     {
- 954       break-if-float>
- 955       var neg1/eax: int <- copy -1
- 956       result <- convert neg1
- 957       break $apply-sgn:core
- 958     }
- 959     {
- 960       break-if-float<
- 961       var one/eax: int <- copy 1
- 962       result <- convert one
- 963       break $apply-sgn:core
- 964     }
- 965   }
- 966   new-float out, result
- 967 }
- 968 
- 969 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 970   trace-text trace, "eval", "apply car"
- 971   var args-ah/eax: (addr handle cell) <- copy _args-ah
- 972   var _args/eax: (addr cell) <- lookup *args-ah
- 973   var args/esi: (addr cell) <- copy _args
- 974   # TODO: check that args is a pair
- 975   var empty-args?/eax: boolean <- nil? args
- 976   compare empty-args?, 0/false
- 977   {
- 978     break-if-=
- 979     error trace, "car needs 1 args but got 0"
- 980     return
- 981   }
- 982   # args->left
- 983   var first-ah/eax: (addr handle cell) <- get args, left
- 984   var first/eax: (addr cell) <- lookup *first-ah
- 985   var first-type/ecx: (addr int) <- get first, type
- 986   compare *first-type, 0/pair
+ 953     error trace, "arg for sgn is not a number"
+ 954     return
+ 955   }
+ 956   var first-value/ecx: (addr float) <- get first, number-data
+ 957   #
+ 958   var result/xmm0: float <- copy *first-value
+ 959   var zero: float
+ 960   $apply-sgn:core: {
+ 961     compare result, zero
+ 962     break-if-=
+ 963     {
+ 964       break-if-float>
+ 965       var neg1/eax: int <- copy -1
+ 966       result <- convert neg1
+ 967       break $apply-sgn:core
+ 968     }
+ 969     {
+ 970       break-if-float<
+ 971       var one/eax: int <- copy 1
+ 972       result <- convert one
+ 973       break $apply-sgn:core
+ 974     }
+ 975   }
+ 976   new-float out, result
+ 977 }
+ 978 
+ 979 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+ 980   trace-text trace, "eval", "apply car"
+ 981   var args-ah/eax: (addr handle cell) <- copy _args-ah
+ 982   var _args/eax: (addr cell) <- lookup *args-ah
+ 983   var args/esi: (addr cell) <- copy _args
+ 984   # TODO: check that args is a pair
+ 985   var empty-args?/eax: boolean <- nil? args
+ 986   compare empty-args?, 0/false
  987   {
  988     break-if-=
- 989     error trace, "arg for car is not a pair"
+ 989     error trace, "car needs 1 args but got 0"
  990     return
  991   }
- 992   # car
- 993   var result/eax: (addr handle cell) <- get first, left
- 994   copy-object result, out
- 995 }
- 996 
- 997 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
- 998   trace-text trace, "eval", "apply cdr"
- 999   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1000   var _args/eax: (addr cell) <- lookup *args-ah
-1001   var args/esi: (addr cell) <- copy _args
-1002   # TODO: check that args is a pair
-1003   var empty-args?/eax: boolean <- nil? args
-1004   compare empty-args?, 0/false
-1005   {
-1006     break-if-=
-1007     error trace, "cdr needs 1 args but got 0"
-1008     return
-1009   }
-1010   # args->left
-1011   var first-ah/eax: (addr handle cell) <- get args, left
-1012   var first/eax: (addr cell) <- lookup *first-ah
-1013   var first-type/ecx: (addr int) <- get first, type
-1014   compare *first-type, 0/pair
+ 992   # args->left
+ 993   var first-ah/eax: (addr handle cell) <- get args, left
+ 994   var first/eax: (addr cell) <- lookup *first-ah
+ 995   var first-type/ecx: (addr int) <- get first, type
+ 996   compare *first-type, 0/pair
+ 997   {
+ 998     break-if-=
+ 999     error trace, "arg for car is not a pair"
+1000     return
+1001   }
+1002   # car
+1003   var result/eax: (addr handle cell) <- get first, left
+1004   copy-object result, out
+1005 }
+1006 
+1007 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1008   trace-text trace, "eval", "apply cdr"
+1009   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1010   var _args/eax: (addr cell) <- lookup *args-ah
+1011   var args/esi: (addr cell) <- copy _args
+1012   # TODO: check that args is a pair
+1013   var empty-args?/eax: boolean <- nil? args
+1014   compare empty-args?, 0/false
 1015   {
 1016     break-if-=
-1017     error trace, "arg for cdr is not a pair"
+1017     error trace, "cdr needs 1 args but got 0"
 1018     return
 1019   }
-1020   # cdr
-1021   var result/eax: (addr handle cell) <- get first, right
-1022   copy-object result, out
-1023 }
-1024 
-1025 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1026   trace-text trace, "eval", "apply cons"
-1027   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1028   var _args/eax: (addr cell) <- lookup *args-ah
-1029   var args/esi: (addr cell) <- copy _args
-1030   # TODO: check that args is a pair
-1031   var empty-args?/eax: boolean <- nil? args
-1032   compare empty-args?, 0/false
-1033   {
-1034     break-if-=
-1035     error trace, "cons needs 2 args but got 0"
-1036     return
-1037   }
-1038   # args->left
-1039   var first-ah/ecx: (addr handle cell) <- get args, left
-1040   # args->right->left
-1041   var right-ah/eax: (addr handle cell) <- get args, right
-1042   var right/eax: (addr cell) <- lookup *right-ah
-1043   # TODO: check that right is a pair
-1044   var second-ah/eax: (addr handle cell) <- get right, left
-1045   # cons
-1046   new-pair out, *first-ah, *second-ah
-1047 }
-1048 
-1049 fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1050   trace-text trace, "eval", "apply '='"
-1051   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1052   var _args/eax: (addr cell) <- lookup *args-ah
-1053   var args/esi: (addr cell) <- copy _args
-1054   # TODO: check that args is a pair
-1055   var empty-args?/eax: boolean <- nil? args
-1056   compare empty-args?, 0/false
-1057   {
-1058     break-if-=
-1059     error trace, "'=' needs 2 args but got 0"
-1060     return
-1061   }
-1062   # args->left
-1063   var first-ah/ecx: (addr handle cell) <- get args, left
-1064   # args->right->left
-1065   var right-ah/eax: (addr handle cell) <- get args, right
-1066   var right/eax: (addr cell) <- lookup *right-ah
-1067   # TODO: check that right is a pair
-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-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1084   trace-text trace, "eval", "apply '<'"
-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   # TODO: check that args is a pair
-1089   var empty-args?/eax: boolean <- nil? args
-1090   compare empty-args?, 0/false
-1091   {
-1092     break-if-=
-1093     error trace, "'<' needs 2 args but got 0"
-1094     return
-1095   }
-1096   # args->left
-1097   var first-ah/ecx: (addr handle cell) <- get args, left
-1098   # args->right->left
-1099   var right-ah/eax: (addr handle cell) <- get args, right
-1100   var right/eax: (addr cell) <- lookup *right-ah
-1101   # TODO: check that right is a pair
-1102   var second-ah/edx: (addr handle cell) <- get right, left
-1103   # compare
-1104   var _first/eax: (addr cell) <- lookup *first-ah
-1105   var first/ecx: (addr cell) <- copy _first
-1106   var first-type/eax: (addr int) <- get first, type
-1107   compare *first-type, 1/number
-1108   {
-1109     break-if-=
-1110     error trace, "first arg for '<' is not a number"
-1111     return
-1112   }
-1113   var first-value/ecx: (addr float) <- get first, number-data
-1114   var first-float/xmm0: float <- copy *first-value
-1115   var second/eax: (addr cell) <- lookup *second-ah
-1116   var second-type/edx: (addr int) <- get second, type
-1117   compare *second-type, 1/number
-1118   {
-1119     break-if-=
-1120     error trace, "first arg for '<' is not a number"
-1121     return
-1122   }
-1123   var second-value/eax: (addr float) <- get second, number-data
-1124   compare first-float, *second-value
-1125   {
-1126     break-if-float<
-1127     nil out
-1128     return
-1129   }
-1130   new-integer out, 1/true
-1131 }
-1132 
-1133 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1134   trace-text trace, "eval", "apply '>'"
-1135   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1136   var _args/eax: (addr cell) <- lookup *args-ah
-1137   var args/esi: (addr cell) <- copy _args
-1138   # TODO: check that args is a pair
-1139   var empty-args?/eax: boolean <- nil? args
-1140   compare empty-args?, 0/false
-1141   {
-1142     break-if-=
-1143     error trace, "'>' needs 2 args but got 0"
-1144     return
-1145   }
-1146   # args->left
-1147   var first-ah/ecx: (addr handle cell) <- get args, left
-1148   # args->right->left
-1149   var right-ah/eax: (addr handle cell) <- get args, right
-1150   var right/eax: (addr cell) <- lookup *right-ah
-1151   # TODO: check that right is a pair
-1152   var second-ah/edx: (addr handle cell) <- get right, left
-1153   # compare
-1154   var _first/eax: (addr cell) <- lookup *first-ah
-1155   var first/ecx: (addr cell) <- copy _first
-1156   var first-type/eax: (addr int) <- get first, type
-1157   compare *first-type, 1/number
-1158   {
-1159     break-if-=
-1160     error trace, "first arg for '>' is not a number"
-1161     return
-1162   }
-1163   var first-value/ecx: (addr float) <- get first, number-data
-1164   var first-float/xmm0: float <- copy *first-value
-1165   var second/eax: (addr cell) <- lookup *second-ah
-1166   var second-type/edx: (addr int) <- get second, type
-1167   compare *second-type, 1/number
-1168   {
-1169     break-if-=
-1170     error trace, "first arg for '>' is not a number"
-1171     return
-1172   }
-1173   var second-value/eax: (addr float) <- get second, number-data
-1174   compare first-float, *second-value
-1175   {
-1176     break-if-float>
-1177     nil out
-1178     return
-1179   }
-1180   new-integer out, 1/true
-1181 }
-1182 
-1183 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1184   trace-text trace, "eval", "apply '<='"
-1185   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1186   var _args/eax: (addr cell) <- lookup *args-ah
-1187   var args/esi: (addr cell) <- copy _args
-1188   # TODO: check that args is a pair
-1189   var empty-args?/eax: boolean <- nil? args
-1190   compare empty-args?, 0/false
-1191   {
-1192     break-if-=
-1193     error trace, "'<=' needs 2 args but got 0"
-1194     return
-1195   }
-1196   # args->left
-1197   var first-ah/ecx: (addr handle cell) <- get args, left
-1198   # args->right->left
-1199   var right-ah/eax: (addr handle cell) <- get args, right
-1200   var right/eax: (addr cell) <- lookup *right-ah
-1201   # TODO: check that right is a pair
-1202   var second-ah/edx: (addr handle cell) <- get right, left
-1203   # compare
-1204   var _first/eax: (addr cell) <- lookup *first-ah
-1205   var first/ecx: (addr cell) <- copy _first
-1206   var first-type/eax: (addr int) <- get first, type
-1207   compare *first-type, 1/number
-1208   {
-1209     break-if-=
-1210     error trace, "first arg for '<=' is not a number"
-1211     return
-1212   }
-1213   var first-value/ecx: (addr float) <- get first, number-data
-1214   var first-float/xmm0: float <- copy *first-value
-1215   var second/eax: (addr cell) <- lookup *second-ah
-1216   var second-type/edx: (addr int) <- get second, type
-1217   compare *second-type, 1/number
-1218   {
-1219     break-if-=
-1220     error trace, "first arg for '<=' is not a number"
-1221     return
-1222   }
-1223   var second-value/eax: (addr float) <- get second, number-data
-1224   compare first-float, *second-value
-1225   {
-1226     break-if-float<=
-1227     nil out
-1228     return
-1229   }
-1230   new-integer out, 1/true
-1231 }
-1232 
-1233 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1234   trace-text trace, "eval", "apply '>='"
-1235   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1236   var _args/eax: (addr cell) <- lookup *args-ah
-1237   var args/esi: (addr cell) <- copy _args
-1238   # TODO: check that args is a pair
-1239   var empty-args?/eax: boolean <- nil? args
-1240   compare empty-args?, 0/false
-1241   {
-1242     break-if-=
-1243     error trace, "'>=' needs 2 args but got 0"
-1244     return
-1245   }
-1246   # args->left
-1247   var first-ah/ecx: (addr handle cell) <- get args, left
-1248   # args->right->left
-1249   var right-ah/eax: (addr handle cell) <- get args, right
-1250   var right/eax: (addr cell) <- lookup *right-ah
-1251   # TODO: check that right is a pair
-1252   var second-ah/edx: (addr handle cell) <- get right, left
-1253   # compare
-1254   var _first/eax: (addr cell) <- lookup *first-ah
-1255   var first/ecx: (addr cell) <- copy _first
-1256   var first-type/eax: (addr int) <- get first, type
-1257   compare *first-type, 1/number
-1258   {
-1259     break-if-=
-1260     error trace, "first arg for '>=' is not a number"
-1261     return
-1262   }
-1263   var first-value/ecx: (addr float) <- get first, number-data
-1264   var first-float/xmm0: float <- copy *first-value
-1265   var second/eax: (addr cell) <- lookup *second-ah
-1266   var second-type/edx: (addr int) <- get second, type
-1267   compare *second-type, 1/number
-1268   {
-1269     break-if-=
-1270     error trace, "first arg for '>=' is not a number"
-1271     return
-1272   }
-1273   var second-value/eax: (addr float) <- get second, number-data
-1274   compare first-float, *second-value
-1275   {
-1276     break-if-float>=
-1277     nil out
-1278     return
-1279   }
-1280   new-integer out, 1/true
-1281 }
-1282 
-1283 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1284   trace-text trace, "eval", "apply print"
-1285   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1286   var _args/eax: (addr cell) <- lookup *args-ah
-1287   var args/esi: (addr cell) <- copy _args
-1288   # TODO: check that args is a pair
-1289   var empty-args?/eax: boolean <- nil? args
-1290   compare empty-args?, 0/false
-1291   {
-1292     break-if-=
-1293     error trace, "print needs 2 args but got 0"
-1294     return
-1295   }
-1296   # screen = args->left
-1297   var first-ah/eax: (addr handle cell) <- get args, left
-1298   var first/eax: (addr cell) <- lookup *first-ah
-1299   var first-type/ecx: (addr int) <- get first, type
-1300   compare *first-type, 5/screen
-1301   {
-1302     break-if-=
-1303     error trace, "first arg for 'print' is not a screen"
-1304     return
-1305   }
-1306   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1307   var _screen/eax: (addr screen) <- lookup *screen-ah
-1308   var screen/ecx: (addr screen) <- copy _screen
-1309   # args->right->left
-1310   var right-ah/eax: (addr handle cell) <- get args, right
-1311   var right/eax: (addr cell) <- lookup *right-ah
-1312   # TODO: check that right is a pair
-1313   var second-ah/eax: (addr handle cell) <- get right, left
-1314   var stream-storage: (stream byte 0x100)
-1315   var stream/edi: (addr stream byte) <- address stream-storage
-1316   print-cell second-ah, stream, trace
-1317   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
-1318   # return what was printed
-1319   copy-object second-ah, out
-1320 }
-1321 
-1322 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1323   trace-text trace, "eval", "apply clear"
-1324   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1325   var _args/eax: (addr cell) <- lookup *args-ah
-1326   var args/esi: (addr cell) <- copy _args
-1327   # TODO: check that args is a pair
-1328   var empty-args?/eax: boolean <- nil? args
-1329   compare empty-args?, 0/false
-1330   {
-1331     break-if-=
-1332     error trace, "'clear' needs 1 arg but got 0"
-1333     return
-1334   }
-1335   # screen = args->left
-1336   var first-ah/eax: (addr handle cell) <- get args, left
-1337   var first/eax: (addr cell) <- lookup *first-ah
-1338   var first-type/ecx: (addr int) <- get first, type
-1339   compare *first-type, 5/screen
-1340   {
-1341     break-if-=
-1342     error trace, "first arg for 'clear' is not a screen"
-1343     return
-1344   }
-1345   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1346   var _screen/eax: (addr screen) <- lookup *screen-ah
-1347   var screen/ecx: (addr screen) <- copy _screen
-1348   #
-1349   clear-screen screen
-1350 }
-1351 
-1352 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1353   trace-text trace, "eval", "apply up"
-1354   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1355   var _args/eax: (addr cell) <- lookup *args-ah
-1356   var args/esi: (addr cell) <- copy _args
-1357   # TODO: check that args is a pair
-1358   var empty-args?/eax: boolean <- nil? args
-1359   compare empty-args?, 0/false
-1360   {
-1361     break-if-=
-1362     error trace, "'up' needs 1 arg but got 0"
-1363     return
-1364   }
-1365   # screen = args->left
-1366   var first-ah/eax: (addr handle cell) <- get args, left
-1367   var first/eax: (addr cell) <- lookup *first-ah
-1368   var first-type/ecx: (addr int) <- get first, type
-1369   compare *first-type, 5/screen
-1370   {
-1371     break-if-=
-1372     error trace, "first arg for 'up' is not a screen"
-1373     return
-1374   }
-1375   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1376   var _screen/eax: (addr screen) <- lookup *screen-ah
-1377   var screen/ecx: (addr screen) <- copy _screen
-1378   #
-1379   move-cursor-up screen
-1380 }
-1381 
-1382 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1383   trace-text trace, "eval", "apply 'down'"
-1384   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1385   var _args/eax: (addr cell) <- lookup *args-ah
-1386   var args/esi: (addr cell) <- copy _args
-1387   # TODO: check that args is a pair
-1388   var empty-args?/eax: boolean <- nil? args
-1389   compare empty-args?, 0/false
-1390   {
-1391     break-if-=
-1392     error trace, "'down' needs 1 arg but got 0"
-1393     return
-1394   }
-1395   # screen = args->left
-1396   var first-ah/eax: (addr handle cell) <- get args, left
-1397   var first/eax: (addr cell) <- lookup *first-ah
-1398   var first-type/ecx: (addr int) <- get first, type
-1399   compare *first-type, 5/screen
-1400   {
-1401     break-if-=
-1402     error trace, "first arg for 'down' is not a screen"
-1403     return
-1404   }
-1405   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1406   var _screen/eax: (addr screen) <- lookup *screen-ah
-1407   var screen/ecx: (addr screen) <- copy _screen
-1408   #
-1409   move-cursor-down screen
-1410 }
-1411 
-1412 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1413   trace-text trace, "eval", "apply 'left'"
-1414   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1415   var _args/eax: (addr cell) <- lookup *args-ah
-1416   var args/esi: (addr cell) <- copy _args
-1417   # TODO: check that args is a pair
-1418   var empty-args?/eax: boolean <- nil? args
-1419   compare empty-args?, 0/false
-1420   {
-1421     break-if-=
-1422     error trace, "'left' needs 1 arg but got 0"
-1423     return
-1424   }
-1425   # screen = args->left
-1426   var first-ah/eax: (addr handle cell) <- get args, left
-1427   var first/eax: (addr cell) <- lookup *first-ah
-1428   var first-type/ecx: (addr int) <- get first, type
-1429   compare *first-type, 5/screen
-1430   {
-1431     break-if-=
-1432     error trace, "first arg for 'left' is not a screen"
-1433     return
-1434   }
-1435   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1436   var _screen/eax: (addr screen) <- lookup *screen-ah
-1437   var screen/ecx: (addr screen) <- copy _screen
-1438   #
-1439   move-cursor-left screen
-1440 }
-1441 
-1442 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1443   trace-text trace, "eval", "apply 'right'"
-1444   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1445   var _args/eax: (addr cell) <- lookup *args-ah
-1446   var args/esi: (addr cell) <- copy _args
-1447   # TODO: check that args is a pair
-1448   var empty-args?/eax: boolean <- nil? args
-1449   compare empty-args?, 0/false
-1450   {
-1451     break-if-=
-1452     error trace, "'right' needs 1 arg but got 0"
-1453     return
-1454   }
-1455   # screen = args->left
-1456   var first-ah/eax: (addr handle cell) <- get args, left
-1457   var first/eax: (addr cell) <- lookup *first-ah
-1458   var first-type/ecx: (addr int) <- get first, type
-1459   compare *first-type, 5/screen
-1460   {
-1461     break-if-=
-1462     error trace, "first arg for 'right' is not a screen"
-1463     return
-1464   }
-1465   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1466   var _screen/eax: (addr screen) <- lookup *screen-ah
-1467   var screen/ecx: (addr screen) <- copy _screen
-1468   #
-1469   move-cursor-right screen
-1470 }
-1471 
-1472 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1473   trace-text trace, "eval", "apply 'cr'"
-1474   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1475   var _args/eax: (addr cell) <- lookup *args-ah
-1476   var args/esi: (addr cell) <- copy _args
-1477   # TODO: check that args is a pair
-1478   var empty-args?/eax: boolean <- nil? args
-1479   compare empty-args?, 0/false
-1480   {
-1481     break-if-=
-1482     error trace, "'cr' needs 1 arg but got 0"
-1483     return
-1484   }
-1485   # screen = args->left
-1486   var first-ah/eax: (addr handle cell) <- get args, left
-1487   var first/eax: (addr cell) <- lookup *first-ah
-1488   var first-type/ecx: (addr int) <- get first, type
-1489   compare *first-type, 5/screen
-1490   {
-1491     break-if-=
-1492     error trace, "first arg for 'cr' is not a screen"
-1493     return
-1494   }
-1495   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1496   var _screen/eax: (addr screen) <- lookup *screen-ah
-1497   var screen/ecx: (addr screen) <- copy _screen
-1498   #
-1499   move-cursor-to-left-margin-of-next-line screen
-1500 }
-1501 
-1502 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1503   trace-text trace, "eval", "apply pixel"
-1504   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1505   var _args/eax: (addr cell) <- lookup *args-ah
-1506   var args/esi: (addr cell) <- copy _args
-1507   # TODO: check that args is a pair
-1508   var empty-args?/eax: boolean <- nil? args
-1509   compare empty-args?, 0/false
-1510   {
-1511     break-if-=
-1512     error trace, "pixel needs 4 args but got 0"
-1513     return
-1514   }
-1515   # screen = args->left
-1516   var first-ah/eax: (addr handle cell) <- get args, left
-1517   var first/eax: (addr cell) <- lookup *first-ah
-1518   var first-type/ecx: (addr int) <- get first, type
-1519   compare *first-type, 5/screen
-1520   {
-1521     break-if-=
-1522     error trace, "first arg for 'pixel' is not a screen"
-1523     return
-1524   }
-1525   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1526   var _screen/eax: (addr screen) <- lookup *screen-ah
-1527   var screen/edi: (addr screen) <- copy _screen
-1528   # x = args->right->left->value
-1529   var rest-ah/eax: (addr handle cell) <- get args, right
-1530   var _rest/eax: (addr cell) <- lookup *rest-ah
-1531   var rest/esi: (addr cell) <- copy _rest
-1532   # TODO: check that rest is a pair
-1533   var second-ah/eax: (addr handle cell) <- get rest, left
-1534   var second/eax: (addr cell) <- lookup *second-ah
-1535   var second-type/ecx: (addr int) <- get second, type
-1536   compare *second-type, 1/number
-1537   {
-1538     break-if-=
-1539     error trace, "second arg for 'pixel' is not an int (x coordinate)"
-1540     return
-1541   }
-1542   var second-value/eax: (addr float) <- get second, number-data
-1543   var x/edx: int <- convert *second-value
-1544   # y = rest->right->left->value
-1545   var rest-ah/eax: (addr handle cell) <- get rest, right
-1546   var _rest/eax: (addr cell) <- lookup *rest-ah
-1547   rest <- copy _rest
-1548   # TODO: check that rest is a pair
-1549   var third-ah/eax: (addr handle cell) <- get rest, left
-1550   var third/eax: (addr cell) <- lookup *third-ah
-1551   var third-type/ecx: (addr int) <- get third, type
-1552   compare *third-type, 1/number
-1553   {
-1554     break-if-=
-1555     error trace, "third arg for 'pixel' is not an int (y coordinate)"
-1556     return
-1557   }
-1558   var third-value/eax: (addr float) <- get third, number-data
-1559   var y/ebx: int <- convert *third-value
-1560   # color = rest->right->left->value
-1561   var rest-ah/eax: (addr handle cell) <- get rest, right
-1562   var _rest/eax: (addr cell) <- lookup *rest-ah
-1563   rest <- copy _rest
-1564   # TODO: check that rest is a pair
-1565   var fourth-ah/eax: (addr handle cell) <- get rest, left
-1566   var fourth/eax: (addr cell) <- lookup *fourth-ah
-1567   var fourth-type/ecx: (addr int) <- get fourth, type
-1568   compare *fourth-type, 1/number
-1569   {
-1570     break-if-=
-1571     error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)"
-1572     return
-1573   }
-1574   var fourth-value/eax: (addr float) <- get fourth, number-data
-1575   var color/eax: int <- convert *fourth-value
-1576   pixel screen, x, y, color
-1577   # return nothing
-1578 }
-1579 
-1580 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1581   trace-text trace, "eval", "apply key"
-1582   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1583   var _args/eax: (addr cell) <- lookup *args-ah
-1584   var args/esi: (addr cell) <- copy _args
-1585   # TODO: check that args is a pair
-1586   var empty-args?/eax: boolean <- nil? args
-1587   compare empty-args?, 0/false
-1588   {
-1589     break-if-=
-1590     error trace, "key needs 1 arg but got 0"
-1591     return
-1592   }
-1593   # keyboard = args->left
-1594   var first-ah/eax: (addr handle cell) <- get args, left
-1595   var first/eax: (addr cell) <- lookup *first-ah
-1596   var first-type/ecx: (addr int) <- get first, type
-1597   compare *first-type, 6/keyboard
-1598   {
-1599     break-if-=
-1600     error trace, "first arg for 'key' is not a keyboard"
-1601     return
-1602   }
-1603   var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
-1604   var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
-1605   var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
-1606   var result/eax: int <- wait-for-key keyboard
-1607   # return key typed
-1608   new-integer out, result
-1609 }
-1610 
-1611 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
-1612   # if keyboard is 0, use real keyboard
-1613   {
-1614     compare keyboard, 0/real-keyboard
-1615     break-if-!=
-1616     var key/eax: byte <- read-key 0/real-keyboard
-1617     var result/eax: int <- copy key
-1618     return result
-1619   }
-1620   # otherwise read from fake keyboard
-1621   var g/eax: grapheme <- read-from-gap-buffer keyboard
-1622   var result/eax: int <- copy g
-1623   return result
-1624 }
-1625 
-1626 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1627   trace-text trace, "eval", "apply stream"
-1628   allocate-stream out
-1629 }
-1630 
-1631 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1632   trace-text trace, "eval", "apply write"
-1633   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1634   var _args/eax: (addr cell) <- lookup *args-ah
-1635   var args/esi: (addr cell) <- copy _args
-1636   # TODO: check that args is a pair
-1637   var empty-args?/eax: boolean <- nil? args
-1638   compare empty-args?, 0/false
-1639   {
-1640     break-if-=
-1641     error trace, "write needs 2 args but got 0"
-1642     return
-1643   }
-1644   # stream = args->left
-1645   var first-ah/edx: (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, 3/stream
-1649   {
-1650     break-if-=
-1651     error trace, "first arg for 'write' is not a stream"
-1652     return
-1653   }
-1654   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
-1655   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
-1656   var stream-data/ebx: (addr stream byte) <- copy _stream-data
-1657   # args->right->left
-1658   var right-ah/eax: (addr handle cell) <- get args, right
-1659   var right/eax: (addr cell) <- lookup *right-ah
-1660   # TODO: check that right is a pair
-1661   var second-ah/eax: (addr handle cell) <- get right, left
-1662   var second/eax: (addr cell) <- lookup *second-ah
-1663   var second-type/ecx: (addr int) <- get second, type
-1664   compare *second-type, 1/number
-1665   {
-1666     break-if-=
-1667     error trace, "second arg for stream is not a number/grapheme"
-1668     return
-1669   }
-1670   var second-value/eax: (addr float) <- get second, number-data
-1671   var x-float/xmm0: float <- copy *second-value
-1672   var x/eax: int <- convert x-float
-1673   var x-grapheme/eax: grapheme <- copy x
-1674   write-grapheme stream-data, x-grapheme
-1675   # return the stream
-1676   copy-object first-ah, out
-1677 }
-1678 
-1679 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1680   trace-text trace, "eval", "apply lines"
-1681   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1682   var _args/eax: (addr cell) <- lookup *args-ah
-1683   var args/esi: (addr cell) <- copy _args
-1684   # TODO: check that args is a pair
-1685   var empty-args?/eax: boolean <- nil? args
-1686   compare empty-args?, 0/false
-1687   {
-1688     break-if-=
-1689     error trace, "lines needs 1 arg but got 0"
-1690     return
-1691   }
-1692   # screen = args->left
-1693   var first-ah/eax: (addr handle cell) <- get args, left
-1694   var first/eax: (addr cell) <- lookup *first-ah
-1695   var first-type/ecx: (addr int) <- get first, type
-1696   compare *first-type, 5/screen
-1697   {
-1698     break-if-=
-1699     error trace, "first arg for 'lines' is not a screen"
-1700     return
-1701   }
-1702   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1703   var _screen/eax: (addr screen) <- lookup *screen-ah
-1704   var screen/edx: (addr screen) <- copy _screen
-1705   # compute dimensions
-1706   var dummy/eax: int <- copy 0
-1707   var height/ecx: int <- copy 0
-1708   dummy, height <- screen-size screen
-1709   var result/xmm0: float <- convert height
-1710   new-float out, result
-1711 }
-1712 
-1713 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1714   abort "aa"
-1715 }
-1716 
-1717 fn apply-life _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1718   life
-1719 }
-1720 
-1721 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1722   trace-text trace, "eval", "apply columns"
-1723   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1724   var _args/eax: (addr cell) <- lookup *args-ah
-1725   var args/esi: (addr cell) <- copy _args
-1726   # TODO: check that args is a pair
-1727   var empty-args?/eax: boolean <- nil? args
-1728   compare empty-args?, 0/false
-1729   {
-1730     break-if-=
-1731     error trace, "columns needs 1 arg but got 0"
-1732     return
-1733   }
-1734   # screen = args->left
-1735   var first-ah/eax: (addr handle cell) <- get args, left
-1736   var first/eax: (addr cell) <- lookup *first-ah
-1737   var first-type/ecx: (addr int) <- get first, type
-1738   compare *first-type, 5/screen
-1739   {
-1740     break-if-=
-1741     error trace, "first arg for 'columns' is not a screen"
-1742     return
-1743   }
-1744   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1745   var _screen/eax: (addr screen) <- lookup *screen-ah
-1746   var screen/edx: (addr screen) <- copy _screen
-1747   # compute dimensions
-1748   var width/eax: int <- copy 0
-1749   var dummy/ecx: int <- copy 0
-1750   width, dummy <- screen-size screen
-1751   var result/xmm0: float <- convert width
-1752   new-float out, result
-1753 }
-1754 
-1755 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1756   trace-text trace, "eval", "apply width"
-1757   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1758   var _args/eax: (addr cell) <- lookup *args-ah
-1759   var args/esi: (addr cell) <- copy _args
-1760   # TODO: check that args is a pair
-1761   var empty-args?/eax: boolean <- nil? args
-1762   compare empty-args?, 0/false
-1763   {
-1764     break-if-=
-1765     error trace, "width needs 1 arg but got 0"
-1766     return
-1767   }
-1768   # screen = args->left
-1769   var first-ah/eax: (addr handle cell) <- get args, left
-1770   var first/eax: (addr cell) <- lookup *first-ah
-1771   var first-type/ecx: (addr int) <- get first, type
-1772   compare *first-type, 5/screen
-1773   {
-1774     break-if-=
-1775     error trace, "first arg for 'width' is not a screen"
-1776     return
-1777   }
-1778   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1779   var _screen/eax: (addr screen) <- lookup *screen-ah
-1780   var screen/edx: (addr screen) <- copy _screen
-1781   # compute dimensions
-1782   var width/eax: int <- copy 0
-1783   var dummy/ecx: int <- copy 0
-1784   width, dummy <- screen-size screen
-1785   width <- shift-left 3/log2-font-width
-1786   var result/xmm0: float <- convert width
-1787   new-float out, result
-1788 }
-1789 
-1790 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
-1791   trace-text trace, "eval", "apply height"
-1792   var args-ah/eax: (addr handle cell) <- copy _args-ah
-1793   var _args/eax: (addr cell) <- lookup *args-ah
-1794   var args/esi: (addr cell) <- copy _args
-1795   # TODO: check that args is a pair
-1796   var empty-args?/eax: boolean <- nil? args
-1797   compare empty-args?, 0/false
-1798   {
-1799     break-if-=
-1800     error trace, "height needs 1 arg but got 0"
-1801     return
-1802   }
-1803   # screen = args->left
-1804   var first-ah/eax: (addr handle cell) <- get args, left
-1805   var first/eax: (addr cell) <- lookup *first-ah
-1806   var first-type/ecx: (addr int) <- get first, type
-1807   compare *first-type, 5/screen
-1808   {
-1809     break-if-=
-1810     error trace, "first arg for 'height' is not a screen"
-1811     return
-1812   }
-1813   var screen-ah/eax: (addr handle screen) <- get first, screen-data
-1814   var _screen/eax: (addr screen) <- lookup *screen-ah
-1815   var screen/edx: (addr screen) <- copy _screen
-1816   # compute dimensions
-1817   var dummy/eax: int <- copy 0
-1818   var height/ecx: int <- copy 0
-1819   dummy, height <- screen-size screen
-1820   height <- shift-left 4/log2-font-height
-1821   var result/xmm0: float <- convert height
-1822   new-float out, result
-1823 }
+1020   # args->left
+1021   var first-ah/eax: (addr handle cell) <- get args, left
+1022   var first/eax: (addr cell) <- lookup *first-ah
+1023   var first-type/ecx: (addr int) <- get first, type
+1024   compare *first-type, 0/pair
+1025   {
+1026     break-if-=
+1027     error trace, "arg for cdr is not a pair"
+1028     return
+1029   }
+1030   # cdr
+1031   var result/eax: (addr handle cell) <- get first, right
+1032   copy-object result, out
+1033 }
+1034 
+1035 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1036   trace-text trace, "eval", "apply cons"
+1037   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1038   var _args/eax: (addr cell) <- lookup *args-ah
+1039   var args/esi: (addr cell) <- copy _args
+1040   # TODO: check that args is a pair
+1041   var empty-args?/eax: boolean <- nil? args
+1042   compare empty-args?, 0/false
+1043   {
+1044     break-if-=
+1045     error trace, "cons needs 2 args but got 0"
+1046     return
+1047   }
+1048   # args->left
+1049   var first-ah/ecx: (addr handle cell) <- get args, left
+1050   # args->right->left
+1051   var right-ah/eax: (addr handle cell) <- get args, right
+1052   var right/eax: (addr cell) <- lookup *right-ah
+1053   # TODO: check that right is a pair
+1054   var second-ah/eax: (addr handle cell) <- get right, left
+1055   # cons
+1056   new-pair out, *first-ah, *second-ah
+1057 }
+1058 
+1059 fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1060   trace-text trace, "eval", "apply '='"
+1061   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1062   var _args/eax: (addr cell) <- lookup *args-ah
+1063   var args/esi: (addr cell) <- copy _args
+1064   # TODO: check that args is a pair
+1065   var empty-args?/eax: boolean <- nil? args
+1066   compare empty-args?, 0/false
+1067   {
+1068     break-if-=
+1069     error trace, "'=' needs 2 args but got 0"
+1070     return
+1071   }
+1072   # args->left
+1073   var first-ah/ecx: (addr handle cell) <- get args, left
+1074   # args->right->left
+1075   var right-ah/eax: (addr handle cell) <- get args, right
+1076   var right/eax: (addr cell) <- lookup *right-ah
+1077   # TODO: check that right is a pair
+1078   var second-ah/edx: (addr handle cell) <- get right, left
+1079   # compare
+1080   var _first/eax: (addr cell) <- lookup *first-ah
+1081   var first/ecx: (addr cell) <- copy _first
+1082   var second/eax: (addr cell) <- lookup *second-ah
+1083   var match?/eax: boolean <- cell-isomorphic? first, second, trace
+1084   compare match?, 0/false
+1085   {
+1086     break-if-!=
+1087     nil out
+1088     return
+1089   }
+1090   new-integer out, 1/true
+1091 }
+1092 
+1093 fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1094   trace-text trace, "eval", "apply not"
+1095   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1096   var _args/eax: (addr cell) <- lookup *args-ah
+1097   var args/esi: (addr cell) <- copy _args
+1098   # TODO: check that args is a pair
+1099   var empty-args?/eax: boolean <- nil? args
+1100   compare empty-args?, 0/false
+1101   {
+1102     break-if-=
+1103     error trace, "not needs 1 args but got 0"
+1104     return
+1105   }
+1106   # args->left
+1107   var first-ah/eax: (addr handle cell) <- get args, left
+1108   var first/eax: (addr cell) <- lookup *first-ah
+1109   # not
+1110   var nil?/eax: boolean <- nil? first
+1111   compare nil?, 0/false
+1112   {
+1113     break-if-!=
+1114     nil out
+1115     return
+1116   }
+1117   new-integer out, 1
+1118 }
+1119 
+1120 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1121   trace-text trace, "eval", "apply '<'"
+1122   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1123   var _args/eax: (addr cell) <- lookup *args-ah
+1124   var args/esi: (addr cell) <- copy _args
+1125   # TODO: check that args is a pair
+1126   var empty-args?/eax: boolean <- nil? args
+1127   compare empty-args?, 0/false
+1128   {
+1129     break-if-=
+1130     error trace, "'<' needs 2 args but got 0"
+1131     return
+1132   }
+1133   # args->left
+1134   var first-ah/ecx: (addr handle cell) <- get args, left
+1135   # args->right->left
+1136   var right-ah/eax: (addr handle cell) <- get args, right
+1137   var right/eax: (addr cell) <- lookup *right-ah
+1138   # TODO: check that right is a pair
+1139   var second-ah/edx: (addr handle cell) <- get right, left
+1140   # compare
+1141   var _first/eax: (addr cell) <- lookup *first-ah
+1142   var first/ecx: (addr cell) <- copy _first
+1143   var first-type/eax: (addr int) <- get first, type
+1144   compare *first-type, 1/number
+1145   {
+1146     break-if-=
+1147     error trace, "first arg for '<' is not a number"
+1148     return
+1149   }
+1150   var first-value/ecx: (addr float) <- get first, number-data
+1151   var first-float/xmm0: float <- copy *first-value
+1152   var second/eax: (addr cell) <- lookup *second-ah
+1153   var second-type/edx: (addr int) <- get second, type
+1154   compare *second-type, 1/number
+1155   {
+1156     break-if-=
+1157     error trace, "first arg for '<' is not a number"
+1158     return
+1159   }
+1160   var second-value/eax: (addr float) <- get second, number-data
+1161   compare first-float, *second-value
+1162   {
+1163     break-if-float<
+1164     nil out
+1165     return
+1166   }
+1167   new-integer out, 1/true
+1168 }
+1169 
+1170 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1171   trace-text trace, "eval", "apply '>'"
+1172   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1173   var _args/eax: (addr cell) <- lookup *args-ah
+1174   var args/esi: (addr cell) <- copy _args
+1175   # TODO: check that args is a pair
+1176   var empty-args?/eax: boolean <- nil? args
+1177   compare empty-args?, 0/false
+1178   {
+1179     break-if-=
+1180     error trace, "'>' needs 2 args but got 0"
+1181     return
+1182   }
+1183   # args->left
+1184   var first-ah/ecx: (addr handle cell) <- get args, left
+1185   # args->right->left
+1186   var right-ah/eax: (addr handle cell) <- get args, right
+1187   var right/eax: (addr cell) <- lookup *right-ah
+1188   # TODO: check that right is a pair
+1189   var second-ah/edx: (addr handle cell) <- get right, left
+1190   # compare
+1191   var _first/eax: (addr cell) <- lookup *first-ah
+1192   var first/ecx: (addr cell) <- copy _first
+1193   var first-type/eax: (addr int) <- get first, type
+1194   compare *first-type, 1/number
+1195   {
+1196     break-if-=
+1197     error trace, "first arg for '>' is not a number"
+1198     return
+1199   }
+1200   var first-value/ecx: (addr float) <- get first, number-data
+1201   var first-float/xmm0: float <- copy *first-value
+1202   var second/eax: (addr cell) <- lookup *second-ah
+1203   var second-type/edx: (addr int) <- get second, type
+1204   compare *second-type, 1/number
+1205   {
+1206     break-if-=
+1207     error trace, "first arg for '>' is not a number"
+1208     return
+1209   }
+1210   var second-value/eax: (addr float) <- get second, number-data
+1211   compare first-float, *second-value
+1212   {
+1213     break-if-float>
+1214     nil out
+1215     return
+1216   }
+1217   new-integer out, 1/true
+1218 }
+1219 
+1220 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1221   trace-text trace, "eval", "apply '<='"
+1222   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1223   var _args/eax: (addr cell) <- lookup *args-ah
+1224   var args/esi: (addr cell) <- copy _args
+1225   # TODO: check that args is a pair
+1226   var empty-args?/eax: boolean <- nil? args
+1227   compare empty-args?, 0/false
+1228   {
+1229     break-if-=
+1230     error trace, "'<=' needs 2 args but got 0"
+1231     return
+1232   }
+1233   # args->left
+1234   var first-ah/ecx: (addr handle cell) <- get args, left
+1235   # args->right->left
+1236   var right-ah/eax: (addr handle cell) <- get args, right
+1237   var right/eax: (addr cell) <- lookup *right-ah
+1238   # TODO: check that right is a pair
+1239   var second-ah/edx: (addr handle cell) <- get right, left
+1240   # compare
+1241   var _first/eax: (addr cell) <- lookup *first-ah
+1242   var first/ecx: (addr cell) <- copy _first
+1243   var first-type/eax: (addr int) <- get first, type
+1244   compare *first-type, 1/number
+1245   {
+1246     break-if-=
+1247     error trace, "first arg for '<=' is not a number"
+1248     return
+1249   }
+1250   var first-value/ecx: (addr float) <- get first, number-data
+1251   var first-float/xmm0: float <- copy *first-value
+1252   var second/eax: (addr cell) <- lookup *second-ah
+1253   var second-type/edx: (addr int) <- get second, type
+1254   compare *second-type, 1/number
+1255   {
+1256     break-if-=
+1257     error trace, "first arg for '<=' is not a number"
+1258     return
+1259   }
+1260   var second-value/eax: (addr float) <- get second, number-data
+1261   compare first-float, *second-value
+1262   {
+1263     break-if-float<=
+1264     nil out
+1265     return
+1266   }
+1267   new-integer out, 1/true
+1268 }
+1269 
+1270 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1271   trace-text trace, "eval", "apply '>='"
+1272   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1273   var _args/eax: (addr cell) <- lookup *args-ah
+1274   var args/esi: (addr cell) <- copy _args
+1275   # TODO: check that args is a pair
+1276   var empty-args?/eax: boolean <- nil? args
+1277   compare empty-args?, 0/false
+1278   {
+1279     break-if-=
+1280     error trace, "'>=' needs 2 args but got 0"
+1281     return
+1282   }
+1283   # args->left
+1284   var first-ah/ecx: (addr handle cell) <- get args, left
+1285   # args->right->left
+1286   var right-ah/eax: (addr handle cell) <- get args, right
+1287   var right/eax: (addr cell) <- lookup *right-ah
+1288   # TODO: check that right is a pair
+1289   var second-ah/edx: (addr handle cell) <- get right, left
+1290   # compare
+1291   var _first/eax: (addr cell) <- lookup *first-ah
+1292   var first/ecx: (addr cell) <- copy _first
+1293   var first-type/eax: (addr int) <- get first, type
+1294   compare *first-type, 1/number
+1295   {
+1296     break-if-=
+1297     error trace, "first arg for '>=' is not a number"
+1298     return
+1299   }
+1300   var first-value/ecx: (addr float) <- get first, number-data
+1301   var first-float/xmm0: float <- copy *first-value
+1302   var second/eax: (addr cell) <- lookup *second-ah
+1303   var second-type/edx: (addr int) <- get second, type
+1304   compare *second-type, 1/number
+1305   {
+1306     break-if-=
+1307     error trace, "first arg for '>=' is not a number"
+1308     return
+1309   }
+1310   var second-value/eax: (addr float) <- get second, number-data
+1311   compare first-float, *second-value
+1312   {
+1313     break-if-float>=
+1314     nil out
+1315     return
+1316   }
+1317   new-integer out, 1/true
+1318 }
+1319 
+1320 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1321   trace-text trace, "eval", "apply print"
+1322   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1323   var _args/eax: (addr cell) <- lookup *args-ah
+1324   var args/esi: (addr cell) <- copy _args
+1325   # TODO: check that args is a pair
+1326   var empty-args?/eax: boolean <- nil? args
+1327   compare empty-args?, 0/false
+1328   {
+1329     break-if-=
+1330     error trace, "print needs 2 args but got 0"
+1331     return
+1332   }
+1333   # screen = args->left
+1334   var first-ah/eax: (addr handle cell) <- get args, left
+1335   var first/eax: (addr cell) <- lookup *first-ah
+1336   var first-type/ecx: (addr int) <- get first, type
+1337   compare *first-type, 5/screen
+1338   {
+1339     break-if-=
+1340     error trace, "first arg for 'print' is not a screen"
+1341     return
+1342   }
+1343   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1344   var _screen/eax: (addr screen) <- lookup *screen-ah
+1345   var screen/ecx: (addr screen) <- copy _screen
+1346   # args->right->left
+1347   var right-ah/eax: (addr handle cell) <- get args, right
+1348   var right/eax: (addr cell) <- lookup *right-ah
+1349   # TODO: check that right is a pair
+1350   var second-ah/eax: (addr handle cell) <- get right, left
+1351   var stream-storage: (stream byte 0x100)
+1352   var stream/edi: (addr stream byte) <- address stream-storage
+1353   print-cell second-ah, stream, trace
+1354   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
+1355   # return what was printed
+1356   copy-object second-ah, out
+1357 }
+1358 
+1359 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1360   trace-text trace, "eval", "apply clear"
+1361   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1362   var _args/eax: (addr cell) <- lookup *args-ah
+1363   var args/esi: (addr cell) <- copy _args
+1364   # TODO: check that args is a pair
+1365   var empty-args?/eax: boolean <- nil? args
+1366   compare empty-args?, 0/false
+1367   {
+1368     break-if-=
+1369     error trace, "'clear' needs 1 arg but got 0"
+1370     return
+1371   }
+1372   # screen = args->left
+1373   var first-ah/eax: (addr handle cell) <- get args, left
+1374   var first/eax: (addr cell) <- lookup *first-ah
+1375   var first-type/ecx: (addr int) <- get first, type
+1376   compare *first-type, 5/screen
+1377   {
+1378     break-if-=
+1379     error trace, "first arg for 'clear' is not a screen"
+1380     return
+1381   }
+1382   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1383   var _screen/eax: (addr screen) <- lookup *screen-ah
+1384   var screen/ecx: (addr screen) <- copy _screen
+1385   #
+1386   clear-screen screen
+1387 }
+1388 
+1389 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1390   trace-text trace, "eval", "apply up"
+1391   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1392   var _args/eax: (addr cell) <- lookup *args-ah
+1393   var args/esi: (addr cell) <- copy _args
+1394   # TODO: check that args is a pair
+1395   var empty-args?/eax: boolean <- nil? args
+1396   compare empty-args?, 0/false
+1397   {
+1398     break-if-=
+1399     error trace, "'up' needs 1 arg but got 0"
+1400     return
+1401   }
+1402   # screen = args->left
+1403   var first-ah/eax: (addr handle cell) <- get args, left
+1404   var first/eax: (addr cell) <- lookup *first-ah
+1405   var first-type/ecx: (addr int) <- get first, type
+1406   compare *first-type, 5/screen
+1407   {
+1408     break-if-=
+1409     error trace, "first arg for 'up' is not a screen"
+1410     return
+1411   }
+1412   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1413   var _screen/eax: (addr screen) <- lookup *screen-ah
+1414   var screen/ecx: (addr screen) <- copy _screen
+1415   #
+1416   move-cursor-up screen
+1417 }
+1418 
+1419 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1420   trace-text trace, "eval", "apply 'down'"
+1421   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1422   var _args/eax: (addr cell) <- lookup *args-ah
+1423   var args/esi: (addr cell) <- copy _args
+1424   # TODO: check that args is a pair
+1425   var empty-args?/eax: boolean <- nil? args
+1426   compare empty-args?, 0/false
+1427   {
+1428     break-if-=
+1429     error trace, "'down' needs 1 arg but got 0"
+1430     return
+1431   }
+1432   # screen = args->left
+1433   var first-ah/eax: (addr handle cell) <- get args, left
+1434   var first/eax: (addr cell) <- lookup *first-ah
+1435   var first-type/ecx: (addr int) <- get first, type
+1436   compare *first-type, 5/screen
+1437   {
+1438     break-if-=
+1439     error trace, "first arg for 'down' is not a screen"
+1440     return
+1441   }
+1442   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1443   var _screen/eax: (addr screen) <- lookup *screen-ah
+1444   var screen/ecx: (addr screen) <- copy _screen
+1445   #
+1446   move-cursor-down screen
+1447 }
+1448 
+1449 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1450   trace-text trace, "eval", "apply 'left'"
+1451   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1452   var _args/eax: (addr cell) <- lookup *args-ah
+1453   var args/esi: (addr cell) <- copy _args
+1454   # TODO: check that args is a pair
+1455   var empty-args?/eax: boolean <- nil? args
+1456   compare empty-args?, 0/false
+1457   {
+1458     break-if-=
+1459     error trace, "'left' needs 1 arg but got 0"
+1460     return
+1461   }
+1462   # screen = args->left
+1463   var first-ah/eax: (addr handle cell) <- get args, left
+1464   var first/eax: (addr cell) <- lookup *first-ah
+1465   var first-type/ecx: (addr int) <- get first, type
+1466   compare *first-type, 5/screen
+1467   {
+1468     break-if-=
+1469     error trace, "first arg for 'left' is not a screen"
+1470     return
+1471   }
+1472   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1473   var _screen/eax: (addr screen) <- lookup *screen-ah
+1474   var screen/ecx: (addr screen) <- copy _screen
+1475   #
+1476   move-cursor-left screen
+1477 }
+1478 
+1479 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1480   trace-text trace, "eval", "apply 'right'"
+1481   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1482   var _args/eax: (addr cell) <- lookup *args-ah
+1483   var args/esi: (addr cell) <- copy _args
+1484   # TODO: check that args is a pair
+1485   var empty-args?/eax: boolean <- nil? args
+1486   compare empty-args?, 0/false
+1487   {
+1488     break-if-=
+1489     error trace, "'right' needs 1 arg but got 0"
+1490     return
+1491   }
+1492   # screen = args->left
+1493   var first-ah/eax: (addr handle cell) <- get args, left
+1494   var first/eax: (addr cell) <- lookup *first-ah
+1495   var first-type/ecx: (addr int) <- get first, type
+1496   compare *first-type, 5/screen
+1497   {
+1498     break-if-=
+1499     error trace, "first arg for 'right' is not a screen"
+1500     return
+1501   }
+1502   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1503   var _screen/eax: (addr screen) <- lookup *screen-ah
+1504   var screen/ecx: (addr screen) <- copy _screen
+1505   #
+1506   move-cursor-right screen
+1507 }
+1508 
+1509 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1510   trace-text trace, "eval", "apply 'cr'"
+1511   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1512   var _args/eax: (addr cell) <- lookup *args-ah
+1513   var args/esi: (addr cell) <- copy _args
+1514   # TODO: check that args is a pair
+1515   var empty-args?/eax: boolean <- nil? args
+1516   compare empty-args?, 0/false
+1517   {
+1518     break-if-=
+1519     error trace, "'cr' needs 1 arg but got 0"
+1520     return
+1521   }
+1522   # screen = args->left
+1523   var first-ah/eax: (addr handle cell) <- get args, left
+1524   var first/eax: (addr cell) <- lookup *first-ah
+1525   var first-type/ecx: (addr int) <- get first, type
+1526   compare *first-type, 5/screen
+1527   {
+1528     break-if-=
+1529     error trace, "first arg for 'cr' is not a screen"
+1530     return
+1531   }
+1532   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1533   var _screen/eax: (addr screen) <- lookup *screen-ah
+1534   var screen/ecx: (addr screen) <- copy _screen
+1535   #
+1536   move-cursor-to-left-margin-of-next-line screen
+1537 }
+1538 
+1539 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1540   trace-text trace, "eval", "apply pixel"
+1541   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1542   var _args/eax: (addr cell) <- lookup *args-ah
+1543   var args/esi: (addr cell) <- copy _args
+1544   # TODO: check that args is a pair
+1545   var empty-args?/eax: boolean <- nil? args
+1546   compare empty-args?, 0/false
+1547   {
+1548     break-if-=
+1549     error trace, "pixel needs 4 args but got 0"
+1550     return
+1551   }
+1552   # screen = args->left
+1553   var first-ah/eax: (addr handle cell) <- get args, left
+1554   var first/eax: (addr cell) <- lookup *first-ah
+1555   var first-type/ecx: (addr int) <- get first, type
+1556   compare *first-type, 5/screen
+1557   {
+1558     break-if-=
+1559     error trace, "first arg for 'pixel' is not a screen"
+1560     return
+1561   }
+1562   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1563   var _screen/eax: (addr screen) <- lookup *screen-ah
+1564   var screen/edi: (addr screen) <- copy _screen
+1565   # x = args->right->left->value
+1566   var rest-ah/eax: (addr handle cell) <- get args, right
+1567   var _rest/eax: (addr cell) <- lookup *rest-ah
+1568   var rest/esi: (addr cell) <- copy _rest
+1569   # TODO: check that rest is a pair
+1570   var second-ah/eax: (addr handle cell) <- get rest, left
+1571   var second/eax: (addr cell) <- lookup *second-ah
+1572   var second-type/ecx: (addr int) <- get second, type
+1573   compare *second-type, 1/number
+1574   {
+1575     break-if-=
+1576     error trace, "second arg for 'pixel' is not an int (x coordinate)"
+1577     return
+1578   }
+1579   var second-value/eax: (addr float) <- get second, number-data
+1580   var x/edx: int <- convert *second-value
+1581   # y = rest->right->left->value
+1582   var rest-ah/eax: (addr handle cell) <- get rest, right
+1583   var _rest/eax: (addr cell) <- lookup *rest-ah
+1584   rest <- copy _rest
+1585   # TODO: check that rest is a pair
+1586   var third-ah/eax: (addr handle cell) <- get rest, left
+1587   var third/eax: (addr cell) <- lookup *third-ah
+1588   var third-type/ecx: (addr int) <- get third, type
+1589   compare *third-type, 1/number
+1590   {
+1591     break-if-=
+1592     error trace, "third arg for 'pixel' is not an int (y coordinate)"
+1593     return
+1594   }
+1595   var third-value/eax: (addr float) <- get third, number-data
+1596   var y/ebx: int <- convert *third-value
+1597   # color = rest->right->left->value
+1598   var rest-ah/eax: (addr handle cell) <- get rest, right
+1599   var _rest/eax: (addr cell) <- lookup *rest-ah
+1600   rest <- copy _rest
+1601   # TODO: check that rest is a pair
+1602   var fourth-ah/eax: (addr handle cell) <- get rest, left
+1603   var fourth/eax: (addr cell) <- lookup *fourth-ah
+1604   var fourth-type/ecx: (addr int) <- get fourth, type
+1605   compare *fourth-type, 1/number
+1606   {
+1607     break-if-=
+1608     error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)"
+1609     return
+1610   }
+1611   var fourth-value/eax: (addr float) <- get fourth, number-data
+1612   var color/eax: int <- convert *fourth-value
+1613   pixel screen, x, y, color
+1614   # return nothing
+1615 }
+1616 
+1617 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1618   trace-text trace, "eval", "apply key"
+1619   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1620   var _args/eax: (addr cell) <- lookup *args-ah
+1621   var args/esi: (addr cell) <- copy _args
+1622   # TODO: check that args is a pair
+1623   var empty-args?/eax: boolean <- nil? args
+1624   compare empty-args?, 0/false
+1625   {
+1626     break-if-=
+1627     error trace, "key needs 1 arg but got 0"
+1628     return
+1629   }
+1630   # keyboard = args->left
+1631   var first-ah/eax: (addr handle cell) <- get args, left
+1632   var first/eax: (addr cell) <- lookup *first-ah
+1633   var first-type/ecx: (addr int) <- get first, type
+1634   compare *first-type, 6/keyboard
+1635   {
+1636     break-if-=
+1637     error trace, "first arg for 'key' is not a keyboard"
+1638     return
+1639   }
+1640   var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
+1641   var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
+1642   var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
+1643   var result/eax: int <- wait-for-key keyboard
+1644   # return key typed
+1645   new-integer out, result
+1646 }
+1647 
+1648 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
+1649   # if keyboard is 0, use real keyboard
+1650   {
+1651     compare keyboard, 0/real-keyboard
+1652     break-if-!=
+1653     var key/eax: byte <- read-key 0/real-keyboard
+1654     var result/eax: int <- copy key
+1655     return result
+1656   }
+1657   # otherwise read from fake keyboard
+1658   var g/eax: grapheme <- read-from-gap-buffer keyboard
+1659   var result/eax: int <- copy g
+1660   return result
+1661 }
+1662 
+1663 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1664   trace-text trace, "eval", "apply stream"
+1665   allocate-stream out
+1666 }
+1667 
+1668 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1669   trace-text trace, "eval", "apply write"
+1670   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1671   var _args/eax: (addr cell) <- lookup *args-ah
+1672   var args/esi: (addr cell) <- copy _args
+1673   # TODO: check that args is a pair
+1674   var empty-args?/eax: boolean <- nil? args
+1675   compare empty-args?, 0/false
+1676   {
+1677     break-if-=
+1678     error trace, "write needs 2 args but got 0"
+1679     return
+1680   }
+1681   # stream = args->left
+1682   var first-ah/edx: (addr handle cell) <- get args, left
+1683   var first/eax: (addr cell) <- lookup *first-ah
+1684   var first-type/ecx: (addr int) <- get first, type
+1685   compare *first-type, 3/stream
+1686   {
+1687     break-if-=
+1688     error trace, "first arg for 'write' is not a stream"
+1689     return
+1690   }
+1691   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
+1692   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
+1693   var stream-data/ebx: (addr stream byte) <- copy _stream-data
+1694   # args->right->left
+1695   var right-ah/eax: (addr handle cell) <- get args, right
+1696   var right/eax: (addr cell) <- lookup *right-ah
+1697   # TODO: check that right is a pair
+1698   var second-ah/eax: (addr handle cell) <- get right, left
+1699   var second/eax: (addr cell) <- lookup *second-ah
+1700   var second-type/ecx: (addr int) <- get second, type
+1701   compare *second-type, 1/number
+1702   {
+1703     break-if-=
+1704     error trace, "second arg for stream is not a number/grapheme"
+1705     return
+1706   }
+1707   var second-value/eax: (addr float) <- get second, number-data
+1708   var x-float/xmm0: float <- copy *second-value
+1709   var x/eax: int <- convert x-float
+1710   var x-grapheme/eax: grapheme <- copy x
+1711   write-grapheme stream-data, x-grapheme
+1712   # return the stream
+1713   copy-object first-ah, out
+1714 }
+1715 
+1716 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1717   trace-text trace, "eval", "apply lines"
+1718   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1719   var _args/eax: (addr cell) <- lookup *args-ah
+1720   var args/esi: (addr cell) <- copy _args
+1721   # TODO: check that args is a pair
+1722   var empty-args?/eax: boolean <- nil? args
+1723   compare empty-args?, 0/false
+1724   {
+1725     break-if-=
+1726     error trace, "lines needs 1 arg but got 0"
+1727     return
+1728   }
+1729   # screen = args->left
+1730   var first-ah/eax: (addr handle cell) <- get args, left
+1731   var first/eax: (addr cell) <- lookup *first-ah
+1732   var first-type/ecx: (addr int) <- get first, type
+1733   compare *first-type, 5/screen
+1734   {
+1735     break-if-=
+1736     error trace, "first arg for 'lines' is not a screen"
+1737     return
+1738   }
+1739   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1740   var _screen/eax: (addr screen) <- lookup *screen-ah
+1741   var screen/edx: (addr screen) <- copy _screen
+1742   # compute dimensions
+1743   var dummy/eax: int <- copy 0
+1744   var height/ecx: int <- copy 0
+1745   dummy, height <- screen-size screen
+1746   var result/xmm0: float <- convert height
+1747   new-float out, result
+1748 }
+1749 
+1750 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1751   abort "aa"
+1752 }
+1753 
+1754 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1755   trace-text trace, "eval", "apply columns"
+1756   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1757   var _args/eax: (addr cell) <- lookup *args-ah
+1758   var args/esi: (addr cell) <- copy _args
+1759   # TODO: check that args is a pair
+1760   var empty-args?/eax: boolean <- nil? args
+1761   compare empty-args?, 0/false
+1762   {
+1763     break-if-=
+1764     error trace, "columns needs 1 arg but got 0"
+1765     return
+1766   }
+1767   # screen = args->left
+1768   var first-ah/eax: (addr handle cell) <- get args, left
+1769   var first/eax: (addr cell) <- lookup *first-ah
+1770   var first-type/ecx: (addr int) <- get first, type
+1771   compare *first-type, 5/screen
+1772   {
+1773     break-if-=
+1774     error trace, "first arg for 'columns' is not a screen"
+1775     return
+1776   }
+1777   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1778   var _screen/eax: (addr screen) <- lookup *screen-ah
+1779   var screen/edx: (addr screen) <- copy _screen
+1780   # compute dimensions
+1781   var width/eax: int <- copy 0
+1782   var dummy/ecx: int <- copy 0
+1783   width, dummy <- screen-size screen
+1784   var result/xmm0: float <- convert width
+1785   new-float out, result
+1786 }
+1787 
+1788 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1789   trace-text trace, "eval", "apply width"
+1790   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1791   var _args/eax: (addr cell) <- lookup *args-ah
+1792   var args/esi: (addr cell) <- copy _args
+1793   # TODO: check that args is a pair
+1794   var empty-args?/eax: boolean <- nil? args
+1795   compare empty-args?, 0/false
+1796   {
+1797     break-if-=
+1798     error trace, "width needs 1 arg but got 0"
+1799     return
+1800   }
+1801   # screen = args->left
+1802   var first-ah/eax: (addr handle cell) <- get args, left
+1803   var first/eax: (addr cell) <- lookup *first-ah
+1804   var first-type/ecx: (addr int) <- get first, type
+1805   compare *first-type, 5/screen
+1806   {
+1807     break-if-=
+1808     error trace, "first arg for 'width' is not a screen"
+1809     return
+1810   }
+1811   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1812   var _screen/eax: (addr screen) <- lookup *screen-ah
+1813   var screen/edx: (addr screen) <- copy _screen
+1814   # compute dimensions
+1815   var width/eax: int <- copy 0
+1816   var dummy/ecx: int <- copy 0
+1817   width, dummy <- screen-size screen
+1818   width <- shift-left 3/log2-font-width
+1819   var result/xmm0: float <- convert width
+1820   new-float out, result
+1821 }
+1822 
+1823 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+1824   trace-text trace, "eval", "apply height"
+1825   var args-ah/eax: (addr handle cell) <- copy _args-ah
+1826   var _args/eax: (addr cell) <- lookup *args-ah
+1827   var args/esi: (addr cell) <- copy _args
+1828   # TODO: check that args is a pair
+1829   var empty-args?/eax: boolean <- nil? args
+1830   compare empty-args?, 0/false
+1831   {
+1832     break-if-=
+1833     error trace, "height needs 1 arg but got 0"
+1834     return
+1835   }
+1836   # screen = args->left
+1837   var first-ah/eax: (addr handle cell) <- get args, left
+1838   var first/eax: (addr cell) <- lookup *first-ah
+1839   var first-type/ecx: (addr int) <- get first, type
+1840   compare *first-type, 5/screen
+1841   {
+1842     break-if-=
+1843     error trace, "first arg for 'height' is not a screen"
+1844     return
+1845   }
+1846   var screen-ah/eax: (addr handle screen) <- get first, screen-data
+1847   var _screen/eax: (addr screen) <- lookup *screen-ah
+1848   var screen/edx: (addr screen) <- copy _screen
+1849   # compute dimensions
+1850   var dummy/eax: int <- copy 0
+1851   var height/ecx: int <- copy 0
+1852   dummy, height <- screen-size screen
+1853   height <- shift-left 4/log2-font-height
+1854   var result/xmm0: float <- convert height
+1855   new-float out, result
+1856 }
+1857 
+1858 # Accepts an input s-expression, naively checks if it is a definition, and if
+1859 # so saves the gap-buffer to the appropriate global, spinning up a new empty
+1860 # one to replace it with.
+1861 fn maybe-stash-gap-buffer-to-global _globals: (addr global-table), _definition-ah: (addr handle cell), gap: (addr handle gap-buffer) {
+1862   # if 'definition' is not a pair, return
+1863   var definition-ah/eax: (addr handle cell) <- copy _definition-ah
+1864   var _definition/eax: (addr cell) <- lookup *definition-ah
+1865   var definition/esi: (addr cell) <- copy _definition
+1866   var definition-type/eax: (addr int) <- get definition, type
+1867   compare *definition-type, 0/pair
+1868   {
+1869     break-if-=
+1870     return
+1871   }
+1872   # if definition->left is neither "def" nor "set", return
+1873   var left-ah/eax: (addr handle cell) <- get definition, left
+1874   var _left/eax: (addr cell) <- lookup *left-ah
+1875   var left/ecx: (addr cell) <- copy _left
+1876   {
+1877     var def?/eax: boolean <- symbol-equal? left, "def"
+1878     compare def?, 0/false
+1879     break-if-!=
+1880     var set?/eax: boolean <- symbol-equal? left, "set"
+1881     compare set?, 0/false
+1882     break-if-!=
+1883     return
+1884   }
+1885   # locate the global for definition->right->left
+1886   var right-ah/eax: (addr handle cell) <- get definition, right
+1887   var right/eax: (addr cell) <- lookup *right-ah
+1888   var defined-symbol-ah/eax: (addr handle cell) <- get right, left
+1889   var defined-symbol/eax: (addr cell) <- lookup *defined-symbol-ah
+1890   var defined-symbol-name-ah/eax: (addr handle stream byte) <- get defined-symbol, text-data
+1891   var defined-symbol-name/eax: (addr stream byte) <- lookup *defined-symbol-name-ah
+1892   var index/ecx: int <- find-symbol-in-globals _globals, defined-symbol-name
+1893   {
+1894     compare index, -1/not-found
+1895     break-if-!=
+1896     return
+1897   }
+1898   # stash 'gap' to it
+1899   var globals/eax: (addr global-table) <- copy _globals
+1900   var global-data-ah/eax: (addr handle array global) <- get globals, data
+1901   var global-data/eax: (addr array global) <- lookup *global-data-ah
+1902   var offset/ebx: (offset global) <- compute-offset global-data, index
+1903   var dest-global/eax: (addr global) <- index global-data, offset
+1904   var dest-ah/eax: (addr handle gap-buffer) <- get dest-global, input
+1905   copy-object gap, dest-ah
+1906   # initialize a new gap-buffer in 'gap'
+1907   var dest/eax: (addr gap-buffer) <- lookup *dest-ah
+1908   var capacity/ecx: int <- gap-buffer-capacity dest
+1909   var gap2/eax: (addr handle gap-buffer) <- copy gap
+1910   allocate gap2
+1911   var gap-addr/eax: (addr gap-buffer) <- lookup *gap2
+1912   initialize-gap-buffer gap-addr, capacity
+1913 }
+1914 
+1915 # Accepts an input s-expression, naively checks if it is a definition, and if
+1916 # so saves the gap-buffer to the appropriate global.
+1917 fn move-gap-buffer-to-global _globals: (addr global-table), _definition-ah: (addr handle cell), gap: (addr handle gap-buffer) {
+1918   # if 'definition' is not a pair, return
+1919   var definition-ah/eax: (addr handle cell) <- copy _definition-ah
+1920   var _definition/eax: (addr cell) <- lookup *definition-ah
+1921   var definition/esi: (addr cell) <- copy _definition
+1922   var definition-type/eax: (addr int) <- get definition, type
+1923   compare *definition-type, 0/pair
+1924   {
+1925     break-if-=
+1926     return
+1927   }
+1928   # if definition->left is neither "def" nor "set", return
+1929   var left-ah/eax: (addr handle cell) <- get definition, left
+1930   var _left/eax: (addr cell) <- lookup *left-ah
+1931   var left/ecx: (addr cell) <- copy _left
+1932   {
+1933     var def?/eax: boolean <- symbol-equal? left, "def"
+1934     compare def?, 0/false
+1935     break-if-!=
+1936     var set?/eax: boolean <- symbol-equal? left, "set"
+1937     compare set?, 0/false
+1938     break-if-!=
+1939     return
+1940   }
+1941   # locate the global for definition->right->left
+1942   var right-ah/eax: (addr handle cell) <- get definition, right
+1943   var right/eax: (addr cell) <- lookup *right-ah
+1944   var defined-symbol-ah/eax: (addr handle cell) <- get right, left
+1945   var defined-symbol/eax: (addr cell) <- lookup *defined-symbol-ah
+1946   var defined-symbol-name-ah/eax: (addr handle stream byte) <- get defined-symbol, text-data
+1947   var defined-symbol-name/eax: (addr stream byte) <- lookup *defined-symbol-name-ah
+1948   var index/ecx: int <- find-symbol-in-globals _globals, defined-symbol-name
+1949   {
+1950     compare index, -1/not-found
+1951     break-if-!=
+1952     return
+1953   }
+1954   # move 'gap' to it
+1955   var globals/eax: (addr global-table) <- copy _globals
+1956   var global-data-ah/eax: (addr handle array global) <- get globals, data
+1957   var global-data/eax: (addr array global) <- lookup *global-data-ah
+1958   var offset/ebx: (offset global) <- compute-offset global-data, index
+1959   var dest-global/eax: (addr global) <- index global-data, offset
+1960   var dest-ah/eax: (addr handle gap-buffer) <- get dest-global, input
+1961   copy-object gap, dest-ah
+1962 }
diff --git a/html/shell/grapheme-stack.mu.html b/html/shell/grapheme-stack.mu.html index a42cf528..1ebdfe9a 100644 --- a/html/shell/grapheme-stack.mu.html +++ b/html/shell/grapheme-stack.mu.html @@ -141,468 +141,478 @@ if ('onhashchange' in window) { 82 } 83 84 # dump stack to screen from bottom to top - 85 # colors hardcoded - 86 fn render-stack-from-bottom-wrapping-right-then-down screen: (addr screen), _self: (addr grapheme-stack), xmin: int, ymin: int, xmax: int, ymax: int, _x: int, _y: int, highlight-matching-open-paren?: boolean, open-paren-depth: int -> _/eax: int, _/ecx: int { - 87 var self/esi: (addr grapheme-stack) <- copy _self - 88 var matching-open-paren-index/edx: int <- get-matching-open-paren-index self, highlight-matching-open-paren?, open-paren-depth - 89 var data-ah/edi: (addr handle array grapheme) <- get self, data - 90 var _data/eax: (addr array grapheme) <- lookup *data-ah - 91 var data/edi: (addr array grapheme) <- copy _data - 92 var x/eax: int <- copy _x - 93 var y/ecx: int <- copy _y - 94 var top-addr/esi: (addr int) <- get self, top - 95 var i/ebx: int <- copy 0 - 96 { - 97 compare i, *top-addr - 98 break-if->= - 99 { -100 var g/esi: (addr grapheme) <- index data, i -101 var fg: int -102 copy-to fg, 3/cyan + 85 # hardcoded colors: + 86 # matching paren + 87 fn render-stack-from-bottom-wrapping-right-then-down screen: (addr screen), _self: (addr grapheme-stack), xmin: int, ymin: int, xmax: int, ymax: int, _x: int, _y: int, highlight-matching-open-paren?: boolean, open-paren-depth: int, color: int, background-color: int -> _/eax: int, _/ecx: int { + 88 var self/esi: (addr grapheme-stack) <- copy _self + 89 var matching-open-paren-index/edx: int <- get-matching-open-paren-index self, highlight-matching-open-paren?, open-paren-depth + 90 var data-ah/edi: (addr handle array grapheme) <- get self, data + 91 var _data/eax: (addr array grapheme) <- lookup *data-ah + 92 var data/edi: (addr array grapheme) <- copy _data + 93 var x/eax: int <- copy _x + 94 var y/ecx: int <- copy _y + 95 var top-addr/esi: (addr int) <- get self, top + 96 var i/ebx: int <- copy 0 + 97 { + 98 compare i, *top-addr + 99 break-if->= +100 { +101 var g/esi: (addr grapheme) <- index data, i +102 var fg: int 103 { -104 compare i, matching-open-paren-index -105 break-if-!= -106 copy-to fg, 0xf/highlight -107 } -108 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, fg, 0/bg -109 } -110 i <- increment -111 loop -112 } -113 return x, y -114 } -115 -116 # helper for small words -117 fn render-stack-from-bottom screen: (addr screen), self: (addr grapheme-stack), x: int, y: int, highlight-matching-open-paren?: boolean, open-paren-depth: int -> _/eax: int { -118 var _width/eax: int <- copy 0 -119 var _height/ecx: int <- copy 0 -120 _width, _height <- screen-size screen -121 var width/edx: int <- copy _width -122 var height/ebx: int <- copy _height -123 var x2/eax: int <- copy 0 -124 var y2/ecx: int <- copy 0 -125 x2, y2 <- render-stack-from-bottom-wrapping-right-then-down screen, self, x, y, width, height, x, y, highlight-matching-open-paren?, open-paren-depth -126 return x2 # y2? yolo -127 } -128 -129 # dump stack to screen from top to bottom -130 # optionally render a 'cursor' with the top grapheme -131 fn render-stack-from-top-wrapping-right-then-down screen: (addr screen), _self: (addr grapheme-stack), xmin: int, ymin: int, xmax: int, ymax: int, _x: int, _y: int, render-cursor?: boolean -> _/eax: int, _/ecx: int { -132 var self/esi: (addr grapheme-stack) <- copy _self -133 var matching-close-paren-index/edx: int <- get-matching-close-paren-index self, render-cursor? -134 var data-ah/eax: (addr handle array grapheme) <- get self, data -135 var _data/eax: (addr array grapheme) <- lookup *data-ah -136 var data/edi: (addr array grapheme) <- copy _data -137 var x/eax: int <- copy _x -138 var y/ecx: int <- copy _y -139 var top-addr/ebx: (addr int) <- get self, top -140 var i/ebx: int <- copy *top-addr -141 i <- decrement -142 # if render-cursor?, peel off first iteration -143 { -144 compare render-cursor?, 0/false -145 break-if-= -146 compare i, 0 -147 break-if-< -148 var g/esi: (addr grapheme) <- index data, i -149 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, 3/fg=cyan, 7/bg=cursor -150 i <- decrement -151 } -152 # remaining iterations -153 { -154 compare i, 0 -155 break-if-< -156 # highlight matching paren if needed -157 var fg: int -158 copy-to fg, 3/cyan -159 compare i, matching-close-paren-index -160 { -161 break-if-!= -162 copy-to fg, 0xf/highlight -163 } -164 # -165 var g/esi: (addr grapheme) <- index data, i -166 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, fg, 0/bg=cursor -167 i <- decrement -168 loop -169 } -170 return x, y -171 } -172 -173 # helper for small words -174 fn render-stack-from-top screen: (addr screen), self: (addr grapheme-stack), x: int, y: int, render-cursor?: boolean -> _/eax: int { -175 var _width/eax: int <- copy 0 -176 var _height/ecx: int <- copy 0 -177 _width, _height <- screen-size screen -178 var width/edx: int <- copy _width -179 var height/ebx: int <- copy _height -180 var x2/eax: int <- copy 0 -181 var y2/ecx: int <- copy 0 -182 x2, y2 <- render-stack-from-top-wrapping-right-then-down screen, self, x, y, width, height, x, y, render-cursor? -183 return x2 # y2? yolo -184 } -185 -186 fn test-render-grapheme-stack { -187 # setup: gs = "abc" -188 var gs-storage: grapheme-stack -189 var gs/edi: (addr grapheme-stack) <- address gs-storage -190 initialize-grapheme-stack gs, 5 -191 var g/eax: grapheme <- copy 0x61/a -192 push-grapheme-stack gs, g -193 g <- copy 0x62/b -194 push-grapheme-stack gs, g -195 g <- copy 0x63/c -196 push-grapheme-stack gs, g -197 # setup: screen -198 var screen-on-stack: screen -199 var screen/esi: (addr screen) <- address screen-on-stack -200 initialize-screen screen, 5, 4, 0/no-pixel-graphics -201 # -202 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 0/y, 0/no-highlight-matching-open-paren, 0/open-paren-depth -203 check-screen-row screen, 0/y, "abc ", "F - test-render-grapheme-stack from bottom" -204 check-ints-equal x, 3, "F - test-render-grapheme-stack from bottom: result" -205 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-render-grapheme-stack from bottom: bg" -206 # -207 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 1/y, 0/cursor=false -208 check-screen-row screen, 1/y, "cba ", "F - test-render-grapheme-stack from top without cursor" -209 check-ints-equal x, 3, "F - test-render-grapheme-stack from top without cursor: result" -210 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-render-grapheme-stack from top without cursor: bg" +104 var tmp/eax: int <- copy color +105 copy-to fg, tmp +106 } +107 { +108 compare i, matching-open-paren-index +109 break-if-!= +110 copy-to fg, 0xf/highlight +111 } +112 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, fg, background-color +113 } +114 i <- increment +115 loop +116 } +117 return x, y +118 } +119 +120 # helper for small words +121 fn render-stack-from-bottom screen: (addr screen), self: (addr grapheme-stack), x: int, y: int, highlight-matching-open-paren?: boolean, open-paren-depth: int -> _/eax: int { +122 var _width/eax: int <- copy 0 +123 var _height/ecx: int <- copy 0 +124 _width, _height <- screen-size screen +125 var width/edx: int <- copy _width +126 var height/ebx: int <- copy _height +127 var x2/eax: int <- copy 0 +128 var y2/ecx: int <- copy 0 +129 x2, y2 <- render-stack-from-bottom-wrapping-right-then-down screen, self, x, y, width, height, x, y, highlight-matching-open-paren?, open-paren-depth, 3/fg=cyan, 0xc5/bg=blue-bg +130 return x2 # y2? yolo +131 } +132 +133 # dump stack to screen from top to bottom +134 # optionally render a 'cursor' with the top grapheme +135 # hard-coded colors: +136 # matching paren +137 # cursor +138 fn render-stack-from-top-wrapping-right-then-down screen: (addr screen), _self: (addr grapheme-stack), xmin: int, ymin: int, xmax: int, ymax: int, _x: int, _y: int, render-cursor?: boolean, color: int, background-color: int -> _/eax: int, _/ecx: int { +139 var self/esi: (addr grapheme-stack) <- copy _self +140 var matching-close-paren-index/edx: int <- get-matching-close-paren-index self, render-cursor? +141 var data-ah/eax: (addr handle array grapheme) <- get self, data +142 var _data/eax: (addr array grapheme) <- lookup *data-ah +143 var data/edi: (addr array grapheme) <- copy _data +144 var x/eax: int <- copy _x +145 var y/ecx: int <- copy _y +146 var top-addr/ebx: (addr int) <- get self, top +147 var i/ebx: int <- copy *top-addr +148 i <- decrement +149 # if render-cursor?, peel off first iteration +150 { +151 compare render-cursor?, 0/false +152 break-if-= +153 compare i, 0 +154 break-if-< +155 var g/esi: (addr grapheme) <- index data, i +156 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, color, 7/bg=cursor +157 i <- decrement +158 } +159 # remaining iterations +160 { +161 compare i, 0 +162 break-if-< +163 # highlight matching paren if needed +164 var fg: int +165 { +166 var tmp/eax: int <- copy color +167 copy-to fg, tmp +168 } +169 compare i, matching-close-paren-index +170 { +171 break-if-!= +172 copy-to fg, 0xf/highlight +173 } +174 # +175 var g/esi: (addr grapheme) <- index data, i +176 x, y <- render-grapheme screen, *g, xmin, ymin, xmax, ymax, x, y, fg, background-color +177 i <- decrement +178 loop +179 } +180 return x, y +181 } +182 +183 # helper for small words +184 fn render-stack-from-top screen: (addr screen), self: (addr grapheme-stack), x: int, y: int, render-cursor?: boolean -> _/eax: int { +185 var _width/eax: int <- copy 0 +186 var _height/ecx: int <- copy 0 +187 _width, _height <- screen-size screen +188 var width/edx: int <- copy _width +189 var height/ebx: int <- copy _height +190 var x2/eax: int <- copy 0 +191 var y2/ecx: int <- copy 0 +192 x2, y2 <- render-stack-from-top-wrapping-right-then-down screen, self, x, y, width, height, x, y, render-cursor?, 3/fg=cyan, 0xc5/bg=blue-bg +193 return x2 # y2? yolo +194 } +195 +196 fn test-render-grapheme-stack { +197 # setup: gs = "abc" +198 var gs-storage: grapheme-stack +199 var gs/edi: (addr grapheme-stack) <- address gs-storage +200 initialize-grapheme-stack gs, 5 +201 var g/eax: grapheme <- copy 0x61/a +202 push-grapheme-stack gs, g +203 g <- copy 0x62/b +204 push-grapheme-stack gs, g +205 g <- copy 0x63/c +206 push-grapheme-stack gs, g +207 # setup: screen +208 var screen-on-stack: screen +209 var screen/esi: (addr screen) <- address screen-on-stack +210 initialize-screen screen, 5, 4, 0/no-pixel-graphics 211 # -212 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 2/y, 1/cursor=true -213 check-screen-row screen, 2/y, "cba ", "F - test-render-grapheme-stack from top with cursor" -214 check-ints-equal x, 3, "F - test-render-grapheme-stack from top with cursor: result" -215 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "| ", "F - test-render-grapheme-stack from top with cursor: bg" -216 } -217 -218 fn test-render-grapheme-stack-while-highlighting-matching-close-paren { -219 # setup: gs = "(b)" -220 var gs-storage: grapheme-stack -221 var gs/edi: (addr grapheme-stack) <- address gs-storage -222 initialize-grapheme-stack gs, 5 -223 var g/eax: grapheme <- copy 0x29/close-paren -224 push-grapheme-stack gs, g -225 g <- copy 0x62/b -226 push-grapheme-stack gs, g -227 g <- copy 0x28/open-paren -228 push-grapheme-stack gs, g -229 # setup: screen -230 var screen-on-stack: screen -231 var screen/esi: (addr screen) <- address screen-on-stack -232 initialize-screen screen, 5, 4, 0/no-pixel-graphics -233 # -234 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 2/y, 1/cursor=true -235 check-screen-row screen, 2/y, "(b) ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren" -236 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "| ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren: cursor" -237 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ) ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren: matching paren" -238 } -239 -240 fn test-render-grapheme-stack-while-highlighting-matching-close-paren-2 { -241 # setup: gs = "(a (b)) c" -242 var gs-storage: grapheme-stack -243 var gs/edi: (addr grapheme-stack) <- address gs-storage -244 initialize-grapheme-stack gs, 0x10 -245 var g/eax: grapheme <- copy 0x63/c -246 push-grapheme-stack gs, g -247 g <- copy 0x20/space -248 push-grapheme-stack gs, g -249 g <- copy 0x29/close-paren -250 push-grapheme-stack gs, g -251 g <- copy 0x29/close-paren -252 push-grapheme-stack gs, g -253 g <- copy 0x62/b -254 push-grapheme-stack gs, g -255 g <- copy 0x28/open-paren +212 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 0/y, 0/no-highlight-matching-open-paren, 0/open-paren-depth +213 check-screen-row screen, 0/y, "abc ", "F - test-render-grapheme-stack from bottom" +214 check-ints-equal x, 3, "F - test-render-grapheme-stack from bottom: result" +215 check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-render-grapheme-stack from bottom: bg" +216 # +217 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 1/y, 0/cursor=false +218 check-screen-row screen, 1/y, "cba ", "F - test-render-grapheme-stack from top without cursor" +219 check-ints-equal x, 3, "F - test-render-grapheme-stack from top without cursor: result" +220 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " ", "F - test-render-grapheme-stack from top without cursor: bg" +221 # +222 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 2/y, 1/cursor=true +223 check-screen-row screen, 2/y, "cba ", "F - test-render-grapheme-stack from top with cursor" +224 check-ints-equal x, 3, "F - test-render-grapheme-stack from top with cursor: result" +225 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "| ", "F - test-render-grapheme-stack from top with cursor: bg" +226 } +227 +228 fn test-render-grapheme-stack-while-highlighting-matching-close-paren { +229 # setup: gs = "(b)" +230 var gs-storage: grapheme-stack +231 var gs/edi: (addr grapheme-stack) <- address gs-storage +232 initialize-grapheme-stack gs, 5 +233 var g/eax: grapheme <- copy 0x29/close-paren +234 push-grapheme-stack gs, g +235 g <- copy 0x62/b +236 push-grapheme-stack gs, g +237 g <- copy 0x28/open-paren +238 push-grapheme-stack gs, g +239 # setup: screen +240 var screen-on-stack: screen +241 var screen/esi: (addr screen) <- address screen-on-stack +242 initialize-screen screen, 5, 4, 0/no-pixel-graphics +243 # +244 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 2/y, 1/cursor=true +245 check-screen-row screen, 2/y, "(b) ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren" +246 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "| ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren: cursor" +247 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ) ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren: matching paren" +248 } +249 +250 fn test-render-grapheme-stack-while-highlighting-matching-close-paren-2 { +251 # setup: gs = "(a (b)) c" +252 var gs-storage: grapheme-stack +253 var gs/edi: (addr grapheme-stack) <- address gs-storage +254 initialize-grapheme-stack gs, 0x10 +255 var g/eax: grapheme <- copy 0x63/c 256 push-grapheme-stack gs, g 257 g <- copy 0x20/space 258 push-grapheme-stack gs, g -259 g <- copy 0x61/a +259 g <- copy 0x29/close-paren 260 push-grapheme-stack gs, g -261 g <- copy 0x28/open-paren +261 g <- copy 0x29/close-paren 262 push-grapheme-stack gs, g -263 # setup: screen -264 var screen-on-stack: screen -265 var screen/esi: (addr screen) <- address screen-on-stack -266 initialize-screen screen, 5, 4, 0/no-pixel-graphics -267 # -268 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 2/y, 1/cursor=true -269 check-screen-row screen, 2/y, "(a (b)) c ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren-2" -270 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "| ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren-2: cursor" -271 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ) ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren-2: matching paren" -272 } -273 -274 fn test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end { -275 # setup: gs = "(b)" -276 var gs-storage: grapheme-stack -277 var gs/edi: (addr grapheme-stack) <- address gs-storage -278 initialize-grapheme-stack gs, 5 -279 var g/eax: grapheme <- copy 0x28/open-paren -280 push-grapheme-stack gs, g -281 g <- copy 0x62/b -282 push-grapheme-stack gs, g -283 g <- copy 0x29/close-paren -284 push-grapheme-stack gs, g -285 # setup: screen -286 var screen-on-stack: screen -287 var screen/esi: (addr screen) <- address screen-on-stack -288 initialize-screen screen, 5, 4, 0/no-pixel-graphics -289 # -290 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 2/y, 1/highlight-matching-open-paren, 1/open-paren-depth -291 check-screen-row screen, 2/y, "(b) ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end" -292 check-screen-row-in-color screen, 0xf/fg=white, 2/y, "( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end: matching paren" -293 } -294 -295 fn test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end-2 { -296 # setup: gs = "a((b))" -297 var gs-storage: grapheme-stack -298 var gs/edi: (addr grapheme-stack) <- address gs-storage -299 initialize-grapheme-stack gs, 0x10 -300 var g/eax: grapheme <- copy 0x61/a -301 push-grapheme-stack gs, g -302 g <- copy 0x28/open-paren -303 push-grapheme-stack gs, g -304 g <- copy 0x28/open-paren -305 push-grapheme-stack gs, g -306 g <- copy 0x62/b -307 push-grapheme-stack gs, g -308 g <- copy 0x29/close-paren -309 push-grapheme-stack gs, g -310 g <- copy 0x29/close-paren +263 g <- copy 0x62/b +264 push-grapheme-stack gs, g +265 g <- copy 0x28/open-paren +266 push-grapheme-stack gs, g +267 g <- copy 0x20/space +268 push-grapheme-stack gs, g +269 g <- copy 0x61/a +270 push-grapheme-stack gs, g +271 g <- copy 0x28/open-paren +272 push-grapheme-stack gs, g +273 # setup: screen +274 var screen-on-stack: screen +275 var screen/esi: (addr screen) <- address screen-on-stack +276 initialize-screen screen, 5, 4, 0/no-pixel-graphics +277 # +278 var x/eax: int <- render-stack-from-top screen, gs, 0/x, 2/y, 1/cursor=true +279 check-screen-row screen, 2/y, "(a (b)) c ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren-2" +280 check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "| ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren-2: cursor" +281 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ) ", "F - test-render-grapheme-stack-while-highlighting-matching-close-paren-2: matching paren" +282 } +283 +284 fn test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end { +285 # setup: gs = "(b)" +286 var gs-storage: grapheme-stack +287 var gs/edi: (addr grapheme-stack) <- address gs-storage +288 initialize-grapheme-stack gs, 5 +289 var g/eax: grapheme <- copy 0x28/open-paren +290 push-grapheme-stack gs, g +291 g <- copy 0x62/b +292 push-grapheme-stack gs, g +293 g <- copy 0x29/close-paren +294 push-grapheme-stack gs, g +295 # setup: screen +296 var screen-on-stack: screen +297 var screen/esi: (addr screen) <- address screen-on-stack +298 initialize-screen screen, 5, 4, 0/no-pixel-graphics +299 # +300 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 2/y, 1/highlight-matching-open-paren, 1/open-paren-depth +301 check-screen-row screen, 2/y, "(b) ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end" +302 check-screen-row-in-color screen, 0xf/fg=white, 2/y, "( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end: matching paren" +303 } +304 +305 fn test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end-2 { +306 # setup: gs = "a((b))" +307 var gs-storage: grapheme-stack +308 var gs/edi: (addr grapheme-stack) <- address gs-storage +309 initialize-grapheme-stack gs, 0x10 +310 var g/eax: grapheme <- copy 0x61/a 311 push-grapheme-stack gs, g -312 # setup: screen -313 var screen-on-stack: screen -314 var screen/esi: (addr screen) <- address screen-on-stack -315 initialize-screen screen, 5, 4, 0/no-pixel-graphics -316 # -317 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 2/y, 1/highlight-matching-open-paren, 1/open-paren-depth -318 check-screen-row screen, 2/y, "a((b)) ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end-2" -319 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end-2: matching paren" -320 } -321 -322 fn test-render-grapheme-stack-while-highlighting-matching-open-paren { -323 # setup: gs = "(b" -324 var gs-storage: grapheme-stack -325 var gs/edi: (addr grapheme-stack) <- address gs-storage -326 initialize-grapheme-stack gs, 5 -327 var g/eax: grapheme <- copy 0x28/open-paren -328 push-grapheme-stack gs, g -329 g <- copy 0x62/b -330 push-grapheme-stack gs, g -331 # setup: screen -332 var screen-on-stack: screen -333 var screen/esi: (addr screen) <- address screen-on-stack -334 initialize-screen screen, 5, 4, 0/no-pixel-graphics -335 # -336 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 2/y, 1/highlight-matching-open-paren, 0/open-paren-depth -337 check-screen-row screen, 2/y, "(b ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren" -338 check-screen-row-in-color screen, 0xf/fg=white, 2/y, "( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren: matching paren" -339 } -340 -341 fn test-render-grapheme-stack-while-highlighting-matching-open-paren-2 { -342 # setup: gs = "a((b)" -343 var gs-storage: grapheme-stack -344 var gs/edi: (addr grapheme-stack) <- address gs-storage -345 initialize-grapheme-stack gs, 0x10 -346 var g/eax: grapheme <- copy 0x61/a -347 push-grapheme-stack gs, g -348 g <- copy 0x28/open-paren -349 push-grapheme-stack gs, g -350 g <- copy 0x28/open-paren -351 push-grapheme-stack gs, g -352 g <- copy 0x62/b -353 push-grapheme-stack gs, g -354 g <- copy 0x29/close-paren -355 push-grapheme-stack gs, g -356 # setup: screen -357 var screen-on-stack: screen -358 var screen/esi: (addr screen) <- address screen-on-stack -359 initialize-screen screen, 5, 4, 0/no-pixel-graphics -360 # -361 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 2/y, 1/highlight-matching-open-paren, 0/open-paren-depth -362 check-screen-row screen, 2/y, "a((b) ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-2" -363 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-2: matching paren" -364 } -365 -366 # return the index of the matching close-paren of the grapheme at cursor (top of stack) -367 # or top index if there's no matching close-paren -368 fn get-matching-close-paren-index _self: (addr grapheme-stack), render-cursor?: boolean -> _/edx: int { -369 var self/esi: (addr grapheme-stack) <- copy _self -370 var top-addr/edx: (addr int) <- get self, top -371 # if not rendering cursor, return -372 compare render-cursor?, 0/false -373 { -374 break-if-!= -375 return *top-addr -376 } -377 var data-ah/eax: (addr handle array grapheme) <- get self, data -378 var data/eax: (addr array grapheme) <- lookup *data-ah -379 var i/ecx: int <- copy *top-addr -380 # if stack is empty, return -381 compare i, 0 -382 { -383 break-if-> -384 return *top-addr -385 } -386 # if cursor is not '(' return -387 i <- decrement -388 var g/esi: (addr grapheme) <- index data, i -389 compare *g, 0x28/open-paren -390 { -391 break-if-= -392 return *top-addr -393 } -394 # otherwise scan to matching paren -395 var paren-count/ebx: int <- copy 1 -396 i <- decrement -397 { -398 compare i, 0 -399 break-if-< -400 var g/esi: (addr grapheme) <- index data, i -401 compare *g, 0x28/open-paren -402 { -403 break-if-!= -404 paren-count <- increment -405 } -406 compare *g, 0x29/close-paren -407 { -408 break-if-!= -409 compare paren-count, 1 -410 { -411 break-if-!= -412 return i -413 } -414 paren-count <- decrement +312 g <- copy 0x28/open-paren +313 push-grapheme-stack gs, g +314 g <- copy 0x28/open-paren +315 push-grapheme-stack gs, g +316 g <- copy 0x62/b +317 push-grapheme-stack gs, g +318 g <- copy 0x29/close-paren +319 push-grapheme-stack gs, g +320 g <- copy 0x29/close-paren +321 push-grapheme-stack gs, g +322 # setup: screen +323 var screen-on-stack: screen +324 var screen/esi: (addr screen) <- address screen-on-stack +325 initialize-screen screen, 5, 4, 0/no-pixel-graphics +326 # +327 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 2/y, 1/highlight-matching-open-paren, 1/open-paren-depth +328 check-screen-row screen, 2/y, "a((b)) ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end-2" +329 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-with-close-paren-at-end-2: matching paren" +330 } +331 +332 fn test-render-grapheme-stack-while-highlighting-matching-open-paren { +333 # setup: gs = "(b" +334 var gs-storage: grapheme-stack +335 var gs/edi: (addr grapheme-stack) <- address gs-storage +336 initialize-grapheme-stack gs, 5 +337 var g/eax: grapheme <- copy 0x28/open-paren +338 push-grapheme-stack gs, g +339 g <- copy 0x62/b +340 push-grapheme-stack gs, g +341 # setup: screen +342 var screen-on-stack: screen +343 var screen/esi: (addr screen) <- address screen-on-stack +344 initialize-screen screen, 5, 4, 0/no-pixel-graphics +345 # +346 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 2/y, 1/highlight-matching-open-paren, 0/open-paren-depth +347 check-screen-row screen, 2/y, "(b ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren" +348 check-screen-row-in-color screen, 0xf/fg=white, 2/y, "( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren: matching paren" +349 } +350 +351 fn test-render-grapheme-stack-while-highlighting-matching-open-paren-2 { +352 # setup: gs = "a((b)" +353 var gs-storage: grapheme-stack +354 var gs/edi: (addr grapheme-stack) <- address gs-storage +355 initialize-grapheme-stack gs, 0x10 +356 var g/eax: grapheme <- copy 0x61/a +357 push-grapheme-stack gs, g +358 g <- copy 0x28/open-paren +359 push-grapheme-stack gs, g +360 g <- copy 0x28/open-paren +361 push-grapheme-stack gs, g +362 g <- copy 0x62/b +363 push-grapheme-stack gs, g +364 g <- copy 0x29/close-paren +365 push-grapheme-stack gs, g +366 # setup: screen +367 var screen-on-stack: screen +368 var screen/esi: (addr screen) <- address screen-on-stack +369 initialize-screen screen, 5, 4, 0/no-pixel-graphics +370 # +371 var x/eax: int <- render-stack-from-bottom screen, gs, 0/x, 2/y, 1/highlight-matching-open-paren, 0/open-paren-depth +372 check-screen-row screen, 2/y, "a((b) ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-2" +373 check-screen-row-in-color screen, 0xf/fg=white, 2/y, " ( ", "F - test-render-grapheme-stack-while-highlighting-matching-open-paren-2: matching paren" +374 } +375 +376 # return the index of the matching close-paren of the grapheme at cursor (top of stack) +377 # or top index if there's no matching close-paren +378 fn get-matching-close-paren-index _self: (addr grapheme-stack), render-cursor?: boolean -> _/edx: int { +379 var self/esi: (addr grapheme-stack) <- copy _self +380 var top-addr/edx: (addr int) <- get self, top +381 # if not rendering cursor, return +382 compare render-cursor?, 0/false +383 { +384 break-if-!= +385 return *top-addr +386 } +387 var data-ah/eax: (addr handle array grapheme) <- get self, data +388 var data/eax: (addr array grapheme) <- lookup *data-ah +389 var i/ecx: int <- copy *top-addr +390 # if stack is empty, return +391 compare i, 0 +392 { +393 break-if-> +394 return *top-addr +395 } +396 # if cursor is not '(' return +397 i <- decrement +398 var g/esi: (addr grapheme) <- index data, i +399 compare *g, 0x28/open-paren +400 { +401 break-if-= +402 return *top-addr +403 } +404 # otherwise scan to matching paren +405 var paren-count/ebx: int <- copy 1 +406 i <- decrement +407 { +408 compare i, 0 +409 break-if-< +410 var g/esi: (addr grapheme) <- index data, i +411 compare *g, 0x28/open-paren +412 { +413 break-if-!= +414 paren-count <- increment 415 } -416 i <- decrement -417 loop -418 } -419 return *top-addr -420 } -421 -422 # return the index of the first open-paren at the given depth -423 # or top index if there's no matching close-paren -424 fn get-matching-open-paren-index _self: (addr grapheme-stack), control: boolean, depth: int -> _/edx: int { -425 var self/esi: (addr grapheme-stack) <- copy _self -426 var top-addr/edx: (addr int) <- get self, top -427 # if not rendering cursor, return -428 compare control, 0/false -429 { -430 break-if-!= -431 return *top-addr -432 } -433 var data-ah/eax: (addr handle array grapheme) <- get self, data -434 var data/eax: (addr array grapheme) <- lookup *data-ah -435 var i/ecx: int <- copy *top-addr -436 # if stack is empty, return -437 compare i, 0 -438 { -439 break-if-> -440 return *top-addr -441 } -442 # scan to matching open paren -443 var paren-count/ebx: int <- copy 0 -444 i <- decrement -445 { -446 compare i, 0 -447 break-if-< -448 var g/esi: (addr grapheme) <- index data, i -449 compare *g, 0x29/close-paren -450 { -451 break-if-!= -452 paren-count <- increment -453 } -454 compare *g, 0x28/open-paren -455 { -456 break-if-!= -457 compare paren-count, depth -458 { -459 break-if-!= -460 return i -461 } -462 paren-count <- decrement +416 compare *g, 0x29/close-paren +417 { +418 break-if-!= +419 compare paren-count, 1 +420 { +421 break-if-!= +422 return i +423 } +424 paren-count <- decrement +425 } +426 i <- decrement +427 loop +428 } +429 return *top-addr +430 } +431 +432 # return the index of the first open-paren at the given depth +433 # or top index if there's no matching close-paren +434 fn get-matching-open-paren-index _self: (addr grapheme-stack), control: boolean, depth: int -> _/edx: int { +435 var self/esi: (addr grapheme-stack) <- copy _self +436 var top-addr/edx: (addr int) <- get self, top +437 # if not rendering cursor, return +438 compare control, 0/false +439 { +440 break-if-!= +441 return *top-addr +442 } +443 var data-ah/eax: (addr handle array grapheme) <- get self, data +444 var data/eax: (addr array grapheme) <- lookup *data-ah +445 var i/ecx: int <- copy *top-addr +446 # if stack is empty, return +447 compare i, 0 +448 { +449 break-if-> +450 return *top-addr +451 } +452 # scan to matching open paren +453 var paren-count/ebx: int <- copy 0 +454 i <- decrement +455 { +456 compare i, 0 +457 break-if-< +458 var g/esi: (addr grapheme) <- index data, i +459 compare *g, 0x29/close-paren +460 { +461 break-if-!= +462 paren-count <- increment 463 } -464 i <- decrement -465 loop -466 } -467 return *top-addr -468 } -469 -470 # compare from bottom -471 # beware: modifies 'stream', which must be disposed of after a false result -472 fn prefix-match? _self: (addr grapheme-stack), s: (addr stream byte) -> _/eax: boolean { -473 var self/esi: (addr grapheme-stack) <- copy _self -474 var data-ah/edi: (addr handle array grapheme) <- get self, data -475 var _data/eax: (addr array grapheme) <- lookup *data-ah -476 var data/edi: (addr array grapheme) <- copy _data -477 var top-addr/ecx: (addr int) <- get self, top -478 var i/ebx: int <- copy 0 -479 { -480 compare i, *top-addr -481 break-if->= -482 # if curr != expected, return false -483 { -484 var curr-a/edx: (addr grapheme) <- index data, i -485 var expected/eax: grapheme <- read-grapheme s -486 { -487 compare expected, *curr-a -488 break-if-= -489 return 0/false -490 } -491 } -492 i <- increment -493 loop -494 } -495 return 1 # true -496 } -497 -498 # compare from bottom -499 # beware: modifies 'stream', which must be disposed of after a false result -500 fn suffix-match? _self: (addr grapheme-stack), s: (addr stream byte) -> _/eax: boolean { -501 var self/esi: (addr grapheme-stack) <- copy _self -502 var data-ah/edi: (addr handle array grapheme) <- get self, data -503 var _data/eax: (addr array grapheme) <- lookup *data-ah -504 var data/edi: (addr array grapheme) <- copy _data -505 var top-addr/eax: (addr int) <- get self, top -506 var i/ebx: int <- copy *top-addr -507 i <- decrement -508 { -509 compare i, 0 -510 break-if-< -511 { -512 var curr-a/edx: (addr grapheme) <- index data, i -513 var expected/eax: grapheme <- read-grapheme s -514 # if curr != expected, return false -515 { -516 compare expected, *curr-a -517 break-if-= -518 return 0/false -519 } -520 } -521 i <- decrement -522 loop -523 } -524 return 1 # true -525 } -526 -527 fn grapheme-stack-is-decimal-integer? _self: (addr grapheme-stack) -> _/eax: boolean { -528 var self/esi: (addr grapheme-stack) <- copy _self -529 var data-ah/eax: (addr handle array grapheme) <- get self, data -530 var _data/eax: (addr array grapheme) <- lookup *data-ah -531 var data/edx: (addr array grapheme) <- copy _data -532 var top-addr/ecx: (addr int) <- get self, top -533 var i/ebx: int <- copy 0 -534 var result/eax: boolean <- copy 1/true -535 $grapheme-stack-is-integer?:loop: { -536 compare i, *top-addr -537 break-if->= -538 var g/edx: (addr grapheme) <- index data, i -539 result <- decimal-digit? *g -540 compare result, 0/false -541 break-if-= -542 i <- increment -543 loop -544 } -545 return result -546 } +464 compare *g, 0x28/open-paren +465 { +466 break-if-!= +467 compare paren-count, depth +468 { +469 break-if-!= +470 return i +471 } +472 paren-count <- decrement +473 } +474 i <- decrement +475 loop +476 } +477 return *top-addr +478 } +479 +480 # compare from bottom +481 # beware: modifies 'stream', which must be disposed of after a false result +482 fn prefix-match? _self: (addr grapheme-stack), s: (addr stream byte) -> _/eax: boolean { +483 var self/esi: (addr grapheme-stack) <- copy _self +484 var data-ah/edi: (addr handle array grapheme) <- get self, data +485 var _data/eax: (addr array grapheme) <- lookup *data-ah +486 var data/edi: (addr array grapheme) <- copy _data +487 var top-addr/ecx: (addr int) <- get self, top +488 var i/ebx: int <- copy 0 +489 { +490 compare i, *top-addr +491 break-if->= +492 # if curr != expected, return false +493 { +494 var curr-a/edx: (addr grapheme) <- index data, i +495 var expected/eax: grapheme <- read-grapheme s +496 { +497 compare expected, *curr-a +498 break-if-= +499 return 0/false +500 } +501 } +502 i <- increment +503 loop +504 } +505 return 1 # true +506 } +507 +508 # compare from bottom +509 # beware: modifies 'stream', which must be disposed of after a false result +510 fn suffix-match? _self: (addr grapheme-stack), s: (addr stream byte) -> _/eax: boolean { +511 var self/esi: (addr grapheme-stack) <- copy _self +512 var data-ah/edi: (addr handle array grapheme) <- get self, data +513 var _data/eax: (addr array grapheme) <- lookup *data-ah +514 var data/edi: (addr array grapheme) <- copy _data +515 var top-addr/eax: (addr int) <- get self, top +516 var i/ebx: int <- copy *top-addr +517 i <- decrement +518 { +519 compare i, 0 +520 break-if-< +521 { +522 var curr-a/edx: (addr grapheme) <- index data, i +523 var expected/eax: grapheme <- read-grapheme s +524 # if curr != expected, return false +525 { +526 compare expected, *curr-a +527 break-if-= +528 return 0/false +529 } +530 } +531 i <- decrement +532 loop +533 } +534 return 1 # true +535 } +536 +537 fn grapheme-stack-is-decimal-integer? _self: (addr grapheme-stack) -> _/eax: boolean { +538 var self/esi: (addr grapheme-stack) <- copy _self +539 var data-ah/eax: (addr handle array grapheme) <- get self, data +540 var _data/eax: (addr array grapheme) <- lookup *data-ah +541 var data/edx: (addr array grapheme) <- copy _data +542 var top-addr/ecx: (addr int) <- get self, top +543 var i/ebx: int <- copy 0 +544 var result/eax: boolean <- copy 1/true +545 $grapheme-stack-is-integer?:loop: { +546 compare i, *top-addr +547 break-if->= +548 var g/edx: (addr grapheme) <- index data, i +549 result <- decimal-digit? *g +550 compare result, 0/false +551 break-if-= +552 i <- increment +553 loop +554 } +555 return result +556 } diff --git a/html/shell/main.mu.html b/html/shell/main.mu.html index cf989aaf..aff6ec88 100644 --- a/html/shell/main.mu.html +++ b/html/shell/main.mu.html @@ -61,150 +61,153 @@ if ('onhashchange' in window) { 2 # A Lisp with indent-sensitivity and infix. 3 4 fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) { - 5 var globals-storage: global-table - 6 var globals/edi: (addr global-table) <- address globals-storage - 7 initialize-globals globals + 5 var globals-storage: global-table + 6 var globals/edi: (addr global-table) <- address globals-storage + 7 initialize-globals globals 8 var sandbox-storage: sandbox 9 var sandbox/esi: (addr sandbox) <- address sandbox-storage 10 initialize-sandbox sandbox, 1/with-screen - 11 load-state data-disk, sandbox, globals + 11 load-state data-disk, sandbox, globals 12 $main:loop: { - 13 render-globals screen, globals, 0/x, 0/y, 0x40/xmax, 0x2f/screen-height-without-menu - 14 render-sandbox screen, sandbox, 0x40/sandbox-left-margin, 0/y, 0x80/screen-width, 0x2f/screen-height-without-menu - 15 { - 16 var key/eax: byte <- read-key keyboard - 17 compare key, 0 - 18 loop-if-= - 19 # ctrl-r - 20 { - 21 compare key, 0x12/ctrl-r - 22 break-if-!= - 23 var tmp/eax: (addr handle cell) <- copy 0 - 24 var nil: (handle cell) - 25 tmp <- address nil - 26 allocate-pair tmp - 27 # (main 0/real-screen 0/real-keyboard) - 28 # We're using the fact that 'screen' and 'keyboard' in this function are always 0. - 29 var real-keyboard: (handle cell) - 30 tmp <- address real-keyboard - 31 allocate-keyboard tmp - 32 # args = cons(real-keyboard, nil) - 33 var args: (handle cell) - 34 tmp <- address args - 35 new-pair tmp, real-keyboard, nil - 36 # - 37 var real-screen: (handle cell) - 38 tmp <- address real-screen - 39 allocate-screen tmp - 40 # args = cons(real-screen, args) - 41 tmp <- address args - 42 new-pair tmp, real-screen, *tmp - 43 # - 44 var main: (handle cell) - 45 tmp <- address main - 46 new-symbol tmp, "main" - 47 # args = cons(main, args) - 48 tmp <- address args - 49 new-pair tmp, main, *tmp - 50 # clear real screen - 51 clear-screen screen - 52 set-cursor-position screen, 0, 0 - 53 # run - 54 var out: (handle cell) - 55 var out-ah/ecx: (addr handle cell) <- address out - 56 evaluate tmp, out-ah, nil, globals, 0/trace, 0/no-fake-screen, 0/no-fake-keyboard, 0/call-number - 57 { - 58 var tmp/eax: byte <- read-key keyboard - 59 compare tmp, 0 - 60 loop-if-= - 61 } - 62 # - 63 loop $main:loop - 64 } - 65 # no way to quit right now; just reboot - 66 edit-sandbox sandbox, key, globals, data-disk, screen, 1/tweak-real-screen - 67 } - 68 loop - 69 } - 70 } - 71 - 72 # Gotcha: some saved state may not load. - 73 fn load-state data-disk: (addr disk), _sandbox: (addr sandbox), globals: (addr global-table) { - 74 var sandbox/eax: (addr sandbox) <- copy _sandbox - 75 var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data - 76 var _data/eax: (addr gap-buffer) <- lookup *data-ah - 77 var data/esi: (addr gap-buffer) <- copy _data - 78 # data-disk -> stream - 79 var s-storage: (stream byte 0x1000) # space for 8/sectors - 80 var s/ebx: (addr stream byte) <- address s-storage - 81 load-sectors data-disk, 0/lba, 8/sectors, s - 82 #? draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg, 0/bg - 83 # stream -> gap-buffer - 84 load-gap-buffer-from-stream data, s - 85 clear-stream s - 86 # read: gap-buffer -> cell - 87 var initial-root-storage: (handle cell) - 88 var initial-root/ecx: (addr handle cell) <- address initial-root-storage - 89 read-cell data, initial-root, 0/no-trace - 90 clear-gap-buffer data - 91 # - 92 { - 93 var initial-root-addr/eax: (addr cell) <- lookup *initial-root - 94 compare initial-root-addr, 0 - 95 break-if-!= - 96 return - 97 } - 98 # load globals from assoc(initial-root, 'globals) - 99 var globals-literal-storage: (handle cell) -100 var globals-literal-ah/eax: (addr handle cell) <- address globals-literal-storage -101 new-symbol globals-literal-ah, "globals" -102 var globals-literal/eax: (addr cell) <- lookup *globals-literal-ah -103 var globals-cell-storage: (handle cell) -104 var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage -105 lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard -106 var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah -107 { -108 compare globals-cell, 0 -109 break-if-= -110 load-globals globals-cell-ah, globals -111 } -112 # sandbox = assoc(initial-root, 'sandbox) -113 var sandbox-literal-storage: (handle cell) -114 var sandbox-literal-ah/eax: (addr handle cell) <- address sandbox-literal-storage -115 new-symbol sandbox-literal-ah, "sandbox" -116 var sandbox-literal/eax: (addr cell) <- lookup *sandbox-literal-ah -117 var sandbox-cell-storage: (handle cell) -118 var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage -119 lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard -120 var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah -121 { -122 compare sandbox-cell, 0 -123 break-if-= -124 # print: cell -> stream -125 print-cell sandbox-cell-ah, s, 0/no-trace -126 # stream -> gap-buffer -127 load-gap-buffer-from-stream data, s -128 } -129 } -130 -131 # Save state as an alist of alists: -132 # ((globals . ((a . (fn ...)) -133 # ...)) -134 # (sandbox . ...)) -135 fn store-state data-disk: (addr disk), sandbox: (addr sandbox), globals: (addr global-table) { -136 compare data-disk, 0/no-disk -137 { -138 break-if-!= -139 return -140 } -141 var stream-storage: (stream byte 0x1000) # space enough for 8/sectors -142 var stream/edi: (addr stream byte) <- address stream-storage -143 write stream, "(\n" -144 write-globals stream, globals -145 write-sandbox stream, sandbox -146 write stream, ")\n" -147 store-sectors data-disk, 0/lba, 8/sectors, stream -148 } + 13 # globals layout: 1 char padding, 41 code, 1 padding, 41 code, 1 padding = 85 + 14 # sandbox layout: 1 padding, 41 code, 1 padding = 43 + 15 # total = 128 chars + 16 render-globals screen, globals + 17 render-sandbox screen, sandbox, 0x55/sandbox-left-margin, 0/sandbox-top-margin, 0x80/screen-width, 0x2f/screen-height-without-menu + 18 { + 19 var key/eax: byte <- read-key keyboard + 20 compare key, 0 + 21 loop-if-= + 22 # ctrl-r + 23 { + 24 compare key, 0x12/ctrl-r + 25 break-if-!= + 26 var tmp/eax: (addr handle cell) <- copy 0 + 27 var nil: (handle cell) + 28 tmp <- address nil + 29 allocate-pair tmp + 30 # (main 0/real-screen 0/real-keyboard) + 31 # We're using the fact that 'screen' and 'keyboard' in this function are always 0. + 32 var real-keyboard: (handle cell) + 33 tmp <- address real-keyboard + 34 allocate-keyboard tmp + 35 # args = cons(real-keyboard, nil) + 36 var args: (handle cell) + 37 tmp <- address args + 38 new-pair tmp, real-keyboard, nil + 39 # + 40 var real-screen: (handle cell) + 41 tmp <- address real-screen + 42 allocate-screen tmp + 43 # args = cons(real-screen, args) + 44 tmp <- address args + 45 new-pair tmp, real-screen, *tmp + 46 # + 47 var main: (handle cell) + 48 tmp <- address main + 49 new-symbol tmp, "main" + 50 # args = cons(main, args) + 51 tmp <- address args + 52 new-pair tmp, main, *tmp + 53 # clear real screen + 54 clear-screen screen + 55 set-cursor-position screen, 0, 0 + 56 # run + 57 var out: (handle cell) + 58 var out-ah/ecx: (addr handle cell) <- address out + 59 evaluate tmp, out-ah, nil, globals, 0/trace, 0/no-fake-screen, 0/no-fake-keyboard, 0/call-number + 60 { + 61 var tmp/eax: byte <- read-key keyboard + 62 compare tmp, 0 + 63 loop-if-= + 64 } + 65 # + 66 loop $main:loop + 67 } + 68 # no way to quit right now; just reboot + 69 edit-sandbox sandbox, key, globals, data-disk, screen, 1/tweak-real-screen + 70 } + 71 loop + 72 } + 73 } + 74 + 75 # Gotcha: some saved state may not load. + 76 fn load-state data-disk: (addr disk), _sandbox: (addr sandbox), globals: (addr global-table) { + 77 var sandbox/eax: (addr sandbox) <- copy _sandbox + 78 var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data + 79 var _data/eax: (addr gap-buffer) <- lookup *data-ah + 80 var data/esi: (addr gap-buffer) <- copy _data + 81 # data-disk -> stream + 82 var s-storage: (stream byte 0x1000) # space for 8/sectors + 83 var s/ebx: (addr stream byte) <- address s-storage + 84 load-sectors data-disk, 0/lba, 8/sectors, s + 85 #? draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg, 0xc5/bg=blue-bg + 86 # stream -> gap-buffer + 87 load-gap-buffer-from-stream data, s + 88 clear-stream s + 89 # read: gap-buffer -> cell + 90 var initial-root-storage: (handle cell) + 91 var initial-root/ecx: (addr handle cell) <- address initial-root-storage + 92 read-cell data, initial-root, 0/no-trace + 93 clear-gap-buffer data + 94 # + 95 { + 96 var initial-root-addr/eax: (addr cell) <- lookup *initial-root + 97 compare initial-root-addr, 0 + 98 break-if-!= + 99 return +100 } +101 # load globals from assoc(initial-root, 'globals) +102 var globals-literal-storage: (handle cell) +103 var globals-literal-ah/eax: (addr handle cell) <- address globals-literal-storage +104 new-symbol globals-literal-ah, "globals" +105 var globals-literal/eax: (addr cell) <- lookup *globals-literal-ah +106 var globals-cell-storage: (handle cell) +107 var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage +108 lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard +109 var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah +110 { +111 compare globals-cell, 0 +112 break-if-= +113 load-globals globals-cell-ah, globals +114 } +115 # sandbox = assoc(initial-root, 'sandbox) +116 var sandbox-literal-storage: (handle cell) +117 var sandbox-literal-ah/eax: (addr handle cell) <- address sandbox-literal-storage +118 new-symbol sandbox-literal-ah, "sandbox" +119 var sandbox-literal/eax: (addr cell) <- lookup *sandbox-literal-ah +120 var sandbox-cell-storage: (handle cell) +121 var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage +122 lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard +123 var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah +124 { +125 compare sandbox-cell, 0 +126 break-if-= +127 # print: cell -> stream +128 print-cell sandbox-cell-ah, s, 0/no-trace +129 # stream -> gap-buffer +130 load-gap-buffer-from-stream data, s +131 } +132 } +133 +134 # Save state as an alist of alists: +135 # ((globals . ((a . (fn ...)) +136 # ...)) +137 # (sandbox . ...)) +138 fn store-state data-disk: (addr disk), sandbox: (addr sandbox), globals: (addr global-table) { +139 compare data-disk, 0/no-disk +140 { +141 break-if-!= +142 return +143 } +144 var stream-storage: (stream byte 0x1000) # space enough for 8/sectors +145 var stream/edi: (addr stream byte) <- address stream-storage +146 write stream, "(\n" +147 write-globals stream, globals +148 write-sandbox stream, sandbox +149 write stream, ")\n" +150 store-sectors data-disk, 0/lba, 8/sectors, stream +151 } diff --git a/html/shell/parse.mu.html b/html/shell/parse.mu.html index aae5d09a..673f9466 100644 --- a/html/shell/parse.mu.html +++ b/html/shell/parse.mu.html @@ -100,12 +100,12 @@ if ('onhashchange' in window) { 42 read-from-stream tokens, curr-token 43 $parse-sexpression:type-check: { 44 # single quote -> parse as list with a special car - 45 var quote-token?/eax: boolean <- quote-token? curr-token - 46 compare quote-token?, 0/false + 45 var quote-token?/eax: boolean <- quote-token? curr-token + 46 compare quote-token?, 0/false 47 { 48 break-if-= 49 var out/edi: (addr handle cell) <- copy _out - 50 allocate-pair out + 50 allocate-pair out 51 var out-addr/eax: (addr cell) <- lookup *out 52 var left-ah/edx: (addr handle cell) <- get out-addr, left 53 new-symbol left-ah, "'" @@ -116,7 +116,7 @@ if ('onhashchange' in window) { 58 return close-paren?, dot? 59 } 60 # dot -> return - 61 var dot?/eax: boolean <- dot-token? curr-token + 61 var dot?/eax: boolean <- dot-token? curr-token 62 compare dot?, 0/false 63 { 64 break-if-= @@ -124,20 +124,20 @@ if ('onhashchange' in window) { 66 return 0/false, 1/true 67 } 68 # not bracket -> parse atom - 69 var bracket-token?/eax: boolean <- bracket-token? curr-token - 70 compare bracket-token?, 0/false + 69 var bracket-token?/eax: boolean <- bracket-token? curr-token + 70 compare bracket-token?, 0/false 71 { 72 break-if-!= 73 parse-atom curr-token, _out, trace 74 break $parse-sexpression:type-check 75 } 76 # open paren -> parse list - 77 var open-paren?/eax: boolean <- open-paren-token? curr-token + 77 var open-paren?/eax: boolean <- open-paren-token? curr-token 78 compare open-paren?, 0/false 79 { 80 break-if-= 81 var curr/esi: (addr handle cell) <- copy _out - 82 allocate-pair curr + 82 allocate-pair curr 83 var curr-addr/eax: (addr cell) <- lookup *curr 84 var left/edx: (addr handle cell) <- get curr-addr, left 85 { @@ -164,10 +164,10 @@ if ('onhashchange' in window) { 106 compare dot?, 0/false 107 { 108 break-if-= -109 parse-dot-tail tokens, curr, trace +109 parse-dot-tail tokens, curr, trace 110 return 0/false, 0/false 111 } -112 allocate-pair curr +112 allocate-pair curr 113 # ')' -> return 114 compare close-paren?, 0/false 115 break-if-!= @@ -182,7 +182,7 @@ if ('onhashchange' in window) { 124 break $parse-sexpression:type-check 125 } 126 # close paren -> return -127 var close-paren?/eax: boolean <- close-paren-token? curr-token +127 var close-paren?/eax: boolean <- close-paren-token? curr-token 128 compare close-paren?, 0/false 129 { 130 break-if-= @@ -211,15 +211,15 @@ if ('onhashchange' in window) { 153 var curr-token-data/esi: (addr stream byte) <- copy _curr-token-data 154 trace trace, "read", curr-token-data 155 # number -156 var number-token?/eax: boolean <- number-token? curr-token -157 compare number-token?, 0/false +156 var number-token?/eax: boolean <- number-token? curr-token +157 compare number-token?, 0/false 158 { 159 break-if-= 160 rewind-stream curr-token-data 161 var _val/eax: int <- parse-decimal-int-from-stream curr-token-data 162 var val/ecx: int <- copy _val 163 var val-float/xmm0: float <- convert val -164 allocate-number _out +164 allocate-number _out 165 var out/eax: (addr handle cell) <- copy _out 166 var out-addr/eax: (addr cell) <- lookup *out 167 var dest/edi: (addr float) <- get out-addr, number-data @@ -233,57 +233,68 @@ if ('onhashchange' in window) { 175 } 176 return 177 } -178 # default: symbol -179 # just copy token data -180 allocate-symbol _out -181 var out/eax: (addr handle cell) <- copy _out -182 var out-addr/eax: (addr cell) <- lookup *out -183 var curr-token-data-ah/ecx: (addr handle stream byte) <- get curr-token, text-data -184 var dest-ah/edx: (addr handle stream byte) <- get out-addr, text-data -185 copy-object curr-token-data-ah, dest-ah -186 { -187 var stream-storage: (stream byte 0x40) -188 var stream/ecx: (addr stream byte) <- address stream-storage -189 write stream, "=> symbol " -190 print-symbol out-addr, stream, 0/no-trace -191 trace trace, "read", stream -192 } -193 } -194 -195 fn parse-dot-tail tokens: (addr stream cell), _out: (addr handle cell), trace: (addr trace) { -196 var out/edi: (addr handle cell) <- copy _out -197 var close-paren?/eax: boolean <- copy 0/false -198 var dot?/ecx: boolean <- copy 0/false -199 close-paren?, dot? <- parse-sexpression tokens, out, trace -200 compare close-paren?, 0/false -201 { -202 break-if-= -203 error trace, "'. )' makes no sense" -204 return -205 } -206 compare dot?, 0/false -207 { -208 break-if-= -209 error trace, "'. .' makes no sense" -210 return -211 } -212 # -213 var dummy: (handle cell) -214 var dummy-ah/edi: (addr handle cell) <- address dummy -215 close-paren?, dot? <- parse-sexpression tokens, dummy-ah, trace -216 compare close-paren?, 0/false -217 { -218 break-if-!= -219 error trace, "cannot have multiple expressions between '.' and ')'" -220 return -221 } -222 compare dot?, 0/false -223 { -224 break-if-= -225 error trace, "cannot have two dots in a single list" -226 return -227 } -228 } +178 # default: copy either to a symbol or a stream +179 # stream token -> literal +180 var stream-token?/eax: boolean <- stream-token? curr-token +181 compare stream-token?, 0/false +182 { +183 break-if-= +184 allocate-stream _out +185 } +186 compare stream-token?, 0/false +187 { +188 break-if-!= +189 allocate-symbol _out +190 } +191 # copy token data +192 var out/eax: (addr handle cell) <- copy _out +193 var out-addr/eax: (addr cell) <- lookup *out +194 var curr-token-data-ah/ecx: (addr handle stream byte) <- get curr-token, text-data +195 var dest-ah/edx: (addr handle stream byte) <- get out-addr, text-data +196 copy-object curr-token-data-ah, dest-ah +197 { +198 var stream-storage: (stream byte 0x40) +199 var stream/ecx: (addr stream byte) <- address stream-storage +200 write stream, "=> symbol " +201 print-symbol out-addr, stream, 0/no-trace +202 trace trace, "read", stream +203 } +204 } +205 +206 fn parse-dot-tail tokens: (addr stream cell), _out: (addr handle cell), trace: (addr trace) { +207 var out/edi: (addr handle cell) <- copy _out +208 var close-paren?/eax: boolean <- copy 0/false +209 var dot?/ecx: boolean <- copy 0/false +210 close-paren?, dot? <- parse-sexpression tokens, out, trace +211 compare close-paren?, 0/false +212 { +213 break-if-= +214 error trace, "'. )' makes no sense" +215 return +216 } +217 compare dot?, 0/false +218 { +219 break-if-= +220 error trace, "'. .' makes no sense" +221 return +222 } +223 # +224 var dummy: (handle cell) +225 var dummy-ah/edi: (addr handle cell) <- address dummy +226 close-paren?, dot? <- parse-sexpression tokens, dummy-ah, trace +227 compare close-paren?, 0/false +228 { +229 break-if-!= +230 error trace, "cannot have multiple expressions between '.' and ')'" +231 return +232 } +233 compare dot?, 0/false +234 { +235 break-if-= +236 error trace, "cannot have two dots in a single list" +237 return +238 } +239 } diff --git a/html/shell/print.mu.html b/html/shell/print.mu.html index 802104e3..18c90801 100644 --- a/html/shell/print.mu.html +++ b/html/shell/print.mu.html @@ -147,14 +147,14 @@ if ('onhashchange' in window) { 88 print-cell in-ah, stream, 0/no-trace 89 var d1/eax: int <- copy 0 90 var d2/ecx: int <- copy 0 - 91 d1, d2 <- draw-stream-wrapping-right-then-down 0/screen, stream, 0/xmin, 0/ymin, 0x80/xmax, 0x30/ymax, 0/x, 0/y, 7/fg, 0/bg + 91 d1, d2 <- draw-stream-wrapping-right-then-down 0/screen, stream, 0/xmin, 0/ymin, 0x80/xmax, 0x30/ymax, 0/x, 0/y, 7/fg, 0xc5/bg=blue-bg 92 } 93 94 fn dump-cell-from-cursor-over-full-screen in-ah: (addr handle cell) { 95 var stream-storage: (stream byte 0x200) 96 var stream/edx: (addr stream byte) <- address stream-storage 97 print-cell in-ah, stream, 0/no-trace - 98 draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, stream, 7/fg, 0/bg + 98 draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, stream, 7/fg, 0xc5/bg=blue-bg 99 } 100 101 fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) { @@ -281,7 +281,7 @@ if ('onhashchange' in window) { 222 fn test-print-cell-zero { 223 var num-storage: (handle cell) 224 var num/esi: (addr handle cell) <- address num-storage -225 new-integer num, 0 +225 new-integer num, 0 226 var out-storage: (stream byte 0x40) 227 var out/edi: (addr stream byte) <- address out-storage 228 print-cell num, out, 0/no-trace @@ -291,7 +291,7 @@ if ('onhashchange' in window) { 232 fn test-print-cell-integer { 233 var num-storage: (handle cell) 234 var num/esi: (addr handle cell) <- address num-storage -235 new-integer num, 1 +235 new-integer num, 1 236 var out-storage: (stream byte 0x40) 237 var out/edi: (addr stream byte) <- address out-storage 238 print-cell num, out, 0/no-trace @@ -301,7 +301,7 @@ if ('onhashchange' in window) { 242 fn test-print-cell-integer-2 { 243 var num-storage: (handle cell) 244 var num/esi: (addr handle cell) <- address num-storage -245 new-integer num, 0x30 +245 new-integer num, 0x30 246 var out-storage: (stream byte 0x40) 247 var out/edi: (addr stream byte) <- address out-storage 248 print-cell num, out, 0/no-trace @@ -312,7 +312,7 @@ if ('onhashchange' in window) { 253 var num-storage: (handle cell) 254 var num/esi: (addr handle cell) <- address num-storage 255 var val/xmm0: float <- rational 1, 2 -256 new-float num, val +256 new-float num, val 257 var out-storage: (stream byte 0x40) 258 var out/edi: (addr stream byte) <- address out-storage 259 print-cell num, out, 0/no-trace @@ -331,11 +331,11 @@ if ('onhashchange' in window) { 272 273 fn test-print-cell-nil-list { 274 var nil-storage: (handle cell) -275 var nil/esi: (addr handle cell) <- address nil-storage -276 allocate-pair nil +275 var nil/esi: (addr handle cell) <- address nil-storage +276 allocate-pair nil 277 var out-storage: (stream byte 0x40) 278 var out/edi: (addr stream byte) <- address out-storage -279 print-cell nil, out, 0/no-trace +279 print-cell nil, out, 0/no-trace 280 check-stream-equal out, "()", "F - test-print-cell-nil-list" 281 } 282 @@ -345,11 +345,11 @@ if ('onhashchange' in window) { 286 var left/ecx: (addr handle cell) <- address left-storage 287 new-symbol left, "abc" 288 var nil-storage: (handle cell) -289 var nil/edx: (addr handle cell) <- address nil-storage -290 allocate-pair nil +289 var nil/edx: (addr handle cell) <- address nil-storage +290 allocate-pair nil 291 var list-storage: (handle cell) 292 var list/esi: (addr handle cell) <- address list-storage -293 new-pair list, *left, *nil +293 new-pair list, *left, *nil 294 # 295 var out-storage: (stream byte 0x40) 296 var out/edi: (addr stream byte) <- address out-storage @@ -363,14 +363,14 @@ if ('onhashchange' in window) { 304 var left/ecx: (addr handle cell) <- address left-storage 305 new-symbol left, "abc" 306 var nil-storage: (handle cell) -307 var nil/edx: (addr handle cell) <- address nil-storage -308 allocate-pair nil +307 var nil/edx: (addr handle cell) <- address nil-storage +308 allocate-pair nil 309 var list-storage: (handle cell) 310 var list/esi: (addr handle cell) <- address list-storage -311 new-pair list, *left, *nil +311 new-pair list, *left, *nil 312 # list = cons 64, list -313 new-integer left, 0x40 -314 new-pair list, *left, *list +313 new-integer left, 0x40 +314 new-pair list, *left, *list 315 # 316 var out-storage: (stream byte 0x40) 317 var out/edi: (addr stream byte) <- address out-storage @@ -382,16 +382,16 @@ if ('onhashchange' in window) { 323 # list = cons "abc", nil 324 var left-storage: (handle cell) 325 var left/ecx: (addr handle cell) <- address left-storage -326 allocate-pair left +326 allocate-pair left 327 var nil-storage: (handle cell) -328 var nil/edx: (addr handle cell) <- address nil-storage -329 allocate-pair nil +328 var nil/edx: (addr handle cell) <- address nil-storage +329 allocate-pair nil 330 var list-storage: (handle cell) 331 var list/esi: (addr handle cell) <- address list-storage -332 new-pair list, *left, *nil +332 new-pair list, *left, *nil 333 # list = cons 64, list -334 new-integer left, 0x40 -335 new-pair list, *left, *list +334 new-integer left, 0x40 +335 new-pair list, *left, *list 336 # 337 var out-storage: (stream byte 0x40) 338 var out/edi: (addr stream byte) <- address out-storage @@ -406,10 +406,10 @@ if ('onhashchange' in window) { 347 new-symbol left, "abc" 348 var right-storage: (handle cell) 349 var right/edx: (addr handle cell) <- address right-storage -350 new-integer right, 0x40 +350 new-integer right, 0x40 351 var list-storage: (handle cell) 352 var list/esi: (addr handle cell) <- address list-storage -353 new-pair list, *left, *right +353 new-pair list, *left, *right 354 # 355 var out-storage: (stream byte 0x40) 356 var out/edi: (addr stream byte) <- address out-storage diff --git a/html/shell/sandbox.mu.html b/html/shell/sandbox.mu.html index f1ba3b65..4d2be852 100644 --- a/html/shell/sandbox.mu.html +++ b/html/shell/sandbox.mu.html @@ -57,1006 +57,902 @@ if ('onhashchange' in window) { https://github.com/akkartik/mu/blob/main/shell/sandbox.mu 
-   1 type sandbox {
-   2   data: (handle gap-buffer)
-   3   value: (handle stream byte)
-   4   screen-var: (handle cell)
-   5   keyboard-var: (handle cell)
-   6   trace: (handle trace)
-   7   cursor-in-data?: boolean
-   8   cursor-in-keyboard?: boolean
-   9   cursor-in-trace?: boolean
-  10 }
-  11 
-  12 fn initialize-sandbox _self: (addr sandbox), fake-screen-and-keyboard?: boolean {
-  13   var self/esi: (addr sandbox) <- copy _self
-  14   var data-ah/eax: (addr handle gap-buffer) <- get self, data
-  15   allocate data-ah
-  16   var data/eax: (addr gap-buffer) <- lookup *data-ah
-  17   initialize-gap-buffer data, 0x1000/4KB
-  18   #
-  19   var value-ah/eax: (addr handle stream byte) <- get self, value
-  20   populate-stream value-ah, 0x1000/4KB
-  21   #
-  22   {
-  23     compare fake-screen-and-keyboard?, 0/false
-  24     break-if-=
-  25     var screen-ah/eax: (addr handle cell) <- get self, screen-var
-  26     new-fake-screen screen-ah, 5/width, 4/height, 1/enable-pixel-graphics
-  27     var keyboard-ah/eax: (addr handle cell) <- get self, keyboard-var
-  28     new-fake-keyboard keyboard-ah, 0x10/keyboard-capacity
-  29   }
-  30   #
-  31   var trace-ah/eax: (addr handle trace) <- get self, trace
-  32   allocate trace-ah
-  33   var trace/eax: (addr trace) <- lookup *trace-ah
-  34   initialize-trace trace, 0x8000/lines, 0x80/visible-lines
-  35   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
-  36   copy-to *cursor-in-data?, 1/true
-  37 }
-  38 
-  39 ## some helpers for tests
-  40 
-  41 fn initialize-sandbox-with _self: (addr sandbox), s: (addr array byte) {
-  42   var self/esi: (addr sandbox) <- copy _self
-  43   var data-ah/eax: (addr handle gap-buffer) <- get self, data
-  44   allocate data-ah
-  45   var data/eax: (addr gap-buffer) <- lookup *data-ah
-  46   initialize-gap-buffer-with data, s
-  47 }
-  48 
-  49 fn allocate-sandbox-with _out: (addr handle sandbox), s: (addr array byte) {
-  50   var out/eax: (addr handle sandbox) <- copy _out
-  51   allocate out
-  52   var out-addr/eax: (addr sandbox) <- lookup *out
-  53   initialize-sandbox-with out-addr, s
-  54 }
-  55 
-  56 fn write-sandbox out: (addr stream byte), _self: (addr sandbox) {
-  57   var self/eax: (addr sandbox) <- copy _self
-  58   var data-ah/eax: (addr handle gap-buffer) <- get self, data
-  59   var data/eax: (addr gap-buffer) <- lookup *data-ah
-  60   {
-  61     var len/eax: int <- gap-buffer-length data
-  62     compare len, 0
-  63     break-if-!=
-  64     return
-  65   }
-  66   write out, "  (sandbox . "
-  67   append-gap-buffer data, out
-  68   write out, ")\n"
-  69 }
-  70 
-  71 ##
-  72 
-  73 fn render-sandbox screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int {
-  74   clear-rect screen, xmin, ymin, xmax, ymax, 0/bg=black
-  75   var self/esi: (addr sandbox) <- copy _self
-  76   # data
-  77   var data-ah/eax: (addr handle gap-buffer) <- get self, data
-  78   var _data/eax: (addr gap-buffer) <- lookup *data-ah
-  79   var data/edx: (addr gap-buffer) <- copy _data
-  80   var x/eax: int <- copy xmin
-  81   var y/ecx: int <- copy ymin
-  82   y <- maybe-render-empty-screen screen, self, xmin, y
-  83   y <- maybe-render-keyboard screen, self, xmin, y
-  84   var cursor-in-sandbox?/ebx: (addr boolean) <- get self, cursor-in-data?
-  85   x, y <- render-gap-buffer-wrapping-right-then-down screen, data, x, y, xmax, ymax, *cursor-in-sandbox?
-  86   y <- increment
-  87   # trace
-  88   var trace-ah/eax: (addr handle trace) <- get self, trace
-  89   var _trace/eax: (addr trace) <- lookup *trace-ah
-  90   var trace/edx: (addr trace) <- copy _trace
-  91   var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
-  92   y <- render-trace screen, trace, xmin, y, xmax, ymax, *cursor-in-trace?
-  93   # value
-  94   $render-sandbox:value: {
-  95     var value-ah/eax: (addr handle stream byte) <- get self, value
-  96     var _value/eax: (addr stream byte) <- lookup *value-ah
-  97     var value/esi: (addr stream byte) <- copy _value
-  98     rewind-stream value
-  99     var done?/eax: boolean <- stream-empty? value
- 100     compare done?, 0/false
- 101     break-if-!=
- 102     var x/eax: int <- copy 0
- 103     x, y <- draw-text-wrapping-right-then-down screen, "=> ", xmin, y, xmax, ymax, xmin, y, 7/fg, 0/bg
- 104     var x2/edx: int <- copy x
- 105     var dummy/eax: int <- draw-stream-rightward screen, value, x2, xmax, y, 7/fg=grey, 0/bg
- 106   }
- 107   y <- add 2  # padding
- 108   y <- maybe-render-screen screen, self, xmin, y
- 109   # render menu
- 110   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
- 111   compare *cursor-in-data?, 0/false
- 112   {
- 113     break-if-=
- 114     render-sandbox-menu screen, self
- 115     return
- 116   }
- 117   var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
- 118   compare *cursor-in-trace?, 0/false
- 119   {
- 120     break-if-=
- 121     render-trace-menu screen
- 122     return
- 123   }
- 124   var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
- 125   compare *cursor-in-keyboard?, 0/false
- 126   {
- 127     break-if-=
- 128     render-keyboard-menu screen
- 129     return
- 130   }
- 131 }
- 132 
- 133 fn clear-sandbox-output screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int {
- 134   # render just enough of the sandbox to figure out what to erase
- 135   var self/esi: (addr sandbox) <- copy _self
- 136   var data-ah/eax: (addr handle gap-buffer) <- get self, data
- 137   var _data/eax: (addr gap-buffer) <- lookup *data-ah
- 138   var data/edx: (addr gap-buffer) <- copy _data
- 139   var x/eax: int <- copy xmin
- 140   var y/ecx: int <- copy ymin
- 141   y <- maybe-render-empty-screen screen, self, xmin, y
- 142   y <- maybe-render-keyboard screen, self, xmin, y
- 143   var cursor-in-sandbox?/ebx: (addr boolean) <- get self, cursor-in-data?
- 144   x, y <- render-gap-buffer-wrapping-right-then-down screen, data, x, y, xmax, ymax, *cursor-in-sandbox?
- 145   y <- increment
- 146   clear-rect screen, xmin, y, xmax, ymax, 0/bg=black
- 147 }
- 148 
- 149 fn maybe-render-empty-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
- 150   var self/esi: (addr sandbox) <- copy _self
- 151   var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var
- 152   var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah
- 153   compare screen-obj-cell, 0
- 154   {
- 155     break-if-!=
- 156     return ymin
- 157   }
- 158   var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type
- 159   compare *screen-obj-cell-type, 5/screen
- 160   {
- 161     break-if-=
- 162     return ymin  # silently give up on rendering the screen
- 163   }
- 164   var y/ecx: int <- copy ymin
- 165   var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data
- 166   var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
- 167   var screen-obj/edx: (addr screen) <- copy _screen-obj
- 168   var x/eax: int <- draw-text-rightward screen, "screen:   ", xmin, 0x99/xmax, y, 7/fg, 0/bg
- 169   y <- render-empty-screen screen, screen-obj, x, y
- 170   return y
- 171 }
- 172 
- 173 fn maybe-render-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
- 174   var self/esi: (addr sandbox) <- copy _self
- 175   var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var
- 176   var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah
- 177   compare screen-obj-cell, 0
- 178   {
- 179     break-if-!=
- 180     return ymin
- 181   }
- 182   var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type
- 183   compare *screen-obj-cell-type, 5/screen
- 184   {
- 185     break-if-=
- 186     return ymin  # silently give up on rendering the screen
- 187   }
- 188   var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data
- 189   var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
- 190   var screen-obj/edx: (addr screen) <- copy _screen-obj
- 191   {
- 192     var screen-empty?/eax: boolean <- fake-screen-empty? screen-obj
- 193     compare screen-empty?, 0/false
- 194     break-if-=
- 195     return ymin
- 196   }
- 197   var x/eax: int <- draw-text-rightward screen, "screen:   ", xmin, 0x99/xmax, ymin, 7/fg, 0/bg
- 198   var y/ecx: int <- copy ymin
- 199   y <- render-screen screen, screen-obj, x, y
- 200   return y
- 201 }
- 202 
- 203 fn render-empty-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int {
- 204   var target-screen/esi: (addr screen) <- copy _target-screen
- 205   var screen-y/edi: int <- copy ymin
- 206   # top border
- 207   {
- 208     set-cursor-position screen, xmin, screen-y
- 209     move-cursor-right screen
- 210     var width/edx: (addr int) <- get target-screen, width
- 211     var x/ebx: int <- copy 0
- 212     {
- 213       compare x, *width
- 214       break-if->=
- 215       draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
- 216       move-cursor-right screen
- 217       x <- increment
- 218       loop
- 219     }
- 220     screen-y <- increment
- 221   }
- 222   # screen
- 223   var height/edx: (addr int) <- get target-screen, height
- 224   var y/ecx: int <- copy 0
- 225   {
- 226     compare y, *height
- 227     break-if->=
- 228     set-cursor-position screen, xmin, screen-y
- 229     draw-code-point-at-cursor screen, 0x7c/vertical-bar, 0x18/fg, 0/bg
- 230     move-cursor-right screen
- 231     var width/edx: (addr int) <- get target-screen, width
- 232     var x/ebx: int <- copy 0
- 233     {
- 234       compare x, *width
- 235       break-if->=
- 236       draw-code-point-at-cursor screen, 0x20/space, 0x18/fg, 0/bg
- 237       move-cursor-right screen
- 238       x <- increment
- 239       loop
- 240     }
- 241     draw-code-point-at-cursor screen, 0x7c/vertical-bar, 0x18/fg, 0/bg
- 242     y <- increment
- 243     screen-y <- increment
- 244     loop
- 245   }
- 246   # bottom border
- 247   {
- 248     set-cursor-position screen, xmin, screen-y
- 249     move-cursor-right screen
- 250     var width/edx: (addr int) <- get target-screen, width
- 251     var x/ebx: int <- copy 0
- 252     {
- 253       compare x, *width
- 254       break-if->=
- 255       draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
- 256       move-cursor-right screen
- 257       x <- increment
- 258       loop
- 259     }
- 260     screen-y <- increment
- 261   }
- 262   return screen-y
- 263 }
- 264 
- 265 fn render-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int {
- 266   var target-screen/esi: (addr screen) <- copy _target-screen
- 267   var screen-y/edi: int <- copy ymin
- 268   # top border
- 269   {
- 270     set-cursor-position screen, xmin, screen-y
- 271     move-cursor-right screen
- 272     var width/edx: (addr int) <- get target-screen, width
- 273     var x/ebx: int <- copy 0
- 274     {
- 275       compare x, *width
- 276       break-if->=
- 277       draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
- 278       move-cursor-right screen
- 279       x <- increment
- 280       loop
- 281     }
- 282     screen-y <- increment
- 283   }
- 284   # text data
- 285   {
- 286     var height/edx: (addr int) <- get target-screen, height
- 287     var y/ecx: int <- copy 0
- 288     {
- 289       compare y, *height
- 290       break-if->=
- 291       set-cursor-position screen, xmin, screen-y
- 292       draw-code-point-at-cursor screen, 0x7c/vertical-bar, 0x18/fg, 0/bg
- 293       move-cursor-right screen
- 294       var width/edx: (addr int) <- get target-screen, width
- 295       var x/ebx: int <- copy 0
- 296       {
- 297         compare x, *width
- 298         break-if->=
- 299         print-screen-cell-of-fake-screen screen, target-screen, x, y
- 300         move-cursor-right screen
- 301         x <- increment
- 302         loop
- 303       }
- 304       draw-code-point-at-cursor screen, 0x7c/vertical-bar, 0x18/fg, 0/bg
- 305       y <- increment
- 306       screen-y <- increment
- 307       loop
- 308     }
- 309   }
- 310   # pixel data
- 311   {
- 312     # screen top left pixels x y width height
- 313     var tmp/eax: int <- copy xmin
- 314     tmp <- add 1/margin-left
- 315     tmp <- shift-left 3/log2-font-width
- 316     var left: int
- 317     copy-to left, tmp
- 318     tmp <- copy ymin
- 319     tmp <- add 1/margin-top
- 320     tmp <- shift-left 4/log2-font-height
- 321     var top: int
- 322     copy-to top, tmp
- 323     var pixels-ah/eax: (addr handle array byte) <- get target-screen, pixels
- 324     var _pixels/eax: (addr array byte) <- lookup *pixels-ah
- 325     var pixels/edi: (addr array byte) <- copy _pixels
- 326     compare pixels, 0
- 327     break-if-=
- 328     var y/ebx: int <- copy 0
- 329     var height-addr/edx: (addr int) <- get target-screen, height
- 330     var height/edx: int <- copy *height-addr
- 331     height <- shift-left 4/log2-font-height
- 332     {
- 333       compare y, height
- 334       break-if->=
- 335       var width-addr/edx: (addr int) <- get target-screen, width
- 336       var width/edx: int <- copy *width-addr
- 337       width <- shift-left 3/log2-font-width
- 338       var x/eax: int <- copy 0
- 339       {
- 340         compare x, width
- 341         break-if->=
- 342         {
- 343           var idx/ecx: int <- pixel-index target-screen, x, y
- 344           var color-addr/ecx: (addr byte) <- index pixels, idx
- 345           var color/ecx: byte <- copy-byte *color-addr
- 346           var color2/ecx: int <- copy color
- 347           compare color2, 0
- 348           break-if-=
- 349           var x2/eax: int <- copy x
- 350           x2 <- add left
- 351           var y2/ebx: int <- copy y
- 352           y2 <- add top
- 353           pixel screen, x2, y2, color2
- 354         }
- 355         x <- increment
- 356         loop
- 357       }
- 358       y <- increment
- 359       loop
- 360     }
- 361   }
- 362   # bottom border
- 363   {
- 364     set-cursor-position screen, xmin, screen-y
- 365     move-cursor-right screen
- 366     var width/edx: (addr int) <- get target-screen, width
- 367     var x/ebx: int <- copy 0
- 368     {
- 369       compare x, *width
- 370       break-if->=
- 371       draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
- 372       move-cursor-right screen
- 373       x <- increment
- 374       loop
- 375     }
- 376     screen-y <- increment
- 377   }
- 378   return screen-y
- 379 }
- 380 
- 381 fn has-keyboard? _self: (addr sandbox) -> _/eax: boolean {
- 382   var self/esi: (addr sandbox) <- copy _self
- 383   var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
- 384   var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah
- 385   compare keyboard-obj-cell, 0
- 386   {
- 387     break-if-!=
- 388     return 0/false
- 389   }
- 390   var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type
- 391   compare *keyboard-obj-cell-type, 6/keyboard
- 392   {
- 393     break-if-=
- 394     return 0/false
- 395   }
- 396   var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data
- 397   var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah
- 398   var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj
- 399   compare keyboard-obj, 0
- 400   {
- 401     break-if-!=
- 402     return 0/false
- 403   }
- 404   return 1/true
- 405 }
- 406 
- 407 fn maybe-render-keyboard screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
- 408   var self/esi: (addr sandbox) <- copy _self
- 409   var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
- 410   var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah
- 411   compare keyboard-obj-cell, 0
- 412   {
- 413     break-if-!=
- 414     return ymin
- 415   }
- 416   var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type
- 417   compare *keyboard-obj-cell-type, 6/keyboard
- 418   {
- 419     break-if-=
- 420     return ymin  # silently give up on rendering the keyboard
- 421   }
- 422   var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data
- 423   var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah
- 424   var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj
- 425   var x/eax: int <- draw-text-rightward screen, "keyboard: ", xmin, 0x99/xmax, ymin, 7/fg, 0/bg
- 426   var y/ecx: int <- copy ymin
- 427   var cursor-in-keyboard?/esi: (addr boolean) <- get self, cursor-in-keyboard?
- 428   y <- render-keyboard screen, keyboard-obj, x, y, *cursor-in-keyboard?
- 429   y <- increment  # padding
- 430   return y
- 431 }
- 432 
- 433 # draw an evocative shape
- 434 fn render-keyboard screen: (addr screen), _keyboard: (addr gap-buffer), xmin: int, ymin: int, render-cursor?: boolean -> _/ecx: int {
- 435   var keyboard/esi: (addr gap-buffer) <- copy _keyboard
- 436   var width/edx: int <- copy 0x10/keyboard-capacity
- 437   var y/edi: int <- copy ymin
- 438   # top border
- 439   {
- 440     set-cursor-position screen, xmin, y
- 441     move-cursor-right screen
- 442     var x/ebx: int <- copy 0
- 443     {
- 444       compare x, width
- 445       break-if->=
- 446       draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
- 447       move-cursor-right screen
- 448       x <- increment
- 449       loop
- 450     }
- 451     y <- increment
- 452   }
- 453   # keyboard
- 454   var x/eax: int <- copy xmin
- 455   draw-code-point screen, 0x7c/vertical-bar, x, y, 0x18/fg, 0/bg
- 456   x <- increment
- 457   x <- render-gap-buffer screen, keyboard, x, y, render-cursor?
- 458   x <- copy xmin
- 459   x <- add 1  # for left bar
- 460   x <- add 0x10/keyboard-capacity
- 461   draw-code-point screen, 0x7c/vertical-bar, x, y, 0x18/fg, 0/bg
- 462   y <- increment
- 463   # bottom border
- 464   {
- 465     set-cursor-position screen, xmin, y
- 466     move-cursor-right screen
- 467     var x/ebx: int <- copy 0
- 468     {
- 469       compare x, width
- 470       break-if->=
- 471       draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
- 472       move-cursor-right screen
- 473       x <- increment
- 474       loop
- 475     }
- 476     y <- increment
- 477   }
- 478   return y
- 479 }
- 480 
- 481 fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), x: int, y: int {
- 482   var target/ecx: (addr screen) <- copy _target
- 483   var data-ah/eax: (addr handle array screen-cell) <- get target, data
- 484   var data/eax: (addr array screen-cell) <- lookup *data-ah
- 485   var index/ecx: int <- screen-cell-index target, x, y
- 486   var offset/ecx: (offset screen-cell) <- compute-offset data, index
- 487   var src-cell/esi: (addr screen-cell) <- index data, offset
- 488   var src-grapheme/eax: (addr grapheme) <- get src-cell, data
- 489   var src-color/ecx: (addr int) <- get src-cell, color
- 490   var src-background-color/edx: (addr int) <- get src-cell, background-color
- 491   draw-grapheme-at-cursor screen, *src-grapheme, *src-color, *src-background-color
- 492 }
- 493 
- 494 fn render-sandbox-menu screen: (addr screen), _self: (addr sandbox) {
- 495   var _width/eax: int <- copy 0
- 496   var height/ecx: int <- copy 0
- 497   _width, height <- screen-size screen
- 498   var width/edx: int <- copy _width
- 499   var y/ecx: int <- copy height
- 500   y <- decrement
- 501   var height/ebx: int <- copy y
- 502   height <- increment
- 503   clear-rect screen, 0/x, y, width, height, 0/bg=black
- 504   set-cursor-position screen, 0/x, y
- 505   draw-text-rightward-from-cursor screen, " ctrl-r ", width, 0/fg, 7/bg=grey
- 506   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0/bg
- 507   draw-text-rightward-from-cursor screen, " ctrl-s ", width, 0/fg, 7/bg=grey
- 508   draw-text-rightward-from-cursor screen, " run sandbox  ", width, 7/fg, 0/bg
- 509   $render-sandbox-menu:render-tab: {
- 510     var self/eax: (addr sandbox) <- copy _self
- 511     var has-trace?/eax: boolean <- has-trace? self
- 512     compare has-trace?, 0/false
- 513     {
- 514       break-if-=
- 515       draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 9/bg=blue
- 516       draw-text-rightward-from-cursor screen, " to trace  ", width, 7/fg, 0/bg
- 517       break $render-sandbox-menu:render-tab
- 518     }
- 519     draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 0x18/bg=keyboard
- 520     draw-text-rightward-from-cursor screen, " to keyboard  ", width, 7/fg, 0/bg
- 521   }
- 522   draw-text-rightward-from-cursor screen, " ctrl-a ", width, 0/fg, 7/bg=grey
- 523   draw-text-rightward-from-cursor screen, " <<  ", width, 7/fg, 0/bg
- 524   draw-text-rightward-from-cursor screen, " ctrl-b ", width, 0/fg, 7/bg=grey
- 525   draw-text-rightward-from-cursor screen, " <word  ", width, 7/fg, 0/bg
- 526   draw-text-rightward-from-cursor screen, " ctrl-f ", width, 0/fg, 7/bg=grey
- 527   draw-text-rightward-from-cursor screen, " word>  ", width, 7/fg, 0/bg
- 528   draw-text-rightward-from-cursor screen, " ctrl-e ", width, 0/fg, 7/bg=grey
- 529   draw-text-rightward-from-cursor screen, " >>  ", width, 7/fg, 0/bg
- 530 }
- 531 
- 532 fn render-keyboard-menu screen: (addr screen) {
- 533   var width/eax: int <- copy 0
- 534   var height/ecx: int <- copy 0
- 535   width, height <- screen-size screen
- 536   var y/ecx: int <- copy height
- 537   y <- decrement
- 538   var height/edx: int <- copy y
- 539   height <- increment
- 540   clear-rect screen, 0/x, y, width, height, 0/bg=black
- 541   set-cursor-position screen, 0/x, y
- 542   draw-text-rightward-from-cursor screen, " ctrl-r ", width, 0/fg, 7/bg=grey
- 543   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0/bg
- 544   draw-text-rightward-from-cursor screen, " ctrl-s ", width, 0/fg, 7/bg=grey
- 545   draw-text-rightward-from-cursor screen, " run sandbox  ", width, 7/fg, 0/bg
- 546   draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 3/bg=cyan
- 547   draw-text-rightward-from-cursor screen, " to sandbox  ", width, 7/fg, 0/bg
- 548 }
- 549 
- 550 fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table), data-disk: (addr disk), real-screen: (addr screen), tweak-real-screen?: boolean {
- 551   var self/esi: (addr sandbox) <- copy _self
- 552   var g/edx: grapheme <- copy key
- 553   # ctrl-s
- 554   {
- 555     compare g, 0x13/ctrl-s
- 556     break-if-!=
- 557     # minor gotcha here: any bindings created later in this iteration won't be
- 558     # persisted.
- 559     # That's ok since we don't clear the gap buffer. If we start doing so
- 560     # we'll need to revisit where serialization happens.
- 561     store-state data-disk, self, globals
- 562     # run sandbox
- 563     var data-ah/eax: (addr handle gap-buffer) <- get self, data
- 564     var _data/eax: (addr gap-buffer) <- lookup *data-ah
- 565     var data/ecx: (addr gap-buffer) <- copy _data
- 566     var value-ah/eax: (addr handle stream byte) <- get self, value
- 567     var _value/eax: (addr stream byte) <- lookup *value-ah
- 568     var value/edx: (addr stream byte) <- copy _value
- 569     var trace-ah/eax: (addr handle trace) <- get self, trace
- 570     var _trace/eax: (addr trace) <- lookup *trace-ah
- 571     var trace/ebx: (addr trace) <- copy _trace
- 572     clear-trace trace
- 573     {
- 574       compare tweak-real-screen?, 0/false
- 575       break-if-=
- 576       clear-sandbox-output real-screen, self, 0x40/sandbox-left-margin, 0/y, 0x80/screen-width, 0x2f/screen-height-without-menu
- 577     }
- 578     var screen-cell/eax: (addr handle cell) <- get self, screen-var
- 579     clear-screen-cell screen-cell
- 580     var keyboard-cell/esi: (addr handle cell) <- get self, keyboard-var
- 581     rewind-keyboard-cell keyboard-cell  # don't clear keys from before
- 582     {
- 583       compare tweak-real-screen?, 0/false
- 584       break-if-=
- 585       set-cursor-position real-screen, 0/x, 0/y  # for any debug prints during evaluation
- 586     }
- 587     run data, value, globals, trace, screen-cell, keyboard-cell
- 588     return
- 589   }
- 590   # tab
- 591   {
- 592     compare g, 9/tab
- 593     break-if-!=
- 594     # if cursor in data, switch to trace or fall through to keyboard
- 595     {
- 596       var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
- 597       compare *cursor-in-data?, 0/false
- 598       break-if-=
- 599       var has-trace?/eax: boolean <- has-trace? self
- 600       compare has-trace?, 0/false
- 601       {
- 602         break-if-=
- 603         var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
- 604         copy-to *cursor-in-data?, 0/false
- 605         var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
- 606         copy-to *cursor-in-trace?, 1/false
- 607         return
- 608       }
- 609       var has-keyboard?/eax: boolean <- has-keyboard? self
- 610       compare has-keyboard?, 0/false
- 611       {
- 612         break-if-=
- 613         var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
- 614         copy-to *cursor-in-data?, 0/false
- 615         var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
- 616         copy-to *cursor-in-keyboard?, 1/false
- 617         return
- 618       }
- 619       return
- 620     }
- 621     # if cursor in trace, switch to keyboard or fall through to data
- 622     {
- 623       var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
- 624       compare *cursor-in-trace?, 0/false
- 625       break-if-=
- 626       copy-to *cursor-in-trace?, 0/false
- 627       var cursor-target/ecx: (addr boolean) <- get self, cursor-in-keyboard?
- 628       var has-keyboard?/eax: boolean <- has-keyboard? self
- 629       compare has-keyboard?, 0/false
- 630       {
- 631         break-if-!=
- 632         cursor-target <- get self, cursor-in-data?
- 633       }
- 634       copy-to *cursor-target, 1/true
- 635       return
- 636     }
- 637     # otherwise if cursor in keyboard, switch to data
- 638     {
- 639       var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
- 640       compare *cursor-in-keyboard?, 0/false
- 641       break-if-=
- 642       copy-to *cursor-in-keyboard?, 0/false
- 643       var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
- 644       copy-to *cursor-in-data?, 1/true
- 645       return
- 646     }
- 647     return
- 648   }
- 649   # if cursor in data, send key to data
- 650   {
- 651     var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
- 652     compare *cursor-in-data?, 0/false
- 653     break-if-=
- 654     var data-ah/eax: (addr handle gap-buffer) <- get self, data
- 655     var data/eax: (addr gap-buffer) <- lookup *data-ah
- 656     edit-gap-buffer data, g
- 657     return
- 658   }
- 659   # if cursor in keyboard, send key to keyboard
- 660   {
- 661     var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
- 662     compare *cursor-in-keyboard?, 0/false
- 663     break-if-=
- 664     var keyboard-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
- 665     var keyboard-cell/eax: (addr cell) <- lookup *keyboard-cell-ah
- 666     compare keyboard-cell, 0
- 667     {
- 668       break-if-!=
- 669       return
- 670     }
- 671     var keyboard-cell-type/ecx: (addr int) <- get keyboard-cell, type
- 672     compare *keyboard-cell-type, 6/keyboard
- 673     {
- 674       break-if-=
- 675       return
- 676     }
- 677     var keyboard-ah/eax: (addr handle gap-buffer) <- get keyboard-cell, keyboard-data
- 678     var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
- 679     edit-gap-buffer keyboard, g
- 680     return
- 681   }
- 682   # if cursor in trace, send key to trace
- 683   {
- 684     var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
- 685     compare *cursor-in-trace?, 0/false
- 686     break-if-=
- 687     var trace-ah/eax: (addr handle trace) <- get self, trace
- 688     var trace/eax: (addr trace) <- lookup *trace-ah
- 689     edit-trace trace, g
- 690     return
- 691   }
- 692 }
- 693 
- 694 fn run in: (addr gap-buffer), out: (addr stream byte), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
- 695   var read-result-storage: (handle cell)
- 696   var read-result/esi: (addr handle cell) <- address read-result-storage
- 697   read-cell in, read-result, trace
- 698   var error?/eax: boolean <- has-errors? trace
- 699   {
- 700     compare error?, 0/false
- 701     break-if-=
- 702     return
- 703   }
- 704   var nil-storage: (handle cell)
- 705   var nil-ah/eax: (addr handle cell) <- address nil-storage
- 706   allocate-pair nil-ah
- 707   var eval-result-storage: (handle cell)
- 708   var eval-result/edi: (addr handle cell) <- address eval-result-storage
- 709   debug-print "^", 4/fg, 0/bg
- 710   evaluate read-result, eval-result, *nil-ah, globals, trace, screen-cell, keyboard-cell, 1/call-number
- 711   debug-print "$", 4/fg, 0/bg
- 712   var error?/eax: boolean <- has-errors? trace
- 713   {
- 714     compare error?, 0/false
- 715     break-if-=
- 716     return
- 717   }
- 718   clear-stream out
- 719   print-cell eval-result, out, trace
- 720   mark-lines-dirty trace
- 721 }
- 722 
- 723 fn test-run-integer {
- 724   var sandbox-storage: sandbox
- 725   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 726   initialize-sandbox sandbox, 0/no-screen-or-keyboard
- 727   # type "1"
- 728   edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 729   # eval
- 730   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 731   # setup: screen
- 732   var screen-on-stack: screen
- 733   var screen/edi: (addr screen) <- address screen-on-stack
- 734   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 735   #
- 736   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 737   check-screen-row screen, 0/y, "1    ", "F - test-run-integer/0"
- 738   check-screen-row screen, 1/y, "...  ", "F - test-run-integer/1"
- 739   check-screen-row screen, 2/y, "=> 1 ", "F - test-run-integer/2"
- 740 }
- 741 
- 742 fn test-run-with-spaces {
- 743   var sandbox-storage: sandbox
- 744   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 745   initialize-sandbox sandbox, 0/no-screen-or-keyboard
- 746   # type input with whitespace before and after
- 747   edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 748   edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 749   edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 750   edit-sandbox sandbox, 0xa/newline, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 751   # eval
- 752   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 753   # setup: screen
- 754   var screen-on-stack: screen
- 755   var screen/edi: (addr screen) <- address screen-on-stack
- 756   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 757   #
- 758   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 759   check-screen-row screen, 0/y, " 1   ", "F - test-run-with-spaces/0"
- 760   check-screen-row screen, 1/y, "     ", "F - test-run-with-spaces/1"
- 761   check-screen-row screen, 2/y, "...  ", "F - test-run-with-spaces/2"
- 762   check-screen-row screen, 3/y, "=> 1 ", "F - test-run-with-spaces/3"
- 763 }
- 764 
- 765 fn test-run-quote {
- 766   var sandbox-storage: sandbox
- 767   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 768   initialize-sandbox sandbox, 0/no-screen-or-keyboard
- 769   # type "'a"
- 770   edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 771   edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 772   # eval
- 773   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 774   # setup: screen
- 775   var screen-on-stack: screen
- 776   var screen/edi: (addr screen) <- address screen-on-stack
- 777   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 778   #
- 779   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 780   check-screen-row screen, 0/y, "'a   ", "F - test-run-quote/0"
- 781   check-screen-row screen, 1/y, "...  ", "F - test-run-quote/1"
- 782   check-screen-row screen, 2/y, "=> a ", "F - test-run-quote/2"
- 783 }
- 784 
- 785 fn test-run-dotted-list {
- 786   var sandbox-storage: sandbox
- 787   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 788   initialize-sandbox sandbox, 0/no-screen-or-keyboard
- 789   # type "'(a . b)"
- 790   edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 791   edit-sandbox sandbox, 0x28/open-paren, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 792   edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 793   edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 794   edit-sandbox sandbox, 0x2e/dot, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 795   edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 796   edit-sandbox sandbox, 0x62/b, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 797   edit-sandbox sandbox, 0x29/close-paren, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 798   # eval
- 799   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 800   # setup: screen
- 801   var screen-on-stack: screen
- 802   var screen/edi: (addr screen) <- address screen-on-stack
- 803   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 804   #
- 805   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 806   check-screen-row screen, 0/y, "'(a . b)   ", "F - test-run-dotted-list/0"
- 807   check-screen-row screen, 1/y, "...        ", "F - test-run-dotted-list/1"
- 808   check-screen-row screen, 2/y, "=> (a . b) ", "F - test-run-dotted-list/2"
- 809 }
- 810 
- 811 fn test-run-dot-and-list {
- 812   var sandbox-storage: sandbox
- 813   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 814   initialize-sandbox sandbox, 0/no-screen-or-keyboard
- 815   # type "'(a . (b))"
- 816   edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 817   edit-sandbox sandbox, 0x28/open-paren, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 818   edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 819   edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 820   edit-sandbox sandbox, 0x2e/dot, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 821   edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 822   edit-sandbox sandbox, 0x28/open-paren, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 823   edit-sandbox sandbox, 0x62/b, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 824   edit-sandbox sandbox, 0x29/close-paren, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 825   edit-sandbox sandbox, 0x29/close-paren, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 826   # eval
- 827   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 828   # setup: screen
- 829   var screen-on-stack: screen
- 830   var screen/edi: (addr screen) <- address screen-on-stack
- 831   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 832   #
- 833   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 834   check-screen-row screen, 0/y, "'(a . (b)) ", "F - test-run-dot-and-list/0"
- 835   check-screen-row screen, 1/y, "...        ", "F - test-run-dot-and-list/1"
- 836   check-screen-row screen, 2/y, "=> (a b)   ", "F - test-run-dot-and-list/2"
- 837 }
- 838 
- 839 fn test-run-final-dot {
- 840   var sandbox-storage: sandbox
- 841   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 842   initialize-sandbox sandbox, 0/no-screen-or-keyboard
- 843   # type "'(a .)"
- 844   edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 845   edit-sandbox sandbox, 0x28/open-paren, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 846   edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 847   edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 848   edit-sandbox sandbox, 0x2e/dot, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 849   edit-sandbox sandbox, 0x29/close-paren, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 850   # eval
- 851   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 852   # setup: screen
- 853   var screen-on-stack: screen
- 854   var screen/edi: (addr screen) <- address screen-on-stack
- 855   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 856   #
- 857   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 858   check-screen-row screen, 0/y, "'(a .)               ", "F - test-run-final-dot/0"
- 859   check-screen-row screen, 1/y, "...                  ", "F - test-run-final-dot/1"
- 860   check-screen-row screen, 2/y, "'. )' makes no sense ", "F - test-run-final-dot/2"
- 861   # further errors may occur
- 862 }
- 863 
- 864 fn test-run-double-dot {
- 865   var sandbox-storage: sandbox
- 866   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 867   initialize-sandbox sandbox, 0/no-screen-or-keyboard
- 868   # type "'(a . .)"
- 869   edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 870   edit-sandbox sandbox, 0x28/open-paren, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 871   edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 872   edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 873   edit-sandbox sandbox, 0x2e/dot, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 874   edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 875   edit-sandbox sandbox, 0x2e/dot, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 876   edit-sandbox sandbox, 0x29/close-paren, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 877   # eval
- 878   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 879   # setup: screen
- 880   var screen-on-stack: screen
- 881   var screen/edi: (addr screen) <- address screen-on-stack
- 882   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 883   #
- 884   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 885   check-screen-row screen, 0/y, "'(a . .)             ", "F - test-run-double-dot/0"
- 886   check-screen-row screen, 1/y, "...                  ", "F - test-run-double-dot/1"
- 887   check-screen-row screen, 2/y, "'. .' makes no sense ", "F - test-run-double-dot/2"
- 888   # further errors may occur
- 889 }
- 890 
- 891 fn test-run-multiple-expressions-after-dot {
- 892   var sandbox-storage: sandbox
- 893   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 894   initialize-sandbox sandbox, 0/no-screen-or-keyboard
- 895   # type "'(a . b c)"
- 896   edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 897   edit-sandbox sandbox, 0x28/open-paren, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 898   edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 899   edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 900   edit-sandbox sandbox, 0x2e/dot, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 901   edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 902   edit-sandbox sandbox, 0x62/b, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 903   edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 904   edit-sandbox sandbox, 0x63/c, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 905   edit-sandbox sandbox, 0x29/close-paren, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 906   # eval
- 907   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 908   # setup: screen
- 909   var screen-on-stack: screen
- 910   var screen/edi: (addr screen) <- address screen-on-stack
- 911   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 912   #
- 913   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 914   check-screen-row screen, 0/y, "'(a . b c)                                           ", "F - test-run-multiple-expressions-after-dot/0"
- 915   check-screen-row screen, 1/y, "...                                                  ", "F - test-run-multiple-expressions-after-dot/1"
- 916   check-screen-row screen, 2/y, "cannot have multiple expressions between '.' and ')' ", "F - test-run-multiple-expressions-after-dot/2"
- 917   # further errors may occur
- 918 }
- 919 
- 920 fn test-run-error-invalid-integer {
- 921   var sandbox-storage: sandbox
- 922   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 923   initialize-sandbox sandbox, 0/no-screen-or-keyboard
- 924   # type "1a"
- 925   edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 926   edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 927   # eval
- 928   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 929   # setup: screen
- 930   var screen-on-stack: screen
- 931   var screen/edi: (addr screen) <- address screen-on-stack
- 932   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 933   #
- 934   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 935   check-screen-row screen, 0/y, "1a             ", "F - test-run-error-invalid-integer/0"
- 936   check-screen-row screen, 1/y, "...            ", "F - test-run-error-invalid-integer/0"
- 937   check-screen-row screen, 2/y, "invalid number ", "F - test-run-error-invalid-integer/2"
- 938 }
- 939 
- 940 fn test-run-move-cursor-into-trace {
- 941   var sandbox-storage: sandbox
- 942   var sandbox/esi: (addr sandbox) <- address sandbox-storage
- 943   initialize-sandbox sandbox, 0/no-screen-or-keyboard
- 944   # type "12"
- 945   edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 946   edit-sandbox sandbox, 0x32/2, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 947   # eval
- 948   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 949   # setup: screen
- 950   var screen-on-stack: screen
- 951   var screen/edi: (addr screen) <- address screen-on-stack
- 952   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
- 953   #
- 954   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 955   check-screen-row screen,                                  0/y, "12    ", "F - test-run-move-cursor-into-trace/pre-0"
- 956   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "  |   ", "F - test-run-move-cursor-into-trace/pre-0/cursor"
- 957   check-screen-row screen,                                  1/y, "...   ", "F - test-run-move-cursor-into-trace/pre-1"
- 958   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "      ", "F - test-run-move-cursor-into-trace/pre-1/cursor"
- 959   check-screen-row screen,                                  2/y, "=> 12 ", "F - test-run-move-cursor-into-trace/pre-2"
- 960   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "      ", "F - test-run-move-cursor-into-trace/pre-2/cursor"
- 961   # move cursor into trace
- 962   edit-sandbox sandbox, 9/tab, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 963   #
- 964   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 965   check-screen-row screen,                                  0/y, "12    ", "F - test-run-move-cursor-into-trace/trace-0"
- 966   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "      ", "F - test-run-move-cursor-into-trace/trace-0/cursor"
- 967   check-screen-row screen,                                  1/y, "...   ", "F - test-run-move-cursor-into-trace/trace-1"
- 968   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "|||   ", "F - test-run-move-cursor-into-trace/trace-1/cursor"
- 969   check-screen-row screen,                                  2/y, "=> 12 ", "F - test-run-move-cursor-into-trace/trace-2"
- 970   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "      ", "F - test-run-move-cursor-into-trace/trace-2/cursor"
- 971   # move cursor into input
- 972   edit-sandbox sandbox, 9/tab, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
- 973   #
- 974   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
- 975   check-screen-row screen,                                  0/y, "12    ", "F - test-run-move-cursor-into-trace/input-0"
- 976   check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, "  |   ", "F - test-run-move-cursor-into-trace/input-0/cursor"
- 977   check-screen-row screen,                                  1/y, "...   ", "F - test-run-move-cursor-into-trace/input-1"
- 978   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "      ", "F - test-run-move-cursor-into-trace/input-1/cursor"
- 979   check-screen-row screen,                                  2/y, "=> 12 ", "F - test-run-move-cursor-into-trace/input-2"
- 980   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "      ", "F - test-run-move-cursor-into-trace/input-2/cursor"
- 981 }
- 982 
- 983 fn has-trace? _self: (addr sandbox) -> _/eax: boolean {
- 984   var self/esi: (addr sandbox) <- copy _self
- 985   var trace-ah/eax: (addr handle trace) <- get self, trace
- 986   var _trace/eax: (addr trace) <- lookup *trace-ah
- 987   var trace/edx: (addr trace) <- copy _trace
- 988   compare trace, 0
- 989   {
- 990     break-if-!=
- 991     return 0/false
- 992   }
- 993   var first-free/ebx: (addr int) <- get trace, first-free
- 994   compare *first-free, 0
- 995   {
- 996     break-if->
- 997     return 0/false
- 998   }
- 999   return 1/true
-1000 }
+  1 type sandbox {
+  2   data: (handle gap-buffer)
+  3   value: (handle stream byte)
+  4   screen-var: (handle cell)
+  5   keyboard-var: (handle cell)
+  6   trace: (handle trace)
+  7   cursor-in-data?: boolean
+  8   cursor-in-keyboard?: boolean
+  9   cursor-in-trace?: boolean
+ 10 }
+ 11 
+ 12 fn initialize-sandbox _self: (addr sandbox), fake-screen-and-keyboard?: boolean {
+ 13   var self/esi: (addr sandbox) <- copy _self
+ 14   var data-ah/eax: (addr handle gap-buffer) <- get self, data
+ 15   allocate data-ah
+ 16   var data/eax: (addr gap-buffer) <- lookup *data-ah
+ 17   initialize-gap-buffer data, 0x1000/4KB
+ 18   #
+ 19   var value-ah/eax: (addr handle stream byte) <- get self, value
+ 20   populate-stream value-ah, 0x1000/4KB
+ 21   #
+ 22   {
+ 23     compare fake-screen-and-keyboard?, 0/false
+ 24     break-if-=
+ 25     var screen-ah/eax: (addr handle cell) <- get self, screen-var
+ 26     new-fake-screen screen-ah, 8/width, 3/height, 1/enable-pixel-graphics
+ 27     var keyboard-ah/eax: (addr handle cell) <- get self, keyboard-var
+ 28     new-fake-keyboard keyboard-ah, 0x10/keyboard-capacity
+ 29   }
+ 30   #
+ 31   var trace-ah/eax: (addr handle trace) <- get self, trace
+ 32   allocate trace-ah
+ 33   var trace/eax: (addr trace) <- lookup *trace-ah
+ 34   initialize-trace trace, 0x8000/lines, 0x80/visible-lines
+ 35   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
+ 36   copy-to *cursor-in-data?, 1/true
+ 37 }
+ 38 
+ 39 ## some helpers for tests
+ 40 
+ 41 fn initialize-sandbox-with _self: (addr sandbox), s: (addr array byte) {
+ 42   var self/esi: (addr sandbox) <- copy _self
+ 43   var data-ah/eax: (addr handle gap-buffer) <- get self, data
+ 44   allocate data-ah
+ 45   var data/eax: (addr gap-buffer) <- lookup *data-ah
+ 46   initialize-gap-buffer-with data, s
+ 47   var value-ah/eax: (addr handle stream byte) <- get self, value
+ 48   populate-stream value-ah, 0x1000/4KB
+ 49   var trace-ah/eax: (addr handle trace) <- get self, trace
+ 50   allocate trace-ah
+ 51   var trace/eax: (addr trace) <- lookup *trace-ah
+ 52   initialize-trace trace, 0x8000/lines, 0x80/visible-lines
+ 53   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
+ 54   copy-to *cursor-in-data?, 1/true
+ 55 }
+ 56 
+ 57 fn allocate-sandbox-with _out: (addr handle sandbox), s: (addr array byte) {
+ 58   var out/eax: (addr handle sandbox) <- copy _out
+ 59   allocate out
+ 60   var out-addr/eax: (addr sandbox) <- lookup *out
+ 61   initialize-sandbox-with out-addr, s
+ 62 }
+ 63 
+ 64 fn write-sandbox out: (addr stream byte), _self: (addr sandbox) {
+ 65   var self/eax: (addr sandbox) <- copy _self
+ 66   var data-ah/eax: (addr handle gap-buffer) <- get self, data
+ 67   var data/eax: (addr gap-buffer) <- lookup *data-ah
+ 68   {
+ 69     var len/eax: int <- gap-buffer-length data
+ 70     compare len, 0
+ 71     break-if-!=
+ 72     return
+ 73   }
+ 74   write out, "  (sandbox . "
+ 75   append-gap-buffer data, out
+ 76   write out, ")\n"
+ 77 }
+ 78 
+ 79 ##
+ 80 
+ 81 fn render-sandbox screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int {
+ 82   clear-rect screen, xmin, ymin, xmax, ymax, 0xc5/bg=blue-bg=black
+ 83   add-to xmin, 1/padding-left
+ 84   add-to ymin, 1/padding-top
+ 85   subtract-from xmax, 1/padding-right
+ 86   var self/esi: (addr sandbox) <- copy _self
+ 87   # data
+ 88   var data-ah/eax: (addr handle gap-buffer) <- get self, data
+ 89   var _data/eax: (addr gap-buffer) <- lookup *data-ah
+ 90   var data/edx: (addr gap-buffer) <- copy _data
+ 91   var x/eax: int <- copy xmin
+ 92   var y/ecx: int <- copy ymin
+ 93   y <- maybe-render-empty-screen screen, self, xmin, y
+ 94   y <- maybe-render-keyboard screen, self, xmin, y
+ 95   var cursor-in-sandbox?/ebx: (addr boolean) <- get self, cursor-in-data?
+ 96   x, y <- render-gap-buffer-wrapping-right-then-down screen, data, x, y, xmax, ymax, *cursor-in-sandbox?, 7/fg, 0xc5/bg=blue-bg
+ 97   y <- increment
+ 98   # trace
+ 99   var trace-ah/eax: (addr handle trace) <- get self, trace
+100   var _trace/eax: (addr trace) <- lookup *trace-ah
+101   var trace/edx: (addr trace) <- copy _trace
+102   var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
+103   y <- render-trace screen, trace, xmin, y, xmax, ymax, *cursor-in-trace?
+104   # value
+105   $render-sandbox:value: {
+106     var value-ah/eax: (addr handle stream byte) <- get self, value
+107     var _value/eax: (addr stream byte) <- lookup *value-ah
+108     var value/esi: (addr stream byte) <- copy _value
+109     rewind-stream value
+110     var done?/eax: boolean <- stream-empty? value
+111     compare done?, 0/false
+112     break-if-!=
+113     var x/eax: int <- copy 0
+114     x, y <- draw-text-wrapping-right-then-down screen, "=> ", xmin, y, xmax, ymax, xmin, y, 7/fg, 0xc5/bg=blue-bg
+115     var x2/edx: int <- copy x
+116     var dummy/eax: int <- draw-stream-rightward screen, value, x2, xmax, y, 7/fg=grey, 0xc5/bg=blue-bg
+117   }
+118   y <- add 2  # padding
+119   y <- maybe-render-screen screen, self, xmin, y
+120   # render menu
+121   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
+122   compare *cursor-in-data?, 0/false
+123   {
+124     break-if-=
+125     render-sandbox-menu screen, self
+126     return
+127   }
+128   var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
+129   compare *cursor-in-trace?, 0/false
+130   {
+131     break-if-=
+132     render-trace-menu screen
+133     return
+134   }
+135   var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
+136   compare *cursor-in-keyboard?, 0/false
+137   {
+138     break-if-=
+139     render-keyboard-menu screen
+140     return
+141   }
+142 }
+143 
+144 fn clear-sandbox-output screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int {
+145   # render just enough of the sandbox to figure out what to erase
+146   var self/esi: (addr sandbox) <- copy _self
+147   var data-ah/eax: (addr handle gap-buffer) <- get self, data
+148   var _data/eax: (addr gap-buffer) <- lookup *data-ah
+149   var data/edx: (addr gap-buffer) <- copy _data
+150   var x/eax: int <- copy xmin
+151   var y/ecx: int <- copy ymin
+152   y <- maybe-render-empty-screen screen, self, xmin, y
+153   y <- maybe-render-keyboard screen, self, xmin, y
+154   var cursor-in-sandbox?/ebx: (addr boolean) <- get self, cursor-in-data?
+155   x, y <- render-gap-buffer-wrapping-right-then-down screen, data, x, y, xmax, ymax, *cursor-in-sandbox?, 3/fg, 0xc5/bg=blue-bg
+156   y <- increment
+157   clear-rect screen, xmin, y, xmax, ymax, 0xc5/bg=blue-bg=black
+158 }
+159 
+160 fn maybe-render-empty-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
+161   var self/esi: (addr sandbox) <- copy _self
+162   var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var
+163   var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah
+164   compare screen-obj-cell, 0
+165   {
+166     break-if-!=
+167     return ymin
+168   }
+169   var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type
+170   compare *screen-obj-cell-type, 5/screen
+171   {
+172     break-if-=
+173     return ymin  # silently give up on rendering the screen
+174   }
+175   var y/ecx: int <- copy ymin
+176   var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data
+177   var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
+178   var screen-obj/edx: (addr screen) <- copy _screen-obj
+179   var x/eax: int <- draw-text-rightward screen, "screen:   ", xmin, 0x99/xmax, y, 7/fg, 0xc5/bg=blue-bg
+180   y <- render-empty-screen screen, screen-obj, x, y
+181   return y
+182 }
+183 
+184 fn maybe-render-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
+185   var self/esi: (addr sandbox) <- copy _self
+186   var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var
+187   var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah
+188   compare screen-obj-cell, 0
+189   {
+190     break-if-!=
+191     return ymin
+192   }
+193   var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type
+194   compare *screen-obj-cell-type, 5/screen
+195   {
+196     break-if-=
+197     return ymin  # silently give up on rendering the screen
+198   }
+199   var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data
+200   var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
+201   var screen-obj/edx: (addr screen) <- copy _screen-obj
+202   {
+203     var screen-empty?/eax: boolean <- fake-screen-empty? screen-obj
+204     compare screen-empty?, 0/false
+205     break-if-=
+206     return ymin
+207   }
+208   var x/eax: int <- draw-text-rightward screen, "screen:   ", xmin, 0x99/xmax, ymin, 7/fg, 0xc5/bg=blue-bg
+209   var y/ecx: int <- copy ymin
+210   y <- render-screen screen, screen-obj, x, y
+211   return y
+212 }
+213 
+214 fn render-empty-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int {
+215   var target-screen/esi: (addr screen) <- copy _target-screen
+216   var screen-y/edi: int <- copy ymin
+217   # screen
+218   var height/edx: (addr int) <- get target-screen, height
+219   var y/ecx: int <- copy 0
+220   {
+221     compare y, *height
+222     break-if->=
+223     set-cursor-position screen, xmin, screen-y
+224     var width/edx: (addr int) <- get target-screen, width
+225     var x/ebx: int <- copy 0
+226     {
+227       compare x, *width
+228       break-if->=
+229       draw-code-point-at-cursor screen, 0x20/space, 0x18/fg, 0/bg
+230       move-cursor-right screen
+231       x <- increment
+232       loop
+233     }
+234     y <- increment
+235     screen-y <- increment
+236     loop
+237   }
+238   return screen-y
+239 }
+240 
+241 fn render-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int {
+242   var target-screen/esi: (addr screen) <- copy _target-screen
+243   var screen-y/edi: int <- copy ymin
+244   # text data
+245   {
+246     var height/edx: (addr int) <- get target-screen, height
+247     var y/ecx: int <- copy 0
+248     {
+249       compare y, *height
+250       break-if->=
+251       set-cursor-position screen, xmin, screen-y
+252       var width/edx: (addr int) <- get target-screen, width
+253       var x/ebx: int <- copy 0
+254       {
+255         compare x, *width
+256         break-if->=
+257         print-screen-cell-of-fake-screen screen, target-screen, x, y
+258         move-cursor-right screen
+259         x <- increment
+260         loop
+261       }
+262       y <- increment
+263       screen-y <- increment
+264       loop
+265     }
+266   }
+267   # pixel data
+268   {
+269     # screen top left pixels x y width height
+270     var tmp/eax: int <- copy xmin
+271     tmp <- shift-left 3/log2-font-width
+272     var left: int
+273     copy-to left, tmp
+274     tmp <- copy ymin
+275     tmp <- shift-left 4/log2-font-height
+276     var top: int
+277     copy-to top, tmp
+278     var pixels-ah/eax: (addr handle array byte) <- get target-screen, pixels
+279     var _pixels/eax: (addr array byte) <- lookup *pixels-ah
+280     var pixels/edi: (addr array byte) <- copy _pixels
+281     compare pixels, 0
+282     break-if-=
+283     var y/ebx: int <- copy 0
+284     var height-addr/edx: (addr int) <- get target-screen, height
+285     var height/edx: int <- copy *height-addr
+286     height <- shift-left 4/log2-font-height
+287     {
+288       compare y, height
+289       break-if->=
+290       var width-addr/edx: (addr int) <- get target-screen, width
+291       var width/edx: int <- copy *width-addr
+292       width <- shift-left 3/log2-font-width
+293       var x/eax: int <- copy 0
+294       {
+295         compare x, width
+296         break-if->=
+297         {
+298           var idx/ecx: int <- pixel-index target-screen, x, y
+299           var color-addr/ecx: (addr byte) <- index pixels, idx
+300           var color/ecx: byte <- copy-byte *color-addr
+301           var color2/ecx: int <- copy color
+302           compare color2, 0
+303           break-if-=
+304           var x2/eax: int <- copy x
+305           x2 <- add left
+306           var y2/ebx: int <- copy y
+307           y2 <- add top
+308           pixel screen, x2, y2, color2
+309         }
+310         x <- increment
+311         loop
+312       }
+313       y <- increment
+314       loop
+315     }
+316   }
+317   return screen-y
+318 }
+319 
+320 fn has-keyboard? _self: (addr sandbox) -> _/eax: boolean {
+321   var self/esi: (addr sandbox) <- copy _self
+322   var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
+323   var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah
+324   compare keyboard-obj-cell, 0
+325   {
+326     break-if-!=
+327     return 0/false
+328   }
+329   var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type
+330   compare *keyboard-obj-cell-type, 6/keyboard
+331   {
+332     break-if-=
+333     return 0/false
+334   }
+335   var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data
+336   var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah
+337   var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj
+338   compare keyboard-obj, 0
+339   {
+340     break-if-!=
+341     return 0/false
+342   }
+343   return 1/true
+344 }
+345 
+346 fn maybe-render-keyboard screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
+347   var self/esi: (addr sandbox) <- copy _self
+348   var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
+349   var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah
+350   compare keyboard-obj-cell, 0
+351   {
+352     break-if-!=
+353     return ymin
+354   }
+355   var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type
+356   compare *keyboard-obj-cell-type, 6/keyboard
+357   {
+358     break-if-=
+359     return ymin  # silently give up on rendering the keyboard
+360   }
+361   var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data
+362   var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah
+363   var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj
+364   var y/ecx: int <- copy ymin
+365   y <- increment  # padding
+366   var x/eax: int <- draw-text-rightward screen, "keyboard: ", xmin, 0x99/xmax, y, 7/fg, 0xc5/bg=blue-bg
+367   var cursor-in-keyboard?/esi: (addr boolean) <- get self, cursor-in-keyboard?
+368   y <- render-keyboard screen, keyboard-obj, x, y, *cursor-in-keyboard?
+369   y <- increment  # padding
+370   return y
+371 }
+372 
+373 fn render-keyboard screen: (addr screen), _keyboard: (addr gap-buffer), xmin: int, ymin: int, render-cursor?: boolean -> _/ecx: int {
+374   var keyboard/esi: (addr gap-buffer) <- copy _keyboard
+375   var width/edx: int <- copy 0x10/keyboard-capacity
+376   var y/edi: int <- copy ymin
+377   # keyboard
+378   var x/eax: int <- copy xmin
+379   var xmax/ecx: int <- copy x
+380   xmax <- add 0x10
+381   var ymax/edx: int <- copy ymin
+382   ymax <- add 1
+383   clear-rect screen, x, y, xmax, ymax, 0/bg
+384   x <- render-gap-buffer screen, keyboard, x, y, render-cursor?, 3/fg, 0/bg
+385   y <- increment
+386   return y
+387 }
+388 
+389 fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), x: int, y: int {
+390   var target/ecx: (addr screen) <- copy _target
+391   var data-ah/eax: (addr handle array screen-cell) <- get target, data
+392   var data/eax: (addr array screen-cell) <- lookup *data-ah
+393   var index/ecx: int <- screen-cell-index target, x, y
+394   var offset/ecx: (offset screen-cell) <- compute-offset data, index
+395   var src-cell/esi: (addr screen-cell) <- index data, offset
+396   var src-grapheme/eax: (addr grapheme) <- get src-cell, data
+397   var src-color/ecx: (addr int) <- get src-cell, color
+398   var src-background-color/edx: (addr int) <- get src-cell, background-color
+399   draw-grapheme-at-cursor screen, *src-grapheme, *src-color, *src-background-color
+400 }
+401 
+402 fn render-sandbox-menu screen: (addr screen), _self: (addr sandbox) {
+403   var _width/eax: int <- copy 0
+404   var height/ecx: int <- copy 0
+405   _width, height <- screen-size screen
+406   var width/edx: int <- copy _width
+407   var y/ecx: int <- copy height
+408   y <- decrement
+409   var height/ebx: int <- copy y
+410   height <- increment
+411   clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg=black
+412   set-cursor-position screen, 0/x, y
+413   draw-text-rightward-from-cursor screen, " ctrl+... ", width, 0xf/fg, 0xc5/bg=blue-bg
+414   draw-text-rightward-from-cursor screen, " r ", width, 0/fg, 0x5c/bg=black
+415   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0xc5/bg=blue-bg
+416   draw-text-rightward-from-cursor screen, " s ", width, 0/fg, 0x5c/bg=black
+417   draw-text-rightward-from-cursor screen, " run sandbox  ", width, 7/fg, 0xc5/bg=blue-bg
+418   $render-sandbox-menu:render-ctrl-m: {
+419     var self/eax: (addr sandbox) <- copy _self
+420     var has-trace?/eax: boolean <- has-trace? self
+421     compare has-trace?, 0/false
+422     {
+423       break-if-=
+424       draw-text-rightward-from-cursor screen, " m ", width, 0/fg, 0x38/bg=trace
+425       draw-text-rightward-from-cursor screen, " to trace  ", width, 7/fg, 0xc5/bg=blue-bg
+426       break $render-sandbox-menu:render-ctrl-m
+427     }
+428     draw-text-rightward-from-cursor screen, " m ", width, 0/fg, 3/bg=keyboard
+429     draw-text-rightward-from-cursor screen, " to keyboard  ", width, 7/fg, 0xc5/bg=blue-bg
+430   }
+431   draw-text-rightward-from-cursor screen, " a ", width, 0/fg, 0x5c/bg=black
+432   draw-text-rightward-from-cursor screen, " <<  ", width, 7/fg, 0xc5/bg=blue-bg
+433   draw-text-rightward-from-cursor screen, " b ", width, 0/fg, 0x5c/bg=black
+434   draw-text-rightward-from-cursor screen, " <word  ", width, 7/fg, 0xc5/bg=blue-bg
+435   draw-text-rightward-from-cursor screen, " f ", width, 0/fg, 0x5c/bg=black
+436   draw-text-rightward-from-cursor screen, " word>  ", width, 7/fg, 0xc5/bg=blue-bg
+437   draw-text-rightward-from-cursor screen, " e ", width, 0/fg, 0x5c/bg=black
+438   draw-text-rightward-from-cursor screen, " >>  ", width, 7/fg, 0xc5/bg=blue-bg
+439 }
+440 
+441 fn render-keyboard-menu screen: (addr screen) {
+442   var width/eax: int <- copy 0
+443   var height/ecx: int <- copy 0
+444   width, height <- screen-size screen
+445   var y/ecx: int <- copy height
+446   y <- decrement
+447   var height/edx: int <- copy y
+448   height <- increment
+449   clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg=black
+450   set-cursor-position screen, 0/x, y
+451   draw-text-rightward-from-cursor screen, " ctrl+... ", width, 0xf/fg, 0xc5/bg=blue-bg
+452   draw-text-rightward-from-cursor screen, " r ", width, 0/fg, 0x5c/bg=black
+453   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0xc5/bg=blue-bg
+454   draw-text-rightward-from-cursor screen, " s ", width, 0/fg, 0x5c/bg=black
+455   draw-text-rightward-from-cursor screen, " run sandbox  ", width, 7/fg, 0xc5/bg=blue-bg
+456   draw-text-rightward-from-cursor screen, " m ", width, 0/fg, 7/bg
+457   draw-text-rightward-from-cursor screen, " to sandbox  ", width, 7/fg, 0xc5/bg=blue-bg
+458 }
+459 
+460 fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table), data-disk: (addr disk), real-screen: (addr screen), tweak-real-screen?: boolean {
+461   var self/esi: (addr sandbox) <- copy _self
+462   var g/edx: grapheme <- copy key
+463   # ctrl-s
+464   {
+465     compare g, 0x13/ctrl-s
+466     break-if-!=
+467     # minor gotcha here: any bindings created later in this iteration won't be
+468     # persisted until the next call to ctrl-s.
+469     store-state data-disk, self, globals
+470     # run sandbox
+471     var data-ah/ecx: (addr handle gap-buffer) <- get self, data
+472     var value-ah/eax: (addr handle stream byte) <- get self, value
+473     var _value/eax: (addr stream byte) <- lookup *value-ah
+474     var value/edx: (addr stream byte) <- copy _value
+475     var trace-ah/eax: (addr handle trace) <- get self, trace
+476     var _trace/eax: (addr trace) <- lookup *trace-ah
+477     var trace/ebx: (addr trace) <- copy _trace
+478     clear-trace trace
+479     {
+480       compare tweak-real-screen?, 0/false
+481       break-if-=
+482       clear-sandbox-output real-screen, self, 0x56/sandbox-left-margin, 1/y, 0x80/screen-width, 0x2f/screen-height-without-menu
+483     }
+484     var screen-cell/eax: (addr handle cell) <- get self, screen-var
+485     clear-screen-cell screen-cell
+486     var keyboard-cell/esi: (addr handle cell) <- get self, keyboard-var
+487     rewind-keyboard-cell keyboard-cell  # don't clear keys from before
+488     {
+489       compare tweak-real-screen?, 0/false
+490       break-if-=
+491       set-cursor-position real-screen, 0/x, 0/y  # for any debug prints during evaluation
+492     }
+493     run data-ah, value, globals, trace, screen-cell, keyboard-cell
+494     return
+495   }
+496   # ctrl-m
+497   {
+498     compare g, 0xd/ctrl-m
+499     break-if-!=
+500     # if cursor in data, switch to trace or fall through to keyboard
+501     {
+502       var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
+503       compare *cursor-in-data?, 0/false
+504       break-if-=
+505       var has-trace?/eax: boolean <- has-trace? self
+506       compare has-trace?, 0/false
+507       {
+508         break-if-=
+509         var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
+510         copy-to *cursor-in-data?, 0/false
+511         var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
+512         copy-to *cursor-in-trace?, 1/false
+513         return
+514       }
+515       var has-keyboard?/eax: boolean <- has-keyboard? self
+516       compare has-keyboard?, 0/false
+517       {
+518         break-if-=
+519         var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
+520         copy-to *cursor-in-data?, 0/false
+521         var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
+522         copy-to *cursor-in-keyboard?, 1/false
+523         return
+524       }
+525       return
+526     }
+527     # if cursor in trace, switch to keyboard or fall through to data
+528     {
+529       var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
+530       compare *cursor-in-trace?, 0/false
+531       break-if-=
+532       copy-to *cursor-in-trace?, 0/false
+533       var cursor-target/ecx: (addr boolean) <- get self, cursor-in-keyboard?
+534       var has-keyboard?/eax: boolean <- has-keyboard? self
+535       compare has-keyboard?, 0/false
+536       {
+537         break-if-!=
+538         cursor-target <- get self, cursor-in-data?
+539       }
+540       copy-to *cursor-target, 1/true
+541       return
+542     }
+543     # otherwise if cursor in keyboard, switch to data
+544     {
+545       var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
+546       compare *cursor-in-keyboard?, 0/false
+547       break-if-=
+548       copy-to *cursor-in-keyboard?, 0/false
+549       var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
+550       copy-to *cursor-in-data?, 1/true
+551       return
+552     }
+553     return
+554   }
+555   # if cursor in data, send key to data
+556   {
+557     var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
+558     compare *cursor-in-data?, 0/false
+559     break-if-=
+560     var data-ah/eax: (addr handle gap-buffer) <- get self, data
+561     var data/eax: (addr gap-buffer) <- lookup *data-ah
+562     edit-gap-buffer data, g
+563     return
+564   }
+565   # if cursor in keyboard, send key to keyboard
+566   {
+567     var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
+568     compare *cursor-in-keyboard?, 0/false
+569     break-if-=
+570     var keyboard-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
+571     var keyboard-cell/eax: (addr cell) <- lookup *keyboard-cell-ah
+572     compare keyboard-cell, 0
+573     {
+574       break-if-!=
+575       return
+576     }
+577     var keyboard-cell-type/ecx: (addr int) <- get keyboard-cell, type
+578     compare *keyboard-cell-type, 6/keyboard
+579     {
+580       break-if-=
+581       return
+582     }
+583     var keyboard-ah/eax: (addr handle gap-buffer) <- get keyboard-cell, keyboard-data
+584     var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
+585     edit-gap-buffer keyboard, g
+586     return
+587   }
+588   # if cursor in trace, send key to trace
+589   {
+590     var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
+591     compare *cursor-in-trace?, 0/false
+592     break-if-=
+593     var trace-ah/eax: (addr handle trace) <- get self, trace
+594     var trace/eax: (addr trace) <- lookup *trace-ah
+595     edit-trace trace, g
+596     return
+597   }
+598 }
+599 
+600 fn run _in-ah: (addr handle gap-buffer), out: (addr stream byte), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
+601   var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah
+602   var in/eax: (addr gap-buffer) <- lookup *in-ah
+603   var read-result-h: (handle cell)
+604   var read-result-ah/esi: (addr handle cell) <- address read-result-h
+605   read-cell in, read-result-ah, trace
+606   var error?/eax: boolean <- has-errors? trace
+607   {
+608     compare error?, 0/false
+609     break-if-=
+610     return
+611   }
+612   var nil-storage: (handle cell)
+613   var nil-ah/eax: (addr handle cell) <- address nil-storage
+614   allocate-pair nil-ah
+615   var eval-result-storage: (handle cell)
+616   var eval-result/edi: (addr handle cell) <- address eval-result-storage
+617   debug-print "^", 4/fg, 0xc5/bg=blue-bg
+618   evaluate read-result-ah, eval-result, *nil-ah, globals, trace, screen-cell, keyboard-cell, 1/call-number
+619   debug-print "$", 4/fg, 0xc5/bg=blue-bg
+620   var error?/eax: boolean <- has-errors? trace
+621   {
+622     compare error?, 0/false
+623     break-if-=
+624     return
+625   }
+626   # if there was no error and the read-result starts with "set" or "def", save
+627   # the gap buffer in the modified global, then create a new one for the next
+628   # command.
+629   maybe-stash-gap-buffer-to-global globals, read-result-ah, _in-ah
+630   clear-stream out
+631   print-cell eval-result, out, trace
+632   mark-lines-dirty trace
+633 }
+634 
+635 fn read-evaluate-and-move-to-globals _in-ah: (addr handle gap-buffer), globals: (addr global-table) {
+636   var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah
+637   var in/eax: (addr gap-buffer) <- lookup *in-ah
+638   var read-result-h: (handle cell)
+639   var read-result-ah/esi: (addr handle cell) <- address read-result-h
+640   read-cell in, read-result-ah, 0/no-trace
+641   var nil-storage: (handle cell)
+642   var nil-ah/eax: (addr handle cell) <- address nil-storage
+643   allocate-pair nil-ah
+644   var eval-result-storage: (handle cell)
+645   var eval-result/edi: (addr handle cell) <- address eval-result-storage
+646   debug-print "^", 4/fg, 0xc5/bg=blue-bg
+647   evaluate read-result-ah, eval-result, *nil-ah, globals, 0/no-trace, 0/no-screen-cell, 0/no-keyboard-cell, 1/call-number
+648   debug-print "$", 4/fg, 0xc5/bg=blue-bg
+649   move-gap-buffer-to-global globals, read-result-ah, _in-ah
+650 }
+651 
+652 fn test-run-integer {
+653   var sandbox-storage: sandbox
+654   var sandbox/esi: (addr sandbox) <- address sandbox-storage
+655   initialize-sandbox-with sandbox, "1"
+656   # eval
+657   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+658   # setup: screen
+659   var screen-on-stack: screen
+660   var screen/edi: (addr screen) <- address screen-on-stack
+661   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
+662   #
+663   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
+664   # skip one line of padding
+665   check-screen-row screen, 1/y, " 1    ", "F - test-run-integer/0"
+666   check-screen-row screen, 2/y, " ...  ", "F - test-run-integer/1"
+667   check-screen-row screen, 3/y, " => 1 ", "F - test-run-integer/2"
+668 }
+669 
+670 fn test-run-error-invalid-integer {
+671   var sandbox-storage: sandbox
+672   var sandbox/esi: (addr sandbox) <- address sandbox-storage
+673   initialize-sandbox-with sandbox, "1a"
+674   # eval
+675   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+676   # setup: screen
+677   var screen-on-stack: screen
+678   var screen/edi: (addr screen) <- address screen-on-stack
+679   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
+680   #
+681   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
+682   # skip one line of padding
+683   check-screen-row screen, 1/y, " 1a             ", "F - test-run-error-invalid-integer/0"
+684   check-screen-row screen, 2/y, " ...            ", "F - test-run-error-invalid-integer/0"
+685   check-screen-row screen, 3/y, " invalid number ", "F - test-run-error-invalid-integer/2"
+686 }
+687 
+688 fn test-run-with-spaces {
+689   var sandbox-storage: sandbox
+690   var sandbox/esi: (addr sandbox) <- address sandbox-storage
+691   initialize-sandbox-with sandbox, " 1 \n"
+692   # eval
+693   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+694   # setup: screen
+695   var screen-on-stack: screen
+696   var screen/edi: (addr screen) <- address screen-on-stack
+697   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
+698   #
+699   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
+700   # skip one line of padding
+701   check-screen-row screen, 1/y, "  1   ", "F - test-run-with-spaces/0"
+702   check-screen-row screen, 2/y, "      ", "F - test-run-with-spaces/1"
+703   check-screen-row screen, 3/y, " ...  ", "F - test-run-with-spaces/2"
+704   check-screen-row screen, 4/y, " => 1 ", "F - test-run-with-spaces/3"
+705 }
+706 
+707 fn test-run-quote {
+708   var sandbox-storage: sandbox
+709   var sandbox/esi: (addr sandbox) <- address sandbox-storage
+710   initialize-sandbox-with sandbox, "'a"
+711   # eval
+712   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+713   # setup: screen
+714   var screen-on-stack: screen
+715   var screen/edi: (addr screen) <- address screen-on-stack
+716   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
+717   #
+718   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
+719   # skip one line of padding
+720   check-screen-row screen, 1/y, " 'a   ", "F - test-run-quote/0"
+721   check-screen-row screen, 2/y, " ...  ", "F - test-run-quote/1"
+722   check-screen-row screen, 3/y, " => a ", "F - test-run-quote/2"
+723 }
+724 
+725 fn test-run-dotted-list {
+726   var sandbox-storage: sandbox
+727   var sandbox/esi: (addr sandbox) <- address sandbox-storage
+728   initialize-sandbox-with sandbox, "'(a . b)"
+729   # eval
+730   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+731   # setup: screen
+732   var screen-on-stack: screen
+733   var screen/edi: (addr screen) <- address screen-on-stack
+734   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
+735   #
+736   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
+737   # skip one line of padding
+738   check-screen-row screen, 1/y, " '(a . b)   ", "F - test-run-dotted-list/0"
+739   check-screen-row screen, 2/y, " ...        ", "F - test-run-dotted-list/1"
+740   check-screen-row screen, 3/y, " => (a . b) ", "F - test-run-dotted-list/2"
+741 }
+742 
+743 fn test-run-dot-and-list {
+744   var sandbox-storage: sandbox
+745   var sandbox/esi: (addr sandbox) <- address sandbox-storage
+746   initialize-sandbox-with sandbox, "'(a . (b))"
+747   # eval
+748   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+749   # setup: screen
+750   var screen-on-stack: screen
+751   var screen/edi: (addr screen) <- address screen-on-stack
+752   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
+753   #
+754   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
+755   # skip one line of padding
+756   check-screen-row screen, 1/y, " '(a . (b)) ", "F - test-run-dot-and-list/0"
+757   check-screen-row screen, 2/y, " ...        ", "F - test-run-dot-and-list/1"
+758   check-screen-row screen, 3/y, " => (a b)   ", "F - test-run-dot-and-list/2"
+759 }
+760 
+761 fn test-run-final-dot {
+762   var sandbox-storage: sandbox
+763   var sandbox/esi: (addr sandbox) <- address sandbox-storage
+764   initialize-sandbox-with sandbox, "'(a .)"
+765   # eval
+766   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+767   # setup: screen
+768   var screen-on-stack: screen
+769   var screen/edi: (addr screen) <- address screen-on-stack
+770   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
+771   #
+772   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
+773   # skip one line of padding
+774   check-screen-row screen, 1/y, " '(a .)               ", "F - test-run-final-dot/0"
+775   check-screen-row screen, 2/y, " ...                  ", "F - test-run-final-dot/1"
+776   check-screen-row screen, 3/y, " '. )' makes no sense ", "F - test-run-final-dot/2"
+777   # further errors may occur
+778 }
+779 
+780 fn test-run-double-dot {
+781   var sandbox-storage: sandbox
+782   var sandbox/esi: (addr sandbox) <- address sandbox-storage
+783   initialize-sandbox-with sandbox, "'(a . .)"
+784   # eval
+785   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+786   # setup: screen
+787   var screen-on-stack: screen
+788   var screen/edi: (addr screen) <- address screen-on-stack
+789   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
+790   #
+791   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
+792   # skip one line of padding
+793   check-screen-row screen, 1/y, " '(a . .)             ", "F - test-run-double-dot/0"
+794   check-screen-row screen, 2/y, " ...                  ", "F - test-run-double-dot/1"
+795   check-screen-row screen, 3/y, " '. .' makes no sense ", "F - test-run-double-dot/2"
+796   # further errors may occur
+797 }
+798 
+799 fn test-run-multiple-expressions-after-dot {
+800   var sandbox-storage: sandbox
+801   var sandbox/esi: (addr sandbox) <- address sandbox-storage
+802   initialize-sandbox-with sandbox, "'(a . b c)"
+803   # eval
+804   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+805   # setup: screen
+806   var screen-on-stack: screen
+807   var screen/edi: (addr screen) <- address screen-on-stack
+808   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
+809   #
+810   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
+811   # skip one line of padding
+812   check-screen-row screen, 1/y, " '(a . b c)                                           ", "F - test-run-multiple-expressions-after-dot/0"
+813   check-screen-row screen, 2/y, " ...                                                  ", "F - test-run-multiple-expressions-after-dot/1"
+814   check-screen-row screen, 3/y, " cannot have multiple expressions between '.' and ')' ", "F - test-run-multiple-expressions-after-dot/2"
+815   # further errors may occur
+816 }
+817 
+818 fn test-run-stream {
+819   var sandbox-storage: sandbox
+820   var sandbox/esi: (addr sandbox) <- address sandbox-storage
+821   initialize-sandbox-with sandbox, "[a b]"
+822   # eval
+823   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+824   # setup: screen
+825   var screen-on-stack: screen
+826   var screen/edi: (addr screen) <- address screen-on-stack
+827   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
+828   #
+829   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
+830   # skip one line of padding
+831   check-screen-row screen, 1/y, " [a b]    ", "F - test-run-stream/0"
+832   check-screen-row screen, 2/y, " ...      ", "F - test-run-stream/1"
+833   check-screen-row screen, 3/y, " => [a b] ", "F - test-run-stream/2"
+834 }
+835 
+836 fn test-run-move-cursor-into-trace {
+837   var sandbox-storage: sandbox
+838   var sandbox/esi: (addr sandbox) <- address sandbox-storage
+839   initialize-sandbox-with sandbox, "12"
+840   # eval
+841   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+842   # setup: screen
+843   var screen-on-stack: screen
+844   var screen/edi: (addr screen) <- address screen-on-stack
+845   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
+846   #
+847   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
+848   # skip one line of padding
+849   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-move-cursor-into-trace/pre-0"
+850   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "   |   ", "F - test-run-move-cursor-into-trace/pre-0/cursor"
+851   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-move-cursor-into-trace/pre-1"
+852   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "       ", "F - test-run-move-cursor-into-trace/pre-1/cursor"
+853   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-move-cursor-into-trace/pre-2"
+854   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-move-cursor-into-trace/pre-2/cursor"
+855   # move cursor into trace
+856   edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+857   #
+858   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
+859   # skip one line of padding
+860   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-move-cursor-into-trace/trace-0"
+861   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "       ", "F - test-run-move-cursor-into-trace/trace-0/cursor"
+862   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-move-cursor-into-trace/trace-1"
+863   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " |||   ", "F - test-run-move-cursor-into-trace/trace-1/cursor"
+864   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-move-cursor-into-trace/trace-2"
+865   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-move-cursor-into-trace/trace-2/cursor"
+866   # move cursor into input
+867   edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
+868   #
+869   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
+870   # skip one line of padding
+871   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-move-cursor-into-trace/input-0"
+872   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "   |   ", "F - test-run-move-cursor-into-trace/input-0/cursor"
+873   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-move-cursor-into-trace/input-1"
+874   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "       ", "F - test-run-move-cursor-into-trace/input-1/cursor"
+875   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-move-cursor-into-trace/input-2"
+876   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-move-cursor-into-trace/input-2/cursor"
+877 }
+878 
+879 fn has-trace? _self: (addr sandbox) -> _/eax: boolean {
+880   var self/esi: (addr sandbox) <- copy _self
+881   var trace-ah/eax: (addr handle trace) <- get self, trace
+882   var _trace/eax: (addr trace) <- lookup *trace-ah
+883   var trace/edx: (addr trace) <- copy _trace
+884   compare trace, 0
+885   {
+886     break-if-!=
+887     return 0/false
+888   }
+889   var first-free/ebx: (addr int) <- get trace, first-free
+890   compare *first-free, 0
+891   {
+892     break-if->
+893     return 0/false
+894   }
+895   return 1/true
+896 }
diff --git a/html/shell/tokenize.mu.html b/html/shell/tokenize.mu.html index 7eae1112..d71e4d49 100644 --- a/html/shell/tokenize.mu.html +++ b/html/shell/tokenize.mu.html @@ -64,644 +64,798 @@ if ('onhashchange' in window) { 5 fn tokenize in: (addr gap-buffer), out: (addr stream cell), trace: (addr trace) { 6 trace-text trace, "read", "tokenize" 7 trace-lower trace - 8 rewind-gap-buffer in + 8 rewind-gap-buffer in 9 var token-storage: cell 10 var token/edx: (addr cell) <- address token-storage 11 { - 12 skip-whitespace-from-gap-buffer in - 13 var done?/eax: boolean <- gap-buffer-scan-done? in + 12 skip-whitespace-from-gap-buffer in + 13 var done?/eax: boolean <- gap-buffer-scan-done? in 14 compare done?, 0/false 15 break-if-!= 16 # initialize token data each iteration to avoid aliasing 17 var dest-ah/eax: (addr handle stream byte) <- get token, text-data - 18 populate-stream dest-ah, 0x40/max-token-size + 18 populate-stream dest-ah, 0x100/max-definition-size 19 # - 20 next-token in, token, trace - 21 var error?/eax: boolean <- has-errors? trace - 22 compare error?, 0/false - 23 { - 24 break-if-= - 25 return - 26 } - 27 write-to-stream out, token # shallow-copy text-data - 28 loop - 29 } - 30 trace-higher trace - 31 } - 32 - 33 fn test-tokenize-dotted-list { - 34 # in: "(a . b)" - 35 var in-storage: gap-buffer - 36 var in/esi: (addr gap-buffer) <- address in-storage - 37 initialize-gap-buffer in, 0x10 - 38 add-code-point-at-gap in, 0x28/open-paren - 39 add-code-point-at-gap in, 0x61/a - 40 add-code-point-at-gap in, 0x20/space - 41 add-code-point-at-gap in, 0x2e/dot - 42 add-code-point-at-gap in, 0x20/space - 43 add-code-point-at-gap in, 0x62/b - 44 add-code-point-at-gap in, 0x29/close-paren + 20 next-token in, token, trace + 21 var skip?/eax: boolean <- comment-token? token + 22 compare skip?, 0/false + 23 loop-if-!= + 24 var error?/eax: boolean <- has-errors? trace + 25 compare error?, 0/false + 26 { + 27 break-if-= + 28 return + 29 } + 30 write-to-stream out, token # shallow-copy text-data + 31 loop + 32 } + 33 trace-higher trace + 34 } + 35 + 36 fn test-tokenize-dotted-list { + 37 var in-storage: gap-buffer + 38 var in/esi: (addr gap-buffer) <- address in-storage + 39 initialize-gap-buffer-with in, "(a . b)" + 40 # + 41 var stream-storage: (stream cell 0x10) + 42 var stream/edi: (addr stream cell) <- address stream-storage + 43 # + 44 tokenize in, stream, 0/no-trace 45 # - 46 var stream-storage: (stream cell 0x10) - 47 var stream/edi: (addr stream cell) <- address stream-storage - 48 # - 49 tokenize in, stream, 0/no-trace - 50 # - 51 var curr-token-storage: cell - 52 var curr-token/ebx: (addr cell) <- address curr-token-storage - 53 read-from-stream stream, curr-token - 54 var open-paren?/eax: boolean <- open-paren-token? curr-token - 55 check open-paren?, "F - test-tokenize-dotted-list: open paren" - 56 read-from-stream stream, curr-token # skip a - 57 read-from-stream stream, curr-token - 58 var dot?/eax: boolean <- dot-token? curr-token - 59 check dot?, "F - test-tokenize-dotted-list: dot" - 60 read-from-stream stream, curr-token # skip b - 61 read-from-stream stream, curr-token - 62 var close-paren?/eax: boolean <- close-paren-token? curr-token - 63 check close-paren?, "F - test-tokenize-dotted-list: close paren" - 64 } - 65 - 66 fn next-token in: (addr gap-buffer), _out-cell: (addr cell), trace: (addr trace) { - 67 trace-text trace, "read", "next-token" - 68 trace-lower trace - 69 var out-cell/eax: (addr cell) <- copy _out-cell - 70 var out-ah/eax: (addr handle stream byte) <- get out-cell, text-data - 71 var _out/eax: (addr stream byte) <- lookup *out-ah - 72 var out/edi: (addr stream byte) <- copy _out - 73 $next-token:body: { - 74 clear-stream out - 75 skip-whitespace-from-gap-buffer in - 76 var g/eax: grapheme <- peek-from-gap-buffer in - 77 { - 78 var stream-storage: (stream byte 0x40) - 79 var stream/esi: (addr stream byte) <- address stream-storage - 80 write stream, "next: " - 81 var gval/eax: int <- copy g - 82 write-int32-hex stream, gval - 83 trace trace, "read", stream - 84 } - 85 # digit - 86 { - 87 var digit?/eax: boolean <- decimal-digit? g - 88 compare digit?, 0/false - 89 break-if-= - 90 next-number-token in, out, trace - 91 break $next-token:body - 92 } - 93 # other symbol char - 94 { - 95 var symbol?/eax: boolean <- symbol-grapheme? g - 96 compare symbol?, 0/false - 97 break-if-= - 98 next-symbol-token in, out, trace - 99 break $next-token:body -100 } -101 # brackets are always single-char tokens -102 { -103 var bracket?/eax: boolean <- bracket-grapheme? g -104 compare bracket?, 0/false -105 break-if-= -106 var g/eax: grapheme <- read-from-gap-buffer in -107 next-bracket-token g, out, trace -108 break $next-token:body -109 } -110 # non-symbol operators -111 { -112 var operator?/eax: boolean <- operator-grapheme? g -113 compare operator?, 0/false -114 break-if-= -115 next-operator-token in, out, trace -116 break $next-token:body -117 } -118 } -119 trace-higher trace -120 var stream-storage: (stream byte 0x40) -121 var stream/eax: (addr stream byte) <- address stream-storage -122 write stream, "=> " -123 rewind-stream out -124 write-stream stream, out -125 trace trace, "read", stream -126 } -127 -128 fn next-symbol-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { -129 trace-text trace, "read", "looking for a symbol" -130 trace-lower trace -131 $next-symbol-token:loop: { -132 var done?/eax: boolean <- gap-buffer-scan-done? in -133 compare done?, 0/false -134 break-if-!= -135 var g/eax: grapheme <- peek-from-gap-buffer in + 46 var curr-token-storage: cell + 47 var curr-token/ebx: (addr cell) <- address curr-token-storage + 48 read-from-stream stream, curr-token + 49 var open-paren?/eax: boolean <- open-paren-token? curr-token + 50 check open-paren?, "F - test-tokenize-dotted-list: open paren" + 51 read-from-stream stream, curr-token # skip a + 52 read-from-stream stream, curr-token + 53 var dot?/eax: boolean <- dot-token? curr-token + 54 check dot?, "F - test-tokenize-dotted-list: dot" + 55 read-from-stream stream, curr-token # skip b + 56 read-from-stream stream, curr-token + 57 var close-paren?/eax: boolean <- close-paren-token? curr-token + 58 check close-paren?, "F - test-tokenize-dotted-list: close paren" + 59 } + 60 + 61 fn test-tokenize-stream-literal { + 62 var in-storage: gap-buffer + 63 var in/esi: (addr gap-buffer) <- address in-storage + 64 initialize-gap-buffer-with in, "[abc def]" + 65 # + 66 var stream-storage: (stream cell 0x10) + 67 var stream/edi: (addr stream cell) <- address stream-storage + 68 # + 69 tokenize in, stream, 0/no-trace + 70 # + 71 var curr-token-storage: cell + 72 var curr-token/ebx: (addr cell) <- address curr-token-storage + 73 read-from-stream stream, curr-token + 74 var stream?/eax: boolean <- stream-token? curr-token + 75 check stream?, "F - test-tokenize-stream-literal: type" + 76 var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data + 77 var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah + 78 var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def" + 79 check data-equal?, "F - test-tokenize-stream-literal" + 80 var empty?/eax: boolean <- stream-empty? stream + 81 check empty?, "F - test-tokenize-stream-literal: empty?" + 82 } + 83 + 84 fn test-tokenize-stream-literal-in-tree { + 85 var in-storage: gap-buffer + 86 var in/esi: (addr gap-buffer) <- address in-storage + 87 initialize-gap-buffer-with in, "([abc def])" + 88 # + 89 var stream-storage: (stream cell 0x10) + 90 var stream/edi: (addr stream cell) <- address stream-storage + 91 # + 92 tokenize in, stream, 0/no-trace + 93 # + 94 var curr-token-storage: cell + 95 var curr-token/ebx: (addr cell) <- address curr-token-storage + 96 read-from-stream stream, curr-token + 97 var bracket?/eax: boolean <- bracket-token? curr-token + 98 check bracket?, "F - test-tokenize-stream-literal-in-tree: open paren" + 99 read-from-stream stream, curr-token +100 var stream?/eax: boolean <- stream-token? curr-token +101 check stream?, "F - test-tokenize-stream-literal-in-tree: type" +102 var curr-token-data-ah/eax: (addr handle stream byte) <- get curr-token, text-data +103 var curr-token-data/eax: (addr stream byte) <- lookup *curr-token-data-ah +104 var data-equal?/eax: boolean <- stream-data-equal? curr-token-data, "abc def" +105 check data-equal?, "F - test-tokenize-stream-literal-in-tree" +106 read-from-stream stream, curr-token +107 var bracket?/eax: boolean <- bracket-token? curr-token +108 check bracket?, "F - test-tokenize-stream-literal-in-tree: close paren" +109 var empty?/eax: boolean <- stream-empty? stream +110 check empty?, "F - test-tokenize-stream-literal-in-tree: empty?" +111 } +112 +113 fn next-token in: (addr gap-buffer), _out-cell: (addr cell), trace: (addr trace) { +114 trace-text trace, "read", "next-token" +115 trace-lower trace +116 var out-cell/eax: (addr cell) <- copy _out-cell +117 { +118 var out-cell-type/eax: (addr int) <- get out-cell, type +119 copy-to *out-cell-type, 0/uninitialized +120 } +121 var out-ah/eax: (addr handle stream byte) <- get out-cell, text-data +122 var _out/eax: (addr stream byte) <- lookup *out-ah +123 var out/edi: (addr stream byte) <- copy _out +124 $next-token:body: { +125 clear-stream out +126 var g/eax: grapheme <- peek-from-gap-buffer in +127 { +128 var stream-storage: (stream byte 0x40) +129 var stream/esi: (addr stream byte) <- address stream-storage +130 write stream, "next: " +131 var gval/eax: int <- copy g +132 write-int32-hex stream, gval +133 trace trace, "read", stream +134 } +135 # comment 136 { -137 var stream-storage: (stream byte 0x40) -138 var stream/esi: (addr stream byte) <- address stream-storage -139 write stream, "next: " -140 var gval/eax: int <- copy g -141 write-int32-hex stream, gval -142 trace trace, "read", stream -143 } -144 # if non-symbol, return -145 { -146 var symbol-grapheme?/eax: boolean <- symbol-grapheme? g -147 compare symbol-grapheme?, 0/false -148 break-if-!= -149 trace-text trace, "read", "stop" -150 break $next-symbol-token:loop -151 } -152 var g/eax: grapheme <- read-from-gap-buffer in -153 write-grapheme out, g -154 loop -155 } -156 trace-higher trace -157 var stream-storage: (stream byte 0x40) -158 var stream/esi: (addr stream byte) <- address stream-storage -159 write stream, "=> " -160 rewind-stream out -161 write-stream stream, out -162 trace trace, "read", stream -163 } -164 -165 fn next-operator-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { -166 trace-text trace, "read", "looking for a operator" -167 trace-lower trace -168 $next-operator-token:loop: { -169 var done?/eax: boolean <- gap-buffer-scan-done? in -170 compare done?, 0/false -171 break-if-!= -172 var g/eax: grapheme <- peek-from-gap-buffer in -173 { -174 var stream-storage: (stream byte 0x40) -175 var stream/esi: (addr stream byte) <- address stream-storage -176 write stream, "next: " -177 var gval/eax: int <- copy g -178 write-int32-hex stream, gval -179 trace trace, "read", stream -180 } -181 # if non-operator, return -182 { -183 var operator-grapheme?/eax: boolean <- operator-grapheme? g -184 compare operator-grapheme?, 0/false -185 break-if-!= -186 trace-text trace, "read", "stop" -187 break $next-operator-token:loop -188 } -189 var g/eax: grapheme <- read-from-gap-buffer in -190 write-grapheme out, g -191 loop -192 } -193 trace-higher trace -194 var stream-storage: (stream byte 0x40) -195 var stream/esi: (addr stream byte) <- address stream-storage -196 write stream, "=> " -197 rewind-stream out -198 write-stream stream, out -199 trace trace, "read", stream -200 } -201 -202 fn next-number-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { -203 trace-text trace, "read", "looking for a number" -204 trace-lower trace -205 $next-number-token:loop: { -206 var done?/eax: boolean <- gap-buffer-scan-done? in -207 compare done?, 0/false -208 break-if-!= -209 var g/eax: grapheme <- peek-from-gap-buffer in -210 { -211 var stream-storage: (stream byte 0x40) -212 var stream/esi: (addr stream byte) <- address stream-storage -213 write stream, "next: " -214 var gval/eax: int <- copy g -215 write-int32-hex stream, gval -216 trace trace, "read", stream -217 } -218 # if not symbol grapheme, return -219 { -220 var symbol-grapheme?/eax: boolean <- symbol-grapheme? g -221 compare symbol-grapheme?, 0/false -222 break-if-!= -223 trace-text trace, "read", "stop" -224 break $next-number-token:loop -225 } -226 # if not digit grapheme, abort -227 { -228 var digit?/eax: boolean <- decimal-digit? g -229 compare digit?, 0/false -230 break-if-!= -231 error trace, "invalid number" -232 return -233 } -234 trace-text trace, "read", "append" -235 var g/eax: grapheme <- read-from-gap-buffer in -236 write-grapheme out, g -237 loop -238 } -239 trace-higher trace -240 } -241 -242 fn next-bracket-token g: grapheme, out: (addr stream byte), trace: (addr trace) { -243 trace-text trace, "read", "bracket" -244 write-grapheme out, g -245 var stream-storage: (stream byte 0x40) -246 var stream/esi: (addr stream byte) <- address stream-storage -247 write stream, "=> " -248 rewind-stream out -249 write-stream stream, out -250 trace trace, "read", stream -251 } -252 -253 fn symbol-grapheme? g: grapheme -> _/eax: boolean { -254 ## whitespace -255 compare g, 9/tab -256 { -257 break-if-!= -258 return 0/false -259 } -260 compare g, 0xa/newline -261 { -262 break-if-!= -263 return 0/false -264 } -265 compare g, 0x20/space -266 { -267 break-if-!= -268 return 0/false -269 } -270 ## quotes -271 compare g, 0x22/double-quote -272 { -273 break-if-!= -274 return 0/false -275 } -276 compare g, 0x60/backquote -277 { -278 break-if-!= -279 return 0/false -280 } -281 ## brackets -282 compare g, 0x28/open-paren -283 { -284 break-if-!= -285 return 0/false -286 } -287 compare g, 0x29/close-paren -288 { -289 break-if-!= -290 return 0/false -291 } -292 compare g, 0x5b/open-square-bracket -293 { -294 break-if-!= -295 return 0/false -296 } -297 compare g, 0x5d/close-square-bracket -298 { -299 break-if-!= -300 return 0/false -301 } -302 compare g, 0x7b/open-curly-bracket -303 { -304 break-if-!= -305 return 0/false -306 } -307 compare g, 0x7d/close-curly-bracket -308 { -309 break-if-!= -310 return 0/false -311 } -312 # - other punctuation -313 # '!' is a symbol char -314 compare g, 0x23/hash -315 { -316 break-if-!= -317 return 0/false -318 } -319 # '$' is a symbol char -320 compare g, 0x25/percent -321 { -322 break-if-!= -323 return 0/false -324 } -325 compare g, 0x26/ampersand -326 { -327 break-if-!= -328 return 0/false -329 } -330 compare g, 0x27/single-quote -331 { -332 break-if-!= -333 return 0/false -334 } -335 compare g, 0x2a/asterisk -336 { -337 break-if-!= -338 return 0/false -339 } -340 compare g, 0x2b/plus -341 { -342 break-if-!= -343 return 0/false -344 } -345 compare g, 0x2c/comma -346 { -347 break-if-!= -348 return 0/false -349 } -350 compare g, 0x2d/dash # '-' not allowed in symbols -351 { -352 break-if-!= -353 return 0/false -354 } -355 compare g, 0x2e/period -356 { -357 break-if-!= -358 return 0/false -359 } -360 compare g, 0x2f/slash -361 { -362 break-if-!= -363 return 0/false -364 } -365 compare g, 0x3a/colon -366 { -367 break-if-!= -368 return 0/false -369 } -370 compare g, 0x3b/semi-colon -371 { -372 break-if-!= -373 return 0/false -374 } -375 compare g, 0x3c/less-than -376 { -377 break-if-!= -378 return 0/false -379 } -380 compare g, 0x3d/equal -381 { -382 break-if-!= -383 return 0/false -384 } -385 compare g, 0x3e/greater-than -386 { -387 break-if-!= -388 return 0/false -389 } -390 # '?' is a symbol char -391 compare g, 0x40/at-sign -392 { -393 break-if-!= -394 return 0/false -395 } -396 compare g, 0x5c/backslash -397 { -398 break-if-!= -399 return 0/false -400 } -401 compare g, 0x5e/caret -402 { -403 break-if-!= -404 return 0/false -405 } -406 # '_' is a symbol char -407 compare g, 0x7c/vertical-line -408 { -409 break-if-!= -410 return 0/false -411 } -412 compare g, 0x7e/tilde -413 { -414 break-if-!= -415 return 0/false -416 } -417 return 1/true -418 } -419 -420 fn bracket-grapheme? g: grapheme -> _/eax: boolean { -421 compare g, 0x28/open-paren -422 { -423 break-if-!= -424 return 1/true -425 } -426 compare g, 0x29/close-paren -427 { -428 break-if-!= -429 return 1/true -430 } -431 compare g, 0x5b/open-square-bracket -432 { -433 break-if-!= -434 return 1/true -435 } -436 compare g, 0x5d/close-square-bracket +137 compare g, 0x23/comment +138 break-if-!= +139 rest-of-line in, out, trace +140 break $next-token:body +141 } +142 # digit +143 { +144 var digit?/eax: boolean <- decimal-digit? g +145 compare digit?, 0/false +146 break-if-= +147 next-number-token in, out, trace +148 break $next-token:body +149 } +150 # other symbol char +151 { +152 var symbol?/eax: boolean <- symbol-grapheme? g +153 compare symbol?, 0/false +154 break-if-= +155 next-symbol-token in, out, trace +156 break $next-token:body +157 } +158 # open square brackets begin streams +159 { +160 compare g, 0x5b/open-square-bracket +161 break-if-!= +162 g <- read-from-gap-buffer in # skip open bracket +163 next-stream-token in, out, trace +164 var out-cell/eax: (addr cell) <- copy _out-cell +165 var out-cell-type/eax: (addr int) <- get out-cell, type +166 copy-to *out-cell-type, 3/stream +167 break $next-token:body +168 } +169 # unbalanced close square brackets are errors +170 { +171 compare g, 0x5d/close-square-bracket +172 break-if-!= +173 error trace, "unbalanced ']'" +174 return +175 } +176 # other brackets are always single-char tokens +177 { +178 var bracket?/eax: boolean <- bracket-grapheme? g +179 compare bracket?, 0/false +180 break-if-= +181 var g/eax: grapheme <- read-from-gap-buffer in +182 next-bracket-token g, out, trace +183 break $next-token:body +184 } +185 # non-symbol operators +186 { +187 var operator?/eax: boolean <- operator-grapheme? g +188 compare operator?, 0/false +189 break-if-= +190 next-operator-token in, out, trace +191 break $next-token:body +192 } +193 } +194 trace-higher trace +195 var stream-storage: (stream byte 0x40) +196 var stream/eax: (addr stream byte) <- address stream-storage +197 write stream, "=> " +198 rewind-stream out +199 write-stream stream, out +200 trace trace, "read", stream +201 } +202 +203 fn next-symbol-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { +204 trace-text trace, "read", "looking for a symbol" +205 trace-lower trace +206 $next-symbol-token:loop: { +207 var done?/eax: boolean <- gap-buffer-scan-done? in +208 compare done?, 0/false +209 break-if-!= +210 var g/eax: grapheme <- peek-from-gap-buffer in +211 { +212 var stream-storage: (stream byte 0x40) +213 var stream/esi: (addr stream byte) <- address stream-storage +214 write stream, "next: " +215 var gval/eax: int <- copy g +216 write-int32-hex stream, gval +217 trace trace, "read", stream +218 } +219 # if non-symbol, return +220 { +221 var symbol-grapheme?/eax: boolean <- symbol-grapheme? g +222 compare symbol-grapheme?, 0/false +223 break-if-!= +224 trace-text trace, "read", "stop" +225 break $next-symbol-token:loop +226 } +227 var g/eax: grapheme <- read-from-gap-buffer in +228 write-grapheme out, g +229 loop +230 } +231 trace-higher trace +232 var stream-storage: (stream byte 0x40) +233 var stream/esi: (addr stream byte) <- address stream-storage +234 write stream, "=> " +235 rewind-stream out +236 write-stream stream, out +237 trace trace, "read", stream +238 } +239 +240 fn next-operator-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { +241 trace-text trace, "read", "looking for a operator" +242 trace-lower trace +243 $next-operator-token:loop: { +244 var done?/eax: boolean <- gap-buffer-scan-done? in +245 compare done?, 0/false +246 break-if-!= +247 var g/eax: grapheme <- peek-from-gap-buffer in +248 { +249 var stream-storage: (stream byte 0x40) +250 var stream/esi: (addr stream byte) <- address stream-storage +251 write stream, "next: " +252 var gval/eax: int <- copy g +253 write-int32-hex stream, gval +254 trace trace, "read", stream +255 } +256 # if non-operator, return +257 { +258 var operator-grapheme?/eax: boolean <- operator-grapheme? g +259 compare operator-grapheme?, 0/false +260 break-if-!= +261 trace-text trace, "read", "stop" +262 break $next-operator-token:loop +263 } +264 var g/eax: grapheme <- read-from-gap-buffer in +265 write-grapheme out, g +266 loop +267 } +268 trace-higher trace +269 var stream-storage: (stream byte 0x40) +270 var stream/esi: (addr stream byte) <- address stream-storage +271 write stream, "=> " +272 rewind-stream out +273 write-stream stream, out +274 trace trace, "read", stream +275 } +276 +277 fn next-number-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { +278 trace-text trace, "read", "looking for a number" +279 trace-lower trace +280 $next-number-token:loop: { +281 var done?/eax: boolean <- gap-buffer-scan-done? in +282 compare done?, 0/false +283 break-if-!= +284 var g/eax: grapheme <- peek-from-gap-buffer in +285 { +286 var stream-storage: (stream byte 0x40) +287 var stream/esi: (addr stream byte) <- address stream-storage +288 write stream, "next: " +289 var gval/eax: int <- copy g +290 write-int32-hex stream, gval +291 trace trace, "read", stream +292 } +293 # if not symbol grapheme, return +294 { +295 var symbol-grapheme?/eax: boolean <- symbol-grapheme? g +296 compare symbol-grapheme?, 0/false +297 break-if-!= +298 trace-text trace, "read", "stop" +299 break $next-number-token:loop +300 } +301 # if not digit grapheme, abort +302 { +303 var digit?/eax: boolean <- decimal-digit? g +304 compare digit?, 0/false +305 break-if-!= +306 error trace, "invalid number" +307 return +308 } +309 trace-text trace, "read", "append" +310 var g/eax: grapheme <- read-from-gap-buffer in +311 write-grapheme out, g +312 loop +313 } +314 trace-higher trace +315 } +316 +317 fn next-stream-token in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { +318 trace-text trace, "read", "stream" +319 { +320 var empty?/eax: boolean <- gap-buffer-scan-done? in +321 compare empty?, 0/false +322 { +323 break-if-= +324 error trace, "unbalanced '['" +325 return +326 } +327 var g/eax: grapheme <- read-from-gap-buffer in +328 compare g, 0x5d/close-square-bracket +329 break-if-= +330 write-grapheme out, g +331 loop +332 } +333 var stream-storage: (stream byte 0x40) +334 var stream/esi: (addr stream byte) <- address stream-storage +335 write stream, "=> " +336 rewind-stream out +337 write-stream stream, out +338 trace trace, "read", stream +339 } +340 +341 fn next-bracket-token g: grapheme, out: (addr stream byte), trace: (addr trace) { +342 trace-text trace, "read", "bracket" +343 write-grapheme out, g +344 var stream-storage: (stream byte 0x40) +345 var stream/esi: (addr stream byte) <- address stream-storage +346 write stream, "=> " +347 rewind-stream out +348 write-stream stream, out +349 trace trace, "read", stream +350 } +351 +352 fn rest-of-line in: (addr gap-buffer), out: (addr stream byte), trace: (addr trace) { +353 trace-text trace, "read", "comment" +354 { +355 var empty?/eax: boolean <- gap-buffer-scan-done? in +356 compare empty?, 0/false +357 { +358 break-if-= +359 return +360 } +361 var g/eax: grapheme <- read-from-gap-buffer in +362 compare g, 0xa/newline +363 break-if-= +364 write-grapheme out, g +365 loop +366 } +367 var stream-storage: (stream byte 0x80) +368 var stream/esi: (addr stream byte) <- address stream-storage +369 write stream, "=> " +370 rewind-stream out +371 write-stream stream, out +372 trace trace, "read", stream +373 } +374 +375 fn symbol-grapheme? g: grapheme -> _/eax: boolean { +376 ## whitespace +377 compare g, 9/tab +378 { +379 break-if-!= +380 return 0/false +381 } +382 compare g, 0xa/newline +383 { +384 break-if-!= +385 return 0/false +386 } +387 compare g, 0x20/space +388 { +389 break-if-!= +390 return 0/false +391 } +392 ## quotes +393 compare g, 0x22/double-quote +394 { +395 break-if-!= +396 return 0/false +397 } +398 compare g, 0x60/backquote +399 { +400 break-if-!= +401 return 0/false +402 } +403 ## brackets +404 compare g, 0x28/open-paren +405 { +406 break-if-!= +407 return 0/false +408 } +409 compare g, 0x29/close-paren +410 { +411 break-if-!= +412 return 0/false +413 } +414 compare g, 0x5b/open-square-bracket +415 { +416 break-if-!= +417 return 0/false +418 } +419 compare g, 0x5d/close-square-bracket +420 { +421 break-if-!= +422 return 0/false +423 } +424 compare g, 0x7b/open-curly-bracket +425 { +426 break-if-!= +427 return 0/false +428 } +429 compare g, 0x7d/close-curly-bracket +430 { +431 break-if-!= +432 return 0/false +433 } +434 # - other punctuation +435 # '!' is a symbol char +436 compare g, 0x23/hash 437 { 438 break-if-!= -439 return 1/true +439 return 0/false 440 } -441 compare g, 0x7b/open-curly-bracket -442 { -443 break-if-!= -444 return 1/true -445 } -446 compare g, 0x7d/close-curly-bracket -447 { -448 break-if-!= -449 return 1/true -450 } -451 return 0/false -452 } -453 -454 fn operator-grapheme? g: grapheme -> _/eax: boolean { -455 # '$' is a symbol char -456 compare g, 0x25/percent -457 { -458 break-if-!= -459 return 1/false -460 } -461 compare g, 0x26/ampersand -462 { -463 break-if-!= -464 return 1/true -465 } -466 compare g, 0x27/single-quote -467 { -468 break-if-!= -469 return 1/true -470 } -471 compare g, 0x2a/asterisk -472 { -473 break-if-!= -474 return 1/true -475 } -476 compare g, 0x2b/plus -477 { -478 break-if-!= -479 return 1/true -480 } -481 compare g, 0x2c/comma -482 { -483 break-if-!= -484 return 1/true -485 } -486 compare g, 0x2d/dash # '-' not allowed in symbols -487 { -488 break-if-!= -489 return 1/true -490 } -491 compare g, 0x2e/period -492 { -493 break-if-!= -494 return 1/true -495 } -496 compare g, 0x2f/slash -497 { -498 break-if-!= -499 return 1/true -500 } -501 compare g, 0x3a/colon -502 { -503 break-if-!= -504 return 1/true -505 } -506 compare g, 0x3b/semi-colon -507 { -508 break-if-!= -509 return 1/true -510 } -511 compare g, 0x3c/less-than -512 { -513 break-if-!= -514 return 1/true -515 } -516 compare g, 0x3d/equal -517 { -518 break-if-!= -519 return 1/true -520 } -521 compare g, 0x3e/greater-than -522 { -523 break-if-!= -524 return 1/true -525 } -526 # '?' is a symbol char -527 compare g, 0x40/at-sign -528 { -529 break-if-!= -530 return 1/true -531 } -532 compare g, 0x5c/backslash -533 { -534 break-if-!= -535 return 1/true -536 } -537 compare g, 0x5e/caret -538 { -539 break-if-!= -540 return 1/true -541 } -542 # '_' is a symbol char -543 compare g, 0x7c/vertical-line +441 # '$' is a symbol char +442 compare g, 0x25/percent +443 { +444 break-if-!= +445 return 0/false +446 } +447 compare g, 0x26/ampersand +448 { +449 break-if-!= +450 return 0/false +451 } +452 compare g, 0x27/single-quote +453 { +454 break-if-!= +455 return 0/false +456 } +457 compare g, 0x2a/asterisk +458 { +459 break-if-!= +460 return 0/false +461 } +462 compare g, 0x2b/plus +463 { +464 break-if-!= +465 return 0/false +466 } +467 compare g, 0x2c/comma +468 { +469 break-if-!= +470 return 0/false +471 } +472 compare g, 0x2d/dash # '-' not allowed in symbols +473 { +474 break-if-!= +475 return 0/false +476 } +477 compare g, 0x2e/period +478 { +479 break-if-!= +480 return 0/false +481 } +482 compare g, 0x2f/slash +483 { +484 break-if-!= +485 return 0/false +486 } +487 compare g, 0x3a/colon +488 { +489 break-if-!= +490 return 0/false +491 } +492 compare g, 0x3b/semi-colon +493 { +494 break-if-!= +495 return 0/false +496 } +497 compare g, 0x3c/less-than +498 { +499 break-if-!= +500 return 0/false +501 } +502 compare g, 0x3d/equal +503 { +504 break-if-!= +505 return 0/false +506 } +507 compare g, 0x3e/greater-than +508 { +509 break-if-!= +510 return 0/false +511 } +512 # '?' is a symbol char +513 compare g, 0x40/at-sign +514 { +515 break-if-!= +516 return 0/false +517 } +518 compare g, 0x5c/backslash +519 { +520 break-if-!= +521 return 0/false +522 } +523 compare g, 0x5e/caret +524 { +525 break-if-!= +526 return 0/false +527 } +528 # '_' is a symbol char +529 compare g, 0x7c/vertical-line +530 { +531 break-if-!= +532 return 0/false +533 } +534 compare g, 0x7e/tilde +535 { +536 break-if-!= +537 return 0/false +538 } +539 return 1/true +540 } +541 +542 fn bracket-grapheme? g: grapheme -> _/eax: boolean { +543 compare g, 0x28/open-paren 544 { 545 break-if-!= 546 return 1/true 547 } -548 compare g, 0x7e/tilde +548 compare g, 0x29/close-paren 549 { 550 break-if-!= 551 return 1/true 552 } -553 return 0/false -554 } -555 -556 fn number-token? _in: (addr cell) -> _/eax: boolean { -557 var in/eax: (addr cell) <- copy _in -558 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -559 var in-data/eax: (addr stream byte) <- lookup *in-data-ah -560 rewind-stream in-data -561 var g/eax: grapheme <- read-grapheme in-data -562 var result/eax: boolean <- decimal-digit? g -563 return result -564 } -565 -566 fn bracket-token? _in: (addr cell) -> _/eax: boolean { -567 var in/eax: (addr cell) <- copy _in -568 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -569 var in-data/eax: (addr stream byte) <- lookup *in-data-ah -570 rewind-stream in-data -571 var g/eax: grapheme <- read-grapheme in-data -572 var result/eax: boolean <- bracket-grapheme? g -573 return result +553 compare g, 0x5b/open-square-bracket +554 { +555 break-if-!= +556 return 1/true +557 } +558 compare g, 0x5d/close-square-bracket +559 { +560 break-if-!= +561 return 1/true +562 } +563 compare g, 0x7b/open-curly-bracket +564 { +565 break-if-!= +566 return 1/true +567 } +568 compare g, 0x7d/close-curly-bracket +569 { +570 break-if-!= +571 return 1/true +572 } +573 return 0/false 574 } 575 -576 fn quote-token? _in: (addr cell) -> _/eax: boolean { -577 var in/eax: (addr cell) <- copy _in -578 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -579 var in-data/eax: (addr stream byte) <- lookup *in-data-ah -580 rewind-stream in-data -581 var g/eax: grapheme <- read-grapheme in-data -582 compare g, 0x27/single-quote -583 { -584 break-if-!= -585 return 1/true -586 } -587 return 0/false -588 } -589 -590 fn open-paren-token? _in: (addr cell) -> _/eax: boolean { -591 var in/eax: (addr cell) <- copy _in -592 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -593 var _in-data/eax: (addr stream byte) <- lookup *in-data-ah -594 var in-data/ecx: (addr stream byte) <- copy _in-data -595 rewind-stream in-data -596 var g/eax: grapheme <- read-grapheme in-data -597 compare g, 0x28/open-paren -598 { -599 break-if-!= -600 var result/eax: boolean <- stream-empty? in-data -601 return result +576 fn operator-grapheme? g: grapheme -> _/eax: boolean { +577 # '$' is a symbol char +578 compare g, 0x25/percent +579 { +580 break-if-!= +581 return 1/false +582 } +583 compare g, 0x26/ampersand +584 { +585 break-if-!= +586 return 1/true +587 } +588 compare g, 0x27/single-quote +589 { +590 break-if-!= +591 return 1/true +592 } +593 compare g, 0x2a/asterisk +594 { +595 break-if-!= +596 return 1/true +597 } +598 compare g, 0x2b/plus +599 { +600 break-if-!= +601 return 1/true 602 } -603 return 0/false -604 } -605 -606 fn close-paren-token? _in: (addr cell) -> _/eax: boolean { -607 var in/eax: (addr cell) <- copy _in -608 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -609 var _in-data/eax: (addr stream byte) <- lookup *in-data-ah -610 var in-data/ecx: (addr stream byte) <- copy _in-data -611 rewind-stream in-data -612 var g/eax: grapheme <- read-grapheme in-data -613 compare g, 0x29/close-paren +603 compare g, 0x2c/comma +604 { +605 break-if-!= +606 return 1/true +607 } +608 compare g, 0x2d/dash # '-' not allowed in symbols +609 { +610 break-if-!= +611 return 1/true +612 } +613 compare g, 0x2e/period 614 { 615 break-if-!= -616 var result/eax: boolean <- stream-empty? in-data -617 return result -618 } -619 return 0/false -620 } -621 -622 fn dot-token? _in: (addr cell) -> _/eax: boolean { -623 var in/eax: (addr cell) <- copy _in -624 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data -625 var _in-data/eax: (addr stream byte) <- lookup *in-data-ah -626 var in-data/ecx: (addr stream byte) <- copy _in-data -627 rewind-stream in-data -628 var g/eax: grapheme <- read-grapheme in-data -629 compare g, 0x2e/dot -630 { -631 break-if-!= -632 var result/eax: boolean <- stream-empty? in-data -633 return result -634 } -635 return 0/false -636 } -637 -638 fn test-dot-token { -639 var tmp-storage: (handle cell) -640 var tmp-ah/eax: (addr handle cell) <- address tmp-storage -641 new-symbol tmp-ah, "." -642 var tmp/eax: (addr cell) <- lookup *tmp-ah -643 var result/eax: boolean <- dot-token? tmp -644 check result, "F - test-dot-token" -645 } +616 return 1/true +617 } +618 compare g, 0x2f/slash +619 { +620 break-if-!= +621 return 1/true +622 } +623 compare g, 0x3a/colon +624 { +625 break-if-!= +626 return 1/true +627 } +628 compare g, 0x3b/semi-colon +629 { +630 break-if-!= +631 return 1/true +632 } +633 compare g, 0x3c/less-than +634 { +635 break-if-!= +636 return 1/true +637 } +638 compare g, 0x3d/equal +639 { +640 break-if-!= +641 return 1/true +642 } +643 compare g, 0x3e/greater-than +644 { +645 break-if-!= +646 return 1/true +647 } +648 # '?' is a symbol char +649 compare g, 0x40/at-sign +650 { +651 break-if-!= +652 return 1/true +653 } +654 compare g, 0x5c/backslash +655 { +656 break-if-!= +657 return 1/true +658 } +659 compare g, 0x5e/caret +660 { +661 break-if-!= +662 return 1/true +663 } +664 # '_' is a symbol char +665 compare g, 0x7c/vertical-line +666 { +667 break-if-!= +668 return 1/true +669 } +670 compare g, 0x7e/tilde +671 { +672 break-if-!= +673 return 1/true +674 } +675 return 0/false +676 } +677 +678 fn number-token? _in: (addr cell) -> _/eax: boolean { +679 var in/eax: (addr cell) <- copy _in +680 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +681 var in-data/eax: (addr stream byte) <- lookup *in-data-ah +682 rewind-stream in-data +683 var g/eax: grapheme <- read-grapheme in-data +684 var result/eax: boolean <- decimal-digit? g +685 return result +686 } +687 +688 fn bracket-token? _in: (addr cell) -> _/eax: boolean { +689 var in/eax: (addr cell) <- copy _in +690 { +691 var in-type/eax: (addr int) <- get in, type +692 compare *in-type, 3/stream +693 break-if-!= +694 # streams are never paren tokens +695 return 0/false +696 } +697 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +698 var in-data/eax: (addr stream byte) <- lookup *in-data-ah +699 rewind-stream in-data +700 var g/eax: grapheme <- read-grapheme in-data +701 var result/eax: boolean <- bracket-grapheme? g +702 return result +703 } +704 +705 fn quote-token? _in: (addr cell) -> _/eax: boolean { +706 var in/eax: (addr cell) <- copy _in +707 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +708 var in-data/eax: (addr stream byte) <- lookup *in-data-ah +709 rewind-stream in-data +710 var g/eax: grapheme <- read-grapheme in-data +711 compare g, 0x27/single-quote +712 { +713 break-if-!= +714 return 1/true +715 } +716 return 0/false +717 } +718 +719 fn open-paren-token? _in: (addr cell) -> _/eax: boolean { +720 var in/eax: (addr cell) <- copy _in +721 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +722 var _in-data/eax: (addr stream byte) <- lookup *in-data-ah +723 var in-data/ecx: (addr stream byte) <- copy _in-data +724 rewind-stream in-data +725 var g/eax: grapheme <- read-grapheme in-data +726 compare g, 0x28/open-paren +727 { +728 break-if-!= +729 var result/eax: boolean <- stream-empty? in-data +730 return result +731 } +732 return 0/false +733 } +734 +735 fn close-paren-token? _in: (addr cell) -> _/eax: boolean { +736 var in/eax: (addr cell) <- copy _in +737 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +738 var _in-data/eax: (addr stream byte) <- lookup *in-data-ah +739 var in-data/ecx: (addr stream byte) <- copy _in-data +740 rewind-stream in-data +741 var g/eax: grapheme <- read-grapheme in-data +742 compare g, 0x29/close-paren +743 { +744 break-if-!= +745 var result/eax: boolean <- stream-empty? in-data +746 return result +747 } +748 return 0/false +749 } +750 +751 fn dot-token? _in: (addr cell) -> _/eax: boolean { +752 var in/eax: (addr cell) <- copy _in +753 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +754 var _in-data/eax: (addr stream byte) <- lookup *in-data-ah +755 var in-data/ecx: (addr stream byte) <- copy _in-data +756 rewind-stream in-data +757 var g/eax: grapheme <- read-grapheme in-data +758 compare g, 0x2e/dot +759 { +760 break-if-!= +761 var result/eax: boolean <- stream-empty? in-data +762 return result +763 } +764 return 0/false +765 } +766 +767 fn test-dot-token { +768 var tmp-storage: (handle cell) +769 var tmp-ah/eax: (addr handle cell) <- address tmp-storage +770 new-symbol tmp-ah, "." +771 var tmp/eax: (addr cell) <- lookup *tmp-ah +772 var result/eax: boolean <- dot-token? tmp +773 check result, "F - test-dot-token" +774 } +775 +776 fn stream-token? _in: (addr cell) -> _/eax: boolean { +777 var in/eax: (addr cell) <- copy _in +778 var in-type/eax: (addr int) <- get in, type +779 compare *in-type, 3/stream +780 { +781 break-if-= +782 return 0/false +783 } +784 return 1/true +785 } +786 +787 fn comment-token? _in: (addr cell) -> _/eax: boolean { +788 var in/eax: (addr cell) <- copy _in +789 var in-data-ah/eax: (addr handle stream byte) <- get in, text-data +790 var in-data/eax: (addr stream byte) <- lookup *in-data-ah +791 rewind-stream in-data +792 var g/eax: grapheme <- read-grapheme in-data +793 compare g, 0x23/hash +794 { +795 break-if-= +796 return 0/false +797 } +798 return 1/true +799 } diff --git a/html/shell/trace.mu.html b/html/shell/trace.mu.html index f2d2336e..8a74c7a4 100644 --- a/html/shell/trace.mu.html +++ b/html/shell/trace.mu.html @@ -167,7 +167,7 @@ if ('onhashchange' in window) { 108 write message, " - find a smaller sub-computation to test,\n" 109 write message, " - allocate more space to the trace in initialize-sandbox\n" 110 write message, " (shell/sandbox.mu), or\n" - 111 write message, " - move the computation to 'main' and run it using ctrl-s" + 111 write message, " - move the computation to 'main' and run it using ctrl-s" 112 initialize-trace-line 0/depth, "error", message, dest 113 increment *index-addr 114 return @@ -361,7 +361,7 @@ if ('onhashchange' in window) { 302 var curr/ebx: (addr trace-line) <- index trace, offset 303 var curr-label-ah/eax: (addr handle array byte) <- get curr, label 304 var curr-label/eax: (addr array byte) <- lookup *curr-label-ah - 305 y <- render-trace-line 0/screen, curr, 0, y, 0x80/width, 0x30/height, 7/fg, 0/bg + 305 y <- render-trace-line 0/screen, curr, 0, y, 0x80/width, 0x30/height, 7/fg, 0xc5/bg=blue-bg 306 } 307 i <- increment 308 loop @@ -406,7 +406,7 @@ if ('onhashchange' in window) { 347 var curr/ebx: (addr trace-line) <- index trace, offset 348 var curr-label-ah/eax: (addr handle array byte) <- get curr, label 349 var curr-label/eax: (addr array byte) <- lookup *curr-label-ah - 350 var bg/edi: int <- copy 0/black + 350 var bg/edi: int <- copy 0xc5/bg=blue-bg 351 compare show-cursor?, 0/false 352 { 353 break-if-= @@ -431,7 +431,7 @@ if ('onhashchange' in window) { 372 { 373 compare display?, 0/false 374 break-if-= - 375 y <- render-trace-line screen, curr, xmin, y, xmax, ymax, 9/fg=blue, bg + 375 y <- render-trace-line screen, curr, xmin, y, xmax, ymax, 0x38/fg=trace, bg 376 copy-to already-hiding-lines?, 0/false 377 break $render-trace:iter 378 } @@ -565,7 +565,7 @@ if ('onhashchange' in window) { 506 { 507 compare display?, 0/false 508 break-if-= - 509 var dummy/ecx: int <- render-trace-line screen, cursor-line, xmin, y, xmax, ymax, 9/fg=blue, 7/cursor-line-bg + 509 var dummy/ecx: int <- render-trace-line screen, cursor-line, xmin, y, xmax, ymax, 0x38/fg=trace, 7/cursor-line-bg 510 return 511 } 512 var dummy1/eax: int <- copy 0 @@ -744,20 +744,20 @@ if ('onhashchange' in window) { 685 var y/ecx: int <- copy height 686 y <- decrement 687 set-cursor-position screen, 0/x, y - 688 draw-text-rightward-from-cursor screen, " ctrl-r ", width, 0/fg, 7/bg=grey - 689 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0/bg - 690 draw-text-rightward-from-cursor screen, " ctrl-s ", width, 0/fg, 7/bg=grey - 691 draw-text-rightward-from-cursor screen, " run sandbox ", width, 7/fg, 0/bg - 692 draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 0x18/bg=keyboard - 693 draw-text-rightward-from-cursor screen, " to keyboard ", width, 7/fg, 0/bg - 694 draw-text-rightward-from-cursor screen, " j ", width, 0/fg, 7/bg=grey - 695 draw-text-rightward-from-cursor screen, " down ", width, 7/fg, 0/bg - 696 draw-text-rightward-from-cursor screen, " k ", width, 0/fg, 7/bg=grey - 697 draw-text-rightward-from-cursor screen, " up ", width, 7/fg, 0/bg - 698 draw-text-rightward-from-cursor screen, " enter ", width, 0/fg, 7/bg=grey - 699 draw-text-rightward-from-cursor screen, " expand ", width, 7/fg, 0/bg - 700 draw-text-rightward-from-cursor screen, " backspace ", width, 0/fg, 7/bg=grey - 701 draw-text-rightward-from-cursor screen, " collapse ", width, 7/fg, 0/bg + 688 draw-text-rightward-from-cursor screen, " ctrl-r ", width, 0/fg, 0x5c/bg=black + 689 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0xc5/bg=blue-bg + 690 draw-text-rightward-from-cursor screen, " ctrl-s ", width, 0/fg, 0x5c/bg=black + 691 draw-text-rightward-from-cursor screen, " run sandbox ", width, 7/fg, 0xc5/bg=blue-bg + 692 draw-text-rightward-from-cursor screen, " ctrl-m ", width, 0/fg, 3/bg=keyboard + 693 draw-text-rightward-from-cursor screen, " to keyboard ", width, 7/fg, 0xc5/bg=blue-bg + 694 draw-text-rightward-from-cursor screen, " j ", width, 0/fg, 0x5c/bg=black + 695 draw-text-rightward-from-cursor screen, " down ", width, 7/fg, 0xc5/bg=blue-bg + 696 draw-text-rightward-from-cursor screen, " k ", width, 0/fg, 0x5c/bg=black + 697 draw-text-rightward-from-cursor screen, " up ", width, 7/fg, 0xc5/bg=blue-bg + 698 draw-text-rightward-from-cursor screen, " enter ", width, 0/fg, 0x5c/bg=black + 699 draw-text-rightward-from-cursor screen, " expand ", width, 7/fg, 0xc5/bg=blue-bg + 700 draw-text-rightward-from-cursor screen, " backspace ", width, 0/fg, 0x5c/bg=black + 701 draw-text-rightward-from-cursor screen, " collapse ", width, 7/fg, 0xc5/bg=blue-bg 702 } 703 704 fn edit-trace _self: (addr trace), key: grapheme { -- cgit 1.4.1-2-gfad0