1 /*
2 * Copyright (c) 1994-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 FIXME: get rid of this "important notice" and proliferating copies.
20
21 I M P O R T A N T N O T I C E
22 Do not modify this file if it resides in the
23 directory src -- modify the copy which is in
24 ../utils/symtab and then run copy.sh
25
26 ********************************************************/
27 /**
28 \file
29 \brief Generic access module. Used by all compilers and
30 initialization utility.
31 */
32
33 /* FIXME: This file is compiled with different gbldefs.h included
34 depending on in which part of the build it is recompiled. */
35 #include "symacc.h"
36 #include "error.h"
37 #include <stdarg.h>
38
39 #ifndef STANDARD_MAXIDLEN
40 #define STANDARD_MAXIDLEN MAXIDLEN
41 #endif
42
43 extern STB stb;
44 extern GBL gbl;
45 static char buff[132];
46
47 void
sym_init_first(void)48 sym_init_first(void)
49 {
50 int i;
51
52 int sizeof_SYM = sizeof(SYM) / sizeof(INT);
53 assert(sizeof_SYM == 36, "bad SYM size", sizeof_SYM, ERR_Fatal);
54
55 if (stb.stg_base == NULL) {
56 STG_ALLOC(stb, 1000);
57 assert(stb.stg_base, "sym_init: no room for symtab", stb.stg_size,
58 ERR_Fatal);
59 stb.n_size = 5024;
60 NEW(stb.n_base, char, stb.n_size);
61 assert(stb.n_base, "sym_init: no room for namtab", stb.n_size, ERR_Fatal);
62 stb.n_base[0] = 0;
63 STG_ALLOC(stb.dt, 400);
64 assert(stb.dt.stg_base, "sym_init: no room for dtypes", stb.dt.stg_size,
65 ERR_Fatal);
66 /* basically, this is sidecar of dt_base */
67
68 stb.w_size = 32;
69 NEW(stb.w_base, INT, stb.w_size);
70 assert(stb.w_base, "sym_init: no room for wtab", stb.w_size, ERR_Fatal);
71 }
72 /* allocate deepcopy info */
73
74 stb.namavl = 1;
75 stb.wrdavl = 0;
76 for (i = 0; i <= HASHSIZE; i++)
77 stb.hashtb[i] = SPTR_NULL;
78
79 }
80
81 /** \brief Expand symbol storage area when NEWSYM runs out of area.
82
83 It is assumed that stb.stg_avail is 1 more than the index of the current
84 symbol being created. */
85 void
realloc_sym_storage()86 realloc_sym_storage()
87 {
88 DEBUG_ASSERT(stb.stg_avail > stb.stg_size,
89 "realloc_sym_storage: call only if necessary");
90 if (stb.stg_avail > SPTR_MAX + 1 || stb.stg_base == NULL)
91 symini_errfatal(7);
92 /* Use unsigned arithmetic to avoid risk of overflow. */
93 DEBUG_ASSERT(stb.stg_size > 0,
94 "realloc_sym_storage: symbol storage not initialized?");
95 STG_NEED(stb);
96 DEBUG_ASSERT(stb.stg_avail <= stb.stg_size,
97 "realloc_sym_storage: internal error");
98 }
99
100 /**
101 \brief Look up symbol with indicated name.
102 \return If there is already such a symbol, the pointer to the
103 existing symbol table entry; or 0 if a symbol doesn't exist.
104 \param name is a symbol name.
105 \param olength is the number of characters in the symbol name.
106 */
107 SPTR
lookupsym(const char * name,int olength)108 lookupsym(const char *name, int olength)
109 {
110 int length;
111 SPTR sptr; /* pointer to symbol table entry */
112 INT hashval; /* index into hashtb. */
113
114 /*
115 * Loop thru the appropriate hash link list to see if symbol is
116 * already in the table:
117 */
118
119 length = olength;
120 if (length > MAXIDLEN) {
121 length = MAXIDLEN;
122 }
123 HASH_ID(hashval, name, length);
124 for (sptr = stb.hashtb[hashval]; sptr != 0; sptr = HASHLKG(sptr)) {
125 if (strncmp(name, SYMNAME(sptr), length) != 0 ||
126 *(SYMNAME(sptr) + length) != '\0')
127 continue;
128
129 /* matching entry has been found in symbol table. return it: */
130
131 return sptr;
132 }
133 return SPTR_NULL;
134 } /* lookupsym */
135
136 /** \brief Issue diagnostic for identifer that is too long.
137
138 \param name - identifier (without terminating njull)
139 \param olength - length of identifier
140 \param max_idlen - maximum allowed length
141
142 Though this routine has only one lexical call site, it is factored
143 out to not clutter the common path in installsym_ex.
144 */
145 static void
report_too_long_identifier(const char * name,int olength,int max_idlen)146 report_too_long_identifier(const char *name, int olength, int max_idlen)
147 {
148 static char *ebuf;
149 static int ebuf_sz = 0;
150 char len_buf[12];
151 if (ebuf_sz == 0) {
152 ebuf_sz = olength + 1;
153 NEW(ebuf, char, ebuf_sz);
154 } else {
155 int ii;
156 NEED(olength + 1, ebuf, char, ebuf_sz, olength + 1);
157 ii = strlen(ebuf);
158 if (ii < olength)
159 strcpy(ebuf + (ii - 2), "..."); /* there's room for at least 1 '.'*/
160 }
161 memcpy(ebuf, name, olength);
162 ebuf[olength] = '\0';
163 sprintf(len_buf, "%d", max_idlen);
164 symini_error(16, 2, gbl.lineno, ebuf, len_buf);
165 }
166
167 /**
168 \brief Get the symbol table index for a NUL-terminated name.
169 */
170 SPTR
lookupsymbol(const char * name)171 lookupsymbol(const char *name)
172 {
173 return lookupsym(name, strlen(name));
174 }
175
176 /**
177 \brief Construct a name via printf-style formatting and then
178 look it up in the symbol table via lookupsymbol().
179 */
180 SPTR
lookupsymf(const char * fmt,...)181 lookupsymf(const char *fmt, ...)
182 {
183 char buffer[MAXIDLEN + 1];
184 va_list ap;
185 va_start(ap, fmt);
186 vsnprintf(buffer, sizeof buffer - 1, fmt, ap);
187 va_end(ap);
188 buffer[sizeof buffer - 1] = '\0'; /* Windows workaround */
189 return lookupsymbol(buffer);
190 }
191
192 /**
193 \brief Enter symbol with indicated name into symbol table,
194 initialize the new entry, and return pointer to it. If there is
195 already such a symbol, just return pointer to the existing symbol
196 table entry.
197
198 \param name is the symbol name.
199 \param olength is the number of characters in the symbol name.
200 */
201 SPTR
installsym_ex(const char * name,int olength,IS_MODE mode)202 installsym_ex(const char *name, int olength, IS_MODE mode)
203 {
204 int length;
205 SPTR sptr; /* pointer to symbol table entry */
206 INT hashval; /* index into hashtb. */
207 bool toolong;
208 int nmptr;
209 static int max_idlen = MAXIDLEN;
210
211 /*
212 * Trim identifier if it is too long.
213 */
214 toolong = false;
215 length = olength;
216 if (flg.standard) {
217 max_idlen = 31;
218 }
219 if (length > max_idlen) {
220 length = max_idlen;
221 toolong = true;
222 }
223
224 nmptr = 0;
225 if (mode != IS_QUICK) {
226 /*
227 * Loop thru the appropriate hash link list to see if symbol is
228 * already in the table.
229 */
230 HASH_ID(hashval, name, length);
231 for (sptr = stb.hashtb[hashval]; sptr != 0; sptr = HASHLKG(sptr)) {
232 const char *sname;
233 int np = NMPTRG(sptr);
234 if (np + length >= stb.namavl)
235 continue;
236 sname = stb.n_base + np;
237 if (sname[0] != name[0] || sname[length] != '\0')
238 continue;
239 if (strncmp(name, sname, length) != 0)
240 continue;
241 nmptr = np;
242
243 /* Matching entry has been found in symbol table. Return it. */
244
245 return sptr;
246 }
247 }
248
249 /* Symbol not found. Create a new symbol table entry. */
250
251 NEWSYM(sptr);
252 if (mode != IS_QUICK) {
253 LINKSYM(sptr, hashval);
254 }
255
256 if (!nmptr)
257 nmptr = putsname(name, length);
258 NMPTRP(sptr, nmptr);
259 SYMLKP(sptr, NOSYM);
260 #ifdef LINENOP
261 LINENOP(sptr, gbl.lineno);
262 #endif
263
264 if (toolong) {
265 report_too_long_identifier(name, olength, max_idlen);
266 }
267
268 return sptr;
269 }
270
271 /**
272 \brief Put a string of characters into the symbol names storage
273 area and return pointer to the string (relative to
274 stb.n_base). This routine is used to enter both symbol names and
275 character string constants.
276
277 \param name are the characters to be entered.
278 \param length is the number of characters to be entered.
279 */
280 int
putsname(const char * name,int length)281 putsname(const char *name, int length)
282 {
283 int nptr; /* index into character storage area */
284 char *np; /* pointer into character storage area */
285 int i; /* counter */
286
287 nptr = stb.namavl;
288 stb.namavl += (length + 1);
289 while (stb.namavl > stb.n_size) {
290 /* To avoid quadratic behavior, we increase the storage area size
291 by a factor, not a constant. Use unsigned arithmetic here
292 to avoid risk of overflow. */
293 unsigned n = 2u * stb.n_size;
294 if (n > MAX_NMPTR) {
295 n = MAX_NMPTR;
296 if (stb.namavl > n)
297 symini_errfatal(7); /* names table overflow */
298 }
299 NEED(stb.namavl, stb.n_base, char, stb.n_size, n);
300 }
301 np = stb.n_base + nptr;
302 for (i = 0; i < length; i++)
303 *np++ = *name++;
304 *np = '\0';
305
306 return nptr;
307 }
308
309 /**
310 \brief Create a local copy of a name known to be stored in the 'stb.n_base'
311 area.
312
313 Used when a symbol needs to be created from a name stored in the
314 area; a purify umr error could occur if the area is realloc'd. The
315 char pointer to the copy is returned.
316 */
317 char *
local_sname(char * name)318 local_sname(char *name)
319 {
320 static char *safe_p;
321 static int safe_sz = 0;
322 int length;
323
324 length = strlen(name) + 2 + 6; /* MW: add one more character,
325 needed in semfunc2 */
326 /* Hongyon: add 6 more for
327 _cr and _nm for cref,nomixed */
328 if (safe_sz == 0) {
329 safe_sz = length + 100;
330 NEW(safe_p, char, safe_sz);
331 } else {
332 NEED(length, safe_p, char, safe_sz, length + 100);
333 }
334
335 strcpy(safe_p, name);
336
337 return safe_p;
338 }
339
340 void
add_fp_constants(void)341 add_fp_constants(void)
342 {
343 INT tmp[4];
344 INT res[4];
345
346 tmp[0] = 0;
347 atoxf("0.0", &tmp[1], 3);
348 /***** the f90 backend *****/
349 stb.flt0 = getcon(tmp, DT_REAL);
350 atoxf("1.0", &tmp[1], 3);
351 stb.flt1 = getcon(tmp, DT_REAL);
352 atoxf("2.0", &tmp[1], 3);
353 stb.flt2 = getcon(tmp, DT_REAL);
354 atoxf("0.5", &tmp[1], 3);
355 stb.flthalf = getcon(tmp, DT_REAL);
356
357 atoxd("0.0", &tmp[0], 3);
358 stb.dbl0 = getcon(tmp, DT_DBLE);
359 atoxd("1.0", &tmp[0], 3);
360 stb.dbl1 = getcon(tmp, DT_DBLE);
361 atoxd("2.0", &tmp[0], 3);
362 stb.dbl2 = getcon(tmp, DT_DBLE);
363 atoxd("0.5", &tmp[0], 3);
364 stb.dblhalf = getcon(tmp, DT_DBLE);
365
366 tmp[0] = 0;
367 res[0] = 0;
368 tmp[1] = CONVAL2G(stb.flt0);
369 xfneg(tmp[1], &res[1]);
370 stb.fltm0 = getcon(res, DT_REAL);
371 tmp[0] = CONVAL1G(stb.dbl0);
372 tmp[1] = CONVAL2G(stb.dbl0);
373 xdneg(tmp, res);
374 stb.dblm0 = getcon(res, DT_DBLE);
375
376 #ifdef LONG_DOUBLE_FLOAT128
377 atoxq("0.0", &tmp[0], 4);
378 stb.float128_0 = getcon(tmp, DT_FLOAT128);
379 xqneg(tmp, res);
380 stb.float128_m0 = getcon(res, DT_FLOAT128);
381 atoxq("1.0", &tmp[0], 4);
382 stb.float128_1 = getcon(tmp, DT_FLOAT128);
383 atoxq("0.5", &tmp[0], 4);
384 stb.float128_half = getcon(tmp, DT_FLOAT128);
385 atoxq("2.0", &tmp[0], 4);
386 stb.float128_2 = getcon(tmp, DT_FLOAT128);
387 #endif
388 }
389
390 bool
is_flt0(SPTR sptr)391 is_flt0(SPTR sptr)
392 {
393 if (sptr == stb.flt0 || sptr == stb.fltm0)
394 return true;
395 return false;
396 }
397
398 bool
is_dbl0(SPTR sptr)399 is_dbl0(SPTR sptr)
400 {
401 if (sptr == stb.dbl0 || sptr == stb.dblm0)
402 return true;
403 return false;
404 }
405
406 bool
is_quad0(SPTR sptr)407 is_quad0(SPTR sptr)
408 {
409 if (sptr == stb.quad0 || sptr == stb.quadm0)
410 return true;
411 return false;
412 }
413
414 #ifdef LONG_DOUBLE_FLOAT128
415 bool
is_float128_0(SPTR sptr)416 is_float128_0(SPTR sptr)
417 {
418 return sptr == stb.float128_0 || sptr == stb.float128_m0;
419 }
420 #endif /* LONG_DOUBLE_FLOAT128 */
421
422 bool
is_cmplx_flt0(SPTR sptr)423 is_cmplx_flt0(SPTR sptr)
424 {
425 if (CONVAL1G(sptr) == CONVAL2G(stb.flt0) ||
426 CONVAL1G(sptr) == CONVAL2G(stb.fltm0)) {
427 if (CONVAL2G(sptr) == CONVAL2G(stb.flt0) ||
428 CONVAL2G(sptr) == CONVAL2G(stb.fltm0)) {
429 return true;
430 }
431 }
432 return false;
433 }
434
435 bool
is_creal_flt0(SPTR sptr)436 is_creal_flt0(SPTR sptr)
437 {
438 if (CONVAL1G(sptr) == CONVAL2G(stb.flt0) ||
439 CONVAL1G(sptr) == CONVAL2G(stb.fltm0))
440 return true;
441 return false;
442 }
443
444 bool
is_cimag_flt0(SPTR sptr)445 is_cimag_flt0(SPTR sptr)
446 {
447 if (CONVAL2G(sptr) == CONVAL2G(stb.flt0) ||
448 CONVAL2G(sptr) == CONVAL2G(stb.fltm0))
449 return true;
450 return false;
451 }
452
453 bool
is_cmplx_dbl0(SPTR sptr)454 is_cmplx_dbl0(SPTR sptr)
455 {
456 return is_dbl0(SymConval1(sptr)) && is_dbl0(SymConval2(sptr));
457 }
458
459 bool
is_cmplx_quad0(SPTR sptr)460 is_cmplx_quad0(SPTR sptr)
461 {
462 return is_quad0(SymConval1(sptr)) && is_quad0(SymConval2(sptr));
463 }
464
465 void
symini_errfatal(int n)466 symini_errfatal(int n)
467 {
468 errfatal((error_code_t)n);
469 }
470
471 void
symini_error(int n,int s,int l,const char * c1,const char * c2)472 symini_error(int n, int s, int l, const char *c1, const char *c2)
473 {
474 error((error_code_t)n, (enum error_severity)s, l, c1, c2);
475 }
476
477 void
symini_interr(const char * txt,int val,int sev)478 symini_interr(const char *txt, int val, int sev)
479 {
480 char buff[8];
481
482 sprintf(buff, "%7d", val);
483 symini_error(0, sev, gbl.lineno, txt, buff);
484 }
485
486