1 /*
2 * Copyright (c) 1993-2018, NVIDIA CORPORATION. All rights reserved.
3 *
4 * Licensed under the Apache License, Version 2.0 (the "License");
5 * you may not use this file except in compliance with the License.
6 * You may obtain a copy of the License at
7 *
8 * http://www.apache.org/licenses/LICENSE-2.0
9 *
10 * Unless required by applicable law or agreed to in writing, software
11 * distributed under the License is distributed on an "AS IS" BASIS,
12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 * See the License for the specific language governing permissions and
14 * limitations under the License.
15 *
16 */
17
18 /**
19 \file
20 \brief FTN Semantic action routines to resolve symbol references as
21 to overloading class. This module hides the walking of hash chains
22 and overloading class checks.
23 */
24
25 #include "semsym.h"
26 #include "error.h"
27 #include "global.h"
28 #include "semant.h"
29 #include "xref.h"
30
31 SPTR
declref(SPTR sptr,SYMTYPE stype,int def)32 declref(SPTR sptr, SYMTYPE stype, int def)
33 {
34 SYMTYPE st;
35 SPTR sptr1;
36 SPTR first;
37
38 first = sptr;
39 do {
40 st = STYPEG(sptr);
41 if (st == ST_UNKNOWN)
42 goto return1; /* stype not set yet, set it */
43 if (stb.ovclass[st] == stb.ovclass[stype]) {
44 if (stype != st) {
45 if (def == 'd') {
46 /* Redeclare of intrinsic symbol is okay unless frozen */
47 if (IS_INTRINSIC(st)) {
48 sptr1 = newsym(sptr);
49 if (sptr1 != SPTR_NULL)
50 sptr = sptr1;
51 goto return1;
52 }
53 /* multiple declaration */
54 error(S_0044_Multiple_declaration_for_symbol_OP1, ERR_Severe,
55 gbl.lineno, SYMNAME(first), CNULL);
56 } else
57 /* illegal use of symbol */
58 error(S_0084_Illegal_use_of_symbol_OP1_OP2, ERR_Severe, gbl.lineno,
59 SYMNAME(first), CNULL);
60 break;
61 }
62 goto return2; /* found, return it */
63 }
64 sptr = HASHLKG(sptr);
65 } while (sptr && NMPTRG(sptr) == NMPTRG(first));
66
67 /* create new one if def or illegal use */
68 sptr = insert_sym(first);
69 return1:
70 STYPEP(sptr, stype);
71 return2:
72 if (flg.xref)
73 xrefput(sptr, def);
74 return sptr;
75 }
76
77 SPTR
declsym(SPTR sptr,SYMTYPE stype,bool errflg)78 declsym(SPTR sptr, SYMTYPE stype, bool errflg)
79 {
80 SYMTYPE st;
81 SPTR sptr1, first;
82
83 first = sptr;
84 do {
85 st = STYPEG(sptr);
86 if (st == ST_UNKNOWN)
87 goto return1; /* Brand new symbol, return it. */
88 if (st == ST_IDENT && stb.ovclass[st] == stb.ovclass[stype])
89 goto return1; /* Found sym in same overloading class */
90 if (stb.ovclass[st] == stb.ovclass[stype]) {
91 if (stype == st) {
92 /* Possible attempt to multiply define symbol */
93 if (errflg) {
94 error(S_0044_Multiple_declaration_for_symbol_OP1, ERR_Severe,
95 gbl.lineno, SYMNAME(first), CNULL);
96 break;
97 } else
98 goto return2;
99 } else {
100 /* Redeclare of intrinsic symbol is okay unless frozen */
101 if (IS_INTRINSIC(st)) {
102 if ((sptr1 = newsym(sptr)) != 0)
103 sptr = sptr1;
104 goto return1;
105 } else {
106 error(S_0043_Illegal_attempt_to_redefine_OP1_OP2, ERR_Severe,
107 gbl.lineno, "symbol", SYMNAME(first));
108 break;
109 }
110 }
111 }
112 sptr = HASHLKG(sptr);
113 } while (sptr && NMPTRG(sptr) == NMPTRG(first));
114
115 /* create new one if def or illegal use */
116 sptr = insert_sym(first);
117 return1:
118 STYPEP(sptr, stype);
119 return2:
120 if (flg.xref)
121 xrefput(sptr, 'd');
122 return sptr;
123 }
124
125 SPTR
refsym(SPTR sptr,int oclass)126 refsym(SPTR sptr, int oclass)
127 {
128 int st;
129 SPTR first;
130
131 first = sptr;
132 do {
133 st = STYPEG(sptr);
134 if (st == ST_UNKNOWN)
135 goto return1;
136 if (stb.ovclass[st] == oclass)
137 goto returnit;
138 sptr = HASHLKG(sptr);
139 } while (sptr && NMPTRG(sptr) == NMPTRG(first));
140
141 /* Symbol in given overloading class not found, create new one */
142 sptr = insert_sym(first);
143 return1:
144 if (flg.xref)
145 xrefput(sptr, 'd');
146 returnit:
147 return sptr;
148 }
149
150 SPTR
getocsym(SPTR sptr,int oclass)151 getocsym(SPTR sptr, int oclass)
152 {
153 int st;
154 SPTR first;
155
156 first = sptr;
157 do {
158 st = STYPEG(sptr);
159 if (st == ST_UNKNOWN)
160 goto return1;
161 if (stb.ovclass[st] == oclass)
162 goto returnit; /* found it! */
163 sptr = HASHLKG(sptr);
164 } while (sptr && NMPTRG(sptr) == NMPTRG(first));
165
166 /* create new symbol if undefined or illegal use */
167 sptr = insert_sym(first);
168 return1:
169 if (flg.xref)
170 xrefput(sptr, 'd');
171 returnit:
172 return sptr;
173 }
174
175 SPTR
newsym(SPTR sptr)176 newsym(SPTR sptr)
177 {
178 SPTR sp2;
179
180 if (EXPSTG(sptr)) {
181 /* Symbol previously frozen as an intrinsic */
182 error(S_0043_Illegal_attempt_to_redefine_OP1_OP2, ERR_Severe, gbl.lineno,
183 "intrinsic", SYMNAME(sptr));
184 return SPTR_NULL;
185 }
186 /*
187 * try to find another sym in the same overloading class; we need to
188 * try this first since there could be multiple occurrences of an
189 * intrinsic and therefore the sptr appears more than once in the
190 * semantic stack. E.g.,
191 * call sub (sin, sin)
192 * NOTE that in order for this to work we need to perform another getsym
193 * to start at the beginning of the hash links for symbols whose names
194 * are the same.
195 */
196 sp2 = getsym(LOCAL_SYMNAME(sptr), strlen(SYMNAME(sptr)));
197 sp2 = getocsym(sp2, OC_OTHER);
198 if (sp2 != sptr)
199 return sp2;
200 /*
201 * create a new symbol with the same name:
202 */
203 error(I_0035_Predefined_intrinsic_OP1_loses_intrinsic_property,
204 ERR_Informational, gbl.lineno, SYMNAME(sptr), CNULL);
205 sp2 = insert_sym(sptr);
206
207 /* transfer dtype if it was explicitly declared for sptr: */
208
209 if (DCLDG(sptr)) {
210 DTYPEP(sp2, DTYPEG(sptr));
211 DCLDP(sp2, 1);
212 }
213
214 return sp2;
215 }
216
217 SPTR
ref_ident(SPTR sptr)218 ref_ident(SPTR sptr)
219 {
220 SPTR sym;
221
222 sym = refsym(sptr, OC_OTHER);
223 if (IS_INTRINSIC(STYPEG(sym))) {
224 sym = newsym(sym);
225 if (sym == 0)
226 sym = insert_sym(sptr);
227 }
228 if (STYPEG(sym) == ST_UNKNOWN)
229 STYPEP(sym, ST_IDENT);
230
231 return sym;
232 }
233
234