contrib/gcc-3.4/gcc/f/lab.c

   1 /* lab.c -- Implementation File (module.c template V1.0)
   2    Copyright (C) 1995, 2003 Free Software Foundation, Inc.
   3    Contributed by James Craig Burley.
   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, 59 Temple Place - Suite 330, Boston, MA
  20 02111-1307, USA.
  21
  22    Related Modules:
  23
  24    Description:
  25       Complex data abstraction for Fortran labels.  Maintains a single master
  26       list for all labels; it is expected initialization and termination of
  27       this list will occur on program-unit boundaries.
  28
  29    Modifications:
  30       22-Aug-89  JCB  1.1
  31          Change ffelab_new for new ffewhere interface.
  32 */
  33
  34 /* Include files. */
  35
  36 #include "proj.h"
  37 #include "lab.h"
  38 #include "malloc.h"
  39
  40 /* Externals defined here. */
  41
  42 ffelab ffelab_list_;
  43 ffelabNumber ffelab_num_news_;
  44
  45 /* Simple definitions and enumerations. */
  46
  47
  48 /* Internal typedefs. */
  49
  50
  51 /* Private include files. */
  52
  53
  54 /* Internal structure definitions. */
  55
  56
  57 /* Static objects accessed by functions in this module. */
  58
  59
  60 /* Static functions (internal). */
  61
  62
  63 /* Internal macros. */
  64 \f
  65
  66 /* ffelab_find -- Find the ffelab object having the desired label value
  67
  68    ffelab l;
  69    ffelabValue v;
  70    l = ffelab_find(v);
  71
  72    If the desired ffelab object doesn't exist, returns NULL.
  73
  74    Straightforward search of list of ffelabs.  */
  75
  76 ffelab
  77 ffelab_find (ffelabValue v)
  78 {
  79   ffelab l;
  80
  81   for (l = ffelab_list_; (l != NULL) && (ffelab_value (l) != v); l = l->next)
  82     ;
  83
  84   return l;
  85 }
  86
  87 /* ffelab_finish -- Shut down label management
  88
  89    ffelab_finish();
  90
  91    At the end of processing a program unit, call this routine to shut down
  92    label management.
  93
  94    Kill all the labels on the list.  */
  95
  96 void
  97 ffelab_finish (void)
  98 {
  99   ffelab l;
 100   ffelab pl;
 101
 102   for (pl = NULL, l = ffelab_list_; l != NULL; pl = l, l = l->next)
 103     if (pl != NULL)
 104       malloc_kill_ks (ffe_pool_any_unit (), pl, sizeof (*pl));
 105
 106   if (pl != NULL)
 107     malloc_kill_ks (ffe_pool_any_unit (), pl, sizeof (*pl));
 108 }
 109
 110 /* ffelab_init_3 -- Initialize label management system
 111
 112    ffelab_init_3();
 113
 114    Initialize the label management system.  Do this before a new program
 115    unit is going to be processed.  */
 116
 117 void
 118 ffelab_init_3 (void)
 119 {
 120   ffelab_list_ = NULL;
 121   ffelab_num_news_ = 0;
 122 }
 123
 124 /* ffelab_new -- Create an ffelab object.
 125
 126    ffelab l;
 127    ffelabValue v;
 128    l = ffelab_new(v);
 129
 130    Create a label having a given value.  If the value isn't known, pass
 131    FFELAB_valueNONE, and set it later with ffelab_set_value.
 132
 133    Allocate, initialize, and stick at top of label list.
 134
 135    22-Aug-89  JCB  1.1
 136       Change for new ffewhere interface.  */
 137
 138 ffelab
 139 ffelab_new (ffelabValue v)
 140 {
 141   ffelab l;
 142
 143   ++ffelab_num_news_;
 144   l = malloc_new_ks (ffe_pool_any_unit (), "FFELAB label", sizeof (*l));
 145   l->next = ffelab_list_;
 146   l->hook = FFECOM_labelNULL;
 147   l->value = v;
 148   l->firstref_line = ffewhere_line_unknown ();
 149   l->firstref_col = ffewhere_column_unknown ();
 150   l->doref_line = ffewhere_line_unknown ();
 151   l->doref_col = ffewhere_column_unknown ();
 152   l->definition_line = ffewhere_line_unknown ();
 153   l->definition_col = ffewhere_column_unknown ();
 154   l->type = FFELAB_typeUNKNOWN;
 155   ffelab_list_ = l;
 156   return l;
 157 }