plugin-inline.c

     
   1  //! @file plugin-inline.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  //! Plugin compiler inlining routines.
  25  
  26  #include "a68g.h"
  27  #include "a68g-prelude.h"
  28  #include "a68g-genie.h"
  29  #include "a68g-listing.h"
  30  #include "a68g-mp.h"
  31  #include "a68g-optimiser.h"
  32  #include "a68g-plugin.h"
  33  #include "a68g-parser.h"
  34  #include "a68g-transput.h"
  35  
  36  //! @brief Code an A68 mode.
  37  
  38  char *inline_mode (MOID_T * m)
  39  {
  40    if (m == M_INT) {
  41      return "A68_INT";
  42    } else if (m == M_REAL) {
  43      return "A68_REAL";
  44    } else if (m == M_BOOL) {
  45      return "A68_BOOL";
  46    } else if (m == M_CHAR) {
  47      return "A68_CHAR";
  48    } else if (m == M_BITS) {
  49      return "A68_BITS";
  50    } else if (m == M_COMPLEX) {
  51      return "A68_COMPLEX";
  52    } else if (IS (m, REF_SYMBOL)) {
  53      return "A68_REF";
  54    } else if (IS (m, ROW_SYMBOL)) {
  55      return "A68_ROW";
  56    } else if (IS (m, PROC_SYMBOL)) {
  57      return "A68_PROCEDURE";
  58    } else if (IS (m, STRUCT_SYMBOL)) {
  59      return "A68_STRUCT";
  60    } else {
  61      return "A68_ERROR";
  62    }
  63  }
  64  
  65  //! @brief Compile inline arguments.
  66  
  67  void inline_arguments (NODE_T * p, FILE_T out, int phase, int *size)
  68  {
  69    if (p == NO_NODE) {
  70      return;
  71    } else if (IS (p, UNIT) && phase == L_PUSH) {
  72      indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "EXECUTE_UNIT_TRACE (_NODE_ (%d));\n", NUMBER (p)));
  73      inline_arguments (NEXT (p), out, L_PUSH, size);
  74    } else if (IS (p, UNIT)) {
  75      char arg[NAME_SIZE];
  76      (void) make_name (arg, ARG, "", NUMBER (p));
  77      if (phase == L_DECLARE) {
  78        (void) add_declaration (&A68_OPT (root_idf), inline_mode (MOID (p)), 1, arg);
  79        inline_unit (p, out, L_DECLARE);
  80      } else if (phase == L_INITIALISE) {
  81        inline_unit (p, out, L_EXECUTE);
  82      } else if (phase == L_EXECUTE) {
  83        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = (%s *) FRAME_OBJECT (%d);\n", arg, inline_mode (MOID (p)), *size));
  84        (*size) += SIZE (MOID (p));
  85      } else if (phase == L_YIELD && primitive_mode (MOID (p))) {
  86        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "_STATUS_ (%s) = INIT_MASK;\n", arg));
  87        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "_VALUE_ (%s) = ", arg));
  88        inline_unit (p, out, L_YIELD);
  89        undent (out, ";\n");
  90      } else if (phase == L_YIELD && basic_mode (MOID (p))) {
  91        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "MOVE ((void *) %s, (void *) ", arg));
  92        inline_unit (p, out, L_YIELD);
  93        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ", %d);\n", SIZE (MOID (p))));
  94      }
  95    } else {
  96      inline_arguments (SUB (p), out, phase, size);
  97      inline_arguments (NEXT (p), out, phase, size);
  98    }
  99  }
 100  
 101  //! @brief Code denotation.
 102  
 103  void inline_denotation (NODE_T * p, FILE_T out, int phase)
 104  {
 105    if (phase == L_YIELD) {
 106      if (MOID (p) == M_INT) {
 107        A68_INT z;
 108        NODE_T *s = IS (SUB (p), SHORTETY) ? NEXT_SUB (p) : SUB (p);
 109        char *den = NSYMBOL (s);
 110        if (genie_string_to_value_internal (p, M_INT, den, (BYTE_T *) & z) == A68_FALSE) {
 111          diagnostic (A68_SYNTAX_ERROR, p, ERROR_IN_DENOTATION, M_INT);
 112        }
 113        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, A68_LD, VALUE (&z)));
 114      } else if (MOID (p) == M_REAL) {
 115        A68_REAL z;
 116        NODE_T *s = IS (SUB (p), SHORTETY) ? NEXT_SUB (p) : SUB (p);
 117        char *den = NSYMBOL (s);
 118        if (genie_string_to_value_internal (p, M_REAL, den, (BYTE_T *) & z) == A68_FALSE) {
 119          diagnostic (A68_SYNTAX_ERROR, p, ERROR_IN_DENOTATION, M_REAL);
 120        }
 121        if (strchr (den, '.') == NO_TEXT && strchr (den, 'e') == NO_TEXT && strchr (den, 'E') == NO_TEXT) {
 122          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "(REAL_T) %s", den));
 123        } else {
 124          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s", den));
 125        }
 126      } else if (MOID (p) == M_BOOL) {
 127        undent (out, "(BOOL_T) A68_");
 128        undent (out, NSYMBOL (p));
 129      } else if (MOID (p) == M_CHAR) {
 130        if (NSYMBOL (p)[0] == '\'') {
 131          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "'\\''"));
 132        } else if (NSYMBOL (p)[0] == NULL_CHAR) {
 133          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "NULL_CHAR"));
 134        } else if (NSYMBOL (p)[0] == '\\') {
 135          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "'\\\\'"));
 136        } else {
 137          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "'%c'", (NSYMBOL (p))[0]));
 138        }
 139      } else if (MOID (p) == M_BITS) {
 140        A68_BITS z;
 141        NODE_T *s = IS (SUB (p), SHORTETY) ? NEXT_SUB (p) : SUB (p);
 142        if (genie_string_to_value_internal (p, M_BITS, NSYMBOL (s), (BYTE_T *) & z) == A68_FALSE) {
 143          diagnostic (A68_SYNTAX_ERROR, p, ERROR_IN_DENOTATION, M_BITS);
 144        }
 145        ASSERT (snprintf (A68 (edit_line), SNPRINTF_SIZE, "(UNSIGNED_T) 0x" A68_LX, VALUE (&z)) >= 0);
 146        undent (out, A68 (edit_line));
 147      }
 148    }
 149  }
 150  
 151  //! @brief Code widening.
 152  
 153  void inline_widening (NODE_T * p, FILE_T out, int phase)
 154  {
 155    if (WIDEN_TO (p, INT, REAL)) {
 156      if (phase == L_DECLARE) {
 157        inline_unit (SUB (p), out, L_DECLARE);
 158      } else if (phase == L_EXECUTE) {
 159        inline_unit (SUB (p), out, L_EXECUTE);
 160      } else if (phase == L_YIELD) {
 161        undent (out, "(REAL_T) (");
 162        inline_unit (SUB (p), out, L_YIELD);
 163        undent (out, ")");
 164      }
 165    } else if (WIDEN_TO (p, REAL, COMPLEX)) {
 166      char acc[NAME_SIZE];
 167      (void) make_name (acc, TMP, "", NUMBER (p));
 168      if (phase == L_DECLARE) {
 169        (void) add_declaration (&A68_OPT (root_idf), inline_mode (M_COMPLEX), 0, acc);
 170        inline_unit (SUB (p), out, L_DECLARE);
 171      } else if (phase == L_EXECUTE) {
 172        inline_unit (SUB (p), out, L_EXECUTE);
 173        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "STATUS_RE (%s) = INIT_MASK;\n", acc));
 174        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "STATUS_IM (%s) = INIT_MASK;\n", acc));
 175        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "RE (%s) = (REAL_T) (", acc));
 176        inline_unit (SUB (p), out, L_YIELD);
 177        undent (out, ");\n");
 178        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "IM (%s) = 0.0;\n", acc));
 179      } else if (phase == L_YIELD) {
 180        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "(A68_REAL *) %s", acc));
 181      }
 182    }
 183  }
 184  
 185  //! @brief Code dereferencing of identifier.
 186  
 187  void inline_dereference_identifier (NODE_T * p, FILE_T out, int phase)
 188  {
 189    NODE_T *q = stems_from (SUB (p), IDENTIFIER);
 190    ABEND (q == NO_NODE, ERROR_INTERNAL_CONSISTENCY, __func__);
 191    if (phase == L_DECLARE) {
 192      if (signed_in (BOOK_DEREF, L_DECLARE, NSYMBOL (q)) != NO_BOOK) {
 193        return;
 194      } else {
 195        char idf[NAME_SIZE];
 196        (void) make_name (idf, NSYMBOL (q), "", NUMBER (p));
 197        (void) add_declaration (&A68_OPT (root_idf), inline_mode (MOID (p)), 1, idf);
 198        sign_in (BOOK_DEREF, L_DECLARE, NSYMBOL (p), NULL, NUMBER (p));
 199        inline_unit (SUB (p), out, L_DECLARE);
 200      }
 201    } else if (phase == L_EXECUTE) {
 202      if (signed_in (BOOK_DEREF, L_EXECUTE, NSYMBOL (q)) != NO_BOOK) {
 203        return;
 204      } else {
 205        char idf[NAME_SIZE];
 206        (void) make_name (idf, NSYMBOL (q), "", NUMBER (p));
 207        inline_unit (SUB (p), out, L_EXECUTE);
 208        if (BODY (TAX (q)) != NO_TAG) {
 209          indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = (%s *) LOCAL_ADDRESS (", idf, inline_mode (MOID (p))));
 210          sign_in (BOOK_DEREF, L_EXECUTE, NSYMBOL (p), NULL, NUMBER (p));
 211          inline_unit (SUB (p), out, L_YIELD);
 212          undent (out, ");\n");
 213        } else {
 214          indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = DEREF (%s, ", idf, inline_mode (MOID (p))));
 215          sign_in (BOOK_DEREF, L_EXECUTE, NSYMBOL (p), NULL, NUMBER (p));
 216          inline_unit (SUB (p), out, L_YIELD);
 217          undent (out, ");\n");
 218        }
 219        gen_check_init (p, out, idf);
 220      }
 221    } else if (phase == L_YIELD) {
 222      char idf[NAME_SIZE];
 223      if (signed_in (BOOK_DEREF, L_EXECUTE, NSYMBOL (q)) != NO_BOOK) {
 224        (void) make_name (idf, NSYMBOL (q), "", NUMBER (signed_in (BOOK_DEREF, L_DECLARE, NSYMBOL (q))));
 225      } else {
 226        (void) make_name (idf, NSYMBOL (q), "", NUMBER (p));
 227      }
 228      if (primitive_mode (MOID (p))) {
 229        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "_VALUE_ (%s)", idf));
 230      } else if (MOID (p) == M_COMPLEX) {
 231        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "(A68_REAL *) (%s)", idf));
 232      } else if (basic_mode (MOID (p))) {
 233        undent (out, idf);
 234      }
 235    }
 236  }
 237  
 238  //! @brief Code identifier.
 239  
 240  void inline_identifier (NODE_T * p, FILE_T out, int phase)
 241  {
 242  // Possible constant folding.
 243    NODE_T *def = NODE (TAX (p));
 244    if (primitive_mode (MOID (p)) && def != NO_NODE && NEXT (def) != NO_NODE && IS (NEXT (def), EQUALS_SYMBOL)) {
 245      NODE_T *src = stems_from (NEXT_NEXT (def), DENOTATION);
 246      if (src != NO_NODE) {
 247        inline_denotation (src, out, phase);
 248        return;
 249      }
 250    }
 251  // No folding - consider identifier.
 252    if (phase == L_DECLARE) {
 253      if (signed_in (BOOK_DECL, L_DECLARE, NSYMBOL (p)) != NO_BOOK) {
 254        return;
 255      } else if (A68_STANDENV_PROC (TAX (p))) {
 256        return;
 257      } else {
 258        char idf[NAME_SIZE];
 259        (void) make_name (idf, NSYMBOL (p), "", NUMBER (p));
 260        (void) add_declaration (&A68_OPT (root_idf), inline_mode (MOID (p)), 1, idf);
 261        sign_in (BOOK_DECL, L_DECLARE, NSYMBOL (p), NULL, NUMBER (p));
 262      }
 263    } else if (phase == L_EXECUTE) {
 264      if (signed_in (BOOK_DECL, L_EXECUTE, NSYMBOL (p)) != NO_BOOK) {
 265        return;
 266      } else if (A68_STANDENV_PROC (TAX (p))) {
 267        return;
 268      } else {
 269        char idf[NAME_SIZE];
 270        (void) make_name (idf, NSYMBOL (p), "", NUMBER (p));
 271        get_stack (p, out, idf, inline_mode (MOID (p)));
 272        sign_in (BOOK_DECL, L_EXECUTE, NSYMBOL (p), NULL, NUMBER (p));
 273        gen_check_init (p, out, idf);
 274      }
 275    } else if (phase == L_YIELD) {
 276      if (A68_STANDENV_PROC (TAX (p))) {
 277        int k;
 278        for (k = 0; PROCEDURE (&constants[k]) != NO_GPROC; k++) {
 279          if (PROCEDURE (TAX (p)) == PROCEDURE (&constants[k])) {
 280            undent (out, CODE (&constants[k]));
 281            return;
 282          }
 283        }
 284      } else {
 285        char idf[NAME_SIZE];
 286        BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE, NSYMBOL (p));
 287        if (entry != NO_BOOK) {
 288          (void) make_name (idf, NSYMBOL (p), "", NUMBER (entry));
 289        } else {
 290          (void) make_name (idf, NSYMBOL (p), "", NUMBER (p));
 291        }
 292        if (primitive_mode (MOID (p))) {
 293          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "_VALUE_ (%s)", idf));
 294        } else if (MOID (p) == M_COMPLEX) {
 295          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "(A68_REAL *) (%s)", idf));
 296        } else if (basic_mode (MOID (p))) {
 297          undent (out, idf);
 298        }
 299      }
 300    }
 301  }
 302  
 303  //! @brief Code indexer.
 304  
 305  void inline_indexer (NODE_T * p, FILE_T out, int phase, INT_T * k, char *tup)
 306  {
 307    if (p == NO_NODE) {
 308      return;
 309    } else if (IS (p, UNIT)) {
 310      if (phase != L_YIELD) {
 311        inline_unit (p, out, phase);
 312      } else {
 313        if ((*k) == 0) {
 314          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "(SPAN (&%s[" A68_LD "]) * (", tup, (*k)));
 315        } else {
 316          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, " + (SPAN (&%s[" A68_LD "]) * (", tup, (*k)));
 317        }
 318        inline_unit (p, out, L_YIELD);
 319        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ") - SHIFT (&%s[" A68_LD "]))", tup, (*k)));
 320      }
 321      (*k)++;
 322    } else {
 323      inline_indexer (SUB (p), out, phase, k, tup);
 324      inline_indexer (NEXT (p), out, phase, k, tup);
 325    }
 326  }
 327  
 328  //! @brief Code dereferencing of slice.
 329  
 330  void inline_dereference_slice (NODE_T * p, FILE_T out, int phase)
 331  {
 332    NODE_T *prim = SUB (p);
 333    NODE_T *indx = NEXT (prim);
 334    MOID_T *row_mode = DEFLEX (MOID (prim));
 335    MOID_T *mode = SUB_SUB (row_mode);
 336    char *symbol = NSYMBOL (SUB (prim));
 337    char drf[NAME_SIZE], idf[NAME_SIZE], arr[NAME_SIZE], tup[NAME_SIZE], elm[NAME_SIZE];
 338    INT_T k;
 339    if (phase == L_DECLARE) {
 340      BOOK_T *entry = signed_in (BOOK_DECL, L_DECLARE, symbol);
 341      if (entry == NO_BOOK) {
 342        (void) make_name (idf, symbol, "", NUMBER (prim));
 343        (void) make_name (arr, ARR, "", NUMBER (prim));
 344        (void) make_name (tup, TUP, "", NUMBER (prim));
 345        (void) make_name (elm, ELM, "", NUMBER (prim));
 346        (void) make_name (drf, DRF, "", NUMBER (prim));
 347        (void) add_declaration (&A68_OPT (root_idf), "A68_REF", 1, idf);
 348        (void) add_declaration (&A68_OPT (root_idf), "A68_REF", 0, elm);
 349        (void) add_declaration (&A68_OPT (root_idf), "A68_ARRAY", 1, arr);
 350        (void) add_declaration (&A68_OPT (root_idf), "A68_TUPLE", 1, tup);
 351        (void) add_declaration (&A68_OPT (root_idf), inline_mode (mode), 1, drf);
 352        sign_in (BOOK_DECL, L_DECLARE, symbol, (void *) indx, NUMBER (prim));
 353      } else if (same_tree (indx, (NODE_T *) (INFO (entry))) == A68_FALSE) {
 354        (void) make_name (elm, ELM, "", NUMBER (prim));
 355        (void) make_name (drf, DRF, "", NUMBER (prim));
 356        (void) add_declaration (&A68_OPT (root_idf), "A68_REF", 0, elm);
 357        (void) add_declaration (&A68_OPT (root_idf), inline_mode (mode), 1, drf);
 358      }
 359      k = 0;
 360      inline_indexer (indx, out, L_DECLARE, &k, NO_TEXT);
 361    } else if (phase == L_EXECUTE) {
 362      BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE, symbol);
 363      NODE_T *pidf = stems_from (prim, IDENTIFIER);
 364      if (entry == NO_BOOK) {
 365        (void) make_name (idf, symbol, "", NUMBER (prim));
 366        (void) make_name (arr, ARR, "", NUMBER (prim));
 367        (void) make_name (tup, TUP, "", NUMBER (prim));
 368        (void) make_name (elm, ELM, "", NUMBER (prim));
 369        (void) make_name (drf, DRF, "", NUMBER (prim));
 370        get_stack (pidf, out, idf, "A68_REF");
 371        if (IS (row_mode, REF_SYMBOL) && IS (SUB (row_mode), ROW_SYMBOL)) {
 372          indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "GET_DESCRIPTOR (%s, %s, DEREF (A68_ROW, %s));\n", arr, tup, idf));
 373        } else {
 374          ABEND (A68_TRUE, ERROR_INTERNAL_CONSISTENCY, __func__);
 375        }
 376        sign_in (BOOK_DECL, L_EXECUTE, NSYMBOL (p), (void *) indx, NUMBER (prim));
 377      } else if (same_tree (indx, (NODE_T *) (INFO (entry))) == A68_FALSE) {
 378        (void) make_name (arr, ARR, "", NUMBER (entry));
 379        (void) make_name (tup, TUP, "", NUMBER (entry));
 380        (void) make_name (elm, ELM, "", NUMBER (prim));
 381        (void) make_name (drf, DRF, "", NUMBER (prim));
 382      } else {
 383        return;
 384      }
 385      indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = ARRAY (%s);\n", elm, arr));
 386      k = 0;
 387      inline_indexer (indx, out, L_EXECUTE, &k, NO_TEXT);
 388      indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "OFFSET (& %s) += ROW_ELEMENT (%s, ", elm, arr));
 389      k = 0;
 390      inline_indexer (indx, out, L_YIELD, &k, tup);
 391      undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ");\n"));
 392      indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = DEREF (%s, & %s);\n", drf, inline_mode (mode), elm));
 393    } else if (phase == L_YIELD) {
 394      BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE, symbol);
 395      if (entry != NO_BOOK && same_tree (indx, (NODE_T *) (INFO (entry))) == A68_TRUE) {
 396        (void) make_name (drf, DRF, "", NUMBER (entry));
 397      } else {
 398        (void) make_name (drf, DRF, "", NUMBER (prim));
 399      }
 400      if (primitive_mode (mode)) {
 401        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "_VALUE_ (%s)", drf));
 402      } else if (mode == M_COMPLEX) {
 403        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "(A68_REAL *) (%s)", drf));
 404      } else if (basic_mode (mode)) {
 405        undent (out, drf);
 406      } else {
 407        ABEND (A68_TRUE, ERROR_INTERNAL_CONSISTENCY, __func__);
 408      }
 409    }
 410  }
 411  
 412  //! @brief Code slice REF [] MODE -> REF MODE.
 413  
 414  void inline_slice_ref_to_ref (NODE_T * p, FILE_T out, int phase)
 415  {
 416    NODE_T *prim = SUB (p);
 417    NODE_T *indx = NEXT (prim);
 418    MOID_T *mode = SUB_MOID (p);
 419    MOID_T *row_mode = DEFLEX (MOID (prim));
 420    char *symbol = NSYMBOL (SUB (prim));
 421    char idf[NAME_SIZE], arr[NAME_SIZE], tup[NAME_SIZE], elm[NAME_SIZE], drf[NAME_SIZE];
 422    INT_T k;
 423    if (phase == L_DECLARE) {
 424      BOOK_T *entry = signed_in (BOOK_DECL, L_DECLARE, symbol);
 425      if (entry == NO_BOOK) {
 426        (void) make_name (idf, symbol, "", NUMBER (prim));
 427        (void) make_name (arr, ARR, "", NUMBER (prim));
 428        (void) make_name (tup, TUP, "", NUMBER (prim));
 429        (void) make_name (elm, ELM, "", NUMBER (prim));
 430        (void) make_name (drf, DRF, "", NUMBER (prim));
 431        (void) add_declaration (&A68_OPT (root_idf), "A68_REF", 1, idf);
 432        (void) add_declaration (&A68_OPT (root_idf), "A68_REF", 0, elm);
 433        (void) add_declaration (&A68_OPT (root_idf), "A68_ARRAY", 1, arr);
 434        (void) add_declaration (&A68_OPT (root_idf), "A68_TUPLE", 1, tup);
 435        (void) add_declaration (&A68_OPT (root_idf), inline_mode (mode), 1, drf);
 436        sign_in (BOOK_DECL, L_DECLARE, symbol, (void *) indx, NUMBER (prim));
 437      } else if (same_tree (indx, (NODE_T *) (INFO (entry))) == A68_FALSE) {
 438        (void) make_name (elm, ELM, "", NUMBER (prim));
 439        (void) make_name (drf, DRF, "", NUMBER (prim));
 440        (void) add_declaration (&A68_OPT (root_idf), "A68_REF", 0, elm);
 441        (void) add_declaration (&A68_OPT (root_idf), inline_mode (mode), 1, drf);
 442      }
 443      k = 0;
 444      inline_indexer (indx, out, L_DECLARE, &k, NO_TEXT);
 445    } else if (phase == L_EXECUTE) {
 446      BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE, symbol);
 447      if (entry == NO_BOOK) {
 448        NODE_T *pidf = stems_from (prim, IDENTIFIER);
 449        (void) make_name (idf, symbol, "", NUMBER (prim));
 450        (void) make_name (arr, ARR, "", NUMBER (prim));
 451        (void) make_name (tup, TUP, "", NUMBER (prim));
 452        (void) make_name (elm, ELM, "", NUMBER (prim));
 453        (void) make_name (drf, DRF, "", NUMBER (prim));
 454        get_stack (pidf, out, idf, "A68_REF");
 455        if (IS (row_mode, REF_SYMBOL) && IS (SUB (row_mode), ROW_SYMBOL)) {
 456          indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "GET_DESCRIPTOR (%s, %s, DEREF (A68_ROW, %s));\n", arr, tup, idf));
 457        } else {
 458          ABEND (A68_TRUE, ERROR_INTERNAL_CONSISTENCY, __func__);
 459        }
 460        sign_in (BOOK_DECL, L_EXECUTE, NSYMBOL (p), (void *) indx, NUMBER (prim));
 461      } else if (same_tree (indx, (NODE_T *) (INFO (entry))) == A68_FALSE) {
 462        (void) make_name (arr, ARR, "", NUMBER (entry));
 463        (void) make_name (tup, TUP, "", NUMBER (entry));
 464        (void) make_name (elm, ELM, "", NUMBER (prim));
 465        (void) make_name (drf, DRF, "", NUMBER (prim));
 466      } else {
 467        return;
 468      }
 469      indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = ARRAY (%s);\n", elm, arr));
 470      k = 0;
 471      inline_indexer (indx, out, L_EXECUTE, &k, NO_TEXT);
 472      indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "OFFSET (& %s) += ROW_ELEMENT (%s, ", elm, arr));
 473      k = 0;
 474      inline_indexer (indx, out, L_YIELD, &k, tup);
 475      undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ");\n"));
 476      indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = DEREF (%s, & %s);\n", drf, inline_mode (mode), elm));
 477    } else if (phase == L_YIELD) {
 478      BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE, symbol);
 479      if (entry != NO_BOOK && same_tree (indx, (NODE_T *) (INFO (entry))) == A68_TRUE) {
 480        (void) make_name (elm, ELM, "", NUMBER (entry));
 481      } else {
 482        (void) make_name (elm, ELM, "", NUMBER (prim));
 483      }
 484      undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "(&%s)", elm));
 485    }
 486  }
 487  
 488  //! @brief Code slice [] MODE -> MODE.
 489  
 490  void inline_slice (NODE_T * p, FILE_T out, int phase)
 491  {
 492    NODE_T *prim = SUB (p);
 493    NODE_T *indx = NEXT (prim);
 494    MOID_T *mode = MOID (p);
 495    MOID_T *row_mode = DEFLEX (MOID (prim));
 496    char *symbol = NSYMBOL (SUB (prim));
 497    char drf[NAME_SIZE], idf[NAME_SIZE], arr[NAME_SIZE], tup[NAME_SIZE], elm[NAME_SIZE];
 498    INT_T k;
 499    if (phase == L_DECLARE) {
 500      BOOK_T *entry = signed_in (BOOK_DECL, L_DECLARE, symbol);
 501      if (entry == NO_BOOK) {
 502        (void) make_name (idf, symbol, "", NUMBER (prim));
 503        (void) make_name (arr, ARR, "", NUMBER (prim));
 504        (void) make_name (tup, TUP, "", NUMBER (prim));
 505        (void) make_name (elm, ELM, "", NUMBER (prim));
 506        (void) make_name (drf, DRF, "", NUMBER (prim));
 507        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "A68_REF * %s, %s; %s * %s; A68_ARRAY * %s; A68_TUPLE * %s;\n", idf, elm, inline_mode (mode), drf, arr, tup));
 508        sign_in (BOOK_DECL, L_DECLARE, symbol, (void *) indx, NUMBER (prim));
 509      } else if (same_tree (indx, (NODE_T *) (INFO (entry))) == A68_FALSE) {
 510        (void) make_name (elm, ELM, "", NUMBER (prim));
 511        (void) make_name (drf, DRF, "", NUMBER (prim));
 512        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "A68_REF %s; %s * %s;\n", elm, inline_mode (mode), drf));
 513      }
 514      k = 0;
 515      inline_indexer (indx, out, L_DECLARE, &k, NO_TEXT);
 516    } else if (phase == L_EXECUTE) {
 517      BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE, symbol);
 518      if (entry == NO_BOOK) {
 519        NODE_T *pidf = stems_from (prim, IDENTIFIER);
 520        (void) make_name (idf, symbol, "", NUMBER (prim));
 521        (void) make_name (arr, ARR, "", NUMBER (prim));
 522        (void) make_name (tup, TUP, "", NUMBER (prim));
 523        (void) make_name (elm, ELM, "", NUMBER (prim));
 524        (void) make_name (drf, DRF, "", NUMBER (prim));
 525        get_stack (pidf, out, idf, "A68_REF");
 526        if (IS (row_mode, REF_SYMBOL)) {
 527          indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "GET_DESCRIPTOR (%s, %s, DEREF (A68_ROW, %s));\n", arr, tup, idf));
 528        } else {
 529          indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "GET_DESCRIPTOR (%s, %s, (A68_ROW *) %s);\n", arr, tup, idf));
 530        }
 531        sign_in (BOOK_DECL, L_EXECUTE, NSYMBOL (p), (void *) indx, NUMBER (prim));
 532      } else if (same_tree (indx, (NODE_T *) (INFO (entry))) == A68_FALSE) {
 533        (void) make_name (arr, ARR, "", NUMBER (entry));
 534        (void) make_name (tup, TUP, "", NUMBER (entry));
 535        (void) make_name (elm, ELM, "", NUMBER (prim));
 536        (void) make_name (drf, DRF, "", NUMBER (prim));
 537      } else {
 538        return;
 539      }
 540      indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = ARRAY (%s);\n", elm, arr));
 541      k = 0;
 542      inline_indexer (indx, out, L_EXECUTE, &k, NO_TEXT);
 543      indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "OFFSET (& %s) += ROW_ELEMENT (%s, ", elm, arr));
 544      k = 0;
 545      inline_indexer (indx, out, L_YIELD, &k, tup);
 546      undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ");\n"));
 547      indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = DEREF (%s, & %s);\n", drf, inline_mode (mode), elm));
 548    } else if (phase == L_YIELD) {
 549      BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE, symbol);
 550      if (entry != NO_BOOK && same_tree (indx, (NODE_T *) (INFO (entry))) == A68_TRUE) {
 551        (void) make_name (drf, DRF, "", NUMBER (entry));
 552      } else {
 553        (void) make_name (drf, DRF, "", NUMBER (prim));
 554      }
 555      if (primitive_mode (mode)) {
 556        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "_VALUE_ (%s)", drf));
 557      } else if (mode == M_COMPLEX) {
 558        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "(A68_REAL *) (%s)", drf));
 559      } else if (basic_mode (mode)) {
 560        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s", drf));
 561      } else {
 562        ABEND (A68_TRUE, ERROR_INTERNAL_CONSISTENCY, __func__);
 563      }
 564    }
 565  }
 566  
 567  //! @brief Code monadic formula.
 568  
 569  void inline_monadic_formula (NODE_T * p, FILE_T out, int phase)
 570  {
 571    NODE_T *op = SUB (p);
 572    NODE_T *rhs = NEXT (op);
 573    if (IS (p, MONADIC_FORMULA) && MOID (p) == M_COMPLEX) {
 574      char acc[NAME_SIZE];
 575      (void) make_name (acc, TMP, "", NUMBER (p));
 576      if (phase == L_DECLARE) {
 577        (void) add_declaration (&A68_OPT (root_idf), inline_mode (M_COMPLEX), 0, acc);
 578        inline_unit (rhs, out, L_DECLARE);
 579      } else if (phase == L_EXECUTE) {
 580        int k;
 581        inline_unit (rhs, out, L_EXECUTE);
 582        for (k = 0; PROCEDURE (&monadics[k]) != NO_GPROC; k++) {
 583          if (PROCEDURE (TAX (op)) == PROCEDURE (&monadics[k])) {
 584            indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s (%s, ", CODE (&monadics[k]), acc));
 585            inline_unit (rhs, out, L_YIELD);
 586            undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ");\n"));
 587          }
 588        }
 589      } else if (phase == L_YIELD) {
 590        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s", acc));
 591      }
 592    } else if (IS (p, MONADIC_FORMULA) && basic_mode (MOID (p))) {
 593      if (phase != L_YIELD) {
 594        inline_unit (rhs, out, phase);
 595      } else {
 596        int k;
 597        for (k = 0; PROCEDURE (&monadics[k]) != NO_GPROC; k++) {
 598          if (PROCEDURE (TAX (op)) == PROCEDURE (&monadics[k])) {
 599            if (IS_ALNUM ((CODE (&monadics[k]))[0])) {
 600              undent (out, CODE (&monadics[k]));
 601              undent (out, "(");
 602              inline_unit (rhs, out, L_YIELD);
 603              undent (out, ")");
 604            } else {
 605              undent (out, CODE (&monadics[k]));
 606              undent (out, "(");
 607              inline_unit (rhs, out, L_YIELD);
 608              undent (out, ")");
 609            }
 610          }
 611        }
 612      }
 613    }
 614  }
 615  
 616  //! @brief Code dyadic formula.
 617  
 618  void inline_formula (NODE_T * p, FILE_T out, int phase)
 619  {
 620    NODE_T *lhs = SUB (p), *rhs;
 621    NODE_T *op = NEXT (lhs);
 622    if (IS (p, FORMULA) && op == NO_NODE) {
 623      inline_monadic_formula (lhs, out, phase);
 624      return;
 625    }
 626    rhs = NEXT (op);
 627    if (IS (p, FORMULA) && MOID (p) == M_COMPLEX) {
 628      if (op == NO_NODE) {
 629        inline_monadic_formula (lhs, out, phase);
 630      } else if (phase == L_DECLARE) {
 631        char acc[NAME_SIZE];
 632        (void) make_name (acc, TMP, "", NUMBER (p));
 633        (void) add_declaration (&A68_OPT (root_idf), inline_mode (MOID (p)), 0, acc);
 634        inline_unit (lhs, out, L_DECLARE);
 635        inline_unit (rhs, out, L_DECLARE);
 636      } else if (phase == L_EXECUTE) {
 637        char acc[NAME_SIZE];
 638        int k;
 639        (void) make_name (acc, TMP, "", NUMBER (p));
 640        inline_unit (lhs, out, L_EXECUTE);
 641        inline_unit (rhs, out, L_EXECUTE);
 642        for (k = 0; PROCEDURE (&dyadics[k]) != NO_GPROC; k++) {
 643          if (PROCEDURE (TAX (op)) == PROCEDURE (&dyadics[k])) {
 644            if (MOID (p) == M_COMPLEX) {
 645              indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s (%s, ", CODE (&dyadics[k]), acc));
 646            } else {
 647              indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s (& %s, ", CODE (&dyadics[k]), acc));
 648            }
 649            inline_unit (lhs, out, L_YIELD);
 650            undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ", "));
 651            inline_unit (rhs, out, L_YIELD);
 652            undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ");\n"));
 653          }
 654        }
 655      } else if (phase == L_YIELD) {
 656        char acc[NAME_SIZE];
 657        (void) make_name (acc, TMP, "", NUMBER (p));
 658        if (MOID (p) == M_COMPLEX) {
 659          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s", acc));
 660        } else {
 661          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "_VALUE_ (& %s)", acc));
 662        }
 663      }
 664    } else if (IS (p, FORMULA) && basic_mode (MOID (p))) {
 665      if (phase != L_YIELD) {
 666        inline_unit (lhs, out, phase);
 667        inline_unit (rhs, out, phase);
 668      } else {
 669        int k;
 670        for (k = 0; PROCEDURE (&dyadics[k]) != NO_GPROC; k++) {
 671          if (PROCEDURE (TAX (op)) == PROCEDURE (&dyadics[k])) {
 672            if (IS_ALNUM ((CODE (&dyadics[k]))[0])) {
 673              undent (out, CODE (&dyadics[k]));
 674              undent (out, "(");
 675              inline_unit (lhs, out, L_YIELD);
 676              undent (out, ", ");
 677              inline_unit (rhs, out, L_YIELD);
 678              undent (out, ")");
 679            } else {
 680              undent (out, "(");
 681              inline_unit (lhs, out, L_YIELD);
 682              undent (out, " ");
 683              undent (out, CODE (&dyadics[k]));
 684              undent (out, " ");
 685              inline_unit (rhs, out, L_YIELD);
 686              undent (out, ")");
 687            }
 688          }
 689        }
 690      }
 691    }
 692  }
 693  
 694  //! @brief Code argument.
 695  
 696  void inline_single_argument (NODE_T * p, FILE_T out, int phase)
 697  {
 698    for (; p != NO_NODE; FORWARD (p)) {
 699      if (IS (p, ARGUMENT_LIST) || IS (p, ARGUMENT)) {
 700        inline_single_argument (SUB (p), out, phase);
 701      } else if (IS (p, GENERIC_ARGUMENT_LIST) || IS (p, GENERIC_ARGUMENT)) {
 702        inline_single_argument (SUB (p), out, phase);
 703      } else if (IS (p, UNIT)) {
 704        inline_unit (p, out, phase);
 705      }
 706    }
 707  }
 708  
 709  //! @brief Code call.
 710  
 711  void inline_call (NODE_T * p, FILE_T out, int phase)
 712  {
 713    NODE_T *prim = SUB (p);
 714    NODE_T *args = NEXT (prim);
 715    NODE_T *idf = stems_from (prim, IDENTIFIER);
 716    if (MOID (p) == M_COMPLEX) {
 717      char acc[NAME_SIZE];
 718      (void) make_name (acc, TMP, "", NUMBER (p));
 719      if (phase == L_DECLARE) {
 720        (void) add_declaration (&A68_OPT (root_idf), inline_mode (M_COMPLEX), 0, acc);
 721        inline_single_argument (args, out, L_DECLARE);
 722      } else if (phase == L_EXECUTE) {
 723        int k;
 724        inline_single_argument (args, out, L_EXECUTE);
 725        for (k = 0; PROCEDURE (&functions[k]) != NO_GPROC; k++) {
 726          if (PROCEDURE (TAX (idf)) == PROCEDURE (&functions[k])) {
 727            indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s (%s, ", CODE (&functions[k]), acc));
 728            inline_single_argument (args, out, L_YIELD);
 729            undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ");\n"));
 730          }
 731        }
 732      } else if (phase == L_YIELD) {
 733        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s", acc));
 734      }
 735    } else if (basic_mode (MOID (p))) {
 736      if (phase != L_YIELD) {
 737        inline_single_argument (args, out, phase);
 738      } else {
 739        int k;
 740        for (k = 0; PROCEDURE (&functions[k]) != NO_GPROC; k++) {
 741          if (PROCEDURE (TAX (idf)) == PROCEDURE (&functions[k])) {
 742            undent (out, CODE (&functions[k]));
 743            undent (out, " (");
 744            inline_single_argument (args, out, L_YIELD);
 745            undent (out, ")");
 746          }
 747        }
 748      }
 749    }
 750  }
 751  
 752  //! @brief Code collateral units.
 753  
 754  void inline_collateral_units (NODE_T * p, FILE_T out, int phase)
 755  {
 756    if (p == NO_NODE) {
 757      return;
 758    } else if (IS (p, UNIT)) {
 759      if (phase == L_DECLARE) {
 760        inline_unit (SUB (p), out, L_DECLARE);
 761      } else if (phase == L_EXECUTE) {
 762        inline_unit (SUB (p), out, L_EXECUTE);
 763      } else if (phase == L_YIELD) {
 764        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "PUSH_VALUE (p, "));
 765        inline_unit (SUB (p), out, L_YIELD);
 766        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ", %s);\n", inline_mode (MOID (p))));
 767      }
 768    } else {
 769      inline_collateral_units (SUB (p), out, phase);
 770      inline_collateral_units (NEXT (p), out, phase);
 771    }
 772  }
 773  
 774  //! @brief Code collateral units.
 775  
 776  void inline_collateral (NODE_T * p, FILE_T out, int phase)
 777  {
 778    char dsp[NAME_SIZE];
 779    (void) make_name (dsp, DSP, "", NUMBER (p));
 780    if (p == NO_NODE) {
 781      return;
 782    } else if (phase == L_DECLARE) {
 783      if (MOID (p) == M_COMPLEX) {
 784        (void) add_declaration (&A68_OPT (root_idf), inline_mode (M_REAL), 1, dsp);
 785      } else {
 786        (void) add_declaration (&A68_OPT (root_idf), inline_mode (MOID (p)), 1, dsp);
 787      }
 788      inline_collateral_units (NEXT_SUB (p), out, L_DECLARE);
 789    } else if (phase == L_EXECUTE) {
 790      if (MOID (p) == M_COMPLEX) {
 791        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = (%s *) STACK_TOP;\n", dsp, inline_mode (M_REAL)));
 792      } else {
 793        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = (%s *) STACK_TOP;\n", dsp, inline_mode (MOID (p))));
 794      }
 795      inline_collateral_units (NEXT_SUB (p), out, L_EXECUTE);
 796      inline_collateral_units (NEXT_SUB (p), out, L_YIELD);
 797    } else if (phase == L_YIELD) {
 798      undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s", dsp));
 799    }
 800  }
 801  
 802  //! @brief Code basic closed clause.
 803  
 804  void inline_closed (NODE_T * p, FILE_T out, int phase)
 805  {
 806    if (p == NO_NODE) {
 807      return;
 808    } else if (phase != L_YIELD) {
 809      inline_unit (SUB (NEXT_SUB (p)), out, phase);
 810    } else {
 811      undent (out, "(");
 812      inline_unit (SUB (NEXT_SUB (p)), out, L_YIELD);
 813      undent (out, ")");
 814    }
 815  }
 816  
 817  //! @brief Code basic closed clause.
 818  
 819  void inline_conditional (NODE_T * p, FILE_T out, int phase)
 820  {
 821    NODE_T *if_part = NO_NODE, *then_part = NO_NODE, *else_part = NO_NODE;
 822    p = SUB (p);
 823    if (IS (p, IF_PART) || IS (p, OPEN_PART)) {
 824      if_part = p;
 825    } else {
 826      ABEND (A68_TRUE, ERROR_INTERNAL_CONSISTENCY, __func__);
 827    }
 828    FORWARD (p);
 829    if (IS (p, THEN_PART) || IS (p, CHOICE)) {
 830      then_part = p;
 831    } else {
 832      ABEND (A68_TRUE, ERROR_INTERNAL_CONSISTENCY, __func__);
 833    }
 834    FORWARD (p);
 835    if (IS (p, ELSE_PART) || IS (p, CHOICE)) {
 836      else_part = p;
 837    } else {
 838      else_part = NO_NODE;
 839    }
 840    if (phase == L_DECLARE) {
 841      inline_unit (SUB (NEXT_SUB (if_part)), out, L_DECLARE);
 842      inline_unit (SUB (NEXT_SUB (then_part)), out, L_DECLARE);
 843      inline_unit (SUB (NEXT_SUB (else_part)), out, L_DECLARE);
 844    } else if (phase == L_EXECUTE) {
 845      inline_unit (SUB (NEXT_SUB (if_part)), out, L_EXECUTE);
 846      inline_unit (SUB (NEXT_SUB (then_part)), out, L_EXECUTE);
 847      inline_unit (SUB (NEXT_SUB (else_part)), out, L_EXECUTE);
 848    } else if (phase == L_YIELD) {
 849      undent (out, "(");
 850      inline_unit (SUB (NEXT_SUB (if_part)), out, L_YIELD);
 851      undent (out, " ? ");
 852      inline_unit (SUB (NEXT_SUB (then_part)), out, L_YIELD);
 853      undent (out, " : ");
 854      if (else_part != NO_NODE) {
 855        inline_unit (SUB (NEXT_SUB (else_part)), out, L_YIELD);
 856      } else {
 857  // This is not an ideal solution although RR permits it;
 858  // an omitted else-part means SKIP: yield some value of the
 859  // mode required.
 860        inline_unit (SUB (NEXT_SUB (then_part)), out, L_YIELD);
 861      }
 862      undent (out, ")");
 863    }
 864  }
 865  
 866  //! @brief Code dereferencing of selection.
 867  
 868  void inline_dereference_selection (NODE_T * p, FILE_T out, int phase)
 869  {
 870    NODE_T *field = SUB (p);
 871    NODE_T *sec = NEXT (field);
 872    NODE_T *idf = stems_from (sec, IDENTIFIER);
 873    char ref[NAME_SIZE], sel[NAME_SIZE];
 874    char *field_idf = NSYMBOL (SUB (field));
 875    if (phase == L_DECLARE) {
 876      BOOK_T *entry = signed_in (BOOK_DECL, L_DECLARE, NSYMBOL (idf));
 877      if (entry == NO_BOOK) {
 878        (void) make_name (ref, NSYMBOL (idf), "", NUMBER (field));
 879        (void) add_declaration (&A68_OPT (root_idf), "A68_REF", 1, ref);
 880        sign_in (BOOK_DECL, L_DECLARE, NSYMBOL (idf), NULL, NUMBER (field));
 881      }
 882      if (entry == NO_BOOK || field_idf != (char *) (INFO (entry))) {
 883        (void) make_name (sel, SEL, "", NUMBER (field));
 884        (void) add_declaration (&A68_OPT (root_idf), inline_mode (SUB_MOID (field)), 1, sel);
 885        sign_in (BOOK_DECL, L_DECLARE, NSYMBOL (idf), (void *) field_idf, NUMBER (field));
 886      }
 887      inline_unit (sec, out, L_DECLARE);
 888    } else if (phase == L_EXECUTE) {
 889      BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE, NSYMBOL (idf));
 890      if (entry == NO_BOOK) {
 891        (void) make_name (ref, NSYMBOL (idf), "", NUMBER (field));
 892        get_stack (idf, out, ref, "A68_REF");
 893        sign_in (BOOK_DECL, L_EXECUTE, NSYMBOL (idf), NULL, NUMBER (field));
 894      }
 895      if (entry == NO_BOOK) {
 896        (void) make_name (ref, NSYMBOL (idf), "", NUMBER (field));
 897        (void) make_name (sel, SEL, "", NUMBER (field));
 898        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = (%s *) & (ADDRESS (%s)[" A68_LU "]);\n", sel, inline_mode (SUB_MOID (field)), ref, OFFSET_OFF (field)));
 899        sign_in (BOOK_DECL, L_EXECUTE, NSYMBOL (idf), (void *) field_idf, NUMBER (field));
 900      } else if (field_idf != (char *) (INFO (entry))) {
 901        (void) make_name (ref, NSYMBOL (idf), "", NUMBER (entry));
 902        (void) make_name (sel, SEL, "", NUMBER (field));
 903        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = (%s *) & (ADDRESS (%s)[" A68_LU "]);\n", sel, inline_mode (SUB_MOID (field)), ref, OFFSET_OFF (field)));
 904        sign_in (BOOK_DECL, L_EXECUTE, NSYMBOL (idf), (void *) field_idf, NUMBER (field));
 905      }
 906      inline_unit (sec, out, L_EXECUTE);
 907    } else if (phase == L_YIELD) {
 908      BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE, NSYMBOL (idf));
 909      if (entry != NO_BOOK && (char *) (INFO (entry)) == field_idf) {
 910        (void) make_name (sel, SEL, "", NUMBER (entry));
 911      } else {
 912        (void) make_name (sel, SEL, "", NUMBER (field));
 913      }
 914      if (primitive_mode (SUB_MOID (p))) {
 915        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "_VALUE_ (%s)", sel));
 916      } else if (SUB_MOID (p) == M_COMPLEX) {
 917        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "(A68_REAL *) (%s)", sel));
 918      } else if (basic_mode (SUB_MOID (p))) {
 919        undent (out, sel);
 920      } else {
 921        ABEND (A68_TRUE, ERROR_INTERNAL_CONSISTENCY, __func__);
 922      }
 923    }
 924  }
 925  
 926  //! @brief Code selection.
 927  
 928  void inline_selection (NODE_T * p, FILE_T out, int phase)
 929  {
 930    NODE_T *field = SUB (p);
 931    NODE_T *sec = NEXT (field);
 932    NODE_T *idf = stems_from (sec, IDENTIFIER);
 933    char ref[NAME_SIZE], sel[NAME_SIZE];
 934    char *field_idf = NSYMBOL (SUB (field));
 935    if (phase == L_DECLARE) {
 936      BOOK_T *entry = signed_in (BOOK_DECL, L_DECLARE, NSYMBOL (idf));
 937      if (entry == NO_BOOK) {
 938        (void) make_name (ref, NSYMBOL (idf), "", NUMBER (field));
 939        (void) add_declaration (&A68_OPT (root_idf), "A68_STRUCT", 0, ref);
 940        sign_in (BOOK_DECL, L_DECLARE, NSYMBOL (idf), NULL, NUMBER (field));
 941      }
 942      if (entry == NO_BOOK || field_idf != (char *) (INFO (entry))) {
 943        (void) make_name (sel, SEL, "", NUMBER (field));
 944        (void) add_declaration (&A68_OPT (root_idf), inline_mode (MOID (field)), 1, sel);
 945        sign_in (BOOK_DECL, L_DECLARE, NSYMBOL (idf), (void *) field_idf, NUMBER (field));
 946      }
 947      inline_unit (sec, out, L_DECLARE);
 948    } else if (phase == L_EXECUTE) {
 949      BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE, NSYMBOL (idf));
 950      if (entry == NO_BOOK) {
 951        (void) make_name (ref, NSYMBOL (idf), "", NUMBER (field));
 952        get_stack (idf, out, ref, "BYTE_T");
 953        (void) make_name (sel, SEL, "", NUMBER (field));
 954        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = (%s *) & (%s[" A68_LU "]);\n", sel, inline_mode (MOID (field)), ref, OFFSET_OFF (field)));
 955        sign_in (BOOK_DECL, L_EXECUTE, NSYMBOL (idf), (void *) field_idf, NUMBER (field));
 956      } else if (field_idf != (char *) (INFO (entry))) {
 957        (void) make_name (ref, NSYMBOL (idf), "", NUMBER (entry));
 958        (void) make_name (sel, SEL, "", NUMBER (field));
 959        indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = (%s *) & (%s[" A68_LU "]);\n", sel, inline_mode (MOID (field)), ref, OFFSET_OFF (field)));
 960        sign_in (BOOK_DECL, L_EXECUTE, NSYMBOL (idf), (void *) field_idf, NUMBER (field));
 961      }
 962      inline_unit (sec, out, L_EXECUTE);
 963    } else if (phase == L_YIELD) {
 964      BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE, NSYMBOL (idf));
 965      if (entry != NO_BOOK && (char *) (INFO (entry)) == field_idf) {
 966        (void) make_name (sel, SEL, "", NUMBER (entry));
 967      } else {
 968        (void) make_name (sel, SEL, "", NUMBER (field));
 969      }
 970      if (primitive_mode (MOID (p))) {
 971        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "_VALUE_ (%s)", sel));
 972      } else {
 973        ABEND (A68_TRUE, ERROR_INTERNAL_CONSISTENCY, __func__);
 974      }
 975    }
 976  }
 977  
 978  //! @brief Code selection.
 979  
 980  void inline_selection_ref_to_ref (NODE_T * p, FILE_T out, int phase)
 981  {
 982    NODE_T *field = SUB (p);
 983    NODE_T *sec = NEXT (field);
 984    NODE_T *idf = stems_from (sec, IDENTIFIER);
 985    char ref[NAME_SIZE], sel[NAME_SIZE];
 986    char *field_idf = NSYMBOL (SUB (field));
 987    if (phase == L_DECLARE) {
 988      BOOK_T *entry = signed_in (BOOK_DECL, L_DECLARE, NSYMBOL (idf));
 989      if (entry == NO_BOOK) {
 990        (void) make_name (ref, NSYMBOL (idf), "", NUMBER (field));
 991        (void) add_declaration (&A68_OPT (root_idf), "A68_REF", 1, ref);
 992        sign_in (BOOK_DECL, L_DECLARE, NSYMBOL (idf), NULL, NUMBER (field));
 993      }
 994      if (entry == NO_BOOK || field_idf != (char *) (INFO (entry))) {
 995        (void) make_name (sel, SEL, "", NUMBER (field));
 996        (void) add_declaration (&A68_OPT (root_idf), "A68_REF", 0, sel);
 997        sign_in (BOOK_DECL, L_DECLARE, NSYMBOL (idf), (void *) field_idf, NUMBER (field));
 998      }
 999      inline_unit (sec, out, L_DECLARE);
1000    } else if (phase == L_EXECUTE) {
1001      BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE_2, NSYMBOL (idf));
1002      if (entry == NO_BOOK) {
1003        (void) make_name (ref, NSYMBOL (idf), "", NUMBER (field));
1004        get_stack (idf, out, ref, "A68_REF");
1005        (void) make_name (sel, SEL, "", NUMBER (field));
1006        sign_in (BOOK_DECL, L_EXECUTE_2, NSYMBOL (idf), (void *) field_idf, NUMBER (field));
1007      } else if (field_idf != (char *) (INFO (entry))) {
1008        (void) make_name (ref, NSYMBOL (idf), "", NUMBER (entry));
1009        (void) make_name (sel, SEL, "", NUMBER (field));
1010        sign_in (BOOK_DECL, L_EXECUTE_2, NSYMBOL (idf), (void *) field_idf, NUMBER (field));
1011      }
1012      indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "%s = *%s;\n", sel, ref));
1013      indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "OFFSET (&%s) += " A68_LU ";\n", sel, OFFSET_OFF (field)));
1014      inline_unit (sec, out, L_EXECUTE);
1015    } else if (phase == L_YIELD) {
1016      BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE, NSYMBOL (idf));
1017      if (entry != NO_BOOK && (char *) (INFO (entry)) == field_idf) {
1018        (void) make_name (sel, SEL, "", NUMBER (entry));
1019      } else {
1020        (void) make_name (sel, SEL, "", NUMBER (field));
1021      }
1022      if (primitive_mode (SUB_MOID (p))) {
1023        undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "(&%s)", sel));
1024      } else {
1025        ABEND (A68_TRUE, ERROR_INTERNAL_CONSISTENCY, __func__);
1026      }
1027    }
1028  }
1029  
1030  //! @brief Code identifier.
1031  
1032  void inline_ref_identifier (NODE_T * p, FILE_T out, int phase)
1033  {
1034  // No folding - consider identifier.
1035    if (phase == L_DECLARE) {
1036      if (signed_in (BOOK_DECL, L_DECLARE, NSYMBOL (p)) != NO_BOOK) {
1037        return;
1038      } else {
1039        char idf[NAME_SIZE];
1040        (void) make_name (idf, NSYMBOL (p), "", NUMBER (p));
1041        (void) add_declaration (&A68_OPT (root_idf), "A68_REF", 1, idf);
1042        sign_in (BOOK_DECL, L_DECLARE, NSYMBOL (p), NULL, NUMBER (p));
1043      }
1044    } else if (phase == L_EXECUTE) {
1045      if (signed_in (BOOK_DECL, L_EXECUTE, NSYMBOL (p)) != NO_BOOK) {
1046        return;
1047      } else {
1048        char idf[NAME_SIZE];
1049        (void) make_name (idf, NSYMBOL (p), "", NUMBER (p));
1050        get_stack (p, out, idf, "A68_REF");
1051        sign_in (BOOK_DECL, L_EXECUTE, NSYMBOL (p), NULL, NUMBER (p));
1052      }
1053    } else if (phase == L_YIELD) {
1054      char idf[NAME_SIZE];
1055      BOOK_T *entry = signed_in (BOOK_DECL, L_EXECUTE, NSYMBOL (p));
1056      if (entry != NO_BOOK) {
1057        (void) make_name (idf, NSYMBOL (p), "", NUMBER (entry));
1058      } else {
1059        (void) make_name (idf, NSYMBOL (p), "", NUMBER (p));
1060      }
1061      undent (out, idf);
1062    }
1063  }
1064  
1065  //! @brief Code identity-relation.
1066  
1067  void inline_identity_relation (NODE_T * p, FILE_T out, int phase)
1068  {
1069  #define GOOD(p) (stems_from (p, IDENTIFIER) != NO_NODE && IS (MOID (stems_from ((p), IDENTIFIER)), REF_SYMBOL))
1070    NODE_T *lhs = SUB (p);
1071    NODE_T *op = NEXT (lhs);
1072    NODE_T *rhs = NEXT (op);
1073    if (GOOD (lhs) && GOOD (rhs)) {
1074      if (phase == L_DECLARE) {
1075        NODE_T *lidf = stems_from (lhs, IDENTIFIER);
1076        NODE_T *ridf = stems_from (rhs, IDENTIFIER);
1077        inline_ref_identifier (lidf, out, L_DECLARE);
1078        inline_ref_identifier (ridf, out, L_DECLARE);
1079      } else if (phase == L_EXECUTE) {
1080        NODE_T *lidf = stems_from (lhs, IDENTIFIER);
1081        NODE_T *ridf = stems_from (rhs, IDENTIFIER);
1082        inline_ref_identifier (lidf, out, L_EXECUTE);
1083        inline_ref_identifier (ridf, out, L_EXECUTE);
1084      } else if (phase == L_YIELD) {
1085        NODE_T *lidf = stems_from (lhs, IDENTIFIER);
1086        NODE_T *ridf = stems_from (rhs, IDENTIFIER);
1087        if (IS (op, IS_SYMBOL)) {
1088          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "ADDRESS ("));
1089          inline_ref_identifier (lidf, out, L_YIELD);
1090          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ") == ADDRESS ("));
1091          inline_ref_identifier (ridf, out, L_YIELD);
1092          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ")"));
1093        } else {
1094          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "ADDRESS ("));
1095          inline_ref_identifier (lidf, out, L_YIELD);
1096          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ") != ADDRESS ("));
1097          inline_ref_identifier (ridf, out, L_YIELD);
1098          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ")"));
1099        }
1100      }
1101    } else if (GOOD (lhs) && stems_from (rhs, NIHIL) != NO_NODE) {
1102      if (phase == L_DECLARE) {
1103        NODE_T *lidf = stems_from (lhs, IDENTIFIER);
1104        inline_ref_identifier (lidf, out, L_DECLARE);
1105      } else if (phase == L_EXECUTE) {
1106        NODE_T *lidf = stems_from (lhs, IDENTIFIER);
1107        inline_ref_identifier (lidf, out, L_EXECUTE);
1108      } else if (phase == L_YIELD) {
1109        NODE_T *lidf = stems_from (lhs, IDENTIFIER);
1110        if (IS (op, IS_SYMBOL)) {
1111          indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "IS_NIL (*"));
1112          inline_ref_identifier (lidf, out, L_YIELD);
1113          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ")"));
1114        } else {
1115          indentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, "!IS_NIL (*"));
1116          inline_ref_identifier (lidf, out, L_YIELD);
1117          undentf (out, snprintf (A68 (edit_line), SNPRINTF_SIZE, ")"));
1118        }
1119      }
1120    }
1121  #undef GOOD
1122  }
1123  
1124  //! @brief Code unit.
1125  
1126  void inline_unit (NODE_T * p, FILE_T out, int phase)
1127  {
1128    if (p == NO_NODE) {
1129      return;
1130    } else if (constant_unit (p) && stems_from (p, DENOTATION) == NO_NODE) {
1131      constant_folder (p, out, phase);
1132    } else if (IS (p, UNIT)) {
1133      inline_unit (SUB (p), out, phase);
1134    } else if (IS (p, TERTIARY)) {
1135      inline_unit (SUB (p), out, phase);
1136    } else if (IS (p, SECONDARY)) {
1137      inline_unit (SUB (p), out, phase);
1138    } else if (IS (p, PRIMARY)) {
1139      inline_unit (SUB (p), out, phase);
1140    } else if (IS (p, ENCLOSED_CLAUSE)) {
1141      inline_unit (SUB (p), out, phase);
1142    } else if (IS (p, CLOSED_CLAUSE)) {
1143      inline_closed (p, out, phase);
1144    } else if (IS (p, COLLATERAL_CLAUSE)) {
1145      inline_collateral (p, out, phase);
1146    } else if (IS (p, CONDITIONAL_CLAUSE)) {
1147      inline_conditional (p, out, phase);
1148    } else if (IS (p, WIDENING)) {
1149      inline_widening (p, out, phase);
1150    } else if (IS (p, IDENTIFIER)) {
1151      inline_identifier (p, out, phase);
1152    } else if (IS (p, DEREFERENCING) && stems_from (SUB (p), IDENTIFIER) != NO_NODE) {
1153      inline_dereference_identifier (p, out, phase);
1154    } else if (IS (p, SLICE)) {
1155      NODE_T *prim = SUB (p);
1156      MOID_T *mode = MOID (p);
1157      MOID_T *row_mode = DEFLEX (MOID (prim));
1158      if (mode == SUB (row_mode)) {
1159        inline_slice (p, out, phase);
1160      } else if (IS (mode, REF_SYMBOL) && IS (row_mode, REF_SYMBOL) && SUB (mode) == SUB_SUB (row_mode)) {
1161        inline_slice_ref_to_ref (p, out, phase);
1162      } else {
1163        ABEND (A68_TRUE, ERROR_INTERNAL_CONSISTENCY, __func__);
1164      }
1165    } else if (IS (p, DEREFERENCING) && stems_from (SUB (p), SLICE) != NO_NODE) {
1166      inline_dereference_slice (SUB (p), out, phase);
1167    } else if (IS (p, DEREFERENCING) && stems_from (SUB (p), SELECTION) != NO_NODE) {
1168      inline_dereference_selection (SUB (p), out, phase);
1169    } else if (IS (p, SELECTION)) {
1170      NODE_T *sec = NEXT_SUB (p);
1171      MOID_T *mode = MOID (p);
1172      MOID_T *struct_mode = MOID (sec);
1173      if (IS (struct_mode, REF_SYMBOL) && IS (mode, REF_SYMBOL)) {
1174        inline_selection_ref_to_ref (p, out, phase);
1175      } else if (IS (struct_mode, STRUCT_SYMBOL) && primitive_mode (mode)) {
1176        inline_selection (p, out, phase);
1177      } else {
1178        ABEND (A68_TRUE, ERROR_INTERNAL_CONSISTENCY, __func__);
1179      }
1180    } else if (IS (p, DENOTATION)) {
1181      inline_denotation (p, out, phase);
1182    } else if (IS (p, MONADIC_FORMULA)) {
1183      inline_monadic_formula (p, out, phase);
1184    } else if (IS (p, FORMULA)) {
1185      inline_formula (p, out, phase);
1186    } else if (IS (p, CALL)) {
1187      inline_call (p, out, phase);
1188    } else if (IS (p, CAST)) {
1189      inline_unit (NEXT_SUB (p), out, phase);
1190    } else if (IS (p, IDENTITY_RELATION)) {
1191      inline_identity_relation (p, out, phase);
1192    }
1193  }
1194