home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / g77-0.5.15-src.tgz / tar.out / fsf / g77 / f / symbol.c < prev    next >
C/C++ Source or Header  |  1996-09-28  |  34KB  |  1,335 lines
  1. /* Implementation of Fortran symbol manager
  2.    Copyright (C) 1995 Free Software Foundation, Inc.
  3.    Contributed by James Craig Burley (burley@gnu.ai.mit.edu).
  4.  
  5. This file is part of GNU Fortran.
  6.  
  7. GNU Fortran is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2, or (at your option)
  10. any later version.
  11.  
  12. GNU Fortran is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. GNU General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with GNU Fortran; see the file COPYING.  If not, write to
  19. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  20.  
  21. #include "proj.h"
  22. #include "symbol.h"
  23. #include "bad.h"
  24. #include "bld.h"
  25. #include "com.h"
  26. #include "equiv.h"
  27. #include "global.h"
  28. #include "info.h"
  29. #include "intrin.h"
  30. #include "lex.h"
  31. #include "malloc.h"
  32. #include "src.h"
  33. #include "st.h"
  34. #include "storag.h"
  35. #include "target.h"
  36. #include "where.h"
  37.  
  38. /* Choice of how to handle global symbols -- either global only within the
  39.    program unit being defined or global within the entire source file.
  40.    The former is appropriate for systems where an object file can
  41.    easily be taken apart program unit by program unit, the latter is the
  42.    UNIX/C model where the object file is essentially a monolith.  */
  43.  
  44. #define FFESYMBOL_globalPROGUNIT_ 0
  45. #define FFESYMBOL_globalFILE_ 1
  46.  
  47. /* Choose how to handle global symbols here.  */
  48.  
  49. #if FFECOM_targetCURRENT == FFECOM_targetFFE
  50. #define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGUNIT_
  51. #else
  52. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  53. #define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGRAMUNIT_
  54. #endif
  55. #endif
  56.  
  57. /* Choose how to handle memory pools based on global symbol stuff.  */
  58.  
  59. #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
  60. #define FFESYMBOL_SPACE_POOL_ ffe_pool_program_unit()
  61. #else
  62. #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_
  63. #define FFESYMBOL_SPACE_POOL_ ffe_pool_file()
  64. #endif
  65. #endif
  66.  
  67. /* What kind of retraction is needed for a symbol?  */
  68.  
  69. enum _ffesymbol_retractcommand_
  70.   {
  71.     FFESYMBOL_retractcommandDELETE_,
  72.     FFESYMBOL_retractcommandRETRACT_,
  73.     FFESYMBOL_retractcommand_
  74.   };
  75. typedef enum _ffesymbol_retractcommand_ ffesymbolRetractCommand_;
  76.  
  77. /* This object keeps track of retraction for a symbol and links to the next
  78.    such object.  */
  79.  
  80. typedef struct _ffesymbol_retract_ *ffesymbolRetract_;
  81. struct _ffesymbol_retract_
  82.   {
  83.     ffesymbolRetract_ next;
  84.     ffesymbolRetractCommand_ command;
  85.     ffesymbol live;        /* Live symbol. */
  86.     ffesymbol symbol;        /* Backup copy of symbol. */
  87.   };
  88.  
  89. static ffebad ffesymbol_check_token_ (ffelexToken t, char *c);
  90. static void ffesymbol_kill_manifest_ (void);
  91. static ffesymbol ffesymbol_new_ (ffename n);
  92. static ffesymbol ffesymbol_unhook_ (ffesymbol s);
  93. static void ffesymbol_whine_state_ (ffebad bad, ffelexToken t, char c);
  94.  
  95. /* Manifest names for unnamed things (as tokens) so we make them only
  96.    once.  */
  97.  
  98. static ffelexToken ffesymbol_token_blank_common_ = NULL;
  99. static ffelexToken ffesymbol_token_unnamed_main_ = NULL;
  100. static ffelexToken ffesymbol_token_unnamed_blockdata_ = NULL;
  101.  
  102. /* Name spaces currently in force.  */
  103.  
  104. static ffenameSpace ffesymbol_global_ = NULL;
  105. static ffenameSpace ffesymbol_local_ = NULL;
  106. static ffenameSpace ffesymbol_sfunc_ = NULL;
  107.  
  108. /* Keep track of retraction.  */
  109.  
  110. static bool ffesymbol_retractable_ = FALSE;
  111. static mallocPool ffesymbol_retract_pool_;
  112. static ffesymbolRetract_ ffesymbol_retract_first_;
  113. static ffesymbolRetract_ *ffesymbol_retract_list_;
  114.  
  115. /* List of state names. */
  116.  
  117. static char *ffesymbol_state_name_[] =
  118. {
  119.   "?",
  120.   "@",
  121.   "&",
  122.   "$",
  123. };
  124.  
  125. /* List of attribute names. */
  126.  
  127. static char *ffesymbol_attr_name_[] =
  128. {
  129. #define DEFATTR(ATTR,ATTRS,NAME) NAME,
  130. #include "symbol.def"
  131. #undef DEFATTR
  132. };
  133.  
  134.  
  135. /* Check whether the token text has any invalid characters.  If not,
  136.    return FALSE.  If so, if error messages inhibited, return TRUE
  137.    so caller knows to try again later, else report error and return
  138.    FALSE.  */
  139.  
  140. static ffebad
  141. ffesymbol_check_token_ (ffelexToken t, char *c)
  142. {
  143.   char *p = ffelex_token_text (t);
  144.   ffeTokenLength len = ffelex_token_length (t);
  145.   ffebad bad;
  146.   ffeTokenLength i = 0;
  147.   ffebad skip_me = ((ffe_case_symbol () == FFE_caseINITCAP)
  148.             ? FFEBAD_SYMBOL_NOLOWER_INITCAP : FFEBAD + 1);
  149.   ffebad stop_me = ((ffe_case_symbol () == FFE_caseINITCAP)
  150.             ? FFEBAD : FFEBAD + 1);
  151.   if (len == 0)
  152.     return FFEBAD;
  153.  
  154.   bad = ffesrc_bad_char_symbol_init (*p);
  155.   if (bad == FFEBAD)
  156.     {
  157.       for (++i, ++p; i < len; ++i, ++p)
  158.     {
  159.       bad = ffesrc_bad_char_symbol_noninit (*p);
  160.       if (bad == skip_me)
  161.         continue;        /* Keep looking for good InitCap character. */
  162.       if (bad == stop_me)
  163.         break;        /* Found good InitCap character. */
  164.       if (bad != FFEBAD)
  165.         break;        /* Bad character found. */
  166.     }
  167.     }
  168.  
  169.   if (bad != FFEBAD)
  170.     if (i >= len)
  171.       *c = *(ffelex_token_text (t));
  172.     else
  173.       *c = *p;
  174.  
  175.   return bad;
  176. }
  177.  
  178. /* Kill manifest (g77-picked) names.  */
  179.  
  180. static void
  181. ffesymbol_kill_manifest_ ()
  182. {
  183.   if (ffesymbol_token_blank_common_ != NULL)
  184.     ffelex_token_kill (ffesymbol_token_blank_common_);
  185.   if (ffesymbol_token_unnamed_main_ != NULL)
  186.     ffelex_token_kill (ffesymbol_token_unnamed_main_);
  187.   if (ffesymbol_token_unnamed_blockdata_ != NULL)
  188.     ffelex_token_kill (ffesymbol_token_unnamed_blockdata_);
  189.  
  190.   ffesymbol_token_blank_common_ = NULL;
  191.   ffesymbol_token_unnamed_main_ = NULL;
  192.   ffesymbol_token_unnamed_blockdata_ = NULL;
  193. }
  194.  
  195. /* Make new symbol.
  196.  
  197.    If the "retractable" flag is not set, just return the new symbol.
  198.    Else, add symbol to the "retract" list as a delete item, set
  199.    the "have_old" flag, and return the new symbol.  */
  200.  
  201. static ffesymbol
  202. ffesymbol_new_ (ffename n)
  203. {
  204.   ffesymbol s;
  205.   ffesymbolRetract_ r;
  206.  
  207.   assert (n != NULL);
  208.  
  209.   s = (ffesymbol) malloc_new_ks (FFESYMBOL_SPACE_POOL_, "FFESYMBOL",
  210.                  sizeof (*s));
  211.   s->name = n;
  212.   s->other_space_name = NULL;
  213. #if FFEGLOBAL_ENABLED
  214.   s->global = NULL;
  215. #endif
  216.   s->attrs = FFESYMBOL_attrsetNONE;
  217.   s->state = FFESYMBOL_stateNONE;
  218.   s->info = ffeinfo_new_null ();
  219.   s->dims = NULL;
  220.   s->extents = NULL;
  221.   s->dim_syms = NULL;
  222.   s->array_size = NULL;
  223.   s->init = NULL;
  224.   s->accretion = NULL;
  225.   s->accretes = 0;
  226.   s->dummy_args = NULL;
  227.   s->namelist = NULL;
  228.   s->common_list = NULL;
  229.   s->sfunc_expr = NULL;
  230.   s->list_bottom = NULL;
  231.   s->common = NULL;
  232.   s->equiv = NULL;
  233.   s->storage = NULL;
  234. #ifdef FFECOM_symbolHOOK
  235.   s->hook = FFECOM_symbolNULL;
  236. #endif
  237.   s->sfa_dummy_parent = NULL;
  238.   s->func_result = NULL;
  239.   s->value = 0;
  240.   s->check_state = FFESYMBOL_checkstateNONE_;
  241.   s->check_token = NULL;
  242.   s->max_entry_num = 0;
  243.   s->num_entries = 0;
  244.   s->generic = FFEINTRIN_genNONE;
  245.   s->specific = FFEINTRIN_specNONE;
  246.   s->implementation = FFEINTRIN_impNONE;
  247.   s->save = FALSE;
  248.   s->do_iter = FALSE;
  249.   s->reported = FALSE;
  250.   s->explicit_where = FALSE;
  251.   s->namelisted = FALSE;
  252.  
  253.   ffename_set_symbol (n, s);
  254.  
  255.   if (!ffesymbol_retractable_)
  256.     {
  257.       s->have_old = FALSE;
  258.       return s;
  259.     }
  260.  
  261.   r = (ffesymbolRetract_) malloc_new_kp (ffesymbol_retract_pool_,
  262.                      "FFESYMBOL retract", sizeof (*r));
  263.   r->next = NULL;
  264.   r->command = FFESYMBOL_retractcommandDELETE_;
  265.   r->live = s;
  266.   r->symbol = NULL;        /* No backup copy. */
  267.  
  268.   *ffesymbol_retract_list_ = r;
  269.   ffesymbol_retract_list_ = &r->next;
  270.  
  271.   s->have_old = TRUE;
  272.   return s;
  273. }
  274.  
  275. /* Unhook a symbol from its (soon-to-be-killed) name obj.
  276.  
  277.    NULLify the names to which this symbol points.  Do other cleanup as
  278.    needed.  */
  279.  
  280. static ffesymbol
  281. ffesymbol_unhook_ (ffesymbol s)
  282. {
  283.   s->other_space_name = s->name = NULL;
  284.   if ((ffesymbol_attrs (s) & FFESYMBOL_attrsCBLOCK)
  285.       || (ffesymbol_kind (s) == FFEINFO_kindNAMELIST))
  286.     ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
  287.   if (s->check_state == FFESYMBOL_checkstatePENDING_)
  288.     ffelex_token_kill (s->check_token);
  289.  
  290.   return s;
  291. }
  292.  
  293. /* Issue diagnostic about bad character in token representing user-defined
  294.    symbol name.     */
  295.  
  296. static void
  297. ffesymbol_whine_state_ (ffebad bad, ffelexToken t, char c)
  298. {
  299.   char badstr[2];
  300.  
  301.   badstr[0] = c;
  302.   badstr[1] = '\0';
  303.  
  304.   ffebad_start (bad);
  305.   ffebad_here (0, ffelex_token_where_line (t),
  306.            ffelex_token_where_column (t));
  307.   ffebad_string (badstr);
  308.   ffebad_finish ();
  309. }
  310.  
  311. /* Returns a string representing the attributes set.  */
  312.  
  313. char *
  314. ffesymbol_attrs_string (ffesymbolAttrs attrs)
  315. {
  316.   static char string[FFESYMBOL_attr * 12 + 20];
  317.   char *p;
  318.   ffesymbolAttr attr;
  319.  
  320.   p = &string[0];
  321.  
  322.   if (attrs == FFESYMBOL_attrsetNONE)
  323.     {
  324.       strcpy (p, "NONE");
  325.       return &string[0];
  326.     }
  327.  
  328.   for (attr = 0; attr < FFESYMBOL_attr; ++attr)
  329.     {
  330.       if (attrs & ((ffesymbolAttrs) 1 << attr))
  331.     {
  332.       attrs &= ~((ffesymbolAttrs) 1 << attr);
  333.       strcpy (p, ffesymbol_attr_name_[attr]);
  334.       while (*p)
  335.         ++p;
  336.       *(p++) = '|';
  337.     }
  338.     }
  339.   if (attrs == FFESYMBOL_attrsetNONE)
  340.     *--p = '\0';
  341.   else
  342.     sprintf (p, "?0x%" ffesymbolAttrs_f "x?", attrs);
  343.   assert ((p - &string[0]) < ARRAY_SIZE (string));
  344.   return &string[0];
  345. }
  346.  
  347. /* Check symbol's name for validity, considering that it might actually
  348.    be an intrinsic and thus should not be complained about just yet.  */
  349.  
  350. void
  351. ffesymbol_check (ffesymbol s, ffelexToken t, bool maybe_intrin)
  352. {
  353.   char c;
  354.   ffebad bad;
  355.   ffeintrinGen gen;
  356.   ffeintrinSpec spec;
  357.   ffeintrinImp imp;
  358.   ffeinfoKind kind;
  359.  
  360.   if (!ffesrc_check_symbol ()
  361.       || ((s->check_state != FFESYMBOL_checkstateNONE_)
  362.       && ((s->check_state != FFESYMBOL_checkstateINHIBITED_)
  363.           || ffebad_inhibit ())))
  364.     return;
  365.  
  366.   bad = ffesymbol_check_token_ (t, &c);
  367.  
  368.   if (bad == FFEBAD)
  369.     {
  370.       s->check_state = FFESYMBOL_checkstateCHECKED_;
  371.       return;
  372.     }
  373.  
  374.   if (maybe_intrin
  375.       && ffeintrin_is_intrinsic (ffelex_token_text (t), NULL, FALSE,
  376.                  &gen, &spec, &imp, &kind))
  377.     {
  378.       s->check_state = FFESYMBOL_checkstatePENDING_;
  379.       s->check_token = ffelex_token_use (t);
  380.       return;
  381.     }
  382.  
  383.   if (ffebad_inhibit ())
  384.     {
  385.       s->check_state = FFESYMBOL_checkstateINHIBITED_;
  386.       return;            /* Don't complain now, do it later. */
  387.     }
  388.  
  389.   s->check_state = FFESYMBOL_checkstateCHECKED_;
  390.  
  391.   ffesymbol_whine_state_ (bad, t, c);
  392. }
  393.  
  394. /* Declare a BLOCKDATA unit.
  395.  
  396.    Retrieves or creates the ffesymbol for the specified BLOCKDATA (unnamed
  397.    if t is NULL).  Doesn't actually ensure the named item is a
  398.    BLOCKDATA; the caller must handle that.  */
  399.  
  400. ffesymbol
  401. ffesymbol_declare_blockdataunit (ffelexToken t, ffewhereLine wl,
  402.                  ffewhereColumn wc)
  403. {
  404.   ffename n;
  405.   ffesymbol s;
  406.   bool user = (t != NULL);
  407.  
  408.   assert (!ffesymbol_retractable_);
  409.  
  410.   if (t == NULL)
  411.     {
  412.       if (ffesymbol_token_unnamed_blockdata_ == NULL)
  413.     ffesymbol_token_unnamed_blockdata_
  414.       = ffelex_token_new_name (FFETARGET_nameUNNAMED_BLOCK_DATA, wl, wc);
  415.       t = ffesymbol_token_unnamed_blockdata_;
  416.     }
  417.  
  418.   n = ffename_lookup (ffesymbol_local_, t);
  419.   if (n != NULL)
  420.     return ffename_symbol (n);    /* This will become an error. */
  421.  
  422.   n = ffename_find (ffesymbol_global_, t);
  423.   s = ffename_symbol (n);
  424.   if (s != NULL)
  425.     {
  426.       if (user)
  427.     ffesymbol_check (s, t, FALSE);
  428.       return s;
  429.     }
  430.  
  431.   s = ffesymbol_new_ (n);
  432.   if (user)
  433.     ffesymbol_check (s, t, FALSE);
  434.  
  435.   /* A program unit name also is in the local name space. */
  436.  
  437.   n = ffename_find (ffesymbol_local_, t);
  438.   ffename_set_symbol (n, s);
  439.   s->other_space_name = n;
  440.  
  441.   ffeglobal_new_blockdata (s, t);    /* Detect conflicts, when
  442.                        appropriate. */
  443.  
  444.   return s;
  445. }
  446.  
  447. /* Declare a common block (named or unnamed).
  448.  
  449.    Retrieves or creates the ffesymbol for the specified common block (blank
  450.    common if t is NULL).  Doesn't actually ensure the named item is a
  451.    common block; the caller must handle that.  */
  452.  
  453. ffesymbol
  454. ffesymbol_declare_cblock (ffelexToken t, ffewhereLine wl, ffewhereColumn wc)
  455. {
  456.   ffename n;
  457.   ffesymbol s;
  458.   bool blank;
  459.  
  460.   assert (!ffesymbol_retractable_);
  461.  
  462.   if (t == NULL)
  463.     {
  464.       blank = TRUE;
  465.       if (ffesymbol_token_blank_common_ == NULL)
  466.     ffesymbol_token_blank_common_
  467.       = ffelex_token_new_name (FFETARGET_nameBLANK_COMMON, wl, wc);
  468.       t = ffesymbol_token_blank_common_;
  469.     }
  470.   else
  471.     blank = FALSE;
  472.  
  473.   n = ffename_find (ffesymbol_global_, t);
  474.   s = ffename_symbol (n);
  475.   if (s != NULL)
  476.     {
  477.       if (!blank)
  478.     ffesymbol_check (s, t, FALSE);
  479.       return s;
  480.     }
  481.  
  482.   s = ffesymbol_new_ (n);
  483.   if (!blank)
  484.     ffesymbol_check (s, t, FALSE);
  485.  
  486.   ffeglobal_new_common (s, t, blank);    /* Detect conflicts. */
  487.  
  488.   return s;
  489. }
  490.  
  491. /* Declare a FUNCTION program unit (with distinct RESULT() name).
  492.  
  493.    Retrieves or creates the ffesymbol for the specified function.  Doesn't
  494.    actually ensure the named item is a function; the caller must handle
  495.    that.
  496.  
  497.    If FUNCTION with RESULT() is specified but the names are the same,
  498.    pretend as though RESULT() was not specified, and don't call this
  499.    function; use ffesymbol_declare_funcunit() instead.    */
  500.  
  501. ffesymbol
  502. ffesymbol_declare_funcnotresunit (ffelexToken t)
  503. {
  504.   ffename n;
  505.   ffesymbol s;
  506.  
  507.   assert (t != NULL);
  508.   assert (!ffesymbol_retractable_);
  509.  
  510.   n = ffename_lookup (ffesymbol_local_, t);
  511.   if (n != NULL)
  512.     return ffename_symbol (n);    /* This will become an error. */
  513.  
  514.   n = ffename_find (ffesymbol_global_, t);
  515.   s = ffename_symbol (n);
  516.   if (s != NULL)
  517.     {
  518.       ffesymbol_check (s, t, FALSE);
  519.       return s;
  520.     }
  521.  
  522.   s = ffesymbol_new_ (n);
  523.   ffesymbol_check (s, t, FALSE);
  524.  
  525.   /* A FUNCTION program unit name also is in the local name space; handle it
  526.      here since RESULT() is a different name and is handled separately. */
  527.  
  528.   n = ffename_find (ffesymbol_local_, t);
  529.   ffename_set_symbol (n, s);
  530.   s->other_space_name = n;
  531.  
  532.   ffeglobal_new_function (s, t);/* Detect conflicts, when appropriate. */
  533.  
  534.   return s;
  535. }
  536.  
  537. /* Declare a function result.
  538.  
  539.    Retrieves or creates the ffesymbol for the specified function result,
  540.    whether specified via a distinct RESULT() or by default in a FUNCTION or
  541.    ENTRY statement.  */
  542.  
  543. ffesymbol
  544. ffesymbol_declare_funcresult (ffelexToken t)
  545. {
  546.   ffename n;
  547.   ffesymbol s;
  548.  
  549.   assert (t != NULL);
  550.   assert (!ffesymbol_retractable_);
  551.  
  552.   n = ffename_find (ffesymbol_local_, t);
  553.   s = ffename_symbol (n);
  554.   if (s != NULL)
  555.     return s;
  556.  
  557.   return ffesymbol_new_ (n);
  558. }
  559.  
  560. /* Declare a FUNCTION program unit with no RESULT().
  561.  
  562.    Retrieves or creates the ffesymbol for the specified function.  Doesn't
  563.    actually ensure the named item is a function; the caller must handle
  564.    that.
  565.  
  566.    This is the function to call when the FUNCTION or ENTRY statement has
  567.    no separate and distinct name specified via RESULT().  That's because
  568.    this function enters the global name of the function in only the global
  569.    name space.    ffesymbol_declare_funcresult() must still be called to
  570.    declare the name for the function result in the local name space.  */
  571.  
  572. ffesymbol
  573. ffesymbol_declare_funcunit (ffelexToken t)
  574. {
  575.   ffename n;
  576.   ffesymbol s;
  577.  
  578.   assert (t != NULL);
  579.   assert (!ffesymbol_retractable_);
  580.  
  581.   n = ffename_find (ffesymbol_global_, t);
  582.   s = ffename_symbol (n);
  583.   if (s != NULL)
  584.     {
  585.       ffesymbol_check (s, t, FALSE);
  586.       return s;
  587.     }
  588.  
  589.   s = ffesymbol_new_ (n);
  590.   ffesymbol_check (s, t, FALSE);
  591.  
  592.   ffeglobal_new_function (s, t);/* Detect conflicts. */
  593.  
  594.   return s;
  595. }
  596.  
  597. /* Declare a local entity.
  598.  
  599.    Retrieves or creates the ffesymbol for the specified local entity.
  600.    Set maybe_intrin TRUE if this name might turn out to name an
  601.    intrinsic (legitimately); otherwise if the name doesn't meet the
  602.    requirements for a user-defined symbol name, a diagnostic will be
  603.    issued right away rather than waiting until the intrinsicness of the
  604.    symbol is determined.  */
  605.  
  606. ffesymbol
  607. ffesymbol_declare_local (ffelexToken t, bool maybe_intrin)
  608. {
  609.   ffename n;
  610.   ffesymbol s;
  611.  
  612.   assert (t != NULL);
  613.  
  614.   /* If we're parsing within a statement function definition, return the
  615.      symbol if already known (a dummy argument for the statement function).
  616.      Otherwise continue on, which means the symbol is declared within the
  617.      containing (local) program unit rather than the statement function
  618.      definition.  */
  619.  
  620.   if ((ffesymbol_sfunc_ != NULL)
  621.       && ((n = ffename_lookup (ffesymbol_sfunc_, t)) != NULL))
  622.     return ffename_symbol (n);
  623.  
  624.   n = ffename_find (ffesymbol_local_, t);
  625.   s = ffename_symbol (n);
  626.   if (s != NULL)
  627.     {
  628.       ffesymbol_check (s, t, maybe_intrin);
  629.       return s;
  630.     }
  631.  
  632.   s = ffesymbol_new_ (n);
  633.   ffesymbol_check (s, t, maybe_intrin);
  634.   return s;
  635. }
  636.  
  637. /* Declare a main program unit.
  638.  
  639.    Retrieves or creates the ffesymbol for the specified main program unit
  640.    (unnamed main program unit if t is NULL).  Doesn't actually ensure the
  641.    named item is a program; the caller must handle that.  */
  642.  
  643. ffesymbol
  644. ffesymbol_declare_programunit (ffelexToken t, ffewhereLine wl,
  645.                    ffewhereColumn wc)
  646. {
  647.   ffename n;
  648.   ffesymbol s;
  649.   bool user = (t != NULL);
  650.  
  651.   assert (!ffesymbol_retractable_);
  652.  
  653.   if (t == NULL)
  654.     {
  655.       if (ffesymbol_token_unnamed_main_ == NULL)
  656.     ffesymbol_token_unnamed_main_
  657.       = ffelex_token_new_name (FFETARGET_nameUNNAMED_MAIN, wl, wc);
  658.       t = ffesymbol_token_unnamed_main_;
  659.     }
  660.  
  661.   n = ffename_lookup (ffesymbol_local_, t);
  662.   if (n != NULL)
  663.     return ffename_symbol (n);    /* This will become an error. */
  664.  
  665.   n = ffename_find (ffesymbol_global_, t);
  666.   s = ffename_symbol (n);
  667.   if (s != NULL)
  668.     {
  669.       if (user)
  670.     ffesymbol_check (s, t, FALSE);
  671.       return s;
  672.     }
  673.  
  674.   s = ffesymbol_new_ (n);
  675.   if (user)
  676.     ffesymbol_check (s, t, FALSE);
  677.  
  678.   /* A program unit name also is in the local name space. */
  679.  
  680.   n = ffename_find (ffesymbol_local_, t);
  681.   ffename_set_symbol (n, s);
  682.   s->other_space_name = n;
  683.  
  684.   ffeglobal_new_program (s, t);    /* Detect conflicts. */
  685.  
  686.   return s;
  687. }
  688.  
  689. /* Declare a statement-function dummy.
  690.  
  691.    Retrieves or creates the ffesymbol for the specified statement
  692.    function dummy.  Also ensures that it has a link to the parent (local)
  693.    ffesymbol with the same name, creating it if necessary.  */
  694.  
  695. ffesymbol
  696. ffesymbol_declare_sfdummy (ffelexToken t)
  697. {
  698.   ffename n;
  699.   ffesymbol s;
  700.   ffesymbol sp;            /* Parent symbol in local area. */
  701.  
  702.   assert (t != NULL);
  703.  
  704.   n = ffename_find (ffesymbol_local_, t);
  705.   sp = ffename_symbol (n);
  706.   if (sp == NULL)
  707.     sp = ffesymbol_new_ (n);
  708.   ffesymbol_check (sp, t, FALSE);
  709.  
  710.   n = ffename_find (ffesymbol_sfunc_, t);
  711.   s = ffename_symbol (n);
  712.   if (s == NULL)
  713.     {
  714.       s = ffesymbol_new_ (n);
  715.       s->sfa_dummy_parent = sp;
  716.     }
  717.   else
  718.     assert (s->sfa_dummy_parent == sp);
  719.  
  720.   return s;
  721. }
  722.  
  723. /* Declare a subroutine program unit.
  724.  
  725.    Retrieves or creates the ffesymbol for the specified subroutine
  726.    Doesn't actually ensure the named item is a subroutine; the caller must
  727.    handle that.  */
  728.  
  729. ffesymbol
  730. ffesymbol_declare_subrunit (ffelexToken t)
  731. {
  732.   ffename n;
  733.   ffesymbol s;
  734.  
  735.   assert (!ffesymbol_retractable_);
  736.   assert (t != NULL);
  737.  
  738.   n = ffename_lookup (ffesymbol_local_, t);
  739.   if (n != NULL)
  740.     return ffename_symbol (n);    /* This will become an error. */
  741.  
  742.   n = ffename_find (ffesymbol_global_, t);
  743.   s = ffename_symbol (n);
  744.   if (s != NULL)
  745.     {
  746.       ffesymbol_check (s, t, FALSE);
  747.       return s;
  748.     }
  749.  
  750.   s = ffesymbol_new_ (n);
  751.   ffesymbol_check (s, t, FALSE);
  752.  
  753.   /* A program unit name also is in the local name space. */
  754.  
  755.   n = ffename_find (ffesymbol_local_, t);
  756.   ffename_set_symbol (n, s);
  757.   s->other_space_name = n;
  758.  
  759.   ffeglobal_new_subroutine (s, t);    /* Detect conflicts, when
  760.                        appropriate. */
  761.  
  762.   return s;
  763. }
  764.  
  765. /* Call given fn with all local/global symbols.
  766.  
  767.    ffesymbol (*fn) (ffesymbol s);
  768.    ffesymbol_drive (fn);  */
  769.  
  770. void
  771. ffesymbol_drive (ffesymbol (*fn) ())
  772. {
  773.   assert (ffesymbol_sfunc_ == NULL);    /* Might be ok, but not for current
  774.                        uses. */
  775.   ffename_space_drive_symbol (ffesymbol_local_, fn);
  776.   ffename_space_drive_symbol (ffesymbol_global_, fn);
  777. }
  778.  
  779. /* Call given fn with all sfunc-only symbols.
  780.  
  781.    ffesymbol (*fn) (ffesymbol s);
  782.    ffesymbol_drive_sfnames (fn);  */
  783.  
  784. void
  785. ffesymbol_drive_sfnames (ffesymbol (*fn) ())
  786. {
  787.   ffename_space_drive_symbol (ffesymbol_sfunc_, fn);
  788. }
  789.  
  790. /* Dump info on the symbol for debugging purposes.  */
  791.  
  792. void
  793. ffesymbol_dump (ffesymbol s)
  794. {
  795.   ffeinfoKind k;
  796.   ffeinfoWhere w;
  797.  
  798.   assert (s != NULL);
  799.  
  800.   if (ffeinfo_size (s->info) != FFETARGET_charactersizeNONE)
  801.     fprintf (stdout, "%s:%d%s%s*%" ffetargetCharacterSize_f "u",
  802.          ffesymbol_text (s),
  803.          (int) ffeinfo_rank (s->info),
  804.          ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
  805.          ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)),
  806.          ffeinfo_size (s->info));
  807.   else
  808.     fprintf (stdout, "%s:%d%s%s",
  809.          ffesymbol_text (s),
  810.          (int) ffeinfo_rank (s->info),
  811.          ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
  812.          ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)));
  813.   if ((k = ffeinfo_kind (s->info)) != FFEINFO_kindNONE)
  814.     fprintf (stdout, "/%s", ffeinfo_kind_string (k));
  815.   if ((w = ffeinfo_where (s->info)) != FFEINFO_whereNONE)
  816.     fprintf (stdout, "@%s", ffeinfo_where_string (w));
  817.  
  818.   if ((s->generic != FFEINTRIN_genNONE)
  819.       || (s->specific != FFEINTRIN_specNONE)
  820.       || (s->implementation != FFEINTRIN_impNONE))
  821.     fprintf (stdout, "{%s:%s:%s}",
  822.          ffeintrin_name_generic (s->generic),
  823.          ffeintrin_name_specific (s->specific),
  824.          ffeintrin_name_implementation (s->implementation));
  825. }
  826.  
  827. /* Produce generic error message about a symbol.
  828.  
  829.    For now, just output error message using symbol's name and pointing to
  830.    the token.  */
  831.  
  832. void
  833. ffesymbol_error (ffesymbol s, ffelexToken t)
  834. {
  835.   if (ffest_ffebad_start (FFEBAD_SYMERR))
  836.     {
  837.       ffebad_string (ffesymbol_text (s));
  838.       ffebad_here (0, ffelex_token_where_line (t),
  839.            ffelex_token_where_column (t));
  840.       ffebad_here (1, ffesymbol_where_line (s), ffesymbol_where_column (s));
  841.       ffebad_finish ();
  842.     }
  843.  
  844.   if (ffesymbol_attr (s, FFESYMBOL_attrANY))
  845.     return;
  846.  
  847.   ffesymbol_signal_change (s);    /* May need to back up to previous version. */
  848.   if ((ffesymbol_attrs (s) & FFESYMBOL_attrsCBLOCK)
  849.       || (ffesymbol_kind (s) == FFEINFO_kindNAMELIST))
  850.     ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
  851.   ffesymbol_set_attr (s, FFESYMBOL_attrANY);
  852.   ffesymbol_set_info (s, ffeinfo_new_any ());
  853.   ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
  854.   if (s->check_state == FFESYMBOL_checkstatePENDING_)
  855.     ffelex_token_kill (s->check_token);
  856.   s->check_state = FFESYMBOL_checkstateCHECKED_;
  857.   s = ffecom_sym_learned (s);
  858.   ffesymbol_signal_unreported (s);
  859. }
  860.  
  861. void
  862. ffesymbol_init_0 ()
  863. {
  864.   ffesymbolAttrs attrs = FFESYMBOL_attrsetNONE;
  865.  
  866.   assert (FFESYMBOL_state == ARRAY_SIZE (ffesymbol_state_name_));
  867.   assert (FFESYMBOL_attr == ARRAY_SIZE (ffesymbol_attr_name_));
  868.   assert (attrs == FFESYMBOL_attrsetNONE);
  869.   attrs = ((ffesymbolAttrs) 1 << FFESYMBOL_attr);
  870.   assert (attrs != 0);
  871. }
  872.  
  873. void
  874. ffesymbol_init_1 ()
  875. {
  876. #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_
  877.   ffesymbol_global_ = ffename_space_new (ffe_pool_file ());
  878. #endif
  879. }
  880.  
  881. void
  882. ffesymbol_init_2 ()
  883. {
  884. }
  885.  
  886. void
  887. ffesymbol_init_3 ()
  888. {
  889. #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
  890.   ffesymbol_global_ = ffename_space_new (ffe_pool_program_unit ());
  891. #endif
  892.   ffesymbol_local_ = ffename_space_new (ffe_pool_program_unit ());
  893. }
  894.  
  895. void
  896. ffesymbol_init_4 ()
  897. {
  898.   ffesymbol_sfunc_ = ffename_space_new (ffe_pool_program_unit ());
  899. }
  900.  
  901. /* Look up a local entity.
  902.  
  903.    Retrieves the ffesymbol for the specified local entity, or returns NULL
  904.    if no local entity by that name exists.  */
  905.  
  906. ffesymbol
  907. ffesymbol_lookup_local (ffelexToken t)
  908. {
  909.   ffename n;
  910.   ffesymbol s;
  911.  
  912.   assert (t != NULL);
  913.  
  914.   n = ffename_lookup (ffesymbol_local_, t);
  915.   if (n == NULL)
  916.     return NULL;
  917.  
  918.   s = ffename_symbol (n);
  919.   return s;            /* May be NULL here, too. */
  920. }
  921.  
  922. /* Report info on the symbol for debugging purposes.  */
  923.  
  924. ffesymbol
  925. ffesymbol_report (ffesymbol s)
  926. {
  927.   ffeinfoKind k;
  928.   ffeinfoWhere w;
  929.  
  930.   assert (s != NULL);
  931.  
  932.   if (s->reported)
  933.     return s;
  934.  
  935.   s->reported = TRUE;
  936.  
  937.   if (ffeinfo_size (s->info) != FFETARGET_charactersizeNONE)
  938.     fprintf (stdout, "\"%s\": %s %s %d%s%s*%" ffetargetCharacterSize_f "u",
  939.          ffesymbol_text (s),
  940.          ffesymbol_state_string (s->state),
  941.          ffesymbol_attrs_string (s->attrs),
  942.          (int) ffeinfo_rank (s->info),
  943.          ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
  944.          ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)),
  945.          ffeinfo_size (s->info));
  946.   else
  947.     fprintf (stdout, "\"%s\": %s %s %d%s%s",
  948.          ffesymbol_text (s),
  949.          ffesymbol_state_string (s->state),
  950.          ffesymbol_attrs_string (s->attrs),
  951.          (int) ffeinfo_rank (s->info),
  952.          ffeinfo_basictype_string (ffeinfo_basictype (s->info)),
  953.          ffeinfo_kindtype_string (ffeinfo_kindtype (s->info)));
  954.   if ((k = ffeinfo_kind (s->info)) != FFEINFO_kindNONE)
  955.     fprintf (stdout, "/%s", ffeinfo_kind_string (k));
  956.   if ((w = ffeinfo_where (s->info)) != FFEINFO_whereNONE)
  957.     fprintf (stdout, "@%s", ffeinfo_where_string (w));
  958.   fputc ('\n', stdout);
  959.  
  960.   if (s->dims != NULL)
  961.     {
  962.       fprintf (stdout, "  dims: ");
  963.       ffebld_dump (s->dims);
  964.       fputs ("\n", stdout);
  965.     }
  966.  
  967.   if (s->extents != NULL)
  968.     {
  969.       fprintf (stdout, "  extents: ");
  970.       ffebld_dump (s->extents);
  971.       fputs ("\n", stdout);
  972.     }
  973.  
  974.   if (s->dim_syms != NULL)
  975.     {
  976.       fprintf (stdout, "  dim syms: ");
  977.       ffebld_dump (s->dim_syms);
  978.       fputs ("\n", stdout);
  979.     }
  980.  
  981.   if (s->array_size != NULL)
  982.     {
  983.       fprintf (stdout, "  array size: ");
  984.       ffebld_dump (s->array_size);
  985.       fputs ("\n", stdout);
  986.     }
  987.  
  988.   if (s->init != NULL)
  989.     {
  990.       fprintf (stdout, "  init-value: ");
  991.       if (ffebld_op (s->init) == FFEBLD_opANY)
  992.     fputs ("<any>\n", stdout);
  993.       else
  994.     {
  995.       ffebld_dump (s->init);
  996.       fputs ("\n", stdout);
  997.     }
  998.     }
  999.  
  1000.   if (s->accretion != NULL)
  1001.     {
  1002.       fprintf (stdout, "  accretion (%" ffetargetOffset_f "u left): ",
  1003.            s->accretes);
  1004.       ffebld_dump (s->accretion);
  1005.       fputs ("\n", stdout);
  1006.     }
  1007.   else if (s->accretes != 0)
  1008.     fprintf (stdout, "  accretes!! = %" ffetargetOffset_f "u left\n",
  1009.          s->accretes);
  1010.  
  1011.   if (s->dummy_args != NULL)
  1012.     {
  1013.       fprintf (stdout, "  dummies: ");
  1014.       ffebld_dump (s->dummy_args);
  1015.       fputs ("\n", stdout);
  1016.     }
  1017.  
  1018.   if (s->namelist != NULL)
  1019.     {
  1020.       fprintf (stdout, "  namelist: ");
  1021.       ffebld_dump (s->namelist);
  1022.       fputs ("\n", stdout);
  1023.     }
  1024.  
  1025.   if (s->common_list != NULL)
  1026.     {
  1027.       fprintf (stdout, "  common-list: ");
  1028.       ffebld_dump (s->common_list);
  1029.       fputs ("\n", stdout);
  1030.     }
  1031.  
  1032.   if (s->sfunc_expr != NULL)
  1033.     {
  1034.       fprintf (stdout, "  sfunc expression: ");
  1035.       ffebld_dump (s->sfunc_expr);
  1036.       fputs ("\n", stdout);
  1037.     }
  1038.  
  1039.   if (s->save)
  1040.     {
  1041.       fprintf (stdout, "  SAVEd\n");
  1042.     }
  1043.  
  1044.   if (s->do_iter)
  1045.     {
  1046.       fprintf (stdout, "  DO-loop iteration variable (currently)\n");
  1047.     }
  1048.  
  1049.   if (s->explicit_where)
  1050.     {
  1051.       fprintf (stdout, "  Explicit INTRINSIC/EXTERNAL\n");
  1052.     }
  1053.  
  1054.   if (s->namelisted)
  1055.     {
  1056.       fprintf (stdout, "  Namelisted\n");
  1057.     }
  1058.  
  1059.   if (s->common != NULL)
  1060.     {
  1061.       fprintf (stdout, "  COMMON area: %s\n", ffesymbol_text (s->common));
  1062.     }
  1063.  
  1064.   if (s->equiv != NULL)
  1065.     {
  1066.       fprintf (stdout, "  EQUIVALENCE information: ");
  1067.       ffeequiv_dump (s->equiv);
  1068.       fputs ("\n", stdout);
  1069.     }
  1070.  
  1071.   if (s->storage != NULL)
  1072.     {
  1073.       fprintf (stdout, "  Storage: ");
  1074.       ffestorag_dump (s->storage);
  1075.       fputs ("\n", stdout);
  1076.     }
  1077.  
  1078.   return s;
  1079. }
  1080.  
  1081. /* Report info on the symbols.    */
  1082.  
  1083. void
  1084. ffesymbol_report_all ()
  1085. {
  1086.   ffename_space_drive_symbol (ffesymbol_sfunc_, ffesymbol_report);
  1087.   ffename_space_drive_symbol (ffesymbol_local_, ffesymbol_report);
  1088.   ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_report);
  1089. }
  1090.  
  1091. /* Resolve symbol that has become known intrinsic or non-intrinsic.  */
  1092.  
  1093. void
  1094. ffesymbol_resolve_intrin (ffesymbol s)
  1095. {
  1096.   char c;
  1097.   ffebad bad;
  1098.  
  1099.   if (!ffesrc_check_symbol ())
  1100.     return;
  1101.   if (s->check_state != FFESYMBOL_checkstatePENDING_)
  1102.     return;
  1103.   if (ffebad_inhibit ())
  1104.     return;            /* We'll get back to this later. */
  1105.  
  1106.   if (ffesymbol_where (s) != FFEINFO_whereINTRINSIC)
  1107.     {
  1108.       bad = ffesymbol_check_token_ (s->check_token, &c);
  1109.       assert (bad != FFEBAD);    /* How did this suddenly become ok? */
  1110.       ffesymbol_whine_state_ (bad, s->check_token, c);
  1111.     }
  1112.  
  1113.   s->check_state = FFESYMBOL_checkstateCHECKED_;
  1114.   ffelex_token_kill (s->check_token);
  1115. }
  1116.  
  1117. /* Retract or cancel retract list.  */
  1118.  
  1119. void
  1120. ffesymbol_retract (bool retract)
  1121. {
  1122.   ffesymbolRetract_ r;
  1123.   ffename name;
  1124.   ffename other_space_name;
  1125.   ffesymbol ls;
  1126.   ffesymbol os;
  1127.  
  1128.   assert (ffesymbol_retractable_);
  1129.  
  1130.   ffesymbol_retractable_ = FALSE;
  1131.  
  1132.   for (r = ffesymbol_retract_first_; r != NULL; r = r->next)
  1133.     {
  1134.       ls = r->live;
  1135.       os = r->symbol;
  1136.       switch (r->command)
  1137.     {
  1138.     case FFESYMBOL_retractcommandDELETE_:
  1139.       if (retract)
  1140.         {
  1141.           ffecom_sym_retract (ls);
  1142.           name = ls->name;
  1143.           other_space_name = ls->other_space_name;
  1144.           ffesymbol_unhook_ (ls);
  1145.           malloc_kill_ks (FFESYMBOL_SPACE_POOL_, ls, sizeof (*ls));
  1146.           if (name != NULL)
  1147.         ffename_set_symbol (name, NULL);
  1148.           if (other_space_name != NULL)
  1149.         ffename_set_symbol (other_space_name, NULL);
  1150.         }
  1151.       else
  1152.         {
  1153.           ffecom_sym_commit (ls);
  1154.           ls->have_old = FALSE;
  1155.         }
  1156.       break;
  1157.  
  1158.     case FFESYMBOL_retractcommandRETRACT_:
  1159.       if (retract)
  1160.         {
  1161.           ffecom_sym_retract (ls);
  1162.           ffesymbol_unhook_ (ls);
  1163.           *ls = *os;
  1164.           malloc_kill_ks (FFESYMBOL_SPACE_POOL_, os, sizeof (*os));
  1165.         }
  1166.       else
  1167.         {
  1168.           ffecom_sym_commit (ls);
  1169.           ffesymbol_unhook_ (os);
  1170.           malloc_kill_ks (FFESYMBOL_SPACE_POOL_, os, sizeof (*os));
  1171.           ls->have_old = FALSE;
  1172.         }
  1173.       break;
  1174.  
  1175.     default:
  1176.       assert ("bad command" == NULL);
  1177.       break;
  1178.     }
  1179.     }
  1180. }
  1181.  
  1182. /* Return retractable flag.  */
  1183.  
  1184. bool
  1185. ffesymbol_retractable ()
  1186. {
  1187.   return ffesymbol_retractable_;
  1188. }
  1189.  
  1190. /* Set retractable flag, retract pool.
  1191.  
  1192.    Between this call and ffesymbol_retract, any changes made to existing
  1193.    symbols cause the previous versions of those symbols to be saved, and any
  1194.    newly created symbols to have their previous nonexistence saved.  When
  1195.    ffesymbol_retract is called, this information either is used to retract
  1196.    the changes and new symbols, or is discarded.  */
  1197.  
  1198. void
  1199. ffesymbol_set_retractable (mallocPool pool)
  1200. {
  1201.   assert (!ffesymbol_retractable_);
  1202.  
  1203.   ffesymbol_retractable_ = TRUE;
  1204.   ffesymbol_retract_pool_ = pool;
  1205.   ffesymbol_retract_list_ = &ffesymbol_retract_first_;
  1206.   ffesymbol_retract_first_ = NULL;
  1207. }
  1208.  
  1209. /* Existing symbol about to be changed; save?
  1210.  
  1211.    Call this function before changing a symbol if it is possible that
  1212.    the current actions may need to be undone (i.e. one of several possible
  1213.    statement forms are being used to analyze the current system).
  1214.  
  1215.    If the "retractable" flag is not set, just return.
  1216.    Else, if the symbol's "have_old" flag is set, just return.
  1217.    Else, make a copy of the symbol and add it to the "retract" list, set
  1218.    the "have_old" flag, and return.  */
  1219.  
  1220. void
  1221. ffesymbol_signal_change (ffesymbol s)
  1222. {
  1223.   ffesymbolRetract_ r;
  1224.   ffesymbol sym;
  1225.  
  1226.   if (!ffesymbol_retractable_ || s->have_old)
  1227.     return;
  1228.  
  1229.   r = (ffesymbolRetract_) malloc_new_kp (ffesymbol_retract_pool_,
  1230.                      "FFESYMBOL retract", sizeof (*r));
  1231.   r->next = NULL;
  1232.   r->command = FFESYMBOL_retractcommandRETRACT_;
  1233.   r->live = s;
  1234.   r->symbol = sym = (ffesymbol) malloc_new_ks (FFESYMBOL_SPACE_POOL_,
  1235.                            "FFESYMBOL", sizeof (*sym));
  1236.   *sym = *s;            /* Make an exact copy of the symbol in case
  1237.                    we need it back. */
  1238.   sym->info = ffeinfo_use (s->info);
  1239.   if (s->check_state == FFESYMBOL_checkstatePENDING_)
  1240.     sym->check_token = ffelex_token_use (s->check_token);
  1241.  
  1242.   *ffesymbol_retract_list_ = r;
  1243.   ffesymbol_retract_list_ = &r->next;
  1244.  
  1245.   s->have_old = TRUE;
  1246. }
  1247.  
  1248. /* Returns the string based on the state.  */
  1249.  
  1250. char *
  1251. ffesymbol_state_string (ffesymbolState state)
  1252. {
  1253.   if (state >= ARRAY_SIZE (ffesymbol_state_name_))
  1254.     return "?\?\?";
  1255.   return ffesymbol_state_name_[state];
  1256. }
  1257.  
  1258. void
  1259. ffesymbol_terminate_0 ()
  1260. {
  1261. }
  1262.  
  1263. void
  1264. ffesymbol_terminate_1 ()
  1265. {
  1266. #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_
  1267.   ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_unhook_);
  1268.   ffename_space_kill (ffesymbol_global_);
  1269.   ffesymbol_global_ = NULL;
  1270.  
  1271.   ffesymbol_kill_manifest ();
  1272. #endif
  1273. }
  1274.  
  1275. void
  1276. ffesymbol_terminate_2 ()
  1277. {
  1278. #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
  1279.   ffesymbol_kill_manifest_ ();
  1280. #endif
  1281. }
  1282.  
  1283. void
  1284. ffesymbol_terminate_3 ()
  1285. {
  1286. #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
  1287.   ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_unhook_);
  1288.   ffename_space_kill (ffesymbol_global_);
  1289. #endif
  1290.   ffename_space_drive_symbol (ffesymbol_local_, ffesymbol_unhook_);
  1291.   ffename_space_kill (ffesymbol_local_);
  1292. #if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
  1293.   ffesymbol_global_ = NULL;
  1294. #endif
  1295.   ffesymbol_local_ = NULL;
  1296. }
  1297.  
  1298. void
  1299. ffesymbol_terminate_4 ()
  1300. {
  1301.   ffename_space_drive_symbol (ffesymbol_sfunc_, ffesymbol_unhook_);
  1302.   ffename_space_kill (ffesymbol_sfunc_);
  1303.   ffesymbol_sfunc_ = NULL;
  1304. }
  1305.  
  1306. /* Update SAVE info to TRUE and all equiv/storage too.
  1307.  
  1308.    If SAVE flag is TRUE, does nothing.    Else sets it to TRUE and calls
  1309.    on the ffeequiv and ffestorag modules to update their SAVE flags if
  1310.    the <s> symbol has those objects, and also updates the common area if
  1311.    it exists.  */
  1312.  
  1313. void
  1314. ffesymbol_update_save (ffesymbol s)
  1315. {
  1316.   ffebld item;
  1317.  
  1318.   if (s->save)
  1319.     return;
  1320.  
  1321.   s->save = TRUE;
  1322.  
  1323.   if (s->equiv != NULL)
  1324.     ffeequiv_update_save (s->equiv);
  1325.  
  1326.   if (s->storage != NULL)
  1327.     ffestorag_update_save (s->storage);
  1328.  
  1329.   if (s->common != NULL)
  1330.     ffesymbol_update_save (s->common);
  1331.  
  1332.   for (item = s->common_list; item != NULL; item = ffebld_trail (item))
  1333.     ffesymbol_update_save (ffebld_symter (ffebld_head (item)));
  1334. }
  1335.