This example creates a binary stream. All the characters read from
the stream are exactly the same as the characters stored in the
file of the stream. All the characters stored in the file of the
stream are the same as the characters written to the stream.
The stream permits flushing output and random seek to arbitrary
byte position in the file.
By choosing QP_VAR_LEN as the format of the stream and using the
full buffer as a record to communicate between middle layer and bottom layer
functions, a line is actually a full buffer of the stream. A newline
operation does not output a <LFD> either so that the line count
of the stream is not based on the number of <LFD> characters.
bin.pl
foreign(open_bin, c, open_bin(+string, +string, -integer, [-address])).
foreign_file('bin', [open_bin]).
:- load_foreign_files(['bin'],[]).
open_bin_file(FileName, ModeName, Stream) :-
open_bin(FileName, ModeName, ErrorNum, CStream),
( CStream =:= 0 ->
raise_exception(existence_error(
open_bin_file(FileName, ModeName, Stream),
1, file, FileName, errno(ErrorNum)))
; stream_code(Stream, CStream)
).
bin.c
#include <fcntl.h>
#include <errno.h>
#include <sys/file.h> /* for seek */
#ifndef L_SET
#define L_SET 0
#endif
#ifndef L_INCR
#define L_INCR 1
#endif
#ifndef L_XTND
#define L_XTND 2
#endif
#include <quintus/quintus.h>
extern char *QP_malloc();
/* The following three functions support UNIX I/O on files
without breaking things into records. All the characters
read from or written to the file are kept exactly the same.
*/
#define Buffer_Size 8192
typedef struct
{
QP_stream qpinfo;
int fd; /* UNIX file descriptor */
int last_rdsize; /* size of last returned line */
unsigned char buffer[Buffer_Size]; /* I/O buffer */
} BinStream;
#define CoerceBinStream(x) ((BinStream *)(x))
bin.c
static int
bin_read(qpstream, bufptr, sizeptr)
QP_stream *qpstream;
unsigned char **bufptr;
size_t *sizeptr;
{
int n;
register BinStream *stream = CoerceBinStream(qpstream);
qpstream->magic.byteno += stream->last_rdsize;
stream->last_rdsize = 0;
n = read(stream->fd, (char*)stream->buffer,
(int) qpstream->max_reclen);
if (n > 0) {
*bufptr = stream->buffer;
*sizeptr = n;
stream->last_rdsize = n;
return QP_FULL;
} else if (n == 0) {
*sizeptr = 0;
return QP_EOF;
} else {
qpstream->errno = errno;
return QP_ERROR;
}
}
static int
bin_write(qpstream, bufptr, sizeptr)
QP_stream *qpstream;
unsigned char **bufptr;
size_t *sizeptr;
{
BinStream *stream = CoerceBinStream(qpstream);
int n, len=(int) *sizeptr;
char *buf = (char *) *bufptr;
while ((n = write(stream->fd, buf, len)) > 0 && n < len) {
buf += n;
len -= n;
}
if (n >= 0) {
qpstream->magic.byteno += *sizeptr;
*sizeptr = qpstream->max_reclen;
*bufptr = stream->buffer;
return QP_SUCCESS;
} else {
qpstream->errno = errno;
return QP_ERROR;
}
}
bin.c
static int
bin_seek(qpstream, qpmagic, whence, bufptr, sizeptr)
QP_stream *qpstream;
union QP_cookie *qpmagic;
int whence;
unsigned char **bufptr;
size_t *sizeptr;
{
BinStream *stream = CoerceBinStream(qpstream);
off_t new_offset;
switch (whence) {
case QP_BEGINNING:
new_offset = lseek(stream->fd,qpmagic->byteno,L_SET);
break;
case QP_CURRENT:
/* The current location of file pointer is different from
what the user thinks it is due to buffering. The magic
field has been brought up to date by the caller of this
function, so just seek to that position first. */
if (lseek(stream->fd, qpstream->magic.byteno, L_SET)
== -1) {
qpstream->errno = errno;
return QP_ERROR;
}
new_offset = lseek(stream->fd,qpmagic->byteno,L_INCR);
break;
case QP_END:
new_offset = lseek(stream->fd,qpmagic->byteno,L_XTND);
break;
default:
qpstream->errno = QP_E_INVAL;
return QP_ERROR;
}
if (new_offset == -1) { /* error in seeking */
qpstream->errno = errno;
return QP_ERROR;
}
qpstream->magic.byteno = new_offset;
*bufptr = stream->buffer;
*sizeptr = (qpstream->mode == QP_READ) ? 0
: qpstream->max_reclen;
stream->last_rdsize = 0;
return QP_SUCCESS;
}
bin.c
static int
bin_close(qpstream)
QP_stream *qpstream;
{
BinStream *stream = CoerceBinStream(qpstream);
int fd = stream->fd;
if (close(fd) < 0) {
qpstream->errno = errno;
return QP_ERROR;
}
(void) QP_free(qpstream);
return QP_SUCCESS;
}
bin.c
QP_stream *
open_bin(filename, modename, error_num)
char *filename, *modename;
int *error_num;
{
BinStream *stream;
QP_stream *option;
int fd, mode;
switch (*modename) {
case 'r': mode = QP_READ;
fd = open(filename, O_RDONLY, 0000);
break;
case 'w': mode = QP_APPEND;
fd = open(filename, O_WRONLY|O_CREAT|O_TRUNC,
0666);
break;
case 'a': mode = QP_APPEND;
fd = open(filename, O_WRONLY|O_CREAT, 0666);
break;
default: *error_num = QP_E_BAD_MODE;
return QP_NULL_STREAM;
}
if (fd < 0) {
*error_num = errno;
return QP_NULL_STREAM;
}
if ((stream = (BinStream *) QP_malloc(sizeof(*stream)))
== ((BinStream *) 0) ) {
(void) close(fd);
*error_num = QP_errno;
return QP_NULL_STREAM;
}
stream->fd = fd;
stream->last_rdsize = 0;
bin.c
/* obtain default values in QP_stream structure */
/* and modified fields for this stream */
option = &stream->qpinfo;
QU_stream_param(filename, mode, QP_VAR_LEN, option);
option->max_reclen = Buffer_Size;
option->line_border = QP_NOLB;
if (isatty(fd)) {
option->format = QP_DELIM_TTY;
option->seek_type = QP_SEEK_ERROR;
} else {
option->seek_type = QP_SEEK_BYTE;
option->seek = bin_seek;
}
if (mode != QP_READ) {
option->write = bin_write;
option->flush = bin_write;
} else
option->read = bin_read;
if (option->mode == QP_APPEND
&& option->format != QP_DELIM_TTY) {
if ((option->magic.byteno=lseek(fd,0L,L_XTND)) < 0) {
(void) close(fd);
*error_num = errno;
return QP_NULL_STREAM;
}
}
option->close = bin_close;
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;
}
/* Use filename to register tty stream to its group */
if (option->format == QP_DELIM_TTY)
(void) QP_add_tty(&stream->qpinfo, filename);
return &stream->qpinfo;
}