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