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 in-ah: (addr handle cell) {
 86   var stream-storage: (stream byte 0x40)
 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, 0/bg
 92 }
 93 
 94 fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
 95   trace-text trace, "print", "symbol"
 96   var in/esi: (addr cell) <- copy _in
 97   var data-ah/eax: (addr handle stream byte) <- get in, text-data
 98   var _data/eax: (addr stream byte) <- lookup *data-ah
 99   var data/esi: (addr stream byte) <- copy _data
100   rewind-stream data
101   write-stream out, data
102   # trace
103   compare trace, 0
104   break-if-=
105   rewind-stream data
106   var stream-storage: (stream byte 0x40)
107   var stream/ecx: (addr stream byte) <- address stream-storage
108   write stream, "=> symbol "
109   write-stream stream, data
110   trace trace, "print", stream
111 }
112 
113 fn print-stream _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
114   trace-text trace, "print", "stream"
115   var in/esi: (addr cell) <- copy _in
116   var data-ah/eax: (addr handle stream byte) <- get in, text-data
117   var _data/eax: (addr stream byte) <- lookup *data-ah
118   var data/esi: (addr stream byte) <- copy _data
119   rewind-stream data
120   write out, "["
121   write-stream out, data
122   write out, "]"
123   # trace
124   compare trace, 0
125   break-if-=
126   rewind-stream data
127   var stream-storage: (stream byte 0x40)
128   var stream/ecx: (addr stream byte) <- address stream-storage
129   write stream, "=> stream "
130   write-stream stream, data
131   trace trace, "print", stream
132 }
133 
134 fn print-number _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
135   var in/esi: (addr cell) <- copy _in
136   var val/eax: (addr float) <- get in, number-data
137   write-float-decimal-approximate out, *val, 3/precision
138   # trace
139   compare trace, 0
140   break-if-=
141   var stream-storage: (stream byte 0x40)
142   var stream/ecx: (addr stream byte) <- address stream-storage
143   write stream, "=> number "
144   write-float-decimal-approximate stream, *val, 3/precision
145   trace trace, "print", stream
146 }
147 
148 fn print-list _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
149   var curr/esi: (addr cell) <- copy _in
150   write out, "("
151   $print-list:loop: {
152     var left/ecx: (addr handle cell) <- get curr, left
153     print-cell left, out, trace
154     var right/ecx: (addr handle cell) <- get curr, right
155     var right-addr/eax: (addr cell) <- lookup *right
156     {
157       compare right-addr, 0
158       break-if-!=
159       abort "null encountered"
160     }
161     {
162       var right-nil?/eax: boolean <- nil? right-addr
163       compare right-nil?, 0/false
164       {
165         break-if-=
166         trace-text trace, "print", "right is nil"
167         break $print-list:loop
168       }
169     }
170     write out, " "
171     var right-type-addr/edx: (addr int) <- get right-addr, type
172     {
173       compare *right-type-addr, 0/pair
174       break-if-=
175       write out, ". "
176       print-cell right, out, trace
177       break $print-list:loop
178     }
179     curr <- copy right-addr
180     loop
181   }
182   write out, ")"
183 }
184 
185 # Most lisps intern nil, but we don't really have globals yet, so we'll be
186 # less efficient for now.
187 fn nil? _in: (addr cell) -> _/eax: boolean {
188   var in/esi: (addr cell) <- copy _in
189   # if type != pair, return false
190   var type/eax: (addr int) <- get in, type
191   compare *type, 0/pair
192   {
193     break-if-=
194     return 0/false
195   }
196   # if left != null, return false
197   var left-ah/eax: (addr handle cell) <- get in, left
198   var left/eax: (addr cell) <- lookup *left-ah
199   compare left, 0
200   {
201     break-if-=
202     return 0/false
203   }
204   # if right != null, return false
205   var right-ah/eax: (addr handle cell) <- get in, right
206   var right/eax: (addr cell) <- lookup *right-ah
207   compare right, 0
208   {
209     break-if-=
210     return 0/false
211   }
212   return 1/true
213 }
214 
215 fn test-print-cell-zero {
216   var num-storage: (handle cell)
217   var num/esi: (addr handle cell) <- address num-storage
218   new-integer num, 0
219   var out-storage: (stream byte 0x40)
220   var out/edi: (addr stream byte) <- address out-storage
221   print-cell num, out, 0/no-trace
222   check-stream-equal out, "0", "F - test-print-cell-zero"
223 }
224 
225 fn test-print-cell-integer {
226   var num-storage: (handle cell)
227   var num/esi: (addr handle cell) <- address num-storage
228   new-integer num, 1
229   var out-storage: (stream byte 0x40)
230   var out/edi: (addr stream byte) <- address out-storage
231   print-cell num, out, 0/no-trace
232   check-stream-equal out, "1", "F - test-print-cell-integer"
233 }
234 
235 fn test-print-cell-integer-2 {
236   var num-storage: (handle cell)
237   var num/esi: (addr handle cell) <- address num-storage
238   new-integer num, 0x30
239   var out-storage: (stream byte 0x40)
240   var out/edi: (addr stream byte) <- address out-storage
241   print-cell num, out, 0/no-trace
242   check-stream-equal out, "48", "F - test-print-cell-integer-2"
243 }
244 
245 fn test-print-cell-fraction {
246   var num-storage: (handle cell)
247   var num/esi: (addr handle cell) <- address num-storage
248   var val/xmm0: float <- rational 1, 2
249   new-float num, val
250   var out-storage: (stream byte 0x40)
251   var out/edi: (addr stream byte) <- address out-storage
252   print-cell num, out, 0/no-trace
253   check-stream-equal out, "0.5", "F - test-print-cell-fraction"
254 }
255 
256 fn test-print-cell-symbol {
257   var sym-storage: (handle cell)
258   var sym/esi: (addr handle cell) <- address sym-storage
259   new-symbol sym, "abc"
260   var out-storage: (stream byte 0x40)
261   var out/edi: (addr stream byte) <- address out-storage
262   print-cell sym, out, 0/no-trace
263   check-stream-equal out, "abc", "F - test-print-cell-symbol"
264 }
265 
266 fn test-print-cell-nil-list {
267   var nil-storage: (handle cell)
268   var nil/esi: (addr handle cell) <- address nil-storage
269   allocate-pair nil
270   var out-storage: (stream byte 0x40)
271   var out/edi: (addr stream byte) <- address out-storage
272   print-cell nil, out, 0/no-trace
273   check-stream-equal out, "()", "F - test-print-cell-nil-list"
274 }
275 
276 fn test-print-cell-singleton-list {
277   # list
278   var left-storage: (handle cell)
279   var left/ecx: (addr handle cell) <- address left-storage
280   new-symbol left, "abc"
281   var nil-storage: (handle cell)
282   var nil/edx: (addr handle cell) <- address nil-storage
283   allocate-pair nil
284   var list-storage: (handle cell)
285   var list/esi: (addr handle cell) <- address list-storage
286   new-pair list, *left, *nil
287   #
288   var out-storage: (stream byte 0x40)
289   var out/edi: (addr stream byte) <- address out-storage
290   print-cell list, out, 0/no-trace
291   check-stream-equal out, "(abc)", "F - test-print-cell-singleton-list"
292 }
293 
294 fn test-print-cell-list {
295   # list = cons "abc", nil
296   var left-storage: (handle cell)
297   var left/ecx: (addr handle cell) <- address left-storage
298   new-symbol left, "abc"
299   var nil-storage: (handle cell)
300   var nil/edx: (addr handle cell) <- address nil-storage
301   allocate-pair nil
302   var list-storage: (handle cell)
303   var list/esi: (addr handle cell) <- address list-storage
304   new-pair list, *left, *nil
305   # list = cons 64, list
306   new-integer left, 0x40
307   new-pair list, *left, *list
308   #
309   var out-storage: (stream byte 0x40)
310   var out/edi: (addr stream byte) <- address out-storage
311   print-cell list, out, 0/no-trace
312   check-stream-equal out, "(64 abc)", "F - test-print-cell-list"
313 }
314 
315 fn test-print-cell-list-of-nil {
316   # list = cons "abc", nil
317   var left-storage: (handle cell)
318   var left/ecx: (addr handle cell) <- address left-storage
319   allocate-pair left
320   var nil-storage: (handle cell)
321   var nil/edx: (addr handle cell) <- address nil-storage
322   allocate-pair nil
323   var list-storage: (handle cell)
324   var list/esi: (addr handle cell) <- address list-storage
325   new-pair list, *left, *nil
326   # list = cons 64, list
327   new-integer left, 0x40
328   new-pair list, *left, *list
329   #
330   var out-storage: (stream byte 0x40)
331   var out/edi: (addr stream byte) <- address out-storage
332   print-cell list, out, 0/no-trace
333   check-stream-equal out, "(64 ())", "F - test-print-cell-list-nil"
334 }
335 
336 fn test-print-dotted-list {
337   # list = cons 64, "abc"
338   var left-storage: (handle cell)
339   var left/ecx: (addr handle cell) <- address left-storage
340   new-symbol left, "abc"
341   var right-storage: (handle cell)
342   var right/edx: (addr handle cell) <- address right-storage
343   new-integer right, 0x40
344   var list-storage: (handle cell)
345   var list/esi: (addr handle cell) <- address list-storage
346   new-pair list, *left, *right
347   #
348   var out-storage: (stream byte 0x40)
349   var out/edi: (addr stream byte) <- address out-storage
350   print-cell list, out, 0/no-trace
351   check-stream-equal out, "(abc . 64)", "F - test-print-dotted-list"
352 }