This example demonstrates creating a stream based on standard I/O library package. The stream is created as unbuffered for the Prolog I/O system (It is still buffered in the standard I/O package). By making the stream unbuffered, mixed I/O operations between Prolog code and C code using standard I/O library functions will work appropriately. In this case, line counts and character counts will be maintained for Prolog I/O predicates and QP functions only.
stdio.pl
foreign(open_stdio, c, open_stdio(+string, +string, -integer,
[-address])).
foreign_file('stdio', [open_stdio]).
:- load_foreign_files(['stdio'],['-lc']).
open_stdio_file(FileName, ModeName, Stream) :-
valid_open_mode(ModeName, Mode),
open_stdio(FileName, Mode, ErrorNum, CStream),
( CStream =:= 0 ->
raise_exception(existence_error(
open_stdio_file(FileName, ModeName, Stream),
1, file, FileName, errno(ErrorNum)))
; stream_code(Stream, CStream)
).
valid_open_mode(read, r).
valid_open_mode(write, w).
valid_open_mode(append, a).
stdio.c
#include <stdio.h>
#include <quintus/quintus.h>
/* Create a stream based on UNIX standard I/O library.
This stream is created as an unbuffered stream so that
mixed calls of Quintus Prolog I/O predicates (functions)
and standard I/O on the stream will read/write the same
sequence of bytes of the stream */
typedef struct
{
QP_stream qpinfo;
FILE *fp;
unsigned char buffer[4];
} StdioStream;
#define CoerceStdioStream(stream) ((StdioStream *) stream)
extern int errno;
static int
stdio_read(qpstream, bufptr, sizeptr)
QP_stream *qpstream;
unsigned char **bufptr;
size_t *sizeptr;
{
StdioStream *stream = CoerceStdioStream(qpstream);
register int c;
if ((c = getc(stream->fp)) < 0)
return QP_EOF;
stream->buffer[0] = (unsigned char) c;
*bufptr = stream->buffer;
*sizeptr = 1;
/* '-1' because the magic field stores the beginning
address of the returned buffer */
qpstream->magic.byteno = ftell(stream->fp)-1;
return (c == '\n') ? QP_FULL : QP_PART;
}
stdio.c
static int
stdio_write(qpstream, bufptr, sizeptr)
QP_stream *qpstream;
unsigned char **bufptr;
size_t *sizeptr;
{
StdioStream *stream = CoerceStdioStream(qpstream);
if (*sizeptr == 0) {
*bufptr = stream->buffer;
*sizeptr = 0;
return QP_SUCCESS;
}
errno = 0;
if (putc((char) stream->buffer[0], stream->fp) < 0) {
qpstream->errno = (errno) ? errno : QP_E_CANT_WRITE;
return QP_ERROR;
}
qpstream->magic.byteno = ftell(stream->fp);
*bufptr = stream->buffer;
*sizeptr = 0; /* use 0 for unbuffered write */
return QP_SUCCESS;
}
static int
stdio_flush(qpstream, bufptr, sizeptr)
QP_stream *qpstream;
unsigned char **bufptr;
size_t *sizeptr;
{
StdioStream *stream = CoerceStdioStream(qpstream);
/* The stream is unbuffered so that there is no character
in the buffer of stream->buffer */
errno = 0;
if (fflush(stream->fp) < 0) {
qpstream->errno = (errno) ? errno : QP_E_CANT_FLUSH;
return QP_ERROR;
}
qpstream->magic.byteno = ftell(stream->fp);
*bufptr = stream->buffer;
*sizeptr = 0;
return QP_SUCCESS;
}
stdio.c
static int
stdio_seek(qpstream, qpmagic, whence, bufptr, sizeptr)
QP_stream *qpstream;
union QP_cookie *qpmagic;
int whence;
unsigned char **bufptr;
size_t *sizeptr;
{
StdioStream *stream = CoerceStdioStream(qpstream);
int rtn;
errno = 0;
/* fseek() should normally flush out the buffered input
for stream->fp. Use fflush() just to be safe */
if (qpstream->mode != QP_READ)
(void) fflush(stream->fp);
switch (whence) {
case QP_BEGINNING:
rtn = fseek(stream->fp, qpmagic->byteno, 0);
break;
case QP_CURRENT:
rtn = fseek(stream->fp, qpmagic->byteno, 1);
break;
case QP_END:
rtn = fseek(stream->fp, qpmagic->byteno, 2);
break;
default:
qpstream->errno = QP_E_INVAL;
return QP_ERROR;
}
if (rtn == -1) {
qpstream->errno = (errno) ? errno : QP_E_CANT_SEEK;
return QP_ERROR;
}
qpstream->magic.byteno = ftell(stream->fp);
*bufptr = stream->buffer;
*sizeptr = (qpstream->mode == QP_READ) ? 0
: qpstream->max_reclen;
return QP_SUCCESS;
}
stdio.c
static int
stdio_close(qpstream)
QP_stream *qpstream;
{
StdioStream *stream = CoerceStdioStream(qpstream);
/* characters in fp buffer is flushed by fclose() */
if (fclose(stream->fp) < 0) {
qpstream->errno = errno;
return QP_ERROR;
}
QP_free((char *) stream);
return QP_SUCCESS;
}
stdio.c
/* open_stdio() creates an instance of standard input/output
based stream. The function creates a file stream based
on the 'filename' and 'modename' parameter.
It returns the pointer to the created QP_stream structure
upon success. It returns QP_NULL_STREAM and sets
error code in 'error_num' upon failure.
*/
QP_stream *
open_stdio(filename, modename, error_num)
char *filename, *modename;
int *error_num;
{
QP_stream *option;
FILE *fp;
StdioStream *stream;
int mode, stdio_read(), stdio_write(),
stdio_flush(), stdio_seek(), stdio_close();
switch (*modename) {
case 'r': mode = QP_READ; break;
case 'w': mode = QP_WRITE; break;
case 'a': mode = QP_APPEND; break;
default: *error_num = QP_E_BAD_MODE;
return QP_NULL_STREAM;
}
if ((fp = fopen(filename, modename)) == NULL) {
*error_num = errno;
return QP_NULL_STREAM;
}
/* allocate space for the stream */
stream = (StdioStream *) QP_malloc(sizeof(*stream));
/* set values in the stream */
stream->fp = fp;
/* obtain default values in QP_stream structure */
/* and modified fields for this stream */
option = &stream->qpinfo;
QU_stream_param(filename, mode, QP_DELIM_LF, option);
if (isatty(fileno(fp))) {
option->format = QP_DELIM_TTY;
option->seek_type = QP_SEEK_ERROR;
} else {
option->seek_type = QP_SEEK_BYTE;
}
option->max_reclen = (mode == QP_READ) ? 1 : 0;
stdio.c
if (mode != QP_READ) {
option->write = stdio_write;
option->flush = stdio_flush;
} else {
option->read = stdio_read;
option->peof_act = QP_PASTEOF_EOFCODE;
}
option->seek = stdio_seek;
option->close = stdio_close;
/* sets correct value in magic field */
if (option->mode != QP_APPEND)
option->magic.byteno = 0;
else
option->magic.byteno = ftell(fp);
/* set internal fields and register stream */
QP_prepare_stream(&stream->qpinfo, stream->buffer);
if (QP_register_stream(&stream->qpinfo) == QP_ERROR) {
(void) stream->qpinfo.close(&stream->qpinfo);
*error_num = QP_errno;
return QP_NULL_STREAM;
}
/* register tty stream to its group */
if (option->format == QP_DELIM_TTY)
(void) QP_add_tty(&stream->qpinfo, filename);
return (QP_stream *) stream;
}