1 // stream.h Copyright (C) Codemist, 1995-2021
2
3 //
4 // Header defining the structure of stream objects in CSL, and also
5 // the format for "library" files used with the fast-load mechanism.
6 //
7
8
9 /**************************************************************************
10 * Copyright (C) 2021, Codemist. A C Norman *
11 * *
12 * Redistribution and use in source and binary forms, with or without *
13 * modification, are permitted provided that the following conditions are *
14 * met: *
15 * *
16 * * Redistributions of source code must retain the relevant *
17 * copyright notice, this list of conditions and the following *
18 * disclaimer. *
19 * * Redistributions in binary form must reproduce the above *
20 * copyright notice, this list of conditions and the following *
21 * disclaimer in the documentation and/or other materials provided *
22 * with the distribution. *
23 * *
24 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS *
25 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT *
26 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS *
27 * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE *
28 * COPYRIGHT OWNERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, *
29 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, *
30 * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS *
31 * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND *
32 * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR *
33 * TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF *
34 * THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH *
35 * DAMAGE. *
36 *************************************************************************/
37
38
39 // $Id: stream.h 5609 2021-01-23 22:02:30Z arthurcnorman $
40
41 #ifndef header_stream_h
42 #define header_stream_h 1
43
44 extern std::FILE *non_terminal_input;
45 extern int terminal_pushed;
46
47 typedef int character_stream_reader(LispObject);
48 typedef int character_stream_writer(int, LispObject);
49 typedef int32_t other_stream_op(int32_t, LispObject);
50
51 extern LispObject Lopen(LispObject env, LispObject name,
52 LispObject dir);
53
54 //
55 // The values used here are placed where characters might be, or possibly
56 // OR'd with character codes. They are now such that even if I am using
57 // 21-bit characters (Unicode) all ought to be well. Anything that can be
58 // treated as a character (including an end of file marker) will be limited
59 // to 0x001fffff
60 // so these two bits are well out of the way.
61 //
62 #define ESCAPED_CHAR 0x20000000
63 #define NOT_CHAR 0x40000000
64
65 extern int char_to_terminal(int c, LispObject f);
66 extern int char_to_file(int c, LispObject f);
67 extern int char_to_pipeout(int c, LispObject f);
68 extern int char_to_synonym(int c, LispObject f);
69 extern int char_to_broadcast(int c, LispObject f);
70 extern int char_to_illegal(int c, LispObject f);
71 extern int char_to_list(int c, LispObject f);
72 extern int code_to_list(int c, LispObject f);
73 extern int count_character(int c, LispObject f);
74 extern int binary_outchar(int c, LispObject f);
75 extern int char_to_function(int c, LispObject f);
76 #if defined HAVE_LIBFOX || defined HAVE_LIBWX
77 extern int char_to_math(int c, LispObject f);
78 extern int char_to_spool(int c, LispObject f);
79 #endif
80
81 extern int32_t write_action_terminal(int32_t c, LispObject f);
82 extern int32_t write_action_file(int32_t c, LispObject f);
83 extern int32_t write_action_pipe(int32_t c, LispObject f);
84 extern int32_t write_action_synonym(int32_t c, LispObject f);
85 extern int32_t write_action_broadcast(int32_t c, LispObject f);
86 extern int32_t write_action_twoway(int32_t c, LispObject f);
87 extern int32_t write_action_illegal(int32_t c, LispObject f);
88 extern int32_t write_action_list(int32_t c, LispObject f);
89 #if defined HAVE_LIBFOX || defined HAVE_LIBWX
90 extern int32_t write_action_math(int32_t c, LispObject f);
91 extern int32_t write_action_spool(int32_t c, LispObject f);
92 #endif
93
94 extern int char_from_terminal(LispObject f);
95 extern int char_from_file(LispObject f);
96 extern int char_from_pipe(LispObject f);
97 extern int char_from_synonym(LispObject f);
98 extern int char_from_concatenated(LispObject f);
99 extern int char_from_echo(LispObject f);
100 extern int char_from_illegal(LispObject f);
101 extern int char_from_list(LispObject f);
102 extern int char_from_vector(LispObject f);
103
104 extern int32_t read_action_terminal(int32_t c, LispObject f);
105 extern int32_t read_action_file(int32_t c, LispObject f);
106 extern int32_t read_action_output_file(int32_t c, LispObject f);
107 extern int32_t read_action_synonym(int32_t c, LispObject f);
108 extern int32_t read_action_concatenated(int32_t c, LispObject f);
109 extern int32_t read_action_echo(int32_t c, LispObject f);
110 extern int32_t read_action_twoway(int32_t c, LispObject f);
111 extern int32_t read_action_illegal(int32_t c, LispObject f);
112 extern int32_t read_action_list(int32_t c, LispObject f);
113 extern int32_t read_action_vector(int32_t c, LispObject f);
114
115 #define MAX_PROMPT_LENGTH 80
116 extern char memory_print_buffer[MAX_PROMPT_LENGTH];
117
118 //
119 // The following typedef shows the expected layout of a Lisp_STREAM object,
120 // but it is not used directly because I need to insist that each field is
121 // exactly CELL wide. Thus when I access things that contain pointers I
122 // will perform horrible casts. This is essential if I am to be able to host
123 // this system on certain 64-bit systems.
124 //
125 // typedef struct Lisp_STREAM
126 // {
127 // Header h; 0
128 // LispObject type; CELL
129 // LispObject write_data; 2*CELL
130 // LispObject read_data; 3*CELL
131 // FILE *file; 4*CELL
132 // character_stream_writer *write_fn; 5*CELL
133 // other_stream_op *write_other_fn; 6*CELL
134 // intptr_t line_length; 7*CELL
135 // intptr_t byte_pos; 8*CELL
136 // intptr_t char_pos; 9*CELL
137 // character_stream_reader *read_fn; 10*CELL
138 // other_stream_op *read_other_fn; 11*CELL
139 // intptr_t pushed_char; 12*CELL
140 // intptr_t spare; 13*CELL
141 // } Lisp_STREAM;
142 //
143 // Now in fact I could make STREAM objects longer than this provided I
144 // accept that if a stream is moved from a 32 to a 64-bit world its length
145 // will alter. If the extra space is for use as a buffer that feels OK to me
146 // because the stream should not be active while it is being dumped and
147 // re-loaded. I can use stream_spare to tell me where the buffer begins.
148 // So here I am now putting STREAM_BUFFER_SIZE bytes at the end of each
149 // STREAM object, and that will be 64K on a 64-bit machine and 32K on
150 // a 32-bit one. I am not yet doing that and may not need to until and unless
151 // I make the code here multi-threaded.
152 //
153
154 #define STREAM_BUFFER_SIZE (8192*CELL)
155 #define STREAM_SIZE (14*CELL)
156 #define BUFFERED_STREAM_SIZE (STREAM_SIZE+STREAM_BUFFER_SIZE)
157
stream_type(LispObject v)158 inline atomic<LispObject> &stream_type(LispObject v)
159 { return basic_elt(v, 0);
160 }
stream_write_data(LispObject v)161 inline atomic<LispObject> &stream_write_data(LispObject v)
162 { return basic_elt(v, 1);
163 }
stream_read_data(LispObject v)164 inline atomic<LispObject> &stream_read_data(LispObject v)
165 { return basic_elt(v, 2);
166 }
stream_file(LispObject v)167 inline atomic<std::FILE *> &stream_file(LispObject v)
168 { return (atomic<std::FILE *>&)basic_elt(v, 3);
169 }
stream_write_fn(LispObject v)170 inline atomic<character_stream_writer *> &stream_write_fn(
171 LispObject v)
172 { return (atomic<character_stream_writer *>&)basic_elt(v, 4);
173 }
stream_write_other(LispObject v)174 inline atomic<other_stream_op *> &stream_write_other(LispObject v)
175 { return (atomic<other_stream_op *>&)basic_elt(v,5);
176 }
stream_line_length(LispObject v)177 inline atomic<LispObject> &stream_line_length(LispObject v)
178 { return basic_elt(v, 6);
179 }
stream_byte_pos(LispObject v)180 inline atomic<LispObject> &stream_byte_pos(LispObject v)
181 { return basic_elt(v, 7);
182 }
stream_char_pos(LispObject v)183 inline atomic<LispObject> &stream_char_pos(LispObject v)
184 { return basic_elt(v, 8);
185 }
stream_read_fn(LispObject v)186 inline atomic<character_stream_reader *> &stream_read_fn(LispObject v)
187 { return (atomic<character_stream_reader *>&)basic_elt(v, 9);
188 }
stream_read_other(LispObject v)189 inline atomic<other_stream_op *> &stream_read_other(LispObject v)
190 { return (atomic<other_stream_op *>&)basic_elt(v,10);
191 }
stream_pushed_char(LispObject v)192 inline atomic<LispObject> &stream_pushed_char(LispObject v)
193 { return basic_elt(v, 11);
194 }
stream_spare(LispObject v)195 inline atomic<LispObject> &stream_spare(LispObject v)
196 { return basic_elt(v, 12);
197 }
198
set_stream_file(LispObject v,std::FILE * x)199 inline LispObject set_stream_file(LispObject v, std::FILE *x)
200 { return (basic_elt(v, 3) = reinterpret_cast<LispObject>(x));
201 }
set_stream_write_fn(LispObject v,character_stream_writer * x)202 inline LispObject set_stream_write_fn(LispObject v,
203 character_stream_writer *x)
204 { return (basic_elt(v, 4) = reinterpret_cast<LispObject>(x));
205 }
set_stream_write_other(LispObject v,other_stream_op * x)206 inline LispObject set_stream_write_other(LispObject v,
207 other_stream_op *x)
208 { return (basic_elt(v, 5) = reinterpret_cast<LispObject>(x));
209 }
set_stream_read_fn(LispObject v,character_stream_reader * x)210 inline LispObject set_stream_read_fn(LispObject v,
211 character_stream_reader *x)
212 { return (basic_elt(v, 9) = reinterpret_cast<LispObject>(x));
213 }
set_stream_read_other(LispObject v,other_stream_op * x)214 inline LispObject set_stream_read_other(LispObject v,
215 other_stream_op *x)
216 { return (basic_elt(v, 10) = reinterpret_cast<LispObject>(x));
217 }
218
219 #define STREAM_HEADER (TAG_HDR_IMMED + TYPE_STREAM + (STREAM_SIZE<<(Tw+5)))
220 #define STREAM_FLAG_PIPE 1
221
is_stream(LispObject v)222 inline bool is_stream(LispObject v)
223 { return (is_vector(v) && vechdr(v) == STREAM_HEADER);
224 }
225
putc_stream(int c,LispObject f)226 inline int putc_stream(int c, LispObject f)
227 { character_stream_writer *fn = stream_write_fn(f);
228 return (*fn)(c & 0xff, f);
229 }
230
getc_stream(LispObject f)231 inline int getc_stream(LispObject f)
232 { character_stream_reader *fn = stream_read_fn(f);
233 return (*fn)(f);
234 }
235
other_write_action(int32_t c,LispObject f)236 inline int32_t other_write_action(int32_t c, LispObject f)
237 { other_stream_op *fn = stream_write_other(f);
238 return (*fn)(c, f);
239 }
240
other_read_action(int32_t c,LispObject f)241 inline int32_t other_read_action(int32_t c, LispObject f)
242 { other_stream_op *fn = stream_read_other(f);
243 return (*fn)(c, f);
244 }
245
246 //
247 // For other_write_action if the top four bits of the operand select an
248 // action to be performed, while the remaining 28 are available to pass
249 // an operand.
250 //
251
252 #define WRITE_GET_INFO 0x00000000
253 # define WRITE_GET_LINE_LENGTH 0
254 # define WRITE_GET_COLUMN 1
255 # define WRITE_IS_CONSOLE 2
256 #define WRITE_CLOSE 0x10000000
257 #define WRITE_FLUSH 0x20000000
258 #define WRITE_SET_LINELENGTH 0x30000000
259 #define WRITE_SET_COLUMN 0x40000000
260 #define WRITE_SET_LINELENGTH_DEFAULT 0x50000000
261
262 //
263 // For other_read_action() if the operand is in the range -1 to 0x10ffff then
264 // it is a character to be unread (-1 is used for EOF). Otherwise if the most
265 // significant bit is a "1" then the request is a seek (with a 31-bit address
266 // within the stream to go to). The remaining few cases are things that do
267 // not need additional data passed.
268 //
269 #define READ_SEEK 0x80000000
270 #define READ_TELL 0x40000000
271 #define READ_CLOSE 0x40000001
272 #define READ_FLUSH 0x40000002
273 #define READ_IS_CONSOLE 0x40000003
274 #define READ_END 0x40000004
275
276 // Print options...
277
278 #define escape_yes 0x0001 // make output re-readable
279
280 #define escape_fold_down 0x0002 // force lower case output
281 #define escape_fold_up 0x0004 // FORCE UPPER CASE OUTPUT
282 #define escape_capitalize 0x0008 // Force Capitalisation (!)
283
284 #define escape_binary 0x0010 // print format for numbers
285 #define escape_octal 0x0020 // (including bignums)
286 #define escape_hex 0x0040
287 #define escape_nolinebreak 0x0080 // use infinite line-length
288 #define escape_hexwidth 0x3f00 // 6 bits to specify width of hex/bin
289 #define escape_width(n) (((n) & escape_hexwidth) >> 8)
290 #define escape_checksum 0x4000 // doing a checksum operation
291 #define escape_exploding 0x8000 // in explode, exploden etc
292
293
294 extern LispObject make_stream_handle(void);
295 extern bool use_wimp;
296
297 extern character_reader *procedural_input;
298 extern character_writer *procedural_output;
299
300 extern directory *rootDirectory;
301 #define PDS_INPUT 0
302 #define PDS_OUTPUT 1
303 #define PDS_PENDING 2
304 extern directory *open_pds(const char *name, int mode);
305 extern bool finished_with(int h);
306
307 #endif // header_stream_h
308
309 // end of stream.h
310