scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added next, cygwin32, sunos and ultrix (all untested)

This commit is contained in:
mainzelm 2000-12-20 15:26:12 +00:00
parent 6a0c146e7c
commit aa8647061d
62 changed files with 3908 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
acconfig.h
View File

@ -52,6 +52,8 @@
#undef _XOPEN_SOURCE_EXTENDED #undef _XOPEN_SOURCE_EXTENDED
#undef socklen_t #undef socklen_t
#undef HAVE_HARRIS
@BOTTOM@ @BOTTOM@
#include "fake/sigact.h" #include "fake/sigact.h"

88
configure.in
View File

@ -214,6 +214,23 @@ AC_INIT(c/scheme48vm.c)
AR=${AR-"ar cq"} AR=${AR-"ar cq"}
TMPDIR=${TMPDIR-"/usr/tmp"} TMPDIR=${TMPDIR-"/usr/tmp"}
case "$host" in case "$host" in
## CX/UX
m88k-harris-cxux* )
dir=cxux
CC="cc -Xa"
CFLAGS="-O"
LDFLAGS="-O -Wl,-Bexport"
AC_DEFINE(HAVE_HARRIS)
;;
## DEC Ultrix
mips-dec-ultrix* )
dir=ultrix
if test ${CC} = cc; then
LDFLAGS=-N
fi
;;
## HP 9000 series 700 and 800, running HP/UX ## HP 9000 series 700 and 800, running HP/UX
hppa*-hp-hpux* ) hppa*-hp-hpux* )
dir=hpux dir=hpux
@ -239,26 +256,38 @@ AC_INIT(c/scheme48vm.c)
AIX_P="exportlist.aix" AIX_P="exportlist.aix"
;; ;;
## Linux ## Linux
*-*-linux* ) *-*-linux* )
dir=linux dir=linux
# gross, but needed for some older a.out systems for 0.4.x # gross, but needed for some older a.out systems for 0.4.x
LIBS=-lc LIBS=-lc
SCSH_ELF SCSH_ELF
;; ;;
## NetBSD and FreeBSD ( and maybe 386BSD also) ## NetBSD and FreeBSD ( and maybe 386BSD also)
*-*-*bsd*|-*-darwin* ) *-*-*bsd*|-*-darwin* )
dir=bsd dir=bsd
SCSH_ELF SCSH_ELF
;; ;;
## SGI IRIX ## NeXT
mips-sgi-irix* ) *-next-* )
dir=irix dir=next
S48_CFLAG_CKR CC="$CC -posix"
INSTALL='$(srcdir)/install-sh' AC_DEFINE(HAVE_SIGACTION)
;; ;;
## SGI IRIX
mips-sgi-irix* )
dir=irix
S48_CFLAG_CKR
INSTALL='$(srcdir)/install-sh'
;;
## SunOS
sparc*-sun-sunos* )
dir=sunos
;;
## Solaris - Sparc and i386 ## Solaris - Sparc and i386
*-*-solaris* ) *-*-solaris* )
@ -266,14 +295,21 @@ AC_INIT(c/scheme48vm.c)
AC_DEFINE(HAVE_NLIST) AC_DEFINE(HAVE_NLIST)
;; ;;
* ) ## NT - cygwin32
dir=generic *-*-cygwin32* )
echo "WARNING: " dir=cygwin32
echo "WARNING: Using generic configuration." EXEEXT=".exe"
echo "WARNING: See doc/install.txt for more information." ;;
echo "WARNING: "
;; ## Generic Configuration
esac * )
dir=generic
echo "WARNING: "
echo "WARNING: Using generic configuration."
echo "WARNING: See doc/install.txt for more information."
echo "WARNING: "
;;
esac
rm -rf $srcdir/scsh/machine rm -rf $srcdir/scsh/machine
ln -s $srcdir/$dir $srcdir/scsh/machine ln -s $srcdir/$dir $srcdir/scsh/machine

0
scsh/cygwin32/Makefile.inc Normal file
View File

13
scsh/cygwin32/bufpol.scm Normal file
View File

@ -0,0 +1,13 @@
;;; Flags that control buffering policy.
;;; Copyright (c) 1993 by Olin Shivers.
;;; Copyright (c) 1999 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

127
scsh/cygwin32/errno.scm Normal file
View File

@ -0,0 +1,127 @@
;;; Errno constant definitions.
;;; Copyright (c) 1993 by Olin Shivers.
;;; Copyright (c) 1999 by Brian D. Carlstrom.
;;; These are the correct values for Cygwin32
(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) ;
(last 134)) ; Must be equal largest errno

77
scsh/cygwin32/fdflags.scm Normal file
View File

