scsh-0.5/scsh/fdports1.c

530 lines
14 KiB
C

/* This file contains the code for doing the scsh file ports stuff.
** Copyright (c) 1993, 1994 by Olin Shivers.
**
** Note that this code mutates Scheme records -- it has the layout
** of fdports and their data records wired in. This is somewhat fragile.
*/
/* A note on the clearerr() calls herein: SunOS stdio input routines,
** contrary to POSIX, will return EOF if the stream's EOF flag is set,
** without trying to read the stream. This is a lose for tty's, which
** can frequently still be read from after the first EOF (e.g., if you
** type a ^D to bag out of a breakpoint, you would like the terminal
** input port to not shut down forever.)
**
** To fix this lossage, we are careful to call clearerr() before every
** input stream op.
*/
/* We maintain the following invariant: every open port has a FILE*
** associated with it.
*/
#include "sysdep.h"
#include <stdio.h>
#include <fcntl.h>
#include <unistd.h>
#include <stdlib.h>
#include <errno.h>
#include "cstuff.h"
#define NUM_FDPORTS 256
#include "fdports.h"
#include "machine/stdio_dep.h"
/* Make sure our exports match up w/the implementation: */
#include "fdports1.h"
extern int errno;
/* Maps fd's to FILE*'s. */
static FILE *fstar_cache[NUM_FDPORTS] = {NULL};
/* Maps fd's to ports. */
static scheme_value fdports[NUM_FDPORTS] = {SCHFALSE};
extern void remove_bone_from_head_of_linux_libc (void);
void init_fdports(void)
{
int i = NUM_FDPORTS;
while( i-- ) fdports[i] = SCHFALSE;
remove_bone_from_head_of_linux_libc();
/* Specially hack stdio. */
fstar_cache[fileno(stdin)] = stdin;
fstar_cache[fileno(stdout)] = stdout;
fstar_cache[fileno(stderr)] = stderr;
}
/* (maybe_fdes2port fd)
** Return: the port if there is one allocated; otherwise #f.
** If a port is returned, the revealed count is NOT incremented.
*/
scheme_value maybe_fdes2port(int fd)
{
if( fd < 0 || fd >= NUM_FDPORTS )
return SCHFALSE;
return fdports[fd];
}
#if 0
/* Bogus old code. We now compute the mode string from the actual fd. */
static char const *mode2string(int mode)
{
if( mode == 0 ) return "r";
else if( mode == 1 ) return "w";
else if( mode == 2 ) return "r+";
else return "x"; /* What??? */
}
#endif
static char const *fdes_modestr(int fd)
{
int flags = fcntl(fd,F_GETFL);
if( flags == -1 ) return NULL;
flags &= O_ACCMODE;
if( flags == O_WRONLY ) return "w";
else if( flags == O_RDONLY ) return "r";
else if( flags == O_RDWR ) return "r+";
fputs("That's impossible.\n", stderr);
abort();
_exit(-1);
/*NOTREACHED*/
}
/* Returns a char, #f for EOF, or errno. */
scheme_value fdport_getchar(scheme_value data)
{
int fd = EXTRACT_FIXNUM(*PortData_Fd(data));
FILE *f = fstar_cache[fd];
int c;
clearerr(f);
c = getc(f);
if( EOF == c )
return ferror(f) ? ENTER_FIXNUM(errno) : SCHFALSE;
else
return ENTER_CHAR(c);
}
int fdport_putchar(scheme_value data, char c)
{
int fd = EXTRACT_FIXNUM(*PortData_Fd(data));
FILE *f = fstar_cache[fd];
int retval = putc(c,f);
return (retval == EOF) ? errno : 0;
}
/* Not POSIX, so we punt to an OS-specific routine. */
scheme_value fdport_char_readyp(scheme_value data)
{
extern scheme_value stream_char_readyp(FILE *);
return stream_char_readyp(fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))]);
}
int flush_fdport(scheme_value data)
{
FILE *f = fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))];
return fflush(f) ? errno : 0;
}
/* This is actually just fflush(NULL), but apparently the pinheads
** at Sun can't be bothered to implement ANSI C or POSIX, so this op
** cleverly dumps core. Hence we do this incomplete approximation.
*/
int flush_all_ports(void)
{
int i;
for(i=0; i<NUM_FDPORTS; i++)
if(fstar_cache[i]) fflush(fstar_cache[i]);
return 0;
/* return fflush(NULL) ? errno : 0; THE REAL SOLUTION.*/
}
int seek_fdport(scheme_value data, off_t offset, int whence, int *newpos)
{
FILE *f = fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))];
*PortData_Peek(data) = SCHFALSE; /* Flush buffered data. */
if( fseek(f, offset, whence) ) /* seek */
{ *newpos = 0; return errno; }
*newpos = ftell(f); /* tell */
return (*newpos < 0) ? errno : 0;
}
int tell_fdport( scheme_value data, int *newpos )
{
FILE *f = fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))];
*newpos = ftell(f);
return (*newpos < 0) ? errno : 0;
}
int set_fdbuf( scheme_value data, int policy, int bufsize )
{
FILE *f = fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))];
int size = (bufsize < 0) ? BUFSIZ : bufsize;
return setvbuf(f, NULL, policy, size) ? errno : 0;
}
int close_fdport(scheme_value port_data)
{
if( *PortData_Closed(port_data) == SCHFALSE ) {
int fd = EXTRACT_FIXNUM(*PortData_Fd(port_data));
FILE *f = fstar_cache[fd];
if( fclose(f) ) return errno;
*PortData_Fd(port_data) = SCHFALSE;
fdports[fd] = SCHFALSE;
*PortData_Closed(port_data) = SCHTRUE;
*PortData_Peek(port_data) = SCHFALSE;
fstar_cache[fd] = NULL;
return 0;
}
else return EBADF; /* Already closed. */
}
static int cloexec_fdport(scheme_value port_data)
{
int fd = EXTRACT_FIXNUM(*PortData_Fd(port_data));
return fcntl(fd, F_SETFD, FD_CLOEXEC) ? errno : 0;
}
int install_port(int fd, scheme_value port, int revealed)
{
FILE *stream;
const char *modestr;
if( fd < 0 || fd >= NUM_FDPORTS ) return -1;
if( fdports[fd] != SCHFALSE ) return -2;
if( !(modestr = fdes_modestr(fd)) )
return -3;
fdports[fd] = port;
if( !revealed )
if( set_cloexec(fd, 1) ) return errno;
if( fstar_cache[fd] ) return 0; /* A hack mainly for stdio. */
fstar_cache[fd] = stream = fdopen(fd, modestr);
return stream ? 0 : errno;
}
FILE *fdes2fstar(int fd)
{
if( fstar_cache[fd] ) return fstar_cache[fd];
else {
const char *modestr = fdes_modestr(fd);
return modestr ? fdopen(fd, modestr) : NULL;
}
}
/* fd_from's FILE* structure is changed to be fd_to's FILE* structure.
** So buffered data isn't lost. Return 0 on failure.
** Rather non-portable.
*/
static int move_fstar(int fd_from, int fd_to)
{
FILE *f1 = fdes2fstar(fd_from);
if( !f1 ) return 0;
setfileno(f1, fd_to);
fstar_cache[fd_from] = NULL;
fstar_cache[fd_to] = f1;
return 1;
}
/* Move port so that it's underlying file descriptor is fd.
** The port's underlying FILE* is also shifted over, so that
** buffered data isn't lost on a shift. Return 0 on success.
*/
int move_fdport(int fd, scheme_value port, int new_revealed)
{
scheme_value port_data = *Port_PortData(port);
int old_fd = EXTRACT_FIXNUM(*PortData_Fd(port_data));
if( fd < 0 || fd >= NUM_FDPORTS ) return 1;
/* You are allowed to "move" a port to its current fd.
Otherwise, the fd must be unallocated. Kluge. */
if( fdports[fd] != port ) {
if( fdports[fd] != SCHFALSE ) return 1; /* Target already allocated. */
if( !move_fstar(old_fd, fd) ) return 1;
fdports[fd] = port;
fdports[old_fd] = SCHFALSE;
*PortData_Fd(port_data) = ENTER_FIXNUM(fd);
}
/* Unreveal the port by shifting the revealed count
over to the old-revealed count. */
*PortData_OldRev(port_data) = ENTER_FIXNUM(EXTRACT_FIXNUM(*PortData_OldRev(port_data))+
EXTRACT_FIXNUM(*PortData_Rev(port_data)));
*PortData_Rev(port_data) = ENTER_FIXNUM(new_revealed);
if( !new_revealed ) return set_cloexec(fd, 1);
return 0;
}
/* Scan the fdports vector after a gc. Uncopied unrevealed ports
** have their fds closed. The fdports vec is updated with the copy.
*/
#ifdef TEST_GC
void post_gc_fdports(void) {}
#else
void post_gc_fdports(void)
{
int fd;
#ifdef NOISY_FDGC
fputs("{GC", stderr); fflush(stderr);
#endif
for(fd=0; fd<NUM_FDPORTS; fd++) {
scheme_value port = fdports[fd];
if(STOBP(port)) {
long header = STOB_HEADER(port);
if(STOBP(header)) {
#ifdef NOISY_FDGC
fprintf(stderr, "Copying port[fd] %d[%d] header %d\n",
port, fd, header);
fflush(stderr);
#endif
/* Port was copied, so update fdports entry. */
fdports[fd] = header;
}
else {
/* Port wasn't copied -- is garbage.
If fd unrevealed, close it. */
int rev = EXTRACT_FIXNUM(*PortRev(port));
#ifdef NOISY_FDGC
fprintf(stderr, "GC'ing %srevealed port[fd] %d[%d]\n",
rev == 0 ? "un" : "",
port, fd);
fflush(stderr);
#endif
if( rev == 0 )
/* Close, even if interrupted -- GC's must be atomic. */
while( EINTR == close_fdport(*Port_PortData(port)) );
fdports[fd] = SCHFALSE; /* Drop the port. */
}
}
}
#ifdef NOISY_FDGC
fputs("}", stderr); fflush(stderr);
#endif
}
#endif
#define Min(a,b) (((a) < (b)) ? (a) : (b)) /* Not a function. */
/* Note the clearerr() call. This is so a ^D on a tty input stream
** doesn't shut the stream down forever. SunOS doesn't handle this according
** to POSIX spec, so we have to explicitly hack this case.
*/
static int read_stream_substring(scheme_value buf, int start, int end, FILE *f)
{
char *p = StrByte(buf,start);
int len = end-start;
clearerr(f);
/* If there's data in the buffer, use it. */
if (fbufcount(f) > 0)
return fread(p, 1, Min(len, fbufcount(f)), f);
/* Otherwise, do a read. */
return read(fileno(f), p, len);
}
#define MIN(a,b) (((a) < (b)) ? (a) : (b)) /* Not a function. */
int read_fdport_substring(scheme_value buf, int start, int end, scheme_value data)
{
scheme_value peek = *PortData_Peek(data);
FILE *f = fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))];
clearerr(f); /* SunOS sux. */
/* If there's a peek char, then we'll use it and
whatever is buffered in the FILE*. */
if( IsChar(peek) ) {
int len = end-start;
if( len > 0 ) {
char *p = StrByte(buf,start);
*p++ = EXTRACT_CHAR(peek);
*PortData_Peek(data) = SCHFALSE;
return 1 + fread(p, 1, MIN(len-1, fbufcount(f)), f);
}
else return 0;
}
/* Otherwise, just do a read_stream_substring. */
return read_stream_substring(buf, start, end, f);
}
/* We assume either fileno(f) does blocking i/o or f is unbuffered. */
int write_fdport_substring(scheme_value buf, int start, int end, scheme_value data)
{
FILE *f = fstar_cache[EXTRACT_FIXNUM(*PortData_Fd(data))];
int retval = fwrite(StrByte(buf,start), 1, end-start, f);
return ferror(f) ? -1 : retval; /* -1: error, 0: eof */
}
/* 1st return value says why we terminated the read:
** - integer errno if error.
** - char c if string terminated by char c (which is consumed).
** - eof object if string terminated by EOF
** - #f if buf overflow.
**
** 2nd return value is num chars read into BUF.
**
** GOBBLE boolean says whether or not to read a terminating delimiter char
** or just leave it in the input stream.
**
** N.B.:
** - This code is dependent on the representation of scsh's char-sets.
** We assume they are 256-elt strings. If this changes, we'd have to
** rewrite the code.
** - This procedure is made more complex by the fact that we may have to take
** the first char read from the *port's* peek-char slot.
** - buffer-full/terminated-char ties are broken in favor of successful
** termination.
*/
scheme_value read_delim(const char *delims, char *buf, int gobble,
scheme_value port, int start, int end,
int *nread)
{
scheme_value data = *Port_PortData(port);
scheme_value peekc = *PortData_Peek(data);
int fd = EXTRACT_FIXNUM(*PortData_Fd(data));
FILE *f = fstar_cache[fd];
char *cptr = buf+start-1, /* Location of last char deposited. */
*bufend = buf+end-1; /* Last writeable position. */
/* This chunk of code is necessary because we have to check
** the port's one-char pushback slot before going to the port's
** stdio FILE*. Yech.
*/
if( IsChar(peekc) ) {
char c = EXTRACT_CHAR(peekc);
if( delims[c] ) { /* Is c in cset? */
if( gobble ) *PortData_Peek(data) = SCHFALSE;
*nread = 0;
return peekc;
}
else if( start >= end ) {
*nread = 0; /* Overflow. */
return SCHFALSE;
}
else {
*++cptr = c;
*PortData_Peek(data) = SCHFALSE;
}
}
clearerr(f);
while( 1 ) {
int c = getc(f);
if( EOF == c ) { /* Terminal case: EOF or error. */
*nread = 1 + cptr - buf - start;
return ferror(f) ? ENTER_FIXNUM(errno) : SCHEOF;
}
else if( delims[c] ) { /* Terminal case: delimiter char. */
scheme_value ch = ENTER_CHAR(c);
*nread = 1 + cptr - buf - start;
if( !gobble ) *PortData_Peek(data) = ch;
return ch;
}
else if( cptr >= bufend ) { /* Terminal case: buffer overflow. */
*PortData_Peek(data) = ENTER_CHAR(c); /* Put C back. */
*nread = end-start;
return SCHFALSE;
}
else *++cptr = c;
}
}
scheme_value skip_chars(const char *skipchars, scheme_value port, int *nread)
{
scheme_value data = *Port_PortData(port);
scheme_value peekc = *PortData_Peek(data);
int fd = EXTRACT_FIXNUM(*PortData_Fd(data));
FILE *f = fstar_cache[fd];
int nr = 0; /* Number of skip chars read. */
/* This chunk of code is necessary because we have to check
** the port's one-char pushback slot before going to the port's
** stdio FILE*. Yech.
*/
if( IsChar(peekc) ) {
int c = EXTRACT_CHAR(peekc);
if( skipchars[c] ) { /* Is c in cset? */
*PortData_Peek(data) = SCHFALSE;
nr = 1;
}
else {
*nread = 0;
return SCHFALSE;
}
}
clearerr(f);
while( 1 ) {
int c = getc(f);
if( EOF == c ) { /* Terminal case: EOF or error. */
*nread = nr;
return ferror(f) ? ENTER_FIXNUM(errno) : SCHFALSE;
}
else if( !skipchars[c] ) { /* Terminal case: non-skip char. */
*PortData_Peek(data) = ENTER_CHAR(c);
*nread = nr;
return SCHFALSE;
}
nr++;
}
}
/* Why, you might ask, do I push back the final char using the Scheme port
** instead of using ungetc()? Because ungetc() isn't guaranteed to work for
** unbuffered ports. This is regrettable, because it causes C stdio clients
** that are ignorant of the Scheme port machinery to miss this char. No
** real help for it.
*/