a68g-listing.c
1 //! @file a68g-listing.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-2025 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 //! Old-school listing file.
25
26 #include "a68g.h"
27 #include "a68g-prelude.h"
28 #include "a68g-listing.h"
29 #include "a68g-parser.h"
30 #include "a68g-optimiser.h"
31
32 // Routines for making a "fat" listing file.
33
34 #define SHOW_EQ A68G_FALSE
35
36 //! @brief a68g_print_short_mode.
37
38 void a68g_print_short_mode (FILE_T f, MOID_T * z)
39 {
40 if (IS (z, STANDARD)) {
41 int i = DIM (z);
42 if (i > 0) {
43 while (i--) {
44 WRITE (f, "LONG ");
45 }
46 } else if (i < 0) {
47 while (i++) {
48 WRITE (f, "SHORT ");
49 }
50 }
51 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s", NSYMBOL (NODE (z))) >= 0);
52 WRITE (f, A68G (output_line));
53 } else if (IS_REF (z) && IS (SUB (z), STANDARD)) {
54 WRITE (f, "REF ");
55 a68g_print_short_mode (f, SUB (z));
56 } else if (IS (z, PROC_SYMBOL) && PACK (z) == NO_PACK && IS (SUB (z), STANDARD)) {
57 WRITE (f, "PROC ");
58 a68g_print_short_mode (f, SUB (z));
59 } else {
60 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "#%d", NUMBER (z)) >= 0);
61 WRITE (f, A68G (output_line));
62 }
63 }
64
65 //! @brief a68g_print_flat_mode.
66
67 void a68g_print_flat_mode (FILE_T f, MOID_T * z)
68 {
69 if (IS (z, STANDARD)) {
70 int i = DIM (z);
71 if (i > 0) {
72 while (i--) {
73 WRITE (f, "LONG ");
74 }
75 } else if (i < 0) {
76 while (i++) {
77 WRITE (f, "SHORT ");
78 }
79 }
80 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s", NSYMBOL (NODE (z))) >= 0);
81 WRITE (f, A68G (output_line));
82 } else if (IS_REF (z)) {
83 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "REF ") >= 0);
84 WRITE (f, A68G (output_line));
85 a68g_print_short_mode (f, SUB (z));
86 } else if (IS (z, PROC_SYMBOL) && DIM (z) == 0) {
87 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "PROC ") >= 0);
88 WRITE (f, A68G (output_line));
89 a68g_print_short_mode (f, SUB (z));
90 } else if (IS_ROW (z)) {
91 int i = DIM (z);
92 WRITE (f, "[");
93 while (--i) {
94 WRITE (f, ", ");
95 }
96 WRITE (f, "] ");
97 a68g_print_short_mode (f, SUB (z));
98 } else {
99 a68g_print_short_mode (f, z);
100 }
101 }
102
103 //! @brief a68g_print_short_pack.
104
105 void a68g_print_short_pack (FILE_T f, PACK_T * pack)
106 {
107 if (pack != NO_PACK) {
108 a68g_print_short_mode (f, MOID (pack));
109 if (NEXT (pack) != NO_PACK) {
110 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", ") >= 0);
111 WRITE (f, A68G (output_line));
112 a68g_print_short_pack (f, NEXT (pack));
113 }
114 }
115 }
116
117 //! @brief a68g_print_mode.
118
119 void a68g_print_mode (FILE_T f, MOID_T * z)
120 {
121 if (z != NO_MOID) {
122 if (IS (z, STANDARD)) {
123 a68g_print_flat_mode (f, z);
124 } else if (IS (z, INDICANT)) {
125 WRITE (f, NSYMBOL (NODE (z)));
126 } else if (z == M_COLLITEM) {
127 WRITE (f, "\"COLLITEM\"");
128 } else if (IS_REF (z)) {
129 WRITE (f, "REF ");
130 a68g_print_flat_mode (f, SUB (z));
131 } else if (IS_FLEX (z)) {
132 WRITE (f, "FLEX ");
133 a68g_print_flat_mode (f, SUB (z));
134 } else if (IS_ROW (z)) {
135 int i = DIM (z);
136 WRITE (f, "[");
137 while (--i) {
138 WRITE (f, ", ");
139 }
140 WRITE (f, "] ");
141 a68g_print_flat_mode (f, SUB (z));
142 } else if (IS_STRUCT (z)) {
143 WRITE (f, "STRUCT (");
144 a68g_print_short_pack (f, PACK (z));
145 WRITE (f, ")");
146 } else if (IS_UNION (z)) {
147 WRITE (f, "UNION (");
148 a68g_print_short_pack (f, PACK (z));
149 WRITE (f, ")");
150 } else if (IS (z, PROC_SYMBOL)) {
151 WRITE (f, "PROC ");
152 if (PACK (z) != NO_PACK) {
153 WRITE (f, "(");
154 a68g_print_short_pack (f, PACK (z));
155 WRITE (f, ") ");
156 }
157 a68g_print_flat_mode (f, SUB (z));
158 } else if (IS (z, IN_TYPE_MODE)) {
159 WRITE (f, "\"SIMPLIN\"");
160 } else if (IS (z, OUT_TYPE_MODE)) {
161 WRITE (f, "\"SIMPLOUT\"");
162 } else if (IS (z, ROWS_SYMBOL)) {
163 WRITE (f, "\"ROWS\"");
164 } else if (IS (z, SERIES_MODE)) {
165 WRITE (f, "\"SERIES\" (");
166 a68g_print_short_pack (f, PACK (z));
167 WRITE (f, ")");
168 } else if (IS (z, STOWED_MODE)) {
169 WRITE (f, "\"STOWED\" (");
170 a68g_print_short_pack (f, PACK (z));
171 WRITE (f, ")");
172 }
173 }
174 }
175
176 //! @brief print_mode_flat.
177
178 void print_mode_flat (FILE_T f, MOID_T * m)
179 {
180 if (m != NO_MOID) {
181 a68g_print_mode (f, m);
182 if (NODE (m) != NO_NODE && NUMBER (NODE (m)) > 0) {
183 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " node %d", NUMBER (NODE (m))) >= 0);
184 WRITE (f, A68G (output_line));
185 }
186 if (EQUIVALENT_MODE (m) != NO_MOID) {
187 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " equi #%d", NUMBER (EQUIVALENT (m))) >= 0);
188 WRITE (f, A68G (output_line));
189 }
190 if (SLICE (m) != NO_MOID) {
191 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " slice #%d", NUMBER (SLICE (m))) >= 0);
192 WRITE (f, A68G (output_line));
193 }
194 if (TRIM (m) != NO_MOID) {
195 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " trim #%d", NUMBER (TRIM (m))) >= 0);
196 WRITE (f, A68G (output_line));
197 }
198 if (ROWED (m) != NO_MOID) {
199 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " rowed #%d", NUMBER (ROWED (m))) >= 0);
200 WRITE (f, A68G (output_line));
201 }
202 if (DEFLEXED (m) != NO_MOID) {
203 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " deflex #%d", NUMBER (DEFLEXED (m))) >= 0);
204 WRITE (f, A68G (output_line));
205 }
206 if (MULTIPLE (m) != NO_MOID) {
207 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " multiple #%d", NUMBER (MULTIPLE (m))) >= 0);
208 WRITE (f, A68G (output_line));
209 }
210 if (NAME (m) != NO_MOID) {
211 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " name #%d", NUMBER (NAME (m))) >= 0);
212 WRITE (f, A68G (output_line));
213 }
214 if (USE (m)) {
215 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " used") >= 0);
216 WRITE (f, A68G (output_line));
217 }
218 if (DERIVATE (m)) {
219 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " derivate") >= 0);
220 WRITE (f, A68G (output_line));
221 }
222 if (SIZE (m) > 0) {
223 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " size %d", SIZE (m)) >= 0);
224 WRITE (f, A68G (output_line));
225 }
226 if (HAS_ROWS (m)) {
227 WRITE (f, " []");
228 }
229 }
230 }
231
232 //! @brief xref_tags.
233
234 void xref_tags (FILE_T f, TAG_T * s, int a)
235 {
236 for (; s != NO_TAG; FORWARD (s)) {
237 NODE_T *where_tag = NODE (s);
238 if ((where_tag != NO_NODE) && ((STATUS_TEST (where_tag, CROSS_REFERENCE_MASK)) || TAG_TABLE (s) == A68G_STANDENV)) {
239 WRITE (f, "\n ");
240 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "tag %d ", NUMBER (s)) >= 0);
241 WRITE (f, A68G (output_line));
242 switch (a) {
243 case IDENTIFIER: {
244 a68g_print_mode (f, MOID (s));
245 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " %s", NSYMBOL (NODE (s))) >= 0);
246 WRITE (f, A68G (output_line));
247 break;
248 }
249 case INDICANT: {
250 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "indicant %s ", NSYMBOL (NODE (s))) >= 0);
251 WRITE (f, A68G (output_line));
252 a68g_print_mode (f, MOID (s));
253 break;
254 }
255 case PRIO_SYMBOL: {
256 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "priority %s %d", NSYMBOL (NODE (s)), PRIO (s)) >= 0);
257 WRITE (f, A68G (output_line));
258 break;
259 }
260 case OP_SYMBOL: {
261 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "operator %s ", NSYMBOL (NODE (s))) >= 0);
262 WRITE (f, A68G (output_line));
263 a68g_print_mode (f, MOID (s));
264 break;
265 }
266 case LABEL: {
267 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "label %s", NSYMBOL (NODE (s))) >= 0);
268 WRITE (f, A68G (output_line));
269 break;
270 }
271 case ANONYMOUS: {
272 switch (PRIO (s)) {
273 case ROUTINE_TEXT: {
274 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "routine text ") >= 0);
275 break;
276 }
277 case FORMAT_TEXT: {
278 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "format text ") >= 0);
279 break;
280 }
281 case FORMAT_IDENTIFIER: {
282 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "format item ") >= 0);
283 break;
284 }
285 case COLLATERAL_CLAUSE: {
286 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "display ") >= 0);
287 break;
288 }
289 case GENERATOR: {
290 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "generator ") >= 0);
291 break;
292 }
293 case UNIT: {
294 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "unit ") >= 0);
295 break;
296 }
297 }
298 WRITE (f, A68G (output_line));
299 a68g_print_mode (f, MOID (s));
300 break;
301 }
302 default: {
303 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "internal %d ", a) >= 0);
304 WRITE (f, A68G (output_line));
305 a68g_print_mode (f, MOID (s));
306 break;
307 }
308 }
309 if (NODE (s) != NO_NODE && NUMBER (NODE (s)) > 0) {
310 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", node %d", NUMBER (NODE (s))) >= 0);
311 WRITE (f, A68G (output_line));
312 }
313 if (where_tag != NO_NODE && INFO (where_tag) != NO_NINFO && LINE (INFO (where_tag)) != NO_LINE) {
314 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", line %d", LINE_NUMBER (where_tag)) >= 0);
315 WRITE (f, A68G (output_line));
316 }
317 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", offset %d", OFFSET (s)) >= 0);
318 WRITE (f, A68G (output_line));
319 }
320 }
321 }
322
323 //! @brief xref_decs.
324
325 void xref_decs (FILE_T f, TABLE_T * t)
326 {
327 if (INDICANTS (t) != NO_TAG) {
328 xref_tags (f, INDICANTS (t), INDICANT);
329 }
330 if (OPERATORS (t) != NO_TAG) {
331 xref_tags (f, OPERATORS (t), OP_SYMBOL);
332 }
333 if (PRIO (t) != NO_TAG) {
334 xref_tags (f, PRIO (t), PRIO_SYMBOL);
335 }
336 if (IDENTIFIERS (t) != NO_TAG) {
337 xref_tags (f, IDENTIFIERS (t), IDENTIFIER);
338 }
339 if (LABELS (t) != NO_TAG) {
340 xref_tags (f, LABELS (t), LABEL);
341 }
342 if (ANONYMOUS (t) != NO_TAG) {
343 xref_tags (f, ANONYMOUS (t), ANONYMOUS);
344 }
345 }
346
347 //! @brief xref1_moid.
348
349 void xref1_moid (FILE_T f, MOID_T * p)
350 {
351 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\n #%d ", NUMBER (p)) >= 0);
352 WRITE (f, A68G (output_line));
353 print_mode_flat (f, p);
354 }
355
356 //! @brief moid_listing.
357
358 void moid_listing (FILE_T f, MOID_T * m)
359 {
360 if (m == NO_MOID) {
361 return;
362 }
363 for (; m != NO_MOID; FORWARD (m)) {
364 xref1_moid (f, m);
365 }
366 WRITE (f, "\n");
367 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\n MODE STRING #%d ", NUMBER (M_STRING)) >= 0);
368 WRITE (f, A68G (output_line));
369 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\n MODE COMPLEX #%d ", NUMBER (M_COMPLEX)) >= 0);
370 WRITE (f, A68G (output_line));
371 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\n MODE SEMA #%d ", NUMBER (M_SEMA)) >= 0);
372 WRITE (f, A68G (output_line));
373 }
374
375 //! @brief cross_reference.
376
377 void cross_reference (FILE_T f, NODE_T * p, LINE_T * l)
378 {
379 if (p != NO_NODE && CROSS_REFERENCE_SAFE (&A68G_JOB)) {
380 for (; p != NO_NODE; FORWARD (p)) {
381 if (is_new_lexical_level (p) && l == LINE (INFO (p))) {
382 TABLE_T *c = TABLE (SUB (p));
383 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\n\n[level %d", LEVEL (c)) >= 0);
384 WRITE (f, A68G (output_line));
385 if (PREVIOUS (c) == A68G_STANDENV) {
386 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", in standard environ") >= 0);
387 } else {
388 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", in level %d", LEVEL (PREVIOUS (c))) >= 0);
389 }
390 WRITE (f, A68G (output_line));
391 #if (A68G_LEVEL >= 3)
392 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", %llu increment]", AP_INCREMENT (c)) >= 0);
393 #else
394 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", %u increment]", AP_INCREMENT (c)) >= 0);
395 #endif
396 WRITE (f, A68G (output_line));
397 if (c != NO_TABLE) {
398 xref_decs (f, c);
399 }
400 WRITE (f, "\n");
401 }
402 cross_reference (f, SUB (p), l);
403 }
404 }
405 }
406
407 //! @brief Tree listing for source line.
408
409 BOOL_T empty_leaf (NODE_T * p)
410 {
411 #define TEST_LEAVE(n)\
412 if (IS (p, (n)) && NEXT (p) == NO_NODE && PREVIOUS (p) == NO_NODE) {\
413 return A68G_TRUE;\
414 }
415 TEST_LEAVE (ENCLOSED_CLAUSE);
416 TEST_LEAVE (UNIT);
417 TEST_LEAVE (TERTIARY);
418 TEST_LEAVE (SECONDARY);
419 TEST_LEAVE (PRIMARY);
420 TEST_LEAVE (DENOTATION);
421 return A68G_FALSE;
422 #undef TEST_LEAVE
423 }
424
425 //! @brief Tree listing for source line.
426
427 void tree_listing (FILE_T f, NODE_T * q, int x, LINE_T * l, int *ld, BOOL_T comment)
428 {
429 for (; q != NO_NODE; FORWARD (q)) {
430 NODE_T *p = q;
431 int dist;
432 if (((STATUS_TEST (p, TREE_MASK)) || comment) && l == LINE (INFO (p))) {
433 if (*ld < 0) {
434 *ld = x;
435 }
436 // Indent.
437 if (comment && empty_leaf (p)) {
438 ;
439 } else {
440 if (comment) {
441 WRITE (f, "\n// ");
442 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%06d ", NUMBER (p)) >= 0);
443 WRITE (f, A68G (output_line));
444 } else {
445 WRITE (f, "\n ");
446 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%02d %06d p%02d ", x, NUMBER (p), PROCEDURE_LEVEL (INFO (p))) >= 0);
447 WRITE (f, A68G (output_line));
448 if (TABLE (p) != NO_TABLE && PREVIOUS (TABLE (p)) != NO_TABLE) {
449 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%02d-%02d-%02d ", (TABLE (p) != NO_TABLE ? LEX_LEVEL (p) : 0), (TABLE (p) != NO_TABLE ? LEVEL (PREVIOUS (TABLE (p))) : 0), (NON_LOCAL (p) != NO_TABLE ? LEVEL (NON_LOCAL (p)) : 0)
450 ) >= 0);
451 } else {
452 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%02d- -%02d", (TABLE (p) != NO_TABLE ? LEX_LEVEL (p) : 0), (NON_LOCAL (p) != NO_TABLE ? LEVEL (NON_LOCAL (p)) : 0)
453 ) >= 0);
454 }
455 WRITE (f, A68G (output_line));
456 if (MOID (q) != NO_MOID) {
457 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "#%04d ", NUMBER (MOID (p))) >= 0);
458 } else {
459 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " ") >= 0);
460 }
461 WRITE (f, A68G (output_line));
462 }
463 for (int k = 0; k < (x - *ld); k++) {
464 WRITE (f, A68G (marker)[k]);
465 }
466 if (MOID (p) != NO_MOID) {
467 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s ", moid_to_string (MOID (p), MOID_WIDTH, NO_NODE)) >= 0);
468 WRITE (f, A68G (output_line));
469 }
470 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "%s", non_terminal_string (A68G (edit_line), ATTRIBUTE (p))) >= 0);
471 WRITE (f, A68G (output_line));
472 if (SUB (p) == NO_NODE) {
473 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, " \"%s\"", NSYMBOL (p)) >= 0);
474 WRITE (f, A68G (output_line));
475 }
476 if (!comment) {
477 if (TAX (p) != NO_TAG) {
478 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", tag %06u", (unt) NUMBER (TAX (p))) >= 0);
479 WRITE (f, A68G (output_line));
480 if (MOID (TAX (p)) != NO_MOID) {
481 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", mode %06u", (unt) NUMBER (MOID (TAX (p)))) >= 0);
482 WRITE (f, A68G (output_line));
483 }
484 }
485 if (GINFO (p) != NO_GINFO && propagator_name ((PROP_PROC *) UNIT (&GPROP (p))) != NO_TEXT) {
486 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", %s", propagator_name ((PROP_PROC *) UNIT (&GPROP (p)))) >= 0);
487 WRITE (f, A68G (output_line));
488 }
489 if (GINFO (p) != NO_GINFO && COMPILE_NAME (GINFO (p)) != NO_TEXT) {
490 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", %s", COMPILE_NAME (GINFO (p))) >= 0);
491 WRITE (f, A68G (output_line));
492 }
493 if (GINFO (p) != NO_GINFO && COMPILE_NODE (GINFO (p)) > 0) {
494 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", %6d", COMPILE_NODE (GINFO (p))) >= 0);
495 WRITE (f, A68G (output_line));
496 }
497 }
498 }
499 dist = x - (*ld);
500 if (dist >= 0 && dist < BUFFER_SIZE) {
501 A68G (marker)[dist] = (NEXT (p) != NO_NODE && l == LINE (INFO (NEXT (p))) ? "|" : " ");
502 }
503 }
504 tree_listing (f, SUB (p), x + 1, l, ld, comment);
505 dist = x - (*ld);
506 if (dist >= 0 && dist < BUFFER_SIZE) {
507 A68G (marker)[dist] = " ";
508 }
509 }
510 }
511
512 //! @brief leaves_to_print.
513
514 int leaves_to_print (NODE_T * p, LINE_T * l)
515 {
516 int z = 0;
517 for (; p != NO_NODE && z == 0; FORWARD (p)) {
518 if (l == LINE (INFO (p)) && ((STATUS_TEST (p, TREE_MASK)))) {
519 z++;
520 } else {
521 z += leaves_to_print (SUB (p), l);
522 }
523 }
524 return z;
525 }
526
527 //! @brief list_source_line.
528
529 void list_source_line (FILE_T f, LINE_T * line, BOOL_T tree)
530 {
531 INT_T k = (INT_T) strlen (STRING (line)) - 1;
532 if (NUMBER (line) <= 0) {
533 // Mask the prelude and postlude.
534 return;
535 }
536 if ((STRING (line))[k] == NEWLINE_CHAR) {
537 (STRING (line))[k] = NULL_CHAR;
538 }
539 // Print source line.
540 write_source_line (f, line, NO_NODE, A68G_ALL_DIAGNOSTICS);
541 // Cross reference for lexical levels starting at this line.
542 if (OPTION_CROSS_REFERENCE (&A68G_JOB)) {
543 cross_reference (f, TOP_NODE (&A68G_JOB), line);
544 }
545 // Syntax tree listing connected with this line.
546 if (tree && OPTION_TREE_LISTING (&A68G_JOB)) {
547 if (TREE_LISTING_SAFE (&A68G_JOB) && leaves_to_print (TOP_NODE (&A68G_JOB), line)) {
548 int ld = -1, k2;
549 WRITE (f, "\n\nSyntax tree");
550 for (k2 = 0; k2 < BUFFER_SIZE; k2++) {
551 A68G (marker)[k2] = " ";
552 }
553 tree_listing (f, TOP_NODE (&A68G_JOB), 1, line, &ld, A68G_FALSE);
554 WRITE (f, "\n");
555 }
556 }
557 }
558
559 //! @brief write_source_listing.
560
561 void write_source_listing (void)
562 {
563 FILE_T f = FILE_LISTING_FD (&A68G_JOB);
564 int listed = 0;
565 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
566 WRITE (FILE_LISTING_FD (&A68G_JOB), "\nSource listing");
567 WRITE (FILE_LISTING_FD (&A68G_JOB), "\n------ -------");
568 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
569 if (FILE_LISTING_OPENED (&A68G_JOB) == 0) {
570 diagnostic (A68G_ERROR, NO_NODE, ERROR_CANNOT_WRITE_LISTING, NO_LINE, 0);
571 return;
572 }
573 for (LINE_T *line = TOP_LINE (&A68G_JOB); line != NO_LINE; FORWARD (line)) {
574 if (NUMBER (line) > 0 && LIST (line)) {
575 listed++;
576 }
577 list_source_line (f, line, A68G_FALSE);
578 }
579 // Warn if there was no source at all.
580 if (listed == 0) {
581 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\n No lines to list") >= 0);
582 WRITE (f, A68G (output_line));
583 }
584 }
585
586 //! @brief write_tree_listing.
587
588 void write_tree_listing (void)
589 {
590 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
591 WRITE (FILE_LISTING_FD (&A68G_JOB), "\nSyntax tree listing");
592 WRITE (FILE_LISTING_FD (&A68G_JOB), "\n------ ---- -------");
593 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
594 if (FILE_LISTING_OPENED (&A68G_JOB) == 0) {
595 diagnostic (A68G_ERROR, NO_NODE, ERROR_CANNOT_WRITE_LISTING, NO_LINE, 0);
596 return;
597 }
598 FILE_T f = FILE_LISTING_FD (&A68G_JOB);
599 int listed = 0;
600 for (LINE_T *line = TOP_LINE (&A68G_JOB); line != NO_LINE; FORWARD (line)) {
601 if (NUMBER (line) > 0 && LIST (line)) {
602 listed++;
603 }
604 list_source_line (f, line, A68G_TRUE);
605 }
606 // Warn if there was no source at all.
607 if (listed == 0) {
608 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\n No lines to list") >= 0);
609 WRITE (f, A68G (output_line));
610 }
611 }
612
613 //! @brief write_object_listing.
614
615 void write_object_listing (void)
616 {
617 if (OPTION_OBJECT_LISTING (&A68G_JOB)) {
618 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
619 WRITE (FILE_LISTING_FD (&A68G_JOB), "\nObject listing");
620 WRITE (FILE_LISTING_FD (&A68G_JOB), "\n------ -------");
621 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
622 plugin_driver_emit (FILE_LISTING_FD (&A68G_JOB));
623 }
624 }
625
626 //! @brief write_listing.
627
628 void write_listing (void)
629 {
630 FILE_T f = FILE_LISTING_FD (&A68G_JOB);
631 if (OPTION_MOID_LISTING (&A68G_JOB) && TOP_MOID (&A68G_JOB) != NO_MOID) {
632 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
633 WRITE (FILE_LISTING_FD (&A68G_JOB), "\nMode listing");
634 WRITE (FILE_LISTING_FD (&A68G_JOB), "\n---- -------");
635 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
636 moid_listing (f, TOP_MOID (&A68G_JOB));
637 }
638 if (OPTION_STANDARD_PRELUDE_LISTING (&A68G_JOB) && A68G_STANDENV != NO_TABLE) {
639 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
640 WRITE (FILE_LISTING_FD (&A68G_JOB), "\nStandard prelude listing");
641 WRITE (FILE_LISTING_FD (&A68G_JOB), "\n-------- ------- -------");
642 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
643 xref_decs (f, A68G_STANDENV);
644 }
645 if (TOP_REFINEMENT (&A68G_JOB) != NO_REFINEMENT) {
646 REFINEMENT_T *x = TOP_REFINEMENT (&A68G_JOB);
647 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
648 WRITE (FILE_LISTING_FD (&A68G_JOB), "\nRefinement listing");
649 WRITE (FILE_LISTING_FD (&A68G_JOB), "\n---------- -------");
650 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
651 while (x != NO_REFINEMENT) {
652 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\n \"%s\"", NAME (x)) >= 0);
653 WRITE (f, A68G (output_line));
654 if (LINE_DEFINED (x) != NO_LINE) {
655 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", defined in line %d", NUMBER (LINE_DEFINED (x))) >= 0);
656 WRITE (f, A68G (output_line));
657 }
658 if (LINE_APPLIED (x) != NO_LINE) {
659 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", applied in line %d", NUMBER (LINE_APPLIED (x))) >= 0);
660 WRITE (f, A68G (output_line));
661 }
662 switch (APPLICATIONS (x)) {
663 case 0: {
664 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", not applied") >= 0);
665 WRITE (f, A68G (output_line));
666 break;
667 }
668 case 1: {
669 break;
670 }
671 default: {
672 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", applied more than once") >= 0);
673 WRITE (f, A68G (output_line));
674 break;
675 }
676 }
677 FORWARD (x);
678 }
679 }
680 if (OPTION_LIST (&A68G_JOB) != NO_OPTION_LIST) {
681 int k = 1;
682 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
683 WRITE (FILE_LISTING_FD (&A68G_JOB), "\nPragmat listing");
684 WRITE (FILE_LISTING_FD (&A68G_JOB), "\n------- -------");
685 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
686 for (OPTION_LIST_T *l = OPTION_LIST (&A68G_JOB); l != NO_OPTION_LIST; FORWARD (l)) {
687 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\n%d: %s", k++, STR (l)) >= 0);
688 WRITE (f, A68G (output_line));
689 }
690 }
691 WRITE (FILE_LISTING_FD (&A68G_JOB), NEWLINE_STRING);
692 }
693
694 //! @brief write_listing_header.
695
696 void write_listing_header (void)
697 {
698 FILE_T f = FILE_LISTING_FD (&A68G_JOB);
699 state_version (FILE_LISTING_FD (&A68G_JOB));
700 WRITE (FILE_LISTING_FD (&A68G_JOB), "\nFile \"");
701 WRITE (FILE_LISTING_FD (&A68G_JOB), FILE_SOURCE_NAME (&A68G_JOB));
702 WRITE (FILE_LISTING_FD (&A68G_JOB), "\"");
703 if (OPTION_STATISTICS_LISTING (&A68G_JOB)) {
704 if (ERROR_COUNT (&A68G_JOB) + WARNING_COUNT (&A68G_JOB) > 0) {
705 ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, "\nDiagnostics: %d error(s), %d warning(s)", ERROR_COUNT (&A68G_JOB), WARNING_COUNT (&A68G_JOB)) >= 0);
706 WRITE (f, A68G (output_line));
707 for (LINE_T *z = TOP_LINE (&A68G_JOB); z != NO_LINE; FORWARD (z)) {
708 if (DIAGNOSTICS (z) != NO_DIAGNOSTIC) {
709 write_source_line (f, z, NO_NODE, A68G_TRUE);
710 }
711 }
712 }
713 }
714 }
|
© 2002-2025 J.M. van der Veer (jmvdveer@xs4all.nl)
|
