1 /*
2 * Copyright (c) 2016-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 Provides the front-end access to the run time library structure
19 * defined in rte_rtns.h
20 */
21
22 #include <string.h>
23 #include "gbldefs.h"
24 #include "global.h"
25 #include "error.h"
26 #include "rtlRtnsDesc.h"
27 #include "rtlRtns.h"
28
29 /* NOTE: within each section (E.g., NO RTN to END_OF_PFX_F90,
30 * END_OF_PFX_F90+1 to ...) the ftnRtlRtns entries must be sorted on the
31 * baseNm field.
32 */
33 FtnRteRtn ftnRtlRtns[] = {
34 {"NO RTN", "", false, ""},
35 {"achara", "", false, ""},
36 {"addr_1_dim_1st_elem", "", true, ""},
37 {"adjustla", "", false, ""},
38 {"adjustra", "", false, ""},
39 {"alloca", "", true, "k"},
40 {"alloc03a", "", true, ""},
41 {"alloc03_chka", "", true, ""},
42 {"alloc04a", "", true, ""},
43 {"alloc04_chka", "", true, ""},
44 {"alloc04_chkma", "", true, ""},
45 {"alloc04_chkpa", "", true, ""},
46 {"alloc04ma", "", true, ""},
47 {"alloc04pa", "", true, ""},
48 {"allocated", "", true, "k"},
49 {"allocated2", "", true, "k"},
50 {"allocated_lhs", "", true, "k"},
51 {"allocated_lhs2", "", true, "k"},
52 {"amodulev", "", false, ""},
53 {"amodulov", "", false, ""},
54 {"asn_closure", "", true, ""},
55 {"auto_alloc", "", true, ""},
56 {"auto_alloc04", "", true, ""},
57 {"auto_alloc04m", "", true, ""},
58 {"auto_alloc04p", "", true, ""},
59 {"auto_allocv", "", false, ""},
60 {"auto_calloc", "", true, ""},
61 {"auto_calloc04", "", true, ""},
62 {"auto_calloc04m", "", true, ""},
63 {"auto_calloc04p", "", true, ""},
64 {"auto_dealloc", "", true, ""},
65 {"auto_deallocm", "", true, ""},
66 {"auto_deallocp", "", true, ""},
67 {"c_f_procptr", "", false, ""},
68 {"c_f_ptr", "", true, ""},
69 {"calloc03a", "", true, ""},
70 {"calloc04a", "", true, ""},
71 {"calloc04ma", "", true, ""},
72 {"calloc04pa", "", true, ""},
73 {"ceiling", "", false, "k"},
74 {"ceilingv", "", false, "k"},
75 {"class_obj_size", "", true, ""},
76 {"cmd_arg_cnt", "", false, "k"},
77 {"cmplx16", "", false, ""},
78 {"cmplx32", "", false, ""},
79 {"cmplx8", "", false, ""},
80 {"conformable", "", false, ""},
81 {"conformable_11v", "", true, ""},
82 {"conformable_1dv", "", true, ""},
83 {"conformable_22v", "", true, ""},
84 {"conformable_2dv", "", true, ""},
85 {"conformable_33v", "", true, ""},
86 {"conformable_3dv", "", true, ""},
87 {"conformable_d1v", "", true, ""},
88 {"conformable_d2v", "", true, ""},
89 {"conformable_d3v", "", true, ""},
90 {"conformable_dd", "", true, ""},
91 {"conformable_dnv", "", true, ""},
92 {"conformable_ndv", "", true, ""},
93 {"conformable_nnv", "", true, ""},
94 {"contigchk", "", true, ""},
95 {"contigerror", "", true, ""},
96 {"copy_f77_argl", "", true, ""},
97 {"copy_f77_argsl", "", true, ""},
98 {"copy_f90_argl", "", true, ""},
99 {"copy_proc_desc", "", true, ""},
100 {"dble", "", false, ""},
101 {"dceiling", "", false, "k"},
102 {"dceilingv", "", false, "k"},
103 {"dealloca", "", true, ""},
104 {"dealloc03a", "", true, ""},
105 {"dealloc03ma", "", true, ""},
106 {"dealloc03pa", "", true, ""},
107 {"dealloc_mbr03a", "", true, ""},
108 {"dealloc_mbr03ma", "", true, ""},
109 {"dealloc_mbr03pa", "", true, ""},
110 {"dealloc_poly03", "", true, ""},
111 {"dealloc_poly_mbr03a", "", true, ""},
112 {"deallocx", "", true, ""},
113 {"dfloor", "", false, "k"},
114 {"dfloorv", "", false, "k"},
115 {"dmodulev", "", false, ""},
116 {"dmodulov", "", false, ""},
117 {"errorstop08a_char", "", false, ""},
118 {"errorstop08a_int", "", false, ""},
119 {"exit", "", false, ""},
120 {"expon", "", false, "k"},
121 {"expond", "", false, "k"},
122 {"expondx", "", false, "k"},
123 {"exponx", "", false, "k"},
124 {"extends_type_of", "", true, "k"},
125 {"finalize", "", true, ""},
126 {"floor", "", false, "k"},
127 {"floorv", "", false, "k"},
128 {"frac", "", false, ""},
129 {"fracd", "", false, ""},
130 {"fracdx", "", false, ""},
131 {"fracx", "", false, ""},
132 {"get_cmda", "", false, ""},
133 {"get_cmd_arga", "", false, ""},
134 {"get_env_vara", "", false, ""},
135 {"hypot", "", false, ""},
136 {"hypotd", "", false, ""},
137 {"i8modulov", "", true, ""},
138 {"iachara", "", false, "k"},
139 {"ichar", "", false, "k"},
140 {"imodulov", "", false, ""},
141 {"indexa", "", false, "k"},
142 {"init_from_desc", "", true, ""},
143 {"init_unl_poly_desc", "", true, ""},
144 {"int", "", false, ""},
145 {"int1", "", false, ""},
146 {"int2", "", false, ""},
147 {"int4", "", false, ""},
148 {"int8", "", false, ""},
149 {"is_contiguous", "", true, ""},
150 {"is_iostat_end", "", false, "k"},
151 {"is_iostat_eor", "", false, "k"},
152 {"kexpondx", "", false, ""},
153 {"ksize", "", true, ""},
154 {"lb", "", true, "k"},
155 {"lb1", "", true, ""},
156 {"lb2", "", true, ""},
157 {"lb4", "", true, ""},
158 {"lb8", "", true, ""},
159 {"lba", "", true, "k"},
160 {"lba1", "", true, ""},
161 {"lba2", "", true, ""},
162 {"lba4", "", true, ""},
163 {"lba8", "", true, ""},
164 {"lbaz", "", true, "k"},
165 {"lbaz1", "", true, ""},
166 {"lbaz2", "", true, ""},
167 {"lbaz4", "", true, ""},
168 {"lbaz8", "", true, ""},
169 {"lbound", "", false, "k"},
170 {"lbound1", "", true, ""},
171 {"lbound2", "", true, ""},
172 {"lbound4", "", true, ""},
173 {"lbound8", "", true, ""},
174 {"lbounda", "", false, "k"},
175 {"lbounda1", "", false, ""},
176 {"lbounda2", "", false, ""},
177 {"lbounda4", "", false, ""},
178 {"lbounda8", "", false, ""},
179 {"lboundaz", "", false, "k"},
180 {"lboundaz1", "", false, ""},
181 {"lboundaz2", "", false, ""},
182 {"lboundaz4", "", false, ""},
183 {"lboundaz8", "", false, ""},
184 {"lena", "", false, "k"},
185 {"lentrima", "", false, "k"},
186 {"loc", "", false, ""},
187 {"log1", "", false, ""},
188 {"log2", "", false, ""},
189 {"log4", "", false, ""},
190 {"log8", "", false, ""},
191 {"matmul_cplx16", "", true, ""},
192 {"matmul_cplx16mxv_t", "", true, ""},
193 {"matmul_cplx32", "", true, ""},
194 {"matmul_cplx8", "", true, ""},
195 {"matmul_cplx8mxv_t", "", true, ""},
196 {"matmul_int1", "", true, ""},
197 {"matmul_int2", "", true, ""},
198 {"matmul_int4", "", true, ""},
199 {"matmul_int8", "", true, ""},
200 {"matmul_log1", "", true, ""},
201 {"matmul_log2", "", true, ""},
202 {"matmul_log4", "", true, ""},
203 {"matmul_log8", "", true, ""},
204 {"matmul_real16", "", true, ""},
205 {"matmul_real4", "", true, ""},
206 {"matmul_real4mxv_t", "", true, ""},
207 {"matmul_real8", "", true, ""},
208 {"matmul_real8mxv_t", "", true, ""},
209 {"max", "", false, "k"},
210 {"mcopy1", "", false, ""},
211 {"mcopy2", "", false, ""},
212 {"mcopy4", "", false, ""},
213 {"mcopy8", "", false, ""},
214 {"mcopyz16", "", false, ""},
215 {"mcopyz4", "", false, ""},
216 {"mcopyz8", "", false, ""},
217 {"mergec", "", false, ""},
218 {"mergecha", "", false, ""},
219 {"merged", "", false, ""},
220 {"mergedc", "", false, ""},
221 {"mergedt", "", false, ""},
222 {"mergei", "", false, ""},
223 {"mergei1", "", false, ""},
224 {"mergei2", "", false, ""},
225 {"mergei8", "", false, ""},
226 {"mergel", "", false, ""},
227 {"mergel1", "", false, ""},
228 {"mergel2", "", false, ""},
229 {"mergel8", "", false, ""},
230 {"mergeq", "", false, ""},
231 {"merger", "", false, ""},
232 {"min", "", false, "k"},
233 {"mmul_cmplx16", "", false, ""},
234 {"mmul_cmplx8", "", false, ""},
235 {"mmul_real4", "", false, ""},
236 {"mmul_real8", "", false, ""},
237 {"modulov", "", false, ""},
238 {"move_alloc", "", true, ""},
239 {"mp_bcs_nest", "", false, ""},
240 {"mp_ecs_nest", "", false, ""},
241 {"mset1", "", false, ""},
242 {"mset2", "", false, ""},
243 {"mset4", "", false, ""},
244 {"mset8", "", false, ""},
245 {"msetz16", "", false, ""},
246 {"msetz4", "", false, ""},
247 {"msetz8", "", false, ""},
248 {"mvbits", "", false, ""},
249 {"mzero1", "", false, ""},
250 {"mzero2", "", false, ""},
251 {"mzero4", "", false, ""},
252 {"mzero8", "", false, ""},
253 {"mzeroz16", "", false, ""},
254 {"mzeroz4", "", false, ""},
255 {"mzeroz8", "", false, ""},
256 {"nadjustl", "", false, ""},
257 {"nadjustr", "", false, ""},
258 {"name", "", false, ""},
259 {"nearest", "", false, ""},
260 {"nearestd", "", false, ""},
261 {"nearestdx", "", false, ""},
262 {"nearestx", "", false, ""},
263 {"nlena", "", true, ""},
264 {"nlentrim", "", false, ""},
265 {"nrepeat", "", false, ""},
266 {"nscan", "", false, "k"},
267 {"nstr_copy", "", false, ""},
268 {"nstr_copy_klen", "", false, ""},
269 {"nstr_index", "", false, ""},
270 {"nstr_index_klen", "", false, ""},
271 {"nstrcmp", "", false, ""},
272 {"nstrcmp_klen", "", false, ""},
273 {"ntrim", "", false, ""},
274 {"nverify", "", false, "k"},
275 {"pausea", "", false, ""},
276 {"poly_asn", "", true, ""},
277 {"poly_asn_dest_intrin", "", true, ""},
278 {"poly_asn_src_intrin", "", true, ""},
279 {"poly_conform_types", "", true, ""},
280 {"poly_element_addr", "", true, "k"},
281 {"poly_element_addr1", "", true, "k"},
282 {"poly_element_addr2", "", true, "k"},
283 {"poly_element_addr3", "", true, "k"},
284 {"present", "", false, "k"},
285 {"present_ptr", "", false, "k"},
286 {"presentca", "", false, "k"},
287 {"ptr_alloca", "", false, ""},
288 {"ptr_alloc03a", "", true, ""},
289 {"ptr_alloc04a", "", true, ""},
290 {"ptr_alloc04ma", "", false, ""},
291 {"ptr_alloc04pa", "", false, ""},
292 {"ptr_calloc03a", "", true, ""},
293 {"ptr_calloc04a", "", true, ""},
294 {"ptr_calloc04ma", "", false, ""},
295 {"ptr_calloc04pa", "", false, ""},
296 {"ptr_src_alloc03a", "", true, ""},
297 {"ptr_src_alloc04a", "", true, ""},
298 {"ptr_src_alloc04ma", "", true, ""},
299 {"ptr_src_alloc04pa", "", true, ""},
300 {"ptr_src_calloc03a", "", true, ""},
301 {"ptr_src_calloc04a", "", true, ""},
302 {"ptr_src_calloc04ma", "", true, ""},
303 {"ptr_src_calloc04pa", "", true, ""},
304 {"ptrchk", "", false, ""},
305 {"ptrcp", "", false, ""},
306 {"real", "", false, ""},
307 {"real16", "", false, ""},
308 {"real4", "", false, ""},
309 {"real8", "", false, ""},
310 {"repeata", "", false, ""},
311 {"rrspacing", "", false, ""},
312 {"rrspacingd", "", false, ""},
313 {"rrspacingdx", "", false, ""},
314 {"rrspacingx", "", false, ""},
315 {"rtn_name", "", false, ""},
316 {"same_intrin_type_as", "", true, "k"},
317 {"same_type_as", "", true, "k"},
318 {"scale", "", false, ""},
319 {"scaled", "", false, ""},
320 {"scaledx", "", false, ""},
321 {"scalex", "", false, ""},
322 {"scana", "", false, "k"},
323 {"sect", "", true, ""},
324 {"sect1", "", true, ""},
325 {"sect1v", "", true, ""},
326 {"sect2", "", true, ""},
327 {"sect2v", "", true, ""},
328 {"sect3", "", true, ""},
329 {"sect3v", "", true, ""},
330 {"sel_char_kinda", "", true, "k"},
331 {"sel_int_kind", "", true, "k"},
332 {"sel_real_kind", "", true, "k"},
333 {"set_intrin_type", "", true, ""},
334 {"set_type", "", true, ""},
335 {"setexp", "", false, ""},
336 {"setexpd", "", false, ""},
337 {"setexpdx", "", false, ""},
338 {"setexpx", "", false, ""},
339 {"shape", "", true, "k"},
340 {"shape1", "", true, ""},
341 {"shape2", "", true, ""},
342 {"shape4", "", true, ""},
343 {"shape8", "", true, ""},
344 {"show", "", false, ""},
345 {"size", "", true, "k"},
346 {"spacing", "", false, ""},
347 {"spacingd", "", false, ""},
348 {"spacingdx", "", false, ""},
349 {"spacingx", "", false, ""},
350 {"stopa", "", false, ""},
351 {"stop08a", "", false, ""},
352 {"str_copy", "", false, ""},
353 {"str_copy_klen", "", false, ""},
354 {"str_cpy1", "", false, ""},
355 {"str_free", "", false, ""},
356 {"str_index", "", false, ""},
357 {"str_index_klen", "", false, ""},
358 {"str_malloc", "", false, ""},
359 {"str_malloc_klen", "", false, ""},
360 {"strcmp", "", false, ""},
361 {"strcmp_klen", "", false, ""},
362 {"subchk", "", false, ""},
363 {"subchk64", "", false, ""},
364 {"tmp_desc", "", true, ""},
365 {"template", "", true, ""},
366 {"template1", "", true, ""},
367 {"template1v", "", true, ""},
368 {"template2", "", true, ""},
369 {"template2v", "", true, ""},
370 {"template3", "", true, ""},
371 {"template3v", "", true, ""},
372 {"test_and_set_type", "", true, ""},
373 {"trima", "", false, ""},
374 {"ub", "", true, "k"},
375 {"ub1", "", true, ""},
376 {"ub2", "", true, ""},
377 {"ub4", "", true, ""},
378 {"ub8", "", true, ""},
379 {"uba", "", true, "k"},
380 {"uba1", "", true, ""},
381 {"uba2", "", true, ""},
382 {"uba4", "", true, ""},
383 {"uba8", "", true, ""},
384 {"ubaz", "", true, "k"},
385 {"ubaz1", "", true, ""},
386 {"ubaz2", "", true, ""},
387 {"ubaz4", "", true, ""},
388 {"ubaz8", "", true, ""},
389 {"ubound", "", false, "k"},
390 {"ubound1", "", true, ""},
391 {"ubound2", "", true, ""},
392 {"ubound4", "", true, ""},
393 {"ubound8", "", true, ""},
394 {"ubounda", "", false, "k"},
395 {"ubounda1", "", false, ""},
396 {"ubounda2", "", false, ""},
397 {"ubounda4", "", false, ""},
398 {"ubounda8", "", false, ""},
399 {"uboundaz", "", false, "k"},
400 {"uboundaz1", "", false, ""},
401 {"uboundaz2", "", false, ""},
402 {"uboundaz4", "", false, ""},
403 {"uboundaz8", "", false, ""},
404 {"verifya", "", false, "k"},
405 {"END_OF_PFX_F90,", "", false, ""},
406 {"all", "", false, ""},
407 {"all_scatterx", "", false, ""},
408 {"alls", "", true, ""},
409 {"any", "", false, ""},
410 {"any_scatterx", "", false, ""},
411 {"anys", "", true, ""},
412 {"associated", "", true, ""},
413 {"associated_chara", "", true, ""},
414 {"associated_t", "", true, ""},
415 {"associated_tchara", "", true, ""},
416 {"barrier", "", false, ""},
417 {"block_loop", "", false, ""},
418 {"comm_copy", "", false, ""},
419 {"comm_free", "", false, ""},
420 {"comm_gatherx", "", false, ""},
421 {"comm_scatterx", "", false, ""},
422 {"copy_out", "", true, ""},
423 {"count", "", false, ""},
424 {"counts", "", true, ""},
425 {"cpu_time", "", false, ""},
426 {"cpu_timed", "", false, ""},
427 {"cshift", "", true, ""},
428 {"cshiftc", "", true, ""},
429 {"cshifts", "", true, ""},
430 {"cshiftsca", "", true, ""},
431 {"cyclic_loop", "", false, ""},
432 {"dandta", "", true, ""},
433 {"datea", "", false, ""},
434 {"datew", "", false, ""},
435 {"dotpr", "", true, ""},
436 {"eoshift", "", true, ""},
437 {"eoshiftca", "", true, ""},
438 {"eoshifts", "", true, ""},
439 {"eoshiftsa", "", true, ""},
440 {"eoshiftsaca", "", true, ""},
441 {"eoshiftsca", "", true, ""},
442 {"eoshiftss", "", true, ""},
443 {"eoshiftssca", "", true, ""},
444 {"eoshiftsz", "", true, ""},
445 {"eoshiftszca", "", true, ""},
446 {"eoshiftz", "", true, ""},
447 {"eoshiftzca", "", true, ""},
448 {"extent", "", true, ""},
449 {"findloc", "", true, "k"},
450 {"findlocs", "", true, "k"},
451 {"findlocstr", "", true, "k"},
452 {"findlocstrs", "", true, "k"},
453 {"free", "", true, ""},
454 {"freen", "", false, ""},
455 {"ftimea", "", true, ""},
456 {"ftimew", "", true, ""},
457 {"function_entrya", "", false, ""},
458 {"function_exit", "", false, ""},
459 {"get_scalar", "", true, ""},
460 {"global_all", "", false, ""},
461 {"global_any", "", false, ""},
462 {"global_firstmax", "", false, ""},
463 {"global_firstmin", "", false, ""},
464 {"global_iall", "", false, ""},
465 {"global_iany", "", false, ""},
466 {"global_iparity", "", false, ""},
467 {"global_lastmax", "", false, ""},
468 {"global_lastmin", "", false, ""},
469 {"global_maxval", "", false, ""},
470 {"global_minval", "", false, ""},
471 {"global_parity", "", false, ""},
472 {"global_product", "", false, ""},
473 {"global_sum", "", false, ""},
474 {"globalize", "", false, ""},
475 {"iall_scatterx", "", false, ""},
476 {"iany_scatterx", "", false, ""},
477 {"idate", "", false, ""},
478 {"ilen", "", false, ""},
479 {"indexa", "", true, "k"},
480 {"indexxa", "", true, "k"},
481 {"indexx_cra", "", true, "k"},
482 {"indexx_cr_nma", "", true, "k"},
483 {"init", "", false, ""},
484 {"instance", "", true, ""},
485 {"iparity_scatterx", "", false, ""},
486 {"islocal_idx", "", false, ""},
487 {"jdate", "", false, ""},
488 {"lastval", "", false, ""},
489 {"lbound1", "", false, ""},
490 {"lbound2", "", false, ""},
491 {"lbound4", "", false, ""},
492 {"lbound8", "", false, ""},
493 {"lbound", "", true, "k"},
494 {"lbounda1", "", true, ""},
495 {"lbounda2", "", true, ""},
496 {"lbounda4", "", true, ""},
497 {"lbounda8", "", true, ""},
498 {"lbounda", "", true, "k"},
499 {"lboundaz1", "", true, ""},
500 {"lboundaz2", "", true, ""},
501 {"lboundaz4", "", true, ""},
502 {"lboundaz8", "", true, ""},
503 {"lboundaz", "", true, "k"},
504 {"leadz", "", false, ""},
505 {"len", "", true, "k"},
506 {"lenxa", "", true, "k"},
507 {"lenx_cra", "", true, "k"},
508 {"lenx_cr_nma", "", true, "k"},
509 {"line_entry", "", false, ""},
510 {"lineno", "", false, ""},
511 {"localize_bounds", "", false, ""},
512 {"localize_index", "", false, ""},
513 {"matmul", "", true, ""},
514 {"maxloc", "", true, "k"},
515 {"maxloc_b", "", true, "k"},
516 {"maxlocs", "", true, "k"},
517 {"maxlocs_b", "", true, "k"},
518 {"norm2", "", true, ""},
519 {"norm2_nodim", "", true, ""},
520 {"maxval", "", true, ""},
521 {"maxval_scatterx", "", false, ""},
522 {"maxvals", "", true, ""},
523 {"member_base", "", false, ""},
524 {"minloc", "", true, "k"},
525 {"minloc_b", "", true, "k"},
526 {"minlocs", "", true, "k"},
527 {"minlocs_b", "", true, "k"},
528 {"minval", "", true, ""},
529 {"minval_scatterx", "", false, ""},
530 {"minvals", "", true, ""},
531 {"np", "", false, ""},
532 {"nullify", "", true, ""},
533 {"nullify_chara", "", true, ""},
534 {"nullifyx", "", true, ""},
535 {"number_of_processors", "", false, "k"},
536 {"olap_cshift", "", false, ""},
537 {"olap_eoshift", "", false, ""},
538 {"olap_shift", "", false, ""},
539 {"pack", "", true, ""},
540 {"packca", "", true, ""},
541 {"packz", "", true, ""},
542 {"packzca", "", true, ""},
543 {"parity_scatterx", "", false, ""},
544 {"permute_section", "", false, ""},
545 {"popcnt", "", false, ""},
546 {"poppar", "", false, ""},
547 {"processors", "", false, ""},
548 {"processors_rank", "", false, "k"},
549 {"product", "", true, ""},
550 {"product_scatterx", "", false, ""},
551 {"products", "", true, ""},
552 {"ptr_asgn", "", true, ""},
553 {"ptr_asgn_chara", "", true, ""},
554 {"ptr_assign", "", true, ""},
555 {"ptr_assign_chara", "", true, ""},
556 {"ptr_assign_charxa", "", true, ""},
557 {"ptr_assignx", "", true, ""},
558 {"ptr_assn", "", true, ""},
559 {"ptr_assn_assumeshp", "", true, ""},
560 {"ptr_assn_chara", "", true, ""},
561 {"ptr_assn_char_assumeshp", "", true, ""},
562 {"ptr_assn_charxa", "", true, ""},
563 {"ptr_assn_dchara", "", true, ""},
564 {"ptr_assn_dchar_assumeshp", "", true, ""},
565 {"ptr_assn_dcharxa", "", true, ""},
566 {"ptr_assnx", "", true, ""},
567 {"ptr_fix_assumeshp", "", true, ""},
568 {"ptr_fix_assumeshp1", "", true, ""},
569 {"ptr_fix_assumeshp2", "", true, ""},
570 {"ptr_fix_assumeshp3", "", true, ""},
571 {"ptr_ina", "", true, ""},
572 {"ptr_in_chara", "", true, ""},
573 {"ptr_offset", "", true, ""},
574 {"ptr_out", "", true, ""},
575 {"ptr_out_chara", "", true, ""},
576 {"ptr_shape_assn", "", true, ""},
577 {"ptr_shape_assnx", "", true, ""},
578 {"qopy_in", "", true, ""},
579 {"realign", "", true, ""},
580 {"redistribute", "", true, ""},
581 {"reduce_descriptor", "", true, ""},
582 {"reshape", "", true, ""},
583 {"reshapeca", "", true, ""},
584 {"rnum", "", true, ""},
585 {"rnumd", "", true, ""},
586 {"rseed", "", true, ""},
587 {"secnds", "", true, ""},
588 {"secndsd", "", true, ""},
589 {"shape", "", true, "k"},
590 {"size", "", true, "k"},
591 {"spread", "", false, ""},
592 {"spread_descriptor", "", true, ""},
593 {"spreadca", "", false, ""},
594 {"spreadcs", "", false, ""},
595 {"spreadsa", "", false, ""},
596 {"sum", "", true, ""},
597 {"sum_scatterx", "", false, ""},
598 {"sums", "", true, ""},
599 {"sysclk", "", true, ""},
600 {"template", "", true, ""},
601 {"transfer", "", true, ""},
602 {"type", "", false, ""},
603 {"typep", "", false, ""},
604 {"ubound1", "", false, ""},
605 {"ubound2", "", false, ""},
606 {"ubound4", "", false, ""},
607 {"ubound8", "", false, ""},
608 {"ubound", "", true, "k"},
609 {"ubounda1", "", true, ""},
610 {"ubounda2", "", true, ""},
611 {"ubounda4", "", true, ""},
612 {"ubounda8", "", true, ""},
613 {"ubounda", "", true, "k"},
614 {"uboundaz1", "", true, ""},
615 {"uboundaz2", "", true, ""},
616 {"uboundaz4", "", true, ""},
617 {"uboundaz8", "", true, ""},
618 {"uboundaz", "", true, "k"},
619 {"unpack", "", true, ""},
620 {"unpackca", "", true, ""},
621 {"END_OF_PFX_FTN", "", false, ""},
622 {"f90io_aux_init", "", false, ""},
623 {"f90io_backspace", "", false, ""},
624 {"f90io_begin", "", false, ""},
625 {"f90io_byte_reada", "", false, ""},
626 {"f90io_byte_read64a", "", false, ""},
627 {"f90io_byte_writea", "", false, ""},
628 {"f90io_byte_write64a", "", false, ""},
629 {"f90io_closea", "", false, ""},
630 {"f90io_dts_fmtr", "", false, ""},
631 {"f90io_dts_fmtw", "", false, ""},
632 {"f90io_dts_stat", "", false, ""},
633 {"f90io_encode_fmta", "", false, ""},
634 {"f90io_encode_fmtv", "", false, ""},
635 {"f90io_end", "", false, ""},
636 {"f90io_endfile", "", false, ""},
637 {"f90io_flush", "", false, ""},
638 {"f90io_fmt_reada", "", false, ""},
639 {"f90io_fmt_read64_aa", "", false, ""},
640 {"f90io_fmt_read_aa", "", false, ""},
641 {"f90io_fmt_writea", "", false, ""},
642 {"f90io_fmt_write64_aa", "", false, ""},
643 {"f90io_fmt_write_aa", "", false, ""},
644 {"f90io_fmtr_end", "", false, ""},
645 {"f90io_fmtr_inita", "", false, ""},
646 {"f90io_fmtr_init03a", "", false, ""},
647 {"f90io_fmtr_init2003a", "", false, ""},
648 {"f90io_fmtr_initva", "", false, ""},
649 {"f90io_fmtr_initv2003a", "", false, ""},
650 {"f90io_fmtr_intern_inita", "", false, ""},
651 {"f90io_fmtr_intern_inite", "", false, ""},
652 {"f90io_fmtr_intern_initev", "", false, ""},
653 {"f90io_fmtr_intern_initva", "", false, ""},
654 {"f90io_fmtw_end", "", false, ""},
655 {"f90io_fmtw_inita", "", false, ""},
656 {"f90io_fmtw_init03a", "", false, ""},
657 {"f90io_fmtw_initva", "", false, ""},
658 {"f90io_fmtw_intern_inita", "", false, ""},
659 {"f90io_fmtw_intern_inite", "", false, ""},
660 {"f90io_fmtw_intern_initev", "", false, ""},
661 {"f90io_fmtw_intern_initva", "", false, ""},
662 {"f90io_get_newunit", "", false, ""},
663 {"f90io_inquirea", "", false, ""},
664 {"f90io_inquire03a", "", false, ""},
665 {"f90io_inquire03_2a", "", false, ""},
666 {"f90io_inquire2003a", "", false, ""},
667 {"f90io_iomsga", "", false, ""},
668 {"f90io_iomsg_", "", false, ""},
669 {"f90io_ldra", "", false, ""},
670 {"f90io_ldr64_aa", "", false, ""},
671 {"f90io_ldr_aa", "", false, ""},
672 {"f90io_ldr_end", "", false, ""},
673 {"f90io_ldr_init", "", false, ""},
674 {"f90io_ldr_init03a", "", false, ""},
675 {"f90io_ldr_intern_inita", "", false, ""},
676 {"f90io_ldr_intern_inite", "", false, ""},
677 {"f90io_ldwa", "", false, ""},
678 {"f90io_ldw64_aa", "", false, ""},
679 {"f90io_ldw_aa", "", false, ""},
680 {"f90io_ldw_end", "", false, ""},
681 {"f90io_ldw_init", "", false, ""},
682 {"f90io_ldw_init03a", "", false, ""},
683 {"f90io_ldw_intern_inita", "", false, ""},
684 {"f90io_ldw_intern_inite", "", false, ""},
685 {"f90io_nml_read", "", true, ""},
686 {"f90io_nml_write", "", true, ""},
687 {"f90io_nmlr", "", true, ""},
688 {"f90io_nmlr_end", "", true, ""},
689 {"f90io_nmlr_init", "", true, ""},
690 {"f90io_nmlr_init03a", "", true, ""},
691 {"f90io_nmlr_intern_inita", "", true, ""},
692 {"f90io_nmlw", "", true, ""},
693 {"f90io_nmlw_end", "", true, ""},
694 {"f90io_nmlw_init", "", true, ""},
695 {"f90io_nmlw_init03a", "", true, ""},
696 {"f90io_nmlw_intern_inita", "", true, ""},
697 {"f90io_open03a", "", false, ""},
698 {"f90io_open2003a", "", false, ""},
699 {"f90io_open_asynca", "", false, ""},
700 {"f90io_open_cvta", "", false, ""},
701 {"f90io_open_sharea", "", false, ""},
702 {"f90io_print_init", "", false, ""},
703 {"f90io_rewind", "", false, ""},
704 {"f90io_sc_cd_fmt_write", "", false, ""},
705 {"f90io_sc_cd_ldw", "", false, ""},
706 {"f90io_sc_cf_fmt_write", "", false, ""},
707 {"f90io_sc_cf_ldw", "", false, ""},
708 {"f90io_sc_ch_fmt_write", "", false, ""},
709 {"f90io_sc_ch_ldw", "", false, ""},
710 {"f90io_sc_d_fmt_write", "", false, ""},
711 {"f90io_sc_d_ldw", "", false, ""},
712 {"f90io_sc_f_fmt_write", "", false, ""},
713 {"f90io_sc_f_ldw", "", false, ""},
714 {"f90io_sc_fmt_write", "", false, ""},
715 {"f90io_sc_i_fmt_write", "", false, ""},
716 {"f90io_sc_i_ldw", "", false, ""},
717 {"f90io_sc_l_fmt_write", "", false, ""},
718 {"f90io_sc_l_ldw", "", false, ""},
719 {"f90io_sc_ldw", "", false, ""},
720 {"f90io_src_info03a", "", false, ""},
721 {"f90io_src_infox03a", "", false, ""},
722 {"f90io_swbackspace", "", false, ""},
723 {"f90io_unf_asynca", "", false, ""},
724 {"f90io_unf_end", "", false, ""},
725 {"f90io_unf_init", "", false, ""},
726 {"f90io_unf_reada", "", false, ""},
727 {"f90io_unf_read64_aa", "", false, ""},
728 {"f90io_unf_read_aa", "", false, ""},
729 {"f90io_unf_writea", "", false, ""},
730 {"f90io_unf_write64_aa", "", false, ""},
731 {"f90io_unf_write_aa", "", false, ""},
732 {"f90io_usw_end", "", false, ""},
733 {"f90io_usw_init", "", false, ""},
734 {"f90io_usw_reada", "", false, ""},
735 {"f90io_usw_read64_aa", "", false, ""},
736 {"f90io_usw_read_aa", "", false, ""},
737 {"f90io_usw_writea", "", false, ""},
738 {"f90io_usw_write64_aa", "", false, ""},
739 {"f90io_usw_write_aa", "", false, ""},
740 {"f90io_wait", "", false, ""},
741 {"END_OF_IO", "", false, ""},
742 {"io_fmt_read", "", false, ""},
743 {"io_fmt_read64", "", false, ""},
744 {"io_fmt_write", "", false, ""},
745 {"io_fmt_write64", "", false, ""},
746 {"io_ldr", "", false, ""},
747 {"io_ldr64", "", false, ""},
748 {"io_ldw", "", false, ""},
749 {"io_ldw64", "", false, ""},
750 {"io_unf_read", "", false, ""},
751 {"io_unf_read64", "", false, ""},
752 {"io_unf_write", "", false, ""},
753 {"io_unf_write64", "", false, ""},
754 {"io_usw_read", "", false, ""},
755 {"io_usw_read64", "", false, ""},
756 {"io_usw_write", "", false, ""},
757 {"io_usw_write64", "", false, ""},
758 {"END_OF_FTNIO", "", false, ""},
759 };
760
761 #ifdef DEBUG
762 void
dump_FtnRteRtn(FtnRtlEnum rteRtn)763 dump_FtnRteRtn(FtnRtlEnum rteRtn)
764 {
765 fprintf(stderr, "ftnRtlRtns[%d]:\n", rteRtn);
766 fprintf(stderr, " baseNm: %s\n", ftnRtlRtns[rteRtn].baseNm);
767 fprintf(stderr, " I8Descr: %s\n",
768 ftnRtlRtns[rteRtn].I8Descr ? "true" : "false");
769 if (strlen(ftnRtlRtns[rteRtn].largeRetValPrefix) != 0) {
770 fprintf(stderr, " largeRetValPrefix: %s\n",
771 ftnRtlRtns[rteRtn].largeRetValPrefix);
772 } else {
773 fprintf(stderr, " largeRetValPrefix: NULL\n");
774 }
775 if (strlen(ftnRtlRtns[rteRtn].fullNm) != 0) {
776 fprintf(stderr, " fullNm: %s\n", ftnRtlRtns[rteRtn].fullNm);
777 } else {
778 fprintf(stderr, " fullNm: NULL\n");
779 }
780 }
781 #endif
782
783 /** \brief given a FtnRtlEnum, return the RTL routine name */
784 char *
mkRteRtnNm(FtnRtlEnum rteRtn)785 mkRteRtnNm(FtnRtlEnum rteRtn)
786 {
787 const char *prefixes[4] = {"f90_", "fort_", "", "ftn"};
788
789 assert(strcmp(ftnRtlRtns[END_OF_FTNIO].baseNm, "END_OF_FTNIO") == 0,
790 "mkRteRtnNm: RTL name table and RTL name enum are out of sync", rteRtn,
791 ERR_Severe);
792 assert(rteRtn > RTE_no_rtn && rteRtn < END_OF_FTNIO,
793 "mkRteRtnNm: invalid rteRtn enum", rteRtn, ERR_Severe);
794
795 if (strlen(ftnRtlRtns[rteRtn].fullNm) == 0) {
796 if (rteRtn < END_OF_PFX_F90) {
797 strcat(ftnRtlRtns[rteRtn].fullNm, prefixes[0]);
798 } else if (rteRtn > END_OF_PFX_F90 && rteRtn < END_OF_PFX_FTN) {
799 strcat(ftnRtlRtns[rteRtn].fullNm, prefixes[1]);
800 } else if (rteRtn > END_OF_PFX_FTN && rteRtn < END_OF_IO) {
801 strcat(ftnRtlRtns[rteRtn].fullNm, prefixes[2]);
802 } else if (rteRtn > END_OF_IO && rteRtn < END_OF_FTNIO) {
803 strcat(ftnRtlRtns[rteRtn].fullNm, prefixes[3]);
804 }
805
806 if (XBIT(124, 0x10) &&
807 strncmp("k", ftnRtlRtns[rteRtn].largeRetValPrefix, 1) == 0) {
808 strcat(ftnRtlRtns[rteRtn].fullNm, ftnRtlRtns[rteRtn].largeRetValPrefix);
809 }
810
811 /* FIXME: what about (XBIT(68, 0x1) && XBIT(68, 0x2), see semfunc.c,
812 * transfrm.c
813 */
814 if (XBIT(124, 0x8) &&
815 (strncmp("d", ftnRtlRtns[rteRtn].largeRetValPrefix, 1) == 0 ||
816 strncmp("cd", ftnRtlRtns[rteRtn].largeRetValPrefix, 2) == 0)) {
817 strcat(ftnRtlRtns[rteRtn].fullNm, ftnRtlRtns[rteRtn].largeRetValPrefix);
818 }
819
820 strcat(ftnRtlRtns[rteRtn].fullNm, ftnRtlRtns[rteRtn].baseNm);
821
822 if (ftnRtlRtns[rteRtn].I8Descr && (XBIT(68, 0x1))) {
823 strcat(ftnRtlRtns[rteRtn].fullNm, "_i8");
824 }
825 }
826 assert(strlen(ftnRtlRtns[rteRtn].fullNm) > 0,
827 "mkRteRtnNm: return NULL name\n", rteRtn, ERR_Severe);
828 return ftnRtlRtns[rteRtn].fullNm;
829 }
830
831 static void
stripI8DescrSuffix(char * inNm,char * outNm)832 stripI8DescrSuffix(char *inNm, char *outNm)
833 {
834 int nmLen = strlen(inNm);
835
836 if (nmLen <= 3) {
837 outNm[0] = '\0';
838 return;
839 }
840
841 assert(nmLen < MAXIDLEN, "stripI8DescrSuffix: name too big", nmLen,
842 ERR_Severe);
843
844 if (XBIT(68, 0x1)) {
845 nmLen -= 3; /* strip "_i8" */
846 }
847 strncpy(outNm, inNm, nmLen);
848 outNm[nmLen] = '\0';
849 }
850
851 typedef struct {
852 FtnRtlEnum rtlRtn;
853 int ftype;
854 } F90TmplSectRtns;
855
856 static F90TmplSectRtns f90TmplSectRtns[] = {
857 {RTE_sect, FTYPE_SECT}, {RTE_sect1, FTYPE_SECT},
858 {RTE_sect1v, FTYPE_SECT}, {RTE_sect2, FTYPE_SECT},
859 {RTE_sect2v, FTYPE_SECT}, {RTE_sect3, FTYPE_SECT},
860 {RTE_sect3v, FTYPE_SECT}, {RTE_template, FTYPE_TEMPLATE},
861 {RTE_template1, FTYPE_TEMPLATE1}, {RTE_template1v, FTYPE_TEMPLATE1V},
862 {RTE_template2, FTYPE_TEMPLATE2}, {RTE_template2v, FTYPE_TEMPLATE2V},
863 {RTE_template3, FTYPE_TEMPLATE3}, {RTE_template3v, FTYPE_TEMPLATE3V},
864 };
865
866 static int
setTmplSectRtnFtype(int i)867 setTmplSectRtnFtype(int i)
868 {
869 int retFtype;
870
871 retFtype = f90TmplSectRtns[i].ftype;
872 /* assert ftnRtlRtns[i].I8Descr == true */
873 if ((XBIT(68, 0x1))) {
874 retFtype |= FTYPE_I8;
875 }
876 return retFtype;
877 }
878
879 int
getF90TmplSectRtn(char * rtnNm)880 getF90TmplSectRtn(char *rtnNm)
881 {
882 int l, h, m, r;
883 char *tmplSectNm;
884 int retFtype = 0;
885 int compLen;
886 char cpyRtnNm[MAXIDLEN];
887 char cpyTmplSectNm[MAXIDLEN];
888
889 stripI8DescrSuffix(rtnNm, cpyRtnNm);
890 if (cpyRtnNm[0] == '\0') {
891 /* name too short to be a RTL descriptor rtn */
892 return 0;
893 }
894
895 l = 0;
896 h = sizeof(f90TmplSectRtns) / sizeof(F90TmplSectRtns) - 1;
897
898 /* The majority of this function's invocations will return 0,
899 * check if routine names are are out of bounds
900 */
901 tmplSectNm = mkRteRtnNm(f90TmplSectRtns[l].rtlRtn);
902 stripI8DescrSuffix(tmplSectNm, cpyTmplSectNm);
903 r = strcmp(cpyRtnNm, cpyTmplSectNm);
904 if (r == 0) {
905 return setTmplSectRtnFtype(l);
906 } else if (r < 0)
907 return 0;
908
909 tmplSectNm = mkRteRtnNm(f90TmplSectRtns[h].rtlRtn);
910 stripI8DescrSuffix(tmplSectNm, cpyTmplSectNm);
911 r = strcmp(cpyRtnNm, cpyTmplSectNm);
912 if (r == 0) {
913 return setTmplSectRtnFtype(h);
914 } else if (r > 0)
915 return 0;
916
917 while (l <= h) {
918 m = (h + l) / 2;
919
920 tmplSectNm = mkRteRtnNm(f90TmplSectRtns[m].rtlRtn);
921 stripI8DescrSuffix(tmplSectNm, cpyTmplSectNm);
922
923 r = strcmp(cpyRtnNm, cpyTmplSectNm);
924 if (r == 0) {
925 retFtype = setTmplSectRtnFtype(m);
926 break;
927 }
928 if (r < 0) {
929 h = m - 1;
930 } else if (r > 0) {
931 l = m + 1;
932 }
933 }
934
935 return retFtype;
936 }
937
938