lib/_io#.scm

   1 ;;;============================================================================
   2
   3 ;;; File: "_io#.scm", Time-stamp: <2009-11-24 19:11:32 feeley>
   4
   5 ;;; Copyright (c) 1994-2009 by Marc Feeley, All Rights Reserved.
   6
   7 ;;;============================================================================
   8
   9 ;;; Representation of exceptions.
  10
  11 (define-library-type-of-exception datum-parsing-exception
  12   id: 84660e37-9565-4abf-ac09-f9767f926d40
  13   constructor: #f
  14   opaque:
  15
  16   (kind       unprintable: read-only:)
  17   (readenv    unprintable: read-only:)
  18   (parameters unprintable: read-only:)
  19 )
  20
  21 (define-library-type-of-exception unterminated-process-exception
  22   id: b320dfbf-c714-4dc5-8bfa-cac5ee6c8421
  23   constructor: #f
  24   opaque:
  25
  26   unprintable:
  27   read-only:
  28
  29   procedure
  30   arguments
  31 )
  32
  33 (define-library-type-of-exception nonempty-input-port-character-buffer-exception
  34   id: 63b50ae7-375b-4b94-81df-3522686f5634
  35   constructor: #f
  36   opaque:
  37
  38   unprintable:
  39   read-only:
  40
  41   procedure
  42   arguments
  43 )
  44
  45 ;;;----------------------------------------------------------------------------
  46
  47 ;;; Define type checking macros.
  48
  49 (define-check-type string-or-ip-address 'string-or-ip-address
  50   macro-string-or-ip-address?)
  51
  52 (##define-macro (macro-string-or-ip-address? obj)
  53   `(##string-or-ip-address? ,obj))
  54
  55 ;;;----------------------------------------------------------------------------
  56
  57 ;;; Representation of ports.
  58
  59 ;; There are 5 kinds of ports, each providing a set of operations.  All
  60 ;; port objects have the capability of being both an input port and an
  61 ;; output port.  The "none-port" kind provides no operation and is
  62 ;; mainly for internal use to indicate that no input operation is
  63 ;; available or that no output operation is available.
  64 ;;
  65 ;; 1) An "object-port" (or simply a "port") provides operations to read
  66 ;;    and write Scheme data (i.e. any Scheme object) to/from the port.
  67 ;;    It also provides operations to get the name of the port, to force
  68 ;;    output to occur, and to close the port.  This kind of port need
  69 ;;    not be connected to a character based device or file (it could
  70 ;;    for example be a FIFO queue linking two threads that need to
  71 ;;    communicate Scheme objects).
  72 ;;
  73 ;; 2) A "character-port" provides all the operations of an "object-port",
  74 ;;    and also operations to read and write individual characters
  75 ;;    to/from the port.  When a Scheme object is written to a
  76 ;;    character-port, it is converted into the sequence of characters that
  77 ;;    corresponds to its "external-representation".  When reading a
  78 ;;    Scheme object, an inverse conversion occurs.
  79 ;;
  80 ;; 3) A "byte-port" provides all the operations of a "character-port", and
  81 ;;    also operations to read and write individual bytes to/from the
  82 ;;    port.  When a **character** is written to a byte-port, some
  83 ;;    encoding of that character into a sequence of bytes will occur
  84 ;;    (for example, #\newline might be encoded as the 2 bytes CR-LF
  85 ;;    when using ISO-8859-1 encoding, or a non-ASCII character will
  86 ;;    generate more than 1 byte when using UTF-8 encoding).  When
  87 ;;    reading a character, a similar decoding occurs.
  88 ;;
  89 ;; 4) A "device-port" provides all the operations of a "byte-port", and
  90 ;;    also operations to control the device (file, tty, etc) that is
  91 ;;    connected to the port, such as changing the tty settings.
  92
  93 (define-type port
  94   id: 2babe060-9af6-456f-a26e-40b592f690ec
  95   type-exhibitor: macro-type-port
  96   constructor: macro-make-port
  97   implementer: implement-type-port
  98   macros:
  99   prefix: macro-
 100   opaque:
 101   unprintable:
 102
 103   extender: define-type-of-port
 104
 105   mutex              ;; access to the port is controlled with this mutex
 106
 107   rkind              ;; port kind for reading (none-port if can't read)
 108   wkind              ;; port kind for writing (none-port if can't write)
 109
 110   name               ;; procedure which returns the name of the port
 111   read-datum         ;; procedure to read a datum
 112   write-datum        ;; procedure to write a datum
 113   newline            ;; procedure to write a datum separator
 114   force-output       ;; procedure to force output to occur on target device
 115   close              ;; procedure to close the port
 116   roptions           ;; options for reading (buffering type, encoding, etc)
 117   rtimeout           ;; time at which a read that would block times out
 118   rtimeout-thunk     ;; thunk called when a read timeout occurs
 119   set-rtimeout       ;; procedure to set rtimeout and rtimeout-thunk
 120   woptions           ;; options for writing (buffering type, encoding, etc)
 121   wtimeout           ;; time at which a write that would block times out
 122   wtimeout-thunk     ;; thunk called when a write timeout occurs
 123   set-wtimeout       ;; procedure to set wtimeout and wtimeout-thunk
 124 )
 125
 126 (define-check-type port (macro-type-port)
 127   macro-port?)
 128
 129 (##define-macro (macro-port-of-rkind? obj kind)
 130   `(let ((obj ,obj))
 131      (and (macro-port? obj)
 132           (##fixnum.= (##fixnum.bitwise-and (macro-port-rkind obj) ,kind)
 133                       ,kind))))
 134
 135 (##define-macro (macro-port-of-wkind? obj kind)
 136   `(let ((obj ,obj))
 137      (and (macro-port? obj)
 138           (##fixnum.= (##fixnum.bitwise-and (macro-port-wkind obj) ,kind)
 139                       ,kind))))
 140
 141 (##define-macro (macro-none-kind)      0) ;; allows nothing
 142 (##define-macro (macro-object-kind)    1) ;; can read and write objects
 143 (##define-macro (macro-character-kind) 3) ;; can also read and write chars
 144 (##define-macro (macro-byte-kind)      7) ;; can also read and write bytes
 145 (##define-macro (macro-device-kind)   15) ;; can also do device operations
 146
 147 (##define-macro (macro-file-kind)        (+ 15 16))
 148 (##define-macro (macro-process-kind)     (+ 15 32))
 149 (##define-macro (macro-tty-kind)         (+ 15 64))
 150 (##define-macro (macro-serial-kind)      (+ 15 128))
 151 (##define-macro (macro-tcp-client-kind)  (+ 15 256))
 152 (##define-macro (macro-tcp-server-kind)  (+ 1 512))
 153 (##define-macro (macro-directory-kind)   (+ 1 1024))
 154 (##define-macro (macro-event-queue-kind) (+ 1 2048))
 155 (##define-macro (macro-timer-kind)       (+ 1 4096))
 156 (##define-macro (macro-vector-kind)      (+ 1 8192))
 157 (##define-macro (macro-string-kind)      (+ 3 16384))
 158 (##define-macro (macro-u8vector-kind)    (+ 7 32768))
 159
 160 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 161
 162 ;;; Representation of object ports.
 163
 164 (define-check-type input-port 'input-port
 165   macro-input-port?)
 166 (define-check-type output-port 'output-port
 167   macro-output-port?)
 168
 169 (##define-macro (macro-input-port? obj)
 170   `(macro-port-of-rkind? ,obj (macro-object-kind)))
 171
 172 (##define-macro (macro-output-port? obj)
 173   `(macro-port-of-wkind? ,obj (macro-object-kind)))
 174
 175 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 176
 177 ;;; Representation of char ports.
 178
 179 (define-check-type character-input-port 'character-input-port
 180   macro-character-input-port?)
 181 (define-check-type character-output-port 'character-output-port
 182   macro-character-output-port?)
 183
 184 (define-type-of-port character-port
 185   id: 85099702-35ec-4cb8-ae55-13c4b9b05d10
 186   type-exhibitor: macro-type-character-port
 187   constructor: macro-make-character-port
 188   implementer: implement-type-character-port
 189   macros:
 190   prefix: macro-
 191   opaque:
 192   unprintable:
 193
 194   extender: define-type-of-character-port
 195
 196   rbuf               ;; character read buffer (a string)
 197   rlo                ;; low pointer (start of unread characters)
 198   rhi                ;; high pointer (end of unread characters)
 199   rchars             ;; number of characters read at start of read buffer
 200   rlines             ;; number of lines read up to low pointer
 201   rcurline           ;; absolute character position where current line starts
 202   rbuf-fill          ;; procedure to read characters into the read buffer
 203   peek-eof?          ;; peeking the next character should return end-of-file?
 204
 205   wbuf               ;; character write buffer (a string)
 206   wlo                ;; low pointer (start of unwritten characters)
 207   whi                ;; high pointer (end of unwritten characters)
 208   wchars             ;; number of characters written at start of write buffer
 209   wlines             ;; number of lines written up to high pointer
 210   wcurline           ;; absolute character position where current line starts
 211   wbuf-drain         ;; procedure to write characters from the write buffer
 212
 213   input-readtable    ;; readtable for reading
 214   output-readtable   ;; readtable for writing
 215   output-width       ;; procedure to get the output width in characters
 216 )
 217
 218 (##define-macro (macro-character-input-port? obj)
 219   `(macro-port-of-rkind? ,obj (macro-character-kind)))
 220
 221 (##define-macro (macro-character-output-port? obj)
 222   `(macro-port-of-wkind? ,obj (macro-character-kind)))
 223
 224 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 225
 226 ;;; Representation of byte ports.
 227
 228 (define-check-type byte-port 'byte-port
 229   macro-byte-port?)
 230 (define-check-type byte-input-port 'byte-input-port
 231   macro-byte-input-port?)
 232 (define-check-type byte-output-port 'byte-output-port
 233   macro-byte-output-port?)
 234
 235 (define-type-of-character-port byte-port
 236   id: 8a99028e-7b99-4468-b94e-728737ec1b1a
 237   type-exhibitor: macro-type-byte-port
 238   constructor: macro-make-byte-port
 239   implementer: implement-type-byte-port
 240   macros:
 241   prefix: macro-
 242   opaque:
 243   unprintable:
 244
 245   extender: define-type-of-byte-port
 246
 247   rbuf               ;; byte read buffer (a u8vector)
 248   rlo                ;; low pointer (start of unread bytes)
 249   rhi                ;; high pointer (end of unread bytes)
 250   rbuf-fill          ;; procedure to read bytes into the read buffer
 251
 252   wbuf               ;; byte write buffer (a u8vector)
 253   wlo                ;; low pointer (start of unwritten bytes)
 254   whi                ;; high pointer (end of unwritten bytes)
 255   wbuf-drain         ;; procedure to write bytes from the write buffer
 256 )
 257
 258 (##define-macro (macro-byte-port? obj)
 259   `(or (macro-byte-input-port? ,obj)
 260        (macro-byte-output-port? ,obj)))
 261
 262 (##define-macro (macro-byte-input-port? obj)
 263   `(macro-port-of-rkind? ,obj (macro-byte-kind)))
 264
 265 (##define-macro (macro-byte-output-port? obj)
 266   `(macro-port-of-wkind? ,obj (macro-byte-kind)))
 267
 268 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 269
 270 ;;; Representation of device ports.
 271
 272 (define-check-type device-input-port 'device-input-port
 273   macro-device-input-port?)
 274 (define-check-type device-output-port 'device-output-port
 275   macro-device-output-port?)
 276
 277 (define-type-of-byte-port device-port
 278   id: b4fa842f-5da6-43b6-b447-d0b0348ae962
 279   type-exhibitor: macro-type-device-port
 280   constructor: macro-make-device-port
 281   implementer: implement-type-device-port
 282   macros:
 283   prefix: macro-
 284   opaque:
 285   unprintable:
 286
 287   extender: define-type-of-device-port
 288
 289   rdevice-condvar    ;; device condvar from which bytes are read
 290   wdevice-condvar    ;; device condvar to which bytes are written
 291   name               ;; name of device
 292 )
 293
 294 (##define-macro (macro-device-input-port? obj)
 295   `(macro-port-of-rkind? ,obj (macro-device-kind)))
 296
 297 (##define-macro (macro-device-output-port? obj)
 298   `(macro-port-of-wkind? ,obj (macro-device-kind)))
 299
 300 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 301
 302 ;;; Representation of vector, string and u8vector ports.
 303
 304
 305 (define-type-of-port vector-port
 306   id: 2fb9e1fc-693b-455f-94a2-70c617a304d1
 307   type-exhibitor: macro-type-vector-port
 308   constructor: macro-make-vector-port
 309   implementer: implement-type-vector-port
 310   macros:
 311   prefix: macro-
 312   opaque:
 313   unprintable:
 314
 315   extender: define-type-of-vector-port
 316
 317   rbuf
 318   rlo
 319   rhi
 320   rbuf-fill
 321   wbuf
 322   wlo
 323   whi
 324   wbuf-drain
 325   peer
 326   fifo
 327   rcondvar
 328   wcondvar
 329   buffering-limit
 330 )
 331
 332 (define-check-type vector-input-port 'vector-input-port
 333   macro-vector-input-port?)
 334 (define-check-type vector-output-port 'vector-output-port
 335   macro-vector-output-port?)
 336
 337 (##define-macro (macro-vector-input-port? obj)
 338   `(macro-port-of-rkind? ,obj (macro-vector-kind)))
 339
 340 (##define-macro (macro-vector-output-port? obj)
 341   `(macro-port-of-wkind? ,obj (macro-vector-kind)))
 342
 343 (define-type-of-character-port string-port
 344   id: 81e73361-b03c-4889-9d02-e340e3309934
 345   type-exhibitor: macro-type-string-port
 346   constructor: macro-make-string-port
 347   implementer: implement-type-string-port
 348   macros:
 349   prefix: macro-
 350   opaque:
 351   unprintable:
 352
 353   extender: define-type-of-string-port
 354
 355   peer
 356   fifo
 357   rcondvar
 358   wcondvar
 359   width
 360   buffering-limit
 361 )
 362
 363 (define-check-type string-input-port 'string-input-port
 364   macro-string-input-port?)
 365 (define-check-type string-output-port 'string-output-port
 366   macro-string-output-port?)
 367
 368 (##define-macro (macro-string-input-port? obj)
 369   `(macro-port-of-rkind? ,obj (macro-string-kind)))
 370
 371 (##define-macro (macro-string-output-port? obj)
 372   `(macro-port-of-wkind? ,obj (macro-string-kind)))
 373
 374 (define-type-of-byte-port u8vector-port
 375   id: 04c1b0ae-b11f-4815-b206-ce01648675bd
 376   type-exhibitor: macro-type-u8vector-port
 377   constructor: macro-make-u8vector-port
 378   implementer: implement-type-u8vector-port
 379   macros:
 380   prefix: macro-
 381   opaque:
 382   unprintable:
 383
 384   extender: define-type-of-u8vector-port
 385
 386   peer
 387   fifo
 388   rcondvar
 389   wcondvar
 390   width
 391   buffering-limit
 392 )
 393
 394 (define-check-type u8vector-input-port 'u8vector-input-port
 395   macro-u8vector-input-port?)
 396 (define-check-type u8vector-output-port 'u8vector-output-port
 397   macro-u8vector-output-port?)
 398
 399 (##define-macro (macro-u8vector-input-port? obj)
 400   `(macro-port-of-rkind? ,obj (macro-u8vector-kind)))
 401
 402 (##define-macro (macro-u8vector-output-port? obj)
 403   `(macro-port-of-wkind? ,obj (macro-u8vector-kind)))
 404
 405 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 406
 407 ;;; Representation of file device ports.
 408
 409 (define-check-type file-port 'file-port
 410   macro-file-port?)
 411
 412 (##define-macro (macro-file-port? obj)
 413   `(##port-of-kind? ,obj (macro-file-kind)))
 414
 415 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 416
 417 ;;; Representation of tty device ports.
 418
 419 (define-check-type tty-port 'tty-port
 420   macro-tty-port?)
 421
 422 (##define-macro (macro-tty-port? obj)
 423   `(##port-of-kind? ,obj (macro-tty-kind)))
 424
 425 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 426
 427 ;;; Representation of process device ports.
 428
 429 (define-check-type process-port 'process-port
 430   macro-process-port?)
 431
 432 (##define-macro (macro-process-port? obj)
 433   `(##port-of-kind? ,obj (macro-process-kind)))
 434
 435 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 436
 437 ;;; Representation of host-info objects.
 438
 439 (define-library-type host-info
 440   id: e3dc833e-a176-42c1-bdc0-76a6c4b302f8
 441   constructor: #f
 442   opaque:
 443
 444   (name      printable: read-only:)
 445   (aliases   printable: read-only:)
 446   (addresses printable: read-only:)
 447 )
 448
 449 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 450
 451 ;;; Representation of service-info objects.
 452
 453 (define-library-type service-info
 454   id: 177749b2-beb0-4670-9ab2-4b9c01b54c1d
 455   constructor: #f
 456   opaque:
 457
 458   (name        printable: read-only:)
 459   (aliases     printable: read-only:)
 460   (port-number printable: read-only:)
 461   (protocol    printable: read-only:)
 462 )
 463
 464 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 465
 466 ;;; Representation of protocol-info objects.
 467
 468 (define-library-type protocol-info
 469   id: ffc668b5-2146-42b7-ab11-7d91641f2124
 470   constructor: #f
 471   opaque:
 472
 473   (name      printable: read-only:)
 474   (aliases   printable: read-only:)
 475   (number    printable: read-only:)
 476 )
 477
 478 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 479
 480 ;;; Representation of network-info objects.
 481
 482 (define-library-type network-info
 483   id: ce2e418b-96c7-4562-9cb6-419ec113704e
 484   constructor: #f
 485   opaque:
 486
 487   (name      printable: read-only:)
 488   (aliases   printable: read-only:)
 489   (number    printable: read-only:)
 490 )
 491
 492 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 493
 494 ;;; Representation of socket-info objects.
 495
 496 (define-library-type socket-info
 497   id: 837d9768-9d27-455e-ac65-5ae59f43f79e
 498   constructor: #f
 499   opaque:
 500
 501   (family      printable: read-only:)
 502   (port-number printable: read-only:)
 503   (address     printable: read-only:)
 504 )
 505
 506 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 507
 508 ;;; Representation of address-info objects.
 509
 510 (define-library-type address-info
 511   id: f165f359-8685-48da-bc99-f38827ad8af9
 512   constructor: #f
 513   opaque:
 514
 515   (family       printable: read-only:)
 516   (socket-type  printable: read-only:)
 517   (protocol     printable: read-only:)
 518   (socket-info  printable: read-only:)
 519 )
 520
 521 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 522
 523 ;;; Representation of TCP client device ports.
 524
 525 (define-check-type tcp-client-port 'tcp-client-port
 526   macro-tcp-client-port?)
 527
 528 (##define-macro (macro-tcp-client-port? obj)
 529   `(##port-of-kind? ,obj (macro-tcp-client-kind)))
 530
 531 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 532
 533 ;;; Representation of TCP server ports.
 534
 535 (define-type-of-port tcp-server-port
 536   id: 42696abb-6729-4637-99de-cef7d3a230ae
 537   type-exhibitor: macro-type-tcp-server-port
 538   constructor: macro-make-tcp-server-port
 539   implementer: implement-type-tcp-server-port
 540   macros:
 541   prefix: macro-
 542   opaque:
 543   unprintable:
 544
 545   extender: define-type-of-tcp-server-port
 546
 547   rdevice-condvar
 548   client-psettings
 549 )
 550
 551 (define-check-type tcp-server-port (macro-type-tcp-server-port)
 552   macro-tcp-server-port?)
 553
 554 (##define-macro (macro-tcp-server-port? obj)
 555   `(##port-of-kind? ,obj (macro-tcp-server-kind)))
 556
 557 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 558
 559 ;;; Representation of pipe device ports.
 560
 561 (define-check-type pipe-port 'pipe-port
 562   macro-pipe-port?)
 563
 564 (##define-macro (macro-pipe-port? obj)
 565   `(##port-of-kind? ,obj (macro-pipe-kind)))
 566
 567 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 568
 569 ;;; Representation of serial device ports.
 570
 571 (define-check-type serial-port 'serial-port
 572   macro-serial-port?)
 573
 574 (##define-macro (macro-serial-port? obj)
 575   `(##port-of-kind? ,obj (macro-serial-kind)))
 576
 577 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 578
 579 ;;; Representation of directory ports.
 580
 581 (define-type-of-port directory-port
 582   id: deebf606-97e4-4d34-8fed-b9e5468851b9
 583   type-exhibitor: macro-type-directory-port
 584   constructor: macro-make-directory-port
 585   implementer: implement-type-directory-port
 586   macros:
 587   prefix: macro-
 588   opaque:
 589   unprintable:
 590
 591   extender: define-type-of-directory-port
 592
 593   rdevice-condvar
 594   path
 595 )
 596
 597 (define-check-type directory-port 'directory-port
 598   macro-directory-port?)
 599
 600 (##define-macro (macro-directory-port? obj)
 601   `(##port-of-kind? ,obj (macro-directory-kind)))
 602
 603 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 604
 605 ;;; Representation of event queue ports.
 606
 607 (define-type-of-port event-queue-port
 608   id: 59109ed7-6339-4c6e-8bc2-f52e9c91b9f5
 609   type-exhibitor: macro-type-event-queue-port
 610   constructor: macro-make-event-queue-port
 611   implementer: implement-type-event-queue-port
 612   macros:
 613   prefix: macro-
 614   opaque:
 615   unprintable:
 616
 617   extender: define-type-of-event-queue-port
 618
 619   rdevice-condvar
 620   index
 621 )
 622
 623 (define-check-type event-queue-port 'event-queue-port
 624   macro-event-queue-port?)
 625
 626 (##define-macro (macro-event-queue-port? obj)
 627   `(##port-of-kind? ,obj (macro-event-queue-kind)))
 628
 629 ;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 630
 631 ;;; Representation of timer ports.
 632
 633 (define-check-type timer-port 'timer-port
 634   macro-timer-port?)
 635
 636 (##define-macro (macro-timer-port? obj)
 637   `(##port-of-kind? ,obj (macro-timer-kind)))
 638
 639 ;;;----------------------------------------------------------------------------
 640
 641 ;;; Representation of port mutexes.
 642
 643 (##define-macro (macro-make-port-mutex)
 644   `(##make-mutex #f))
 645
 646 (##define-macro (macro-port-mutex-lock! port)
 647   `(macro-mutex-lock! (macro-port-mutex ,port) #f (macro-current-thread)))
 648
 649 (##define-macro (macro-port-mutex-unlock! port)
 650   `(macro-mutex-unlock! (macro-port-mutex ,port)))
 651
 652 (##define-macro (macro-port-mutex-unlocked-not-abandoned-and-not-multiprocessor? port)
 653   `(macro-mutex-unlocked-not-abandoned-and-not-multiprocessor? (macro-port-mutex ,port)))
 654
 655 ;;;----------------------------------------------------------------------------
 656
 657 ;;; Representation of port settings.
 658
 659 (define-type psettings
 660   id: 0b02934e-7c23-4f9e-a629-0eede16e6987
 661   type-exhibitor: macro-type-psettings
 662   constructor: macro-make-psettings
 663   implementer: implement-type-psettings
 664   macros:
 665   prefix: macro-
 666   opaque:
 667   unprintable:
 668
 669   direction
 670   roptions
 671   woptions
 672   path
 673   init
 674   arguments
 675   environment
 676   directory
 677   append
 678   create
 679   truncate
 680   permissions
 681   output-width
 682   stdin-redir
 683   stdout-redir
 684   stderr-redir
 685   pseudo-term
 686   show-console
 687   server-address
 688   port-number
 689   socket-type
 690   coalesce
 691   keep-alive
 692   backlog
 693   reuse-address
 694   broadcast
 695   ignore-hidden
 696 )
 697
 698 (define-type psettings-options
 699   id: edb28923-9aa0-4c55-9756-f1a37136f727
 700   type-exhibitor: macro-type-psettings-options
 701   constructor: macro-make-psettings-options
 702   implementer: implement-type-psettings-options
 703   macros:
 704   prefix: macro-
 705   opaque:
 706   unprintable:
 707
 708   readtable
 709   char-encoding
 710   char-encoding-errors
 711   eol-encoding
 712   buffering
 713   permanent-close
 714 )
 715
 716 (##define-macro (macro-default-readtable) #f)
 717
 718 (##define-macro (macro-char-encoding-shift)                     1)
 719 (##define-macro (macro-char-encoding-range)                     32)
 720 (##define-macro (macro-default-char-encoding)                   0)
 721 (##define-macro (macro-char-encoding-ASCII)                     1)
 722 (##define-macro (macro-char-encoding-ISO-8859-1)                2)
 723 (##define-macro (macro-char-encoding-UTF-8)                     3)
 724 (##define-macro (macro-char-encoding-UTF-16)                    4)
 725 (##define-macro (macro-char-encoding-UTF-16BE)                  5)
 726 (##define-macro (macro-char-encoding-UTF-16LE)                  6)
 727 (##define-macro (macro-char-encoding-UTF-fallback-ASCII)        7)
 728 (##define-macro (macro-char-encoding-UTF-fallback-ISO-8859-1)   8)
 729 (##define-macro (macro-char-encoding-UTF-fallback-UTF-8)        9)
 730 (##define-macro (macro-char-encoding-UTF-fallback-UTF-16)       10)
 731 (##define-macro (macro-char-encoding-UTF-fallback-UTF-16BE)     11)
 732 (##define-macro (macro-char-encoding-UTF-fallback-UTF-16LE)     12)
 733 (##define-macro (macro-char-encoding-UCS-2)                     13)
 734 (##define-macro (macro-char-encoding-UCS-2BE)                   14)
 735 (##define-macro (macro-char-encoding-UCS-2LE)                   15)
 736 (##define-macro (macro-char-encoding-UCS-4)                     16)
 737 (##define-macro (macro-char-encoding-UCS-4BE)                   17)
 738 (##define-macro (macro-char-encoding-UCS-4LE)                   18)
 739 (##define-macro (macro-char-encoding-wchar)                     19)
 740 (##define-macro (macro-char-encoding-native)                    20)
 741
 742 (##define-macro (macro-char-encoding-UTF)
 743   `(macro-char-encoding-UTF-fallback-UTF-8))
 744
 745 (##define-macro (macro-char-encoding-errors-shift)   32)
 746 (##define-macro (macro-char-encoding-errors-range)   4)
 747 (##define-macro (macro-default-char-encoding-errors) 0)
 748 (##define-macro (macro-char-encoding-errors-on)      1)
 749 (##define-macro (macro-char-encoding-errors-off)     2)
 750
 751 (##define-macro (macro-eol-encoding-shift)   128)
 752 (##define-macro (macro-eol-encoding-range)   4)
 753 (##define-macro (macro-default-eol-encoding) 0)
 754 (##define-macro (macro-eol-encoding-lf)      1)
 755 (##define-macro (macro-eol-encoding-cr)      2)
 756 (##define-macro (macro-eol-encoding-crlf)    3)
 757
 758 (##define-macro (macro-buffering-shift)   512)
 759 (##define-macro (macro-buffering-range)   4)
 760 (##define-macro (macro-default-buffering) 0)
 761 (##define-macro (macro-no-buffering)      1)
 762 (##define-macro (macro-line-buffering)    2)
 763 (##define-macro (macro-full-buffering)    3)
 764
 765 (##define-macro (macro-unbuffered? options)
 766   `(##fixnum.< (##fixnum.bitwise-and ,options 2047) 1024))
 767
 768 (##define-macro (macro-fully-buffered? options)
 769   `(##not (##fixnum.< (##fixnum.bitwise-and ,options 2047) 1536)))
 770
 771 (##define-macro (macro-decode-state-shift)  2048)
 772 (##define-macro (macro-decode-state-range)  4)
 773 (##define-macro (macro-decode-state-none)   0)
 774 (##define-macro (macro-decode-state-lf)     1)
 775 (##define-macro (macro-decode-state-cr)     2)
 776
 777 (##define-macro (macro-open-state-shift)  8192)
 778 (##define-macro (macro-open-state-range)  2)
 779 (##define-macro (macro-open-state-open)   0)
 780 (##define-macro (macro-open-state-closed) 1)
 781
 782 (##define-macro (macro-closed? options)
 783   `(##not (##fixnum.= (##fixnum.bitwise-and ,options 8192) 0)))
 784
 785 (##define-macro (macro-close! options)
 786   `(##fixnum.bitwise-ior ,options 8192))
 787
 788 (##define-macro (macro-unclose! options)
 789   `(##fixnum.bitwise-and ,options -8193))
 790
 791 (##define-macro (macro-permanent-close-shift)  16384)
 792 (##define-macro (macro-permanent-close-range)  2)
 793 (##define-macro (macro-permanent-close-no)     0)
 794 (##define-macro (macro-permanent-close-yes)    1)
 795
 796 (##define-macro (macro-perm-close? options)
 797   `(##not (##fixnum.= (##fixnum.bitwise-and ,options 16384) 0)))
 798
 799 (##define-macro (macro-direction-shift) 16)
 800 (##define-macro (macro-direction-in)    1)
 801 (##define-macro (macro-direction-out)   2)
 802 (##define-macro (macro-direction-inout) 3)
 803
 804 (##define-macro (macro-default-path) #f)
 805
 806 (##define-macro (macro-default-init) #f)
 807
 808 (##define-macro (macro-default-arguments) ''())
 809
 810 (##define-macro (macro-default-environment) #f)
 811
 812 (##define-macro (macro-default-directory) #f)
 813
 814 (##define-macro (macro-append-shift)   8)
 815 (##define-macro (macro-no-append)      0)
 816 (##define-macro (macro-append)         1)
 817 (##define-macro (macro-default-append) 2)
 818
 819 (##define-macro (macro-create-shift)   2)
 820 (##define-macro (macro-no-create)      0)
 821 (##define-macro (macro-maybe-create)   1)
 822 (##define-macro (macro-create)         2)
 823 (##define-macro (macro-default-create) 3)
 824
 825 (##define-macro (macro-truncate-shift)   1)
 826 (##define-macro (macro-no-truncate)      0)
 827 (##define-macro (macro-truncate)         1)
 828 (##define-macro (macro-default-truncate) 2)
 829
 830 (##define-macro (macro-default-permissions)  -1)
 831
 832 (##define-macro (macro-default-output-width) -1)
 833
 834 (##define-macro (macro-permanent-close) 1)
 835 (##define-macro (macro-no-permanent-close) 0)
 836 (##define-macro (macro-default-permanent-close) `(macro-permanent-close))
 837
 838 (##define-macro (macro-stdin-from-port) 1)
 839 (##define-macro (macro-stdin-unchanged) 0)
 840 (##define-macro (macro-default-stdin-redir) `(macro-stdin-from-port))
 841
 842 (##define-macro (macro-stdout-to-port) 1)
 843 (##define-macro (macro-stdout-unchanged) 0)
 844 (##define-macro (macro-default-stdout-redir) `(macro-stdout-to-port))
 845
 846 (##define-macro (macro-stderr-to-port) 1)
 847 (##define-macro (macro-stderr-unchanged) 0)
 848 (##define-macro (macro-default-stderr-redir) `(macro-stderr-unchanged))
 849
 850 (##define-macro (macro-pseudo-term) 1)
 851 (##define-macro (macro-no-pseudo-term) 0)
 852 (##define-macro (macro-default-pseudo-term) `(macro-no-pseudo-term))
 853
 854 (##define-macro (macro-show-console) 1)
 855 (##define-macro (macro-no-show-console) 0)
 856 (##define-macro (macro-default-show-console) `(macro-show-console))
 857
 858 (##define-macro (macro-default-server-address) `'#u8(127 0 0 1))
 859
 860 (##define-macro (macro-default-port-number) #f)
 861
 862 (##define-macro (macro-socket-type-TCP) 0)
 863 (##define-macro (macro-socket-type-UDP) 1)
 864 (##define-macro (macro-socket-type-RAW) 2)
 865 (##define-macro (macro-default-socket-type) `(macro-socket-type-TCP))
 866
 867 (##define-macro (macro-coalesce) 1)
 868 (##define-macro (macro-no-coalesce) 0)
 869 (##define-macro (macro-default-coalesce) `(macro-coalesce))
 870
 871 (##define-macro (macro-keep-alive) 1)
 872 (##define-macro (macro-no-keep-alive) 0)
 873 (##define-macro (macro-default-keep-alive) `(macro-no-keep-alive))
 874
 875 (##define-macro (macro-broadcast) 1)
 876 (##define-macro (macro-no-broadcast) 0)
 877 (##define-macro (macro-default-broadcast) `(macro-no-broadcast))
 878
 879 (##define-macro (macro-default-backlog) 128)
 880
 881 (##define-macro (macro-reuse-address) 1)
 882 (##define-macro (macro-no-reuse-address) 0)
 883 (##define-macro (macro-default-reuse-address) `(macro-reuse-address))
 884
 885 (##define-macro (macro-ignore-hidden) 2)
 886 (##define-macro (macro-ignore-dot-and-dot-dot) 1)
 887 (##define-macro (macro-ignore-nothing) 0)
 888 (##define-macro (macro-default-ignore-hidden) `(macro-ignore-hidden))
 889
 890 ;;;----------------------------------------------------------------------------
 891
 892 ;;; Representation of write environments.
 893
 894 ;; A writeenv structure maintains the "write environment" throughout
 895 ;; the writing of a Scheme datum.  It includes the write style
 896 ;; (display, write, pretty-print, mark), the port on which to write,
 897 ;; the readtable, the marktable (for detecting cycles), the force flag,
 898 ;; the pretty-print width, the number of closing parentheses to follow
 899 ;; the datum, the current nesting level, and the character count limit.
 900
 901 (define-type writeenv
 902   id: f5cfcf78-bba4-4140-9aa0-1a136c50d36b
 903   type-exhibitor: macro-type-writeenv
 904   constructor: macro-make-writeenv
 905   implementer: implement-type-writeenv
 906   macros:
 907   prefix: macro-
 908   opaque:
 909   unprintable:
 910
 911   style
 912   port
 913   readtable
 914   marktable
 915   force?
 916   width
 917   shift
 918   close-parens
 919   level
 920   limit
 921 )
 922
 923 ;;;----------------------------------------------------------------------------
 924
 925 ;;; Representation of read environments.
 926
 927 ;; A readenv structure maintains the "read environment" throughout the
 928 ;; reading of a Scheme datum.  It includes the port from which to read,
 929 ;; the readtable, the wrap and unwrap procedures, the table of labels
 930 ;; (i.e. "#n#"), and the position where the currently being read datum
 931 ;; started.
 932
 933 (define-type readenv
 934   id: edd21ef2-ee48-407f-a9a9-c1c361078e55
 935   type-exhibitor: macro-type-readenv
 936   constructor: macro-make-readenv
 937   implementer: implement-type-readenv
 938   macros:
 939   prefix: macro-
 940   opaque:
 941   unprintable:
 942
 943   port
 944   readtable
 945   wrapper
 946   unwrapper
 947   allow-script?
 948   labels
 949   container
 950   filepos
 951 )
 952
 953 (##define-macro (macro-readenv-wrap re x)
 954   `(let ((re ,re)
 955          (x ,x))
 956      ((macro-readenv-wrapper re) re x)))
 957
 958 (##define-macro (macro-readenv-unwrap re x)
 959   `(let ((re ,re)
 960          (x ,x))
 961      ((macro-readenv-unwrapper re) re x)))
 962
 963 ;;;----------------------------------------------------------------------------
 964
 965 ;;; Generic char port procedures.
 966
 967 (##define-macro (macro-peek-char port)
 968   `(let ((port ,port))
 969
 970      (##declare (not interrupts-enabled))
 971
 972      ;; try to get exclusive access to port and if successful perform
 973      ;; operation inline
 974
 975      (if (macro-port-mutex-unlocked-not-abandoned-and-not-multiprocessor? port)
 976
 977        (let ((char-rlo (macro-character-port-rlo port))
 978              (char-rhi (macro-character-port-rhi port)))
 979          (if (##fixnum.< char-rlo char-rhi)
 980
 981            ;; the next character is in the character read buffer
 982
 983            (##string-ref (macro-character-port-rbuf port) char-rlo)
 984
 985            ;; more characters are needed, do this out-of-line
 986
 987            (let ()
 988              (##declare (interrupts-enabled))
 989              (##peek-char port))))
 990
 991        ;; couldn't easily get exclusive access to port, handle this out-of-line
 992
 993        (let ()
 994          (##declare (interrupts-enabled))
 995          (##peek-char port)))))
 996
 997 (##define-macro (macro-read-char port)
 998   `(let ((port ,port))
 999
1000      (##declare (not interrupts-enabled))
1001
1002      ;; try to get exclusive access to port and if successful perform
1003      ;; operation inline
1004
1005      (if (macro-port-mutex-unlocked-not-abandoned-and-not-multiprocessor? port)
1006
1007        (let ((char-rlo (macro-character-port-rlo port))
1008              (char-rhi (macro-character-port-rhi port)))
1009          (if (##fixnum.< char-rlo char-rhi)
1010
1011            ;; the next character is in the character read buffer
1012
1013            (let ((c (##string-ref (macro-character-port-rbuf port) char-rlo)))
1014              (if (##not (##char=? c #\newline))
1015
1016                ;; frequent simple case, just advance rlo
1017
1018                (begin
1019                  (macro-character-port-rlo-set! port (##fixnum.+ char-rlo 1))
1020                  c)
1021
1022                ;; end-of-line processing is complex, so do it out-of-line
1023
1024                (let ()
1025                  (##declare (interrupts-enabled))
1026                  (##read-char port))))
1027
1028            ;; more characters are needed, do this out-of-line
1029
1030            (let ()
1031              (##declare (interrupts-enabled))
1032              (##read-char port))))
1033
1034        ;; couldn't easily get exclusive access to port, handle this out-of-line
1035
1036        (let ()
1037          (##declare (interrupts-enabled))
1038          (##read-char port)))))
1039
1040 (##define-macro (macro-write-char c port)
1041   `(let ((c ,c)
1042          (port ,port))
1043
1044      (##declare (not interrupts-enabled))
1045
1046      ;; try to get exclusive access to port and if successful perform
1047      ;; operation inline
1048
1049      (if (and (##not (##char=? c #\newline))
1050               (macro-port-mutex-unlocked-not-abandoned-and-not-multiprocessor? port))
1051
1052        (let ((char-wbuf (macro-character-port-wbuf port))
1053              (char-whi+1 (##fixnum.+ (macro-character-port-whi port) 1)))
1054          (if (##fixnum.< char-whi+1 (##string-length char-wbuf))
1055
1056            ;; adding this character would not make the character write
1057            ;; buffer full, so add character and increment whi
1058
1059            (begin
1060              (##string-set! char-wbuf (##fixnum.- char-whi+1 1) c)
1061              (macro-character-port-whi-set! port char-whi+1)
1062              (##void))
1063
1064            ;; the character write buffer would become full, so handle
1065            ;; this out-of-line
1066
1067            (let ()
1068              (##declare (interrupts-enabled))
1069              (##write-char c port))))
1070
1071        ;; end-of-line processing is needed or exclusive access to port
1072        ;; cannot be obtained easily, so handle this out-of-line
1073
1074        (let ()
1075          (##declare (interrupts-enabled))
1076          (##write-char c port)))))
1077
1078 ;;;----------------------------------------------------------------------------
1079
1080 ;;; Representation of readtables.
1081
1082 (define-type readtable
1083   id: bebee95d-0da2-401d-a33a-c1afc75b9e43
1084   type-exhibitor: macro-type-readtable
1085   constructor: macro-make-readtable
1086   implementer: implement-type-readtable
1087   macros:
1088   prefix: macro-
1089   opaque:
1090
1091   (case-conversion?               unprintable: read-write:)
1092   (keywords-allowed?              unprintable: read-write:)
1093   (escaped-char-table             unprintable: read-write:)
1094   (named-char-table               unprintable: read-write:)
1095   (sharp-bang-table               unprintable: read-write:)
1096   (char-delimiter?-table          unprintable: read-write:)
1097   (char-handler-table             unprintable: read-write:)
1098   (char-sharp-handler-table       unprintable: read-write:)
1099   (max-unescaped-char             unprintable: read-write:)
1100   (escape-ctrl-chars?             unprintable: read-write:)
1101   (sharing-allowed?               unprintable: read-write:)
1102   (eval-allowed?                  unprintable: read-write:)
1103   (write-extended-read-macros?    unprintable: read-write:)
1104   (write-cdr-read-macros?         unprintable: read-write:)
1105   (max-write-level                unprintable: read-write:)
1106   (max-write-length               unprintable: read-write:)
1107   (pretty-print-formats           unprintable: read-write:)
1108   (quote-keyword                  unprintable: read-write:)
1109   (quasiquote-keyword             unprintable: read-write:)
1110   (unquote-keyword                unprintable: read-write:)
1111   (unquote-splicing-keyword       unprintable: read-write:)
1112   (sharp-quote-keyword            unprintable: read-write:)
1113   (sharp-quasiquote-keyword       unprintable: read-write:)
1114   (sharp-unquote-keyword          unprintable: read-write:)
1115   (sharp-unquote-splicing-keyword unprintable: read-write:)
1116   (sharp-num-keyword              unprintable: read-write:)
1117   (sharp-seq-keyword              unprintable: read-write:)
1118   (paren-keyword                  unprintable: read-write:)
1119   (bracket-keyword                unprintable: read-write:)
1120   (brace-keyword                  unprintable: read-write:)
1121   (angle-keyword                  unprintable: read-write:)
1122   (start-syntax                   unprintable: read-write:)
1123   (six-type?                      unprintable: read-write:)
1124   (r6rs-compatible-read?          unprintable: read-write:)
1125   (r6rs-compatible-write?         unprintable: read-write:)
1126   (here-strings-allowed?          unprintable: read-write:)
1127 )
1128
1129 (define-check-type readtable (macro-type-readtable)
1130   macro-readtable?)
1131
1132 ;;;----------------------------------------------------------------------------
1133
1134 ;;; Representation of language specs.
1135
1136 (##define-macro (macro-language-name x)              `(##vector-ref ,x 0))
1137 (##define-macro (macro-language-case-conversion? x)  `(##vector-ref ,x 1))
1138 (##define-macro (macro-language-keywords-allowed? x) `(##vector-ref ,x 2))
1139 (##define-macro (macro-language-start-syntax x)      `(##vector-ref ,x 3))
1140 (##define-macro (macro-language-srfi-22? x)          `(##vector-ref ,x 4))
1141
1142 ;;;============================================================================