434 lines
10 KiB
C
434 lines
10 KiB
C
/*
|
|
* i o . c -- Low level I/O
|
|
*
|
|
* Copyright © 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
|
*
|
|
*
|
|
* Permission to use, copy, and/or distribute this software and its
|
|
* documentation for any purpose and without fee is hereby granted, provided
|
|
* that both the above copyright notice and this permission notice appear in
|
|
* all copies and derived works. Fees for distribution or use of this
|
|
* software or derived works may only be charged with express written
|
|
* permission of the copyright holder.
|
|
* This software is provided ``as is'' without express or implied warranty.
|
|
*
|
|
* This software is a derivative work of other copyrighted softwares; the
|
|
* copyright notices of these softwares are placed in the file COPYRIGHTS
|
|
*
|
|
* $Id: io.c 1.11 Sat, 26 Dec 1998 21:34:30 +0100 eg $
|
|
*
|
|
* Author: Erick Gallesio [eg@kaolin.unice.fr]
|
|
* Creation date: ????
|
|
* Last file update: 26-Dec-1998 21:21
|
|
*/
|
|
|
|
#ifdef WIN32
|
|
# include <windows.h>
|
|
# include <io.h>
|
|
# include <fcntl.h>
|
|
# define TCL_EVENT_FLAG TCL_DONT_WAIT /* (FIXME) */
|
|
#else
|
|
# include <sys/ioctl.h>
|
|
# include <sys/time.h>
|
|
# include <ctype.h>
|
|
# define TCL_EVENT_FLAG 0
|
|
# ifdef HAVE_SYS_SELECT_H
|
|
# include <sys/select.h> /* This seems to be useful only for AIX */
|
|
# endif
|
|
|
|
# ifndef NO_FD_SET
|
|
# define SELECT_MASK fd_set
|
|
# else
|
|
# ifndef _AIX
|
|
typedef long fd_mask;
|
|
# endif
|
|
# if defined(_IBMR2)
|
|
# define SELECT_MASK void
|
|
# else
|
|
# define SELECT_MASK int
|
|
# endif
|
|
# endif
|
|
#endif
|
|
|
|
|
|
#include "stk.h"
|
|
#include "sport.h"
|
|
#include "vport.h"
|
|
|
|
#define BUFFER_SIZE 512
|
|
#define SYSTEM(instr) { instr; }
|
|
|
|
|
|
#ifdef max
|
|
# undef max
|
|
#endif
|
|
#define max(a,b) ((a)>(b)? (a) : (b))
|
|
|
|
#ifdef _STDIO_USES_IOSTREAM /* GNU libc */
|
|
# if defined(_IO_STDIO_H) || defined (linux)
|
|
# define READ_DATA_PENDING(fp) (max(0,(fp)->_IO_read_end - (fp)->_IO_read_ptr))
|
|
# else
|
|
# define READ_DATA_PENDING(fp) (max(0,(fp)->_egptr - (fp)->_gptr))
|
|
# endif
|
|
#endif
|
|
#if (!defined (READ_DATA_PENDING)) && defined __SLBF
|
|
# define READ_DATA_PENDING(fp) (max(0,fp->_r))
|
|
#endif
|
|
#if !defined (READ_DATA_PENDING)
|
|
# ifdef WIN32
|
|
# define READ_DATA_PENDING(fp) (1)
|
|
# else
|
|
# define READ_DATA_PENDING(fp) (fp->_cnt)
|
|
# endif
|
|
#endif
|
|
|
|
|
|
static char static_buffer[BUFFER_SIZE+1], *buffer = static_buffer;
|
|
static int bufidx=0;
|
|
static int count=-1;
|
|
static int filled=0;
|
|
|
|
|
|
void STk_StdinProc()
|
|
{
|
|
buffer = static_buffer;
|
|
for ( ; ; ) {
|
|
SYSTEM(count = read(fileno(PORT_FILE(STk_stdin)), buffer, BUFFER_SIZE););
|
|
if (count != -1 || errno != EINTR) break;
|
|
}
|
|
filled = 1;
|
|
STk_control_C = 0; /* neglect ^C which arose when waiting an input */
|
|
}
|
|
|
|
|
|
void STk_fill_stdin_buffer(char *s)
|
|
{
|
|
/* This procedure is called by the console to simulate the arrival of
|
|
* characters on stdin. The string is GC protected */
|
|
count = strlen(s);
|
|
buffer = s;
|
|
filled = 1;
|
|
}
|
|
|
|
|
|
static int file_data_available(SCM port)
|
|
{
|
|
return ( (PORT_UNGETC(port) != EOF) ||
|
|
((port == STk_stdin) && (bufidx < count)) ||
|
|
(READ_DATA_PENDING(PORT_FILE(port))) );
|
|
}
|
|
|
|
|
|
/*****************************************************************************/
|
|
|
|
|
|
int STk_getc(SCM port)
|
|
{
|
|
int result = PORT_UNGETC(port);
|
|
|
|
/* Ungetted character ? */
|
|
if (result != EOF) {
|
|
PORT_UNGETC(port) = EOF;
|
|
return result;
|
|
}
|
|
|
|
/* Stdin */
|
|
if (port == STk_stdin) {
|
|
if (bufidx < count) return buffer[bufidx++];
|
|
else {
|
|
#ifdef USE_TK
|
|
if (Tk_initialized && STk_interactivep) {
|
|
filled = 0;
|
|
while (!filled && !STk_control_C) {
|
|
Tcl_DoOneEvent(TCL_EVENT_FLAG);
|
|
if (Tk_GetNumMainWindows() <= 0) return EOF;
|
|
}
|
|
}
|
|
else
|
|
STk_StdinProc();
|
|
#else
|
|
STk_StdinProc();
|
|
#endif
|
|
if (count <= 0) return EOF;
|
|
else {
|
|
bufidx = 1;
|
|
return *buffer;
|
|
}
|
|
}
|
|
}
|
|
|
|
/* Otherwise */
|
|
switch (TYPE(port)) {
|
|
case tc_iport : for ( ; ; ) {
|
|
SYSTEM(result=getc(PORT_FILE(port)));
|
|
if (result != EOF || errno != EINTR) break;
|
|
}
|
|
return result;
|
|
case tc_isport: {
|
|
register struct str_iob *f;
|
|
|
|
f = (struct str_iob *) PORT_FILE(port);
|
|
return (--(f->cnt)>=0? ((int)*f->ptr++): EOF);
|
|
}
|
|
case tc_ivport: {
|
|
register struct virtual_iob *f;
|
|
SCM res, proc;
|
|
|
|
f = (struct virtual_iob *) PORT_FILE(port);
|
|
proc = f->getc;
|
|
if (proc == Ntruth) /* No getc function: return EOF */
|
|
return EOF;
|
|
else {
|
|
res = STk_apply(proc, NIL);
|
|
return (res == STk_eof_object) ? EOF: CHAR(res);
|
|
}
|
|
}
|
|
default: Err("INTERNAL ERROR in STk_getc", NIL);
|
|
return 0;
|
|
}
|
|
}
|
|
|
|
int STk_ungetc(int c, SCM port)
|
|
{
|
|
int result = PORT_UNGETC(port);
|
|
|
|
if (result != EOF) STk_err("INTERNAL ERROR: cannot unget character", NIL);
|
|
PORT_UNGETC(port) = c;
|
|
return c;
|
|
}
|
|
|
|
int STk_putc(int c, SCM port)
|
|
{
|
|
ENTER_PRIMITIVE("write-char");
|
|
switch (TYPE(port)) {
|
|
case tc_oport : SYSTEM(c=fputc(c, PORT_FILE(port)));
|
|
/* Signal an error if write fails. We can't do better here */
|
|
if (c == EOF) Serror("write error", NIL);
|
|
break;
|
|
case tc_osport: {
|
|
register struct str_iob *f;
|
|
register unsigned int tmp;
|
|
|
|
f = (struct str_iob *) PORT_FILE(port);
|
|
if (++f->cnt == f->bufsiz) {
|
|
tmp = f->bufsiz;
|
|
tmp += tmp/2;
|
|
f->base = must_realloc(f->base, tmp);
|
|
f->ptr = f->base + f->bufsiz - 1; /* base can move */
|
|
f->bufsiz = tmp;
|
|
}
|
|
*f->ptr++ = (unsigned char) c;
|
|
break;
|
|
}
|
|
case tc_ovport: {
|
|
register struct virtual_iob *f;
|
|
SCM res, proc;
|
|
|
|
f = (struct virtual_iob *) PORT_FILE(port);
|
|
proc = f->putc;
|
|
if (proc == Ntruth) /* No putc function: return EOF */
|
|
return EOF;
|
|
else {
|
|
res = STk_apply(proc, LIST1(STk_makechar(c)));
|
|
if (res == STk_eof_object) Serror("write error", NIL);
|
|
}
|
|
}
|
|
}
|
|
return c;
|
|
}
|
|
|
|
int STk_puts(char *s, SCM port)
|
|
{
|
|
ENTER_PRIMITIVE("write");
|
|
|
|
switch (TYPE(port)) {
|
|
case tc_oport : {
|
|
int result;
|
|
|
|
SYSTEM(result = fputs(s, PORT_FILE(port)));
|
|
if (result == EOF) Serror("write-error", NIL);
|
|
return result;
|
|
}
|
|
case tc_osport: {
|
|
register struct str_iob *f;
|
|
register unsigned int tmp;
|
|
|
|
f = (struct str_iob *) PORT_FILE(port);
|
|
for ( ; *s; s++) {
|
|
if (++f->cnt == f->bufsiz) {
|
|
tmp = f->bufsiz;
|
|
tmp += tmp/2;
|
|
f->base = must_realloc(f->base, tmp);
|
|
f->ptr = f->base + f->bufsiz - 1; /* base can move */
|
|
f->bufsiz = tmp;
|
|
}
|
|
*f->ptr++ = (unsigned char) *s;
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
case tc_ovport: {
|
|
register struct virtual_iob *f;
|
|
SCM res, proc;
|
|
|
|
f = (struct virtual_iob *) PORT_FILE(port);
|
|
proc = f->puts;
|
|
if (proc == Ntruth) /* No putc function: return EOF */
|
|
return EOF;
|
|
else {
|
|
res = STk_apply(proc, LIST1(STk_makestring(s)));
|
|
if (res ==STk_eof_object) Serror("write error", NIL);
|
|
}
|
|
}
|
|
/* NO BREAK */
|
|
default: return 0;
|
|
}
|
|
}
|
|
|
|
int STk_eof(SCM port)
|
|
{
|
|
switch (TYPE(port)) {
|
|
case tc_iport : {
|
|
int result;
|
|
SYSTEM(result = feof(PORT_FILE(port)));
|
|
return result;
|
|
}
|
|
case tc_isport: {
|
|
register struct str_iob *f;
|
|
f = (struct str_iob *) PORT_FILE(port);
|
|
return f->cnt <= 0;
|
|
}
|
|
|
|
case tc_ivport: {
|
|
register struct virtual_iob *f;
|
|
SCM proc;
|
|
|
|
f = (struct virtual_iob *) PORT_FILE(port);
|
|
proc = f->eofp;
|
|
return (proc == Ntruth) ? 1 : (STk_apply(proc, NIL)!=Ntruth);
|
|
}
|
|
default: return 1; /* always EOF on output files */
|
|
}
|
|
}
|
|
|
|
int STk_internal_flush(SCM port)
|
|
{
|
|
switch (TYPE(port)) {
|
|
case tc_oport : {
|
|
int result;
|
|
SYSTEM(result = fflush(PORT_FILE(port)));
|
|
return result;
|
|
}
|
|
case tc_ovport: {
|
|
register struct virtual_iob *f;
|
|
SCM proc;
|
|
|
|
f = (struct virtual_iob *) PORT_FILE(port);
|
|
proc = f->flush;
|
|
return (proc == Ntruth) ? 0 : (STk_apply(proc, NIL)!=Ntruth);
|
|
}
|
|
default: return 0; /* i.e. always works on other ports */
|
|
}
|
|
}
|
|
|
|
int STk_internal_char_readyp(SCM port)
|
|
{
|
|
switch (TYPE(port)) {
|
|
case tc_iport : {
|
|
if (file_data_available(port)) return 1;
|
|
#ifdef WIN32
|
|
panic("char-ready?: Not yet implemented!");
|
|
#else
|
|
# ifdef HAVE_SELECT
|
|
{
|
|
SELECT_MASK readfds;
|
|
struct timeval timeout;
|
|
int f = fileno(PORT_FILE(port));
|
|
|
|
FD_ZERO(&readfds);
|
|
FD_SET(f, &readfds);
|
|
timeout.tv_sec = timeout.tv_usec = 0;
|
|
return (select(f+1, &readfds, NULL, NULL, &timeout));
|
|
}
|
|
# else
|
|
# ifdef FIONREAD
|
|
{
|
|
int result;
|
|
|
|
ioctl(fileno(PORT_FILE(port)), FIONREAD, &result);
|
|
return result;
|
|
}
|
|
# else
|
|
return 1;
|
|
# endif
|
|
# endif
|
|
#endif
|
|
}
|
|
case tc_isport: return 1;
|
|
case tc_ivport: {
|
|
register struct virtual_iob *f;
|
|
SCM proc;
|
|
|
|
f = (struct virtual_iob *) PORT_FILE(port);
|
|
proc = f->readyp;
|
|
return (proc == Ntruth) ? 1 : (STk_apply(proc, NIL)!=Ntruth);
|
|
}
|
|
default: return 1; /* always EOF on output files */
|
|
}
|
|
}
|
|
|
|
|
|
void STk_close(SCM port)
|
|
{
|
|
if (PORT_FLAGS(port) & PORT_CLOSED) /* already closed */ return;
|
|
|
|
STk_internal_flush(port);
|
|
|
|
switch (TYPE(port)) {
|
|
case tc_iport :
|
|
case tc_oport : STk_close_file_port(port); break;
|
|
|
|
case tc_ivport:
|
|
case tc_ovport: {
|
|
register struct virtual_iob *f;
|
|
SCM proc;
|
|
|
|
f = (struct virtual_iob *) PORT_FILE(port);
|
|
proc = f->close;
|
|
if (proc != Ntruth) STk_apply(proc, NIL);
|
|
}
|
|
}
|
|
PORT_FLAGS(port) |= PORT_CLOSED;
|
|
}
|
|
|
|
|
|
void STk_fprintf(SCM port, char *format, ...)
|
|
{
|
|
va_list ap;
|
|
char buffer[MAX_FPRINTF];
|
|
|
|
va_start(ap, format);
|
|
vsprintf(buffer, format, ap);
|
|
Puts(buffer, port);
|
|
}
|
|
|
|
|
|
char *STk_line_bufferize_io(SCM port)
|
|
{
|
|
if (IPORTP(port) || OPORTP(port)) {
|
|
char *buff= STk_must_malloc(BUFFER_SIZE);
|
|
|
|
setvbuf(PORT_FILE(port), buff, _IOLBF, BUFFER_SIZE);
|
|
return buff;
|
|
}
|
|
return NULL;
|
|
}
|
|
|
|
|
|
void STk_init_io(void)
|
|
{
|
|
STk_stdin = STk_stdout = STk_stderr = NULL;
|
|
STk_curr_iport = STk_curr_oport = STk_curr_eport = NULL;
|
|
}
|
|
|