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), 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 }