1 fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr trace) {
  2   check-stack
  3   trace-text trace, "print", "print"
  4   trace-lower trace
  5   var in/eax: (addr handle cell) <- copy _in
  6   var in-addr/eax: (addr cell) <- lookup *in
  7   {
  8     compare in-addr, 0
  9     break-if-!=
 10     write out, "NULL"
 11     trace-higher trace
 12     return
 13   }
 14   {
 15     var nil?/eax: boolean <- nil? in-addr
 16     compare nil?, 0/false
 17     break-if-=
 18     write out, "()"
 19     trace-higher trace
 20     return
 21   }
 22   var in-type/ecx: (addr int) <- get in-addr, type
 23   compare *in-type, 0/pair
 24   {
 25     break-if-!=
 26     print-pair in-addr, out, trace
 27     trace-higher trace
 28     return
 29   }
 30   compare *in-type, 1/number
 31   {
 32     break-if-!=
 33     print-number in-addr, out, trace
 34     trace-higher trace
 35     return
 36   }
 37   compare *in-type, 2/symbol
 38   {
 39     break-if-!=
 40     print-symbol in-addr, out, trace
 41     trace-higher trace
 42     return
 43   }
 44   compare *in-type, 3/stream
 45   {
 46     break-if-!=
 47     print-stream in-addr, out, trace
 48     trace-higher trace
 49     return
 50   }
 51   compare *in-type, 4/primitive
 52   {
 53     break-if-!=
 54     write out, "[primitive]"
 55     trace-higher trace
 56     return
 57   }
 58   compare *in-type, 5/screen
 59   {
 60     break-if-!=
 61     write out, "[screen "
 62     var screen-ah/eax: (addr handle screen) <- get in-addr, screen-data
 63     var screen/eax: (addr screen) <- lookup *screen-ah
 64     var screen-addr/eax: int <- copy screen
 65     write-int32-hex out, screen-addr
 66     write out, "]"
 67     trace-higher trace
 68     return
 69   }
 70   compare *in-type, 6/keyboard
 71   {
 72     break-if-!=
 73     write out, "[keyboard "
 74     var keyboard-ah/eax: (addr handle gap-buffer) <- get in-addr, keyboard-data
 75     var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
 76     var keyboard-addr/eax: int <- copy keyboard
 77     write-int32-hex out, keyboard-addr
 78     write out, "]"
 79     trace-higher trace
 80     return
 81   }
 82 }
 83 
 84 # debug helper
 85 fn dump-cell-at-top-right in-ah: (addr handle cell) {
 86   var stream-storage: (stream byte 0x1000)
 87   var stream/edx: (addr stream byte) <- address stream-storage
 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, 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
 99 }
