Added hpux (untested)

This commit is contained in:
mainzelm 2000-12-19 16:33:51 +00:00
parent 59a757fccf
commit d7d0c6f3b8
18 changed files with 978 additions and 0 deletions

View File

@ -214,6 +214,17 @@ 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
## HP 9000 series 700 and 800, running HP/UX
hppa*-hp-hpux* )
dir=hpux
LDFLAGS="-Wl,-E"
if test ${CC} = cc; then
CFLAGS="-Ae -O +Obb1800"
AC_DEFINE(_HPUX_SOURCE)
AC_DEFINE(hpux)
fi
;;
## IBM AIX ## IBM AIX
rs6000-ibm-aix*|powerpc-ibm-aix* ) rs6000-ibm-aix*|powerpc-ibm-aix* )
dir=aix dir=aix

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

12
scsh/hpux/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

144
scsh/hpux/errno.scm Normal file
View File

@ -0,0 +1,144 @@
;;; HP-UX errno definitions. This file adapted from errno.h on an HP machine.
;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
;;; NOTE: When the hp9000s500 symbol is set, errno.h defines ENOMSG to be 250
;;; instead of 35. What to do? We go with 35 in this file.
(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
(nomem 12) ; Not enough core
(acces 13) ; Permission denied
(fault 14) ; Bad address
(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) ; File table overflow
(mfile 24) ; Too many open files
(notty 25) ; Not a typewriter
(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
(deadlk 45) ; A deadlock would occur
(nolck 46) ; System record lock table was full
(ilseq 47) ; Illegal byte sequence
(notempty 247) ; Directory not empty
(nametoolong 248) ; File name too long
(nosys 251) ; Function not implemented
;; Things in XPG3 not in POSIX or ANSI C.
(notblk 15) ; Block device required
(txtbsy 26) ; Text file busy
(nomsg 35) ; No message of desired type
(idrm 36) ; Identifier removed
;; Things in AES not in XPG3, POSIX or ANSI C.
(loop 249) ; Too many levels of symbolic links
;; Things in HP-UX not in XPG3, POSIX or ANSI C.
;; The error numbers between 37 and 44 are not produced by HP-UX.
;; They will track whatever the UNIX(tm) system does in the future.
(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
(nonet 50) ; Machine is not on the network
(nodata 51) ; no data (for no delay io)
(time 52) ; timer expired
(nosr 53) ; out of streams resources
(nostr 54) ; Device not a stream
(nopkg 55) ; Package not installed
(nolink 57) ; the link has been severed
(adv 58) ; advertise error
(srmnt 59) ; srmount error
(comm 60) ; Communication error on send
(proto 61) ; Protocol error
(multihop 64) ; multihop attempted
(dotdot 66) ; Cross mount point (not really error)
(badmsg 67) ; trying to read unreadable message
(nosym 215) ; symbol does not exist in executable
(users 68) ; For Sun compatibilty, will not occur.
(dquot 69) ; Disc quota exceeded
(stale 70) ; Stale NFS file handle
(remote 71) ; Too many levels of remote in path
;; hp9000s500 only
(unexpect 99) ; Unexpected Error
;; hp9000s300, hp9000s800
;; ipc/network software
;; Argument errors
(notsock 216) ; Socket operation on non-socket
(destaddrreq 217) ; Destination address required
(msgsize 218) ; Message too long
(prototype 219) ; Protocol wrong type for socket
(noprotoopt 220) ; Protocol not available
(protonosupport 221) ; Protocol not supported
(socktnosupport 222) ; Socket type not supported
(opnotsupp 223) ; Operation not supported
(pfnosupport 224) ; Protocol family not supported
(afnosupport 225) ; Address family not supported by
; protocol family
(addrinuse 226) ; Address already in use
(addrnotavail 227) ; Can't assign requested address
;; operational errors
(netdown 228) ; Network is down
(netunreach 229) ; Network is unreachable
(netreset 230) ; Network dropped connection on reset
(connaborted 231) ; Software caused connection abort
(connreset 232) ; Connection reset by peer
(nobufs 233) ; No buffer space available
(isconn 234) ; Socket is already connected
(notconn 235) ; Socket is not connected
(shutdown 236) ; Can't send after socket shutdown
(toomanyrefs 237) ; Too many references: can't splice
(timedout 238) ; Connection timed out
(connrefused 239) ; Connection refused
;; hp9000s800 only
(refused errno/connrefused) ; Double define for NFS
(remoterelease 240) ; Remote peer released connection
(hostdown 241) ; Host is down
(hostunreach 242) ; No route to host
;; endif hp9000s300, hp9000s800
(already 244) ; Operation already in progress
(inprogress 245) ; Operation now in progress
(wouldblock 246) ; Operation would block
;; hp9000s500 only
; (nomsg 250) ; No message of desired type
)

47
scsh/hpux/fdflags.scm Normal file
View File

@ -0,0 +1,47 @@
;;; 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 #o200000)
(append #o10)
(no-control-tty #o400000)
(create #o0400)
(truncate #o1000)
(exclusive #o2000)
;; NextStep
(sync #o100000)) ; Synchronous writes
(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 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 1) ; F_RDLCK
(write 2) ; F_WRLCK
(release 3)) ; F_UNLCK

3
scsh/hpux/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.
*/

128
scsh/hpux/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 #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
(define socket/send-avoid-copy #x1009) ; avoid copy on send
(define socket/receive-avoid-copy #x100a) ; avoid copy on rcv
;;; ip options -- <netinet/in.h>
(define ip/options 1) ; set/get IP per-packet options
(define ip/multicast-if 2) ; set/get ip multicast interface
(define ip/multicast-ttl 3) ; set/get ip multicast timetolive
(define ip/multicast-loop 4) ; set/get ip multicast loopback
(define ip/add-membership 5) ; add an ip group membership
(define ip/drop-membership 6) ; drop an ip group membership
(define ip/time-to-live 16) ; 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))

65
scsh/hpux/packages.scm Normal file
View File

@ -0,0 +1,65 @@
;;; Interfaces and packages for the HP-UX specific parts of scsh.
;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
(define-interface hpux-fdflags-extras-interface
(export open/sync))
(define-interface hpux-errno-extras-interface
(export errno/wouldblock))
(define-interface hpux-signals-extras-interface
(export))
(define-interface hpux-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/send-avoid-copy ;hpux
socket/receive-avoid-copy ;hpux
;; all options except ip/options & ip/time-to-live hpux specific
ip/options
ip/multicast-if
ip/multicast-ttl
ip/multicast-loop
ip/add-membership
ip/drop-membership
ip/time-to-live
tcp/no-delay
tcp/max-segment))
(define-interface hpux-extras-interface
(compound-interface hpux-errno-extras-interface
hpux-fdflags-extras-interface
hpux-network-extras-interface
hpux-signals-extras-interface))
(define-interface hpux-defs-interface
(compound-interface hpux-extras-interface
sockets-network-interface
posix-errno-interface
posix-fdflags-interface
posix-signals-interface
signals-internals-interface))
(define-structure hpux-defs hpux-defs-interface
(open scheme bitwise defenum-package)
(files fdflags errno signals netconst))
(define-interface os-extras-interface hpux-extras-interface)
(define os-dependent hpux-defs)

48
scsh/hpux/signals.scm Normal file
View File

@ -0,0 +1,48 @@
;;; Signal constant definitions for HP-UX
;;; Copyright (c) 1994 by Olin Shivers. See file COPYING.
;;; Copyright (c) 1994 by Brian D. Carlstrom.
(define-enum-constants signal
(hup 1) ; floating point exception
(int 2) ; Interrupt
(quit 3) ; quit
(ill 4) ; Illegal instruction (not reset when caught)
(trap 5) ; trace trap (not reset when caught)
(abrt 6) ; Process abort signal
(iot signal/abrt) ; IOT instruction
(emt 7) ; EMT instruction
(fpe 8) ; Floating point exception
(kill 9) ; kill (cannot be caught of ignored)
(bus 10) ; bus error
(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
(usr1 16) ; user defined signal 1
(usr2 17) ; user defined signal 2
(chld 18) ; Child process terminated or stopped
(cld signal/chld) ; death of a child
(pwr 19) ; power state indication
(vtalrm 20) ; virtual timer alarm
(prof 21) ; profiling timer alarm
(io 22) ; asynchronous I/O
(poll signal/io) ; for HP-UX hpstreams signal
(winch 23) ; window size change signal
(window signal/winch) ; added for compatibility reasons
(stop 24) ; Stop signal (cannot be caught or ignored)
(tstp 25) ; Interactive stop signal
(cont 26) ; Continue if stopped
(ttin 27) ; Read from control terminal attempted by a
; member of a background process group
(ttou 28) ; Write to control terminal attempted by a
; member of a background process group
(urg 29) ; urgent condition on IO channel
(lost 30) ; remote lock lost (NFS)
; Signal 31 is reserved for future use.
(dil 32)) ; DIL signal
(define signals-ignored-by-default
(list signal/chld signal/cont ; These are Posix.
signal/io signal/pwr signal/urg signal/winch)) ; These are HP-UX.

99
scsh/hpux/signals1.c Normal file
View File

@ -0,0 +1,99 @@
/* 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, /* 1: SIGHUP */
scshint_keyboard, /* 2: SIGINT */
scshint_quit, /* 3: SIGQUIT */
-1, /* 4: SIGILL */
-1, /* 5: SIGTRAP */
-1, /* 6: SIGABRT */
-1, /* 7: SIGEMT */
-1, /* 8: SIGFPE */
-1, /* 9: SIGKILL */
-1, /* 10: SIGBUS */
-1, /* 11: SIGSEGV */
-1, /* 12: SIGSYS */
-1, /* 13: SIGPIPE */
scshint_alarm, /* 14: SIGALRM */
scshint_term, /* 15: SIGTERM */
scshint_usr1, /* 16: SIGUSR1 */
scshint_usr2, /* 17: SIGUSR2 */
scshint_chld, /* 18: SIGCHLD */
scshint_pwr, /* 19: SIGPWR */
scshint_vtalrm, /* 20: SIGVTALRM */
scshint_prof, /* 21: SIGPROF */
scshint_io, /* 22: SIGIO */
scshint_winch, /* 23: SIGWINCH */
-1, /* 24: SIGSTOP */
scshint_tstp, /* 25: SIGTSTP */
scshint_cont, /* 26: SIGCONT */
-1, /* 27: SIGTTIN */ /* scshint_ttyin */
-1, /* 28: SIGTTOU */ /* scshint_ttyou */
scshint_urg, /* 29: SIGURG */
-1, /* 30: SIGLOST */
-1, /* 32: SIGDIL */
scshint_xcpu, /* 33: SIGXCPU */
scshint_xfsz /* 34: SIGXFSZ */
};
const int max_sig = 34; /* SIGXFSZ */
/*
scshint_alarm
scshint_keyboard
scshint_memory_shortage
scshint_chld
scshint_cont
scshint_hup
scshint_quit
scshint_term
scshint_tstp
scshint_usr1
scshint_usr2
scshint_info
scshint_io
scshint_poll
scshint_prof
scshint_pwr
scshint_urg
scshint_vtalrm
scshint_winch
scshint_xcpu
scshint_xfsz
scshint_alarm
scshint_chld
scshint_cont
scshint_hup
scshint_info
scshint_io
scshint_keyboard
scshint_memory_shortage
scshint_poll
scshint_prof
scshint_pwr
scshint_quit
scshint_term
scshint_tstp
scshint_urg
scshint_usr1
scshint_usr2
scshint_vtalrm
scshint_winch
scshint_xcpu
scshint_xfsz
*/

10
scsh/hpux/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)->sigset[0]=((hi)<<24)|(lo))
/* Not a procedure: */
#define split_sigset(mask, hip, lop) \
((*(hip)=((mask).sigset[0]>>24)&0xff), \
(*(lop)=((mask).sigset[0]&0xffffff)))

84
scsh/hpux/stdio_dep.c Normal file
View File

@ -0,0 +1,84 @@
/* 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)
{
fs->__fileL = (fd & 0xFF);
fs->__fileH = ((fd>>8) & 0xFF);
}
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/hpux/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/hpux/sysdep.h Normal file
View File

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

228
scsh/hpux/tty-consts.scm Normal file
View File

@ -0,0 +1,228 @@
;;; 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 HP-UX,
;;; and are taken from /usr/include/sys/termio.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 13) ; ^z isig
(define ttychar/start 14) ; ^q ixon, ixoff
(define ttychar/stop 15) ; ^s ixon, ixoff
(define ttychar/min 11) ; !icanon ; Not exported
(define ttychar/time 12) ; !icanon ; Not exported
;;; SVR4 & 4.3+BSD
(define ttychar/delete-word #f) ; ^w icanon
(define ttychar/reprint #f) ; ^r icanon
(define ttychar/literal-next #f) ; ^v iexten
(define ttychar/discard #f) ; ^o iexten
(define ttychar/delayed-suspend #f) ; ^y isig
(define ttychar/eol2 #f) ; icanon
;;; 4.3+BSD
(define ttychar/status #f) ; ^t icanon
;;; Length of control-char string -- *Not Exported*
(define num-ttychars 16)
;;; Magic "disable feature" tty character
(define disable-tty-char (ascii->char #xff)) ; _POSIX_VDISABLE
;;; HP-UX brain death:
;;; HP-UX defines NCCS to be 16, then sneaks the DSUSP char (^y) in as
;;; a seventeenth char -- there's another non-standard NLDCC constant
;;; defined to be 1+16 that's used elsewhere. Since the scsh interface
;;; to tcsetattr() uses a char vec of size NCCS, you can't get at this
;;; hidden char. So we do not support the delayed-suspension char; sorry.
;;;
;;; If you are an HP-UX hacker, and know a way to fix this, let me know.
;;; 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 #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 #o00140) ; csize: character size mask
(define ttyc/char-size5 #o00000) ; 5 bits (cs5)
(define ttyc/char-size6 #o00040) ; 6 bits (cs6)
(define ttyc/char-size7 #o00100) ; 7 bits (cs7)
(define ttyc/char-size8 #o00140) ; 8 bits (cs8)
(define ttyc/2-stop-bits #o00200) ; cstopb: Send 2 stop bits.
(define ttyc/enable-read #o00400) ; cread: Enable receiver.
(define ttyc/enable-parity #o01000) ; parenb
(define ttyc/odd-parity #o02000) ; parodd
(define ttyc/hup-on-close #o04000) ; hupcl: Hang up on last close.
(define ttyc/no-modem-sync #o10000) ; 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 #o20000000000); iexten: Enable extensions
(define ttyl/ttou-signal #o10000000000); 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 . 900) (10 . 1200) (11 . 1800)
(12 . 2400) (13 . 3600) (14 . 4800)
(15 . 7200) (16 . 9600) (17 . 19200)
(18 . 38400) (19 . 57600) (20 . 115200)
(21 . 230400) (22 . 460800) ; 23-29 unused.
(30 . exta) (31 . 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/hpux/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 HPUX.
;;;
;;; 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 (= #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 ((low-byte (bitwise-and status #xFF)))
(and (not (= low-byte 0)) ; Didn't exit.
(not (= low-byte #x7F)) ; 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.