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

added linux/ from 0.5.2 but s48_ adapted

This commit is contained in:
marting 1999-10-14 16:25:18 +00:00
parent bd1b187663
commit 7f9aa175d6
18 changed files with 1035 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

@ -0,0 +1,13 @@
;;; Flags that control buffering policy.
;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
;;; Copyright (c) 1995 by Brian D. Carlstrom.
;;; These are for the SET-PORT-BUFFERING procedure, essentially a Scheme
;;; analog of the setbuf(3S) stdio call. We use the actual stdio values.
;;; These constants are not likely to change from stdio lib to stdio lib,
;;; but you need to check when you do a port.
(define-enum-constants bufpol
(block 0) ; _IOFBF
(line 1) ; _IOLBF
(none 2)) ; _IONBF

126
scsh/linux/errno.scm Normal file
View File

@ -0,0 +1,126 @@
;;; Errno constant definitions.
;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
;;; These are the correct values for Linux systems.
(define errno/2big 7) ; 2big is not a legit Scheme symbol. Lose, lose.
(define-enum-constants errno
(perm 1) ; Not super-user
(noent 2) ; No such file or directory
(srch 3) ; No such process
(intr 4) ; Interrupted system call
(io 5) ; I/O error
(nxio 6) ; No such device or address
(2big 7) ; Arg list too long
(noexec 8) ; Exec format error
(badf 9) ; Bad file number
(child 10) ; No children
(again 11) ; No more processes
(wouldblock 11) ; EAGAIN again
(nomem 12) ; Not enough core
(acces 13) ; Permission denied
(fault 14) ; Bad address
(notblk 15) ; Block device required
(busy 16) ; Mount device busy
(exist 17) ; File exists
(xdev 18) ; Cross-device link
(nodev 19) ; No such device
(notdir 20) ; Not a directory
(isdir 21) ; Is a directory
(inval 22) ; Invalid argument
(nfile 23) ; Too many open files in system
(mfile 24) ; Too many open files
(notty 25) ; Not a typewriter
(txtbsy 26) ; Text file busy
(fbig 27) ; File too large
(nospc 28) ; No space left on device
(spipe 29) ; Illegal seek
(rofs 30) ; Read only file system
(mlink 31) ; Too many links
(pipe 32) ; Broken pipe
(dom 33) ; Math arg out of domain of func
(range 34) ; Math result not representable
(nomsg 35) ; No message of desired type
(idrm 36) ; Identifier removed
(chrng 37) ; Channel number out of range
(l2nsync 38) ; Level 2 not synchronized
(l3hlt 39) ; Level 3 halted
(l3rst 40) ; Level 3 reset
(lnrng 41) ; Link number out of range
(unatch 42) ; Protocol driver not attached
(nocsi 43) ; No CSI structure available
(l2hlt 44) ; Level 2 halted
(deadlk 45) ; Deadlock condition
(nolck 46) ; No record locks available
(bade 50) ; Invalid exchange
(badr 51) ; Invalid request descriptor
(xfull 52) ; Exchange full
(noano 53) ; No anode
(badrqc 54) ; Invalid request code
(badslt 55) ; Invalid slot
(deadlock 56) ; File locking deadlock error
(bfont 57) ; Bad font file fmt
(nostr 60) ; Device not a stream
(nodata 61) ; No data (for no delay io)
(time 62) ; Timer expired
(nosr 63) ; Out of streams resources
(nonet 64) ; Machine is not on the network
(nopkg 65) ; Package not installed
(remote 66) ; The object is remote
(nolink 67) ; The link has been severed
(adv 68) ; Advertise error
(srmnt 69) ; Srmount error
(comm 70) ; Communication error on send
(proto 71) ; Protocol error
(multihop 74) ; Multihop attempted
(lbin 75) ; Inode is remote (not really error)
(dotdot 76) ; Cross mount point (not really error)
(badmsg 77) ; Trying to read unreadable message
(notuniq 80) ; Given log. name not unique
(badfd 81) ; f.d. invalid for this operation
(remchg 82) ; Remote address changed
(libacc 83) ; Can't access a needed shared lib
(libbad 84) ; Accessing a corrupted shared lib
(libscn 85) ; .lib section in a.out corrupted
(libmax 86) ; Attempting to link in too many libs
(libexec 87) ; Attempting to exec a shared library
(nosys 88) ; Function not implemented
(nmfile 89) ; No more files
(notempty 90) ; Directory not empty
(nametoolong 91) ; File or path name too long
(loop 92) ; Too many symbolic links
(opnotsupp 95) ; Operation not supported on transport endpoint
(pfnosupport 96) ; Protocol family not supported
(connreset 104) ; Connection reset by peer
(nobufs 105) ; No buffer space available
(afnosupport 106) ;
(prototype 107) ;
(notsock 108) ;
(noprotoopt 109) ;
(shutdown 110) ;
(connrefused 111) ; Connection refused
(addrinuse 112) ; Address already in use
(connaborted 113) ; Connection aborted
(netunreach 114) ;
(netdown 115) ;
(timedout 116) ;
(hostdown 117) ;
(hostunreach 118) ;
(inprogress 119) ;
(already 120) ;
(destaddrreq 121) ;
(msgsize 122) ;
(protonosupport 123) ;
(socktnosupport 124) ;
(addrnotavail 125) ;
(netreset 126) ;
(isconn 127) ;
(notconn 128) ;
(toomanyrefs 129) ;
(proclim 130) ;
(users 131) ;
(dquot 132) ;
(stale 133) ;
(notsup 134)) ;

