1 /* $Revision: 1.14 $
2 */
3
4 /* The implementation of the Scheme type `stream' and the primitives
5 * that work on streams. Additional functions exported by this module:
6 *
7 * istream_is_open() -- true if current input stream != #f
8 * ostream_is_open() -- true if current output stream != #f
9 * curr_istream_target() -- returns target of current input stream
10 * curr_istream_lno() -- returns current istream's input line number
11 * safe_readline(buffer) -- reads line from current istream into buffer;
12 * signals error if istream is not open
13 * safe_write_char(c) -- sends character to current ostream or to
14 * stdout if ostream is #f
15 * safe_write(data,len) -- same, but writes several characters
16 */
17
18
19 #include "unroff.h"
20
21 typedef struct _stream {
22 Object tag;
23 char open;
24 char type;
25 char direction;
26 char *target;
27 FILE *fp;
28 Buffer *bp;
29 int bs;
30 unsigned long lno;
31 unsigned long pos;
32 Buffer *unread;
33 int (*readline)(struct _stream *, Buffer *);
34 void (*write)(struct _stream *, char *, int);
35 void (*close)(struct _stream *);
36 } Stream;
37
38 static Object buffers;
39 static Object istream, ostream;
40
41 #define STREAM(x) ((Stream *)POINTER(x))
42
43 static int T_Stream;
44
p_streamp(Object x)45 static Object p_streamp(Object x) {
46 return TYPE(x) == T_Stream ? True : False;
47 }
48
stream_equal(Object s1,Object s2)49 static int stream_equal(Object s1, Object s2) {
50 return EQ(s1, s2);
51 }
52
stream_print(Object x,Object port,int raw,int depth,int length)53 static int stream_print(Object x, Object port, int raw, int depth,
54 int length) {
55 Stream *p = STREAM(x);
56
57 if (p->open || p->type == 'b')
58 Printf(port, "#[stream %s]", p->target);
59 else
60 Printf(port, "#[stream %lu]", POINTER(x));
61 return 0;
62 }
63
terminate_stream(Object x)64 static Object terminate_stream(Object x) {
65 Stream *p = STREAM(x);
66
67 if (p->open && !(p->type == 'b' && p->direction == 'o')) {
68 free(p->target);
69 buffer_delete(p->unread);
70 if (p->type != 'b')
71 p->close(p);
72 }
73 p->open = 0;
74 return Void;
75 }
76
istream_is_open(void)77 int istream_is_open(void) {
78 return Truep(istream);
79 }
80
curr_istream_target(void)81 char *curr_istream_target(void) {
82 assert(Truep(istream));
83 assert(STREAM(istream)->open);
84 return STREAM(istream)->target;
85 }
86
curr_istream_lno(void)87 unsigned long curr_istream_lno(void) {
88 return STREAM(istream)->lno;
89 }
90
stream_is_active(Object str)91 static int stream_is_active(Object str) {
92 return EQ(istream, str) || EQ(ostream, str);
93 }
94
safe_readline(Buffer * bp)95 int safe_readline(Buffer *bp) {
96 Stream *str;
97
98 if (!Truep(istream))
99 Primitive_Error("no input stream defined");
100 str = STREAM(istream);
101 if (str->unread->size > 0) {
102 buffer_puts(bp, str->unread->data, str->unread->size);
103 if (bp->data[bp->size-1] != '\n')
104 buffer_putc(bp, '\n');
105 buffer_clear(str->unread);
106 return 0;
107 }
108 return str->readline(str, bp);
109 }
110
safe_write_char(char c)111 void safe_write_char(char c) {
112 if (Truep(ostream)) {
113 STREAM(ostream)->pos++;
114 STREAM(ostream)->write(STREAM(ostream), &c, 1);
115 } else if (putc(c, stdout) == EOF)
116 write_error("stdout");
117 }
118
safe_write(char * data,int len)119 void safe_write(char *data, int len) {
120 if (len == 0)
121 return;
122 if (Truep(ostream)) {
123 STREAM(ostream)->pos += len;
124 STREAM(ostream)->write(STREAM(ostream), data, len);
125 } else if (fwrite(data, len, 1, stdout) == 0)
126 write_error("stdout");
127 }
128
129 #define is_continuation(p) \
130 ((p)->size > oldsize && (p)->data[(p)->size-1] == escape &&\
131 !((p)->size > oldsize+1 && (p)->data[(p)->size-2] == escape))
132
readline_buffer(Stream * self,Buffer * bp)133 static int readline_buffer(Stream *self, Buffer *bp) {
134 int oldsize;
135 int c;
136 Buffer *sp = self->bp;
137
138 assert(self->bs <= sp->size);
139 if (self->bs == sp->size)
140 return 1;
141 oldsize = bp->size;
142 while (self->bs < sp->size) {
143 if ((c = sp->data[self->bs++]) == '\n') {
144 self->lno++;
145 if (is_continuation(bp)) {
146 bp->size--;
147 } else {
148 buffer_putc(bp, c);
149 return 0;
150 }
151 } else buffer_putc(bp, c);
152 }
153 if (bp->size > oldsize) {
154 buffer_putc(bp, '\n');
155 self->lno++;
156 }
157 return 1;
158 }
159
readline_file(Stream * self,Buffer * bp)160 static int readline_file(Stream *self, Buffer *bp) {
161 int oldsize;
162 int c;
163
164 if (feof(self->fp))
165 return 1;
166 oldsize = bp->size;
167 while ((c = getc(self->fp)) != EOF) {
168 if (c == '\n') {
169 self->lno++;
170 if (is_continuation(bp)) {
171 bp->size--;
172 } else {
173 buffer_putc(bp, c);
174 return 0;
175 }
176 } else buffer_putc(bp, c);
177 }
178 if (ferror(self->fp))
179 read_error(self->target);
180 if (bp->size > oldsize) {
181 buffer_putc(bp, '\n');
182 self->lno++;
183 }
184 return 1;
185 }
186
write_buffer(Stream * self,char * data,int len)187 static void write_buffer(Stream *self, char *data, int len) {
188 buffer_puts(self->bp, data, len);
189 }
190
write_file(Stream * self,char * data,int len)191 static void write_file(Stream *self, char *data, int len) {
192 if (fwrite(data, len, 1, self->fp) == 0)
193 write_error(self->target);
194 }
195
close_file(Stream * self)196 static void close_file(Stream *self) {
197 (void)fclose(self->fp);
198 }
199
close_pipe(Stream * self)200 static void close_pipe(Stream *self) {
201 (void)pclose(self->fp);
202 }
203
find_buffer(char * s)204 static Object find_buffer(char *s) {
205 Object p;
206
207 for (p = buffers; !Nullp(p); p = Cdr(p)) {
208 if (strcmp(STREAM(Car(p))->target, s) == 0)
209 return Car(p);
210 }
211 return Null;
212 }
213
target_is_buffer(char * s)214 static int target_is_buffer(char *s) {
215 int len = strlen(s);
216
217 return len > 1 && s[0] == '[' && s[len-1] == ']';
218 }
219
open_stream(Object target,char direction,int append)220 static Object open_stream(Object target, char direction, int append) {
221 char *t = Get_Strsym(target), *mode;
222 Stream *p;
223 Object ret = Null, b = Null;
224 GC_Node3;
225
226 GC_Link3(target, ret, b);
227 if (target_is_buffer(t)) {
228 b = find_buffer(t);
229 if (!Nullp(b)) {
230 p = STREAM(b);
231 assert(p->type == 'b');
232 assert(p->direction == 'o');
233 if (p->open)
234 Primitive_Error("stream ~s is already open", b);
235 if (direction == 'o') {
236 p->open = 1;
237 p->lno = p->bs = 0;
238 if (!append) {
239 p->pos = 0;
240 buffer_clear(p->bp);
241 }
242 GC_Unlink;
243 return b;
244 }
245 }
246 }
247 ret = Alloc_Object(sizeof(Stream), T_Stream, 0);
248 p = STREAM(ret);
249 p->tag = Null;
250 p->open = 1;
251 p->direction = direction;
252 p->lno = p->pos = 0;
253 p->unread = buffer_new(0);
254 p->target = safe_malloc(strlen(t) + 1);
255 strcpy(p->target, t);
256 if (target_is_buffer(t)) {
257 p->readline = readline_buffer;
258 p->write = write_buffer; /* no close function */
259 p->type = 'b';
260 p->bp = buffer_new(0);
261 if (direction == 'o') {
262 buffers = Cons(ret, buffers);
263 } else {
264 p->bs = 0;
265 if (!Nullp(b))
266 buffer_puts(p->bp, STREAM(b)->bp->data, STREAM(b)->bp->size);
267 }
268 } else {
269 mode = direction == 'i' ? "r" : append ? "a" : "w";
270 p->readline = readline_file;
271 p->write = write_file;
272 if (t[0] == '|') {
273 char *s;
274 if ((p->fp = popen(t+1, mode)) == 0)
275 Primitive_Error("cannot open pipe to ~s", target);
276 if ((s = strchr(p->target, ' ')) != 0)
277 *s = 0;
278 p->close = close_pipe;
279 p->type = 'p';
280 } else {
281 if (direction == 'i' && strcmp(t, "stdin") == 0) {
282 p->fp = stdin;
283 } else if ((p->fp = fopen(t, mode)) == 0) {
284 Saved_Errno = errno;
285 Primitive_Error("cannot open ~s: ~E", target);
286 }
287 p->close = close_file;
288 p->type = 'f';
289 }
290 }
291 Register_Object(ret, (GENERIC)0, terminate_stream, 0);
292 GC_Unlink;
293 return ret;
294 }
295
p_open_input_stream(Object target)296 Object p_open_input_stream(Object target) {
297 return open_stream(target, 'i', 0);
298 }
299
p_open_output_stream(Object target)300 static Object p_open_output_stream(Object target) {
301 return open_stream(target, 'o', 0);
302 }
303
p_append_output_stream(Object target)304 static Object p_append_output_stream(Object target) {
305 return open_stream(target, 'o', 1);
306 }
307
p_close_stream(Object x)308 Object p_close_stream(Object x) {
309 if (!Truep(x))
310 return Void;
311 Check_Type(x, T_Stream);
312 if (!STREAM(x)->open)
313 return Void;
314 if (stream_is_active(x))
315 Primitive_Error("stream ~s is still in use", x);
316 return terminate_stream(x);
317 }
318
set_stream(Object x,Object * which)319 static Object set_stream(Object x, Object *which) {
320 Object ret = *which;
321 Stream *p;
322
323 if (Truep(*which) && STREAM(*which)->type != 'b' &&
324 STREAM(*which)->direction == 'o')
325 (void)fflush(STREAM(*which)->fp);
326 if (Truep(x)) {
327 Check_Type(x, T_Stream);
328 p = STREAM(x);
329 if (!p->open)
330 Primitive_Error("stream ~s has been closed", x);
331 if (stream_is_active(x))
332 Primitive_Error("stream ~s is already in use", x);
333 if (which == &istream && p->direction != 'i')
334 Primitive_Error("stream ~s is not an input stream", x);
335 if (which == &ostream && p->direction != 'o')
336 Primitive_Error("stream ~s is not an output stream", x);
337 *which = x;
338 } else {
339 *which = False;
340 }
341 return ret;
342 }
343
p_set_input_stream(Object x)344 Object p_set_input_stream(Object x) {
345 return set_stream(x, &istream);
346 }
347
p_set_output_stream(Object x)348 static Object p_set_output_stream(Object x) {
349 return set_stream(x, &ostream);
350 }
351
p_input_stream(void)352 static Object p_input_stream(void) {
353 return istream;
354 }
355
p_output_stream(void)356 static Object p_output_stream(void) {
357 return ostream;
358 }
359
p_unread_line(Object str)360 static Object p_unread_line(Object str) {
361 Check_Type(str, T_String);
362 if (!Truep(istream))
363 Primitive_Error("no input stream defined");
364 buffer_puts(STREAM(istream)->unread, STRING(str)->data,
365 STRING(str)->size);
366 return Void;
367 }
368
369 #define stream_type_pred(what,t)\
370 static Object p_stream_##what(Object x) {\
371 if (Truep(x)) {\
372 Check_Type(x, T_Stream);\
373 return STREAM(x)->type == t ? True : False;\
374 } else return False;\
375 }
376 stream_type_pred(buffer, 'b')
377 stream_type_pred(file, 'f')
378 stream_type_pred(pipe, 'p')
379
p_stream_target(Object x)380 static Object p_stream_target(Object x) {
381 if (!Truep(x))
382 return Make_String("", 0);
383 Check_Type(x, T_Stream);
384 return Make_String(STREAM(x)->target, strlen(STREAM(x)->target));
385 }
386
p_stream_to_string(Object target)387 static Object p_stream_to_string(Object target) {
388 Object str, old, ret;
389 Stream *sp;
390 Buffer *bp;
391
392 str = p_open_input_stream(target);
393 old = p_set_input_stream(str);
394 bp = buffer_new(0);
395 for (sp = STREAM(str); sp->readline(sp, bp) == 0; )
396 ;
397 (void)p_set_input_stream(old);
398 (void)p_close_stream(str);
399 ret = Make_String(bp->data, bp->size);
400 buffer_delete(bp);
401 return ret;
402 }
403
p_stream_position(Object x)404 static Object p_stream_position(Object x) {
405 if (!Truep(x))
406 return Make_Integer(0);
407 Check_Type(x, T_Stream);
408 return Make_Unsigned_Long(STREAM(x)->pos);
409 }
410
init_stream(void)411 void init_stream(void) {
412 istream = ostream = False;
413 buffers = Null;
414 Global_GC_Link(istream);
415 Global_GC_Link(ostream);
416 Global_GC_Link(buffers);
417 T_Stream = Define_Type(0, "stream", NOFUNC, sizeof(Stream),
418 stream_equal, stream_equal, stream_print, NOFUNC);
419 Define_Primitive(p_streamp, "stream?", 1, 1, EVAL);
420 Define_Primitive(p_open_input_stream,
421 "open-input-stream", 1, 1, EVAL);
422 Define_Primitive(p_open_output_stream,
423 "open-output-stream", 1, 1, EVAL);
424 Define_Primitive(p_append_output_stream,
425 "append-output-stream", 1, 1, EVAL);
426 Define_Primitive(p_close_stream, "close-stream", 1, 1, EVAL);
427 Define_Primitive(p_set_input_stream,
428 "set-input-stream!", 1, 1, EVAL);
429 Define_Primitive(p_set_output_stream,
430 "set-output-stream!", 1, 1, EVAL);
431 Define_Primitive(p_input_stream, "input-stream", 0, 0, EVAL);
432 Define_Primitive(p_output_stream, "output-stream", 0, 0, EVAL);
433 Define_Primitive(p_unread_line, "unread-line", 1, 1, EVAL);
434 Define_Primitive(p_stream_buffer, "stream-buffer?", 1, 1, EVAL);
435 Define_Primitive(p_stream_file, "stream-file?", 1, 1, EVAL);
436 Define_Primitive(p_stream_pipe, "stream-pipe?", 1, 1, EVAL);
437 Define_Primitive(p_stream_target, "stream-target", 1, 1, EVAL);
438 Define_Primitive(p_stream_to_string,"stream->string", 1, 1, EVAL);
439 Define_Primitive(p_stream_position, "stream-position", 1, 1, EVAL);
440 }
441