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   # type 7: array
 18   array-data: (handle array handle cell)
 19   # type 8: image
 20   image-data: (handle image)
 21   # TODO: (associative) table
 22   # if you add types here, don't forget to update cell-isomorphic?
 23 }
 24 
 25 fn allocate-symbol _out: (addr handle cell) {
 26   var out/eax: (addr handle cell) <- copy _out
 27   allocate out
 28   var out-addr/eax: (addr cell) <- lookup *out
 29   var type/ecx: (addr int) <- get out-addr, type
 30   copy-to *type, 2/symbol
 31   var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data
 32   populate-stream dest-ah, 0x40/max-symbol-size
 33 }
 34 
 35 fn initialize-symbol _out: (addr handle cell), val: (addr array byte) {
 36   var out/eax: (addr handle cell) <- copy _out
 37   var out-addr/eax: (addr cell) <- lookup *out
 38   var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data
 39   var dest/eax: (addr stream byte) <- lookup *dest-ah
 40   write dest, val
 41 }
 42 
 43 fn new-symbol out: (addr handle cell), val: (addr array byte) {
 44   allocate-symbol out
 45   initialize-symbol out, val
 46 }
 47 
 48 fn symbol? _x: (addr cell) -> _/eax: boolean {
 49   var x/esi: (addr cell) <- copy _x
 50   var type/eax: (addr int) <- get x, type
 51   compare *type, 2/symbol
 52   {
 53     break-if-=
 54     return 0/false
 55   }
 56   return 1/true
 57 }
 58 
 59 fn symbol-equal? _in: (addr cell), name: (addr array byte) -> _/eax: boolean {
 60   var in/esi: (addr cell) <- copy _in
 61   var in-type/eax: (addr int) <- get in, type
 62   compare *in-type, 2/symbol
 63   {
 64     break-if-=
 65     return 0/false
 66   }
 67   var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
 68   var in-data/eax: (addr stream byte) <- lookup *in-data-ah
 69   var result/eax: boolean <- stream-data-equal? in-data, name
 70   return result
 71 }
 72 
 73 fn allocate-stream _out: (addr handle cell) {
 74   var out/eax: (addr handle cell) <- copy _out
 75   allocate out
 76   var out-addr/eax: (addr cell) <- lookup *out
 77   var type/ecx: (addr int) <- get out-addr, type
 78   copy-to *type, 3/stream
 79   var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data
 80   populate-stream dest-ah, 0x40/max-stream-size
 81 }
 82 
 83 fn allocate-number _out: (addr handle cell) {
 84   var out/eax: (addr handle cell) <- copy _out
 85   allocate out
 86   var out-addr/eax: (addr cell) <- lookup *out
 87   var type/ecx: (addr int) <- get out-addr, type
 88   copy-to *type, 1/number
 89 }
 90 
 91 fn initialize-integer _out: (addr handle cell), n: int {
 92   var out/eax: (addr handle cell) <- copy _out
 93   var out-addr/eax: (addr cell) <- lookup *out
 94   var dest-addr/eax: (addr float) <- get out-addr, number-data
 95   var src/xmm0: float <- convert n
 96   copy-to *dest-addr, src
 97 }
 98 
 99 fn new-integer out: (addr handle cell), n: int {
100   allocate-number out
101   initialize-integer out, n
102 }
103 
104 fn initialize-float _out: (addr handle cell), n: float {
105   var out/eax: (addr handle cell) <- copy _out
106   var out-addr/eax: (addr cell) <- lookup *out
107   var dest-ah/eax: (addr float) <- get out-addr, number-data
108   var src/xmm0: float <- copy n
109   copy-to *dest-ah, src
110 }
111 
112 fn new-float out: (addr handle cell), n: float {
113   allocate-number out
114   initialize-float out, n
115 }
116 
117 fn number? _x: (addr cell) -> _/eax: boolean {
118   var x/esi: (addr cell) <- copy _x
119   var type/eax: (addr int) <- get x, type
120   compare *type, 1/number
121   {
122     break-if-=
123     return 0/false
124   }
125   return 1/true
126 }
127 
128 fn allocate-pair out: (addr handle cell) {
129   allocate out
130   # new cells have type pair by default
131 }
132 
133 fn initialize-pair _out: (addr handle cell), left: (handle cell), right: (handle cell) {
134   var out/eax: (addr handle cell) <- copy _out
135   var out-addr/eax: (addr cell) <- lookup *out
136   var dest-ah/ecx: (addr handle cell) <- get out-addr, left
137   copy-handle left, dest-ah
138   dest-ah <- get out-addr, right
139   copy-handle right, dest-ah
140 }
141 
142 fn new-pair out: (addr handle cell), left: (handle cell), right: (handle cell) {
143   allocate-pair out
144   initialize-pair out, left, right
145 }
146 
147 fn nil out: (addr handle cell) {
148   allocate-pair out
149 }
150 
151 fn pair? _x: (addr cell) -> _/eax: boolean {
152   var x/esi: (addr cell) <- copy _x
153   var type/eax: (addr int) <- get x, type
154   compare *type, 0/pair
155   {
156     break-if-=
157     return 0/false
158   }
159   return 1/true
160 }
161 
162 fn allocate-primitive-function _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, 4/primitive-function
168 }
169 
170 fn initialize-primitive-function _out: (addr handle cell), n: int {
171   var out/eax: (addr handle cell) <- copy _out
172   var out-addr/eax: (addr cell) <- lookup *out
173   var type/ecx: (addr int) <- get out-addr, type
174   copy-to *type, 4/primitive
175   var dest-addr/eax: (addr int) <- get out-addr, index-data
176   var src/ecx: int <- copy n
177   copy-to *dest-addr, src
178 }
179 
180 fn new-primitive-function out: (addr handle cell), n: int {
181   allocate-primitive-function out
182   initialize-primitive-function out, n
183 }
184 
185 fn primitive? _x: (addr cell) -> _/eax: boolean {
186   var x/esi: (addr cell) <- copy _x
187   var type/eax: (addr int) <- get x, type
188   compare *type, 4/primitive
189   {
190     break-if-=
191     return 0/false
192   }
193   return 1/true
194 }
195 
196 fn allocate-screen _out: (addr handle cell) {
197   var out/eax: (addr handle cell) <- copy _out
198   allocate out
199   var out-addr/eax: (addr cell) <- lookup *out
200   var type/ecx: (addr int) <- get out-addr, type
201   copy-to *type, 5/screen
202 }
203 
204 fn new-fake-screen _out: (addr handle cell), width: int, height: int, pixel-graphics?: boolean {
205   var out/eax: (addr handle cell) <- copy _out
206   allocate-screen out
207   var out-addr/eax: (addr cell) <- lookup *out
208   var dest-ah/eax: (addr handle screen) <- get out-addr, screen-data
209   allocate dest-ah
210   var dest-addr/eax: (addr screen) <- lookup *dest-ah
211   initialize-screen dest-addr, width, height, pixel-graphics?
212 }
213 
214 fn screen? _x: (addr cell) -> _/eax: boolean {
215   var x/esi: (addr cell) <- copy _x
216   var type/eax: (addr int) <- get x, type
217   compare *type, 5/screen
218   {
219     break-if-=
220     return 0/false
221   }
222   return 1/true
223 }
224 
225 fn clear-screen-var _self-ah: (addr handle cell) {
226   var self-ah/eax: (addr handle cell) <- copy _self-ah
227   var self/eax: (addr cell) <- lookup *self-ah
228   compare self, 0
229   {
230     break-if-!=
231     return
232   }
233   var screen-ah/eax: (addr handle screen) <- get self, screen-data
234   var screen/eax: (addr screen) <- lookup *screen-ah
235   clear-screen screen
236 }
237 
238 fn allocate-keyboard _out: (addr handle cell) {
239   var out/eax: (addr handle cell) <- copy _out
240   allocate out
241   var out-addr/eax: (addr cell) <- lookup *out
242   var type/ecx: (addr int) <- get out-addr, type
243   copy-to *type, 6/keyboard
244 }
245 
246 fn new-fake-keyboard _out: (addr handle cell), capacity: int {
247   var out/eax: (addr handle cell) <- copy _out
248   allocate-keyboard out
249   var out-addr/eax: (addr cell) <- lookup *out
250   var dest-ah/eax: (addr handle gap-buffer) <- get out-addr, keyboard-data
251   allocate dest-ah
252   var dest-addr/eax: (addr gap-buffer) <- lookup *dest-ah
253   initialize-gap-buffer dest-addr, capacity
254 }
255 
256 fn keyboard? _x: (addr cell) -> _/eax: boolean {
257   var x/esi: (addr cell) <- copy _x
258   var type/eax: (addr int) <- get x, type
259   compare *type, 6/keyboard
260   {
261     break-if-=
262     return 0/false
263   }
264   return 1/true
265 }
266 
267 fn rewind-keyboard-var _self-ah: (addr handle cell) {
268   var self-ah/eax: (addr handle cell) <- copy _self-ah
269   var self/eax: (addr cell) <- lookup *self-ah
270   compare self, 0
271   {
272     break-if-!=
273     return
274   }
275   var keyboard-ah/eax: (addr handle gap-buffer) <- get self, keyboard-data
276   var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
277   rewind-gap-buffer keyboard
278 }
279 
280 fn new-array _out: (addr handle cell), capacity: int {
281   var out/eax: (addr handle cell) <- copy _out
282   allocate out
283   var out-addr/eax: (addr cell) <- lookup *out
284   var type/ecx: (addr int) <- get out-addr, type
285   copy-to *type, 7/array
286   var dest-ah/eax: (addr handle array handle cell) <- get out-addr, array-data
287   populate dest-ah, capacity
288 }
289 
290 fn array? _x: (addr cell) -> _/eax: boolean {
291   var x/esi: (addr cell) <- copy _x
292   var type/eax: (addr int) <- get x, type
293   compare *type, 7/array
294   {
295     break-if-=
296     return 0/false
297   }
298   return 1/true
299 }
300 
301 fn new-image _out-ah: (addr handle cell), in: (addr stream byte) {
302   rewind-stream in
303   var out-ah/eax: (addr handle cell) <- copy _out-ah
304   allocate out-ah
305   var out/eax: (addr cell) <- lookup *out-ah
306   var type/ecx: (addr int) <- get out, type
307   copy-to *type, 8/image
308   var dest-ah/eax: (addr handle image) <- get out, image-data
309   allocate dest-ah
310   var dest/eax: (addr image) <- lookup *dest-ah
311   initialize-image dest, in
312 }
313 
314 fn image? _x: (addr cell) -> _/eax: boolean {
315   var x/esi: (addr cell) <- copy _x
316   var type/eax: (addr int) <- get x, type
317   compare *type, 8/image
318   {
319     break-if-=
320     return 0/false
321   }
322   return 1/true
323 }