@ -0,0 +1,77 @@
;;; Flags for open(2) and fcntl(2).
;;; Copyright (c) 1993 by Olin Shivers.
;;; Copyright (c) 1999 by Brian D. Carlstrom
(define-enum-constants open
;; POSIX
(read #x0000)
(write #x0001)
(read+write #x0002)
;; Cygwin32
(ndelay #x0004) ; non blocking I/O (4.2 style)
;; POSIX
(append #x0008) ; set append mode
;; Cygwin32
(mark #x0010) ; internal; mark during gc()
(defer #x0020) ; internal; defer for next gc pass
(async #x0040) ; signal pgrep when data ready
(shared-lock #x0080) ; open with shared file lock
(exclusive-lock #x0100) ; open with exclusive file lock
;; POSIX
(create #x0200) ; create if nonexistant
(truncate #x0400) ; truncate to zero length
(exclusive #x0800) ; error if already exists
;; Cygwin32
(non-blocking #x1000) ; non blocking I/O (sys5 style)
(fsync #x2000) ; synchronus writes
;; POSIX
(non-blocking #x4000) ; non blocking I/O (POSIX style)
(no-control-tty #x8000) ; don't assign controlling terminal
;; Cygwin32
(binary #x10000)
(text #x20000)
(noinherit #x40000))
(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 5) ; F_GETOWN (Not POSIX)
(set-owner 6) ; F_SETOWN (Not POSIX)
(get-record-lock 7) ; F_GETLK
(set-record-lock-no-block 8) ; F_SETLK
(set-record-lock 9) ; F_SETLKW
(remote-get-lock 10) ; F_RGETLK (Not POSIX)
(remote-set-lock-no-block 11) ; F_RSETLK (Not POSIX)
(convert 12) ; F_CNVT (Not POSIX)
(remote-get-lock 13)) ; F_RSETLKW (Not POSIX)
;;; 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 1) ; F_RDLCK
(release 2) ; F_UNLCK
(write 3) ; F_WRLCK
(release-remote 4)) ; F_UNLKSYS (Not POSIX)

3
scsh/cygwin32/libansi.c Normal file
View File

@ -0,0 +1,3 @@
/* OS-dependent support for what is supposed to be the standard ANSI C Library.
** Copyright (c) 1999 by Brian D. Carlstrom.
*/

125
scsh/cygwin32/netconst.scm Normal file
View File

@ -0,0 +1,125 @@
;;; Magic Numbers for Networking
;;; Copyright (c) 1999 by Brian D. Carlstrom.
;;; 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
(define socket-type/packet 10) ; CYGWIN specific
;;; 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 #xffff) ; SOL_SOCKET: options for socket level
;;; socket options -- <sys/socket.h>
(define socket/debug #x0001) ; turn on debugging info recording
(define socket/accept-connect #x0002) ; socket has had listen()
(define socket/reuse-address #x0004) ; allow local address reuse
(define socket/keep-alive #x0008) ; keep connections alive
(define socket/dont-route #x0010) ; just use interface addresses
(define socket/broadcast #x0020) ; permit sending of broadcast msgs
(define socket/use-loop-back #x0040) ; bypass hardware when possible
(define socket/linger #x0080) ; linger on close if data present
(define socket/oob-inline #x0100) ; leave received OOB data in line
(define socket/send-buffer #x1001) ; send buffer size
(define socket/receive-buffer #x1002) ; 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 #x1007) ; get error status and clear
(define socket/type #x1008) ; get socket type
;;; ip options -- <cygwin/socket.h>
(define ip/options 1 ) ; buf/ip/opts; set/get ip options
(define ip/multicast-if 2 ) ; u_char; set/get ip multicast i/f
(define ip/multicast-ttl 3 ) ; u_char; set/get ip multicast ttl
(define ip/multicast-loop 4 ) ; u_char; set/get ip multicast loopback
(define ip/add-membership 5 ) ; ip_mreq; add an ip group membership
(define ip/drop-membership 6 ) ; ip_mreq; drop an ip group membership
(define ip/time-to-live 7 ) ; int; ip time to live
(define ip/type-of-service 8 ) ; int; ip type of service and preced.
(define ip/dont-fragment 9 ) ;
;;; 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
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
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))

117
scsh/cygwin32/packages.scm Normal file
View File

@ -0,0 +1,117 @@
;;; Interfaces and packages for the Cygwin32 specific parts of scsh.
;;; Copyright (c) 1994 by Olin Shivers.
;;; Copyright (c) 1999 by Brian D. Carlstrom.
(define-interface cygwin32-fdflags-extras-interface
(export open/shared-lock
open/exclusive-lock
open/async
open/fsync
fcntl/get-owner
fcntl/set-owner))
(define-interface cygwin32-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/last))
(define-interface cygwin32-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
signal/info))
(define-interface cygwin32-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/send-buffer
socket/receive-buffer
socket/send-low-water
socket/receive-low-water
socket/send-timeout
socket/receive-timeout
socket/error
socket/type
;;; all ip/* but ip/options and ip/time-to-live cygwin32 only
ip/options
ip/type-of-service
ip/time-to-live
ip/multicast-if
ip/multicast-ttl
ip/multicast-loop
ip/add-membership
ip/drop-membership
tcp/no-delay
tcp/max-segment))
(define-interface cygwin32-extras-interface
(compound-interface cygwin32-errno-extras-interface
cygwin32-fdflags-extras-interface
cygwin32-network-extras-interface
cygwin32-signals-extras-interface))
(define-interface cygwin32-defs-interface
(compound-interface cygwin32-extras-interface
sockets-network-interface
posix-errno-interface
posix-fdflags-interface
posix-signals-interface
signals-internals-interface))
(define-structure cygwin32-defs cygwin32-defs-interface
(open scheme bitwise defenum-package)
(files fdflags errno signals netconst))
(define-interface os-extras-interface cygwin32-extras-interface)
(define os-dependent cygwin32-defs)

73
scsh/cygwin32/signals.scm Normal file
View File

@ -0,0 +1,73 @@
;;; Signal constant definitions for Cygwin32
;;; Copyright (c) 1994 by Olin Shivers.
;;; Copyright (c) 1999 by Brian D. Carlstrom.
(define-enum-constants signal
;; POSIX
(hup 1) ; hangup
(int 2) ; interrupt
(quit 3) ; quit
(ill 4) ; illegal instruction (not reset when caught)
;; Cygwin32
(trap 5) ; trace trap (not reset when caught)
;; POSIX
(iot 6) ; IOT instruction
(abrt 6) ; used by abort, replace SIGIOT in the future
;; Cygwin32
(emt 7) ; EMT instruction
;; POSIX
(fpe 8) ; floating point exception
(kill 9) ; kill (cannot be caught or ignored)
;; Cygwin32
(bus 10) ; bus error
;; POSIX
(segv 11) ; segmentation violation
;; Cygwin32
(sys 12) ; bad argument to system call
;; POSIX
(pipe 13) ; write on a pipe with no one to read it
(alrm 14) ; alarm clock
(term 15) ; software termination signal from kill
;; Cygwin32
(urg 16) ; urgent condition on IO channel
;; POSIX
(stop 17) ; sendable stop signal not from tty
(tstp 18) ; stop signal from tty
(cont 19) ; continue a stopped process
(chld 20) ; to parent on child stop or exit
;; Cygwin32
(cld 20) ; System V name for SIGCHLD
;; POSIX
(ttin 21) ; to readers pgrp upon background tty read
(ttou 22) ; like TTIN for output if (tp->t_local&LTOSTOP)
;; Cygwin32
(io 23) ; input/output possible signal
(poll 23) ; System V name for SIGIO
(xcpu 24) ; exceeded CPU time limit
(xfsz 25) ; exceeded file size limit
(vtalrm 26) ; virtual time alarm
(prof 27) ; profiling time alarm
(winch 28) ; window changed
(info 29) ; information request
;; User defined
(usr1 30) ; user defined signal 1
(usr2 31) ; user defined signal 2
)
(define signals-ignored-by-default
(list signal/chld signal/cont ; These are Posix.
signal/info signal/io signal/urg signal/winch)) ; These are BSD.

90
scsh/cygwin32/stdio_dep.c Normal file
View File

@ -0,0 +1,90 @@
/* Copyright (c) 1994 by Olin Shivers.
** Copyright (c) 1994-1999 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->_r > 0 ? S48_TRUE : char_ready_fdes(fd);
}
void setfileno(FILE *fs, int fd)
{
fs->_file = fd;
}
int fbufcount(FILE* fs)
{
return(fs->_r);
}
/* Returns true if there is no buffered data in stream FS
** (or there is no buffering, period.)
*/
int ibuf_empty(FILE *fs) {return fs->_r <= 0;}
/* Returns true if the buffer in stream FS is full
** (or there is no buffering, period).
*/
int obuf_full(FILE *fs) {return fs->_w <= 0;}
/* Cygwin doesn't yet implement these system calls */
struct netent *getnetbyaddr (long x, int y) {return NULL;}
struct netent *getnetbyname (const char *x) {return NULL;}
int fchown(int x, uid_t y, gid_t z) {return 0;}
int mkfifo(char *__path, mode_t __mode) {return 0;}

13
scsh/cygwin32/stdio_dep.h Normal file
View File

@ -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);

6
scsh/cygwin32/sysdep.h Normal file
View File

@ -0,0 +1,6 @@
/* Cygwin seems to have TZNAME but they forgot to define it */
#define HAVE_TZNAME
#define tzname _tzname
/* Cygwin's adds _'s but making configure.in know about dlltool seemed evil */
#define DLSYM_ADDS_USCORE

8
scsh/cygwin32/time_dep.scm Normal file
View File

@ -0,0 +1,8 @@
;;; OS-dependent time stuff
;;; Copyright (c) 1995 by Olin Shivers.
;;; This suffices for BSD systems with the gettimeofday()
;;; microsecond-resolution timer.
(define (ticks/sec) 1000000) ; usec

38
scsh/cygwin32/time_dep1.c Normal file
View File

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

212
scsh/cygwin32/tty-consts.scm Normal file
View File

@ -0,0 +1,212 @@
;;; Constant definitions for tty control code (POSIX termios).
;;; Copyright (c) 1999 by Brian Carlstrom.
;;; Special Control Characters
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Indices into the c_cc[] character array.
;;; Name Subscript Enabled by
;;; ---- --------- ----------
;;; POSIX
(define ttychar/eof 4) ; ^d icanon
(define ttychar/eol 2) ; icanon
(define ttychar/delete-char 5) ; ^? icanon
(define ttychar/delete-line 7) ; ^u icanon
(define ttychar/interrupt 6) ; ^c isig
(define ttychar/quit 10) ; ^\ isig
(define ttychar/suspend 14) ; ^z isig
(define ttychar/start 12) ; ^q ixon, ixoff
(define ttychar/stop 13) ; ^s ixon, ixoff
(define ttychar/min 9) ; !icanon ; Not exported
(define ttychar/time 16) ; !icanon ; Not exported
;;; SVR4 & 4.3+BSD
(define ttychar/eol2 3) ; icanon
(define ttychar/delete-word 17) ; ^w icanon
(define ttychar/reprint 11) ; ^r icanon
(define ttychar/delayed-suspend #f) ; ^y isig
(define ttychar/literal-next 8) ; ^v iexten
(define ttychar/discard 1) ; ^o iexten
;;; 4.3+BSD
(define ttychar/status #f) ; ^t icanon
;;; Cygwin32
(define ttychar/swtc 15) ; ???
;;; Length of control-char string -- *Not Exported*
(define num-ttychars 18)
;;; Magic "disable feature" tty character
(define disable-tty-char (ascii->char #xff)) ; _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 #o200000) ; 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 #o100000) ; ixany: Any char restarts after stop
(define ttyin/beep-on-overflow #o00010) ; imaxbel: queue full => ring bell
;;; SVR4
(define ttyin/lowercase #o40000) ; iuclc: Map upper-case to lower case
;;; Flags controlling output processing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; POSIX
(define ttyout/enable #o0001) ; opost: enable output processing
;;; SVR4 & 4.3+BSD
(define ttyout/nl->crnl #o0010) ; 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 #o0004) ; ocrnl
(define ttyout/fill-w/del #o100000) ; ofdel
(define ttyout/delay-w/fill-char #o0100) ; ofill
(define ttyout/uppercase #o0002) ; olcuc
(define ttyout/nl-does-cr #o0040) ; onlret
(define ttyout/no-col0-cr #o0020) ; onocr
;;; Newline delay
(define ttyout/nl-delay #o1000) ; mask (nldly)
(define ttyout/nl-delay0 #o0000)
(define ttyout/nl-delay1 #o1000) ; tty 37
;;; Horizontal-tab delay
(define ttyout/tab-delay #o14000) ; mask (tabdly)
(define ttyout/tab-delay0 #o00000)
(define ttyout/tab-delay1 #o04000) ; tty 37
(define ttyout/tab-delay2 #o01000)
(define ttyout/tab-delayx #o14000) ; Expand tabs (xtabs, tab3)
;;; Carriage-return delay
(define ttyout/cr-delay #o600) ; mask (crdly)
(define ttyout/cr-delay0 #o000)
(define ttyout/cr-delay1 #o200) ; tn 300
(define ttyout/cr-delay2 #o400) ; tty 37
(define ttyout/cr-delay3 #o600) ; concept 100
;;; Vertical tab delay
(define ttyout/vtab-delay #o20000) ; mask (vtdly)
(define ttyout/vtab-delay0 #o00000)
(define ttyout/vtab-delay1 #o20000) ; tty 37
;;; Backspace delay
(define ttyout/bs-delay #o2000) ; mask (bsdly)
(define ttyout/bs-delay0 #o0000)
(define ttyout/bs-delay1 #o2000)
;;; Form-feed delay
(define ttyout/ff-delay #o40000) ; mask (ffdly)
(define ttyout/ff-delay0 #o00000)
(define ttyout/ff-delay1 #o40000)
(define ttyout/all-delay #f)
;;; 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 #x0008) ; echoe: Visually erase chars
(define ttyl/echo-delete-line #x0010) ; echok: Echo nl after line kill
(define ttyl/echo #x0004) ; echo: Enable echoing
(define ttyl/echo-nl #x0020) ; echonl: Echo nl even if echo is off
(define ttyl/canonical #x0002) ; icanon: Canonicalize input
(define ttyl/enable-signals #x0001) ; isig: Enable ^c, ^z signalling
(define ttyl/extended #x0100) ; iexten: Enable extensions
(define ttyl/ttou-signal #x0080) ; tostop: SIGTTOU on background output
(define ttyl/no-flush-on-interrupt #x0040) ; noflsh
;;; SVR4 & 4.3+BSD
(define ttyl/visual-delete-line #x0400); echoke: visually erase a line-kill
(define ttyl/hardcopy-delete #f); echoprt: visual erase for hardcopy
(define ttyl/echo-ctl #x0800); echoctl: echo control chars as "^X"
(define ttyl/flush-output #x0200); flusho: output is being flushed
(define ttyl/reprint-unread-chars #f); 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 #f) ; 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) (16 . 57600) (17 .115200)))
;;; tcflush() constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define %flush-tty/input 0) ; TCIFLUSH
(define %flush-tty/output 1) ; TCOFLUSH
(define %flush-tty/both 2) ; TCIOFLUSH
(define %flush-tty/flush 3) ; TCFLSH
;;; tcflow() constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define %tcflow/stop-out 0) ; TCOOFF
(define %tcflow/start-out 1) ; TCOON
(define %tcflow/stop-in 2) ; TCIOFF
(define %tcflow/start-in 3) ; TCION
;;; tcsetattr() constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define %set-tty-info/flush 1) ; TCSAFLUSH Drain output, flush input.
(define %set-tty-info/now 2) ; TCSANOW Make change immediately.
(define %set-tty-info/drain 3) ; TCSADRAIN Drain output, then change.
(define %set-tty-info/dflush 4) ; TCSADFLUSH

41
scsh/cygwin32/waitcodes.scm Normal file
View File

@ -0,0 +1,41 @@
;;; Scsh routines for analysing exit codes returned by WAIT.
;;; Copyright (c) 1994 by Olin Shivers.
;;; Copyright (c) 1999 by Brian D. Carlstrom.
;;;
;;; 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 Cygwin32
;;;
;;; 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 (zero? (bitwise-and #x7F status))
(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 #x7F))
(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)) ; 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.

0
scsh/next/Makefile.inc Normal file
View File

12
scsh/next/bufpol.scm Normal file
View File

@ -0,0 +1,12 @@
;;; Flags that control buffering policy.
;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
;;; 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 #o200) ; _IOLBF
(none 4)) ; _IONBF

142
scsh/next/errno.scm Normal file
View File

@ -0,0 +1,142 @@
;;; Errno constant definitions.
;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
;;; These are the correct values for NextStep systems.
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-enum-constants errno
;; POSIX:
(perm 1) ; Operation not permitted
(noent 2) ; No such file or directory
(srch 3) ; No such process
(intr 4) ; Interrupted function call
(io 5) ; Input/output error
(nxio 6) ; No such device or address
; (2big 7) ; Arg list too long
(noexec 8) ; Exec format error
(badf 9) ; Bad file descriptor
(child 10) ; No child processes
(again 11) ; Resource temporarily unavailable
(nomem 12) ; Not enough space
(acces 13) ; Permission denied
(fault 14) ; Bad address
;; NextStep
(notblk 15) ; Block device required
;; POSIX
(busy 16) ; Resource busy
(exist 17) ; File exists
(xdev 18) ; Improper 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) ; Inappropriate I/O control operation
(txtbsy 26) ; Text file busy
(fbig 27) ; File too large
(nospc 28) ; No space left on device
(spipe 29) ; Invalid seek
(rofs 30) ; Read-only file system
(mlink 31) ; Too many links
(pipe 32) ; Broken pipe
;; Strict ANSI
;; math software
(dom 33) ; Domain error
(range 34) ; Result too large
;; NextStep
;; non-blocking and interrupt i/o
(wouldblock 35) ; Operation would block
(inprogress 36) ; Operation now in progress
(already 37) ; Operation already in progress
;; ipc/network software
;; argument errors
(notsock 38) ; Socket operation on non-socket
(destaddrreq 39) ; Destination address required
(msgsize 40) ; Message too long
(prototype 41) ; Protocol wrong type for socket
(noprotoopt 42) ; Protocol not available
(protonosupport 43) ; Protocol not supported
(socktnosupport 44) ; Socket type not supported
(opnotsupp 45) ; Operation not supported on socket
(pfnosupport 46) ; Protocol family not supported
(afnosupport 47) ; Address family not supported by protocol family
(addrinuse 48) ; Address already in use
(addrnotavail 49) ; Can't assign requested address
;; operational errors
(netdown 50) ; Network is down
(netunreach 51) ; Network is unreachable
(netreset 52) ; Network dropped connection on reset
(connaborted 53) ; Software caused connection abort
(connreset 54) ; Connection reset by peer
(nobufs 55) ; No buffer space available
(isconn 56) ; Socket is already connected
(notconn 57) ; Socket is not connected
(shutdown 58) ; Can't send after socket shutdown
(toomanyrefs 59) ; Too many references: can't splice
(timedout 60) ; Connection timed out
(connrefused 61) ; Connection refused
(loop 62) ; Too many levels of symbolic links
;; POSIX:
(nametoolong 63) ; File name too long
;; NextStep
(hostdown 64) ; Host is down
(hostunreach 65) ; No route to host
;; POSIX:
(notempty 66) ; Directory not empty
;; NextStep
;; quotas & mush
(proclim 67) ; Too many processes
(users 68) ; Too many users
(dquot 69) ; Disc quota exceeded
;; Network File System
(stale 70) ; Stale NFS file handle
(remote 71) ; Too many levels of remote in path
;; streams - the following not defined in errno.h for NextStep
;;(nostr 72) ; Device is not a stream
;;(time 73) ; Timer expired
;;(nosr 74) ; Out of streams resources
;;(nomsg 75) ; No message of desired type
;;(badmsg 76) ; Trying to read unreadable message
;; SystemV IPC
;;(idrm 77) ; Identifier removed
;; POSIX
;; SystemV Record Locking
(deadlk 78) ; Resource deadlock avoided
(nolck 79) ; No locks available
;; NextStep
(pwroff 80) ; Device power is off
(deverr 81) ; Device error
(noinit 82) ; Device not initialized
(badexec 83) ; Bad executable
(badarch 84) ; Bad CPU type in executable
(shlibvers 85) ; Shared library version mismatch
(badmacho 86) ; Malformed Macho file
;; POSIX
(nosys 87)) ; Function not implemented
;; the following not implemented in NextStep
;;(dotdot 88) ; Cross mount point (not an error)
;;(remchg 89) ; Remote address changed
;; POSIX
;;(nosys 90)) ; function not implemented

51
scsh/next/fdflags.scm Normal file
View File

@ -0,0 +1,51 @@
;;; Flags for open(2) and fcntl(2).
;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
(define-enum-constants open
;; POSIX
(read 0)
(write 1)
(read+write 2)
(non-blocking 4)
(append #o10)
(no-control-tty #o20)
(create #o1000)
(truncate #o2000)
(exclusive #o4000)
;; NextStep
(sync #o1000000) ; Synchronous writes
(async #o100)) ; Signal process group when data
(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 5) ; F_GETOWN (Not POSIX)
(set-owner 6) ; F_SETOWN (Not POSIX)
(get-record-lock 7) ; F_GETLK
(set-record-lock-no-block 8) ; F_SETLK
(set-record-lock 9)) ; 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 1) ; F_RDLCK
(write 2) ; F_WRLCK
(release 3)) ; F_UNLCK

3
scsh/next/libansi.c Normal file
View File

@ -0,0 +1,3 @@
/* OS-dependent support for what is supposed to be the standard ANSI C Library.
** Copyright (c) 1996 by Brian D. Carlstrom.
*/

121
scsh/next/netconst.scm Normal file
View File

@ -0,0 +1,121 @@
;;; 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 #xffff) ; SOL_SOCKET: options for socket level
;;; socket options -- <sys/socket.h>
(define socket/debug #x0001) ; turn on debugging info recording
(define socket/accept-connect #x0002) ; socket has had listen()
(define socket/reuse-address #x0004) ; allow local address reuse
(define socket/keep-alive #x0008) ; keep connections alive
(define socket/dont-route #x0010) ; just use interface addresses
(define socket/broadcast #x0020) ; permit sending of broadcast msgs
(define socket/use-loop-back #x0040) ; bypass hardware when possible
(define socket/linger #x0080) ; linger on close if data present
(define socket/oob-inline #x0100) ; 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 #x1001) ; send buffer size
(define socket/receive-buffer #x1002) ; 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 #x1007) ; get error status and clear
(define socket/type #x1008) ; get socket type
;;; ip options -- <netinet/in.h>
(define ip/options 1) ; set/get IP per-packet options
(define ip/time-to-live 2) ; set/get IP time-to-live value
;;; 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
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
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))

116
scsh/next/packages.scm Normal file
View File

@ -0,0 +1,116 @@
;;; Interfaces and packages for the NeXTSTEP specific parts of scsh.
;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
(define-interface next-fdflags-extras-interface
(export open/async
open/sync
fcntl/get-owner
fcntl/set-owner))
(define-interface next-errno-extras-interface
(export errno/addrinuse
errno/addrnotavail
errno/afnosupport
errno/already
errno/badarch
errno/badexec
errno/badmacho
errno/connaborted
errno/connrefused
errno/connreset
errno/destaddrreq
errno/deverr
errno/dquot
errno/hostdown
errno/hostunreach
errno/inprogress
errno/isconn
errno/loop
errno/msgsize
errno/netdown
errno/netreset
errno/nobufs
errno/noinit
errno/noprotoopt
errno/notblk
errno/notconn
errno/notsock
errno/netunreach
errno/opnotsupp
errno/pfnosupport
errno/proclim
errno/protonosupport
errno/prototype
errno/pwroff
errno/remote
errno/shlibvers
errno/shutdown
errno/socktnosupport
errno/stale
errno/timedout
errno/toomanyrefs
errno/users
errno/wouldblock
errno/txtbsy))
(define-interface next-signals-extras-interface
(export signal/bus
signal/cld
signal/emt
signal/io
signal/iot
signal/lost
signal/prof
signal/sys
signal/trap
signal/urg
signal/vtalrm
signal/winch
signal/xcpu
signal/xfsz))
(define-interface next-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
ip/options
ip/time-to-live
tcp/no-delay
tcp/max-segment))
(define-interface next-extras-interface
(compound-interface next-errno-extras-interface
next-fdflags-extras-interface
next-network-extras-interface
next-signals-extras-interface))
(define-interface next-defs-interface
(compound-interface next-extras-interface
sockets-network-interface
posix-errno-interface
posix-fdflags-interface
posix-signals-interface
signals-internals-interface))
(define-structure next-defs next-defs-interface
(open scheme bitwise defenum-package)
(files fdflags errno signals netconst))
(define-interface os-extras-interface next-extras-interface)
(define os-dependent next-defs)

71
scsh/next/signals.scm Normal file
View File

@ -0,0 +1,71 @@
;;; Signal constant definitions for NextStep
;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
(define-enum-constants signal
;; POSIX
(hup 1) ; hangup
(int 2) ; interrupt
(quit 3) ; quit
(ill 4) ; illegal instruction (not reset when caught)
;; NextStep
(trap 5) ; trace trap (not reset when caught)
;; POSIX
(iot 6) ; IOT instruction
(abrt 6) ; used by abort, replace SIGIOT in the future
;; NextStep
(emt 7) ; EMT instruction
;; POSIX
(fpe 8) ; floating point exception
(kill 9) ; kill (cannot be caught or ignored)
;; NextStep
(bus 10) ; bus error
;; POSIX
(segv 11) ; segmentation violation
;; NextStep
(sys 12) ; bad argument to system call
;; POSIX
(pipe 13) ; write on a pipe with no one to read it
(alrm 14) ; alarm clock
(term 15) ; software termination signal from kill
;; NextStep
(urg 16) ; urgent condition on IO channel
;; POSIX
(stop 17) ; sendable stop signal not from tty
(tstp 18) ; stop signal from tty
(cont 19) ; continue a stopped process
(chld 20) ; to parent on child stop or exit
;; NextStep
(cld 20) ; System V name for SIGCHLD
;; POSIX
(ttin 21) ; to readers pgrp upon background tty read
(ttou 22) ; like TTIN for output if (tp->t_local&LTOSTOP)
;; NextStep
(io 23) ; input/output possible signal
(xcpu 24) ; exceeded CPU time limit
(xfsz 25) ; exceeded file size limit
(vtalrm 26) ; virtual time alarm
(prof 27) ; profiling time alarm
(winch 28) ; window changed
(lost 29) ; resource lost (eg, record-lock lost)
;; User defined
(usr1 30) ; user defined signal 1
(usr2 31) ; user defined signal 2
)
(define signals-ignored-by-default
(list signal/chld signal/cont ; These are Posix.
signal/io signal/urg signal/winch)) ; These are NeXT.

91
scsh/next/stdio_dep.c Normal file
View File

@ -0,0 +1,91 @@
/* 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->_cnt > 0 ? S48_TRUE : char_ready_fdes(fd);
}
void setfileno(FILE *fs, int fd)
{
fileno(fs) = fd;
}
int fbufcount(FILE* fs)
{
return fs->_cnt;
}
/* Returns true if there is no buffered data in stream FS
** (or there is no buffering, period.)
*/
int ibuf_empty(FILE *fs)
{
return fs->_cnt <= 0;
}
/* Returns true if the buffer in stream FS is full
** (or there is no buffering, period).
*/
int obuf_full(FILE *fs)
{
return (fs->_flag & _IOLBF) ? (- fs->_cnt >= fs->_bufsiz-1)
: (fs->_cnt <= 0);
}

13
scsh/next/stdio_dep.h Normal file
View File

@ -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);

2
scsh/next/sysdep.h Normal file
View File

@ -0,0 +1,2 @@
#undef HAVE_SIGACTION
#define HAVE_SIGACTION

8
scsh/next/time_dep.scm Normal file
View File

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

38
scsh/next/time_dep1.c Normal file
View File

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

248
scsh/next/tty-consts.scm Normal file
View File

@ -0,0 +1,248 @@
;;; 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 NeXTSTEP 3.x,
;;; and are taken from /usr/include/bsd/sys/termios.h and
;;; /usr/include/bsd/sys/ttydev.h
;;; Non-standard (POSIX, SVR4, 4.3+BSD) things:
;;; - Useless ttychar/quote char.
;;; - Two extra newline delay values
;;; - Some control and local flags:
;;; ttyc/2-stop-bits-when-110-baud stopb110
;;; ttyc/parity0 par0
;;; ttyc/parity1 par1
;;; ttyl/crt-delete echocrt
;;; ttyl/xlcase xlcase Vas ist das?
;;; ttyl/xeucbksp xeucbksp 'n das?
;;; - Some baud rates
;;; Special Control Characters
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Indices into the c_cc[] character array.
;;; Name Subscript Enabled by
;;; ---- --------- ----------
;;; POSIX
(define ttychar/eof 0) ; ^d icanon
(define ttychar/eol 1) ; icanon
(define ttychar/delete-char 2) ; ^? icanon
(define ttychar/delete-line 3) ; ^u icanon
(define ttychar/interrupt 4) ; ^c isig
(define ttychar/quit 5) ; ^\ isig
(define ttychar/suspend 6) ; ^z isig
(define ttychar/start 7) ; ^q ixon, ixoff
(define ttychar/stop 8) ; ^s ixon, ixoff
(define ttychar/min 9) ; !icanon ; Not exported
(define ttychar/time 10) ; !icanon ; Not exported
;;; SVR4 & 4.3+BSD
(define ttychar/delete-word 11) ; ^w icanon
(define ttychar/reprint 12) ; ^r icanon
(define ttychar/literal-next 13) ; ^v iexten
(define ttychar/discard 14) ; ^o iexten
(define ttychar/delayed-suspend 15) ; ^y isig
(define ttychar/eol2 #f) ; icanon
;;; 4.3+BSD
(define ttychar/status #f) ; ^t icanon
;;; NeXT
(define ttychar/quote 16) ; icanon
;;; Length of control-char string -- *Not Exported*
(define num-ttychars 17)
;;; Magic "disable feature" tty character
(define disable-tty-char (ascii->char #xff))
;;; Flags controllling input processing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; POSIX
(define ttyin/ignore-break #x0001) ; ignbrk
(define ttyin/interrupt-on-break #x0002) ; brkint
(define ttyin/ignore-bad-parity-chars #x0004) ; ignpar
(define ttyin/mark-parity-errors #x0008) ; parmrk
(define ttyin/check-parity #x0010) ; inpck
(define ttyin/7bits #x0020) ; istrip
(define ttyin/nl->cr #x0040) ; inlcr
(define ttyin/ignore-cr #x0080) ; igncr
(define ttyin/cr->nl #x0100) ; icrnl
(define ttyin/output-flow-ctl #x0200) ; ixon
(define ttyin/input-flow-ctl #x0400) ; ixoff
;;; SVR4 & 4.3+BSD
(define ttyin/xon-any #x0800) ; ixany: Any char restarts after stop
(define ttyin/beep-on-overflow #x2000) ; imaxbel: queue full => ring bell
;;; SVR4
(define ttyin/lowercase #f) ; iuclc: Map upper-case to lower case
;;; Flags controlling output processing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; POSIX
(define ttyout/enable #x0001) ; opost: enable output processing
;;; SVR4 & 4.3+BSD
(define ttyout/nl->crnl #x0002) ; 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 #f) ; ocrnl
(define ttyout/fill-w/del #f) ; ofdel
(define ttyout/delay-w/fill-char #f) ; ofill
(define ttyout/uppercase #f) ; olcuc
(define ttyout/nl-does-cr #f) ; onlret
(define ttyout/no-col0-cr #f) ; onocr
;;; Newline delay
(define ttyout/nl-delay #x0300) ; mask (nldly)
(define ttyout/nl-delay0 #x0000)
(define ttyout/nl-delay1 #x0100) ; tty 37
(define ttyout/nl-delay2 #x0200) ; vt05 Non-standard
(define ttyout/nl-delay3 #x0300) ; Non-standard
;;; Horizontal-tab delay
(define ttyout/tab-delay #x0c00) ; mask (tabdly)
(define ttyout/tab-delay0 #x0000)
(define ttyout/tab-delay1 #x0400) ; tty 37
(define ttyout/tab-delay2 #x0800)
(define ttyout/tab-delayx #x0c00) ; Expand tabs (xtabs, tab3)
;;; Carriage-return delay
(define ttyout/cr-delay #x3000) ; mask (crdly)
(define ttyout/cr-delay0 #x0000)
(define ttyout/cr-delay1 #x1000) ; tn 300
(define ttyout/cr-delay2 #x2000) ; tty 37
(define ttyout/cr-delay3 #x3000) ; concept 100
;;; Vertical tab delay
(define ttyout/vtab-delay #x4000) ; mask (vtdly)
(define ttyout/vtab-delay0 #x0000)
(define ttyout/vtab-delay1 #x4000) ; tty 37
;;; Backspace delay
(define ttyout/bs-delay #x8000) ; mask (bsldy)
(define ttyout/bs-delay0 #x0000)
(define ttyout/bs-delay1 #x8000)
;;; Form-feed delay -- appears to be rolled into the vertical-tab delay.
(define ttyout/ff-delay ttyout/vtab-delay) ; mask (ffdly)
(define ttyout/ff-delay0 ttyout/vtab-delay0)
(define ttyout/ff-delay1 ttyout/vtab-delay1)
(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 #x0300) ; csize: character size mask
(define ttyc/char-size5 #x0000) ; 5 bits (cs5)
(define ttyc/char-size6 #x0100) ; 6 bits (cs6)
(define ttyc/char-size7 #x0200) ; 7 bits (cs7)
(define ttyc/char-size8 #x0300) ; 8 bits (cs8)
(define ttyc/2-stop-bits #x0400) ; cstopb: Send 2 stop bits.
(define ttyc/enable-read #x0800) ; cread: Enable receiver.
(define ttyc/enable-parity #x1000) ; parenb
(define ttyc/odd-parity #x2000) ; parodd
(define ttyc/hup-on-close #x4000) ; hupcl: Hang up on last close.
(define ttyc/no-modem-sync #x8000) ; clocal: Ignore modem lines.
;;; 4.3+BSD
(define ttyc/ignore-flags #x0001); 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
;;; NeXT
(define ttyc/2-stop-bits-when-110-baud #x010000) ; stopb110
(define ttyc/parity0 #x20000) ; par0
(define ttyc/parity1 #x40000) ; par1
;;; Local flags -- hacking the tty driver / user interface.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; POSIX
(define ttyl/visual-delete #x000002) ; echoe: Visually erase chars
(define ttyl/echo-delete-line #x000004) ; echok: Echo nl after line kill
(define ttyl/echo #x000008) ; echo: Enable echoing
(define ttyl/echo-nl #x000010) ; echonl: Echo nl even if echo is off
(define ttyl/canonical #x000020) ; icanon: Canonicalize input
(define ttyl/enable-signals #x000040) ; isig: Enable ^c, ^z signalling
(define ttyl/extended #x000080) ; iexten: Enable extensions
(define ttyl/ttou-signal #x400000) ; tostop: SIGTTOU on background output
(define ttyl/no-flush-on-interrupt #x80000000) ; noflsh
;;; SVR4 & 4.3+BSD
(define ttyl/visual-delete-line #x001) ; echoke: visually erase a line-kill
(define ttyl/hardcopy-delete #x200) ; echoprt: visual erase for hardcopy
(define ttyl/echo-ctl #x400) ; echoctl: echo control chars as "^X"
(define ttyl/flush-output #f) ; flusho: output is being flushed
(define ttyl/reprint-unread-chars #f) ; pendin: retype pending input
;;; 4.3+BSD
(define ttyl/alt-delete-word #x800) ; altwerase
(define ttyl/no-kernel-status #f) ; nokerninfo: no kernel status on ^T
;;; SVR4
(define ttyl/case-map #f) ; xcase: canonical upper/lower presentation
;;; NeXT
(define ttyl/crt-delete #x00000100) ; visual erase does "\b \b"
(define ttyl/xlcase #x04000000) ; Vas ist das?
(define ttyl/xeucbksp #x08000000) ; 'n das?
;;; NOTE: xlcase and xeucbksp are in the NeXT <termios.h>, but don't appear
;;; in the tty(4) or termios(4) man pages. Where are they documented?
;;; 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)
(16 . 14400) (17 . 28800) (18 . 43200)
(19 . 57600)))
;;; tcflush() constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define %flush-tty/input 0) ; TCIFLUSH
(define %flush-tty/output 1) ; TCOFLUSH
(define %flush-tty/both 2) ; TCIOFLUSH
;;; tcflow() constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define %tcflow/stop-out 1) ; TCOOFF
(define %tcflow/start-out 2) ; TCOON
(define %tcflow/stop-in 3) ; TCIOFF
(define %tcflow/start-in 4) ; TCION
;;; 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.

40
scsh/next/waitcodes.scm Normal file
View File

@ -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 NeXTSTEP.
;;;
;;; 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 (zero? (bitwise-and #xFF 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 (not (zero? (bitwise-and status #x40)))
(bitwise-and #x7F (arithmetic-shift status -8))))
;;; If the process terminated abnormally,
;;; return the terminating signal, otw #f.
(define (status:term-sig status)
(and (not (zero? (bitwise-and status #xFF))) ; Didn't exit.
(zero? (bitwise-and status #x40)) ; Not suspended.
(bitwise-and status #x7F)))
;;; Flags.
(define wait/poll 1) ; Don't hang if nothing to wait for.
(define wait/stopped-children 2) ; Report on suspended subprocs, too.

0
scsh/sunos/Makefile.inc Normal file
View File

12
scsh/sunos/bufpol.scm Normal file
View File

@ -0,0 +1,12 @@
;;; Flags that control buffering policy.
;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
;;; 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 #o200) ; _IOLBF
(none 4)) ; _IONBF

153
scsh/sunos/errno.scm Normal file
View File

@ -0,0 +1,153 @@
;;; Errno constant definitions.
;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
;;; These are the correct values for my SparcStation.
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-enum-constants errno
;; POSIX:
(perm 1) ; Operation not permitted
(noent 2) ; No such file or directory
(srch 3) ; No such process
(intr 4) ; Interrupted function call
(io 5) ; Input/output error
(nxio 6) ; No such device or address
; (2big 7) ; Arg list too long
(noexec 8) ; Exec format error
(badf 9) ; Bad file descriptor
(child 10) ; No child processes
(again 11) ; Resource temporarily unavailable
(nomem 12) ; Not enough space
(acces 13) ; Permission denied
(fault 14) ; Bad address
(notblk 15) ; Block device required
(busy 16) ; Resource busy
(exist 17) ; File exists
(xdev 18) ; Improper 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) ; Inappropriate I/O control operation
(xtbsy 26) ; Text file busy
(fbig 27) ; File too large
(nospc 28) ; No space left on device
(spipe 29) ; Invalid seek
(rofs 30) ; Read-only file system
(mlink 31) ; Too many links
(pipe 32) ; Broken pipe
;; POSIX:
;; math software
(dom 33) ; Domain error
(range 34) ; Result too large
;; non-blocking and interrupt i/o
(wouldblock 35) ; Operation would block
(inprogress 36) ; Operation now in progress
(already 37) ; Operation already in progress
;; ipc/network software
;; argument errors
(notsock 38) ; Socket operation on non-socket
(destaddrreq 39) ; Destination address required
(msgsize 40) ; Message too long
(prototype 41) ; Protocol wrong type for socket
(noprotoopt 42) ; Protocol not available
(protonosupport 43) ; Protocol not supported
(socktnosupport 44) ; Socket type not supported
(opnotsupp 45) ; Operation not supported on socket
(pfnosupport 46) ; Protocol family not supported
(afnosupport 47) ; Address family not supported by protocol family
(addrinuse 48) ; Address already in use
(addrnotavail 49) ; Can't assign requested address
;; operational errors
(netdown 50) ; Network is down
(netunreach 51) ; Network is unreachable
(netreset 52) ; Network dropped connection on reset
(connaborted 53) ; Software caused connection abort
(connreset 54) ; Connection reset by peer
(nobufs 55) ; No buffer space available
(isconn 56) ; Socket is already connected
(notconn 57) ; Socket is not connected
(shutdown 58) ; Can't send after socket shutdown
(toomanyrefs 59) ; Too many references: can't splice
(timedout 60) ; Connection timed out
(connrefused 61) ; Connection refused
(loop 62) ; Too many levels of symbolic links
;; POSIX:
(nametoolong 63) ; File name too long
;; should be rearranged
(hostdown 64) ; Host is down
(hostunreach 65) ; No route to host
;; POSIX:
(notempty 66) ; Directory not empty
;; quotas & mush
(proclim 67) ; Too many processes
(users 68) ; Too many users
(dquot 69) ; Disc quota exceeded
;; Network File System
(stale 70) ; Stale NFS file handle
(remote 71) ; Too many levels of remote in path
;; streams
(nostr 72) ; Device is not a stream
(time 73) ; Timer expired
(nosr 74) ; Out of streams resources
(nomsg 75) ; No message of desired type
(badmsg 76) ; Trying to read unreadable message
;; SystemV IPC
(idrm 77) ; Identifier removed
;; POSIX
;; SystemV Record Locking
(deadlk 78) ; Resource deadlock avoided
(nolck 79) ; No locks available
;; RFS
(nonet 80) ; Machine is not on the network
(rremote 81) ; Object is remote
(nolink 82) ; the link has been severed
(adv 83) ; advertise error
(srmnt 84) ; srmount error
(comm 85) ; Communication error on send
(proto 86) ; Protocol error
(multihop 87) ; multihop attempted
(dotdot 88) ; Cross mount point (not an error)
(remchg 89) ; Remote address changed
;; POSIX
(nosys 90)) ; function not implemented
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Non-POSIX messages
; Some of these SunOS messages are better. Some are stupid.
;
; Error SunOS POSIX
; perm Not owner Operation not permitted
; intr Interrupted system call Interrupted function call
; io I/O error Input/output error
; badf Bad file number Bad file descriptor
; child No children No child processes
; again No more processes Resource temporarily unavailable
; nomem Not enough core Not enough space
; busy Mount device busy Resource busy
; xdev Cross-device link Improper link
; nfile File table overflow Too many open files in system
; notty Not a typewriter Inappropriate I/O control operation
; spipe Illegal seek Invalid seek
; dom Argument too large Domain error
; deadlk Deadlock condition Resource deadlock avoided
; nolck No record locks available No locks available

49
scsh/sunos/fdflags.scm Normal file
View File

@ -0,0 +1,49 @@
;;; Flags for open(2) and fcntl(2).
;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
(define-enum-constants open
(read 0)
(write 1)
(read+write 2)
(append 8)
(create #x0200)
(exclusive #x0800)
(no-control-tty #x8000)
(non-blocking #x4000)
(truncate #x0400)
;;; Not POSIX.
(no-delay 4)
(sync #x2000))
(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 5) ; F_GETOWN (Not Posix)
(set-owner 6) ; F_SETOWN (Not Posix)
(get-record-lock 7) ; F_GETLK
(set-record-lock-no-block 8) ; F_SETLK
(set-record-lock 9)) ; 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 1) ; F_RDLCK
(write 2) ; F_WRLCK
(release 3)) ; F_UNLCK

139
scsh/sunos/libansi.c Normal file
View File

@ -0,0 +1,139 @@
/* OS-dependent support for what is supposed to be the standard ANSI C Library.
** Copyright (c) 1996 by Brian D. Carlstrom.
**
** For SunOS we provide raise and memmove from the BSD distribution.
**
*/
/*-
* Copyright (c) 1990, 1993
* The Regents of the University of California. All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. All advertising materials mentioning features or use of this software
* must display the following acknowledgement:
* This product includes software developed by the University of
* California, Berkeley and its contributors.
* 4. Neither the name of the University nor the names of its contributors
* may be used to endorse or promote products derived from this software
* without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*/
#if defined(LIBC_SCCS) && !defined(lint)
#if 0
static char sccsid[] = "@(#)raise.c 8.1 (Berkeley) 6/4/93";
#else
static char rcsid[] = "$NetBSD: raise.c,v 1.5 1995/02/27 04:35:54 cgd Exp $";
#endif
#endif /* LIBC_SCCS and not lint */
#include <signal.h>
#include <unistd.h>
int
raise(s)
int s;
{
return(kill(getpid(), s));
}
#include <string.h>
/*
* sizeof(word) MUST BE A POWER OF TWO
* SO THAT wmask BELOW IS ALL ONES
*/
typedef long word; /* "word" used for optimal copy speed */
#define wsize sizeof(word)
#define wmask (wsize - 1)
void *
memmove(dst0, src0, length)
void *dst0;
const void *src0;
register size_t length;
{
register char *dst = dst0;
register const char *src = src0;
register size_t t;
if (length == 0 || dst == src) /* nothing to do */
goto done;
/*
* Macros: loop-t-times; and loop-t-times, t>0
*/
#define TLOOP(s) if (t) TLOOP1(s)
#define TLOOP1(s) do { s; } while (--t)
if ((unsigned long)dst < (unsigned long)src) {
/*
* Copy forward.
*/
t = (long)src; /* only need low bits */
if ((t | (long)dst) & wmask) {
/*
* Try to align operands. This cannot be done
* unless the low bits match.
*/
if ((t ^ (long)dst) & wmask || length < wsize)
t = length;
else
t = wsize - (t & wmask);
length -= t;
TLOOP1(*dst++ = *src++);
}
/*
* Copy whole words, then mop up any trailing bytes.
*/
t = length / wsize;
TLOOP(*(word *)dst = *(word *)src; src += wsize; dst += wsize);
t = length & wmask;
TLOOP(*dst++ = *src++);
} else {
/*
* Copy backwards. Otherwise essentially the same.
* Alignment works as before, except that it takes
* (t&wmask) bytes to align, not wsize-(t&wmask).
*/
src += length;
dst += length;
t = (long)src;
if ((t | (long)dst) & wmask) {
if ((t ^ (long)dst) & wmask || length <= wsize)
t = length;
else
t &= wmask;
length -= t;
TLOOP1(*--dst = *--src);
}
t = length / wsize;
TLOOP(src -= wsize; dst -= wsize; *(word *)dst = *(word *)src);
t = length & wmask;
TLOOP(*--dst = *--src);
}
done:
return (dst0);
}

121
scsh/sunos/netconst.scm Normal file
View File

@ -0,0 +1,121 @@
;;; 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 #xffff) ; SOL_SOCKET: options for socket level
;;; socket options -- <sys/socket.h>
(define socket/debug #x0001) ; turn on debugging info recording
(define socket/accept-connect #x0002) ; socket has had listen()
(define socket/reuse-address #x0004) ; allow local address reuse
(define socket/keep-alive #x0008) ; keep connections alive
(define socket/dont-route #x0010) ; just use interface addresses
(define socket/broadcast #x0020) ; permit sending of broadcast msgs
(define socket/use-loop-back #x0040) ; bypass hardware when possible
(define socket/linger #x0080) ; linger on close if data present
(define socket/oob-inline #x0100) ; 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 #x1001) ; send buffer size
(define socket/receive-buffer #x1002) ; 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 #x1007) ; get error status and clear
(define socket/type #x1008) ; get socket type
;;; ip options -- <netinet/in.h>
(define ip/options 1) ; set/get IP per-packet options
;(define ip/time-to-live 2) ; set/get IP time-to-live value
;;; 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
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
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))

112
scsh/sunos/packages.scm Normal file
View File

@ -0,0 +1,112 @@
;;; Interfaces and packages for the Sun specific parts of scsh.
;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
(define-interface sunos-fdflags-extras-interface
(export open/no-delay
open/sync
))
(define-interface sunos-errno-extras-interface
(export errno/addrinuse
errno/addrnotavail
errno/adv
errno/afnosupport
errno/already
errno/badmsg
errno/comm
errno/connaborted
errno/connrefused
errno/connreset
errno/destaddrreq
errno/dotdot
errno/dquot
errno/hostdown
errno/hostunreach
errno/idrm
errno/inprogress
errno/isconn
errno/loop
errno/msgsize
errno/multihop
errno/netdown
errno/netreset
errno/netunreach
errno/nobufs
errno/nolink
errno/nomsg
errno/nonet
errno/noprotoopt
errno/nosr
errno/nostr
errno/notblk
errno/notconn
errno/notsock
errno/opnotsupp
errno/pfnosupport
errno/proclim
errno/proto
errno/protonosupport
errno/prototype
errno/remchg
errno/remote
errno/rremote
errno/shutdown
errno/socktnosupport
errno/srmnt
errno/stale
errno/time
errno/timedout
errno/toomanyrefs
errno/users
errno/wouldblock
errno/xtbsy))
(define-interface sunos-signals-extras-interface
(export signal/cld
signal/iot))
(define-interface sunos-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
ip/options
; ip/time-to-live
tcp/no-delay
tcp/max-segment))
(define-interface sunos-extras-interface
(compound-interface sunos-errno-extras-interface
sunos-fdflags-extras-interface
sunos-network-extras-interface
sunos-signals-extras-interface))
(define-interface sunos-defs-interface
(compound-interface sunos-extras-interface
sockets-network-interface
posix-errno-interface
posix-fdflags-interface
posix-signals-interface
signals-internals-interface))
(define-structure sunos-defs sunos-defs-interface
(open scheme bitwise defenum-package)
(files fdflags errno signals netconst))
(define-interface os-extras-interface sunos-extras-interface)
(define os-dependent sunos-defs)

58
scsh/sunos/signals.scm Normal file
View File

@ -0,0 +1,58 @@
;;; Signal constant definitions for Sun4
;;; Copyright (c) 1994, 1996 by Olin Shivers and Brian D. Carlstrom
;;; See file COPYING.
(define-enum-constants signal
;; POSIX
(hup 1) ; hangup
(int 2) ; interrupt
(quit 3) ; quit
(ill 4) ; illegal instruction (not reset when caught)
;; SunOS
(trap 5) ; trace trap (not reset when caught) */
;; POSIX
(iot 6) ; IOT instruction
(abrt 6) ; used by abort, replace SIGIOT in the future
;; SunOS
(emt 7) ; EMT instruction
;; POSIX
(fpe 8) ; floating point exception
(kill 9) ; kill (cannot be caught or ignored)
;; SunOS
(bus 10) ; bus error
;; POSIX
(segv 11) ; segmentation violation
;; SunOS
(sys 12) ; bad argument to system call
;; POSIX
(pipe 13) ; write on a pipe with no one to read it
(alrm 14) ; alarm clock
(term 15) ; software termination signal from kill
;; SunOS
(urg 16) ; urgent condition on IO channel
;; POSIX
(stop 17) ; sendable stop signal not from tty
(tstp 18) ; stop signal from tty
(cont 19) ; continue a stopped process
(chld 20) ; to parent on child stop or exit
(cld 20) ; System V name for SIGCHLD
(ttin 21) ; to readers pgrp upon background tty read
(ttou 22) ; like TTIN for output if (tp->t_local&LTOSTOP)
;; SunOS
(io 23) ; input/output possible signal
(poll 23) ; System V name for SIGIO
(xcpu 24) ; exceeded CPU time limit
(xfsz 25) ; exceeded file size limit
(vtalrm 26) ; virtual time alarm
(prof 27) ; profiling time alarm
(winch 28) ; window changed
(lost 29) ; resource lost (eg, record-lock lost)
;; POSIX
;; User defined
(usr1 30) ; user defined signal 1
(usr2 31) ; user defined signal 2
)
(define signals-ignored-by-default
(list signal/chld signal/cont ; These are Posix.
signal/urg signal/io signal/winch)) ; These are SunOS.

83
scsh/sunos/stdio_dep.c Normal file
View File

@ -0,0 +1,83 @@
/* 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->_cnt > 0 ? S48_TRUE : char_ready_fdes(fd);
}
void setfileno(FILE *fs, int fd)
{
fileno(fs) = fd;
}
int fbufcount(FILE* fs)
{
return(fs->_cnt);
}
/* Returns true if there is no buffered data in stream FS
** (or there is no buffering, period.)
*/
int ibuf_empty(FILE *fs) {return fs->_cnt <= 0;}
/* Returns true if the buffer in stream FS is full
** (or there is no buffering, period).
*/
int obuf_full(FILE *fs) {return fs->_cnt <= 0;}

13
scsh/sunos/stdio_dep.h Normal file
View File

@ -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
scsh/sunos/sysdep.h Normal file
View File

8
scsh/sunos/time_dep.scm Normal file
View File

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

38
scsh/sunos/time_dep1.c Normal file
View File

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

217
scsh/sunos/tty-consts.scm Normal file
View File

@ -0,0 +1,217 @@
;;; 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 SunOS 4.x.x,
;;; and are taken from /usr/include/sys/termio.h
;;; and /usr/include/sys/termios.h
;;; and /usr/include/sys/ttydev.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 5) ; 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 4) ; !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 11) ; ^y isig
(define ttychar/eol2 6) ; icanon
;;; 4.3+BSD
(define ttychar/status 16) ; ^t icanon
;;; Length of control-char string -- *Not Exported*
(define num-ttychars 17)
;;; Magic "disable feature" tty character
(define disable-tty-char (ascii->char #x00)) ; _POSIX_VDISABLE
;;; Flags controllling input processing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; POSIX
(define ttyin/ignore-break #x00001) ; ignbrk
(define ttyin/interrupt-on-break #x00002) ; brkint
(define ttyin/ignore-bad-parity-chars #x00004) ; ignpar
(define ttyin/mark-parity-errors #x00008) ; parmrk
(define ttyin/check-parity #x00010) ; inpck
(define ttyin/7bits #x00020) ; istrip
(define ttyin/nl->cr #x00040) ; inlcr
(define ttyin/ignore-cr #x00080) ; igncr
(define ttyin/cr->nl #x00100) ; icrnl
(define ttyin/output-flow-ctl #x00400) ; ixon
(define ttyin/input-flow-ctl #x01000) ; ixoff
;;; SVR4 & 4.3+BSD
(define ttyin/xon-any #x800) ; ixany: Any char restarts after stop
(define ttyin/beep-on-overflow #x2000) ; imaxbel: queue full => ring bell
;;; SVR4
(define ttyin/lowercase #x200) ; 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 #x000008) ; ocrnl
(define ttyout/fill-w/del #x000080) ; ofdel
(define ttyout/delay-w/fill-char #x000040) ; ofill
(define ttyout/uppercase #x000002) ; olcuc
(define ttyout/nl-does-cr #x000020) ; onlret
(define ttyout/no-col0-cr #x000010) ; onocr
;;; Newline delay
(define ttyout/nl-delay #x000100) ; mask (nldly)
(define ttyout/nl-delay0 #x000000)
(define ttyout/nl-delay1 #x000100) ; tty 37
;;; Horizontal-tab delay
(define ttyout/tab-delay #x001800) ; mask (tabdly)
(define ttyout/tab-delay0 #x000000)
(define ttyout/tab-delay1 #x000800) ; tty 37
(define ttyout/tab-delay2 #x001000)
(define ttyout/tab-delayx #x001800) ; Expand tabs (xtabs, tab3)
;;; Carriage-return delay
(define ttyout/cr-delay #x000600) ; mask (crdly)
(define ttyout/cr-delay0 #x000000)
(define ttyout/cr-delay1 #x000200) ; tn 300
(define ttyout/cr-delay2 #x000400) ; tty 37
(define ttyout/cr-delay3 #x000600) ; concept 100
;;; Vertical tab delay
(define ttyout/vtab-delay #x004000) ; mask (vtdly)
(define ttyout/vtab-delay0 #x000000)
(define ttyout/vtab-delay1 #x004000) ; tty 37
;;; Backspace delay
(define ttyout/bs-delay #x002000) ; mask (bsdly)
(define ttyout/bs-delay0 #x000000)
(define ttyout/bs-delay1 #x002000)
;;; Form-feed delay
(define ttyout/ff-delay #x008000) ; mask (ffdly)
(define ttyout/ff-delay0 #x000000)
(define ttyout/ff-delay1 #x008000)
(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 #x00030) ; csize: character size mask
(define ttyc/char-size5 #x00000) ; 5 bits (cs5)
(define ttyc/char-size6 #x00010) ; 6 bits (cs6)
(define ttyc/char-size7 #x00020) ; 7 bits (cs7)
(define ttyc/char-size8 #x00030) ; 8 bits (cs8)
(define ttyc/2-stop-bits #x00040) ; cstopb: Send 2 stop bits.
(define ttyc/enable-read #x00080) ; cread: Enable receiver.
(define ttyc/enable-parity #x00100) ; parenb
(define ttyc/odd-parity #x00200) ; parodd
(define ttyc/hup-on-close #x00400) ; hupcl: Hang up on last close.
(define ttyc/no-modem-sync #x00800) ; 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 #x010) ; echoe: Visually erase chars
(define ttyl/echo-delete-line #x020) ; echok: Echo nl after line kill
(define ttyl/echo #x008) ; echo: Enable echoing
(define ttyl/echo-nl #x040) ; echonl: Echo nl even if echo is off
(define ttyl/canonical #x002) ; icanon: Canonicalize input
(define ttyl/enable-signals #x001) ; isig: Enable ^c, ^z signalling
(define ttyl/extended #x8000) ; iexten: Enable extensions
(define ttyl/ttou-signal #x100) ; tostop: SIGTTOU on background output
(define ttyl/no-flush-on-interrupt #x80) ; noflsh
;;; SVR4 & 4.3+BSD
(define ttyl/visual-delete-line #x0800); echoke: visually erase a line-kill
(define ttyl/hardcopy-delete #x0400); echoprt: visual erase for hardcopy
(define ttyl/echo-ctl #x0200); echoctl: echo control chars as "^X"
(define ttyl/flush-output #x2000); flusho: output is being flushed
(define ttyl/reprint-unread-chars #x4000); 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 #x4) ; 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.

40
scsh/sunos/waitcodes.scm Normal file
View File

@ -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 SunOS.
;;;
;;; 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.

0
scsh/ultrix/Makefile.inc Normal file
View File

12
scsh/ultrix/bufpol.scm Normal file
View File

@ -0,0 +1,12 @@
;;; Flags that control buffering policy.
;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
;;; 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 #o200) ; _IOLBF
(none 4)) ; _IONBF

135
scsh/ultrix/errno.scm Normal file
View File

@ -0,0 +1,135 @@
;;; 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 Ultrix.
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-enum-constants errno
;; POSIX:
(perm 1) ; Operation not permitted
(noent 2) ; No such file or directory
(srch 3) ; No such process
(intr 4) ; Interrupted function call
(io 5) ; Input/output error
(nxio 6) ; No such device or address
; (2big 7) ; Arg list too long
(noexec 8) ; Exec format error
(badf 9) ; Bad file descriptor
(child 10) ; No child processes
(again 11) ; Resource temporarily unavailable
(nomem 12) ; Not enough space
(acces 13) ; Permission denied
(fault 14) ; Bad address
(notblk 15) ; Block device required
(busy 16) ; Resource busy
(exist 17) ; File exists
(xdev 18) ; Improper 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) ; Inappropriate I/O control operation
(xtbsy 26) ; Text file busy
(fbig 27) ; File too large
(nospc 28) ; No space left on device
(spipe 29) ; Invalid seek
(rofs 30) ; Read-only file system
(mlink 31) ; Too many links
(pipe 32) ; Broken pipe
;; POSIX:
;; math software
(dom 33) ; Domain error
(range 34) ; Result too large
;; non-blocking and interrupt i/o
(wouldblock 35) ; Operation would block
(inprogress 36) ; Operation now in progress
(already 37) ; Operation already in progress
;; ipc/network software
;; argument errors
(notsock 38) ; Socket operation on non-socket
(destaddrreq 39) ; Destination address required
(msgsize 40) ; Message too long
(prototype 41) ; Protocol wrong type for socket
(noprotoopt 42) ; Protocol not available
(protonosupport 43) ; Protocol not supported
(socktnosupport 44) ; Socket type not supported
(opnotsupp 45) ; Operation not supported on socket
(pfnosupport 46) ; Protocol family not supported
(afnosupport 47) ; Address family not supported by protocol family
(addrinuse 48) ; Address already in use
(addrnotavail 49) ; Can't assign requested address
;; operational errors
(netdown 50) ; Network is down
(netunreach 51) ; Network is unreachable
(netreset 52) ; Network dropped connection on reset
(connaborted 53) ; Software caused connection abort
(connreset 54) ; Connection reset by peer
(nobufs 55) ; No buffer space available
(isconn 56) ; Socket is already connected
(notconn 57) ; Socket is not connected
(shutdown 58) ; Can't send after socket shutdown
(toomanyrefs 59) ; Too many references: can't splice
(timedout 60) ; Connection timed out
(connrefused 61) ; Connection refused
(loop 62) ; Too many levels of symbolic links
;; POSIX:
(nametoolong 63) ; File name too long
;; should be rearranged
(hostdown 64) ; Host is down
(hostunreach 65) ; No route to host
;; POSIX:
(notempty 66) ; Directory not empty
;; quotas & mush
(proclim 67) ; Too many processes
(users 68) ; Too many users
(dquot 69) ; Disc quota exceeded
;; Network File System
(stale 70) ; Stale NFS file handle
(remote 71) ; Too many levels of remote in path
;; ipc
(nomsg 72) ; No message of desired type
(idrm 73) ; Identifier removed
;; alignment
(align 74) ; alignment error
;; SystemV Record Locking
(deadlk 35) ; Resource deadlock avoided
;; POSIX
(nolck 75) ; No locks available
(nosys 76) ; function not implemented
;; * DUP (Diagnostic/Utilities Protocol) related error numbers.
(active 77 ) ; device is active.
(noactive 78 ) ; device is not active.
(noresources 79 ) ; no resources available.
(nosystem 80 ) ; no system block found.
(nodust 81 ) ; getdust failed
(dupnoconn 82 ) ; msdup could not connect to device.
(dupnodisconn 83 ) ; msdup could not disconnect.
(dupnotcntd 84 ) ; server is not connected.
(dupnotidle 85 ) ; server is not idle.
(dupnotwait 86 ) ; server is not waiting for input.
(dupnotrun 87 ) ; server is not running program.
(dupbadopcode 88 ) ; op code not valid.
(dupintransit 89 ) ; an state transition event in progress.
(duptoomanycpus 90 ) ; only single cpu systems supported.
)

52
scsh/ultrix/fdflags.scm Normal file
View File

@ -0,0 +1,52 @@
;;; 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
(read #o000)
(write #o001)
(read+write #o002)
(append #o00010)
(create #o01000)
(exclusive #o04000)
(no-control-tty #o20000000)
(non-blocking #o4000000)
(truncate #o2000)
;;; Not POSIX.
(no-delay #o0004)
(sync #o100000)
; (blkinuse #o10000)
; (blkandset (bitwise-ior #o10000 #o20000))
(termio #o10000000)
)
(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-record-lock 7) ; F_GETLK
(set-record-lock-no-block 8) ; F_SETLK
(set-record-lock 9)) ; 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 1) ; F_RDLCK
(write 2) ; F_WRLCK
(release 3)) ; F_UNLCK

3
scsh/ultrix/libansi.c Normal file
View File

@ -0,0 +1,3 @@
/* OS-dependent support for what is supposed to be the standard ANSI C Library.
** Copyright (c) 1996 by Brian D. Carlstrom.
*/

121
scsh/ultrix/netconst.scm Normal file
View File

@ -0,0 +1,121 @@
;;; 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 #xffff) ; SOL_SOCKET: options for socket level
;;; socket options -- <sys/socket.h>
(define socket/debug #x0001) ; turn on debugging info recording
(define socket/accept-connect #x0002) ; socket has had listen()
(define socket/reuse-address #x0004) ; allow local address reuse
(define socket/keep-alive #x0008) ; keep connections alive
(define socket/dont-route #x0010) ; just use interface addresses
(define socket/broadcast #x0020) ; permit sending of broadcast msgs
(define socket/use-loop-back #x0040) ; bypass hardware when possible
(define socket/linger #x0080) ; linger on close if data present
(define socket/oob-inline #x0100) ; 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 #x1001) ; send buffer size
(define socket/receive-buffer #x1002) ; 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 #x1007) ; get error status and clear
(define socket/type #x1008) ; get socket type
;;; ip options -- <netinet/in.h>
(define ip/options 1) ; set/get IP per-packet options
;(define ip/time-to-live 2) ; set/get IP time-to-live value
;;; 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
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
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))

129
scsh/ultrix/packages.scm Normal file
View File

@ -0,0 +1,129 @@
;;; Interfaces and packages for the machine specific parts of scsh for Ultrix.
;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
(define-interface ultrix-fdflags-extras-interface
(export open/no-delay
open/sync
; open/bklinuse
; open/bklandset
open/termio
))
(define-interface ultrix-errno-extras-interface
(export errno/addrinuse
errno/addrnotavail
errno/afnosupport
errno/align
errno/already
errno/connaborted
errno/connrefused
errno/connreset
errno/destaddrreq
errno/dquot
errno/hostdown
errno/hostunreach
errno/idrm
errno/inprogress
errno/isconn
errno/loop
errno/msgsize
errno/netdown
errno/netreset
errno/netunreach
errno/nobufs
errno/nomsg
errno/noprotoopt
errno/notblk
errno/notconn
errno/notsock
errno/opnotsupp
errno/pfnosupport
errno/proclim
errno/protonosupport
errno/prototype
errno/remote
errno/shutdown
errno/socktnosupport
errno/stale
errno/timedout
errno/toomanyrefs
errno/users
errno/wouldblock
errno/xtbsy
errno/active
errno/noactive
errno/noresources
errno/nosystem
errno/nodust
errno/dupnoconn
errno/dupnodisconn
errno/dupnotcntd
errno/dupnotidle
errno/dupnotwait
errno/dupnotrun
errno/dupbadopcode
errno/dupintransit
errno/duptoomanycpus
))
(define-interface ultrix-signals-extras-interface
(export signal/cld
signal/iot
signal/trap
signal/emt
signal/io
signal/urg
signal/xcpu
signal/xfsz
signal/vtalrm
signal/prof
signal/winch
signal/lost
))
(define-interface ultrix-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
ip/options
; ip/time-to-live
tcp/no-delay
tcp/max-segment))
(define-interface ultrix-extras-interface
(compound-interface ultrix-errno-extras-interface
ultrix-fdflags-extras-interface
ultrix-network-extras-interface
ultrix-signals-extras-interface))
(define-interface ultrix-defs-interface
(compound-interface ultrix-extras-interface
sockets-network-interface
posix-errno-interface
posix-fdflags-interface
posix-signals-interface
signals-internals-interface))
(define-structure ultrix-defs ultrix-defs-interface
(open scheme bitwise defenum-package)
(files fdflags errno signals netconst))
(define-interface os-extras-interface ultrix-extras-interface)
(define os-dependent ultrix-defs)

50
scsh/ultrix/signals.scm Normal file
View File

@ -0,0 +1,50 @@
;;; Signal constant definitions for Ultrix
;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
;;POSIX only defined here.
(define-enum-constants signal
;; POSIX
(hup 1) ; hangup
(int 2) ; interrupt
(quit 3) ; quit
(ill 4) ; illegal instruction (not reset when caught)
(trap 5) ; trace trap (not reset when caught)
(iot 6) ; IOT instruction
(abrt 6) ; compat
(emt 7) ; EMT instruction
(fpe 8) ; floating point exception
(kill 9) ; kill (cannot be caught or ignored)
;; Ultrix
(bus 10)
;; POSIX
(segv 11) ; segmentation violation
(sys 12) ; bad argument to system call
(pipe 13) ; write on a pipe with no one to read it
(alrm 14) ; alarm clock
(term 15) ; software termination signal from kill
(urg 16) ; urgent condition on IO channel
(stop 17) ; sendable stop signal not from tty
(tstp 18) ; stop signal from tty
(cont 19) ; continue a stopped process
(chld 20) ; to parent on child stop or exit
(cld 20) ; compat
(ttin 21) ; to readers pgrp upon background tty read
(ttou 22) ; like TTIN for output if (tp->t_local&LTOSTOP)
(io 23) ; input/output possible signal
(xcpu 24) ; exceeded cpu time limit
(xfsz 25) ; exceeded file size limit
(vtalrm 26) ; virtual time alarm
(prof 27) ; profiling time alarm
(winch 28) ; window size changes
(lost 29) ; sys-v rec lock: notify user upon server crash
;; User defined
(usr1 30) ; user defined signal 1
(usr2 31) ; user defined signal 2
)
(define signals-ignored-by-default
(list signal/cont signal/chld
signal/urg signal/io signal/winch))

83
scsh/ultrix/stdio_dep.c Normal file
View File

@ -0,0 +1,83 @@
/* 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->_cnt > 0 ? S48_TRUE : char_ready_fdes(fd);
}
void setfileno(FILE *fs, int fd)
{
fileno(fs) = fd;
}
int fbufcount(FILE* fs)
{
return(fs->_cnt);
}
/* Returns true if there is no buffered data in stream FS
** (or there is no buffering, period.)
*/
int ibuf_empty(FILE *fs) {return fs->_cnt <= 0;}
/* Returns true if the buffer in stream FS is full
** (or there is no buffering, period).
*/
int obuf_full(FILE *fs) {return fs->_cnt <= 0;}

13
scsh/ultrix/stdio_dep.h Normal file
View File

@ -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
scsh/ultrix/sysdep.h Normal file
View File

8
scsh/ultrix/time_dep.scm Normal file
View File

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

38
scsh/ultrix/time_dep1.c Normal file
View File

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

216
scsh/ultrix/tty-consts.scm Normal file
View File

@ -0,0 +1,216 @@
;;; 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 Ultrix 4.2
;;; and are taken from /usr/include/sys/termio.h
;;; and /usr/include/sys/termios.h
;;; and /usr/include/sys/ttydev.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 5) ; 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 12) ; ^q ixon, ixoff
(define ttychar/stop 11) ; ^s ixon, ixoff
(define ttychar/min 8) ; !icanon ; Not exported
(define ttychar/time 9) ; !icanon ; Not exported
;;; SVR4 & 4.3+BSD
(define ttychar/delete-word 16) ; ^w icanon
(define ttychar/reprint 14) ; ^r icanon
(define ttychar/literal-next 17) ; ^v iexten
(define ttychar/discard #f) ; ^o iexten
(define ttychar/delayed-suspend 13) ; ^y isig
(define ttychar/eol2 6) ; 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 #f) ; 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 #o006000) ; mask (tabdly)
(define ttyout/tab-delay0 #o000000)
(define ttyout/tab-delay1 #o000000) ; tty 37
(define ttyout/tab-delay2 #o000000)
(define ttyout/tab-delayx #o006000) ; Expand tabs (xtabs, tab3)
;;; Carriage-return delay
(define ttyout/cr-delay #o030000) ; mask (crdly)
(define ttyout/cr-delay0 #o000000)
(define ttyout/cr-delay1 #o010000) ; tn 300
(define ttyout/cr-delay2 #o020000) ; tty 37
(define ttyout/cr-delay3 #o030000) ; concept 100
;;; Vertical tab delay
(define ttyout/vtab-delay #o001000) ; mask (vtdly)
(define ttyout/vtab-delay0 #o000000)
(define ttyout/vtab-delay1 #o001000) ; 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 #o400) ; iexten: Enable extensions
(define ttyl/ttou-signal #f) ; tostop: SIGTTOU on background output
(define ttyl/no-flush-on-interrupt #o200) ; noflsh
;;; SVR4 & 4.3+BSD
(define ttyl/visual-delete-line #f) ; echoke: visually erase a line-kill
(define ttyl/hardcopy-delete #f) ; echoprt: visual erase for hardcopy
(define ttyl/echo-ctl #f) ; echoctl: echo control chars as "^X"
(define ttyl/flush-output #f) ; flusho: output is being flushed
(define ttyl/reprint-unread-chars #f) ; 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 . 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.

40
scsh/ultrix/waitcodes.scm Normal file
View File

@ -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 Ultrix.
;;;
;;; 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.