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