1 # Scenario:
  2 #   print-cell can be used for printing into a trace
  3 #   traces can run out of space
  4 #   therefore, we need to gracefully handle insufficient space in 'out'
  5 #     if we're printing something 3 bytes or less, just make sure it doesn't crash
  6 #     if we're printing something longer than 3 bytes, try to fall back to ellipses (which are 3 bytes)
  7 fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr trace) {
  8   check-stack
  9   trace-text trace, "print", "print"
 10   trace-lower trace
 11   var in/eax: (addr handle cell) <- copy _in
 12   var in-addr/eax: (addr cell) <- lookup *in
 13   {
 14     compare in-addr, 0
 15     break-if-!=
 16     var overflow?/eax: boolean <- try-write out, "NULL"
 17     compare overflow?, 0/false
 18     {
 19       break-if-=
 20       overflow? <- try-write out, "..."
 21       error trace, "print-cell: no space for 'NULL'"
 22     }
 23     trace-higher trace
 24     return
 25   }
 26   {
 27     var nil?/eax: boolean <- nil? in-addr
 28     compare nil?, 0/false
 29     break-if-=
 30     var overflow?/eax: boolean <- try-write out, "()"
 31     compare overflow?, 0/false
 32     {
 33       break-if-=
 34       error trace, "print-cell: no space for '()'"
 35     }
 36     trace-higher trace
 37     return
 38   }
 39   var in-type/ecx: (addr int) <- get in-addr, type
 40   compare *in-type, 0/pair
 41   {
 42     break-if-!=
 43     print-pair in-addr, out, trace
 44     trace-higher trace
 45     return
 46   }
 47   compare *in-type, 1/number
 48   {
 49     break-if-!=
 50     print-number in-addr, out, trace
 51     trace-higher trace
 52     return
 53   }
 54   compare *in-type, 2/symbol
 55   {
 56     break-if-!=
 57     print-symbol in-addr, out, trace
 58     trace-higher trace
 59     return
 60   }
 61   compare *in-type, 3/stream
 62   {
 63     break-if-!=
 64     print-stream in-addr, out, trace
 65     trace-higher trace
 66     return
 67   }
 68   compare *in-type, 4/primitive
 69   {
 70     break-if-!=
 71     var overflow?/eax: boolean <- try-write out, "[primitive]"
 72     compare overflow?, 0/false
 73     {
 74       break-if-=
 75       overflow? <- try-write out, "..."
 76       error trace, "print-cell: no space for primitive"
 77     }
 78     trace-higher trace
 79     return
 80   }
 81   compare *in-type, 5/screen
 82   {
 83     break-if-!=
 84     {
 85       var available-space/eax: int <- space-remaining-in-stream out
 86       compare available-space, 0x10
 87       break-if->=
 88       var dummy/eax: boolean <- try-write out, "..."
 89       error trace, "print-cell: no space for screen"
 90       return
 91     }
 92     write out, "[screen "
 93     var screen-ah/eax: (addr handle screen) <- get in-addr, screen-data
 94     var screen/eax: (addr screen) <- lookup *screen-ah
 95     var screen-addr/eax: int <- copy screen
 96     write-int32-hex out, screen-addr
 97     write out, "]"
 98     trace-higher trace
 99     return
100   }
101   compare *in-type, 6/keyboard
102   {
103     break-if-!=
104     {
105       var available-space/eax: int <- space-remaining-in-stream out
106       compare available-space, 0x10
107       break-if->=
108       var dummy/eax: boolean <- try-write out, "..."
109       error trace, "print-cell: no space for keyboard"
110       return
111     }
112     write out, "[keyboard "
113     var keyboard-ah/eax: (addr handle gap-buffer) <- get in-addr, keyboard-data
114     var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
115     var keyboard-addr/eax: int <- copy keyboard
116     write-int32-hex out, keyboard-addr
117     write out, "]"
118     trace-higher trace
119     return
120   }
121 }
122 
123 # debug helper
124 fn dump-cell-at-top-right in-ah: (addr handle cell) {
125   var stream-storage: (stream byte 0x1000)
126   var stream/edx: (addr stream byte) <- address stream-storage
127   var trace-storage: trace
128   var trace/edi: (addr trace) <- address trace-storage
129   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
130   print-cell in-ah, stream, trace
131   var d1/eax: int <- copy 0
132   var d2/ecx: int <- copy 0
133   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
134 }
135 
136 fn dump-cell-from-cursor-over-full-screen in-ah: (addr handle cell), fg: int, bg: int {
137   var stream-storage: (stream byte 0x200)
138   var stream/edx: (addr stream byte) <- address stream-storage
139   var trace-storage: trace
140   var trace/edi: (addr trace) <- address trace-storage
141   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
142   print-cell in-ah, stream, trace
143   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, stream, fg, bg
144 }
145 
146 fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
147   trace-text trace, "print", "symbol"
148   var in/esi: (addr cell) <- copy _in
149   var data-ah/eax: (addr handle stream byte) <- get in, text-data
150   var _data/eax: (addr stream byte) <- lookup *data-ah
151   var data/esi: (addr stream byte) <- copy _data
152   rewind-stream data
153   var _required-space/eax: int <- stream-size data
154   var required-space/ecx: int <- copy _required-space
155   var available-space/eax: int <- space-remaining-in-stream out
156   compare required-space, available-space
157   {
158     break-if-<=
159     var dummy/eax: boolean <- try-write out, "..."
160     error trace, "print-symbol: no space"
161     return
162   }
163   write-stream out, data
164   # trace
165   var should-trace?/eax: boolean <- should-trace? trace
166   compare should-trace?, 0/false
167   break-if-=
168   rewind-stream data
169   var stream-storage: (stream byte 0x40)
170   var stream/ecx: (addr stream byte) <- address stream-storage
171   write stream, "=> symbol "
172   write-stream stream, data
173   trace trace, "print", stream
174 }
175 
176 fn print-stream _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
177   trace-text trace, "print", "stream"
178   var in/esi: (addr cell) <- copy _in
179   var data-ah/eax: (addr handle stream byte) <- get in, text-data
180   var _data/eax: (addr stream byte) <- lookup *data-ah
181   var data/esi: (addr stream byte) <- copy _data
182   rewind-stream data
183   var _required-space/eax: int <- stream-size data
184   var required-space/ecx: int <- copy _required-space
185   required-space <- add 2  # for []
186   var available-space/eax: int <- space-remaining-in-stream out
187   compare required-space, available-space
188   {
189     break-if-<=
190     var dummy/eax: boolean <- try-write out, "..."
191     error trace, "print-stream: no space"
192     return
193   }
194   write out, "["
195   write-stream out, data
196   write out, "]"
197   # trace
198   var should-trace?/eax: boolean <- should-trace? trace
199   compare should-trace?, 0/false
200   break-if-=
201   rewind-stream data
202   var stream-storage: (stream byte 0x40)
203   var stream/ecx: (addr stream byte) <- address stream-storage
204   write stream, "=> stream "
205   write-stream stream, data
206   trace trace, "print", stream
207 }
208 
209 fn print-number _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
210   var available-space/eax: int <- space-remaining-in-stream out
211   compare available-space, 0x10
212   {
213     break-if->=
214     var dummy/eax: boolean <- try-write out, "..."
215     error trace, "print-number: no space"
216     return
217   }
218   var in/esi: (addr cell) <- copy _in
219   var val/eax: (addr float) <- get in, number-data
220   write-float-decimal-approximate out, *val, 0x10/precision
221   # trace
222   {
223     var should-trace?/eax: boolean <- should-trace? trace
224     compare should-trace?, 0/false
225     break-if-!=
226     return
227   }
228   var stream-storage: (stream byte 0x40)
229   var stream/ecx: (addr stream byte) <- address stream-storage
230   write stream, "=> number "
231   write-float-decimal-approximate stream, *val, 0x10/precision
232   trace trace, "print", stream
233 }
234 
235 fn print-pair _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
236   # if in starts with a quote, print the quote outside the expression
237   var in/esi: (addr cell) <- copy _in
238   var left-ah/eax: (addr handle cell) <- get in, left
239   var _left/eax: (addr cell) <- lookup *left-ah
240   var left/ecx: (addr cell) <- copy _left
241   var is-quote?/eax: boolean <- symbol-equal? left, "'"
242   compare is-quote?, 0/false
243   {
244     break-if-=
245     var dummy/eax: boolean <- try-write out, "'"
246     var right-ah/eax: (addr handle cell) <- get in, right
247     print-cell right-ah, out, trace
248     return
249   }
250   var is-backquote?/eax: boolean <- symbol-equal? left, "`"
251   compare is-backquote?, 0/false
252   {
253     break-if-=
254     var dummy/eax: boolean <- try-write out, "`"
255     var right-ah/eax: (addr handle cell) <- get in, right
256     print-cell right-ah, out, trace
257     return
258   }
259   var is-unquote?/eax: boolean <- symbol-equal? left, ","
260   compare is-unquote?, 0/false
261   {
262     break-if-=
263     var dummy/eax: boolean <- try-write out, ","
264     var right-ah/eax: (addr handle cell) <- get in, right
265     print-cell right-ah, out, trace
266     return
267   }
268   var is-unquote-splice?/eax: boolean <- symbol-equal? left, ",@"
269   compare is-unquote-splice?, 0/false
270   {
271     break-if-=
272     var dummy/eax: boolean <- try-write out, ",@"
273     var right-ah/eax: (addr handle cell) <- get in, right
274     print-cell right-ah, out, trace
275     return
276   }
277   #
278   var curr/esi: (addr cell) <- copy _in
279   {
280     var overflow?/eax: boolean <- try-write out, "("
281     compare overflow?, 0/false
282     break-if-=
283     error trace, "print-pair: no space for '('"
284     return
285   }
286   $print-pair:loop: {
287     var left/ecx: (addr handle cell) <- get curr, left
288     print-cell left, out, trace
289     # errors? skip
290     {
291       var error?/eax: boolean <- has-errors? trace
292       compare error?, 0/false
293       break-if-=
294       return
295     }
296     var right/ecx: (addr handle cell) <- get curr, right
297     var right-addr/eax: (addr cell) <- lookup *right
298     {
299       compare right-addr, 0
300       break-if-!=
301       abort "NULL in print!"
302     }
303     {
304       var right-nil?/eax: boolean <- nil? right-addr
305       compare right-nil?, 0/false
306       {
307         break-if-=
308         trace-text trace, "print", "right is nil"
309         break $print-pair:loop
310       }
311     }
312     {
313       var overflow?/eax: boolean <- try-write out, " "
314       compare overflow?, 0/false
315       break-if-=
316       error trace, "print-pair: no space"
317       return
318     }
319     var right-type-addr/edx: (addr int) <- get right-addr, type
320     {
321       compare *right-type-addr, 0/pair
322       break-if-=
323       {
324         var overflow?/eax: boolean <- try-write out, ". "
325         compare overflow?, 0/false
326         break-if-=
327         error trace, "print-pair: no space"
328         return
329       }
330       print-cell right, out, trace
331       break $print-pair:loop
332     }
333     curr <- copy right-addr
334     loop
335   }
336   {
337     var overflow?/eax: boolean <- try-write out, ")"
338     compare overflow?, 0/false
339     break-if-=
340     error trace, "print-pair: no space for ')'"
341     return
342   }
343 }
344 
345 # Most lisps intern nil, but we don't really have globals yet, so we'll be
346 # less efficient for now.
347 fn nil? _in: (addr cell) -> _/eax: boolean {
348   var in/esi: (addr cell) <- copy _in
349   # if type != pair, return false
350   var type/eax: (addr int) <- get in, type
351   compare *type, 0/pair
352   {
353     break-if-=
354     return 0/false
355   }
356   # if left != null, return false
357   var left-ah/eax: (addr handle cell) <- get in, left
358   var left/eax: (addr cell) <- lookup *left-ah
359   compare left, 0
360   {
361     break-if-=
362     return 0/false
363   }
364   # if right != null, return false
365   var right-ah/eax: (addr handle cell) <- get in, right
366   var right/eax: (addr cell) <- lookup *right-ah
367   compare right, 0
368   {
369     break-if-=
370     return 0/false
371   }
372   return 1/true
373 }
374 
375 fn test-print-cell-zero {
376   var num-storage: (handle cell)
377   var num/esi: (addr handle cell) <- address num-storage
378   new-integer num, 0
379   var out-storage: (stream byte 0x40)
380   var out/edi: (addr stream byte) <- address out-storage
381   var trace-storage: trace
382   var trace/edx: (addr trace) <- address trace-storage
383   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
384   print-cell num, out, trace
385   check-stream-equal out, "0", "F - test-print-cell-zero"
386 }
387 
388 fn test-print-cell-integer {
389   var num-storage: (handle cell)
390   var num/esi: (addr handle cell) <- address num-storage
391   new-integer num, 1
392   var out-storage: (stream byte 0x40)
393   var out/edi: (addr stream byte) <- address out-storage
394   var trace-storage: trace
395   var trace/edx: (addr trace) <- address trace-storage
396   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
397   print-cell num, out, trace
398   check-stream-equal out, "1", "F - test-print-cell-integer"
399 }
400 
401 fn test-print-cell-integer-2 {
402   var num-storage: (handle cell)
403   var num/esi: (addr handle cell) <- address num-storage
404   new-integer num, 0x30
405   var out-storage: (stream byte 0x40)
406   var out/edi: (addr stream byte) <- address out-storage
407   var trace-storage: trace
408   var trace/edx: (addr trace) <- address trace-storage
409   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
410   print-cell num, out, trace
411   check-stream-equal out, "48", "F - test-print-cell-integer-2"
412 }
413 
414 fn test-print-cell-fraction {
415   var num-storage: (handle cell)
416   var num/esi: (addr handle cell) <- address num-storage
417   var val/xmm0: float <- rational 1, 2
418   new-float num, val
419   var out-storage: (stream byte 0x40)
420   var out/edi: (addr stream byte) <- address out-storage
421   var trace-storage: trace
422   var trace/edx: (addr trace) <- address trace-storage
423   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
424   print-cell num, out, trace
425   check-stream-equal out, "0.5", "F - test-print-cell-fraction"
426 }
427 
428 fn test-print-cell-symbol {
429   var sym-storage: (handle cell)
430   var sym/esi: (addr handle cell) <- address sym-storage
431   new-symbol sym, "abc"
432   var out-storage: (stream byte 0x40)
433   var out/edi: (addr stream byte) <- address out-storage
434   var trace-storage: trace
435   var trace/edx: (addr trace) <- address trace-storage
436   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
437   print-cell sym, out, trace
438   check-stream-equal out, "abc", "F - test-print-cell-symbol"
439 }
440 
441 fn test-print-cell-nil-list {
442   var nil-storage: (handle cell)
443   var nil/esi: (addr handle cell) <- address nil-storage
444   allocate-pair nil
445   var out-storage: (stream byte 0x40)
446   var out/edi: (addr stream byte) <- address out-storage
447   var trace-storage: trace
448   var trace/edx: (addr trace) <- address trace-storage
449   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
450   print-cell nil, out, trace
451   check-stream-equal out, "()", "F - test-print-cell-nil-list"
452 }
453 
454 fn test-print-cell-singleton-list {
455   # list
456   var left-storage: (handle cell)
457   var left/ecx: (addr handle cell) <- address left-storage
458   new-symbol left, "abc"
459   var nil-storage: (handle cell)
460   var nil/edx: (addr handle cell) <- address nil-storage
461   allocate-pair nil
462   var list-storage: (handle cell)
463   var list/esi: (addr handle cell) <- address list-storage
464   new-pair list, *left, *nil
465   #
466   var out-storage: (stream byte 0x40)
467   var out/edi: (addr stream byte) <- address out-storage
468   var trace-storage: trace
469   var trace/edx: (addr trace) <- address trace-storage
470   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
471   print-cell list, out, trace
472   check-stream-equal out, "(abc)", "F - test-print-cell-singleton-list"
473 }
474 
475 fn test-print-cell-list {
476   # list = cons "abc", nil
477   var left-storage: (handle cell)
478   var left/ecx: (addr handle cell) <- address left-storage
479   new-symbol left, "abc"
480   var nil-storage: (handle cell)
481   var nil/edx: (addr handle cell) <- address nil-storage
482   allocate-pair nil
483   var list-storage: (handle cell)
484   var list/esi: (addr handle cell) <- address list-storage
485   new-pair list, *left, *nil
486   # list = cons 64, list
487   new-integer left, 0x40
488   new-pair list, *left, *list
489   #
490   var out-storage: (stream byte 0x40)
491   var out/edi: (addr stream byte) <- address out-storage
492   var trace-storage: trace
493   var trace/edx: (addr trace) <- address trace-storage
494   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
495   print-cell list, out, trace
496   check-stream-equal out, "(64 abc)", "F - test-print-cell-list"
497 }
498 
499 fn test-print-cell-list-of-nil {
500   # list = cons "abc", nil
501   var left-storage: (handle cell)
502   var left/ecx: (addr handle cell) <- address left-storage
503   allocate-pair left
504   var nil-storage: (handle cell)
505   var nil/edx: (addr handle cell) <- address nil-storage
506   allocate-pair nil
507   var list-storage: (handle cell)
508   var list/esi: (addr handle cell) <- address list-storage
509   new-pair list, *left, *nil
510   # list = cons 64, list
511   new-integer left, 0x40
512   new-pair list, *left, *list
513   #
514   var out-storage: (stream byte 0x40)
515   var out/edi: (addr stream byte) <- address out-storage
516   var trace-storage: trace
517   var trace/edx: (addr trace) <- address trace-storage
518   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
519   print-cell list, out, trace
520   check-stream-equal out, "(64 ())", "F - test-print-cell-list-nil"
521 }
522 
523 fn test-print-dotted-list {
524   # list = cons 64, "abc"
525   var left-storage: (handle cell)
526   var left/ecx: (addr handle cell) <- address left-storage
527   new-symbol left, "abc"
528   var right-storage: (handle cell)
529   var right/edx: (addr handle cell) <- address right-storage
530   new-integer right, 0x40
531   var list-storage: (handle cell)
532   var list/esi: (addr handle cell) <- address list-storage
533   new-pair list, *left, *right
534   #
535   var out-storage: (stream byte 0x40)
536   var out/edi: (addr stream byte) <- address out-storage
537   var trace-storage: trace
538   var trace/edx: (addr trace) <- address trace-storage
539   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
540   print-cell list, out, trace
541   check-stream-equal out, "(abc . 64)", "F - test-print-dotted-list"
542 }
543 
544 fn test-print-cell-interrupted {
545   var sym-storage: (handle cell)
546   var sym/esi: (addr handle cell) <- address sym-storage
547   new-symbol sym, "abcd"  # requires 4 bytes
548   var out-storage: (stream byte 3)  # space for just 3 bytes
549   var out/edi: (addr stream byte) <- address out-storage
550   var trace-storage: trace
551   var trace/edx: (addr trace) <- address trace-storage
552   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
553   print-cell sym, out, trace
554   # insufficient space to print out the symbol; print out ellipses if we can
555   check-stream-equal out, "...", "F - test-print-cell-interrupted"
556 }
557 
558 fn test-print-cell-impossible {
559   var sym-storage: (handle cell)
560   var sym/esi: (addr handle cell) <- address sym-storage
561   new-symbol sym, "abcd"  # requires 4 bytes
562   var out-storage: (stream byte 2)
563   var out/edi: (addr stream byte) <- address out-storage
564   var trace-storage: trace
565   var trace/edx: (addr trace) <- address trace-storage
566   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
567   print-cell sym, out, trace
568   # insufficient space even for ellipses; print nothing
569   check-stream-equal out, "", "F - test-print-cell-impossible"
570 }
571 
572 fn test-print-cell-interrupted-list {
573   # list = (abcd) requires 6 bytes
574   var left-storage: (handle cell)
575   var left/ecx: (addr handle cell) <- address left-storage
576   new-symbol left, "abcd"
577   var nil-storage: (handle cell)
578   var nil/edx: (addr handle cell) <- address nil-storage
579   allocate-pair nil
580   var list-storage: (handle cell)
581   var list/esi: (addr handle cell) <- address list-storage
582   new-pair list, *left, *nil
583   #
584   var out-storage: (stream byte 4)  # space for just 4 bytes
585   var out/edi: (addr stream byte) <- address out-storage
586   var trace-storage: trace
587   var trace/edx: (addr trace) <- address trace-storage
588   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
589   print-cell list, out, trace
590   check-stream-equal out, "(...", "F - test-print-cell-interrupted-list"
591 }