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 ((const PROP_PROC *) UNIT (&GPROP (p))) != NO_TEXT) {
 486              ASSERT (a68g_bufprt (A68G (output_line), SNPRINTF_SIZE, ", %s", propagator_name ((const 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)