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