1 /*
2  * Copyright (c) 1994-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 /** \file semstk.h
19  * Shared by Parser and Semantic Analyzer modules.
20  * This file contains semantic stack definitions and prototypes of functions
21  * that operate on the semantic stack.
22  */
23 
24 /*
25  * These two macros refer to the translation associated with the
26  * Left Hand Side non-terminal and the Right Hand Side elements
27  * numbers 1 to N
28  */
29 #define LHS top
30 #define RHS(i) (top + ((i)-1))
31 
32 /* stack size */
33 #define SST_SIZE 200
34 
35 /* INT members within the union portion of the stack entry need to be
36  * padded for systems, such as the decalpha, where ints are 32-bits and
37  * pointers are 64-bits.  We cannot have pointer members in the stack entry
38  * overlapping two INT members.
39  */
40 #define SST_INT(m) INT m
41 
42 typedef struct sst {
43   short id;           /**< type of this stack entry */
44   unsigned char flag; /**< general flag */
45   unsigned f1 : 1;    /**< plain expr flag - 0 => no parens */
46   unsigned f2 : 1;    /**< id is an alias */
47   int ast; /**< the AST for this stack entry */
48   int mnoff; /**< derived type flag & information */
49   int sr;    /**< save & restore word */
50   int lineno; /**< line number associated with this stack entry */
51   int col;    /**< column number associated with this stack entry */
52 
53   union { /**< value of this stack entry */
54     struct {/**< general purpose word value */
55       SST_INT(w1);
56       SST_INT(w2);
57       SST_INT(w3);
58       SST_INT(w4);
59       SST_INT(w5);
60     } wval;
61     struct {         /**< constructor value */
62       SST_INT(dum1); /**< needs wval.w1 */
63       SST_INT(dum2); /**< needs wval.w2 */
64       SST_INT(dum3); /**< needs wval.w3 */
65       SST_INT(dum4); /**< needs wval.w4 */
66       ACL *acl;
67     } cnval;
68     struct {         /**< equivalence item */
69       SST_INT(dum1); /**< needs wval.w1 (SYM)*/
70       SST_INT(substring);
71       SST_INT(offset);
72       SST_INT(subscript);
73     } eqvval;
74     struct {/**< item list value */
75       ITEM *beg;
76       ITEM *end;
77       SST_INT(count);
78     } ilval;
79     struct {/**< variable name list for initializers */
80       VAR *beg;
81       VAR *end;
82       SST_INT(count);
83     } vlval;
84     struct {/**< constant list for initializers */
85       ACL *beg;
86       ACL *end;
87       SST_INT(count);
88     } clval;
89     struct {      /**< derived type value */
90       ITEM *dum1; /**< needs ilval.beg */
91       ITEM *dum2; /**< needs ilval.end */
92       ITEM *beg;
93       ITEM *end;
94     } dtval;
95     struct {/**< vector slice triplet notation */
96       struct sst *next;
97       struct sst *e1;
98       struct sst *e2;
99       struct sst *e3;
100     } tlval;
101   } value;
102 } SST;
103 
104 extern SST *sst;
105 
106 /* ident put/get macros -- for all types */
107 #define SST_IDG(p) ((p)->id)
108 #define SST_IDP(p, v) ((p)->id = ((int)(v)))
109 
110 #define SST_FLAGG(p) ((p)->flag)
111 #define SST_FLAGP(p, v) ((p)->flag = ((int)(v)))
112 
113 #define SST_PARENG(p) ((p)->f1)
114 #define SST_PARENP(p, v) ((p)->f1 = ((int)(v)))
115 
116 #define SST_ALIASG(p) ((p)->f2)
117 #define SST_ALIASP(p, v) ((p)->f2 = (v))
118 
119 /* put/get macros for ast */
120 #define SST_ASTG(p) ((p)->ast)
121 #define SST_ASTP(p, v) ((p)->ast = (v))
122 
123 #define SST_MNOFFG(p) ((p)->mnoff)
124 #define SST_MNOFFP(p, v) ((p)->mnoff = (v))
125 
126 #define SST_DIMFLAGG(p) ((p)->mnoff)
127 #define SST_DIMFLAGP(p, v) ((p)->mnoff = (v))
128 
129 #define SST_TMPG(p) ((p)->sr)
130 #define SST_TMPP(p, v) ((p)->sr = (v))
131 
132 #define SST_LINENOG(p) ((p)->lineno)
133 #define SST_LINENOP(p, v) ((p)->lineno = (v))
134 
135 #define SST_COLUMNG(p) ((p)->col)
136 #define SST_COLUMNP(p, v) ((p)->col = (v))
137 
138 
139 /* put/get macros for expressions */
140 #define SST_OPTYPEG(p) ((p)->value.wval.w1)
141 #define SST_SYMG(p) ((p)->value.wval.w1)
142 #define SST_CVALG(p) ((p)->value.wval.w1)
143 #define SST_GDTYPEG(p) ((p)->value.wval.w2)
144 #define SST_DTYPEG(p) ((p)->value.wval.w2)
145 #define SST_GTYG(p) ((p)->value.wval.w3)
146 #define SST_LSYMG(p) ((p)->value.wval.w3)
147 #define SST_LENG(p) ((p)->value.wval.w3)
148 #define SST_ERRSYMG(p) ((p)->value.wval.w3)
149 #define SST_SHAPEG(p) ((p)->value.wval.w4)
150 #define SST_OPCG(p) ((p)->value.wval.w4)
151 #define SST_UNITG(p) ((p)->value.wval.w4)
152 #define SST_FIRSTG(p) ((p)->value.wval.w4)
153 #define SST_LASTG(p) ((p)->value.wval.w5)
154 #define SST_CVLENG(p) ((p)->value.wval.w5)
155 #define SST_CPLXPARTG ((p)->value.wval.w5)
156 #define SST_ACLG(p) ((p)->value.cnval.acl)
157 #define SST_SUBSCRIPTG(p) ((p)->value.eqvval.subscript)
158 #define SST_SUBSTRINGG(p) ((p)->value.eqvval.substring)
159 #define SST_OFFSETG(p) ((p)->value.eqvval.offset)
160 #define SST_NMLBEGG(p) ((p)->value.wval.w1)
161 #define SST_NMLENDG(p) ((p)->value.wval.w2)
162 #define SST_BEGG(p) ((p)->value.ilval.beg)
163 #define SST_ENDG(p) ((p)->value.ilval.end)
164 #define SST_COUNTG(p) ((p)->value.ilval.count)
165 #define SST_CLBEGG(p) ((p)->value.clval.beg)
166 #define SST_CLENDG(p) ((p)->value.clval.end)
167 #define SST_DBEGG(p) ((p)->value.dtval.beg)
168 #define SST_DENDG(p) ((p)->value.dtval.end)
169 #define SST_VLBEGG(p) ((p)->value.vlval.beg)
170 #define SST_VLENDG(p) ((p)->value.vlval.end)
171 #define SST_RNG1G(p) ((p)->value.wval.w1)
172 #define SST_RNG2G(p) ((p)->value.wval.w2)
173 #define SST_E1G(p) ((p)->value.tlval.e1)
174 #define SST_E2G(p) ((p)->value.tlval.e2)
175 #define SST_E3G(p) ((p)->value.tlval.e3)
176 /* for parsing acc routine */
177 #define SST_ROUTG(p) ((p)->value.wval.w3)
178 #define SST_DEVTYPEG(p) ((p)->value.wval.w2)
179 #define SST_DEVICEG(p) ((p)->value.wval.w2)
180 
181 #define SST_OPTYPEP(p, v) ((p)->value.wval.w1 = (v))
182 #define SST_SYMP(p, v) ((p)->value.wval.w1 = (v))
183 #define SST_CVALP(p, v) ((p)->value.wval.w1 = (v))
184 #define SST_GDTYPEP(p, v) ((p)->value.wval.w2 = (v))
185 #define SST_DTYPEP(p, v) ((p)->value.wval.w2 = (v))
186 #define SST_GTYP(p, v) ((p)->value.wval.w3 = (v))
187 #define SST_LSYMP(p, v) ((p)->value.wval.w3 = (v))
188 #define SST_LENP(p, v) ((p)->value.wval.w3 = (v))
189 #define SST_ERRSYMP(p, v) ((p)->value.wval.w3 = (v))
190 #define SST_SHAPEP(p, v) ((p)->value.wval.w4 = (v))
191 #define SST_OPCP(p, v) ((p)->value.wval.w4 = (v))
192 #define SST_UNITP(p, v) ((p)->value.wval.w4 = (v))
193 #define SST_FIRSTP(p, v) ((p)->value.wval.w4 = (v))
194 #define SST_LASTP(p, v) ((p)->value.wval.w5 = (v))
195 #define SST_CVLENP(p, v) ((p)->value.wval.w5 = (v))
196 #define SST_CPLXPARTP(p, v) ((p)->value.wval.w5 = (v))
197 #define SST_ACLP(p, v) ((p)->value.cnval.acl = (v))
198 #define SST_SUBSCRIPTP(p, v) ((p)->value.eqvval.subscript = (v))
199 #define SST_SUBSTRINGP(p, v) ((p)->value.eqvval.substring = (v))
200 #define SST_OFFSETP(p, v) ((p)->value.eqvval.offset = (v))
201 #define SST_NMLBEGP(p, v) ((p)->value.wval.w1 = (v))
202 #define SST_NMLENDP(p, v) ((p)->value.wval.w2 = (v))
203 #define SST_BEGP(p, v) ((p)->value.ilval.beg = (v))
204 #define SST_ENDP(p, v) ((p)->value.ilval.end = (v))
205 #define SST_COUNTP(p, v) ((p)->value.ilval.count = (v))
206 #define SST_CLBEGP(p, v) ((p)->value.clval.beg = (v))
207 #define SST_CLENDP(p, v) ((p)->value.clval.end = (v))
208 #define SST_DBEGP(p, v) ((p)->value.dtval.beg = (v))
209 #define SST_DENDP(p, v) ((p)->value.dtval.end = (v))
210 #define SST_VLBEGP(p, v) ((p)->value.vlval.beg = (v))
211 #define SST_VLENDP(p, v) ((p)->value.vlval.end = (v))
212 #define SST_RNG1P(p, v) ((p)->value.wval.w1 = (v))
213 #define SST_RNG2P(p, v) ((p)->value.wval.w2 = (v))
214 #define SST_E1P(p, v) ((p)->value.tlval.e1 = (v))
215 #define SST_E2P(p, v) ((p)->value.tlval.e2 = (v))
216 #define SST_E3P(p, v) ((p)->value.tlval.e3 = (v))
217 /* for parsing acc routine */
218 #define SST_ROUTP(p, v) ((p)->value.wval.w3 = (v))
219 #define SST_DEVTYPEP(p, v) ((p)->value.wval.w2 = (v))
220 #define SST_DEVICEP(p, v) ((p)->value.wval.w2 = (v))
221 
222 #define SST_ISNONDECC(p)    \
223   (SST_IDG(p) == S_CONST && \
224    (SST_DTYPEG(p) == DT_WORD || SST_DTYPEG(p) == DT_HOLL))
225 
226 /* Functions that would be declared in semant.h but have SST in their
227  * signatures are declared here instead.
228  */
229 
230 void semant1(int rednum, SST *top); /* semant.c */
231 void semant2(int rednum, SST *top); /* semant2.c */
232 void semant3(int rednum, SST *top); /* semant3.c */
233 
234 void psemant1(int rednum, SST *top);  /* psemant.c */
235 void psemant2(int rednum, SST *top);  /* psemant2.c */
236 void psemant3(int rednum, SST *top);  /* psemant3.c */
237 void psemantio(int rednum, SST *top); /* psemantio.c */
238 void psemsmp(int rednum, SST *top);   /* psemsmp.c */
239 void semantio(int rednum, SST *top);  /* semantio.c */
240 
241 /* semfunc.c */
242 int func_call2(SST *stktop, ITEM *list, int flag);
243 int func_call(SST *stktop, ITEM *list);
244 int ptrfunc_call(SST *stktop, ITEM *list);
245 void subr_call2(SST *stktop, ITEM *list, int flag);
246 void subr_call(SST *stktop, ITEM *list);
247 void ptrsubr_call(SST *stktop, ITEM *list);
248 void cuda_call(SST *stktop, ITEM *list, ITEM *chevlist);
249 int ref_intrin(SST *stktop, ITEM *list);
250 int ref_pd(SST *stktop, ITEM *list);
251 
252 /* semfunc2.c */
253 int define_stfunc(int sptr, ITEM *argl, SST *estk);
254 int ref_stfunc(SST *stktop, ITEM *args);
255 int mkarg(SST *stkptr, int *dtype);
256 int chkarg(SST *stkptr, int *dtype);
257 int tempify(SST *stkptr);
258 
259 /* semutil.c */
260 void constant_lvalue(SST *);
261 INT chkcon(SST *, int, LOGICAL);
262 ISZ_T chkcon_to_isz(SST *, LOGICAL);
263 INT chktyp(SST *, int, LOGICAL);
264 INT chk_scalartyp(SST *, int, LOGICAL);
265 INT chk_scalar_inttyp(SST *, int, char *);
266 INT chk_arr_extent(SST *, char *);
267 INT chksubscr(SST *, int);
268 int casttyp(SST *, int);
269 void cngtyp(SST *, DTYPE);
270 void cngshape(SST *, SST *);
271 LOGICAL chkshape(SST *, SST *, LOGICAL);
272 int chklog(SST *);
273 void mkident(SST *);
274 int mkexpr(SST *);
275 int mkexpr1(SST *);
276 int mkexpr2(SST *);
277 void mklogint4(SST *);
278 int mklvalue(SST *, int);
279 int mkvarref(SST *, ITEM *);
280 LOGICAL is_sst_const(SST *);
281 INT get_sst_cval(SST *);
282 LOGICAL is_varref(SST *);
283 int chksubstr(SST *, ITEM *);
284 void ch_substring(SST *, SST *, SST *);
285 int fix_term(SST *, int);
286 int assign(SST *, SST *);
287 int assign_pointer(SST *, SST *);
288 void chkopnds(SST *, SST *, SST *);
289 void unop(SST *, SST *, SST *);
290 void binop(SST *, SST *, SST *, SST *);
291 char *prtsst(SST *);
292 int mklabelvar(SST *);
293 
294 /* semutil2.c */
295 void construct_acl_for_sst(SST *, DTYPE);
296 void dinit_struct_param(SPTR, ACL *, DTYPE);
297 VAR *dinit_varref(SST *);
298 int sem_tempify(SST *);
299 int check_etmp(SST *);
300 
301 /* semsmp.c */
302 void semsmp(int rednum, SST *top);
303 int mk_storage(int sptr, SST *stkp);
304 extern LOGICAL validate_omp_atomic(SST*, SST*);
305 extern int do_openmp_atomics(SST*, SST*);
306 
307 /* semgnr.c */
308 int generic_tbp_call(int gnr, SST *stktop, ITEM *list, ITEM *chevlist);
309 void generic_call(int gnr, SST *stktop, ITEM *list, ITEM *chevlist);
310 int generic_tbp_func(int gnr, SST *stktop, ITEM *list);
311 int generic_func(int gnr, SST *stktop, ITEM *list);
312 int defined_operator(int opr, SST *stktop, SST *lop, SST *rop);
313 LOGICAL is_intrinsic_opr(int val, SST *stktop, SST *lop, SST *rop,
314                          int tkn_alias);
315 int resolve_defined_io(int read_or_write, SST *stktop, ITEM *list);
316