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
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
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
ffelab_find(ffelabValue v)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
ffelab_finish()97 ffelab_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
117 void
ffelab_init_3()118 ffelab_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
138 ffelab
ffelab_new(ffelabValue v)139 ffelab_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