added linux/ from 0.5.2 but s48_ adapted
This commit is contained in:
marting
parent
bd1b187663
commit
7f9aa175d6
|
|
@ -0,0 +1,13 @@
|
|||
;;; Flags that control buffering policy.
|
||||
;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
|
||||
;;; Copyright (c) 1995 by Brian D. Carlstrom.
|
||||
|
||||
;;; These are for the SET-PORT-BUFFERING procedure, essentially a Scheme
|
||||
;;; analog of the setbuf(3S) stdio call. We use the actual stdio values.
|
||||
;;; These constants are not likely to change from stdio lib to stdio lib,
|
||||
;;; but you need to check when you do a port.
|
||||
|
||||
(define-enum-constants bufpol
|
||||
(block 0) ; _IOFBF
|
||||
(line 1) ; _IOLBF
|
||||
(none 2)) ; _IONBF
|
||||
|
|
@ -0,0 +1,126 @@
|
|||
;;; Errno constant definitions.
|
||||
;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
|
||||
;;; Copyright (c) 1994 by Brian D. Carlstrom.
|
||||
|
||||
;;; These are the correct values for Linux systems.
|
||||
|
||||
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
|
||||
|
||||
(define-enum-constants errno
|
||||
(perm 1) ; Not super-user
|
||||
(noent 2) ; No such file or directory
|
||||
(srch 3) ; No such process
|
||||
(intr 4) ; Interrupted system call
|
||||
(io 5) ; I/O error
|
||||
(nxio 6) ; No such device or address
|
||||
(2big 7) ; Arg list too long
|
||||
(noexec 8) ; Exec format error
|
||||
(badf 9) ; Bad file number
|
||||
(child 10) ; No children
|
||||
(again 11) ; No more processes
|
||||
(wouldblock 11) ; EAGAIN again
|
||||
(nomem 12) ; Not enough core
|
||||
(acces 13) ; Permission denied
|
||||
(fault 14) ; Bad address
|
||||
(notblk 15) ; Block device required
|
||||
(busy 16) ; Mount device busy
|
||||
(exist 17) ; File exists
|
||||
(xdev 18) ; Cross-device link
|
||||
(nodev 19) ; No such device
|
||||
(notdir 20) ; Not a directory
|
||||
(isdir 21) ; Is a directory
|
||||
(inval 22) ; Invalid argument
|
||||
(nfile 23) ; Too many open files in system
|
||||
(mfile 24) ; Too many open files
|
||||
(notty 25) ; Not a typewriter
|
||||
(txtbsy 26) ; Text file busy
|
||||
(fbig 27) ; File too large
|
||||
(nospc 28) ; No space left on device
|
||||
(spipe 29) ; Illegal seek
|
||||
(rofs 30) ; Read only file system
|
||||
(mlink 31) ; Too many links
|
||||
(pipe 32) ; Broken pipe
|
||||
(dom 33) ; Math arg out of domain of func
|
||||
(range 34) ; Math result not representable
|
||||
(nomsg 35) ; No message of desired type
|
||||
(idrm 36) ; Identifier removed
|
||||
(chrng 37) ; Channel number out of range
|
||||
(l2nsync 38) ; Level 2 not synchronized
|
||||
(l3hlt 39) ; Level 3 halted
|
||||
(l3rst 40) ; Level 3 reset
|
||||
(lnrng 41) ; Link number out of range
|
||||
(unatch 42) ; Protocol driver not attached
|
||||
(nocsi 43) ; No CSI structure available
|
||||
(l2hlt 44) ; Level 2 halted
|
||||
(deadlk 45) ; Deadlock condition
|
||||
(nolck 46) ; No record locks available
|
||||
(bade 50) ; Invalid exchange
|
||||
(badr 51) ; Invalid request descriptor
|
||||
(xfull 52) ; Exchange full
|
||||
(noano 53) ; No anode
|
||||
(badrqc 54) ; Invalid request code
|
||||
(badslt 55) ; Invalid slot
|
||||
(deadlock 56) ; File locking deadlock error
|
||||
(bfont 57) ; Bad font file fmt
|
||||
(nostr 60) ; Device not a stream
|
||||
(nodata 61) ; No data (for no delay io)
|
||||
(time 62) ; Timer expired
|
||||
(nosr 63) ; Out of streams resources
|
||||
(nonet 64) ; Machine is not on the network
|
||||
(nopkg 65) ; Package not installed
|
||||
(remote 66) ; The object is remote
|
||||
(nolink 67) ; The link has been severed
|
||||
(adv 68) ; Advertise error
|
||||
(srmnt 69) ; Srmount error
|
||||
(comm 70) ; Communication error on send
|
||||
(proto 71) ; Protocol error
|
||||
(multihop 74) ; Multihop attempted
|
||||
(lbin 75) ; Inode is remote (not really error)
|
||||
(dotdot 76) ; Cross mount point (not really error)
|
||||
(badmsg 77) ; Trying to read unreadable message
|
||||
(notuniq 80) ; Given log. name not unique
|
||||
(badfd 81) ; f.d. invalid for this operation
|
||||
(remchg 82) ; Remote address changed
|
||||
(libacc 83) ; Can't access a needed shared lib
|
||||
(libbad 84) ; Accessing a corrupted shared lib
|
||||
(libscn 85) ; .lib section in a.out corrupted
|
||||
(libmax 86) ; Attempting to link in too many libs
|
||||
(libexec 87) ; Attempting to exec a shared library
|
||||
(nosys 88) ; Function not implemented
|
||||
(nmfile 89) ; No more files
|
||||
(notempty 90) ; Directory not empty
|
||||
(nametoolong 91) ; File or path name too long
|
||||
(loop 92) ; Too many symbolic links
|
||||
(opnotsupp 95) ; Operation not supported on transport endpoint
|
||||
(pfnosupport 96) ; Protocol family not supported
|
||||
(connreset 104) ; Connection reset by peer
|
||||
(nobufs 105) ; No buffer space available
|
||||
(afnosupport 106) ;
|
||||
(prototype 107) ;
|
||||
(notsock 108) ;
|
||||
(noprotoopt 109) ;
|
||||
(shutdown 110) ;
|
||||
(connrefused 111) ; Connection refused
|
||||
(addrinuse 112) ; Address already in use
|
||||
(connaborted 113) ; Connection aborted
|
||||
(netunreach 114) ;
|
||||
(netdown 115) ;
|
||||
(timedout 116) ;
|
||||
(hostdown 117) ;
|
||||
(hostunreach 118) ;
|
||||
(inprogress 119) ;
|
||||
(already 120) ;
|
||||
(destaddrreq 121) ;
|
||||
(msgsize 122) ;
|
||||
(protonosupport 123) ;
|
||||
(socktnosupport 124) ;
|
||||
(addrnotavail 125) ;
|
||||
(netreset 126) ;
|
||||
(isconn 127) ;
|
||||
(notconn 128) ;
|
||||
(toomanyrefs 129) ;
|
||||
(proclim 130) ;
|
||||
(users 131) ;
|
||||
(dquot 132) ;
|
||||
(stale 133) ;
|
||||
(notsup 134)) ;
|
||||
|
|
@ -0,0 +1,57 @@
|
|||
;;; Flags for open(2) and fcntl(2).
|
||||
;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
|
||||
;;; Copyright (c) 1994 by Brian D. Carlstrom
|
||||
|
||||
(define-enum-constants open
|
||||
;; POSIX
|
||||
(read #x0000)
|
||||
(write #x0001)
|
||||
(read+write #x0002)
|
||||
(non-blocking #x0800) ; no delay
|
||||
(append #x0400) ; set append mode
|
||||
|
||||
;; Linux
|
||||
(shared-lock #x0004) ; open with shared file lock
|
||||
(exclusive-lock #x0008) ; open with exclusive file lock
|
||||
(async #x2000) ; signal pgrep when data ready
|
||||
(fsync #x1000) ; synchronus writes
|
||||
|
||||
;; POSIX
|
||||
(create #x0040) ; create if nonexistant
|
||||
(truncate #x0200) ; truncate to zero length
|
||||
(exclusive #x0080) ; error if already exists
|
||||
(no-control-tty #x0100)) ; don't assign controlling terminal
|
||||
|
||||
|
||||
|
||||
(define open/access-mask
|
||||
(bitwise-ior open/read
|
||||
(bitwise-ior open/write open/read+write)))
|
||||
|
||||
;;; fcntl() commands
|
||||
(define-enum-constants fcntl
|
||||
(dup-fdes 0) ; F_DUPFD
|
||||
(get-fdes-flags 1) ; F_GETFD
|
||||
(set-fdes-flags 2) ; F_SETFD
|
||||
(get-status-flags 3) ; F_GETFL
|
||||
(set-status-flags 4) ; F_SETFL
|
||||
(get-owner 9) ; F_GETOWN (Not POSIX)
|
||||
(set-owner 8) ; F_SETOWN (Not POSIX)
|
||||
(get-record-lock 5) ; F_GETLK
|
||||
(set-record-lock-no-block 6) ; F_SETLK
|
||||
(set-record-lock 7)) ; F_SETLKW
|
||||
|
||||
;;; fcntl fdes-flags (F_GETFD)
|
||||
|
||||
(define fdflags/close-on-exec 1)
|
||||
|
||||
;;; fcntl status-flags (F_GETFL)
|
||||
;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
|
||||
;;; (define fdstatus/... ...)
|
||||
|
||||
;;; fcntl lock values.
|
||||
|
||||
(define-enum-constants lock
|
||||
(read 0) ; F_RDLCK
|
||||
(release 2) ; F_UNLCK
|
||||
(write 1)) ; F_WRLCK
|
||||
|
|
@ -0,0 +1,79 @@
|
|||
#include <stdio.h>
|
||||
|
||||
/* The current stdio lib that Linux uses has a problem that screws up
|
||||
** scsh's interrupt system: when a stdio function such as getc() or fputs()
|
||||
** blocks in an i/o system call, and that system call is interrupted, the
|
||||
** stdio function realises this and loops, retrying the the i/o operation.
|
||||
** What we need is for the stdio function to return an error, with
|
||||
** errno=EINTR -- i.e., we need for the stdio function to give control back
|
||||
** to the caller, telling it that the i/o call was interrupted.
|
||||
**
|
||||
** The EINTR error return is in fact mandated by Posix. The next release
|
||||
** of the GNU libc will provide this functionality. The current release
|
||||
** doesn't. So we use the workaround in this file. Calling
|
||||
** remove_bone_from_head_of_linux_libc()
|
||||
** will smash the call tables of the i/o library so that non-retrying
|
||||
** functions get called to do the i/o system calls.
|
||||
**
|
||||
** Why does scsh need non-retry? Because in scsh, Unix signals are *not*
|
||||
** handled by the actual Unix signal handler. The signal handler is just
|
||||
** a piece of C code that sets a bit, notifying the S48 vm that it needs
|
||||
** to service a signal. When the vm gets to a vm instruction boundary,
|
||||
** it suspends execution of the program and services the interrupt by
|
||||
** invoking a *Scheme* function. In this way, we can interrupt on VM
|
||||
** instruction boundaries with VM interrupt handlers.
|
||||
**
|
||||
** If a C function retries when interrupted, we never return to Scheme,
|
||||
** and so the vm never has a chance to service the interrupt. This is bad.
|
||||
**
|
||||
** This code was contributed by Roland McGrath.
|
||||
*/
|
||||
|
||||
#ifdef __GLIBC__
|
||||
|
||||
/* GNU libc 2.0 needs no fixing. */
|
||||
void remove_bone_from_head_of_linux_libc () {}
|
||||
|
||||
#else
|
||||
|
||||
#include <libio.h>
|
||||
|
||||
extern _IO_ssize_t _IO_file_read (_IO_FILE *, void *, _IO_ssize_t);
|
||||
_IO_ssize_t
|
||||
my_linux_file_read (_IO_FILE *fp, void *buf, _IO_ssize_t size)
|
||||
{
|
||||
return read (fp->_fileno, buf, size);
|
||||
}
|
||||
|
||||
extern _IO_ssize_t _IO_file_write (_IO_FILE *, const void *, _IO_ssize_t);
|
||||
_IO_ssize_t
|
||||
my_linux_file_write (_IO_FILE *fp, const void *buf, _IO_ssize_t size)
|
||||
{
|
||||
return write (fp->_fileno, buf, size);
|
||||
}
|
||||
|
||||
static void
|
||||
debone (_IO_ssize_t (**jumptable) ())
|
||||
{
|
||||
_IO_ssize_t (**p) ();
|
||||
int r, w;
|
||||
r = w = 0;
|
||||
for (p = jumptable; !r || !w; ++p)
|
||||
{
|
||||
if (*p == &_IO_file_read)
|
||||
++r, *p = &my_linux_file_read;
|
||||
else if (*p == &_IO_file_write)
|
||||
++w, *p = &my_linux_file_write;
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
remove_bone_from_head_of_linux_libc ()
|
||||
{
|
||||
extern _IO_ssize_t (*_IO_file_jumps[]) (); /* used for normal fds */
|
||||
extern _IO_ssize_t (*_IO_proc_jumps[]) (); /* used by popen */
|
||||
|
||||
debone (_IO_file_jumps);
|
||||
debone (_IO_proc_jumps);
|
||||
}
|
||||
#endif
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
/* OS-dependent support for what is supposed to be the standard ANSI C Library.
|
||||
** Copyright (c) 1996 by Brian D. Carlstrom.
|
||||
*/
|
||||
|
||||
/* Bogus hack so we don't have to add another file to the Makefile list. */
|
||||
#include "fix_stdio.c"
|
||||
|
|
@ -0,0 +1,128 @@
|
|||
;;; Magic Numbers for Networking
|
||||
;;; Copyright (c) 1994 by Brian D. Carlstrom. See file COPYING.
|
||||
|
||||
;;; magic numbers not from header file
|
||||
;;; but from man page
|
||||
;;; why can't unix make up its mind
|
||||
(define shutdown/receives 0)
|
||||
(define shutdown/sends 1)
|
||||
(define shutdown/sends+receives 2)
|
||||
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
;;; BELOW THIS POINT ARE BITS FROM:
|
||||
;;; <sys/socket.h>
|
||||
;;; <sys/un.h>
|
||||
;;; <netinet/in.h>
|
||||
;;; <netinet/tcp.h>
|
||||
;;; <netdb.h>
|
||||
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
|
||||
;;; ADDRESS FAMILIES -- <sys/socket.h>
|
||||
(define address-family/unspecified 0) ; unspecified
|
||||
(define address-family/unix 1) ; local to host (pipes, portals)
|
||||
(define address-family/internet 2) ; internetwork: UDP, TCP, etc.
|
||||
|
||||
;;; SOCKET TYPES -- <sys/socket.h>
|
||||
(define socket-type/stream 1) ; stream socket
|
||||
(define socket-type/datagram 2) ; datagram socket
|
||||
(define socket-type/raw 3) ; raw-protocol interface
|
||||
;;(define socket-type/rdm 4) ; reliably-delivered message
|
||||
;;(define socket-type/seqpacket 5) ; sequenced packet stream
|
||||
|
||||
;;; PROTOCOL FAMILIES -- <sys/socket.h>
|
||||
(define protocol-family/unspecified 0) ; unspecified
|
||||
(define protocol-family/unix 1) ; local to host (pipes, portals)
|
||||
(define protocol-family/internet 2) ; internetwork: UDP, TCP, etc.
|
||||
|
||||
;;; Well know addresses -- <netinet/in.h>
|
||||
(define internet-address/any #x00000000)
|
||||
(define internet-address/loopback #x7f000001)
|
||||
(define internet-address/broadcast #xffffffff) ; must be masked
|
||||
|
||||
;;; errors from host lookup -- <netdb.h>
|
||||
(define herror/host-not-found 1) ;Authoritative Answer Host not found
|
||||
(define herror/try-again 2) ;Non-Authoritive Host not found, or SERVERFAIL
|
||||
(define herror/no-recovery 3) ;Non recoverable errors, FORMERR, REFUSED, NOTIMP
|
||||
(define herror/no-data 4) ;Valid name, no data record of requested type
|
||||
(define herror/no-address herror/no-data) ;no address, look for MX record
|
||||
|
||||
;;; flags for send/recv -- <sys/socket.h>
|
||||
(define message/out-of-band 1) ; process out-of-band data
|
||||
(define message/peek 2) ; peek at incoming message
|
||||
(define message/dont-route 4) ; send without using routing tables
|
||||
|
||||
;;; protocol level for socket options -- <sys/socket.h>
|
||||
(define level/socket #x1) ; SOL_SOCKET: options for socket level
|
||||
|
||||
;;; socket options -- <sys/socket.h>
|
||||
(define socket/debug 1) ; turn on debugging info recording
|
||||
;(define socket/accept-connect #x0002) ; socket has had listen()
|
||||
(define socket/reuse-address 2) ; allow local address reuse
|
||||
(define socket/keep-alive 9) ; keep connections alive
|
||||
(define socket/dont-route 5) ; just use interface addresses
|
||||
(define socket/broadcast 6) ; permit sending of broadcast msgs
|
||||
;(define socket/use-loop-back #x0040) ; bypass hardware when possible
|
||||
(define socket/linger 13) ; linger on close if data present
|
||||
(define socket/oob-inline 10) ; leave received OOB data in line
|
||||
;(define socket/use-privileged #x4000) ; allocate from privileged port area
|
||||
;(define socket/cant-signal #x8000) ; prevent SIGPIPE on SS_CANTSENDMORE
|
||||
(define socket/send-buffer 7) ; send buffer size
|
||||
(define socket/receive-buffer 8) ; receive buffer size
|
||||
;(define socket/send-low-water #x1003) ; send low-water mark
|
||||
;(define socket/receive-low-water #x1004) ; receive low-water mark
|
||||
;(define socket/send-timeout #x1005) ; send timeout
|
||||
;(define socket/receive-timeout #x1006) ; receive timeout
|
||||
(define socket/error 4) ; get error status and clear
|
||||
(define socket/type 3) ; get socket type
|
||||
(define socket/no-check 11) ; linux
|
||||
(define socket/priority 12) ; sucks
|
||||
|
||||
;;; ip options -- <netinet/in.h>
|
||||
(define ip/type-of-service 1) ; set/get IP type of service value
|
||||
(define ip/time-to-live 2) ; set/get IP time-to-live value
|
||||
(define ip/include-header 3) ; include header with data
|
||||
(define ip/options 4) ; set/get IP per-packet options
|
||||
|
||||
;;; tcp options -- <netinet/tcp.h>
|
||||
(define tcp/no-delay #x01) ; don't delay send to coalesce packets
|
||||
(define tcp/max-segment #x02) ; set maximum segment size
|
||||
|
||||
;;; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
||||
;;; OPTION SETS FOR SOCKET-OPTION AND SET-SOCKET-OPTION
|
||||
|
||||
;;; Boolean Options
|
||||
(define options/boolean
|
||||
(list socket/debug
|
||||
; socket/accept-connect
|
||||
socket/reuse-address
|
||||
socket/keep-alive
|
||||
socket/dont-route
|
||||
socket/broadcast
|
||||
; socket/use-loop-back
|
||||
socket/oob-inline
|
||||
; socket/use-privileged
|
||||
; socket/cant-signal
|
||||
ip/include-header
|
||||
tcp/no-delay))
|
||||
|
||||
;;; Integer Options
|
||||
(define options/value
|
||||
(list socket/send-buffer
|
||||
socket/receive-buffer
|
||||
; socket/send-low-water
|
||||
; socket/receive-low-water
|
||||
socket/error
|
||||
socket/type
|
||||
ip/time-to-live
|
||||
ip/type-of-service
|
||||
tcp/max-segment))
|
||||
|
||||
;;; #f or Positive Integer
|
||||
(define options/linger
|
||||
(list socket/linger))
|
||||
|
||||
;;; Real Number
|
||||
(define options/timeout
|
||||
(list ;socket/send-timeout
|
||||
;socket/receive-timeout
|
||||
))
|
||||
|
|
@ -0,0 +1,125 @@
|
|||
;;; Interfaces and packages for the Linux specific parts of scsh.
|
||||
;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
|
||||
;;; Copyright (c) 1994 by Brian D. Carlstrom.
|
||||
|
||||
(define-interface linux-fdflags-extras-interface
|
||||
(export open/shared-lock
|
||||
open/exclusive-lock
|
||||
open/async
|
||||
open/fsync
|
||||
fcntl/get-owner
|
||||
fcntl/set-owner))
|
||||
|
||||
(define-interface linux-errno-extras-interface
|
||||
(export errno/notblk
|
||||
errno/txtbsy
|
||||
errno/wouldblock
|
||||
errno/inprogress
|
||||
errno/already
|
||||
errno/notsock
|
||||
errno/destaddrreq
|
||||
errno/msgsize
|
||||
errno/prototype
|
||||
errno/noprotoopt
|
||||
errno/protonosupport
|
||||
errno/socktnosupport
|
||||
errno/opnotsupp
|
||||
errno/pfnosupport
|
||||
errno/afnosupport
|
||||
errno/addrinuse
|
||||
errno/addrnotavail
|
||||
errno/netdown
|
||||
errno/netunreach
|
||||
errno/netreset
|
||||
errno/connaborted
|
||||
errno/connreset
|
||||
errno/nobufs
|
||||
errno/isconn
|
||||
errno/notconn
|
||||
errno/shutdown
|
||||
errno/toomanyrefs
|
||||
errno/timedout
|
||||
errno/connrefused
|
||||
errno/loop
|
||||
errno/hostdown
|
||||
errno/hostunreach
|
||||
; errno/proclim
|
||||
errno/users
|
||||
errno/dquot
|
||||
errno/stale
|
||||
errno/remote
|
||||
; errno/badrpc
|
||||
; errno/rpcmismatch
|
||||
; errno/progunavail
|
||||
; errno/progmismatch
|
||||
; errno/ftype
|
||||
; errno/auth
|
||||
; errno/needauth
|
||||
; errno/last
|
||||
))
|
||||
|
||||
(define-interface linux-signals-extras-interface
|
||||
(export signal/trap
|
||||
; signal/emt
|
||||
signal/bus
|
||||
; signal/sys
|
||||
signal/urg
|
||||
signal/cld
|
||||
signal/io
|
||||
signal/xcpu
|
||||
signal/xfsz
|
||||
signal/vtalrm
|
||||
signal/prof
|
||||
signal/winch
|
||||
))
|
||||
|
||||
|
||||
(define-interface linux-network-extras-interface
|
||||
(export socket/debug
|
||||
; socket/accept-connect
|
||||
socket/reuse-address
|
||||
socket/keep-alive
|
||||
socket/dont-route
|
||||
socket/broadcast
|
||||
; socket/use-loop-back
|
||||
socket/linger
|
||||
socket/oob-inline
|
||||
; socket/use-privileged
|
||||
; socket/cant-signal
|
||||
socket/send-buffer
|
||||
socket/receive-buffer
|
||||
; socket/send-low-water
|
||||
; socket/receive-low-water
|
||||
; socket/send-timeout
|
||||
; socket/receive-timeout
|
||||
socket/error
|
||||
socket/type
|
||||
socket/no-check
|
||||
socket/priority
|
||||
ip/options
|
||||
ip/time-to-live
|
||||
ip/type-of-service ;linux
|
||||
ip/include-header ;linux
|
||||
tcp/no-delay
|
||||
tcp/max-segment))
|
||||
|
||||
(define-interface linux-extras-interface
|
||||
(compound-interface linux-errno-extras-interface
|
||||
linux-fdflags-extras-interface
|
||||
linux-network-extras-interface
|
||||
linux-signals-extras-interface))
|
||||
|
||||
(define-interface linux-defs-interface
|
||||
(compound-interface linux-extras-interface
|
||||
sockets-network-interface
|
||||
posix-errno-interface
|
||||
posix-fdflags-interface
|
||||
posix-signals-interface
|
||||
signals-internals-interface))
|
||||
|
||||
(define-structure linux-defs linux-defs-interface
|
||||
(open scheme bitwise defenum-package)
|
||||
(files fdflags errno signals netconst))
|
||||
|
||||
(define-interface os-extras-interface linux-extras-interface)
|
||||
(define os-dependent linux-defs)
|
||||
|
|
@ -0,0 +1,45 @@
|
|||
;;; Signal constant definitions for Linux
|
||||
;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
|
||||
;;; Copyright (c) 1994 by Brian D. Carlstrom.
|
||||
|
||||
(define-enum-constants signal
|
||||
;; POSIX
|
||||
(hup 1)
|
||||
(int 2)
|
||||
(quit 3)
|
||||
(ill 4)
|
||||
(trap 5)
|
||||
(abrt 6)
|
||||
(iot 6)
|
||||
(bus 7)
|
||||
(fpe 8)
|
||||
(kill 9)
|
||||
(usr1 10)
|
||||
(segv 11)
|
||||
(usr2 12)
|
||||
(pipe 13)
|
||||
(alrm 14)
|
||||
(term 15)
|
||||
(stkflt 16)
|
||||
(chld 17)
|
||||
(cld 17) ;compat
|
||||
(cont 18)
|
||||
(stop 19)
|
||||
(tstp 20)
|
||||
(ttin 21)
|
||||
(ttou 22)
|
||||
(urg 23)
|
||||
(xcpu 24)
|
||||
(xfsz 25)
|
||||
(vtalrm 26)
|
||||
(prof 27)
|
||||
(winch 28)
|
||||
(io 29)
|
||||
(poll 29)
|
||||
(pwr 30)
|
||||
(unused 31)
|
||||
)
|
||||
|
||||
(define signals-ignored-by-default
|
||||
(list signal/chld signal/cont signal/winch))
|
||||
|
||||
|
|
@ -0,0 +1,52 @@
|
|||
/* This is bogus -- currently unchanged from the bsd file. */
|
||||
/* Need to turn off synchronous error signals (SIGPIPE, SIGSYS). */
|
||||
|
||||
#include "../scsh_aux.h"
|
||||
|
||||
/* Make sure our exports match up w/the implementation: */
|
||||
#include "../signals1.h"
|
||||
|
||||
/* This table converts Unix signal numbers to S48/scsh interrupt numbers.
|
||||
** If the signal doesn't have an interrupt number, the entry is -1.
|
||||
** (Only asynchronous signals have interrupt numbers.)
|
||||
**
|
||||
** Note that we bake into this table the integer values of the signals --
|
||||
** i.e., we assume that SIGHUP=1, SIGALRM=15, etc. So this definition is
|
||||
** very system-dependent.
|
||||
*/
|
||||
const int sig2int[] = {
|
||||
-1, /* 0 is not a signal */
|
||||
scshint_hup, /* SIGHUP */
|
||||
scshint_keyboard, /* SIGINT */
|
||||
scshint_quit, /* SIGQUIT */
|
||||
-1, /* SIGILL */
|
||||
-1, /* SIGTRAP */
|
||||
-1, /* SIGABRT & SIGIOT */
|
||||
-1, /* SIGBUS */
|
||||
-1, /* SIGFPE */
|
||||
-1, /* SIGKILL */
|
||||
scshint_usr1, /* SIGUSR1 */
|
||||
-1, /* SIGSEGV */
|
||||
scshint_usr2, /* SIGUSR2 */
|
||||
-1, /* SIGPIPE */
|
||||
scshint_alarm, /* SIGALRM */
|
||||
scshint_term, /* SIGTERM */
|
||||
-1, /* SIGTKFLT (x86 coprocessor stack fault) */
|
||||
scshint_chld, /* SIGCHLD */
|
||||
scshint_cont, /* SIGCONT */
|
||||
-1, /* SIGSTOP */
|
||||
scshint_tstp, /* SIGTSTP */
|
||||
-1, /* scshint_ttyin, /* SIGTTIN */
|
||||
-1, /* scshint_ttou, /* SIGTTOU */
|
||||
scshint_urg, /* SIGURG */
|
||||
scshint_xcpu, /* SIGXCPU */
|
||||
scshint_xfsz, /* SIGXFSZ */
|
||||
scshint_vtalrm, /* SIGVTALRM */
|
||||
scshint_prof, /* SIGPROF */
|
||||
scshint_winch, /* SIGWINCH */
|
||||
scshint_io, /* SIGIO aka SIGPOLL*/
|
||||
scshint_pwr, /* SIGPWR */
|
||||
-1 /* SIGPWR */
|
||||
};
|
||||
|
||||
const int max_sig = 31; /* SIGUNUSED */
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
/* Convert between a lo24/hi integer-pair bitset and a sigset_t value.
|
||||
** These macros are OS-dependent, and must be defined per-OS.
|
||||
*/
|
||||
|
||||
#define make_sigset(maskp, hi, lo) \
|
||||
((maskp)->__val[0] = (unsigned long int) ((hi) << 24) | (lo))
|
||||
|
||||
#define split_sigset(mask, hip, lop)\
|
||||
((*(hip) = ((mask).__val[0] >> 24) & 0xff),\
|
||||
(*(lop) = ((mask).__val[0] & 0xffffff)))
|
||||
|
|
@ -0,0 +1,80 @@
|
|||
/* Copyright (c) 1994 by Olin Shivers.
|
||||
** Copyright (c) 1994-1995 by Brian D. Carlstrom.
|
||||
**
|
||||
** This file implements the char-ready? procedure for file descriptors
|
||||
** and Scsh's fdports. It is not Posix, so it must be implemented for
|
||||
** each OS to which scsh is ported.
|
||||
**
|
||||
** This version assumes two things:
|
||||
** - the existence of select to tell if there is data
|
||||
** available for the file descriptor.
|
||||
** - the existence of the _cnt field in the stdio FILE struct, telling
|
||||
** if there is any buffered input in the struct.
|
||||
**
|
||||
** Most Unixes have these things, so this file should work for them.
|
||||
** However, Your Mileage May Vary.
|
||||
**
|
||||
** You could also replace the select() with a iotctl(FIONREAD) call, if you
|
||||
** had one but not the other.
|
||||
** -Olin&Brian
|
||||
*/
|
||||
|
||||
#include <sys/types.h>
|
||||
#include <sys/time.h>
|
||||
#include <stdio.h>
|
||||
#include <unistd.h>
|
||||
#include "libcig.h"
|
||||
#include <errno.h>
|
||||
|
||||
#include "stdio_dep.h" /* Make sure the .h interface agrees with the code. */
|
||||
|
||||
/* These two procs return #t if data ready, #f data not ready,
|
||||
** and errno if error.
|
||||
*/
|
||||
|
||||
s48_value char_ready_fdes(int fd)
|
||||
{
|
||||
fd_set readfds;
|
||||
struct timeval timeout;
|
||||
int result;
|
||||
|
||||
FD_ZERO(&readfds);
|
||||
FD_SET(fd,&readfds);
|
||||
|
||||
timeout.tv_sec=0;
|
||||
timeout.tv_usec=0;
|
||||
|
||||
result=select(fd+1, &readfds, NULL, NULL, &timeout);
|
||||
|
||||
if(result == -1 )
|
||||
return(s48_enter_fixnum(errno));
|
||||
if(result)
|
||||
return(S48_TRUE);
|
||||
return(S48_FALSE);
|
||||
}
|
||||
|
||||
s48_value stream_char_readyp(FILE *f)
|
||||
{
|
||||
int fd = fileno(f);
|
||||
return (f->_IO_read_ptr < f->_IO_read_end) ? S48_TRUE : char_ready_fdes(fd);
|
||||
}
|
||||
|
||||
void setfileno(FILE *fs, int fd)
|
||||
{
|
||||
fs->_fileno = fd;
|
||||
}
|
||||
|
||||
int fbufcount(FILE *fs)
|
||||
{
|
||||
return((fs->_IO_read_end)-(fs->_IO_read_ptr));
|
||||
}
|
||||
|
||||
int ibuf_empty(FILE *fs)
|
||||
{
|
||||
return((fs->_IO_read_end)-(fs->_IO_read_ptr) <= 0);
|
||||
}
|
||||
|
||||
int obuf_full(FILE *fs)
|
||||
{
|
||||
return((fs->_IO_write_end)-(fs->_IO_write_ptr) <= 0);
|
||||
}
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
/* Exports from stdio_dep.h. */
|
||||
|
||||
s48_value char_ready_fdes(int fd);
|
||||
|
||||
s48_value stream_char_readyp(FILE *f);
|
||||
|
||||
void setfileno(FILE *fs, int fd);
|
||||
|
||||
int fbufcount(FILE* fs);
|
||||
|
||||
int ibuf_empty(FILE *fs);
|
||||
|
||||
int obuf_full(FILE *fs);
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
;;; OS-dependent time stuff
|
||||
;;; Copyright (c) 1995 by Olin Shivers. See file COPYING.
|
||||
|
||||
;;; This suffices for BSD systems with the gettimeofday()
|
||||
;;; microsecond-resolution timer.
|
||||
|
||||
(define (ticks/sec) 1000000) ; usec
|
||||
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
/* OS-dependent support for fine-grained timer.
|
||||
** Copyright (c) 1995 by Olin Shivers.
|
||||
**
|
||||
** We return the current time in seconds and sub-second "ticks" where the
|
||||
** number of ticks/second is OS dependent (and is defined in time_dep.scm).
|
||||
** This definition works on any BSD Unix with the gettimeofday()
|
||||
** microsecond-resolution timer.
|
||||
*/
|
||||
|
||||
#include <errno.h>
|
||||
#include <sys/time.h>
|
||||
#include "scheme48.h"
|
||||
#include "../time1.h"
|
||||
|
||||
/* Sux because it's dependent on 32-bitness. */
|
||||
#define hi8(i) (((i)>>24) & 0xff)
|
||||
#define lo24(i) ((i) & 0xffffff)
|
||||
#define comp8_24(hi, lo) (((hi)<<24) + (lo))
|
||||
|
||||
s48_value time_plus_ticks(int *hi_secs, int *lo_secs,
|
||||
int *hi_ticks, int *lo_ticks)
|
||||
{
|
||||
struct timeval t;
|
||||
struct timezone tz;
|
||||
|
||||
if( gettimeofday(&t, &tz) ) return s48_enter_fixnum(errno);
|
||||
|
||||
{ long int secs = t.tv_sec;
|
||||
long int ticks = t.tv_usec;
|
||||
|
||||
*hi_secs = hi8(secs);
|
||||
*lo_secs = lo24(secs);
|
||||
*hi_ticks = hi8(ticks);
|
||||
*lo_ticks = lo24(ticks);
|
||||
}
|
||||
|
||||
return S48_FALSE;
|
||||
}
|
||||
|
|
@ -0,0 +1,215 @@
|
|||
;;; Constant definitions for tty control code (POSIX termios).
|
||||
;;; Copyright (c) 1995 by Brian Carlstrom. See file COPYING.
|
||||
;;; Largely rehacked by Olin.
|
||||
|
||||
;;; These constants are for Solaris 2.x,
|
||||
;;; and are taken from /usr/include/sys/termio.h
|
||||
;;; and /usr/include/sys/termios.h.
|
||||
|
||||
;;; Non-standard (POSIX, SVR4, 4.3+BSD) things:
|
||||
;;; - Some of the baud rates.
|
||||
|
||||
|
||||
;;; Special Control Characters
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;; Indices into the c_cc[] character array.
|
||||
|
||||
;;; Name Subscript Enabled by
|
||||
;;; ---- --------- ----------
|
||||
;;; POSIX
|
||||
(define ttychar/eof 4) ; ^d icanon
|
||||
(define ttychar/eol 11) ; icanon
|
||||
(define ttychar/delete-char 2) ; ^? icanon
|
||||
(define ttychar/delete-line 3) ; ^u icanon
|
||||
(define ttychar/interrupt 0) ; ^c isig
|
||||
(define ttychar/quit 1) ; ^\ isig
|
||||
(define ttychar/suspend 10) ; ^z isig
|
||||
(define ttychar/start 8) ; ^q ixon, ixoff
|
||||
(define ttychar/stop 9) ; ^s ixon, ixoff
|
||||
(define ttychar/min 6) ; !icanon ; Not exported
|
||||
(define ttychar/time 5) ; !icanon ; Not exported
|
||||
|
||||
;;; SVR4 & 4.3+BSD
|
||||
(define ttychar/delete-word 14) ; ^w icanon
|
||||
(define ttychar/reprint 12) ; ^r icanon
|
||||
(define ttychar/literal-next 15) ; ^v iexten
|
||||
(define ttychar/discard 13) ; ^o iexten
|
||||
(define ttychar/delayed-suspend #f) ; ^y isig
|
||||
(define ttychar/eol2 16) ; icanon
|
||||
|
||||
;;; 4.3+BSD
|
||||
(define ttychar/status #f) ; ^t icanon
|
||||
|
||||
;;; Length of control-char string -- *Not Exported*
|
||||
(define num-ttychars 19)
|
||||
|
||||
;;; Magic "disable feature" tty character
|
||||
(define disable-tty-char (ascii->char #x00)) ; _POSIX_VDISABLE
|
||||
|
||||
;;; Flags controllling input processing
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; POSIX
|
||||
(define ttyin/ignore-break #o00001) ; ignbrk
|
||||
(define ttyin/interrupt-on-break #o00002) ; brkint
|
||||
(define ttyin/ignore-bad-parity-chars #o00004) ; ignpar
|
||||
(define ttyin/mark-parity-errors #o00010) ; parmrk
|
||||
(define ttyin/check-parity #o00020) ; inpck
|
||||
(define ttyin/7bits #o00040) ; istrip
|
||||
(define ttyin/nl->cr #o00100) ; inlcr
|
||||
(define ttyin/ignore-cr #o00200) ; igncr
|
||||
(define ttyin/cr->nl #o00400) ; icrnl
|
||||
(define ttyin/output-flow-ctl #o02000) ; ixon
|
||||
(define ttyin/input-flow-ctl #o10000) ; ixoff
|
||||
|
||||
;;; SVR4 & 4.3+BSD
|
||||
(define ttyin/xon-any #o4000) ; ixany: Any char restarts after stop
|
||||
(define ttyin/beep-on-overflow #o20000) ; imaxbel: queue full => ring bell
|
||||
|
||||
;;; SVR4
|
||||
(define ttyin/lowercase #o1000) ; iuclc: Map upper-case to lower case
|
||||
|
||||
|
||||
;;; Flags controlling output processing
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; POSIX
|
||||
(define ttyout/enable #o000001) ; opost: enable output processing
|
||||
|
||||
;;; SVR4 & 4.3+BSD
|
||||
(define ttyout/nl->crnl #o000004) ; onlcr: map nl to cr-nl
|
||||
|
||||
;;; 4.3+BSD
|
||||
(define ttyout/discard-eot #f) ; onoeot
|
||||
(define ttyout/expand-tabs #f) ; oxtabs (NOT xtabs)
|
||||
|
||||
;;; SVR4
|
||||
(define ttyout/cr->nl #o000010) ; ocrnl
|
||||
(define ttyout/fill-w/del #o000200) ; ofdel
|
||||
(define ttyout/delay-w/fill-char #o000100) ; ofill
|
||||
(define ttyout/uppercase #o000002) ; olcuc
|
||||
(define ttyout/nl-does-cr #o000040) ; onlret
|
||||
(define ttyout/no-col0-cr #o000020) ; onocr
|
||||
|
||||
;;; Newline delay
|
||||
(define ttyout/nl-delay #o000400) ; mask (nldly)
|
||||
(define ttyout/nl-delay0 #o000000)
|
||||
(define ttyout/nl-delay1 #o000400) ; tty 37
|
||||
|
||||
;;; Horizontal-tab delay
|
||||
(define ttyout/tab-delay #o014000) ; mask (tabdly)
|
||||
(define ttyout/tab-delay0 #o000000)
|
||||
(define ttyout/tab-delay1 #o004000) ; tty 37
|
||||
(define ttyout/tab-delay2 #o010000)
|
||||
(define ttyout/tab-delayx #o014000) ; Expand tabs (xtabs, tab3)
|
||||
|
||||
;;; Carriage-return delay
|
||||
(define ttyout/cr-delay #o003000) ; mask (crdly)
|
||||
(define ttyout/cr-delay0 #o000000)
|
||||
(define ttyout/cr-delay1 #o001000) ; tn 300
|
||||
(define ttyout/cr-delay2 #o002000) ; tty 37
|
||||
(define ttyout/cr-delay3 #o003000) ; concept 100
|
||||
|
||||
;;; Vertical tab delay
|
||||
(define ttyout/vtab-delay #o040000) ; mask (vtdly)
|
||||
(define ttyout/vtab-delay0 #o000000)
|
||||
(define ttyout/vtab-delay1 #o040000) ; tty 37
|
||||
|
||||
;;; Backspace delay
|
||||
(define ttyout/bs-delay #o020000) ; mask (bsdly)
|
||||
(define ttyout/bs-delay0 #o000000)
|
||||
(define ttyout/bs-delay1 #o020000)
|
||||
|
||||
;;; Form-feed delay
|
||||
(define ttyout/ff-delay #o100000) ; mask (ffdly)
|
||||
(define ttyout/ff-delay0 #o000000)
|
||||
(define ttyout/ff-delay1 #o100000)
|
||||
|
||||
(define ttyout/all-delay
|
||||
(bitwise-ior (bitwise-ior (bitwise-ior ttyout/nl-delay ttyout/tab-delay)
|
||||
(bitwise-ior ttyout/cr-delay ttyout/vtab-delay))
|
||||
(bitwise-ior ttyout/bs-delay ttyout/ff-delay)))
|
||||
|
||||
|
||||
;;; Control flags - hacking the serial-line.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; POSIX
|
||||
(define ttyc/char-size #o00060) ; csize: character size mask
|
||||
(define ttyc/char-size5 #o00000) ; 5 bits (cs5)
|
||||
(define ttyc/char-size6 #o00020) ; 6 bits (cs6)
|
||||
(define ttyc/char-size7 #o00040) ; 7 bits (cs7)
|
||||
(define ttyc/char-size8 #o00060) ; 8 bits (cs8)
|
||||
(define ttyc/2-stop-bits #o00100) ; cstopb: Send 2 stop bits.
|
||||
(define ttyc/enable-read #o00200) ; cread: Enable receiver.
|
||||
(define ttyc/enable-parity #o00400) ; parenb
|
||||
(define ttyc/odd-parity #o01000) ; parodd
|
||||
(define ttyc/hup-on-close #o02000) ; hupcl: Hang up on last close.
|
||||
(define ttyc/no-modem-sync #o04000) ; clocal: Ignore modem lines.
|
||||
|
||||
;;; 4.3+BSD
|
||||
(define ttyc/ignore-flags #f) ; cignore: ignore control flags
|
||||
(define ttyc/CTS-output-flow-ctl #f) ; ccts_oflow: CTS flow control of output
|
||||
(define ttyc/RTS-input-flow-ctl #f) ; crts_iflow: RTS flow control of input
|
||||
(define ttyc/carrier-flow-ctl #f) ; mdmbuf
|
||||
|
||||
;;; Local flags -- hacking the tty driver / user interface.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;; POSIX
|
||||
(define ttyl/visual-delete #o020) ; echoe: Visually erase chars
|
||||
(define ttyl/echo-delete-line #o040) ; echok: Echo nl after line kill
|
||||
(define ttyl/echo #o010) ; echo: Enable echoing
|
||||
(define ttyl/echo-nl #o100) ; echonl: Echo nl even if echo is off
|
||||
(define ttyl/canonical #o002) ; icanon: Canonicalize input
|
||||
(define ttyl/enable-signals #o001) ; isig: Enable ^c, ^z signalling
|
||||
(define ttyl/extended #o100000) ; iexten: Enable extensions
|
||||
(define ttyl/ttou-signal #o400) ; tostop: SIGTTOU on background output
|
||||
(define ttyl/no-flush-on-interrupt #o200) ; noflsh
|
||||
|
||||
;;; SVR4 & 4.3+BSD
|
||||
(define ttyl/visual-delete-line #o04000); echoke: visually erase a line-kill
|
||||
(define ttyl/hardcopy-delete #o02000); echoprt: visual erase for hardcopy
|
||||
(define ttyl/echo-ctl #o01000); echoctl: echo control chars as "^X"
|
||||
(define ttyl/flush-output #o10000); flusho: output is being flushed
|
||||
(define ttyl/reprint-unread-chars #o40000); pendin: retype pending input
|
||||
|
||||
;;; 4.3+BSD
|
||||
(define ttyl/alt-delete-word #f) ; altwerase
|
||||
(define ttyl/no-kernel-status #f) ; nokerninfo: no kernel status on ^T
|
||||
|
||||
;;; SVR4
|
||||
(define ttyl/case-map #o4) ; xcase: canonical upper/lower presentation
|
||||
|
||||
;;; Vector of (speed . code) pairs.
|
||||
|
||||
(define baud-rates '#((0 . 0) (1 . 50) (2 . 75)
|
||||
(3 . 110) (4 . 134) (5 . 150)
|
||||
(6 . 200) (7 . 300) (8 . 600)
|
||||
(9 . 1200) (10 . 1800) (11 . 2400)
|
||||
(12 . 4800) (13 . 9600) (14 . 19200)
|
||||
(15 . 38400) (14 . exta) (15 . extb)))
|
||||
|
||||
;;; tcflush() constants
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define %flush-tty/input 0) ; TCIFLUSH
|
||||
(define %flush-tty/output 1) ; TCOFLUSH
|
||||
(define %flush-tty/both 2) ; TCIOFLUSH
|
||||
|
||||
|
||||
;;; tcflow() constants
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define %tcflow/start-out 1) ; TCOON
|
||||
(define %tcflow/stop-out 0) ; TCOOFF
|
||||
(define %tcflow/start-in 3) ; TCION
|
||||
(define %tcflow/stop-in 2) ; TCIOFF
|
||||
|
||||
|
||||
;;; tcsetattr() constants
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define %set-tty-info/now 0) ; TCSANOW Make change immediately.
|
||||
(define %set-tty-info/drain 1) ; TCSADRAIN Drain output, then change.
|
||||
(define %set-tty-info/flush 2) ; TCSAFLUSH Drain output, flush input.
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
;;; Scsh routines for analysing exit codes returned by WAIT.
|
||||
;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
|
||||
;;;
|
||||
;;; To port these to a new OS, consult /usr/include/sys/wait.h,
|
||||
;;; and check the WIFEXITED, WEXITSTATUS, WIFSTOPPED, WSTOPSIG,
|
||||
;;; WIFSIGNALED, and WTERMSIG macros for the magic fields they use.
|
||||
;;; These definitions are for Linux.
|
||||
;;;
|
||||
;;; I could have done a portable version by making C calls for this,
|
||||
;;; but it's such overkill.
|
||||
|
||||
|
||||
;;; If process terminated normally, return the exit code, otw #f.
|
||||
|
||||
(define (status:exit-val status)
|
||||
(and (not (= (bitwise-and #xFF status) #x7F))
|
||||
(zero? (bitwise-and #x7F status))
|
||||
(bitwise-and #xFF (arithmetic-shift status -8))))
|
||||
|
||||
|
||||
;;; If the process was suspended, return the suspending signal, otw #f.
|
||||
|
||||
(define (status:stop-sig status)
|
||||
(and (= #x7F (bitwise-and status #xFF))
|
||||
(bitwise-and #xFF (arithmetic-shift status -8))))
|
||||
|
||||
|
||||
;;; If the process terminated abnormally,
|
||||
;;; return the terminating signal, otw #f.
|
||||
|
||||
(define (status:term-sig status)
|
||||
(let ((termsig (bitwise-and status #x7F)))
|
||||
(and (not (zero? termsig)) ; Didn't exit.
|
||||
(not (= #x7F (bitwise-and status #xFF))) ; Not suspended.
|
||||
termsig)))
|
||||
|
||||
|
||||
;;; Flags.
|
||||
(define wait/poll 1) ; Don't hang if nothing to wait for.
|
||||
(define wait/stopped-children 2) ; Report on suspended subprocs, too.
|
||||
Loading…
Reference in New Issue