57
scsh/linux/fdflags.scm Normal file
View File

@ -0,0 +1,57 @@
;;; Flags for open(2) and fcntl(2).
;;; Copyright (c) 1993 by Olin Shivers. See file COPYING.
;;; Copyright (c) 1994 by Brian D. Carlstrom
(define-enum-constants open
;; POSIX
(read #x0000)
(write #x0001)
(read+write #x0002)
(non-blocking #x0800) ; no delay
(append #x0400) ; set append mode
;; Linux
(shared-lock #x0004) ; open with shared file lock
(exclusive-lock #x0008) ; open with exclusive file lock
(async #x2000) ; signal pgrep when data ready
(fsync #x1000) ; synchronus writes
;; POSIX
(create #x0040) ; create if nonexistant
(truncate #x0200) ; truncate to zero length
(exclusive #x0080) ; error if already exists
(no-control-tty #x0100)) ; don't assign controlling terminal
(define open/access-mask
(bitwise-ior open/read
(bitwise-ior open/write open/read+write)))
;;; fcntl() commands
(define-enum-constants fcntl
(dup-fdes 0) ; F_DUPFD
(get-fdes-flags 1) ; F_GETFD
(set-fdes-flags 2) ; F_SETFD
(get-status-flags 3) ; F_GETFL
(set-status-flags 4) ; F_SETFL
(get-owner 9) ; F_GETOWN (Not POSIX)
(set-owner 8) ; F_SETOWN (Not POSIX)
(get-record-lock 5) ; F_GETLK
(set-record-lock-no-block 6) ; F_SETLK
(set-record-lock 7)) ; F_SETLKW
;;; fcntl fdes-flags (F_GETFD)
(define fdflags/close-on-exec 1)
;;; fcntl status-flags (F_GETFL)
;;; Mostly, these are OPEN/... flags, like OPEN/APPEND.
;;; (define fdstatus/... ...)
;;; fcntl lock values.
(define-enum-constants lock
(read 0) ; F_RDLCK
(release 2) ; F_UNLCK
(write 1)) ; F_WRLCK

79
scsh/linux/fix_stdio.c Normal file
View File

@ -0,0 +1,79 @@
#include <stdio.h>
/* The current stdio lib that Linux uses has a problem that screws up
** scsh's interrupt system: when a stdio function such as getc() or fputs()
** blocks in an i/o system call, and that system call is interrupted, the
** stdio function realises this and loops, retrying the the i/o operation.
** What we need is for the stdio function to return an error, with
** errno=EINTR -- i.e., we need for the stdio function to give control back
** to the caller, telling it that the i/o call was interrupted.
**
** The EINTR error return is in fact mandated by Posix. The next release
** of the GNU libc will provide this functionality. The current release
** doesn't. So we use the workaround in this file. Calling
** remove_bone_from_head_of_linux_libc()
** will smash the call tables of the i/o library so that non-retrying
** functions get called to do the i/o system calls.
**
** Why does scsh need non-retry? Because in scsh, Unix signals are *not*
** handled by the actual Unix signal handler. The signal handler is just
** a piece of C code that sets a bit, notifying the S48 vm that it needs
** to service a signal. When the vm gets to a vm instruction boundary,
** it suspends execution of the program and services the interrupt by
** invoking a *Scheme* function. In this way, we can interrupt on VM
** instruction boundaries with VM interrupt handlers.
**
** If a C function retries when interrupted, we never return to Scheme,
** and so the vm never has a chance to service the interrupt. This is bad.
**
** This code was contributed by Roland McGrath.
*/
#ifdef __GLIBC__
/* GNU libc 2.0 needs no fixing. */
void remove_bone_from_head_of_linux_libc () {}
#else
#include <libio.h>
extern _IO_ssize_t _IO_file_read (_IO_FILE *, void *, _IO_ssize_t);
_IO_ssize_t
my_linux_file_read (_IO_FILE *fp, void *buf, _IO_ssize_t size)
{
return read (fp->_fileno, buf, size);
}
extern _IO_ssize_t _IO_file_write (_IO_FILE *, const void *, _IO_ssize_t);
_IO_ssize_t
my_linux_file_write (_IO_FILE *fp, const void *buf, _IO_ssize_t size)
{
return write (fp->_fileno, buf, size);
}
static void
debone (_IO_ssize_t (**jumptable) ())
{
_IO_ssize_t (**p) ();
int r, w;
r = w = 0;
for (p = jumptable; !r || !w; ++p)
{
if (*p == &_IO_file_read)
++r, *p = &my_linux_file_read;
else if (*p == &_IO_file_write)
++w, *p = &my_linux_file_write;
}
}
void
remove_bone_from_head_of_linux_libc ()
{
extern _IO_ssize_t (*_IO_file_jumps[]) (); /* used for normal fds */
extern _IO_ssize_t (*_IO_proc_jumps[]) (); /* used by popen */
debone (_IO_file_jumps);
debone (_IO_proc_jumps);
}
#endif

6
scsh/linux/libansi.c Normal file
View File

@ -0,0 +1,6 @@
/* OS-dependent support for what is supposed to be the standard ANSI C Library.
** Copyright (c) 1996 by Brian D. Carlstrom.
*/
/* Bogus hack so we don't have to add another file to the Makefile list. */
#include "fix_stdio.c"

128
scsh/linux/netconst.scm Normal file
View File

@ -0,0 +1,128 @@
;;; Magic Numbers for Networking
;;; Copyright (c) 1994 by Brian D. Carlstrom. See file COPYING.
;;; magic numbers not from header file
;;; but from man page
;;; why can't unix make up its mind
(define shutdown/receives 0)
(define shutdown/sends 1)
(define shutdown/sends+receives 2)
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
;;; BELOW THIS POINT ARE BITS FROM:
;;; <sys/socket.h>
;;; <sys/un.h>
;;; <netinet/in.h>
;;; <netinet/tcp.h>
;;; <netdb.h>
;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
;;; ADDRESS FAMILIES -- <sys/socket.h>
(define address-family/unspecified 0) ; unspecified
(define address-family/unix 1) ; local to host (pipes, portals)
(define address-family/internet 2) ; internetwork: UDP, TCP, etc.
;;; SOCKET TYPES -- <sys/socket.h>
(define socket-type/stream 1) ; stream socket
(define socket-type/datagram 2) ; datagram socket
(define socket-type/raw 3) ; raw-protocol interface
;;(define socket-type/rdm 4) ; reliably-delivered message
;;(define socket-type/seqpacket 5) ; sequenced packet stream
;;; PROTOCOL FAMILIES -- <sys/socket.h>
(define protocol-family/unspecified 0) ; unspecified
(define protocol-family/unix 1) ; local to host (pipes, portals)
(define protocol-family/internet 2) ; internetwork: UDP, TCP, etc.
;;; Well know addresses -- <netinet/in.h>
(define internet-address/any #x00000000)
(define internet-address/loopback #x7f000001)
(define internet-address/broadcast #xffffffff) ; must be masked
;;; errors from host lookup -- <netdb.h>
(define herror/host-not-found 1) ;Authoritative Answer Host not found
(define herror/try-again 2) ;Non-Authoritive Host not found, or SERVERFAIL
(define herror/no-recovery 3) ;Non recoverable errors, FORMERR, REFUSED, NOTIMP
(define herror/no-data 4) ;Valid name, no data record of requested type
(define herror/no-address herror/no-data) ;no address, look for MX record
;;; flags for send/recv -- <sys/socket.h>
(define message/out-of-band 1) ; process out-of-band data
(define message/peek 2) ; peek at incoming message
(define message/dont-route 4) ; send without using routing tables
;;; protocol level for socket options -- <sys/socket.h>
(define level/socket #x1) ; SOL_SOCKET: options for socket level
;;; socket options -- <sys/socket.h>
(define socket/debug 1) ; turn on debugging info recording
;(define socket/accept-connect #x0002) ; socket has had listen()
(define socket/reuse-address 2) ; allow local address reuse
(define socket/keep-alive 9) ; keep connections alive
(define socket/dont-route 5) ; just use interface addresses
(define socket/broadcast 6) ; permit sending of broadcast msgs
;(define socket/use-loop-back #x0040) ; bypass hardware when possible
(define socket/linger 13) ; linger on close if data present
(define socket/oob-inline 10) ; leave received OOB data in line
;(define socket/use-privileged #x4000) ; allocate from privileged port area
;(define socket/cant-signal #x8000) ; prevent SIGPIPE on SS_CANTSENDMORE
(define socket/send-buffer 7) ; send buffer size
(define socket/receive-buffer 8) ; receive buffer size
;(define socket/send-low-water #x1003) ; send low-water mark
;(define socket/receive-low-water #x1004) ; receive low-water mark
;(define socket/send-timeout #x1005) ; send timeout
;(define socket/receive-timeout #x1006) ; receive timeout
(define socket/error 4) ; get error status and clear
(define socket/type 3) ; get socket type
(define socket/no-check 11) ; linux
(define socket/priority 12) ; sucks
;;; ip options -- <netinet/in.h>
(define ip/type-of-service 1) ; set/get IP type of service value
(define ip/time-to-live 2) ; set/get IP time-to-live value
(define ip/include-header 3) ; include header with data
(define ip/options 4) ; set/get IP per-packet options
;;; tcp options -- <netinet/tcp.h>
(define tcp/no-delay #x01) ; don't delay send to coalesce packets
(define tcp/max-segment #x02) ; set maximum segment size
;;; -=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
;;; OPTION SETS FOR SOCKET-OPTION AND SET-SOCKET-OPTION
;;; Boolean Options
(define options/boolean
(list socket/debug
; socket/accept-connect
socket/reuse-address
socket/keep-alive
socket/dont-route
socket/broadcast
; socket/use-loop-back
socket/oob-inline
; socket/use-privileged
; socket/cant-signal
ip/include-header
tcp/no-delay))
;;; Integer Options
(define options/value
(list socket/send-buffer
socket/receive-buffer
; socket/send-low-water
; socket/receive-low-water
socket/error
socket/type
ip/time-to-live
ip/type-of-service
tcp/max-segment))
;;; #f or Positive Integer
(define options/linger
(list socket/linger))
;;; Real Number
(define options/timeout
(list ;socket/send-timeout
;socket/receive-timeout
))

125
scsh/linux/packages.scm Normal file
View File

@ -0,0 +1,125 @@
;;; Interfaces and packages for the Linux specific parts of scsh.
;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
(define-interface linux-fdflags-extras-interface
(export open/shared-lock
open/exclusive-lock
open/async
open/fsync
fcntl/get-owner
fcntl/set-owner))
(define-interface linux-errno-extras-interface
(export errno/notblk
errno/txtbsy
errno/wouldblock
errno/inprogress
errno/already
errno/notsock
errno/destaddrreq
errno/msgsize
errno/prototype
errno/noprotoopt
errno/protonosupport
errno/socktnosupport
errno/opnotsupp
errno/pfnosupport
errno/afnosupport
errno/addrinuse
errno/addrnotavail
errno/netdown
errno/netunreach
errno/netreset
errno/connaborted
errno/connreset
errno/nobufs
errno/isconn
errno/notconn
errno/shutdown
errno/toomanyrefs
errno/timedout
errno/connrefused
errno/loop
errno/hostdown
errno/hostunreach
; errno/proclim
errno/users
errno/dquot
errno/stale
errno/remote
; errno/badrpc
; errno/rpcmismatch
; errno/progunavail
; errno/progmismatch
; errno/ftype
; errno/auth
; errno/needauth
; errno/last
))
(define-interface linux-signals-extras-interface
(export signal/trap
; signal/emt
signal/bus
; signal/sys
signal/urg
signal/cld
signal/io
signal/xcpu
signal/xfsz
signal/vtalrm
signal/prof
signal/winch
))
(define-interface linux-network-extras-interface
(export socket/debug
; socket/accept-connect
socket/reuse-address
socket/keep-alive
socket/dont-route
socket/broadcast
; socket/use-loop-back
socket/linger
socket/oob-inline
; socket/use-privileged
; socket/cant-signal
socket/send-buffer
socket/receive-buffer
; socket/send-low-water
; socket/receive-low-water
; socket/send-timeout
; socket/receive-timeout
socket/error
socket/type
socket/no-check
socket/priority
ip/options
ip/time-to-live
ip/type-of-service ;linux
ip/include-header ;linux
tcp/no-delay
tcp/max-segment))
(define-interface linux-extras-interface
(compound-interface linux-errno-extras-interface
linux-fdflags-extras-interface
linux-network-extras-interface
linux-signals-extras-interface))
(define-interface linux-defs-interface
(compound-interface linux-extras-interface
sockets-network-interface
posix-errno-interface
posix-fdflags-interface
posix-signals-interface
signals-internals-interface))
(define-structure linux-defs linux-defs-interface
(open scheme bitwise defenum-package)
(files fdflags errno signals netconst))
(define-interface os-extras-interface linux-extras-interface)
(define os-dependent linux-defs)

45
scsh/linux/signals.scm Normal file
View File

@ -0,0 +1,45 @@
;;; Signal constant definitions for Linux
;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
(define-enum-constants signal
;; POSIX
(hup 1)
(int 2)
(quit 3)
(ill 4)
(trap 5)
(abrt 6)
(iot 6)
(bus 7)
(fpe 8)
(kill 9)
(usr1 10)
(segv 11)
(usr2 12)
(pipe 13)
(alrm 14)
(term 15)
(stkflt 16)
(chld 17)
(cld 17) ;compat
(cont 18)
(stop 19)
(tstp 20)
(ttin 21)
(ttou 22)
(urg 23)
(xcpu 24)
(xfsz 25)
(vtalrm 26)
(prof 27)
(winch 28)
(io 29)
(poll 29)
(pwr 30)
(unused 31)
)
(define signals-ignored-by-default
(list signal/chld signal/cont signal/winch))

52
scsh/linux/signals1.c Normal file
View File

@ -0,0 +1,52 @@
/* This is bogus -- currently unchanged from the bsd file. */
/* Need to turn off synchronous error signals (SIGPIPE, SIGSYS). */
#include "../scsh_aux.h"
/* Make sure our exports match up w/the implementation: */
#include "../signals1.h"
/* This table converts Unix signal numbers to S48/scsh interrupt numbers.
** If the signal doesn't have an interrupt number, the entry is -1.
** (Only asynchronous signals have interrupt numbers.)
**
** Note that we bake into this table the integer values of the signals --
** i.e., we assume that SIGHUP=1, SIGALRM=15, etc. So this definition is
** very system-dependent.
*/
const int sig2int[] = {
-1, /* 0 is not a signal */
scshint_hup, /* SIGHUP */
scshint_keyboard, /* SIGINT */
scshint_quit, /* SIGQUIT */
-1, /* SIGILL */
-1, /* SIGTRAP */
-1, /* SIGABRT & SIGIOT */
-1, /* SIGBUS */
-1, /* SIGFPE */
-1, /* SIGKILL */
scshint_usr1, /* SIGUSR1 */
-1, /* SIGSEGV */
scshint_usr2, /* SIGUSR2 */
-1, /* SIGPIPE */
scshint_alarm, /* SIGALRM */
scshint_term, /* SIGTERM */
-1, /* SIGTKFLT (x86 coprocessor stack fault) */
scshint_chld, /* SIGCHLD */
scshint_cont, /* SIGCONT */
-1, /* SIGSTOP */
scshint_tstp, /* SIGTSTP */
-1, /* scshint_ttyin, /* SIGTTIN */
-1, /* scshint_ttou, /* SIGTTOU */
scshint_urg, /* SIGURG */
scshint_xcpu, /* SIGXCPU */
scshint_xfsz, /* SIGXFSZ */
scshint_vtalrm, /* SIGVTALRM */
scshint_prof, /* SIGPROF */
scshint_winch, /* SIGWINCH */
scshint_io, /* SIGIO aka SIGPOLL*/
scshint_pwr, /* SIGPWR */
-1 /* SIGPWR */
};
const int max_sig = 31; /* SIGUNUSED */

10
scsh/linux/sigset.h Normal file
View File

@ -0,0 +1,10 @@
/* Convert between a lo24/hi integer-pair bitset and a sigset_t value.
** These macros are OS-dependent, and must be defined per-OS.
*/
#define make_sigset(maskp, hi, lo) \
((maskp)->__val[0] = (unsigned long int) ((hi) << 24) | (lo))
#define split_sigset(mask, hip, lop)\
((*(hip) = ((mask).__val[0] >> 24) & 0xff),\
(*(lop) = ((mask).__val[0] & 0xffffff)))

80
scsh/linux/stdio_dep.c Normal file
View File

@ -0,0 +1,80 @@
/* Copyright (c) 1994 by Olin Shivers.
** Copyright (c) 1994-1995 by Brian D. Carlstrom.
**
** This file implements the char-ready? procedure for file descriptors
** and Scsh's fdports. It is not Posix, so it must be implemented for
** each OS to which scsh is ported.
**
** This version assumes two things:
** - the existence of select to tell if there is data
** available for the file descriptor.
** - the existence of the _cnt field in the stdio FILE struct, telling
** if there is any buffered input in the struct.
**
** Most Unixes have these things, so this file should work for them.
** However, Your Mileage May Vary.
**
** You could also replace the select() with a iotctl(FIONREAD) call, if you
** had one but not the other.
** -Olin&Brian
*/
#include <sys/types.h>
#include <sys/time.h>
#include <stdio.h>
#include <unistd.h>
#include "libcig.h"
#include <errno.h>
#include "stdio_dep.h" /* Make sure the .h interface agrees with the code. */
/* These two procs return #t if data ready, #f data not ready,
** and errno if error.
*/
s48_value char_ready_fdes(int fd)
{
fd_set readfds;
struct timeval timeout;
int result;
FD_ZERO(&readfds);
FD_SET(fd,&readfds);
timeout.tv_sec=0;
timeout.tv_usec=0;
result=select(fd+1, &readfds, NULL, NULL, &timeout);
if(result == -1 )
return(s48_enter_fixnum(errno));
if(result)
return(S48_TRUE);
return(S48_FALSE);
}
s48_value stream_char_readyp(FILE *f)
{
int fd = fileno(f);
return (f->_IO_read_ptr < f->_IO_read_end) ? S48_TRUE : char_ready_fdes(fd);
}
void setfileno(FILE *fs, int fd)
{
fs->_fileno = fd;
}
int fbufcount(FILE *fs)
{
return((fs->_IO_read_end)-(fs->_IO_read_ptr));
}
int ibuf_empty(FILE *fs)
{
return((fs->_IO_read_end)-(fs->_IO_read_ptr) <= 0);
}
int obuf_full(FILE *fs)
{
return((fs->_IO_write_end)-(fs->_IO_write_ptr) <= 0);
}

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

8
scsh/linux/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/linux/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;
}

215
scsh/linux/tty-consts.scm Normal file
View File

@ -0,0 +1,215 @@
;;; Constant definitions for tty control code (POSIX termios).
;;; Copyright (c) 1995 by Brian Carlstrom. See file COPYING.
;;; Largely rehacked by Olin.
;;; These constants are for Solaris 2.x,
;;; and are taken from /usr/include/sys/termio.h
;;; and /usr/include/sys/termios.h.
;;; Non-standard (POSIX, SVR4, 4.3+BSD) things:
;;; - Some of the baud rates.
;;; Special Control Characters
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Indices into the c_cc[] character array.
;;; Name Subscript Enabled by
;;; ---- --------- ----------
;;; POSIX
(define ttychar/eof 4) ; ^d icanon
(define ttychar/eol 11) ; icanon
(define ttychar/delete-char 2) ; ^? icanon
(define ttychar/delete-line 3) ; ^u icanon
(define ttychar/interrupt 0) ; ^c isig
(define ttychar/quit 1) ; ^\ isig
(define ttychar/suspend 10) ; ^z isig
(define ttychar/start 8) ; ^q ixon, ixoff
(define ttychar/stop 9) ; ^s ixon, ixoff
(define ttychar/min 6) ; !icanon ; Not exported
(define ttychar/time 5) ; !icanon ; Not exported
;;; SVR4 & 4.3+BSD
(define ttychar/delete-word 14) ; ^w icanon
(define ttychar/reprint 12) ; ^r icanon
(define ttychar/literal-next 15) ; ^v iexten
(define ttychar/discard 13) ; ^o iexten
(define ttychar/delayed-suspend #f) ; ^y isig
(define ttychar/eol2 16) ; icanon
;;; 4.3+BSD
(define ttychar/status #f) ; ^t icanon
;;; Length of control-char string -- *Not Exported*
(define num-ttychars 19)
;;; Magic "disable feature" tty character
(define disable-tty-char (ascii->char #x00)) ; _POSIX_VDISABLE
;;; Flags controllling input processing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; POSIX
(define ttyin/ignore-break #o00001) ; ignbrk
(define ttyin/interrupt-on-break #o00002) ; brkint
(define ttyin/ignore-bad-parity-chars #o00004) ; ignpar
(define ttyin/mark-parity-errors #o00010) ; parmrk
(define ttyin/check-parity #o00020) ; inpck
(define ttyin/7bits #o00040) ; istrip
(define ttyin/nl->cr #o00100) ; inlcr
(define ttyin/ignore-cr #o00200) ; igncr
(define ttyin/cr->nl #o00400) ; icrnl
(define ttyin/output-flow-ctl #o02000) ; ixon
(define ttyin/input-flow-ctl #o10000) ; ixoff
;;; SVR4 & 4.3+BSD
(define ttyin/xon-any #o4000) ; ixany: Any char restarts after stop
(define ttyin/beep-on-overflow #o20000) ; imaxbel: queue full => ring bell
;;; SVR4
(define ttyin/lowercase #o1000) ; iuclc: Map upper-case to lower case
;;; Flags controlling output processing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; POSIX
(define ttyout/enable #o000001) ; opost: enable output processing
;;; SVR4 & 4.3+BSD
(define ttyout/nl->crnl #o000004) ; onlcr: map nl to cr-nl
;;; 4.3+BSD
(define ttyout/discard-eot #f) ; onoeot
(define ttyout/expand-tabs #f) ; oxtabs (NOT xtabs)
;;; SVR4
(define ttyout/cr->nl #o000010) ; ocrnl
(define ttyout/fill-w/del #o000200) ; ofdel
(define ttyout/delay-w/fill-char #o000100) ; ofill
(define ttyout/uppercase #o000002) ; olcuc
(define ttyout/nl-does-cr #o000040) ; onlret
(define ttyout/no-col0-cr #o000020) ; onocr
;;; Newline delay
(define ttyout/nl-delay #o000400) ; mask (nldly)
(define ttyout/nl-delay0 #o000000)
(define ttyout/nl-delay1 #o000400) ; tty 37
;;; Horizontal-tab delay
(define ttyout/tab-delay #o014000) ; mask (tabdly)
(define ttyout/tab-delay0 #o000000)
(define ttyout/tab-delay1 #o004000) ; tty 37
(define ttyout/tab-delay2 #o010000)
(define ttyout/tab-delayx #o014000) ; Expand tabs (xtabs, tab3)
;;; Carriage-return delay
(define ttyout/cr-delay #o003000) ; mask (crdly)
(define ttyout/cr-delay0 #o000000)
(define ttyout/cr-delay1 #o001000) ; tn 300
(define ttyout/cr-delay2 #o002000) ; tty 37
(define ttyout/cr-delay3 #o003000) ; concept 100
;;; Vertical tab delay
(define ttyout/vtab-delay #o040000) ; mask (vtdly)
(define ttyout/vtab-delay0 #o000000)
(define ttyout/vtab-delay1 #o040000) ; tty 37
;;; Backspace delay
(define ttyout/bs-delay #o020000) ; mask (bsdly)
(define ttyout/bs-delay0 #o000000)
(define ttyout/bs-delay1 #o020000)
;;; Form-feed delay
(define ttyout/ff-delay #o100000) ; mask (ffdly)
(define ttyout/ff-delay0 #o000000)
(define ttyout/ff-delay1 #o100000)
(define ttyout/all-delay
(bitwise-ior (bitwise-ior (bitwise-ior ttyout/nl-delay ttyout/tab-delay)
(bitwise-ior ttyout/cr-delay ttyout/vtab-delay))
(bitwise-ior ttyout/bs-delay ttyout/ff-delay)))
;;; Control flags - hacking the serial-line.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; POSIX
(define ttyc/char-size #o00060) ; csize: character size mask
(define ttyc/char-size5 #o00000) ; 5 bits (cs5)
(define ttyc/char-size6 #o00020) ; 6 bits (cs6)
(define ttyc/char-size7 #o00040) ; 7 bits (cs7)
(define ttyc/char-size8 #o00060) ; 8 bits (cs8)
(define ttyc/2-stop-bits #o00100) ; cstopb: Send 2 stop bits.
(define ttyc/enable-read #o00200) ; cread: Enable receiver.
(define ttyc/enable-parity #o00400) ; parenb
(define ttyc/odd-parity #o01000) ; parodd
(define ttyc/hup-on-close #o02000) ; hupcl: Hang up on last close.
(define ttyc/no-modem-sync #o04000) ; clocal: Ignore modem lines.
;;; 4.3+BSD
(define ttyc/ignore-flags #f) ; cignore: ignore control flags
(define ttyc/CTS-output-flow-ctl #f) ; ccts_oflow: CTS flow control of output
(define ttyc/RTS-input-flow-ctl #f) ; crts_iflow: RTS flow control of input
(define ttyc/carrier-flow-ctl #f) ; mdmbuf
;;; Local flags -- hacking the tty driver / user interface.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; POSIX
(define ttyl/visual-delete #o020) ; echoe: Visually erase chars
(define ttyl/echo-delete-line #o040) ; echok: Echo nl after line kill
(define ttyl/echo #o010) ; echo: Enable echoing
(define ttyl/echo-nl #o100) ; echonl: Echo nl even if echo is off
(define ttyl/canonical #o002) ; icanon: Canonicalize input
(define ttyl/enable-signals #o001) ; isig: Enable ^c, ^z signalling
(define ttyl/extended #o100000) ; iexten: Enable extensions
(define ttyl/ttou-signal #o400) ; tostop: SIGTTOU on background output
(define ttyl/no-flush-on-interrupt #o200) ; noflsh
;;; SVR4 & 4.3+BSD
(define ttyl/visual-delete-line #o04000); echoke: visually erase a line-kill
(define ttyl/hardcopy-delete #o02000); echoprt: visual erase for hardcopy
(define ttyl/echo-ctl #o01000); echoctl: echo control chars as "^X"
(define ttyl/flush-output #o10000); flusho: output is being flushed
(define ttyl/reprint-unread-chars #o40000); pendin: retype pending input
;;; 4.3+BSD
(define ttyl/alt-delete-word #f) ; altwerase
(define ttyl/no-kernel-status #f) ; nokerninfo: no kernel status on ^T
;;; SVR4
(define ttyl/case-map #o4) ; xcase: canonical upper/lower presentation
;;; Vector of (speed . code) pairs.
(define baud-rates '#((0 . 0) (1 . 50) (2 . 75)
(3 . 110) (4 . 134) (5 . 150)
(6 . 200) (7 . 300) (8 . 600)
(9 . 1200) (10 . 1800) (11 . 2400)
(12 . 4800) (13 . 9600) (14 . 19200)
(15 . 38400) (14 . exta) (15 . extb)))
;;; tcflush() constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define %flush-tty/input 0) ; TCIFLUSH
(define %flush-tty/output 1) ; TCOFLUSH
(define %flush-tty/both 2) ; TCIOFLUSH
;;; tcflow() constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define %tcflow/start-out 1) ; TCOON
(define %tcflow/stop-out 0) ; TCOOFF
(define %tcflow/start-in 3) ; TCION
(define %tcflow/stop-in 2) ; TCIOFF
;;; tcsetattr() constants
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define %set-tty-info/now 0) ; TCSANOW Make change immediately.
(define %set-tty-info/drain 1) ; TCSADRAIN Drain output, then change.
(define %set-tty-info/flush 2) ; TCSAFLUSH Drain output, flush input.

40
scsh/linux/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 Linux.
;;;
;;; I could have done a portable version by making C calls for this,
;;; but it's such overkill.
;;; If process terminated normally, return the exit code, otw #f.
(define (status:exit-val status)
(and (not (= (bitwise-and #xFF status) #x7F))
(zero? (bitwise-and #x7F status))
(bitwise-and #xFF (arithmetic-shift status -8))))
;;; If the process was suspended, return the suspending signal, otw #f.
(define (status:stop-sig status)
(and (= #x7F (bitwise-and status #xFF))
(bitwise-and #xFF (arithmetic-shift status -8))))
;;; If the process terminated abnormally,
;;; return the terminating signal, otw #f.
(define (status:term-sig status)
(let ((termsig (bitwise-and status #x7F)))
(and (not (zero? termsig)) ; Didn't exit.
(not (= #x7F (bitwise-and status #xFF))) ; Not suspended.
termsig)))
;;; Flags.
(define wait/poll 1) ; Don't hang if nothing to wait for.
(define wait/stopped-children 2) ; Report on suspended subprocs, too.