1/* lab.c -- Implementation File (module.c template V1.0)
2   Copyright (C) 1995 Free Software Foundation, Inc.
3   Contributed by James Craig Burley.
4
5This file is part of GNU Fortran.
6
7GNU Fortran is free software; you can redistribute it and/or modify
8it under the terms of the GNU General Public License as published by
9the Free Software Foundation; either version 2, or (at your option)
10any later version.
11
12GNU Fortran is distributed in the hope that it will be useful,
13but WITHOUT ANY WARRANTY; without even the implied warranty of
14MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15GNU General Public License for more details.
16
17You should have received a copy of the GNU General Public License
18along with GNU Fortran; see the file COPYING.  If not, write to
19the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
2002111-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
42ffelab ffelab_list_;
43ffelabNumber 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
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
76ffelab
77ffelab_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
96void
97ffelab_finish ()
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
117void
118ffelab_init_3 ()
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
138ffelab
139ffelab_new (ffelabValue v)
140{
141  ffelab l;
142
143  ++ffelab_num_news_;
144  l = (ffelab) malloc_new_ks (ffe_pool_any_unit (), "FFELAB label", sizeof (*l));
145  l->next = ffelab_list_;
146#ifdef FFECOM_labelHOOK
147  l->hook = FFECOM_labelNULL;
148#endif
149  l->value = v;
150  l->firstref_line = ffewhere_line_unknown ();
151  l->firstref_col = ffewhere_column_unknown ();
152  l->doref_line = ffewhere_line_unknown ();
153  l->doref_col = ffewhere_column_unknown ();
154  l->definition_line = ffewhere_line_unknown ();
155  l->definition_col = ffewhere_column_unknown ();
156  l->type = FFELAB_typeUNKNOWN;
157  ffelab_list_ = l;
158  return l;
159}
160