1 /*
2  * Copyright (c) 2003-2019, 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 #ifndef SYMTAB_H_
19 #define SYMTAB_H_
20 
21 /**
22  *  \file
23  *  \brief symtab.h - symbol tab definitions for Fortran
24  */
25 
26 #include <universal.h>
27 
28 /* clang-format off */
29 .OC
30 
31 .ST
32 /* the following macro depends on stype ordering */
33 #define ST_ISVAR(s) ( ((s) >= ST_VAR && (s) <= ST_UNION) )
34 #define IS_PROC(st) ( (st) >= ST_ENTRY && (st) <= ST_PD )
35 .TY
36 
37 /*
38  * DT_MAX before adding DT_DEFERNCHAR & DT_DEFERCHAR
39  */
40 #define DT_MAX_43 43
41 
42 /*
43  * Target-dependent default integer, real, complex, and logical data types.
44  * Double and double complex as well, since they may be quad.
45  * These values are initialized in sym_init_first(); they need to be initialized
46  * for the symtab utility.  The target-dependent values are assigned in
47  * sym_init(); sym_init() has access to the flg structure.
48  */
49 
50 #define DT_INT stb.dt_int
51 #define DT_REAL stb.dt_real
52 #define DT_CMPLX stb.dt_cmplx
53 #define DT_LOG stb.dt_log
54 #define DT_DBLE stb.dt_dble
55 #define DT_DCMPLX stb.dt_dcmplx
56 #define DT_PTR stb.dt_ptr
57 
58 #define DT_FLOAT DT_REAL4
59 #define TY_FLOAT TY_REAL
60 #define DT_CPTR DT_ADDR
61 
62 
63 #define DTY(d) (stb.dt.stg_base[d])
64 
65 /* for fast DT checking -- define table indexed by TY_ */
66 extern short dttypes[TY_MAX+1];
67 .TA
68 
69 #define DDTG(dt) (DTY(dt) == TY_ARRAY ? DTY(dt+1) : dt)
70 #define DTYG(dt) (DTY(dt) == TY_ARRAY ? DTY(DTY(dt+1)) : DTY(dt))
71 
72 #define DT_ISCHAR(dt)	(dttypes[DTY(dt)]&(_TY_CHAR|_TY_NCHAR))
73 #define DT_ISINT(dt)	(dttypes[DTY(dt)]&_TY_INT)
74 #define DT_ISREAL(dt)	(dttypes[DTY(dt)]&_TY_REAL)
75 #define DT_ISCMPLX(dt)	(dttypes[DTY(dt)]&_TY_CMPLX)
76 #define DT_ISNUMERIC(dt) (dttypes[DTY(dt)]&(_TY_INT|_TY_REAL|_TY_CMPLX))
77 #define DT_ISBASIC(dt)	(dttypes[DTY(dt)]&_TY_BASIC)
78 #define DT_ISUNSIGNED(dt) (dttypes[DTY(dt)]&_TY_UNSIGNED)
79 #define DT_ISSCALAR(dt)	(dttypes[DTY(dt)]&_TY_SCALAR)
80 #define DT_ISVEC(dt)	(dttypes[DTY(dt)]&_TY_VEC)
81 #define DT_ISLOG(dt)	(dttypes[DTY(dt)]&_TY_LOG)
82 #define DT_ISWORD(dt)	(dttypes[DTY(dt)]&_TY_WORD)
83 #define DT_ISDWORD(dt)	(dttypes[DTY(dt)]&_TY_DWORD)
84 
85 #define DT_ISINT_ARR(dt)     (DTY(dt)==TY_ARRAY && DT_ISINT(DTY(dt+1)))
86 #define DT_ISREAL_ARR(dt)    (DTY(dt)==TY_ARRAY && DT_ISREAL(DTY(dt+1)))
87 #define DT_ISCMPLX_ARR(dt)   (DTY(dt)==TY_ARRAY && DT_ISCMPLX(DTY(dt+1)))
88 #define DT_ISNUMERIC_ARR(dt) (DTY(dt)==TY_ARRAY && DT_ISNUMERIC(DTY(dt+1)))
89 #define DT_ISLOG_ARR(dt)     (DTY(dt)==TY_ARRAY && DT_ISLOG(DTY(dt+1)))
90 
91 #define TY_ISCHAR(t)	(dttypes[t]&(_TY_CHAR|_TY_NCHAR))
92 #define TY_ISINT(t)	(dttypes[t]&_TY_INT)
93 #define TY_ISREAL(t)	(dttypes[t]&_TY_REAL)
94 #define TY_ISCMPLX(t)	(dttypes[t]&_TY_CMPLX)
95 #define TY_ISNUMERIC(t)	(dttypes[t]&(_TY_INT|_TY_REAL|_TY_CMPLX))
96 #define TY_ISBASIC(t)	(dttypes[t]&_TY_BASIC)
97 #define TY_ISUNSIGNED(t) (dttypes[t]&_TY_UNSIGNED)
98 #define TY_ISSCALAR(t)	(dttypes[t]&_TY_SCALAR)
99 #define TY_ISLOG(t)	(dttypes[t]&_TY_LOG)
100 #define TY_ISVEC(t)	(dttypes[t]&_TY_VEC)
101 #define TY_ISWORD(t)	(dttypes[t]&_TY_WORD)
102 #define TY_ISDWORD(t)	(dttypes[t]&_TY_DWORD)
103 
104 #define IS_CHAR_TYPE(t) (TY_ISCHAR(t))
105 
106 #define ALIGN(addr, a) ((addr + a) & ~(a))
107 #define ALIGN_AUTO(addr, a) ((addr) & ~(a))
108 
109 .Sc
110 
111 #define SC_AUTO SC_LOCAL
112 #define SC_ISCMBLK(p)  (p == SC_CMBLK)
113 #define CUDA_HOST             0x01
114 #define CUDA_DEVICE           0x02
115 #define CUDA_GLOBAL           0x04
116 #define CUDA_BUILTIN          0x08
117 #define CUDA_GRID             0x10
118 
119 #define INTENT_IN 0x1
120 #define INTENT_OUT 0x2
121 #define INTENT_INOUT 0x3
122 #define INTENT_DFLT 0x0
123 
124 #define IGNORE_T 0x1
125 #define IGNORE_K 0x2
126 #define IGNORE_R 0x4
127 #define IGNORE_D 0x8
128 /******          0x10 MARKER indicating IGNORE_TKR_ALL ******/
129 #define IGNORE_M 0x20
130 #define IGNORE_C 0x40
131 /* IGNORE_TKR directive without any specifiers, except for _C */
132 #define IGNORE_TKR_ALL 0x3f
133 #define IGNORE_TKR_ALL0 0x1f 	/* old value of IGNORE_TKR_ALL */
134 
135 #define DLL_NONE   0x0
136 #define DLL_EXPORT 0x1
137 #define DLL_IMPORT 0x2
138 
139 #define PRESCRIPTIVE  0
140 #define DESCRIPTIVE   1
141 #define TRANSCRIPTIVE 2
142 
143 .Ik
144 
145 #ifdef __cplusplus
check_SPTR(SPTR v)146 inline SPTR check_SPTR(SPTR v) { return v; }
check_DTYPE(DTYPE v)147 inline DTYPE check_DTYPE(DTYPE v) { return v; }
check_INT(INT v)148 inline INT check_INT(INT v) { return v; }
149 #else
150 #define check_SPTR(v) (v)
151 #define check_DTYPE(v) (v)
152 #define check_INT(v) (v)
153 #endif
154 
155 .SE
156 
157 /* Test for type-bound procedure */
158 #define IS_TBP(func)  (VTOFFG(func) && TBPLNKG(func))
159 
160 /* overloaded macros accessing shared fields */
161 
162 #define FORALLNDXG(s)    DOVARG(s)
163 #define FORALLNDXP(s,v)  DOVARP(s,v)
164 #define ACONOFFG(s)   (( stb.stg_base)[s].w14)
165 #define ACONOFFP(s,v) (( stb.stg_base)[s].w14 = (v))
166 #define INTENTG(s)    b3G(s)
167 #define INTENTP(s,v)  b3P(s,v)
168 #define DLLG(s)       b3G(s)
169 #define DLLP(s,v)     b3P(s,v)
170 #define PDALN_EXPLICIT_0 0xf
171 #define PDALNG(s)     (b4G(s) == PDALN_EXPLICIT_0 ? 0 : b4G(s))
172 #define PDALNP(s,v)   b4P(s, (v) == 0 ? PDALN_EXPLICIT_0 : (v))
173 #define PDALN_IS_DEFAULT(s) (b4G(s) == 0)
174 #define CUDAG(s)      b4G(s)
175 #define CUDAP(s,v)    b4P(s,v)
176 #define NEWDSCG(s)   (( stb.stg_base)[s].w10)
177 #define NEWDSCP(s,v) (( stb.stg_base)[s].w10 = (v))
178 #define ARGINFOG(s)   (( stb.stg_base)[s].w16)
179 #define ARGINFOP(s,v) (( stb.stg_base)[s].w16 = (v))
180 #define XREFLKG(s)   (( stb.stg_base)[s].w16)
181 #define XREFLKP(s,v) (( stb.stg_base)[s].w16 = (v))
182 
183 #define SYMNAME(p)        (stb.n_base + NMPTRG(p))
184 #define SYMNAMEG(p, buff, len)    len = NMLENG(p); strncpy(buff,SYMNAME(p),len)
185 #define LOCAL_SYMNAME(p) local_sname(SYMNAME(p))
186 #define RFCNTI(s) (++RFCNTG(s))
187 #define RFCNTD(s) (--RFCNTG(s))
188 #define KWDARGSTR(p) intrinsic_kwd[KWDARGG(p)]
189 #define NOSYM 1
190 
191 typedef enum{
192     ETLS_PROCESS,
193     ETLS_TASK,
194     ETLS_THREAD,
195     ETLS_OMP
196 } etls_levels;
197 #define IS_TLS(s) (TLSG(s) || ETLSG(s))
198 #define IS_THREAD_TLS(s) (THREADG(s) &&   IS_TLS(s))
199 #define IS_THREAD_TP(s)  (THREADG(s) && (!IS_TLS(s)))
200 
201 #define CMPLXFUNC_C XBIT(49, 0x40000000)
202 
203 /*****  Array Descriptor  *****/
204 
205 typedef struct {
206     int    numdim;
207     int    zbase;
208     char   pxx[3];	/* available flags */
209     char   assumshp;
210     char   defer;
211     char   adjarr;
212     char   assumsz;
213     char   nobounds;
214     struct {
215         int mlpyr;
216         int lwbd;
217         int upbd;
218 	int lwast;
219 	int upast;
220 	int extntast;
221     } b[1];
222 } ADSC;
223 
224 #define AD_DPTR(dtype) ((ADSC *)(aux.arrdsc_base+DTY((dtype)+2)))
225 #define AD_PTR(sptr) ((ADSC *) (aux.arrdsc_base + DTY(DTYPEG(sptr)+2)))
226 #define AD_NUMDIM(p)  ((p)->numdim)
227 #define AD_DEFER(p) ((p)->defer)
228 #define AD_ASSUMSHP(p) ((p)->assumshp)
229 #define AD_ADJARR(p) ((p)->adjarr)
230 #define AD_ASSUMSZ(p) ((p)->assumsz)
231 #define AD_NOBOUNDS(p) ((p)->nobounds)
232 #define AD_ZBASE(p)  ((p)->zbase)
233 #define AD_MLPYR(p, i) ((p)->b[i].mlpyr)
234 #define AD_LWBD(p, i)  ((p)->b[i].lwbd)
235 #define AD_UPBD(p, i)  ((p)->b[i].upbd)
236 #define AD_LWAST(p, i)  ((p)->b[i].lwast)
237 #define AD_UPAST(p, i)  ((p)->b[i].upast)
238 #define AD_EXTNTAST(p, i) ((p)->b[i].extntast)
239 #define AD_NUMELM(p)  ((p)->b[AD_NUMDIM(p)].mlpyr)
240 
241 /* Use the following macros instead of the AD_* macros when there is
242  * the possibility of memory reallocation following assignment of an
243  * array descriptor's address to a pointer. */
244 #define ADD_NUMDIM(dtyp)  AD_NUMDIM(AD_DPTR(dtyp))
245 #define ADD_DEFER(dtyp) AD_DEFER(AD_DPTR(dtyp))
246 #define ADD_ASSUMSHP(dtyp) AD_ASSUMSHP(AD_DPTR(dtyp))
247 #define ADD_ADJARR(dtyp) AD_ADJARR(AD_DPTR(dtyp))
248 #define ADD_ASSUMSZ(dtyp) AD_ASSUMSZ(AD_DPTR(dtyp))
249 #define ADD_NOBOUNDS(dtyp) AD_NOBOUNDS(AD_DPTR(dtyp))
250 #define ADD_ZBASE(dtyp)  AD_ZBASE(AD_DPTR(dtyp))
251 #define ADD_MLPYR(dtyp, i) AD_MLPYR(AD_DPTR(dtyp), i)
252 #define ADD_LWBD(dtyp, i)  AD_LWBD(AD_DPTR(dtyp), i)
253 #define ADD_UPBD(dtyp, i)  AD_UPBD(AD_DPTR(dtyp), i)
254 #define ADD_LWAST(dtyp, i)  AD_LWAST(AD_DPTR(dtyp), i)
255 #define ADD_UPAST(dtyp, i)  AD_UPAST(AD_DPTR(dtyp), i)
256 #define ADD_EXTNTAST(dtyp, i)  AD_EXTNTAST(AD_DPTR(dtyp), i)
257 #define ADD_NUMELM(dtyp)  AD_NUMELM(AD_DPTR(dtyp))
258 
259 typedef struct {
260     ISZ_T   stack_addr;	/* available address on run-time stack  */
261     int     ent_save;	/* sptr to cc array to hold saved ar's and excstat */
262     short   first_dr;	/* first data reg used as global  */
263     short   first_ar;	/* first address reg used as global  */
264     short   first_sp;	/* first float reg used as global  */
265     short   first_dp;	/* first double reg used as global  */
266     int     auto_array;	/* static array used for auto vars, else 0 */
267     int     ret_var;   	/* sym of return value if passed as arg */
268     int     memarg_ptr;	/* sym where memarg ptr is saved upon entry */
269     int     gr_area;	/* sym of where to save global regs */
270     int     flags;	/* misc. target dependent flags */
271     char   *arasgn;	/* local ar (base pointer) ARASGN records */
272     char   *regset;	/* target dependent register set info */
273     char   *argset;	/* target dependent register set info */
274     int     launch_maxthread, launch_minctasm;
275                         /* launch_bounds for CUDA Fortran. 0 means not set. */
276 } ENTRY;
277 
278 
279 /*****  Namelist Descriptor  *****/
280 
281 typedef struct {
282     int   sptr;
283     int   next;
284     int   lineno;
285 } NMLDSC;
286 
287 #define NML_SPTR(i)   aux.nml_base[i].sptr
288 #define NML_NEXT(i)   aux.nml_base[i].next
289 #define NML_LINENO(i) aux.nml_base[i].lineno
290 
291 
292 /*****  Symbol List Item  *****/
293 
294 typedef struct {
295     int   sptr;
296     int   next;
297 } SYMI;
298 
299 #define SYMI_SPTR(i) aux.symi_base[i].sptr
300 #define SYMI_NEXT(i) aux.symi_base[i].next
301 
302 /*
303  * Define macro which converts character into index into implicit array.
304  */
305 #define IMPL_INDEX(uc)  (islower(uc) ? uc - 'a' :      \
306 			   (isupper(uc) ? 26+(uc-'A') : \
307 			      (uc == '$'  ? 52 :              \
308 				 (uc == '_'  ?  53  : -1) )))
309 
310 typedef struct {
311     int    sptr;
312     INT    conval;
313 } DVL;
314 
315 #define DVL_SPTR(i)   aux.dvl_base[i].sptr
316 #define DVL_CONVAL(i) aux.dvl_base[i].conval
317 
318 typedef struct {
319    int    *dpdsc_base;
320    int     dpdsc_size;
321    int     dpdsc_avl;
322    int    *arrdsc_base;
323    int     arrdsc_size;
324    int     arrdsc_avl;
325    ENTRY  *entry_base;
326    int     entry_size;
327    int     entry_avail;
328    ENTRY  *curr_entry;
329    int     dt_iarray;
330    int     dt_iarray_int;
331    NMLDSC *nml_base;
332    int     nml_size;
333    int     nml_avl;
334    DVL    *dvl_base;
335    int     dvl_size;
336    int     dvl_avl;
337    int     list[ST_MAX+1];
338    SYMI   *symi_base;
339    int     symi_size;
340    int     symi_avl;
341    INT    *parsyms_base; /* Symbols in parallel regions */
342    int     parsyms_size;
343    int     parsyms_avl;
344 } AUX;
345 
346 #include "symacc.h"
347 
348 /*   symbol table data declarations:  */
349 
350 extern AUX aux;
351 
352 extern char *intrinsic_kwd[];
353 
354 /*  declarations required to access switch statement or computed goto lists: */
355 
356 typedef struct {
357     INT   val;
358     INT   uval;		/* val : uval, for CASE constructs */
359     SPTR  clabel;
360     int   next;
361 } SWEL;
362 
363 extern SWEL *switch_base;
364 
365 /*   declare external functions from symtab.c */
366 
367 void sym_init(void);
368 void init_implicit(void);
369 void implicit_int(int);
370 void save_implicit(LOGICAL);
371 void restore_implicit(void);
372 void hpf_library_stat(int *, int *, int);
373 SPTR getsym (const char *, int);
374 SPTR getsymbol (const char *);
375 SPTR getsymf(const char *, ...);
376 SPTR getcon(INT *, DTYPE);
377 SPTR get_acon(SPTR, ISZ_T);
378 SPTR get_acon3(SPTR, ISZ_T, DTYPE);
379 INT get_int_cval(int);
380 ISZ_T get_isz_cval(int);
381 INT sign_extend(INT, int);
382 int getstring(char *, int);
383 int gethollerith(int, int);
384 void newimplicit(int, int, int);
385 void setimplicit(int);
386 char *parmprint(int);
387 char *getprint(int);
388 void symdentry(FILE *, int);
389 void symdmp(FILE *, LOGICAL);
390 void dmp_socs(int, FILE *);
391 int getccsym(int, int, SYMTYPE);
392 int getnewccsym(int, int, int);
393 int getnewccsymf(int stype, const char *, ...);
394 int getccsym_sc(int, int, int, int);
395 int getccssym(const char *, int, int);
396 int getccssym_sc(const char *, int, int, int);
397 int getcctmp(int, int, int, int);
398 int getcctmp_sc(int, int, int, int, int);
399 int insert_sym(int);
400 int getlab(void);
401 void pop_sym(int);
402 SPTR mkfunc(const char *);
403 SPTR mkfunc_cncall(const char *);
404 char *mkfunc_name(int, char *);
405 char *mkfunc_ir8name(int, char *, int);
406 char *ir8name(char *, int);
407 char *mk_coercion_func_name(int);
408 int mk_coercion_func(int);
409 int mk_external_var(char *, int);
410 LOGICAL is_arg_in_entry(int, int);
411 int resolve_sym_aliases(int);
412 LOGICAL is_procedure_ptr(int);
413 void proc_arginfo(int, int *, int *, int *);
414 void dup_sym(int, struct SYM *);
415 int insert_dup_sym(int);
416 int get_align_desc(int, int);
417 void dump_align(FILE*, int);
418 int copy_align_desc(int);
419 int copy_dist_desc(int);
420 int get_dist_desc(int);
421 void dump_dist(FILE*, int);
422 int get_shadow_desc(int);
423 void dump_shadow(FILE*, int);
424 char *mangle_name(char *, char *);
425 char *sym_strsave(char *);
426 void save_uname(int, INT);
427 int add_symitem(int, int);
428 void change_predefineds(int, LOGICAL);
429 SPTR find_explicit_interface(SPTR s);
430 void convert_2dollar_signs_to_hyphen(char *name);
431 
432 char *getsname(int);	/* defined in assem.c */
433 void sym_is_refd(SPTR);	/* defined in assem.c */
434 
435 void iso_c_lib_stat(int *, int *, int);
436 int get_ieee_arith_intrin(char *);
437 void symtab_standard(void);
438 void symtab_nostandard(void);
439 void newimplicitnone(void);
440 void reinit_sym(int);
441 void symtab_fini(void);
442 int get_len_of_deferchar_ast(int ast); /* symutl.c */
443 SPTR get_proc_ptr(SPTR sptr); /* symutl.c */
444 
445 LOGICAL sym_in_sym_list(int sptr, int symi);
446 LOGICAL same_sym_list(int list1, int list2);
447 void push_sym(int sptr);
448 void init_implicit(void);
449 void implicit_int(int default_int);
450 bool cmp_interfaces(int sym1, int sym2, int flag);
451 void dmp_socs(int sptr, FILE *file);
452 
453 #define ALIGNG(sptr)	0
454 #define DISTG(sptr)	0
455 #define RUNTIMEG(sptr)	0
456 #define INHERITG(sptr)	0
457 
458 /**
459  * \brief flag defintions for cmp_interfaces_strict()
460  */
461 typedef enum CMP_INTERFACE_FLAGS {
462   IGNORE_IFACE_NAMES = 0x0, /**< ignore the symbol names sym1 & sym2, but make
463                                  sure arguments have same stypes and names. */
464   CMP_IFACE_NAMES = 0x1, /**< make sure sym1 and sym2 have the same symbol
465                               name. */
466   IGNORE_ARG_NAMES = 0x2, /**< ignore the argument names. */
467   RELAX_STYPE_CHK = 0x4, /**< relax stype check on arguments. */
468   CMP_OPTARG = 0x8, /**< make sure sym1 and sym2 OPTARG fields are identical. */
469   RELAX_INTENT_CHK = 0x10, /**< relax intent check on arguments. */
470   RELAX_POINTER_CHK = 0x20, /**< relax pointer check on arguments. */
471 
472   RELAX_PURE_CHK_1 = 0x40, /**< relax pure check on argument #1 of
473                                 cmp_interfaces_strict() function */
474   RELAX_PURE_CHK_2 = 0x80,  /**< relax pure check on argument #2 of
475                                 cmp_interfaces_strict() function */
476   CMP_SUBMOD_IFACE = 0x100, /**< make sure submodule interface of a procedure
477                                  defined by a separate module subprogram's
478                                  definition matches the declaration */
479   DEFER_IFACE_CHK = 0x200   /**< defer interface check for procedure dummy
480                                  arguments. */
481 } cmp_interface_flags;
482 
483 bool compatible_characteristics(int psptr, int psptr2,
484                                 cmp_interface_flags flag);
485 bool cmp_interfaces_strict(SPTR sym1, SPTR sym2, cmp_interface_flags flag);
486 bool is_used_by_submod(SPTR sym1, SPTR sym2);
487 
488 #endif // SYMTAB_H_
489