/* $Revision: 1.14 $ */ /* The implementation of the Scheme type `stream' and the primitives * that work on streams. Additional functions exported by this module: * * istream_is_open() -- true if current input stream != #f * ostream_is_open() -- true if current output stream != #f * curr_istream_target() -- returns target of current input stream * curr_istream_lno() -- returns current istream's input line number * safe_readline(buffer) -- reads line from current istream into buffer; * signals error if istream is not open * safe_write_char(c) -- sends character to current ostream or to * stdout if ostream is #f * safe_write(data,len) -- same, but writes several characters */ #include "unroff.h" typedef struct _stream { Object tag; char open; char type; char direction; char *target; FILE *fp; Buffer *bp; int bs; unsigned long lno; unsigned long pos; Buffer *unread; int (*readline)(struct _stream *, Buffer *); void (*write)(struct _stream *, char *, int); void (*close)(struct _stream *); } Stream; static Object buffers; static Object istream, ostream; #define STREAM(x) ((Stream *)POINTER(x)) static int T_Stream; static Object p_streamp(Object x) { return TYPE(x) == T_Stream ? True : False; } static int stream_equal(Object s1, Object s2) { return EQ(s1, s2); } static int stream_print(Object x, Object port, int raw, int depth, int length) { Stream *p = STREAM(x); if (p->open || p->type == 'b') Printf(port, "#[stream %s]", p->target); else Printf(port, "#[stream %lu]", POINTER(x)); return 0; } static Object terminate_stream(Object x) { Stream *p = STREAM(x); if (p->open && !(p->type == 'b' && p->direction == 'o')) { free(p->target); buffer_delete(p->unread); if (p->type != 'b') p->close(p); } p->open = 0; return Void; } int istream_is_open(void) { return Truep(istream); } char *curr_istream_target(void) { assert(Truep(istream)); assert(STREAM(istream)->open); return STREAM(istream)->target; } unsigned long curr_istream_lno(void) { return STREAM(istream)->lno; } static int stream_is_active(Object str) { return EQ(istream, str) || EQ(ostream, str); } int safe_readline(Buffer *bp) { Stream *str; if (!Truep(istream)) Primitive_Error("no input stream defined"); str = STREAM(istream); if (str->unread->size > 0) { buffer_puts(bp, str->unread->data, str->unread->size); if (bp->data[bp->size-1] != '\n') buffer_putc(bp, '\n'); buffer_clear(str->unread); return 0; } return str->readline(str, bp); } void safe_write_char(char c) { if (Truep(ostream)) { STREAM(ostream)->pos++; STREAM(ostream)->write(STREAM(ostream), &c, 1); } else if (putc(c, stdout) == EOF) write_error("stdout"); } void safe_write(char *data, int len) { if (len == 0) return; if (Truep(ostream)) { STREAM(ostream)->pos += len; STREAM(ostream)->write(STREAM(ostream), data, len); } else if (fwrite(data, len, 1, stdout) == 0) write_error("stdout"); } #define is_continuation(p) \ ((p)->size > oldsize && (p)->data[(p)->size-1] == escape &&\ !((p)->size > oldsize+1 && (p)->data[(p)->size-2] == escape)) static int readline_buffer(Stream *self, Buffer *bp) { int oldsize; int c; Buffer *sp = self->bp; assert(self->bs <= sp->size); if (self->bs == sp->size) return 1; oldsize = bp->size; while (self->bs < sp->size) { if ((c = sp->data[self->bs++]) == '\n') { self->lno++; if (is_continuation(bp)) { bp->size--; } else { buffer_putc(bp, c); return 0; } } else buffer_putc(bp, c); } if (bp->size > oldsize) { buffer_putc(bp, '\n'); self->lno++; } return 1; } static int readline_file(Stream *self, Buffer *bp) { int oldsize; int c; if (feof(self->fp)) return 1; oldsize = bp->size; while ((c = getc(self->fp)) != EOF) { if (c == '\n') { self->lno++; if (is_continuation(bp)) { bp->size--; } else { buffer_putc(bp, c); return 0; } } else buffer_putc(bp, c); } if (ferror(self->fp)) read_error(self->target); if (bp->size > oldsize) { buffer_putc(bp, '\n'); self->lno++; } return 1; } static void write_buffer(Stream *self, char *data, int len) { buffer_puts(self->bp, data, len); } static void write_file(Stream *self, char *data, int len) { if (fwrite(data, len, 1, self->fp) == 0) write_error(self->target); } static void close_file(Stream *self) { (void)fclose(self->fp); } static void close_pipe(Stream *self) { (void)pclose(self->fp); } static Object find_buffer(char *s) { Object p; for (p = buffers; !Nullp(p); p = Cdr(p)) { if (strcmp(STREAM(Car(p))->target, s) == 0) return Car(p); } return Null; } static int target_is_buffer(char *s) { int len = strlen(s); return len > 1 && s[0] == '[' && s[len-1] == ']'; } static Object open_stream(Object target, char direction, int append) { char *t = Get_Strsym(target), *mode; Stream *p; Object ret = Null, b = Null; GC_Node3; GC_Link3(target, ret, b); if (target_is_buffer(t)) { b = find_buffer(t); if (!Nullp(b)) { p = STREAM(b); assert(p->type == 'b'); assert(p->direction == 'o'); if (p->open) Primitive_Error("stream ~s is already open", b); if (direction == 'o') { p->open = 1; p->lno = p->bs = 0; if (!append) { p->pos = 0; buffer_clear(p->bp); } GC_Unlink; return b; } } } ret = Alloc_Object(sizeof(Stream), T_Stream, 0); p = STREAM(ret); p->tag = Null; p->open = 1; p->direction = direction; p->lno = p->pos = 0; p->unread = buffer_new(0); p->target = safe_malloc(strlen(t) + 1); strcpy(p->target, t); if (target_is_buffer(t)) { p->readline = readline_buffer; p->write = write_buffer; /* no close function */ p->type = 'b'; p->bp = buffer_new(0); if (direction == 'o') { buffers = Cons(ret, buffers); } else { p->bs = 0; if (!Nullp(b)) buffer_puts(p->bp, STREAM(b)->bp->data, STREAM(b)->bp->size); } } else { mode = direction == 'i' ? "r" : append ? "a" : "w"; p->readline = readline_file; p->write = write_file; if (t[0] == '|') { char *s; if ((p->fp = popen(t+1, mode)) == 0) Primitive_Error("cannot open pipe to ~s", target); if ((s = strchr(p->target, ' ')) != 0) *s = 0; p->close = close_pipe; p->type = 'p'; } else { if (direction == 'i' && strcmp(t, "stdin") == 0) { p->fp = stdin; } else if ((p->fp = fopen(t, mode)) == 0) { Saved_Errno = errno; Primitive_Error("cannot open ~s: ~E", target); } p->close = close_file; p->type = 'f'; } } Register_Object(ret, (GENERIC)0, terminate_stream, 0); GC_Unlink; return ret; } Object p_open_input_stream(Object target) { return open_stream(target, 'i', 0); } static Object p_open_output_stream(Object target) { return open_stream(target, 'o', 0); } static Object p_append_output_stream(Object target) { return open_stream(target, 'o', 1); } Object p_close_stream(Object x) { if (!Truep(x)) return Void; Check_Type(x, T_Stream); if (!STREAM(x)->open) return Void; if (stream_is_active(x)) Primitive_Error("stream ~s is still in use", x); return terminate_stream(x); } static Object set_stream(Object x, Object *which) { Object ret = *which; Stream *p; if (Truep(*which) && STREAM(*which)->type != 'b' && STREAM(*which)->direction == 'o') (void)fflush(STREAM(*which)->fp); if (Truep(x)) { Check_Type(x, T_Stream); p = STREAM(x); if (!p->open) Primitive_Error("stream ~s has been closed", x); if (stream_is_active(x)) Primitive_Error("stream ~s is already in use", x); if (which == &istream && p->direction != 'i') Primitive_Error("stream ~s is not an input stream", x); if (which == &ostream && p->direction != 'o') Primitive_Error("stream ~s is not an output stream", x); *which = x; } else { *which = False; } return ret; } Object p_set_input_stream(Object x) { return set_stream(x, &istream); } static Object p_set_output_stream(Object x) { return set_stream(x, &ostream); } static Object p_input_stream(void) { return istream; } static Object p_output_stream(void) { return ostream; } static Object p_unread_line(Object str) { Check_Type(str, T_String); if (!Truep(istream)) Primitive_Error("no input stream defined"); buffer_puts(STREAM(istream)->unread, STRING(str)->data, STRING(str)->size); return Void; } #define stream_type_pred(what,t)\ static Object p_stream_##what(Object x) {\ if (Truep(x)) {\ Check_Type(x, T_Stream);\ return STREAM(x)->type == t ? True : False;\ } else return False;\ } stream_type_pred(buffer, 'b') stream_type_pred(file, 'f') stream_type_pred(pipe, 'p') static Object p_stream_target(Object x) { if (!Truep(x)) return Make_String("", 0); Check_Type(x, T_Stream); return Make_String(STREAM(x)->target, strlen(STREAM(x)->target)); } static Object p_stream_to_string(Object target) { Object str, old, ret; Stream *sp; Buffer *bp; str = p_open_input_stream(target); old = p_set_input_stream(str); bp = buffer_new(0); for (sp = STREAM(str); sp->readline(sp, bp) == 0; ) ; (void)p_set_input_stream(old); (void)p_close_stream(str); ret = Make_String(bp->data, bp->size); buffer_delete(bp); return ret; } static Object p_stream_position(Object x) { if (!Truep(x)) return Make_Integer(0); Check_Type(x, T_Stream); return Make_Unsigned_Long(STREAM(x)->pos); } void init_stream(void) { istream = ostream = False; buffers = Null; Global_GC_Link(istream); Global_GC_Link(ostream); Global_GC_Link(buffers); T_Stream = Define_Type(0, "stream", NOFUNC, sizeof(Stream), stream_equal, stream_equal, stream_print, NOFUNC); Define_Primitive(p_streamp, "stream?", 1, 1, EVAL); Define_Primitive(p_open_input_stream, "open-input-stream", 1, 1, EVAL); Define_Primitive(p_open_output_stream, "open-output-stream", 1, 1, EVAL); Define_Primitive(p_append_output_stream, "append-output-stream", 1, 1, EVAL); Define_Primitive(p_close_stream, "close-stream", 1, 1, EVAL); Define_Primitive(p_set_input_stream, "set-input-stream!", 1, 1, EVAL); Define_Primitive(p_set_output_stream, "set-output-stream!", 1, 1, EVAL); Define_Primitive(p_input_stream, "input-stream", 0, 0, EVAL); Define_Primitive(p_output_stream, "output-stream", 0, 0, EVAL); Define_Primitive(p_unread_line, "unread-line", 1, 1, EVAL); Define_Primitive(p_stream_buffer, "stream-buffer?", 1, 1, EVAL); Define_Primitive(p_stream_file, "stream-file?", 1, 1, EVAL); Define_Primitive(p_stream_pipe, "stream-pipe?", 1, 1, EVAL); Define_Primitive(p_stream_target, "stream-target", 1, 1, EVAL); Define_Primitive(p_stream_to_string,"stream->string", 1, 1, EVAL); Define_Primitive(p_stream_position, "stream-position", 1, 1, EVAL); }