Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

1144 lines (874 sloc) 36.706 kb
;;;============================================================================
;;; File: "_io#.scm"
;;; Copyright (c) 1994-2012 by Marc Feeley, All Rights Reserved.
;;;============================================================================
;;; Representation of exceptions.
(define-library-type-of-exception datum-parsing-exception
id: 84660e37-9565-4abf-ac09-f9767f926d40
constructor: #f
opaque:
(kind unprintable: read-only:)
(readenv unprintable: read-only:)
(parameters unprintable: read-only:)
)
(define-library-type-of-exception unterminated-process-exception
id: b320dfbf-c714-4dc5-8bfa-cac5ee6c8421
constructor: #f
opaque:
unprintable:
read-only:
procedure
arguments
)
(define-library-type-of-exception nonempty-input-port-character-buffer-exception
id: 63b50ae7-375b-4b94-81df-3522686f5634
constructor: #f
opaque:
unprintable:
read-only:
procedure
arguments
)
;;;----------------------------------------------------------------------------
;;; Define type checking macros.
(define-check-type string-or-ip-address 'string-or-ip-address
macro-string-or-ip-address?)
(##define-macro (macro-string-or-ip-address? obj)
`(##string-or-ip-address? ,obj))
;;;----------------------------------------------------------------------------
;;; Representation of ports.
;; There are 5 kinds of ports, each providing a set of operations. All
;; port objects have the capability of being both an input port and an
;; output port. The "none-port" kind provides no operation and is
;; mainly for internal use to indicate that no input operation is
;; available or that no output operation is available.
;;
;; 1) An "object-port" (or simply a "port") provides operations to read
;; and write Scheme data (i.e. any Scheme object) to/from the port.
;; It also provides operations to get the name of the port, to force
;; output to occur, and to close the port. This kind of port need
;; not be connected to a character based device or file (it could
;; for example be a FIFO queue linking two threads that need to
;; communicate Scheme objects).
;;
;; 2) A "character-port" provides all the operations of an "object-port",
;; and also operations to read and write individual characters
;; to/from the port. When a Scheme object is written to a
;; character-port, it is converted into the sequence of characters that
;; corresponds to its "external-representation". When reading a
;; Scheme object, an inverse conversion occurs.
;;
;; 3) A "byte-port" provides all the operations of a "character-port", and
;; also operations to read and write individual bytes to/from the
;; port. When a **character** is written to a byte-port, some
;; encoding of that character into a sequence of bytes will occur
;; (for example, #\newline might be encoded as the 2 bytes CR-LF
;; when using ISO-8859-1 encoding, or a non-ASCII character will
;; generate more than 1 byte when using UTF-8 encoding). When
;; reading a character, a similar decoding occurs.
;;
;; 4) A "device-port" provides all the operations of a "byte-port", and
;; also operations to control the device (file, tty, etc) that is
;; connected to the port, such as changing the tty settings.
(define-type port
id: 2babe060-9af6-456f-a26e-40b592f690ec
type-exhibitor: macro-type-port
constructor: macro-make-port
implementer: implement-type-port
macros:
prefix: macro-
opaque:
unprintable:
extender: define-type-of-port
mutex ;; access to the port is controlled with this mutex
rkind ;; port kind for reading (none-port if can't read)
wkind ;; port kind for writing (none-port if can't write)
name ;; procedure which returns the name of the port
read-datum ;; procedure to read a datum
write-datum ;; procedure to write a datum
newline ;; procedure to write a datum separator
force-output ;; procedure to force output to occur on target device
close ;; procedure to close the port
roptions ;; options for reading (buffering type, encoding, etc)
rtimeout ;; time at which a read that would block times out
rtimeout-thunk ;; thunk called when a read timeout occurs
set-rtimeout ;; procedure to set rtimeout and rtimeout-thunk
woptions ;; options for writing (buffering type, encoding, etc)
wtimeout ;; time at which a write that would block times out
wtimeout-thunk ;; thunk called when a write timeout occurs
set-wtimeout ;; procedure to set wtimeout and wtimeout-thunk
)
(define-check-type port (macro-type-port)
macro-port?)
(##define-macro (macro-port-of-rkind? obj kind)
`(let ((obj ,obj))
(and (macro-port? obj)
(##fixnum.= (##fixnum.bitwise-and (macro-port-rkind obj) ,kind)
,kind))))
(##define-macro (macro-port-of-wkind? obj kind)
`(let ((obj ,obj))
(and (macro-port? obj)
(##fixnum.= (##fixnum.bitwise-and (macro-port-wkind obj) ,kind)
,kind))))
(##define-macro (macro-none-kind) 0) ;; allows nothing
(##define-macro (macro-object-kind) 1) ;; can read and write objects
(##define-macro (macro-character-kind) 3) ;; can also read and write chars
(##define-macro (macro-byte-kind) 7) ;; can also read and write bytes
(##define-macro (macro-device-kind) 15) ;; can also do device operations
(##define-macro (macro-file-kind) (+ 15 16))
(##define-macro (macro-process-kind) (+ 15 32))
(##define-macro (macro-tty-kind) (+ 15 64))
(##define-macro (macro-serial-kind) (+ 15 128))
(##define-macro (macro-tcp-client-kind) (+ 15 256))
(##define-macro (macro-tcp-server-kind) (+ 1 512))
(##define-macro (macro-directory-kind) (+ 1 1024))
(##define-macro (macro-event-queue-kind) (+ 1 2048))
(##define-macro (macro-timer-kind) (+ 1 4096))
(##define-macro (macro-vector-kind) (+ 1 8192))
(##define-macro (macro-string-kind) (+ 3 16384))
(##define-macro (macro-u8vector-kind) (+ 7 32768))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of object ports.
(define-check-type input-port 'input-port
macro-input-port?)
(define-check-type output-port 'output-port
macro-output-port?)
(##define-macro (macro-input-port? obj)
`(macro-port-of-rkind? ,obj (macro-object-kind)))
(##define-macro (macro-output-port? obj)
`(macro-port-of-wkind? ,obj (macro-object-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of char ports.
(define-check-type character-input-port 'character-input-port
macro-character-input-port?)
(define-check-type character-output-port 'character-output-port
macro-character-output-port?)
(define-type-of-port character-port
id: 85099702-35ec-4cb8-ae55-13c4b9b05d10
type-exhibitor: macro-type-character-port
constructor: macro-make-character-port
implementer: implement-type-character-port
macros:
prefix: macro-
opaque:
unprintable:
extender: define-type-of-character-port
rbuf ;; character read buffer (a string)
rlo ;; low pointer (start of unread characters)
rhi ;; high pointer (end of unread characters)
rchars ;; number of characters read at start of read buffer
rlines ;; number of lines read up to low pointer
rcurline ;; absolute character position where current line starts
rbuf-fill ;; procedure to read characters into the read buffer
peek-eof? ;; peeking the next character should return end-of-file?
wbuf ;; character write buffer (a string)
wlo ;; low pointer (start of unwritten characters)
whi ;; high pointer (end of unwritten characters)
wchars ;; number of characters written at start of write buffer
wlines ;; number of lines written up to high pointer
wcurline ;; absolute character position where current line starts
wbuf-drain ;; procedure to write characters from the write buffer
input-readtable ;; readtable for reading
output-readtable ;; readtable for writing
output-width ;; procedure to get the output width in characters
)
(##define-macro (macro-character-input-port? obj)
`(macro-port-of-rkind? ,obj (macro-character-kind)))
(##define-macro (macro-character-output-port? obj)
`(macro-port-of-wkind? ,obj (macro-character-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of byte ports.
(define-check-type byte-port 'byte-port
macro-byte-port?)
(define-check-type byte-input-port 'byte-input-port
macro-byte-input-port?)
(define-check-type byte-output-port 'byte-output-port
macro-byte-output-port?)
(define-type-of-character-port byte-port
id: 8a99028e-7b99-4468-b94e-728737ec1b1a
type-exhibitor: macro-type-byte-port
constructor: macro-make-byte-port
implementer: implement-type-byte-port
macros:
prefix: macro-
opaque:
unprintable:
extender: define-type-of-byte-port
rbuf ;; byte read buffer (a u8vector)
rlo ;; low pointer (start of unread bytes)
rhi ;; high pointer (end of unread bytes)
rbuf-fill ;; procedure to read bytes into the read buffer
wbuf ;; byte write buffer (a u8vector)
wlo ;; low pointer (start of unwritten bytes)
whi ;; high pointer (end of unwritten bytes)
wbuf-drain ;; procedure to write bytes from the write buffer
)
(##define-macro (macro-byte-port? obj)
`(or (macro-byte-input-port? ,obj)
(macro-byte-output-port? ,obj)))
(##define-macro (macro-byte-input-port? obj)
`(macro-port-of-rkind? ,obj (macro-byte-kind)))
(##define-macro (macro-byte-output-port? obj)
`(macro-port-of-wkind? ,obj (macro-byte-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of device ports.
(define-check-type device-input-port 'device-input-port
macro-device-input-port?)
(define-check-type device-output-port 'device-output-port
macro-device-output-port?)
(define-type-of-byte-port device-port
id: b4fa842f-5da6-43b6-b447-d0b0348ae962
type-exhibitor: macro-type-device-port
constructor: macro-make-device-port
implementer: implement-type-device-port
macros:
prefix: macro-
opaque:
unprintable:
extender: define-type-of-device-port
rdevice-condvar ;; device condvar from which bytes are read
wdevice-condvar ;; device condvar to which bytes are written
name ;; name of device
)
(##define-macro (macro-device-input-port? obj)
`(macro-port-of-rkind? ,obj (macro-device-kind)))
(##define-macro (macro-device-output-port? obj)
`(macro-port-of-wkind? ,obj (macro-device-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of vector, string and u8vector ports.
(define-type-of-port vector-port
id: 2fb9e1fc-693b-455f-94a2-70c617a304d1
type-exhibitor: macro-type-vector-port
constructor: macro-make-vector-port
implementer: implement-type-vector-port
macros:
prefix: macro-
opaque:
unprintable:
extender: define-type-of-vector-port
rbuf
rlo
rhi
rbuf-fill
wbuf
wlo
whi
wbuf-drain
peer
fifo
rcondvar
wcondvar
buffering-limit
)
(define-check-type vector-input-port 'vector-input-port
macro-vector-input-port?)
(define-check-type vector-output-port 'vector-output-port
macro-vector-output-port?)
(##define-macro (macro-vector-input-port? obj)
`(macro-port-of-rkind? ,obj (macro-vector-kind)))
(##define-macro (macro-vector-output-port? obj)
`(macro-port-of-wkind? ,obj (macro-vector-kind)))
(define-type-of-character-port string-port
id: 81e73361-b03c-4889-9d02-e340e3309934
type-exhibitor: macro-type-string-port
constructor: macro-make-string-port
implementer: implement-type-string-port
macros:
prefix: macro-
opaque:
unprintable:
extender: define-type-of-string-port
peer
fifo
rcondvar
wcondvar
width
buffering-limit
)
(define-check-type string-input-port 'string-input-port
macro-string-input-port?)
(define-check-type string-output-port 'string-output-port
macro-string-output-port?)
(##define-macro (macro-string-input-port? obj)
`(macro-port-of-rkind? ,obj (macro-string-kind)))
(##define-macro (macro-string-output-port? obj)
`(macro-port-of-wkind? ,obj (macro-string-kind)))
(define-type-of-byte-port u8vector-port
id: 04c1b0ae-b11f-4815-b206-ce01648675bd
type-exhibitor: macro-type-u8vector-port
constructor: macro-make-u8vector-port
implementer: implement-type-u8vector-port
macros:
prefix: macro-
opaque:
unprintable:
extender: define-type-of-u8vector-port
peer
fifo
rcondvar
wcondvar
width
buffering-limit
)
(define-check-type u8vector-input-port 'u8vector-input-port
macro-u8vector-input-port?)
(define-check-type u8vector-output-port 'u8vector-output-port
macro-u8vector-output-port?)
(##define-macro (macro-u8vector-input-port? obj)
`(macro-port-of-rkind? ,obj (macro-u8vector-kind)))
(##define-macro (macro-u8vector-output-port? obj)
`(macro-port-of-wkind? ,obj (macro-u8vector-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of file device ports.
(define-check-type file-port 'file-port
macro-file-port?)
(##define-macro (macro-file-port? obj)
`(##port-of-kind? ,obj (macro-file-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of tty device ports.
(define-check-type tty-port 'tty-port
macro-tty-port?)
(##define-macro (macro-tty-port? obj)
`(##port-of-kind? ,obj (macro-tty-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of process device ports.
(define-check-type process-port 'process-port
macro-process-port?)
(##define-macro (macro-process-port? obj)
`(##port-of-kind? ,obj (macro-process-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of host-info objects.
(define-library-type host-info
id: e3dc833e-a176-42c1-bdc0-76a6c4b302f8
constructor: #f
opaque:
(name printable: read-only:)
(aliases printable: read-only:)
(addresses printable: read-only:)
)
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of service-info objects.
(define-library-type service-info
id: 177749b2-beb0-4670-9ab2-4b9c01b54c1d
constructor: #f
opaque:
(name printable: read-only:)
(aliases printable: read-only:)
(port-number printable: read-only:)
(protocol printable: read-only:)
)
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of protocol-info objects.
(define-library-type protocol-info
id: ffc668b5-2146-42b7-ab11-7d91641f2124
constructor: #f
opaque:
(name printable: read-only:)
(aliases printable: read-only:)
(number printable: read-only:)
)
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of network-info objects.
(define-library-type network-info
id: ce2e418b-96c7-4562-9cb6-419ec113704e
constructor: #f
opaque:
(name printable: read-only:)
(aliases printable: read-only:)
(number printable: read-only:)
)
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of socket-info objects.
(define-library-type socket-info
id: 837d9768-9d27-455e-ac65-5ae59f43f79e
constructor: #f
opaque:
(family printable: read-only:)
(port-number printable: read-only:)
(address printable: read-only:)
)
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of address-info objects.
(define-library-type address-info
id: f165f359-8685-48da-bc99-f38827ad8af9
constructor: #f
opaque:
(family printable: read-only:)
(socket-type printable: read-only:)
(protocol printable: read-only:)
(socket-info printable: read-only:)
)
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of TCP client device ports.
(define-check-type tcp-client-port 'tcp-client-port
macro-tcp-client-port?)
(##define-macro (macro-tcp-client-port? obj)
`(##port-of-kind? ,obj (macro-tcp-client-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of TCP server ports.
(define-type-of-port tcp-server-port
id: 42696abb-6729-4637-99de-cef7d3a230ae
type-exhibitor: macro-type-tcp-server-port
constructor: macro-make-tcp-server-port
implementer: implement-type-tcp-server-port
macros:
prefix: macro-
opaque:
unprintable:
extender: define-type-of-tcp-server-port
rdevice-condvar
client-psettings
)
(define-check-type tcp-server-port (macro-type-tcp-server-port)
macro-tcp-server-port?)
(##define-macro (macro-tcp-server-port? obj)
`(##port-of-kind? ,obj (macro-tcp-server-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of pipe device ports.
(define-check-type pipe-port 'pipe-port
macro-pipe-port?)
(##define-macro (macro-pipe-port? obj)
`(##port-of-kind? ,obj (macro-pipe-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of serial device ports.
(define-check-type serial-port 'serial-port
macro-serial-port?)
(##define-macro (macro-serial-port? obj)
`(##port-of-kind? ,obj (macro-serial-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of directory ports.
(define-type-of-port directory-port
id: deebf606-97e4-4d34-8fed-b9e5468851b9
type-exhibitor: macro-type-directory-port
constructor: macro-make-directory-port
implementer: implement-type-directory-port
macros:
prefix: macro-
opaque:
unprintable:
extender: define-type-of-directory-port
rdevice-condvar
path
)
(define-check-type directory-port 'directory-port
macro-directory-port?)
(##define-macro (macro-directory-port? obj)
`(##port-of-kind? ,obj (macro-directory-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of event queue ports.
(define-type-of-port event-queue-port
id: 59109ed7-6339-4c6e-8bc2-f52e9c91b9f5
type-exhibitor: macro-type-event-queue-port
constructor: macro-make-event-queue-port
implementer: implement-type-event-queue-port
macros:
prefix: macro-
opaque:
unprintable:
extender: define-type-of-event-queue-port
rdevice-condvar
index
)
(define-check-type event-queue-port 'event-queue-port
macro-event-queue-port?)
(##define-macro (macro-event-queue-port? obj)
`(##port-of-kind? ,obj (macro-event-queue-kind)))
;;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;;; Representation of timer ports.
(define-check-type timer-port 'timer-port
macro-timer-port?)
(##define-macro (macro-timer-port? obj)
`(##port-of-kind? ,obj (macro-timer-kind)))
;;;----------------------------------------------------------------------------
;;; Representation of port mutexes.
(##define-macro (macro-make-port-mutex)
`(##make-mutex #f))
(##define-macro (macro-port-mutex-lock! port)
`(macro-mutex-lock! (macro-port-mutex ,port) #f (macro-current-thread)))
(##define-macro (macro-port-mutex-unlock! port)
`(macro-mutex-unlock! (macro-port-mutex ,port)))
(##define-macro (macro-port-mutex-unlocked-not-abandoned-and-not-multiprocessor? port)
`(macro-mutex-unlocked-not-abandoned-and-not-multiprocessor? (macro-port-mutex ,port)))
;;;----------------------------------------------------------------------------
;;; Representation of port settings.
(define-type psettings
id: 0b02934e-7c23-4f9e-a629-0eede16e6987
type-exhibitor: macro-type-psettings
constructor: macro-make-psettings
implementer: implement-type-psettings
macros:
prefix: macro-
opaque:
unprintable:
direction
roptions
woptions
path
init
arguments
environment
directory
append
create
truncate
permissions
output-width
stdin-redir
stdout-redir
stderr-redir
pseudo-term
show-console
server-address
port-number
socket-type
coalesce
keep-alive
backlog
reuse-address
broadcast
ignore-hidden
)
(define-type psettings-options
id: edb28923-9aa0-4c55-9756-f1a37136f727
type-exhibitor: macro-type-psettings-options
constructor: macro-make-psettings-options
implementer: implement-type-psettings-options
macros:
prefix: macro-
opaque:
unprintable:
readtable
char-encoding
char-encoding-errors
eol-encoding
buffering
permanent-close
)
(##define-macro (macro-default-readtable) #f)
(##define-macro (macro-char-encoding-shift) 1)
(##define-macro (macro-char-encoding-range) 32)
(##define-macro (macro-default-char-encoding) 0)
(##define-macro (macro-char-encoding-ASCII) 1)
(##define-macro (macro-char-encoding-ISO-8859-1) 2)
(##define-macro (macro-char-encoding-UTF-8) 3)
(##define-macro (macro-char-encoding-UTF-16) 4)
(##define-macro (macro-char-encoding-UTF-16BE) 5)
(##define-macro (macro-char-encoding-UTF-16LE) 6)
(##define-macro (macro-char-encoding-UTF-fallback-ASCII) 7)
(##define-macro (macro-char-encoding-UTF-fallback-ISO-8859-1) 8)
(##define-macro (macro-char-encoding-UTF-fallback-UTF-8) 9)
(##define-macro (macro-char-encoding-UTF-fallback-UTF-16) 10)
(##define-macro (macro-char-encoding-UTF-fallback-UTF-16BE) 11)
(##define-macro (macro-char-encoding-UTF-fallback-UTF-16LE) 12)
(##define-macro (macro-char-encoding-UCS-2) 13)
(##define-macro (macro-char-encoding-UCS-2BE) 14)
(##define-macro (macro-char-encoding-UCS-2LE) 15)
(##define-macro (macro-char-encoding-UCS-4) 16)
(##define-macro (macro-char-encoding-UCS-4BE) 17)
(##define-macro (macro-char-encoding-UCS-4LE) 18)
(##define-macro (macro-char-encoding-wchar) 19)
(##define-macro (macro-char-encoding-native) 20)
(##define-macro (macro-char-encoding-UTF)
`(macro-char-encoding-UTF-fallback-UTF-8))
(##define-macro (macro-char-encoding-errors-shift) 32)
(##define-macro (macro-char-encoding-errors-range) 4)
(##define-macro (macro-default-char-encoding-errors) 0)
(##define-macro (macro-char-encoding-errors-on) 1)
(##define-macro (macro-char-encoding-errors-off) 2)
(##define-macro (macro-eol-encoding-shift) 128)
(##define-macro (macro-eol-encoding-range) 4)
(##define-macro (macro-default-eol-encoding) 0)
(##define-macro (macro-eol-encoding-lf) 1)
(##define-macro (macro-eol-encoding-cr) 2)
(##define-macro (macro-eol-encoding-crlf) 3)
(##define-macro (macro-buffering-shift) 512)
(##define-macro (macro-buffering-range) 4)
(##define-macro (macro-default-buffering) 0)
(##define-macro (macro-no-buffering) 1)
(##define-macro (macro-line-buffering) 2)
(##define-macro (macro-full-buffering) 3)
(##define-macro (macro-unbuffered? options)
`(##fixnum.< (##fixnum.bitwise-and ,options 2047) 1024))
(##define-macro (macro-fully-buffered? options)
`(##not (##fixnum.< (##fixnum.bitwise-and ,options 2047) 1536)))
(##define-macro (macro-decode-state-shift) 2048)
(##define-macro (macro-decode-state-range) 4)
(##define-macro (macro-decode-state-none) 0)
(##define-macro (macro-decode-state-lf) 1)
(##define-macro (macro-decode-state-cr) 2)
(##define-macro (macro-open-state-shift) 8192)
(##define-macro (macro-open-state-range) 2)
(##define-macro (macro-open-state-open) 0)
(##define-macro (macro-open-state-closed) 1)
(##define-macro (macro-closed? options)
`(##not (##fixnum.= (##fixnum.bitwise-and ,options 8192) 0)))
(##define-macro (macro-close! options)
`(##fixnum.bitwise-ior ,options 8192))
(##define-macro (macro-unclose! options)
`(##fixnum.bitwise-and ,options -8193))
(##define-macro (macro-permanent-close-shift) 16384)
(##define-macro (macro-permanent-close-range) 2)
(##define-macro (macro-permanent-close-no) 0)
(##define-macro (macro-permanent-close-yes) 1)
(##define-macro (macro-perm-close? options)
`(##not (##fixnum.= (##fixnum.bitwise-and ,options 16384) 0)))
(##define-macro (macro-direction-shift) 16)
(##define-macro (macro-direction-in) 1)
(##define-macro (macro-direction-out) 2)
(##define-macro (macro-direction-inout) 3)
(##define-macro (macro-default-path) #f)
(##define-macro (macro-default-init) #f)
(##define-macro (macro-default-arguments) ''())
(##define-macro (macro-default-environment) #f)
(##define-macro (macro-default-directory) #f)
(##define-macro (macro-append-shift) 8)
(##define-macro (macro-no-append) 0)
(##define-macro (macro-append) 1)
(##define-macro (macro-default-append) 2)
(##define-macro (macro-create-shift) 2)
(##define-macro (macro-no-create) 0)
(##define-macro (macro-maybe-create) 1)
(##define-macro (macro-create) 2)
(##define-macro (macro-default-create) 3)
(##define-macro (macro-truncate-shift) 1)
(##define-macro (macro-no-truncate) 0)
(##define-macro (macro-truncate) 1)
(##define-macro (macro-default-truncate) 2)
(##define-macro (macro-default-permissions) -1)
(##define-macro (macro-default-output-width) -1)
(##define-macro (macro-permanent-close) 1)
(##define-macro (macro-no-permanent-close) 0)
(##define-macro (macro-default-permanent-close) `(macro-permanent-close))
(##define-macro (macro-stdin-from-port) 1)
(##define-macro (macro-stdin-unchanged) 0)
(##define-macro (macro-default-stdin-redir) `(macro-stdin-from-port))
(##define-macro (macro-stdout-to-port) 1)
(##define-macro (macro-stdout-unchanged) 0)
(##define-macro (macro-default-stdout-redir) `(macro-stdout-to-port))
(##define-macro (macro-stderr-to-port) 1)
(##define-macro (macro-stderr-unchanged) 0)
(##define-macro (macro-default-stderr-redir) `(macro-stderr-unchanged))
(##define-macro (macro-pseudo-term) 1)
(##define-macro (macro-no-pseudo-term) 0)
(##define-macro (macro-default-pseudo-term) `(macro-no-pseudo-term))
(##define-macro (macro-show-console) 1)
(##define-macro (macro-no-show-console) 0)
(##define-macro (macro-default-show-console) `(macro-show-console))
(##define-macro (macro-default-server-address) `'#u8(127 0 0 1))
(##define-macro (macro-default-port-number) #f)
(##define-macro (macro-socket-type-TCP) 0)
(##define-macro (macro-socket-type-UDP) 1)
(##define-macro (macro-socket-type-RAW) 2)
(##define-macro (macro-default-socket-type) `(macro-socket-type-TCP))
(##define-macro (macro-coalesce) 1)
(##define-macro (macro-no-coalesce) 0)
(##define-macro (macro-default-coalesce) `(macro-coalesce))
(##define-macro (macro-keep-alive) 1)
(##define-macro (macro-no-keep-alive) 0)
(##define-macro (macro-default-keep-alive) `(macro-no-keep-alive))
(##define-macro (macro-broadcast) 1)
(##define-macro (macro-no-broadcast) 0)
(##define-macro (macro-default-broadcast) `(macro-no-broadcast))
(##define-macro (macro-default-backlog) 128)
(##define-macro (macro-reuse-address) 1)
(##define-macro (macro-no-reuse-address) 0)
(##define-macro (macro-default-reuse-address) `(macro-reuse-address))
(##define-macro (macro-ignore-hidden) 2)
(##define-macro (macro-ignore-dot-and-dot-dot) 1)
(##define-macro (macro-ignore-nothing) 0)
(##define-macro (macro-default-ignore-hidden) `(macro-ignore-hidden))
;;;----------------------------------------------------------------------------
;;; Representation of write environments.
;; A writeenv structure maintains the "write environment" throughout
;; the writing of a Scheme datum. It includes the write style
;; (display, write, pretty-print, mark), the port on which to write,
;; the readtable, the marktable (for detecting cycles), the force flag,
;; the pretty-print width, the number of closing parentheses to follow
;; the datum, the current nesting level, and the character count limit.
(define-type writeenv
id: f5cfcf78-bba4-4140-9aa0-1a136c50d36b
type-exhibitor: macro-type-writeenv
constructor: macro-make-writeenv
implementer: implement-type-writeenv
macros:
prefix: macro-
opaque:
unprintable:
style
port
readtable
marktable
force?
width
shift
close-parens
level
limit
)
;;;----------------------------------------------------------------------------
;;; Representation of read environments.
;; A readenv structure maintains the "read environment" throughout the
;; reading of a Scheme datum. It includes the port from which to read,
;; the readtable, the wrap and unwrap procedures, the table of labels
;; (i.e. "#n#"), and the position where the currently being read datum
;; started.
(define-type readenv
id: edd21ef2-ee48-407f-a9a9-c1c361078e55
type-exhibitor: macro-type-readenv
constructor: macro-make-readenv
implementer: implement-type-readenv
macros:
prefix: macro-
opaque:
unprintable:
port
readtable
wrapper
unwrapper
allow-script?
labels
container
filepos
)
(##define-macro (macro-readenv-wrap re x)
`(let ((re ,re)
(x ,x))
((macro-readenv-wrapper re) re x)))
(##define-macro (macro-readenv-unwrap re x)
`(let ((re ,re)
(x ,x))
((macro-readenv-unwrapper re) re x)))
;;;----------------------------------------------------------------------------
;;; Generic char port procedures.
(##define-macro (macro-peek-char port)
`(let ((port ,port))
(##declare (not interrupts-enabled))
;; try to get exclusive access to port and if successful perform
;; operation inline
(if (macro-port-mutex-unlocked-not-abandoned-and-not-multiprocessor? port)
(let ((char-rlo (macro-character-port-rlo port))
(char-rhi (macro-character-port-rhi port)))
(if (##fixnum.< char-rlo char-rhi)
;; the next character is in the character read buffer
(##string-ref (macro-character-port-rbuf port) char-rlo)
;; more characters are needed, do this out-of-line
(let ()
(##declare (interrupts-enabled))
(##peek-char port))))
;; couldn't easily get exclusive access to port, handle this out-of-line
(let ()
(##declare (interrupts-enabled))
(##peek-char port)))))
(##define-macro (macro-read-char port)
`(let ((port ,port))
(##declare (not interrupts-enabled))
;; try to get exclusive access to port and if successful perform
;; operation inline
(if (macro-port-mutex-unlocked-not-abandoned-and-not-multiprocessor? port)
(let ((char-rlo (macro-character-port-rlo port))
(char-rhi (macro-character-port-rhi port)))
(if (##fixnum.< char-rlo char-rhi)
;; the next character is in the character read buffer
(let ((c (##string-ref (macro-character-port-rbuf port) char-rlo)))
(if (##not (##char=? c #\newline))
;; frequent simple case, just advance rlo
(begin
(macro-character-port-rlo-set! port (##fixnum.+ char-rlo 1))
c)
;; end-of-line processing is complex, so do it out-of-line
(let ()
(##declare (interrupts-enabled))
(##read-char port))))
;; more characters are needed, do this out-of-line
(let ()
(##declare (interrupts-enabled))
(##read-char port))))
;; couldn't easily get exclusive access to port, handle this out-of-line
(let ()
(##declare (interrupts-enabled))
(##read-char port)))))
(##define-macro (macro-write-char c port)
`(let ((c ,c)
(port ,port))
(##declare (not interrupts-enabled))
;; try to get exclusive access to port and if successful perform
;; operation inline
(if (and (##not (##char=? c #\newline))
(macro-port-mutex-unlocked-not-abandoned-and-not-multiprocessor? port))
(let ((char-wbuf (macro-character-port-wbuf port))
(char-whi+1 (##fixnum.+ (macro-character-port-whi port) 1)))
(if (##fixnum.< char-whi+1 (##string-length char-wbuf))
;; adding this character would not make the character write
;; buffer full, so add character and increment whi
(begin
(##string-set! char-wbuf (##fixnum.- char-whi+1 1) c)
(macro-character-port-whi-set! port char-whi+1)
(##void))
;; the character write buffer would become full, so handle
;; this out-of-line
(let ()
(##declare (interrupts-enabled))
(##write-char c port))))
;; end-of-line processing is needed or exclusive access to port
;; cannot be obtained easily, so handle this out-of-line
(let ()
(##declare (interrupts-enabled))
(##write-char c port)))))
;;;----------------------------------------------------------------------------
;;; Representation of readtables.
(define-type readtable
id: bebee95d-0da2-401d-a33a-c1afc75b9e43
type-exhibitor: macro-type-readtable
constructor: macro-make-readtable
implementer: implement-type-readtable
macros:
prefix: macro-
opaque:
(case-conversion? unprintable: read-write:)
(keywords-allowed? unprintable: read-write:)
(escaped-char-table unprintable: read-write:)
(named-char-table unprintable: read-write:)
(sharp-bang-table unprintable: read-write:)
(char-delimiter?-table unprintable: read-write:)
(char-handler-table unprintable: read-write:)
(char-sharp-handler-table unprintable: read-write:)
(max-unescaped-char unprintable: read-write:)
(escape-ctrl-chars? unprintable: read-write:)
(sharing-allowed? unprintable: read-write:)
(eval-allowed? unprintable: read-write:)
(write-extended-read-macros? unprintable: read-write:)
(write-cdr-read-macros? unprintable: read-write:)
(max-write-level unprintable: read-write:)
(max-write-length unprintable: read-write:)
(pretty-print-formats unprintable: read-write:)
(quote-keyword unprintable: read-write:)
(quasiquote-keyword unprintable: read-write:)
(unquote-keyword unprintable: read-write:)
(unquote-splicing-keyword unprintable: read-write:)
(sharp-quote-keyword unprintable: read-write:)
(sharp-quasiquote-keyword unprintable: read-write:)
(sharp-unquote-keyword unprintable: read-write:)
(sharp-unquote-splicing-keyword unprintable: read-write:)
(sharp-num-keyword unprintable: read-write:)
(sharp-seq-keyword unprintable: read-write:)
(paren-keyword unprintable: read-write:)
(bracket-keyword unprintable: read-write:)
(brace-keyword unprintable: read-write:)
(angle-keyword unprintable: read-write:)
(start-syntax unprintable: read-write:)
(six-type? unprintable: read-write:)
(r6rs-compatible-read? unprintable: read-write:)
(r6rs-compatible-write? unprintable: read-write:)
(here-strings-allowed? unprintable: read-write:)
(comment-handler unprintable: read-write:)
)
(define-check-type readtable (macro-type-readtable)
macro-readtable?)
;;;----------------------------------------------------------------------------
;;; Representation of language specs.
(##define-macro (macro-language-name x) `(##vector-ref ,x 0))
(##define-macro (macro-language-case-conversion? x) `(##vector-ref ,x 1))
(##define-macro (macro-language-keywords-allowed? x) `(##vector-ref ,x 2))
(##define-macro (macro-language-start-syntax x) `(##vector-ref ,x 3))
(##define-macro (macro-language-srfi-22? x) `(##vector-ref ,x 4))
;;;============================================================================
Jump to Line
Something went wrong with that request. Please try again.