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