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-list 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 0x200)
 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, 0xc5/bg=blue-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-list _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
156   var curr/esi: (addr cell) <- copy _in
157   write out, "("
158   $print-list:loop: {
159     var left/ecx: (addr handle cell) <- get curr, left
160     print-cell left, out, trace
161     var right/ecx: (addr handle cell) <- get curr, right
162     var right-addr/eax: (addr cell) <- lookup *right
163     {
164       compare right-addr, 0
165       break-if-!=
166       abort "null encountered"
167     }
168     {
169       var right-nil?/eax: boolean <- nil? right-addr
170       compare right-nil?, 0/false
171       {
172         break-if-=
173         trace-text trace, "print", "right is nil"
174         break $print-list:loop
175       }
176     }
177     write out, " "
178     var right-type-addr/edx: (addr int) <- get right-addr, type
179     {
180       compare *right-type-addr, 0/pair
181       break-if-=
182       write out, ". "
183       print-cell right, out, trace
184       break $print-list:loop
185     }
186     curr <- copy right-addr
187     loop
188   }
189   write out, ")"
190 }
191 
192 # Most lisps intern nil, but we don't really have globals yet, so we'll be
193 # less efficient for now.
194 fn nil? _in: (addr cell) -> _/eax: boolean {
195   var in/esi: (addr cell) <- copy _in
196   # if type != pair, return false
197   var type/eax: (addr int) <- get in, type
198   compare *type, 0/pair
199   {
200     break-if-=
201     return 0/false
202   }
203   # if left != null, return false
204   var left-ah/eax: (addr handle cell) <- get in, left
205   var left/eax: (addr cell) <- lookup *left-ah
206   compare left, 0
207   {
208     break-if-=
209     return 0/false
210   }
211   # if right != null, return false
212   var right-ah/eax: (addr handle cell) <- get in, right
213   var right/eax: (addr cell) <- lookup *right-ah
214   compare right, 0
215   {
216     break-if-=
217     return 0/false
218   }
219   return 1/true
220 }
221 
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
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
229   check-stream-equal out, "0", "F - test-print-cell-zero"
230 }
231 
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
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
239   check-stream-equal out, "1", "F - test-print-cell-integer"
240 }
241 
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
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
249   check-stream-equal out, "48", "F - test-print-cell-integer-2"
250 }
251 
252 fn test-print-cell-fraction {
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
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
260   check-stream-equal out, "0.5", "F - test-print-cell-fraction"
261 }
262 
263 fn test-print-cell-symbol {
264   var sym-storage: (handle cell)
265   var sym/esi: (addr handle cell) <- address sym-storage
266   new-symbol sym, "abc"
267   var out-storage: (stream byte 0x40)
268   var out/edi: (addr stream byte) <- address out-storage
269   print-cell sym, out, 0/no-trace
270   check-stream-equal out, "abc", "F - test-print-cell-symbol"
271 }
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
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
280   check-stream-equal out, "()", "F - test-print-cell-nil-list"
281 }
282 
283 fn test-print-cell-singleton-list {
284   # list
285   var left-storage: (handle cell)
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
291   var list-storage: (handle cell)
292   var list/esi: (addr handle cell) <- address list-storage
293   new-pair list, *left, *nil
294   #
295   var out-storage: (stream byte 0x40)
296   var out/edi: (addr stream byte) <- address out-storage
297   print-cell list, out, 0/no-trace
298   check-stream-equal out, "(abc)", "F - test-print-cell-singleton-list"
299 }
300 
301 fn test-print-cell-list {
302   # list = cons "abc", nil
303   var left-storage: (handle cell)
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
309   var list-storage: (handle cell)
310   var list/esi: (addr handle cell) <- address list-storage
311   new-pair list, *left, *nil
312   # list = cons 64, 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
318   print-cell list, out, 0/no-trace
319   check-stream-equal out, "(64 abc)", "F - test-print-cell-list"
320 }
321 
322 fn test-print-cell-list-of-nil {
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
327   var nil-storage: (handle cell)
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
333   # list = cons 64, 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
339   print-cell list, out, 0/no-trace
340   check-stream-equal out, "(64 ())", "F - test-print-cell-list-nil"
341 }
342 
343 fn test-print-dotted-list {
344   # list = cons 64, "abc"
345   var left-storage: (handle cell)
346   var left/ecx: (addr handle cell) <- address left-storage
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
351   var list-storage: (handle cell)
352   var list/esi: (addr handle cell) <- address list-storage
353   new-pair list, *left, *right
354   #
355   var out-storage: (stream byte 0x40)
356   var out/edi: (addr stream byte) <- address out-storage
357   print-cell list, out, 0/no-trace
358   check-stream-equal out, "(abc . 64)", "F - test-print-dotted-list"
359 }