rts-internal.c
1 //! @file rts-internal.c
2 //! @author J. Marcel van der Veer
3
4 //! @section Copyright
5 //!
6 //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
7 //! Copyright 2001-2023 J. Marcel van der Veer [algol68g@xs4all.nl].
8
9 //! @section License
10 //!
11 //! This program is free software; you can redistribute it and/or modify it
12 //! under the terms of the GNU General Public License as published by the
13 //! Free Software Foundation; either version 3 of the License, or
14 //! (at your option) any later version.
15 //!
16 //! This program is distributed in the hope that it will be useful, but
17 //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 //! more details. You should have received a copy of the GNU General Public
20 //! License along with this program. If not, see [http://www.gnu.org/licenses/].
21
22 //! @section Synopsis
23 //!
24 //! Transput routines.
25
26 #include "a68g.h"
27 #include "a68g-genie.h"
28 #include "a68g-prelude.h"
29 #include "a68g-transput.h"
30
31 // These routines use A68G's RR transput routines,
32 // essentially mimicking code of the form
33 // PROC puts = (REF STRING s, [] SIMPLOUT items) VOID:
34 // BEGIN FILE f;
35 // associate (f, s);
36 // put (f, items);
37 // close (f)
38 // END
39 // which is not the most efficient, though practical.
40
41 static void associate (A68_FILE *f, A68_REF s)
42 {
43 STATUS (f) = INIT_MASK;
44 FILE_ENTRY (f) = -1;
45 CHANNEL (f) = A68 (associate_channel);
46 OPENED (f) = A68_TRUE;
47 OPEN_EXCLUSIVE (f) = A68_FALSE;
48 READ_MOOD (f) = A68_FALSE;
49 WRITE_MOOD (f) = A68_FALSE;
50 CHAR_MOOD (f) = A68_FALSE;
51 DRAW_MOOD (f) = A68_FALSE;
52 TMP_FILE (f) = A68_FALSE;
53 IDENTIFICATION (f) = nil_ref;
54 TERMINATOR (f) = nil_ref;
55 FORMAT (f) = nil_format;
56 FD (f) = A68_NO_FILE;
57 STRING (f) = s;
58 STRPOS (f) = 0;
59 DEVICE_MADE (&DEVICE (f)) = A68_FALSE;
60 STREAM (&DEVICE (f)) = NO_STREAM;
61 set_default_event_procedures (f);
62 }
63
64 //! @brief PROC (REF STRING, [] SIMPLIN) VOID gets
65
66 void genie_get_text (NODE_T * p)
67 {
68 // Block GC momentarily.
69 A68_GC (sema)++;
70 // Pop [] SIMPLIN.
71 A68_REF row;
72 POP_REF (p, &row);
73 CHECK_REF (p, row, M_ROW_SIMPLIN);
74 // Pop REF STRING.
75 A68_REF ref_string;
76 POP_REF (p, &ref_string);
77 CHECK_REF (p, ref_string, M_REF_STRING);
78 // Associate a temp file with argument string.
79 A68_REF ref_file = heap_generator (p, M_REF_FILE, SIZE (M_FILE));
80 A68_FILE *file = FILE_DEREF (&ref_file);
81 associate (file, ref_string);
82 open_for_reading (p, ref_file);
83 // Read.
84 A68_ARRAY *arr; A68_TUPLE *tup;
85 GET_DESCRIPTOR (arr, tup, &row);
86 int elems = ROW_SIZE (tup);
87 if (elems > 0) {
88 BYTE_T *base_address = DEREF (BYTE_T, &ARRAY (arr));
89 int elem_index = 0;
90 for (int k = 0; k < elems; k++) {
91 A68_UNION *z = (A68_UNION *) & base_address[elem_index];
92 MOID_T *mode = (MOID_T *) (VALUE (z));
93 BYTE_T *item = (BYTE_T *) & base_address[elem_index + A68_UNION_SIZE];
94 genie_read_standard (p, mode, item, ref_file);
95 elem_index += SIZE (M_SIMPLIN);
96 }
97 }
98 // Discard temp file.
99 unblock_transput_buffer (TRANSPUT_BUFFER (file));
100 A68_GC (sema)--;
101 }
102
103 //! @brief PROC (REF STRING, [] SIMPLOUT) VOID puts
104
105 void genie_put_text (NODE_T * p)
106 {
107 // Block GC momentarily.
108 A68_GC (sema)++;
109 // Pop [] SIMPLOUT.
110 A68_REF row;
111 POP_REF (p, &row);
112 CHECK_REF (p, row, M_ROW_SIMPLOUT);
113 // Pop REF STRING.
114 A68_REF ref_string;
115 POP_REF (p, &ref_string);
116 CHECK_REF (p, ref_string, M_REF_STRING);
117 // Associate a temp file with argument string.
118 A68_REF ref_file = heap_generator (p, M_REF_FILE, SIZE (M_FILE));
119 A68_FILE *file = FILE_DEREF (&ref_file);
120 associate (file, ref_string);
121 open_for_writing (p, ref_file);
122 // Write.
123 A68_ARRAY *arr; A68_TUPLE *tup;
124 GET_DESCRIPTOR (arr, tup, &row);
125 int elems = ROW_SIZE (tup);
126 if (elems > 0) {
127 reset_transput_buffer (UNFORMATTED_BUFFER);
128 BYTE_T *base_address = DEREF (BYTE_T, &ARRAY (arr));
129 int elem_index = 0;
130 for (int k = 0; k < elems; k++) {
131 A68_UNION *z = (A68_UNION *) & base_address[elem_index];
132 MOID_T *mode = (MOID_T *) (VALUE (z));
133 BYTE_T *item = (BYTE_T *) & base_address[elem_index + A68_UNION_SIZE];
134 genie_write_standard (p, mode, item, ref_file);
135 elem_index += SIZE (M_SIMPLOUT);
136 }
137 * DEREF (A68_REF, &ref_string) = c_to_a_string (p, get_transput_buffer (UNFORMATTED_BUFFER), DEFAULT_WIDTH);
138 }
139 // Discard temp file.
140 unblock_transput_buffer (TRANSPUT_BUFFER (file));
141 A68_GC (sema)--;
142 }
143
144 //! @brief PROC (REF STRING, [] SIMPLIN) VOID getsf
145
146 void genie_getf_text (NODE_T * p)
147 {
148 // Block GC momentarily.
149 A68_GC (sema)++;
150 // Pop [] SIMPLIN.
151 A68_REF row;
152 POP_REF (p, &row);
153 CHECK_REF (p, row, M_ROW_SIMPLIN);
154 // Pop REF STRING.
155 A68_REF ref_string;
156 POP_REF (p, &ref_string);
157 CHECK_REF (p, ref_string, M_REF_STRING);
158 // Associate a temp file with argument string.
159 A68_REF ref_file = heap_generator (p, M_REF_FILE, SIZE (M_FILE));
160 A68_FILE *file = FILE_DEREF (&ref_file);
161 associate (file, ref_string);
162 open_for_reading (p, ref_file);
163 // Save stack state since formats have frames.
164 ADDR_T pop_fp = FRAME_POINTER (file);
165 ADDR_T pop_sp = STACK_POINTER (file);
166 FRAME_POINTER (file) = A68_FP;
167 STACK_POINTER (file) = A68_SP;
168 // Process [] SIMPLIN.
169 if (BODY (&FORMAT (file)) != NO_NODE) {
170 open_format_frame (p, ref_file, &FORMAT (file), NOT_EMBEDDED_FORMAT, A68_FALSE);
171 }
172 int formats = 0;
173 // Read.
174 A68_ARRAY *arr; A68_TUPLE *tup;
175 GET_DESCRIPTOR (arr, tup, &row);
176 int elems = ROW_SIZE (tup);
177 if (elems > 0) {
178 BYTE_T *base_address = DEREF (BYTE_T, &ARRAY (arr));
179 int elem_index = 0;
180 for (int k = 0; k < elems; k++) {
181 A68_UNION *z = (A68_UNION *) & base_address[elem_index];
182 MOID_T *mode = (MOID_T *) (VALUE (z));
183 BYTE_T *item = (BYTE_T *) & base_address[elem_index + A68_UNION_SIZE];
184 genie_read_standard_format (p, mode, item, ref_file, &formats);
185 elem_index += SIZE (M_SIMPLIN);
186 }
187 }
188 // Empty the format to purge insertions.
189 purge_format_read (p, ref_file);
190 BODY (&FORMAT (file)) = NO_NODE;
191 // Forget about active formats.
192 A68_FP = FRAME_POINTER (file);
193 A68_SP = STACK_POINTER (file);
194 FRAME_POINTER (file) = pop_fp;
195 STACK_POINTER (file) = pop_sp;
196 // Discard temp file.
197 unblock_transput_buffer (TRANSPUT_BUFFER (file));
198 A68_GC (sema)--;
199 }
200
201 //! @brief PROC (REF STRING, [] SIMPLOUT) VOID putsf
202
203 void genie_putf_text (NODE_T * p)
204 {
205 // Block GC momentarily.
206 A68_GC (sema)++;
207 // Pop [] SIMPLOUT.
208 A68_REF row;
209 POP_REF (p, &row);
210 CHECK_REF (p, row, M_ROW_SIMPLOUT);
211 // Pop REF STRING.
212 A68_REF ref_string;
213 POP_REF (p, &ref_string);
214 CHECK_REF (p, ref_string, M_REF_STRING);
215 // Associate a temp file with argument string.
216 A68_REF ref_file = heap_generator (p, M_REF_FILE, SIZE (M_FILE));
217 A68_FILE *file = FILE_DEREF (&ref_file);
218 associate (file, ref_string);
219 open_for_writing (p, ref_file);
220 // Save stack state since formats have frames.
221 ADDR_T pop_fp = FRAME_POINTER (file);
222 ADDR_T pop_sp = STACK_POINTER (file);
223 FRAME_POINTER (file) = A68_FP;
224 STACK_POINTER (file) = A68_SP;
225 // Process [] SIMPLIN.
226 if (BODY (&FORMAT (file)) != NO_NODE) {
227 open_format_frame (p, ref_file, &FORMAT (file), NOT_EMBEDDED_FORMAT, A68_FALSE);
228 }
229 int formats = 0;
230 // Write.
231 A68_ARRAY *arr; A68_TUPLE *tup;
232 GET_DESCRIPTOR (arr, tup, &row);
233 int elems = ROW_SIZE (tup);
234 if (elems > 0) {
235 reset_transput_buffer (FORMATTED_BUFFER);
236 BYTE_T *base_address = DEREF (BYTE_T, &ARRAY (arr));
237 int elem_index = 0;
238 for (int k = 0; k < elems; k++) {
239 A68_UNION *z = (A68_UNION *) & base_address[elem_index];
240 MOID_T *mode = (MOID_T *) (VALUE (z));
241 BYTE_T *item = (BYTE_T *) & base_address[elem_index + A68_UNION_SIZE];
242 genie_write_standard_format (p, mode, item, ref_file, &formats);
243 elem_index += SIZE (M_SIMPLOUT);
244 }
245 * DEREF (A68_REF, &ref_string) = c_to_a_string (p, get_transput_buffer (FORMATTED_BUFFER), DEFAULT_WIDTH);
246 }
247 // Empty the format to purge insertions.
248 purge_format_write (p, ref_file);
249 write_purge_buffer (p, ref_file, FORMATTED_BUFFER);
250 BODY (&FORMAT (file)) = NO_NODE;
251 // Forget about active formats.
252 A68_FP = FRAME_POINTER (file);
253 A68_SP = STACK_POINTER (file);
254 FRAME_POINTER (file) = pop_fp;
255 STACK_POINTER (file) = pop_sp;
256 // Discard temp file.
257 unblock_transput_buffer (TRANSPUT_BUFFER (file));
258 A68_GC (sema)--;
259 }
260
261 //! @brief PROC (REF STRING, [] SIMPLOUT) REF STRING string
262
263 void genie_string (NODE_T * p)
264 {
265 // Block GC momentarily.
266 A68_GC (sema)++;
267 // Pop [] SIMPLOUT.
268 A68_REF row;
269 POP_REF (p, &row);
270 CHECK_REF (p, row, M_ROW_SIMPLOUT);
271 // Pop REF STRING.
272 A68_REF ref_string;
273 POP_REF (p, &ref_string);
274 CHECK_REF (p, ref_string, M_REF_STRING);
275 // Associate a temp file with argument string.
276 A68_REF ref_file = heap_generator (p, M_REF_FILE, SIZE (M_FILE));
277 A68_FILE *file = FILE_DEREF (&ref_file);
278 associate (file, ref_string);
279 open_for_writing (p, ref_file);
280 // Write.
281 A68_ARRAY *arr; A68_TUPLE *tup;
282 GET_DESCRIPTOR (arr, tup, &row);
283 int elems = ROW_SIZE (tup);
284 if (elems > 0) {
285 reset_transput_buffer (UNFORMATTED_BUFFER);
286 BYTE_T *base_address = DEREF (BYTE_T, &ARRAY (arr));
287 int elem_index = 0;
288 for (int k = 0; k < elems; k++) {
289 A68_UNION *z = (A68_UNION *) & base_address[elem_index];
290 MOID_T *mode = (MOID_T *) (VALUE (z));
291 BYTE_T *item = (BYTE_T *) & base_address[elem_index + A68_UNION_SIZE];
292 genie_write_standard (p, mode, item, ref_file);
293 elem_index += SIZE (M_SIMPLOUT);
294 }
295 * DEREF (A68_REF, &ref_string) = c_to_a_string (p, get_transput_buffer (UNFORMATTED_BUFFER), DEFAULT_WIDTH);
296 }
297 PUSH_REF (p, ref_string);
298 // Discard temp file.
299 unblock_transput_buffer (TRANSPUT_BUFFER (file));
300 A68_GC (sema)--;
301 }
302
303 //! @brief PROC (REF STRING, [] SIMPLOUT) REF STRING stringf
304
305 void genie_stringf (NODE_T * p)
306 {
307 // Block GC momentarily.
308 A68_GC (sema)++;
309 // Pop [] SIMPLOUT.
310 A68_REF row;
311 POP_REF (p, &row);
312 CHECK_REF (p, row, M_ROW_SIMPLOUT);
313 // Pop REF STRING.
314 A68_REF ref_string;
315 POP_REF (p, &ref_string);
316 CHECK_REF (p, ref_string, M_REF_STRING);
317 // Associate a temp file with argument string.
318 A68_REF ref_file = heap_generator (p, M_REF_FILE, SIZE (M_FILE));
319 A68_FILE *file = FILE_DEREF (&ref_file);
320 associate (file, ref_string);
321 open_for_writing (p, ref_file);
322 // Save stack state since formats have frames.
323 ADDR_T pop_fp = FRAME_POINTER (file);
324 ADDR_T pop_sp = STACK_POINTER (file);
325 FRAME_POINTER (file) = A68_FP;
326 STACK_POINTER (file) = A68_SP;
327 // Process [] SIMPLIN.
328 if (BODY (&FORMAT (file)) != NO_NODE) {
329 open_format_frame (p, ref_file, &FORMAT (file), NOT_EMBEDDED_FORMAT, A68_FALSE);
330 }
331 int formats = 0;
332 // Write.
333 A68_ARRAY *arr; A68_TUPLE *tup;
334 GET_DESCRIPTOR (arr, tup, &row);
335 int elems = ROW_SIZE (tup);
336 if (elems > 0) {
337 reset_transput_buffer (FORMATTED_BUFFER);
338 BYTE_T *base_address = DEREF (BYTE_T, &ARRAY (arr));
339 int elem_index = 0;
340 for (int k = 0; k < elems; k++) {
341 A68_UNION *z = (A68_UNION *) & base_address[elem_index];
342 MOID_T *mode = (MOID_T *) (VALUE (z));
343 BYTE_T *item = (BYTE_T *) & base_address[elem_index + A68_UNION_SIZE];
344 genie_write_standard_format (p, mode, item, ref_file, &formats);
345 elem_index += SIZE (M_SIMPLOUT);
346 }
347 * DEREF (A68_REF, &ref_string) = c_to_a_string (p, get_transput_buffer (FORMATTED_BUFFER), DEFAULT_WIDTH);
348 }
349 // Empty the format to purge insertions.
350 purge_format_write (p, ref_file);
351 write_purge_buffer (p, ref_file, FORMATTED_BUFFER);
352 BODY (&FORMAT (file)) = NO_NODE;
353 // Forget about active formats.
354 A68_FP = FRAME_POINTER (file);
355 A68_SP = STACK_POINTER (file);
356 FRAME_POINTER (file) = pop_fp;
357 STACK_POINTER (file) = pop_sp;
358 PUSH_REF (p, ref_string);
359 // Discard temp file.
360 unblock_transput_buffer (TRANSPUT_BUFFER (file));
361 A68_GC (sema)--;
362 }
