1 type cell {
  2   type: int
  3   # type 0: pair; the unit of lists, trees, DAGS or graphs
  4   left: (handle cell)
  5   right: (handle cell)
  6   # type 1: number
  7   number-data: float
  8   # type 2: symbol
  9   # type 3: stream
 10   text-data: (handle stream byte)
 11   # type 4: primitive function
 12   index-data: int
 13   # type 5: screen
 14   screen-data: (handle screen)
 15   # type 6: keyboard
 16   keyboard-data: (handle gap-buffer)
 17   # TODO: array, (associative) table
 18   # if you add types here, don't forget to update cell-isomorphic?
 19 }
 20 
 21 fn allocate-symbol _out: (addr handle cell) {
 22   var out/eax: (addr handle cell) <- copy _out
 23   allocate out
 24   var out-addr/eax: (addr cell) <- lookup *out
 25   var type/ecx: (addr int) <- get out-addr, type
 26   copy-to *type, 2/symbol
 27   var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data
 28   populate-stream dest-ah, 0x40/max-symbol-size
 29 }
 30 
 31 fn initialize-symbol _out: (addr handle cell), val: (addr array byte) {
 32   var out/eax: (addr handle cell) <- copy _out
 33   var out-addr/eax: (addr cell) <- lookup *out
 34   var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data
 35   var dest/eax: (addr stream byte) <- lookup *dest-ah
 36   write dest, val
 37 }
 38 
 39 fn new-symbol out: (addr handle cell), val: (addr array byte) {
 40   allocate-symbol out
 41   initialize-symbol out, val
 42 }
 43 
 44 fn symbol-equal? _in: (addr cell), name: (addr array byte) -> _/eax: boolean {
 45   var in/esi: (addr cell) <- copy _in
 46   var in-type/eax: (addr int) <- get in, type
 47   compare *in-type, 2/symbol
 48   {
 49     break-if-=
 50     return 0/false
 51   }
 52   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
 53   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
 54   var result/eax: boolean <- stream-data-equal? in-data, name
 55   return result
 56 }
 57 
 58 fn allocate-stream _out: (addr handle cell) {
 59   var out/eax: (addr handle cell) <- copy _out
 60   allocate out
 61   var out-addr/eax: (addr cell) <- lookup *out
 62   var type/ecx: (addr int) <- get out-addr, type
 63   copy-to *type, 3/stream
 64   var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data
 65   populate-stream dest-ah, 0x40/max-stream-size
 66 }
 67 
 68 fn allocate-number _out: (addr handle cell) {
 69   var out/eax: (addr handle cell) <- copy _out
 70   allocate out
 71   var out-addr/eax: (addr cell) <- lookup *out
 72   var type/ecx: (addr int) <- get out-addr, type
 73   copy-to *type, 1/number
 74 }
 75 
 76 fn initialize-integer _out: (addr handle cell), n: int {
 77   var out/eax: (addr handle cell) <- copy _out
 78   var out-addr/eax: (addr cell) <- lookup *out
 79   var dest-addr/eax: (addr float) <- get out-addr, number-data
 80   var src/xmm0: float <- convert n
 81   copy-to *dest-addr, src
 82 }
 83 
 84 fn new-integer out: (addr handle cell), n: int {
 85   allocate-number out
 86   initialize-integer out, n
 87 }
 88 
 89 fn initialize-float _out: (addr handle cell), n: float {
 90   var out/eax: (addr handle cell) <- copy _out
 91   var out-addr/eax: (addr cell) <- lookup *out
 92   var dest-ah/eax: (addr float) <- get out-addr, number-data
 93   var src/xmm0: float <- copy n
 94   copy-to *dest-ah, src
 95 }
 96 
 97 fn new-float out: (addr handle cell), n: float {
 98   allocate-number out
 99   initialize-float out, n
100 }
101 
102 fn allocate-pair out: (addr handle cell) {
103   allocate out
104   # new cells have type pair by default
105 }
106 
107 fn initialize-pair _out: (addr handle cell), left: (handle cell), right: (handle cell) {
108   var out/eax: (addr handle cell) <- copy _out
109   var out-addr/eax: (addr cell) <- lookup *out
110   var dest-ah/ecx: (addr handle cell) <- get out-addr, left
111   copy-handle left, dest-ah
112   dest-ah <- get out-addr, right
113   copy-handle right, dest-ah
114 }
115 
116 fn new-pair out: (addr handle cell), left: (handle cell), right: (handle cell) {
117   allocate-pair out
118   initialize-pair out, left, right
119 }
120 
121 fn nil out: (addr handle cell) {
122   allocate-pair out
123 }
124 
125 fn allocate-primitive-function _out: (addr handle cell) {
126   var out/eax: (addr handle cell) <- copy _out
127   allocate out
128   var out-addr/eax: (addr cell) <- lookup *out
129   var type/ecx: (addr int) <- get out-addr, type
130   copy-to *type, 4/primitive-function
131 }
132 
133 fn initialize-primitive-function _out: (addr handle cell), n: int {
134   var out/eax: (addr handle cell) <- copy _out
135   var out-addr/eax: (addr cell) <- lookup *out
136   var dest-addr/eax: (addr int) <- get out-addr, index-data
137   var src/ecx: int <- copy n
138   copy-to *dest-addr, src
139 }
140 
141 fn new-primitive-function out: (addr handle cell), n: int {
142   allocate-primitive-function out
143   initialize-primitive-function out, n
144 }
145 
146 fn allocate-screen _out: (addr handle cell) {
147   var out/eax: (addr handle cell) <- copy _out
148   allocate out
149   var out-addr/eax: (addr cell) <- lookup *out
150   var type/ecx: (addr int) <- get out-addr, type
151   copy-to *type, 5/screen
152 }
153 
154 fn new-fake-screen _out: (addr handle cell), width: int, height: int, pixel-graphics?: boolean {
155   var out/eax: (addr handle cell) <- copy _out
156   allocate-screen out
157   var out-addr/eax: (addr cell) <- lookup *out
158   var dest-ah/eax: (addr handle screen) <- get out-addr, screen-data
159   allocate dest-ah
160   var dest-addr/eax: (addr screen) <- lookup *dest-ah
161   initialize-screen dest-addr, width, height, pixel-graphics?
162 }
163 
164 fn clear-screen-var _self-ah: (addr handle cell) {
165   var self-ah/eax: (addr handle cell) <- copy _self-ah
166   var self/eax: (addr cell) <- lookup *self-ah
167   compare self, 0
168   {
169     break-if-!=
170     return
171   }
172   var screen-ah/eax: (addr handle screen) <- get self, screen-data
173   var screen/eax: (addr screen) <- lookup *screen-ah
174   clear-screen screen
175 }
176 
177 fn allocate-keyboard _out: (addr handle cell) {
178   var out/eax: (addr handle cell) <- copy _out
179   allocate out
180   var out-addr/eax: (addr cell) <- lookup *out
181   var type/ecx: (addr int) <- get out-addr, type
182   copy-to *type, 6/keyboard
183 }
184 
185 fn new-fake-keyboard _out: (addr handle cell), capacity: int {
186   var out/eax: (addr handle cell) <- copy _out
187   allocate-keyboard out
188   var out-addr/eax: (addr cell) <- lookup *out
189   var dest-ah/eax: (addr handle gap-buffer) <- get out-addr, keyboard-data
190   allocate dest-ah
191   var dest-addr/eax: (addr gap-buffer) <- lookup *dest-ah
192   initialize-gap-buffer dest-addr, capacity
193 }
194 
195 fn rewind-keyboard-var _self-ah: (addr handle cell) {
196   var self-ah/eax: (addr handle cell) <- copy _self-ah
197   var self/eax: (addr cell) <- lookup *self-ah
198   compare self, 0
199   {
200     break-if-!=
201     return
202   }
203   var keyboard-ah/eax: (addr handle gap-buffer) <- get self, keyboard-data
204   var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
205   rewind-gap-buffer keyboard
206 }