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-2024 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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, "%s", NSYMBOL (NODE (z))) >= 0);
  81      WRITE (f, A68 (output_line));
  82    } else if (IS_REF (z)) {
  83      ASSERT (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, " name #%d", NUMBER (NAME (m))) >= 0);
 212        WRITE (f, A68 (output_line));
 213      }
 214      if (USE (m)) {
 215        ASSERT (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, " used") >= 0);
 216        WRITE (f, A68 (output_line));
 217      }
 218      if (DERIVATE (m)) {
 219        ASSERT (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, " derivate") >= 0);
 220        WRITE (f, A68 (output_line));
 221      }
 222      if (SIZE (m) > 0) {
 223        ASSERT (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, " %s", NSYMBOL (NODE (s))) >= 0);
 246            WRITE (f, A68 (output_line));
 247            break;
 248          }
 249        case INDICANT: {
 250            ASSERT (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, "routine text ") >= 0);
 275                break;
 276              }
 277            case FORMAT_TEXT: {
 278                ASSERT (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, "format text ") >= 0);
 279                break;
 280              }
 281            case FORMAT_IDENTIFIER: {
 282                ASSERT (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, "format item ") >= 0);
 283                break;
 284              }
 285            case COLLATERAL_CLAUSE: {
 286                ASSERT (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, "display ") >= 0);
 287                break;
 288              }
 289            case GENERATOR: {
 290                ASSERT (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, "\n     MODE STRING  #%d ", NUMBER (M_STRING)) >= 0);
 362    WRITE (f, A68 (output_line));
 363    ASSERT (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, "\n     MODE COMPLEX #%d ", NUMBER (M_COMPLEX)) >= 0);
 364    WRITE (f, A68 (output_line));
 365    ASSERT (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, ", in standard environ") >= 0);
 381          } else {
 382            ASSERT (a68_bufprt (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 (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, ", %llu increment]", AP_INCREMENT (c)) >= 0);
 387  #else
 388          ASSERT (a68_bufprt (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 (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, "%06d ", NUMBER (p)) >= 0);
 437            WRITE (f, A68 (output_line));
 438          } else {
 439            WRITE (f, "\n     ");
 440            ASSERT (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, "#%04d ", NUMBER (MOID (p))) >= 0);
 452            } else {
 453              ASSERT (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 ((const PROP_PROC *) UNIT (&GPROP (p))) != NO_TEXT) {
 480              ASSERT (a68_bufprt (A68 (output_line), SNPRINTF_SIZE, ", %s", propagator_name ((const PROP_PROC *) 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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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 (a68_bufprt (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  }
     


© 2002-2024 J.M. van der Veer (jmvdveer@xs4all.nl)