# Mu - shell/print.mu

https://github.com/akkartik/mu/blob/main/shell/print.mu

      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) {
    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, 7/fg, 0/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, 3/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, 3/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 }