100 
101 fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
102   trace-text trace, "print", "symbol"
103   var in/esi: (addr cell) <- copy _in
104   var data-ah/eax: (addr handle stream byte) <- get in, text-data
105   var _data/eax: (addr stream byte) <- lookup *data-ah
106   var data/esi: (addr stream byte) <- copy _data
107   rewind-stream data
108   write-stream out, data
109   # trace
110   compare trace, 0
111   break-if-=
112   rewind-stream data
113   var stream-storage: (stream byte 0x40)
114   var stream/ecx: (addr stream byte) <- address stream-storage
115   write stream, "=> symbol "
116   write-stream stream, data
117   trace trace, "print", stream
118 }
119 
120 fn print-stream _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
121   trace-text trace, "print", "stream"
122   var in/esi: (addr cell) <- copy _in
123   var data-ah/eax: (addr handle stream byte) <- get in, text-data
124   var _data/eax: (addr stream byte) <- lookup *data-ah
125   var data/esi: (addr stream byte) <- copy _data
126   rewind-stream data
127   write out, "["
128   write-stream out, data
129   write out, "]"
130   # trace
131   compare trace, 0
132   break-if-=
133   rewind-stream data
134   var stream-storage: (stream byte 0x40)
135   var stream/ecx: (addr stream byte) <- address stream-storage
136   write stream, "=> stream "
137   write-stream stream, data
138   trace trace, "print", stream
139 }
140 
141 fn print-number _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
142   var in/esi: (addr cell) <- copy _in
143   var val/eax: (addr float) <- get in, number-data
144   write-float-decimal-approximate out, *val, 3/precision
145   # trace
146   compare trace, 0
147   break-if-=
148   var stream-storage: (stream byte 0x40)
149   var stream/ecx: (addr stream byte) <- address stream-storage
150   write stream, "=> number "
151   write-float-decimal-approximate stream, *val, 3/precision
152   trace trace, "print", stream
153 }
154 
155 fn print-pair _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
156   # if in starts with a quote, print the quote outside the expression
157   var in/esi: (addr cell) <- copy _in
158   var left-ah/eax: (addr handle cell) <- get in, left
159   var _left/eax: (addr cell) <- lookup *left-ah
160   var left/ecx: (addr cell) <- copy _left
161   var is-quote?/eax: boolean <- symbol-equal? left, "'"
162   compare is-quote?, 0/false
163   {
164     break-if-=
165     write out, "'"
166     var right-ah/eax: (addr handle cell) <- get in, right
167     print-cell right-ah, out, trace
168     return
169   }
170   var is-backquote?/eax: boolean <- symbol-equal? left, "`"
171   compare is-backquote?, 0/false
172   {
173     break-if-=
174     write out, "`"
175     var right-ah/eax: (addr handle cell) <- get in, right
176     print-cell right-ah, out, trace
177     return
178   }
179   var is-unquote?/eax: boolean <- symbol-equal? left, ","
180   compare is-unquote?, 0/false
181   {
182     break-if-=
183     write out, ","
184     var right-ah/eax: (addr handle cell) <- get in, right
185     print-cell right-ah, out, trace
186     return
187   }
188   var is-unquote-splice?/eax: boolean <- symbol-equal? left, ",@"
189   compare is-unquote-splice?, 0/false
190   {
191     break-if-=
192     write out, ",@"
193     var right-ah/eax: (addr handle cell) <- get in, right
194     print-cell right-ah, out, trace
195     return
196   }
197   #
198   var curr/esi: (addr cell) <- copy _in
199   write out, "("
200   $print-pair:loop: {
201     var left/ecx: (addr handle cell) <- get curr, left
202     print-cell left, out, trace
203     var right/ecx: (addr handle cell) <- get curr, right
204     var right-addr/eax: (addr cell) <- lookup *right
205     {
206       compare right-addr, 0
207       break-if-!=
208       abort "null encountered"
209     }
210     {
211       var right-nil?/eax: boolean <- nil? right-addr
212       compare right-nil?, 0/false
213       {
214         break-if-=
215         trace-text trace, "print", "right is nil"
216         break $print-pair:loop
217       }
218     }
219     write out, " "
220     var right-type-addr/edx: (addr int) <- get right-addr, type
221     {
222       compare *right-type-addr, 0/pair
223       break-if-=
224       write out, ". "
225       print-cell right, out, trace
226       break $print-pair:loop
227     }
228     curr <- copy right-addr
229     loop
230   }
231   write out, ")"
232 }
233 
234 # Most lisps intern nil, but we don't really have globals yet, so we'll be
235 # less efficient for now.
236 fn nil? _in: (addr cell) -> _/eax: boolean {
237   var in/esi: (addr cell) <- copy _in
238   # if type != pair, return false
239   var type/eax: (addr int) <- get in, type
240   compare *type, 0/pair
241   {
242     break-if-=
243     return 0/false
244   }
245   # if left != null, return false
246   var left-ah/eax: (addr handle cell) <- get in, left
247   var left/eax: (addr cell) <- lookup *left-ah
248   compare left, 0
249   {
250     break-if-=
251     return 0/false
252   }
253   # if right != null, return false
254   var right-ah/eax: (addr handle cell) <- get in, right
255   var right/eax: (addr cell) <- lookup *right-ah
256   compare right, 0
257   {
258     break-if-=
259     return 0/false
260   }
261   return 1/true
262 }
263 
264 fn test-print-cell-zero {
265   var num-storage: (handle cell)
266   var num/esi: (addr handle cell) <- address num-storage
267   new-integer num, 0
268   var out-storage: (stream byte 0x40)
269   var out/edi: (addr stream byte) <- address out-storage
270   print-cell num, out, 0/no-trace
271   check-stream-equal out, "0", "F - test-print-cell-zero"
272 }
273 
274 fn test-print-cell-integer {
275   var num-storage: (handle cell)
276   var num/esi: (addr handle cell) <- address num-storage
277   new-integer num, 1
278   var out-storage: (stream byte 0x40)
279   var out/edi: (addr stream byte) <- address out-storage
280   print-cell num, out, 0/no-trace
281   check-stream-equal out, "1", "F - test-print-cell-integer"
282 }
283 
284 fn test-print-cell-integer-2 {
285   var num-storage: (handle cell)
286   var num/esi: (addr handle cell) <- address num-storage
287   new-integer num, 0x30
288   var out-storage: (stream byte 0x40)
289   var out/edi: (addr stream byte) <- address out-storage
290   print-cell num, out, 0/no-trace
291   check-stream-equal out, "48", "F - test-print-cell-integer-2"
292 }
293 
294 fn test-print-cell-fraction {
295   var num-storage: (handle cell)
296   var num/esi: (addr handle cell) <- address num-storage
297   var val/xmm0: float <- rational 1, 2
298   new-float num, val
299   var out-storage: (stream byte 0x40)
300   var out/edi: (addr stream byte) <- address out-storage
301   print-cell num, out, 0/no-trace
302   check-stream-equal out, "0.5", "F - test-print-cell-fraction"
303 }
304 
305 fn test-print-cell-symbol {
306   var sym-storage: (handle cell)
307   var sym/esi: (addr handle cell) <- address sym-storage
308   new-symbol sym, "abc"
309   var out-storage: (stream byte 0x40)
310   var out/edi: (addr stream byte) <- address out-storage
311   print-cell sym, out, 0/no-trace
312   check-stream-equal out, "abc", "F - test-print-cell-symbol"
313 }
314 
315 fn test-print-cell-nil-list {
316   var nil-storage: (handle cell)
317   var nil/esi: (addr handle cell) <- address nil-storage
318   allocate-pair nil
319   var out-storage: (stream byte 0x40)
320   var out/edi: (addr stream byte) <- address out-storage
321   print-cell nil, out, 0/no-trace
322   check-stream-equal out, "()", "F - test-print-cell-nil-list"
323 }
324 
325 fn test-print-cell-singleton-list {
326   # list
327   var left-storage: (handle cell)
328   var left/ecx: (addr handle cell) <- address left-storage
329   new-symbol left, "abc"
330   var nil-storage: (handle cell)
331   var nil/edx: (addr handle cell) <- address nil-storage
332   allocate-pair nil
333   var list-storage: (handle cell)
334   var list/esi: (addr handle cell) <- address list-storage
335   new-pair list, *left, *nil
336   #
337   var out-storage: (stream byte 0x40)
338   var out/edi: (addr stream byte) <- address out-storage
339   print-cell list, out, 0/no-trace
340   check-stream-equal out, "(abc)", "F - test-print-cell-singleton-list"
341 }
342 
343 fn test-print-cell-list {
344   # list = cons "abc", nil
345   var left-storage: (handle cell)
346   var left/ecx: (addr handle cell) <- address left-storage
347   new-symbol left, "abc"
348   var nil-storage: (handle cell)
349   var nil/edx: (addr handle cell) <- address nil-storage
350   allocate-pair nil
351   var list-storage: (handle cell)
352   var list/esi: (addr handle cell) <- address list-storage
353   new-pair list, *left, *nil
354   # list = cons 64, list
355   new-integer left, 0x40
356   new-pair list, *left, *list
357   #
358   var out-storage: (stream byte 0x40)
359   var out/edi: (addr stream byte) <- address out-storage
360   print-cell list, out, 0/no-trace
361   check-stream-equal out, "(64 abc)", "F - test-print-cell-list"
362 }
363 
364 fn test-print-cell-list-of-nil {
365   # list = cons "abc", nil
366   var left-storage: (handle cell)
367   var left/ecx: (addr handle cell) <- address left-storage
368   allocate-pair left
369   var nil-storage: (handle cell)
370   var nil/edx: (addr handle cell) <- address nil-storage
371   allocate-pair nil
372   var list-storage: (handle cell)
373   var list/esi: (addr handle cell) <- address list-storage
374   new-pair list, *left, *nil
375   # list = cons 64, list
376   new-integer left, 0x40
377   new-pair list, *left, *list
378   #
379   var out-storage: (stream byte 0x40)
380   var out/edi: (addr stream byte) <- address out-storage
381   print-cell list, out, 0/no-trace
382   check-stream-equal out, "(64 ())", "F - test-print-cell-list-nil"
383 }
384 
385 fn test-print-dotted-list {
386   # list = cons 64, "abc"
387   var left-storage: (handle cell)
388   var left/ecx: (addr handle cell) <- address left-storage
389   new-symbol left, "abc"
390   var right-storage: (handle cell)
391   var right/edx: (addr handle cell) <- address right-storage
392   new-integer right, 0x40
393   var list-storage: (handle cell)
394   var list/esi: (addr handle cell) <- address list-storage
395   new-pair list, *left, *right
396   #
397   var out-storage: (stream byte 0x40)
398   var out/edi: (addr stream byte) <- address out-storage
399   print-cell list, out, 0/no-trace
400   check-stream-equal out, "(abc . 64)", "F - test-print-dotted-list"
401 }