1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
|
/* xlio - xlisp i/o routines */
/* Copyright (c) 1989, by David Michael Betz. */
/* You may give out copies of this software; for conditions see the file */
/* COPYING included with this distribution. */
#include "xlisp.h"
/* xlgetc - get a character from a file or stream */
int xlgetc P1C(LVAL, fptr)
{
LVAL lptr,cptr=NULL;
FILEP fp;
int ch;
/* check for input from nil */
if (fptr == NIL)
ch = EOF;
/* otherwise, check for input from a stream */
else if (ustreamp(fptr)) {
if ((lptr = gethead(fptr)) == NIL)
ch = EOF;
else {
if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
xlfail("bad stream");
sethead(fptr,lptr = cdr(lptr));
if (lptr == NIL)
settail(fptr,NIL);
ch = getchcode(cptr);
}
}
/* otherwise, check for a buffered character */
else if ((ch = getsavech(fptr)) != 0)
setsavech(fptr,'\0');
/* otherwise, check for terminal input or file input */
else {
fp = getfile(fptr);
if (fp == CLOSED) /* TAA MOD -- give error */
xlfail("can't read closed stream");
else if (fp == CONSOLE)
/* TAA MOD -- revamped for redirecting */
ch = ostgetc();
else {
if ((fptr->n_sflags & S_FORREADING) == 0)
xlerror("can't read write-only file stream", fptr);
if ((fptr->n_sflags & S_READING) == 0) {
/* possible direction change*/
if (fptr->n_sflags & S_WRITING) {
OSSEEKCUR(fp,0L);
}
fptr->n_sflags |= S_READING;
fptr->n_sflags &= ~S_WRITING;
}
#ifdef OSAGETC
ch = (fptr->n_sflags & S_BINARY) ? OSGETC(fp) : OSAGETC(fp);
#else
ch = OSGETC(fp);
#endif
}
}
/* return the character */
return (ch);
}
/* xlungetc - unget a character */
VOID xlungetc P2C(LVAL, fptr, int, ch)
{
LVAL lptr;
/* check for ungetc from nil, or ungetc of EOF */
if (fptr == NIL || ch == EOF)
;
/* otherwise, check for ungetc to a stream */
else if (ustreamp(fptr)) {
lptr = cons(cvchar(ch),gethead(fptr));
if (gethead(fptr) == NIL)
settail(fptr,lptr);
sethead(fptr,lptr);
}
/* otherwise, it must be a file */
else
setsavech(fptr,ch);
}
/* xlpeek - peek at a character from a file or stream */
int xlpeek P1C(LVAL, fptr)
{
LVAL lptr,cptr=NULL;
int ch;
/* check for input from nil */
if (fptr == NIL)
ch = EOF;
/* otherwise, check for input from a stream */
else if (ustreamp(fptr)) {
if ((lptr = gethead(fptr)) == NIL)
ch = EOF;
else {
if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
xlfail("bad stream");
ch = getchcode(cptr);
}
}
/* otherwise, get the next file character and save it */
else {
ch = xlgetc(fptr);
if (ch != EOF) setsavech(fptr,ch); /* TAA MOD -- don't save EOF! */
}
/* return the character */
return (ch);
}
/* xlputc - put a character to a file or stream */
VOID xlputc P2C(LVAL, fptr, int, ch)
{
LVAL lptr;
FILEP fp;
/* TAA MOD -- delete output to NIL and character counting 1/97 */
/* check for output to an unnamed stream */
if (ntype(fptr) == USTREAM) { /* TAA MOD, was ustreamp() */
lptr = consa(cvchar((unsigned char)ch));
if (gettail(fptr)!=NIL)
rplacd(gettail(fptr),lptr);
else
sethead(fptr,lptr);
settail(fptr,lptr);
}
/* otherwise, check for terminal output or file output */
else {
fp = getfile(fptr);
if (fp == CLOSED) /* TAA MOD -- give error */
xlfail("can't write closed stream");
if (fp == CONSOLE) /* TAA MOD -- for redirecting */
ostputc(ch);
else {
if ((fptr->n_sflags & S_FORWRITING) == 0)
xlerror("can't write read-only file stream", fptr);
if ((fptr->n_sflags & S_WRITING) == 0) {
/* possible direction change*/
if (fptr->n_sflags & S_READING) {
OSSEEKCUR(fp,
(getsavech(fptr)?(setsavech(fptr,'\0'),-1L):0L));
}
fptr->n_sflags |= S_WRITING;
fptr->n_sflags &= ~S_READING;
#ifdef BIGNUMS
if ((fptr->n_sflags & S_BINARY) == 0)
#endif
fptr->n_cpos = 0; /* best guess */
}
#ifdef BIGNUMS
if ((fptr->n_sflags & S_BINARY) == 0) {
#endif
if (ch == '\n') fptr->n_cpos = 0;
else fptr->n_cpos++;
#ifdef BIGNUMS
}
#endif
#ifdef OSAGETC
if (((fptr->n_sflags & S_BINARY) ?
OSPUTC(ch,fp) : OSAPUTC(ch,fp)) == EOF)
/* TAA MOD to check for write to RO file */
xlerror("write failed", fptr);
#else
if (OSPUTC(ch,fp)==EOF) /* TAA MOD to check for write to RO file*/
xlerror("write failed", fptr);
#endif
}
}
}
/* xlflush - flush the input buffer */
VOID xlflush(V)
{
setsavech(getvalue(s_termio), '\0'); /* TAA mod -- added 10/93 */
osflush();
}
/* stdprint - print to *standard-output* */
VOID stdprint P1C(LVAL, expr)
{
xlprint(getvalue(s_stdout),expr,TRUE);
xlterpri(getvalue(s_stdout));
}
/* stdputstr - print a string to *standard-output* */
VOID stdputstr P1C(char *, str)
{
xlputstr(getvalue(s_stdout),str);
}
/* errprint - print to *error-output* */
VOID errprint P1C(LVAL, expr)
{
xlprint(getvalue(s_stderr),expr,TRUE);
xlterpri(getvalue(s_stderr));
}
/* errputstr - print a string to *error-output* */
VOID errputstr P1C(char *, str)
{
xlputstr(getvalue(s_stderr),str);
}
/* dbgprint - print to *debug-io* */
VOID dbgprint P1C(LVAL, expr)
{
xlprint(getvalue(s_debugio),expr,TRUE);
xlterpri(getvalue(s_debugio));
}
/* dbgputstr - print a string to *debug-io* */
VOID dbgputstr P1C(char *, str)
{
xlputstr(getvalue(s_debugio),str);
}
/* trcprin1 - print to *trace-output* */
VOID trcprin1 P1C(LVAL, expr)
{
xlprint(getvalue(s_traceout),expr,TRUE);
}
/* trcputstr - print a string to *trace-output* */
VOID trcputstr P1C(char *, str)
{
xlputstr(getvalue(s_traceout),str);
}
|
