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 / name.c < prev    next >
C/C++ Source or Header  |  1996-09-28  |  6KB  |  253 lines
  1. /* name.c -- Implementation File (module.c template V1.0)
  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.    Related Modules:
  22.       None.
  23.  
  24.    Description:
  25.       Name and name space abstraction.
  26.  
  27.    Modifications:
  28. */
  29.  
  30. /* Include files. */
  31.  
  32. #include "proj.h"
  33. #include "bad.h"
  34. #include "name.h"
  35. #include "lex.h"
  36. #include "malloc.h"
  37. #include "src.h"
  38. #include "where.h"
  39.  
  40. /* Externals defined here. */
  41.  
  42.  
  43. /* Simple definitions and enumerations. */
  44.  
  45.  
  46. /* Internal typedefs. */
  47.  
  48.  
  49. /* Private include files. */
  50.  
  51.  
  52. /* Internal structure definitions. */
  53.  
  54.  
  55. /* Static objects accessed by functions in this module. */
  56.  
  57.  
  58. /* Static functions (internal). */
  59.  
  60. static ffename ffename_lookup_ (ffenameSpace ns, ffelexToken t, bool *found);
  61.  
  62. /* Internal macros. */
  63.  
  64. #define FFENAME_spacePROGUNIT_ 0
  65. #define FFENAME_spaceFILE_ 1
  66.  
  67. #if FFECOM_targetCURRENT == FFECOM_targetFFE
  68. #define FFENAME_spaceCURRENT_ FFENAME_spacePROGUNIT_
  69. #else
  70. #if FFECOM_targetCURRENT == FFECOM_targetGCC
  71. #define FFENAME_spaceCURRENT_ FFENAME_spacePROGUNIT_
  72. #endif
  73. #endif
  74.  
  75.  
  76. /* Searches for and returns the matching ffename object, or returns a
  77.    pointer to the name before which the new name should go.  */
  78.  
  79. static ffename
  80. ffename_lookup_ (ffenameSpace ns, ffelexToken t, bool *found)
  81. {
  82.   ffename n;
  83.  
  84.   for (n = ns->first; n != (ffename) &ns->first; n = n->next)
  85.     {
  86.       if (ffelex_token_strcmp (t, n->t) == 0)
  87.     {
  88.       *found = TRUE;
  89.       return n;
  90.     }
  91.     }
  92.  
  93.   *found = FALSE;
  94.   return n;            /* (n == (ffename) &ns->first) */
  95. }
  96.  
  97. /* Searches for and returns the matching ffename object, or creates a new
  98.    one (with a NULL ffesymbol) and returns that.  If last arg is TRUE,
  99.    check whether token meets character-content requirements (such as
  100.    "all characters must be uppercase", as determined by
  101.    ffesrc_bad_char_symbol (), issue diagnostic if it doesn't.  */
  102.  
  103. ffename
  104. ffename_find (ffenameSpace ns, ffelexToken t)
  105. {
  106.   ffename n;
  107.   ffename newn;
  108.   bool found;
  109.  
  110.   assert (ns != NULL);
  111.   assert ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeNAME)
  112.               || (ffelex_token_type (t) == FFELEX_typeNAMES)));
  113.  
  114.   n = ffename_lookup_ (ns, t, &found);
  115.   if (found)
  116.     return n;
  117.  
  118.   newn = (ffename) malloc_new_ks (ns->pool, "FFENAME name", sizeof (*n));
  119.   newn->next = n;
  120.   newn->previous = n->previous;
  121.   n->previous = newn;
  122.   newn->previous->next = newn;
  123.   newn->t = ffelex_token_use (t);
  124.   newn->u.s = NULL;
  125.  
  126.   return newn;
  127. }
  128.  
  129. /* ffename_kill -- Kill name from name space
  130.  
  131.    ffenameSpace ns;
  132.    ffename s;
  133.    ffename_kill(ns,s);
  134.  
  135.    Removes the name from the name space.  */
  136.  
  137. void
  138. ffename_kill (ffenameSpace ns, ffename n)
  139. {
  140.   assert (ns != NULL);
  141.   assert (n != NULL);
  142.  
  143.   ffelex_token_kill (n->t);
  144.   n->next->previous = n->previous;
  145.   n->previous->next = n->next;
  146.   malloc_kill_ks (ns->pool, n, sizeof (*n));
  147. }
  148.  
  149. /* ffename_lookup -- Look up name in name space
  150.  
  151.    ffenameSpace ns;
  152.    ffelexToken t;
  153.    ffename s;
  154.    n = ffename_lookup(ns,t);
  155.  
  156.    Searches for and returns the matching ffename object, or returns NULL.  */
  157.  
  158. ffename
  159. ffename_lookup (ffenameSpace ns, ffelexToken t)
  160. {
  161.   ffename n;
  162.   bool found;
  163.  
  164.   assert (ns != NULL);
  165.   assert ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeNAME)
  166.               || (ffelex_token_type (t) == FFELEX_typeNAMES)));
  167.  
  168.   n = ffename_lookup_ (ns, t, &found);
  169.  
  170.   return found ? n : NULL;
  171. }
  172.  
  173. /* ffename_space_drive_global -- Call given fn for each global in name space
  174.  
  175.    ffenameSpace ns;
  176.    ffeglobal (*fn)();
  177.    ffename_space_drive_global(ns,fn);  */
  178.  
  179. void
  180. ffename_space_drive_global (ffenameSpace ns, ffeglobal (*fn) ())
  181. {
  182.   ffename n;
  183.  
  184.   if (ns == NULL)
  185.     return;
  186.  
  187.   for (n = ns->first; n != (ffename) &ns->first; n = n->next)
  188.     {
  189.       if (n->u.g != NULL)
  190.     n->u.g = (*fn) (n->u.g);
  191.     }
  192. }
  193.  
  194. /* ffename_space_drive_symbol -- Call given fn for each symbol in name space
  195.  
  196.    ffenameSpace ns;
  197.    ffesymbol (*fn)();
  198.    ffename_space_drive_symbol(ns,fn);  */
  199.  
  200. void
  201. ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) ())
  202. {
  203.   ffename n;
  204.  
  205.   if (ns == NULL)
  206.     return;
  207.  
  208.   for (n = ns->first; n != (ffename) &ns->first; n = n->next)
  209.     {
  210.       if (n->u.s != NULL)
  211.     n->u.s = (*fn) (n->u.s);
  212.     }
  213. }
  214.  
  215. /* ffename_space_kill -- Kill name space
  216.  
  217.    ffenameSpace ns;
  218.    ffename_space_kill(ns);
  219.  
  220.    Removes the names from the name space; kills the name space.     */
  221.  
  222. void
  223. ffename_space_kill (ffenameSpace ns)
  224. {
  225.   assert (ns != NULL);
  226.  
  227.   while (ns->first != (ffename) &ns->first)
  228.     ffename_kill (ns, ns->first);
  229.  
  230.   malloc_kill_ks (ns->pool, ns, sizeof (*ns));
  231. }
  232.  
  233. /* ffename_space_new -- Create name space
  234.  
  235.    ffenameSpace ns;
  236.    ns = ffename_space_new(malloc_pool_image());
  237.  
  238.    Create new name space.  */
  239.  
  240. ffenameSpace
  241. ffename_space_new (mallocPool pool)
  242. {
  243.   ffenameSpace ns;
  244.  
  245.   ns = (ffenameSpace) malloc_new_ks (pool, "FFENAME space",
  246.                      sizeof (*ns));
  247.   ns->first = (ffename) &ns->first;
  248.   ns->last = (ffename) &ns->first;
  249.   ns->pool = pool;
  250.  
  251.   return ns;
  252. }
  253.