1017 lines
24 KiB
Scheme
1017 lines
24 KiB
Scheme
;;; The packages that scsh uses/defines.
|
|
;;; Copyright (c) 1994 by Olin Shivers.
|
|
|
|
;;; You link up a scsh package by defining a package named OS-DEPENDENT
|
|
;;; that satisfies the interfaces for packages
|
|
;;; buffered-io-flags
|
|
;;; posix-fdflags
|
|
;;; posix-errno
|
|
;;; posix-signals
|
|
;;; Anything else it provides should be specified in an interface called
|
|
;;; os-extras-interface. See the scsh structure below.
|
|
;;; Then the scsh structure can be instantiated.
|
|
;;;
|
|
;;; The architecture directories, like next/ and irix/ and so forth,
|
|
;;; provide packages that can serve as the os-dependent package. E.g.,
|
|
;;; the next-defs package, defined in next/packages.
|
|
;;;
|
|
;;; This whole mechanism would be better solved with a functor.
|
|
;;; -Olin
|
|
|
|
|
|
(define-structure error-package (export error warn)
|
|
(open signals)
|
|
; (optimize auto-integrate)
|
|
)
|
|
|
|
|
|
(define-structure scsh-utilities scsh-utilities-interface
|
|
(open bitwise error-package loopholes let-opt scheme define-record-types
|
|
records
|
|
threads threads-internal placeholders locks srfi-1)
|
|
(files utilities)
|
|
; (optimize auto-integrate)
|
|
)
|
|
|
|
(define-structure scsh-resources scsh-resources-interface
|
|
(open scheme
|
|
define-record-types
|
|
handle
|
|
locks
|
|
sort)
|
|
(files resource))
|
|
|
|
(define-structure weak-tables weak-tables-interface
|
|
(open scheme
|
|
weak
|
|
tables)
|
|
(files weaktables))
|
|
|
|
(define-structure string-collectors string-collectors-interface
|
|
(open scheme
|
|
defrec-package)
|
|
(files stringcoll))
|
|
|
|
(define-structure delimited-readers delimited-readers-interface
|
|
(open scheme
|
|
byte-vectors
|
|
signals ; ERROR
|
|
let-opt
|
|
receiving
|
|
re-level-0 rx-syntax
|
|
(subset srfi-14 (char-set x->char-set char-set-contains?))
|
|
ascii
|
|
i/o-internal ports)
|
|
(files rdelim))
|
|
|
|
(define list-lib srfi-1)
|
|
(define string-lib srfi-13)
|
|
(define char-set-lib srfi-14)
|
|
|
|
|
|
;;; This guy goes into the FOR-SYNTAX part of scsh's syntax exports.
|
|
(define-structure scsh-syntax-helpers
|
|
(export transcribe-extended-process-form)
|
|
(open receiving ; receive
|
|
error-package
|
|
names ; generated? by JMG
|
|
(subset scsh-utilities (check-arg))
|
|
scheme
|
|
)
|
|
(files syntax-helpers)
|
|
; (optimize auto-integrate)
|
|
)
|
|
|
|
|
|
;;; The bufpol/{block, line, none} values
|
|
(define-structure buffered-io-flags buffered-io-flags-interface
|
|
(open defenum-package scheme)
|
|
(files (machine bufpol))
|
|
; (optimize auto-integrate)
|
|
)
|
|
|
|
|
|
|
|
(define-structures ((tty-flags tty-flags-interface)
|
|
(scsh-internal-tty-flags scsh-internal-tty-flags-interface))
|
|
(open scheme ascii bitwise)
|
|
(files (machine tty-consts))
|
|
; (optimize auto-integrate)
|
|
)
|
|
|
|
(define-structure scsh-continuations scsh-continuations-interface
|
|
(open scheme
|
|
escapes)
|
|
(files continuation))
|
|
|
|
(define-structure scsh-import-os-error-syscalls scsh-import-os-error-syscalls-interface
|
|
(open scheme
|
|
handle conditions
|
|
external-calls
|
|
(subset os-dependent (errno/intr))
|
|
(subset scsh-errors (errno-error))
|
|
scsh-continuations)
|
|
(files import-os-error-syscall))
|
|
|
|
(define-structure scsh-file-syscalls scsh-file-syscalls-interface
|
|
(open scheme
|
|
scsh-import-os-error-syscalls)
|
|
(files file-syscalls))
|
|
|
|
(define-structure scsh-version scsh-version-interface
|
|
(open scheme)
|
|
(files scsh-version))
|
|
|
|
(define-structure scsh-errors scsh-errors-interface
|
|
(open scheme
|
|
architecture
|
|
(subset srfi-1 (last drop-right))
|
|
handle conditions signals)
|
|
(files scsh-condition))
|
|
|
|
(define-structure scsh-environments scsh-environments-interface
|
|
(open scheme
|
|
locks thread-fluids
|
|
(subset primitives (add-finalizer!))
|
|
defrec-package records
|
|
(subset signals (error))
|
|
(subset srfi-1 (fold filter))
|
|
(subset srfi-13 (string-index string-join))
|
|
(subset scsh-utilities
|
|
(with-lock make-reinitializer define-simple-syntax))
|
|
shared-bindings
|
|
scsh-import-os-error-syscalls
|
|
scsh-resources)
|
|
(files environment))
|
|
|
|
(define-structure scsh-file-names scsh-file-names-interface
|
|
(open scheme
|
|
receiving
|
|
let-opt
|
|
signals
|
|
(subset srfi-1 (reverse!))
|
|
(subset srfi-13 (string-index string-index-right)))
|
|
(files fname))
|
|
|
|
(define-structure scsh-directories scsh-directories-interface
|
|
(open scheme
|
|
structure-refs
|
|
(subset primitives (add-finalizer!))
|
|
(subset srfi-1 (filter))
|
|
(subset srfi-13 (string<=))
|
|
(subset scsh-utilities (check-arg))
|
|
defrec-package records
|
|
let-opt
|
|
(subset scsh-file-syscalls (%open-dir))
|
|
scsh-import-os-error-syscalls
|
|
scsh-file-names
|
|
scsh-resources
|
|
scsh-process-state)
|
|
(access sort)
|
|
(files directory))
|
|
|
|
(define-structure scsh-user/group-db scsh-user/group-db-interface
|
|
(open scheme
|
|
defrec-package
|
|
receiving
|
|
handle (subset signals (error))
|
|
scsh-import-os-error-syscalls
|
|
scsh-file-names
|
|
scsh-environments)
|
|
(files user-group))
|
|
|
|
(define-structure scsh-process-state scsh-process-state-interface
|
|
(open scheme
|
|
receiving
|
|
let-opt
|
|
locks thread-fluids
|
|
(subset channels (set-with-fs-context-aligned*!))
|
|
(subset signals (error))
|
|
(subset scsh-utilities (with-lock make-reinitializer define-simple-syntax))
|
|
scsh-resources
|
|
scsh-file-names
|
|
scsh-user/group-db
|
|
scsh-import-os-error-syscalls)
|
|
(files process-state))
|
|
|
|
(define-structure scsh-time scsh-time-interface
|
|
(open scheme
|
|
receiving
|
|
let-opt
|
|
formats
|
|
bitwise
|
|
signals
|
|
external-calls
|
|
defrec-package
|
|
(subset scsh-utilities (check-arg real->exact-integer))
|
|
scsh-import-os-error-syscalls)
|
|
(files time
|
|
(machine time_dep)))
|
|
|
|
(define-structure scsh-signal-handlers signal-handler-interface
|
|
(open scheme
|
|
external-calls
|
|
signals
|
|
enumerated
|
|
threads
|
|
interrupts low-interrupt
|
|
structure-refs
|
|
(subset scsh-utilities (define-simple-syntax run-as-long-as))
|
|
(subset os-dependent (signals-ignored-by-default signal/alrm)))
|
|
(access threads-internal sigevents)
|
|
(files sighandlers))
|
|
|
|
(define-structure scsh-newports scsh-newports-interface
|
|
(open (modify scheme (hide call-with-input-file
|
|
call-with-output-file
|
|
with-input-from-file
|
|
with-output-to-file
|
|
open-input-file
|
|
open-output-file))
|
|
structure-refs
|
|
defrec-package define-record-types
|
|
bitwise
|
|
ascii
|
|
tables weak-tables
|
|
enumerated
|
|
byte-vectors
|
|
fluids
|
|
placeholders
|
|
receiving
|
|
let-opt
|
|
i/o i/o-internal channels channel-i/o low-channels ports
|
|
(subset architecture (channel-status-option))
|
|
(subset primitives (add-pending-channel copy-bytes!))
|
|
extended-ports
|
|
scsh-utilities os-dependent buffered-io-flags
|
|
signals
|
|
threads
|
|
(subset srfi-1 (any filter))
|
|
scsh-file-syscalls
|
|
scsh-resources
|
|
scsh-process-state)
|
|
(access scheme
|
|
formats
|
|
i/o
|
|
threads-internal
|
|
interrupts)
|
|
(files newports))
|
|
|
|
(define-structure scsh-file scsh-file-interface
|
|
(open scheme
|
|
bitwise
|
|
defrec-package
|
|
let-opt
|
|
i/o
|
|
(subset scsh-utilities (define-simple-syntax deprecated-proc real->exact-integer))
|
|
os-dependent
|
|
scsh-errors
|
|
scsh-file-syscalls
|
|
scsh-file-names
|
|
scsh-process-state
|
|
delimited-readers
|
|
scsh-newports)
|
|
(files fileinfo
|
|
file
|
|
filesys))
|
|
|
|
(define-structure scsh-temp-files scsh-temp-files-interface
|
|
(open scheme
|
|
receiving
|
|
let-opt
|
|
bitwise
|
|
formats
|
|
os-dependent
|
|
fluids
|
|
(subset scsh-utilities (make-reinitializer))
|
|
scsh-errors
|
|
scsh-environments
|
|
scsh-process-state
|
|
scsh-file
|
|
scsh-newports)
|
|
(files temp-file))
|
|
|
|
(define-structure scsh-globbing scsh-globbing-interface
|
|
(open scheme
|
|
ascii
|
|
receiving
|
|
(subset srfi-1 (filter fold))
|
|
srfi-14
|
|
re-level-0
|
|
scsh-errors
|
|
scsh-file-names
|
|
scsh-file
|
|
scsh-directories)
|
|
(files glob))
|
|
|
|
(define-structure scsh-file-matching scsh-file-matching-interface
|
|
(open scheme
|
|
re-level-0
|
|
signals handle conditions
|
|
(subset srfi-1 (filter))
|
|
(subset srfi-13 (string-index-right))
|
|
scsh-file-names
|
|
scsh-globbing)
|
|
(files filemtch))
|
|
|
|
(define-structure scsh-fcntl scsh-fcntl-interface
|
|
(open scheme
|
|
scsh-file-syscalls
|
|
scsh-newports
|
|
(subset os-dependent (export fcntl/get-fdes-flags
|
|
fcntl/set-fdes-flags
|
|
fcntl/get-status-flags
|
|
fcntl/set-status-flags)))
|
|
(files fcntl))
|
|
|
|
(define-structure scsh-read/write scsh-read/write-interface
|
|
(open scheme
|
|
bitwise
|
|
(subset primitives (copy-bytes!))
|
|
let-opt
|
|
signals
|
|
scsh-newports
|
|
scsh-fcntl
|
|
buffered-io-flags
|
|
(subset scsh-utilities (bogus-substring-spec?))
|
|
(subset i/o (read-block write-block))
|
|
(subset i/o-internal (open-input-port?))
|
|
(subset os-dependent (open/non-blocking)))
|
|
(files rw))
|
|
|
|
(define-structure scsh-process-objects scsh-process-objects-interface
|
|
(open scheme
|
|
receiving
|
|
threads
|
|
locks placeholders
|
|
signals
|
|
bitwise
|
|
tables weak-tables
|
|
weak
|
|
let-opt
|
|
structure-refs
|
|
defrec-package
|
|
(subset primitives (add-finalizer!))
|
|
(subset srfi-1 (delete filter))
|
|
(subset scsh-utilities (make-reinitializer
|
|
with-lock run-as-long-as))
|
|
low-interrupt
|
|
(subset os-dependent (errno/child))
|
|
scsh-import-os-error-syscalls
|
|
scsh-file-names
|
|
scsh-errors)
|
|
(access sigevents
|
|
threads-internal)
|
|
(files procobj
|
|
(machine waitcodes)))
|
|
|
|
(define-structure scsh-fdports scsh-fdports-interface
|
|
(open scheme
|
|
signals
|
|
bitwise
|
|
(subset scsh-utilities (check-arg stringify))
|
|
os-dependent
|
|
scsh-file-syscalls
|
|
scsh-fcntl
|
|
scsh-newports)
|
|
(files fdports))
|
|
|
|
(define-structure scsh-signals scsh-signals-interface
|
|
(open scheme
|
|
signals
|
|
structure-refs
|
|
scsh-import-os-error-syscalls
|
|
scsh-process-objects)
|
|
(access sigevents)
|
|
(files signal))
|
|
|
|
(define-structure scsh-processes scsh-processes-interface
|
|
(open scheme
|
|
receiving
|
|
signals
|
|
i/o
|
|
let-opt
|
|
threads thread-fluids
|
|
structure-refs
|
|
(subset srfi-13 (string-index))
|
|
(subset command-levels (session-started? set-batch-mode?!))
|
|
(subset scsh-utilities (mapv! stringify))
|
|
scsh-import-os-error-syscalls
|
|
(subset scsh-environments (alist->env-vec))
|
|
scsh-continuations
|
|
scsh-resources
|
|
scsh-environments
|
|
scsh-process-state
|
|
scsh-process-objects
|
|
scsh-file-names
|
|
scsh-newports
|
|
scsh-file
|
|
scsh-fdports
|
|
exit-hooks
|
|
scsh-signals
|
|
scsh-time
|
|
(subset os-dependent (signal/stop)))
|
|
(access interrupts)
|
|
(files process))
|
|
|
|
(define-structure scsh-ttys tty-interface
|
|
(open scheme
|
|
ascii
|
|
i/o
|
|
signals
|
|
bitwise
|
|
let-opt
|
|
defrec-package
|
|
tty-flags scsh-internal-tty-flags
|
|
scsh-import-os-error-syscalls
|
|
scsh-newports
|
|
(subset os-dependent (open/read+write open/access-mask open/read))
|
|
scsh-process-objects)
|
|
(files tty))
|
|
|
|
(define-structure scsh-stdio scsh-stdio-interface
|
|
(open scheme
|
|
(subset i/o (current-error-port))
|
|
(subset scsh-utilities (define-simple-syntax))
|
|
scsh-fdports
|
|
scsh-newports)
|
|
(files stdio))
|
|
|
|
(define-structure scsh-ptys scsh-ptys-interface
|
|
(open scheme
|
|
receiving
|
|
scsh-processes
|
|
scsh-fdports
|
|
scsh-errors
|
|
scsh-newports
|
|
scsh-stdio
|
|
scsh-ttys
|
|
scsh-process-state
|
|
(subset os-dependent (open/read+write)))
|
|
(files pty))
|
|
|
|
(define-structure scsh-flock scsh-flock-interface
|
|
(open scheme
|
|
signals
|
|
let-opt
|
|
threads
|
|
defrec-package
|
|
scsh-import-os-error-syscalls
|
|
os-dependent
|
|
(subset scsh-utilities (check-arg deprecated-proc))
|
|
scsh-errors
|
|
(subset scsh-newports (seek/set))
|
|
scsh-process-objects)
|
|
(files flock))
|
|
|
|
(define-structure scsh-crypt crypt-interface
|
|
(open scheme
|
|
signals
|
|
re-level-0 rx-syntax
|
|
scsh-import-os-error-syscalls)
|
|
(files crypt))
|
|
|
|
(define-structure scsh-system (compound-interface uname-interface
|
|
(export system-name) ; ####
|
|
)
|
|
(open scheme
|
|
defrec-package
|
|
shared-bindings
|
|
scsh-import-os-error-syscalls)
|
|
(files system))
|
|
|
|
(define-structure scsh-networking (compound-interface sockets-network-interface
|
|
scsh-sockets-interface)
|
|
(open scheme
|
|
structure-refs
|
|
receiving
|
|
let-opt
|
|
handle signals
|
|
external-calls shared-bindings
|
|
defrec-package
|
|
channel-i/o ports
|
|
(subset scsh-utilities (bogus-substring-spec?))
|
|
scsh-import-os-error-syscalls
|
|
scsh-errors
|
|
scsh-fdports
|
|
scsh-newports
|
|
scsh-fcntl
|
|
os-dependent)
|
|
(access interrupts)
|
|
(files network))
|
|
|
|
(define-structure scsh-file-names-system scsh-file-names-system-interface
|
|
(open scheme
|
|
signals
|
|
let-opt
|
|
(subset srfi-1 (reverse!))
|
|
(subset srfi-13 (string-index))
|
|
scsh-file-names
|
|
scsh-environments
|
|
scsh-user/group-db
|
|
scsh-process-state)
|
|
(files fname-system))
|
|
|
|
(define-structure scsh-collect-ports scsh-collect-ports-interface
|
|
(open scheme
|
|
let-opt
|
|
(subset scsh-utilities (deprecated-proc))
|
|
(subset srfi-1 (reverse!))
|
|
scsh-read/write
|
|
delimited-readers
|
|
string-collectors)
|
|
(files port-collect))
|
|
|
|
(define-structure scsh-high-level-processes scsh-high-level-process-interface
|
|
(for-syntax (open scsh-syntax-helpers scheme))
|
|
(open scheme
|
|
signals
|
|
receiving
|
|
let-opt
|
|
(subset scsh-utilities (define-simple-syntax))
|
|
(subset srfi-1 (fold))
|
|
scsh-temp-files
|
|
scsh-processes scsh-process-objects
|
|
scsh-stdio
|
|
scsh-newports
|
|
scsh-fdports
|
|
scsh-collect-ports)
|
|
(files syntax
|
|
process-high-level))
|
|
|
|
(define-structure scsh-command-line scsh-command-line-interface
|
|
(open scheme
|
|
signals)
|
|
(files command-line))
|
|
|
|
;;; The scsh-level-0 package is for implementation convenience.
|
|
;;; The scsh startup and top-level modules need access to scsh
|
|
;;; procedures, but they export procedures that are themselves
|
|
;;; part of scsh. So scsh-level-0 is the core scsh stuff, which is
|
|
;;; imported by these two modules. These modules all collectively
|
|
;;; export the whole scsh enchilada.
|
|
|
|
(define-structures
|
|
((scsh-level-0
|
|
(compound-interface posix-fdflags-interface
|
|
posix-errno-interface
|
|
posix-signals-interface
|
|
sockets-network-interface ; Standard Network Interface
|
|
os-extras-interface ; Extra stuff from OS.
|
|
scsh-delimited-readers-interface
|
|
scsh-errors-interface
|
|
scsh-io-interface
|
|
scsh-file-interface
|
|
scsh-fcntl-interface
|
|
scsh-read/write-interface
|
|
scsh-globbing-interface
|
|
scsh-file-matching-interface
|
|
scsh-temp-files-interface
|
|
scsh-directories-interface
|
|
scsh-process-state-interface
|
|
scsh-process-objects-interface
|
|
scsh-processes-interface
|
|
scsh-user/group-db-interface
|
|
scsh-command-line-interface
|
|
scsh-signals-interface
|
|
scsh-environments-interface
|
|
scsh-file-names-interface
|
|
scsh-misc-interface
|
|
scsh-high-level-process-interface
|
|
scsh-time-interface ; new in 0.2
|
|
scsh-sockets-interface ; new in 0.3
|
|
tty-interface ; new in 0.4
|
|
scsh-version-interface
|
|
(interface-of srfi-14) ;; export this here for
|
|
(export ->char-set) ;; this kludge
|
|
(export system-name) ; #### has nowhere else to go for now
|
|
scsh-file-names-system-interface
|
|
signal-handler-interface
|
|
;; This stuff would probably be better off kept
|
|
;; in separate modules, but we'll toss it in for now.
|
|
(interface-of ascii) ; char<->ascii
|
|
string-ports-interface
|
|
syslog-interface
|
|
crypt-interface
|
|
uname-interface
|
|
))
|
|
(scsh-level-0-internals (export set-command-line-args!
|
|
init-home-directory
|
|
init-exec-path-list))
|
|
; (scsh-regexp-package scsh-regexp-interface)
|
|
)
|
|
(for-syntax (open scsh-syntax-helpers scheme))
|
|
(access rts-sigevents sigevents threads)
|
|
(open enumerated
|
|
defenum-package
|
|
receiving
|
|
defrec-package
|
|
formats
|
|
string-collectors
|
|
delimited-readers
|
|
os-dependent ; OS dependent stuff
|
|
buffered-io-flags ; stdio dependent
|
|
ascii
|
|
records
|
|
extended-ports
|
|
ports
|
|
build
|
|
bigbit
|
|
bitwise
|
|
signals
|
|
|
|
srfi-14
|
|
|
|
scsh-version
|
|
tty-flags
|
|
|
|
scsh-continuations
|
|
scsh-import-os-error-syscalls
|
|
scsh-file-syscalls
|
|
scsh-resources
|
|
scsh-environments
|
|
scsh-file-names
|
|
scsh-directories
|
|
scsh-user/group-db
|
|
scsh-process-state
|
|
scsh-time
|
|
scsh-signal-handlers
|
|
scsh-newports
|
|
scsh-file
|
|
scsh-read/write
|
|
scsh-fcntl
|
|
scsh-temp-files
|
|
scsh-globbing
|
|
scsh-file-matching
|
|
scsh-process-objects
|
|
scsh-processes
|
|
scsh-fdports
|
|
scsh-signals
|
|
scsh-ttys
|
|
scsh-stdio
|
|
scsh-ptys
|
|
scsh-flock
|
|
scsh-crypt
|
|
scsh-system
|
|
scsh-networking
|
|
scsh-file-names-system
|
|
scsh-high-level-processes
|
|
scsh-collect-ports
|
|
scsh-command-line
|
|
|
|
syslog
|
|
|
|
re-level-0
|
|
rx-syntax
|
|
|
|
srfi-13
|
|
|
|
(subset scheme (define
|
|
input-port? output-port?))
|
|
|
|
(subset i/o (current-error-port))
|
|
|
|
scsh-errors)
|
|
(begin
|
|
;; work around for SRFI 14 naming fuckage
|
|
(define ->char-set x->char-set))
|
|
)
|
|
|
|
(define-structure defrec-package (export (define-record :syntax))
|
|
(open records scheme)
|
|
(for-syntax (open scheme error-package receiving))
|
|
(files defrec)
|
|
; (optimize auto-integrate)
|
|
)
|
|
|
|
(define-structure defenum-package (export (define-enum-constant :syntax)
|
|
(define-enum-constants :syntax)
|
|
(define-enum-constants-from-zero
|
|
:syntax))
|
|
(open scheme)
|
|
(files enumconst)
|
|
; (optimize auto-integrate)
|
|
)
|
|
|
|
;;; This code opens so many modules of gruesome, low-level S48 internals
|
|
;;; that these two modules are segregated into separate packages, each
|
|
;;; exporting just two definitions.
|
|
|
|
(define-structure scsh-startup-package (export dump-scsh-program
|
|
dump-scsh
|
|
make-scsh-starter
|
|
scsh-stand-alone-resumer)
|
|
(open scsh-level-0-internals ; init-scsh-* set-command-line-args!
|
|
(subset scsh-level-0 (init-fdports!
|
|
error-output-port current-error-port
|
|
command-line command-line-arguments))
|
|
scsh-top-package ; parse-switches-and-execute
|
|
handle ; with-handler
|
|
command-levels ; user-context
|
|
write-images ; write-image
|
|
build-internals ; simple-condition-handler
|
|
low-level ; flush-the-symbol-table!
|
|
command-processor ; command-output
|
|
package-commands-internal
|
|
filenames ; translate
|
|
usual-resumer ; usual-resumer
|
|
environments ; with-interaction-environment
|
|
fluids-internal ; JMG: get-dynamic-env
|
|
threads threads-internal queues scheduler
|
|
structure-refs
|
|
scsh-utilities
|
|
interrupts
|
|
low-interrupt
|
|
sigevents
|
|
primitives
|
|
(modify scheme (hide call-with-input-file
|
|
call-with-output-file
|
|
with-input-from-file
|
|
with-output-to-file
|
|
open-input-file
|
|
open-output-file)))
|
|
(access threads-internal)
|
|
(files startup))
|
|
|
|
(define-structure scsh-top-package (export parse-switches-and-execute
|
|
with-scsh-initialized)
|
|
(open command-processor
|
|
command-levels ; with-new-session
|
|
conditions
|
|
ensures-loaded
|
|
environments
|
|
error-package
|
|
evaluation
|
|
extended-ports
|
|
fluids
|
|
interfaces
|
|
sigevents
|
|
low-interrupt
|
|
fluids-internal ; JMG: get-dynamic-env
|
|
handle ; JMG: with-handler
|
|
; package-commands
|
|
interrupts
|
|
i/o
|
|
package-commands-internal
|
|
package-mutation
|
|
packages
|
|
receiving
|
|
scsh-version
|
|
(subset scsh-level-0 (error-output-port
|
|
with-current-input-port with-current-output-port
|
|
exit
|
|
fdes->inport
|
|
release-port-handle
|
|
getenv
|
|
user-uid
|
|
user-info
|
|
user-info:home-dir
|
|
init-home-directory
|
|
init-exec-path-list
|
|
with-autoreaping
|
|
with-scsh-sighandlers
|
|
command-line
|
|
flush-all-ports-no-threads
|
|
file-name-absolute?
|
|
file-name-directory
|
|
file-name-directory?
|
|
absolute-file-name
|
|
directory-files
|
|
file-directory?
|
|
resolve-file-name
|
|
substitute-env-vars
|
|
skip-char-set
|
|
char->ascii
|
|
ascii->char))
|
|
|
|
(subset scsh-level-0-internals (set-command-line-args! init-scsh-vars))
|
|
threads
|
|
(subset srfi-1 (any))
|
|
(subset srfi-14 (char-set
|
|
char-set-complement!
|
|
char-set-contains?
|
|
string->char-set))
|
|
root-scheduler ; scheme-exit-now
|
|
exit-hooks
|
|
scheme)
|
|
(files top meta-arg))
|
|
|
|
(define-structure exit-hooks exit-hooks-interface
|
|
(open scheme
|
|
threads)
|
|
(begin
|
|
(define *exit-hooks* '())
|
|
(define (add-exit-hook! thunk)
|
|
(set! *exit-hooks* (cons thunk *exit-hooks*)))
|
|
(define (call-exit-hooks!)
|
|
(for-each (lambda (thunk) (thunk)) *exit-hooks*))
|
|
|
|
(define *narrowed-exit-hooks* '())
|
|
(define (add-narrowed-exit-hook! thunk)
|
|
(set! *narrowed-exit-hooks* (cons thunk *narrowed-exit-hooks*)))
|
|
(define (call-narrowed-exit-hooks!)
|
|
(for-each (lambda (thunk) (thunk)) *narrowed-exit-hooks*))
|
|
|
|
(define (call-exit-hooks-and-narrow thunk)
|
|
(call-exit-hooks!)
|
|
(narrow
|
|
(lambda ()
|
|
(call-narrowed-exit-hooks!)
|
|
(thunk))))))
|
|
|
|
|
|
(define-structure field-reader-package scsh-field-reader-interface
|
|
(open receiving ; receive
|
|
scsh-utilities ; deprecated-proc
|
|
error-package ; error
|
|
(subset srfi-13 (string-join))
|
|
(subset srfi-14 (char-set?
|
|
char-set:whitespace
|
|
char-set
|
|
x->char-set
|
|
char-set-complement))
|
|
delimited-readers
|
|
re-exports
|
|
let-opt ; optional-arg parsing & defaulting
|
|
scheme
|
|
)
|
|
(files fr)
|
|
;; Handle a little bit of backwards compatibility.
|
|
(begin (define join-strings (deprecated-proc string-join 'join-strings
|
|
"Use SRFI-13 STRING-JOIN.")))
|
|
)
|
|
|
|
|
|
(define-structures
|
|
((awk-expander-package (export expand-awk expand-awk/obsolete))
|
|
(awk-support-package (export next-range next-:range
|
|
next-range: next-:range:)))
|
|
(open receiving ; receive
|
|
;; scsh-utilities
|
|
(subset srfi-1 (any filter))
|
|
error-package ; error
|
|
; scsh-regexp-package
|
|
; re-exports
|
|
sre-syntax-tools
|
|
scheme
|
|
)
|
|
(files awk)
|
|
; (optimize auto-integrate)
|
|
)
|
|
|
|
|
|
(define-structure awk-package awk-interface
|
|
(open awk-support-package ; These packages provide all the stuff
|
|
re-exports ; that appears in the code produced by
|
|
receiving ; an awk expansion.
|
|
scheme)
|
|
(for-syntax (open awk-expander-package scheme))
|
|
(begin (define-syntax awk expand-awk)
|
|
(define-syntax awk/posix-string expand-awk/obsolete)))
|
|
|
|
;;; Exports an AWK macro that is just AWK/POSIX-STRING.
|
|
(define-structure obsolete-awk-package (export (awk :syntax))
|
|
(open awk-package)
|
|
(begin (define-syntax awk
|
|
(syntax-rules () ((awk body ...) (awk/posix-string body ....))))))
|
|
|
|
(define-structure scsh
|
|
(compound-interface (interface-of scsh-level-0)
|
|
(interface-of scsh-startup-package)
|
|
; scsh-regexp-interface
|
|
re-exports-interface
|
|
re-old-funs-interface
|
|
scsh-field-reader-interface ; new in 0.3
|
|
; scsh-dbm-interface
|
|
awk-interface
|
|
char-predicates-interface; Urk -- Some of this is R5RS!
|
|
dot-locking-interface
|
|
md5-interface
|
|
)
|
|
|
|
(open structure-refs
|
|
scsh-level-0
|
|
scsh-level-0-internals
|
|
re-exports
|
|
re-old-funs
|
|
; scsh-regexp-package
|
|
scsh-startup-package
|
|
; dbm
|
|
awk-package
|
|
field-reader-package
|
|
char-predicates-lib ; Urk -- Some of this is R5RS!
|
|
dot-locking
|
|
md5
|
|
scheme)
|
|
|
|
(access scsh-top-package)
|
|
; (optimize auto-integrate)
|
|
)
|
|
|
|
(define-structure scheme-with-scsh
|
|
(compound-interface (interface-of scsh)
|
|
(interface-of scheme))
|
|
(open scsh
|
|
(modify scheme (hide call-with-input-file
|
|
call-with-output-file
|
|
with-input-from-file
|
|
with-output-to-file
|
|
open-input-file
|
|
open-output-file))))
|
|
|
|
(define-structure scsh-here-string-hax (export)
|
|
(open reading
|
|
receiving
|
|
scsh ; Just need the delimited readers.
|
|
features ; make-immutable!
|
|
(subset srfi-14 (char-set))
|
|
scheme)
|
|
(files here))
|
|
|
|
(define-structure sigevents sigevents-interface
|
|
(open scsh-level-0
|
|
scheme
|
|
structure-refs
|
|
low-interrupt
|
|
rts-sigevents)
|
|
(files event))
|
|
|
|
(define-structure simple-syntax (export define-simple-syntax)
|
|
(open scheme)
|
|
(begin (define-syntax define-simple-syntax
|
|
(syntax-rules ()
|
|
((define-simple-syntax (name . pattern) result)
|
|
(define-syntax name (syntax-rules () ((name . pattern) result))))))))
|
|
|
|
|
|
(define-structure low-interrupt low-interrupt-interface
|
|
(open scheme
|
|
enumerated
|
|
bigbit
|
|
bitwise)
|
|
(files low-interrupt))
|
|
|
|
;(define-structure test-package (export test-proc)
|
|
; (open scsh-regexp-package scheme)
|
|
; (begin (define (test-proc p)
|
|
; (regexp-substitute p
|
|
; (string-match "(foo)(.*)(bar)" "Hello foo Olin bar quux")
|
|
; 'post 3 1 2 'pre))))
|
|
|
|
|
|
(define-structure scsh-threads
|
|
(export fork/thread
|
|
fork/process
|
|
wait/thread
|
|
wait/process)
|
|
(open structure-refs
|
|
scheme)
|
|
(access scsh-level-0
|
|
threads
|
|
threads-internal)
|
|
(files threads))
|
|
|
|
(define-structure dot-locking dot-locking-interface
|
|
(open scsh-level-0
|
|
scheme
|
|
let-opt
|
|
threads ; sleep
|
|
random)
|
|
(files dot-locking))
|
|
|
|
(define-structures ((syslog syslog-interface)
|
|
(syslog-channels syslog-channels-interface))
|
|
(open scheme
|
|
define-record-types finite-types enum-sets
|
|
locks thread-fluids
|
|
external-calls
|
|
bitwise)
|
|
(files syslog))
|
|
|
|
(define-structure libscsh (export dump-libscsh-image)
|
|
(open scheme
|
|
external-calls
|
|
(subset i/o (current-error-port))
|
|
(subset extended-ports (make-string-input-port))
|
|
(subset handle (with-handler))
|
|
(subset escapes (with-continuation))
|
|
(subset environments (with-interaction-environment))
|
|
(subset package-commands-internal (user-environment))
|
|
(subset command-levels (user-context start-new-session))
|
|
(subset command-processor (user-command-environment))
|
|
(subset scsh-startup-package (dump-scsh-program)))
|
|
(files libscsh))
|
|
|
|
(define-structure md5 md5-interface
|
|
(open scheme
|
|
ascii
|
|
define-record-types
|
|
bitwise
|
|
(subset i/o (read-block))
|
|
(subset srfi-13 (string-fold-right))
|
|
signals
|
|
external-calls)
|
|
(files md5))
|
|
|
|
(define srfi-19 (make-srfi-19 scheme-with-scsh))
|