530 lines
14 KiB
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.
|
|
*/
|