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