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-immutable 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   var _required-space/eax: int <- stream-size data
183   var required-space/ecx: int <- copy _required-space
184   required-space <- add 2  # for []
185   var available-space/eax: int <- space-remaining-in-stream out
186   compare required-space, available-space
187   {
188     break-if-<=
189     var dummy/eax: boolean <- try-write out, "..."
190     error trace, "print-stream: no space"
191     return
192   }
193   write out, "["
194   write-stream-immutable out, data
195   write out, "]"
196   # trace
197   var should-trace?/eax: boolean <- should-trace? trace
198   compare should-trace?, 0/false
199   break-if-=
200   rewind-stream data
201   var stream-storage: (stream byte 0x40)
202   var stream/ecx: (addr stream byte) <- address stream-storage
203   write stream, "=> stream "
204   write-stream-immutable stream, data
205   trace trace, "print", stream
206 }
207 
208 fn print-number _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
209   var available-space/eax: int <- space-remaining-in-stream out
210   compare available-space, 0x10
211   {
212     break-if->=
213     var dummy/eax: boolean <- try-write out, "..."
214     error trace, "print-number: no space"
215     return
216   }
217   var in/esi: (addr cell) <- copy _in
218   var val/eax: (addr float) <- get in, number-data
219   write-float-decimal-approximate out, *val, 0x10/precision
220   # trace
221   {
222     var should-trace?/eax: boolean <- should-trace? trace
223     compare should-trace?, 0/false
224     break-if-!=
225     return
226   }
227   var stream-storage: (stream byte 0x40)
228   var stream/ecx: (addr stream byte) <- address stream-storage
229   write stream, "=> number "
230   write-float-decimal-approximate stream, *val, 0x10/precision
231   trace trace, "print", stream
232 }
233 
234 fn print-pair _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
235   # if in starts with a quote, print the quote outside the expression
236   var in/esi: (addr cell) <- copy _in
237   var left-ah/eax: (addr handle cell) <- get in, left
238   var _left/eax: (addr cell) <- lookup *left-ah
239   var left/ecx: (addr cell) <- copy _left
240   var is-quote?/eax: boolean <- symbol-equal? left, "'"
241   compare is-quote?, 0/false
242   {
243     break-if-=
244     var dummy/eax: boolean <- try-write out, "'"
245     var right-ah/eax: (addr handle cell) <- get in, right
246     print-cell right-ah, out, trace
247     return
248   }
249   var is-backquote?/eax: boolean <- symbol-equal? left, "`"
250   compare is-backquote?, 0/false
251   {
252     break-if-=
253     var dummy/eax: boolean <- try-write out, "`"
254     var right-ah/eax: (addr handle cell) <- get in, right
255     print-cell right-ah, out, trace
256     return
257   }
258   var is-unquote?/eax: boolean <- symbol-equal? left, ","
259   compare is-unquote?, 0/false
260   {
261     break-if-=
262     var dummy/eax: boolean <- try-write out, ","
263     var right-ah/eax: (addr handle cell) <- get in, right
264     print-cell right-ah, out, trace
265     return
266   }
267   var is-unquote-splice?/eax: boolean <- symbol-equal? left, ",@"
268   compare is-unquote-splice?, 0/false
269   {
270     break-if-=
271     var dummy/eax: boolean <- try-write out, ",@"
272     var right-ah/eax: (addr handle cell) <- get in, right
273     print-cell right-ah, out, trace
274     return
275   }
276   #
277   var curr/esi: (addr cell) <- copy _in
278   {
279     var overflow?/eax: boolean <- try-write out, "("
280     compare overflow?, 0/false
281     break-if-=
282     error trace, "print-pair: no space for '('"
283     return
284   }
285   $print-pair:loop: {
286     var left/ecx: (addr handle cell) <- get curr, left
287     print-cell left, out, trace
288     # errors? skip
289     {
290       var error?/eax: boolean <- has-errors? trace
291       compare error?, 0/false
292       break-if-=
293       return
294     }
295     var right/ecx: (addr handle cell) <- get curr, right
296     var right-addr/eax: (addr cell) <- lookup *right
297     {
298       compare right-addr, 0
299       break-if-!=
300       {
301         var overflow?/eax: boolean <- try-write out, " ... NULL"
302         compare overflow?, 0/false
303         break-if-=
304         error trace, "print-pair: no space for ' ... NULL'"
305         return
306       }
307       return
308     }
309     {
310       var right-nil?/eax: boolean <- nil? right-addr
311       compare right-nil?, 0/false
312       {
313         break-if-=
314         trace-text trace, "print", "right is nil"
315         break $print-pair:loop
316       }
317     }
318     {
319       var overflow?/eax: boolean <- try-write out, " "
320       compare overflow?, 0/false
321       break-if-=
322       error trace, "print-pair: no space"
323       return
324     }
325     var right-type-addr/edx: (addr int) <- get right-addr, type
326     {
327       compare *right-type-addr, 0/pair
328       break-if-=
329       {
330         var overflow?/eax: boolean <- try-write out, ". "
331         compare overflow?, 0/false
332         break-if-=
333         error trace, "print-pair: no space"
334         return
335       }
336       print-cell right, out, trace
337       break $print-pair:loop
338     }
339     curr <- copy right-addr
340     loop
341   }
342   {
343     var overflow?/eax: boolean <- try-write out, ")"
344     compare overflow?, 0/false
345     break-if-=
346     error trace, "print-pair: no space for ')'"
347     return
348   }
349 }
350 
351 # Most lisps intern nil, but we don't really have globals yet, so we'll be
352 # less efficient for now.
353 fn nil? _in: (addr cell) -> _/eax: boolean {
354   var in/esi: (addr cell) <- copy _in
355   # if type != pair, return false
356   var type/eax: (addr int) <- get in, type
357   compare *type, 0/pair
358   {
359     break-if-=
360     return 0/false
361   }
362   # if left != null, return false
363   var left-ah/eax: (addr handle cell) <- get in, left
364   var left/eax: (addr cell) <- lookup *left-ah
365   compare left, 0
366   {
367     break-if-=
368     return 0/false
369   }
370   # if right != null, return false
371   var right-ah/eax: (addr handle cell) <- get in, right
372   var right/eax: (addr cell) <- lookup *right-ah
373   compare right, 0
374   {
375     break-if-=
376     return 0/false
377   }
378   return 1/true
379 }
380 
381 fn test-print-cell-zero {
382   var num-storage: (handle cell)
383   var num/esi: (addr handle cell) <- address num-storage
384   new-integer num, 0
385   var out-storage: (stream byte 0x40)
386   var out/edi: (addr stream byte) <- address out-storage
387   var trace-storage: trace
388   var trace/edx: (addr trace) <- address trace-storage
389   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
390   print-cell num, out, trace
391   check-stream-equal out, "0", "F - test-print-cell-zero"
392 }
393 
394 fn test-print-cell-integer {
395   var num-storage: (handle cell)
396   var num/esi: (addr handle cell) <- address num-storage
397   new-integer num, 1
398   var out-storage: (stream byte 0x40)
399   var out/edi: (addr stream byte) <- address out-storage
400   var trace-storage: trace
401   var trace/edx: (addr trace) <- address trace-storage
402   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
403   print-cell num, out, trace
404   check-stream-equal out, "1", "F - test-print-cell-integer"
405 }
406 
407 fn test-print-cell-integer-2 {
408   var num-storage: (handle cell)
409   var num/esi: (addr handle cell) <- address num-storage
410   new-integer num, 0x30
411   var out-storage: (stream byte 0x40)
412   var out/edi: (addr stream byte) <- address out-storage
413   var trace-storage: trace
414   var trace/edx: (addr trace) <- address trace-storage
415   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
416   print-cell num, out, trace
417   check-stream-equal out, "48", "F - test-print-cell-integer-2"
418 }
419 
420 fn test-print-cell-fraction {
421   var num-storage: (handle cell)
422   var num/esi: (addr handle cell) <- address num-storage
423   var val/xmm0: float <- rational 1, 2
424   new-float num, val
425   var out-storage: (stream byte 0x40)
426   var out/edi: (addr stream byte) <- address out-storage
427   var trace-storage: trace
428   var trace/edx: (addr trace) <- address trace-storage
429   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
430   print-cell num, out, trace
431   check-stream-equal out, "0.5", "F - test-print-cell-fraction"
432 }
433 
434 fn test-print-cell-symbol {
435   var sym-storage: (handle cell)
436   var sym/esi: (addr handle cell) <- address sym-storage
437   new-symbol sym, "abc"
438   var out-storage: (stream byte 0x40)
439   var out/edi: (addr stream byte) <- address out-storage
440   var trace-storage: trace
441   var trace/edx: (addr trace) <- address trace-storage
442   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
443   print-cell sym, out, trace
444   check-stream-equal out, "abc", "F - test-print-cell-symbol"
445 }
446 
447 fn test-print-cell-nil-list {
448   var nil-storage: (handle cell)
449   var nil/esi: (addr handle cell) <- address nil-storage
450   allocate-pair nil
451   var out-storage: (stream byte 0x40)
452   var out/edi: (addr stream byte) <- address out-storage
453   var trace-storage: trace
454   var trace/edx: (addr trace) <- address trace-storage
455   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
456   print-cell nil, out, trace
457   check-stream-equal out, "()", "F - test-print-cell-nil-list"
458 }
459 
460 fn test-print-cell-singleton-list {
461   # list
462   var left-storage: (handle cell)
463   var left/ecx: (addr handle cell) <- address left-storage
464   new-symbol left, "abc"
465   var nil-storage: (handle cell)
466   var nil/edx: (addr handle cell) <- address nil-storage
467   allocate-pair nil
468   var list-storage: (handle cell)
469   var list/esi: (addr handle cell) <- address list-storage
470   new-pair list, *left, *nil
471   #
472   var out-storage: (stream byte 0x40)
473   var out/edi: (addr stream byte) <- address out-storage
474   var trace-storage: trace
475   var trace/edx: (addr trace) <- address trace-storage
476   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
477   print-cell list, out, trace
478   check-stream-equal out, "(abc)", "F - test-print-cell-singleton-list"
479 }
480 
481 fn test-print-cell-list {
482   # list = cons "abc", nil
483   var left-storage: (handle cell)
484   var left/ecx: (addr handle cell) <- address left-storage
485   new-symbol left, "abc"
486   var nil-storage: (handle cell)
487   var nil/edx: (addr handle cell) <- address nil-storage
488   allocate-pair nil
489   var list-storage: (handle cell)
490   var list/esi: (addr handle cell) <- address list-storage
491   new-pair list, *left, *nil
492   # list = cons 64, list
493   new-integer left, 0x40
494   new-pair list, *left, *list
495   #
496   var out-storage: (stream byte 0x40)
497   var out/edi: (addr stream byte) <- address out-storage
498   var trace-storage: trace
499   var trace/edx: (addr trace) <- address trace-storage
500   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
501   print-cell list, out, trace
502   check-stream-equal out, "(64 abc)", "F - test-print-cell-list"
503 }
504 
505 fn test-print-cell-list-of-nil {
506   # list = cons "abc", nil
507   var left-storage: (handle cell)
508   var left/ecx: (addr handle cell) <- address left-storage
509   allocate-pair left
510   var nil-storage: (handle cell)
511   var nil/edx: (addr handle cell) <- address nil-storage
512   allocate-pair nil
513   var list-storage: (handle cell)
514   var list/esi: (addr handle cell) <- address list-storage
515   new-pair list, *left, *nil
516   # list = cons 64, list
517   new-integer left, 0x40
518   new-pair list, *left, *list
519   #
520   var out-storage: (stream byte 0x40)
521   var out/edi: (addr stream byte) <- address out-storage
522   var trace-storage: trace
523   var trace/edx: (addr trace) <- address trace-storage
524   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
525   print-cell list, out, trace
526   check-stream-equal out, "(64 ())", "F - test-print-cell-list-nil"
527 }
528 
529 fn test-print-dotted-list {
530   # list = cons 64, "abc"
531   var left-storage: (handle cell)
532   var left/ecx: (addr handle cell) <- address left-storage
533   new-symbol left, "abc"
534   var right-storage: (handle cell)
535   var right/edx: (addr handle cell) <- address right-storage
536   new-integer right, 0x40
537   var list-storage: (handle cell)
538   var list/esi: (addr handle cell) <- address list-storage
539   new-pair list, *left, *right
540   #
541   var out-storage: (stream byte 0x40)
542   var out/edi: (addr stream byte) <- address out-storage
543   var trace-storage: trace
544   var trace/edx: (addr trace) <- address trace-storage
545   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
546   print-cell list, out, trace
547   check-stream-equal out, "(abc . 64)", "F - test-print-dotted-list"
548 }
549 
550 fn test-print-cell-interrupted {
551   var sym-storage: (handle cell)
552   var sym/esi: (addr handle cell) <- address sym-storage
553   new-symbol sym, "abcd"  # requires 4 bytes
554   var out-storage: (stream byte 3)  # space for just 3 bytes
555   var out/edi: (addr stream byte) <- address out-storage
556   var trace-storage: trace
557   var trace/edx: (addr trace) <- address trace-storage
558   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
559   print-cell sym, out, trace
560   # insufficient space to print out the symbol; print out ellipses if we can
561   check-stream-equal out, "...", "F - test-print-cell-interrupted"
562 }
563 
564 fn test-print-cell-impossible {
565   var sym-storage: (handle cell)
566   var sym/esi: (addr handle cell) <- address sym-storage
567   new-symbol sym, "abcd"  # requires 4 bytes
568   var out-storage: (stream byte 2)
569   var out/edi: (addr stream byte) <- address out-storage
570   var trace-storage: trace
571   var trace/edx: (addr trace) <- address trace-storage
572   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
573   print-cell sym, out, trace
574   # insufficient space even for ellipses; print nothing
575   check-stream-equal out, "", "F - test-print-cell-impossible"
576 }
577 
578 fn test-print-cell-interrupted-list {
579   # list = (abcd) requires 6 bytes
580   var left-storage: (handle cell)
581   var left/ecx: (addr handle cell) <- address left-storage
582   new-symbol left, "abcd"
583   var nil-storage: (handle cell)
584   var nil/edx: (addr handle cell) <- address nil-storage
585   allocate-pair nil
586   var list-storage: (handle cell)
587   var list/esi: (addr handle cell) <- address list-storage
588   new-pair list, *left, *nil
589   #
590   var out-storage: (stream byte 4)  # space for just 4 bytes
591   var out/edi: (addr stream byte) <- address out-storage
592   var trace-storage: trace
593   var trace/edx: (addr trace) <- address trace-storage
594   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
595   print-cell list, out, trace
596   check-stream-equal out, "(...", "F - test-print-cell-interrupted-list"
597 }