1 /* xlio - xlisp i/o routines */
2 /* Copyright (c) 1985, by David Michael Betz
3 All Rights Reserved
4 Permission is granted for unrestricted non-commercial use */
5
6 /* CHANGE LOG
7 * --------------------------------------------------------------------
8 * 28Apr03 dm eliminate some compiler warnings
9 */
10
11 #include "xlisp.h"
12
13 /* external variables */
14 extern LVAL s_stdin,s_stdout,s_stderr,s_debugio,s_traceout,s_unbound;
15 extern int xlfsize;
16
17 #ifdef DEBUG_INPUT
18 extern FILE *read_by_xlisp;
19 #endif
20
21 /* xlgetc - get a character from a file or stream */
xlgetc(LVAL fptr)22 int xlgetc(LVAL fptr)
23 {
24 LVAL lptr, cptr=NULL;
25 FILE *fp;
26 int ch;
27
28 /* check for input from nil */
29 if (fptr == NIL)
30 ch = EOF;
31
32 /* otherwise, check for input from a stream */
33 else if (ustreamp(fptr)) {
34 if ((lptr = gethead(fptr)) == NIL)
35 ch = EOF;
36 else {
37 if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
38 xlfail("bad stream");
39 sethead(fptr,lptr = cdr(lptr));
40 if (lptr == NIL)
41 settail(fptr,NIL);
42 ch = getchcode(cptr);
43 }
44 }
45
46 /* otherwise, check for a buffered character */
47 else if ((ch = getsavech(fptr)))
48 setsavech(fptr,'\0');
49
50 /* otherwise, check for terminal input or file input */
51 else {
52 fp = getfile(fptr);
53 if (fp == stdin || fp == STDERR)
54 ch = ostgetc();
55 else
56 ch = osagetc(fp);
57 #ifdef DEBUG_INPUT
58 if (read_by_xlisp && ch != -1) {
59 putc(ch, read_by_xlisp);
60 }
61 #endif
62 }
63
64 /* return the character */
65 return (ch);
66 }
67
68 /* xlungetc - unget a character */
xlungetc(LVAL fptr,int ch)69 void xlungetc(LVAL fptr, int ch)
70 {
71 LVAL lptr;
72
73 /* check for ungetc from nil */
74 if (fptr == NIL || ch == EOF)
75 ;
76
77 /* otherwise, check for ungetc to a stream */
78 else if (ustreamp(fptr)) {
79 if (ch != EOF) {
80 lptr = cons(cvchar(ch),gethead(fptr));
81 if (gethead(fptr) == NIL)
82 settail(fptr,lptr);
83 sethead(fptr,lptr);
84 }
85 }
86
87 /* otherwise, it must be a file */
88 else
89 setsavech(fptr,ch);
90 }
91
92 /* xlpeek - peek at a character from a file or stream */
xlpeek(LVAL fptr)93 int xlpeek(LVAL fptr)
94 {
95 LVAL lptr, cptr=NULL;
96 int ch;
97
98 /* check for input from nil */
99 if (fptr == NIL)
100 ch = EOF;
101
102 /* otherwise, check for input from a stream */
103 else if (ustreamp(fptr)) {
104 if ((lptr = gethead(fptr)) == NIL)
105 ch = EOF;
106 else {
107 if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
108 xlfail("bad stream");
109 ch = getchcode(cptr);
110 }
111 }
112
113 /* otherwise, get the next file character and save it */
114 else {
115 ch = xlgetc(fptr);
116 setsavech(fptr,ch);
117 }
118
119 /* return the character */
120 return (ch);
121 }
122
123 /* xlputc - put a character to a file or stream */
xlputc(LVAL fptr,int ch)124 void xlputc(LVAL fptr, int ch)
125 {
126 LVAL lptr;
127 FILE *fp;
128
129 /* count the character */
130 ++xlfsize;
131
132 /* check for output to nil */
133 if (fptr == NIL)
134 ;
135
136 /* otherwise, check for output to an unnamed stream */
137 else if (ustreamp(fptr)) {
138 lptr = consa(cvchar(ch));
139 if (gettail(fptr))
140 rplacd(gettail(fptr),lptr);
141 else
142 sethead(fptr,lptr);
143 settail(fptr,lptr);
144 }
145
146 /* otherwise, check for terminal output or file output */
147 else {
148 fp = getfile(fptr);
149 if (!fp)
150 xlfail("file not open");
151 else if (fp == stdout || fp == STDERR)
152 ostputc(ch);
153 else
154 osaputc(ch,fp);
155 }
156 }
157
158 /* xloutflush -- flush output buffer */
xloutflush(LVAL fptr)159 void xloutflush(LVAL fptr)
160 {
161 FILE *fp;
162
163 /* check for output to nil or unnamed stream */
164 if (fptr == NIL || ustreamp(fptr))
165 ;
166
167 /* otherwise, check for terminal output or file output */
168 else {
169 fp = getfile(fptr);
170 if (!fp)
171 xlfail("file not open");
172 else if (fp == stdout || fp == STDERR)
173 ostoutflush();
174 else
175 osoutflush(fp);
176 }
177 }
178
179 /* xlflush - flush the input buffer */
xlflush(void)180 void xlflush(void)
181 {
182 osflush();
183 }
184
185 /* stdprint - print to *standard-output* */
stdprint(LVAL expr)186 void stdprint(LVAL expr)
187 {
188 xlprint(getvalue(s_stdout),expr,TRUE);
189 xlterpri(getvalue(s_stdout));
190 }
191
192 /* stdputstr - print a string to *standard-output* */
stdputstr(const char * str)193 void stdputstr(const char *str)
194 {
195 xlputstr(getvalue(s_stdout),str);
196 }
197
198 /* stdflush - flush the *standard-output* buffer */
stdflush()199 void stdflush()
200 {
201 xloutflush(getvalue(s_stdout));
202 }
203
204 /* errprint - print to *error-output* */
errprint(LVAL expr)205 void errprint(LVAL expr)
206 {
207 xlprint(getvalue(s_stderr),expr,TRUE);
208 xlterpri(getvalue(s_stderr));
209 }
210
211 /* errputstr - print a string to *error-output* */
errputstr(const char * str)212 void errputstr(const char *str)
213 {
214 xlputstr(getvalue(s_stderr),str);
215 }
216
217 /* dbgprint - print to *debug-io* */
dbgprint(LVAL expr)218 void dbgprint(LVAL expr)
219 {
220 xlprint(getvalue(s_debugio),expr,TRUE);
221 xlterpri(getvalue(s_debugio));
222 }
223
224 /* dbgputstr - print a string to *debug-io* */
dbgputstr(const char * str)225 void dbgputstr(const char *str)
226 {
227 xlputstr(getvalue(s_debugio),str);
228 }
229
230 /* trcprin1 - print to *trace-output* */
trcprin1(LVAL expr)231 void trcprin1(LVAL expr)
232 {
233 xlprint(getvalue(s_traceout),expr,TRUE);
234 }
235
236 /* trcputstr - print a string to *trace-output* */
trcputstr(const char * str)237 void trcputstr(const char *str)
238 {
239 xlputstr(getvalue(s_traceout),str);
240 }
241
242
243