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 /**
19 * \file
20 * \brief Symbol initialization for Fortran
21 */
22
23 #include "scutil.h"
24 #include "gbldefs.h"
25 #include "global.h"
26 #include "sharedefs.h"
27 #include "symtab.h"
28 #include "symnames.h"
29 #include "utils.h"
30 #include <algorithm>
31 #include <fstream>
32 #include <map>
33 #include <sstream>
34 #include <string>
35 #include <vector>
36 #include <assert.h>
37
38 /*---------------------------------------------------------------------
39 * Usage:
40 * symini infile -o out1 out2 out3 out4 out5
41 * The following files are opened:
42 *
43 * ifs - input file to the utility (symini.n)
44 * out1 - output file which will contain the initializations of symbol
45 * tables. (syminidf.h)
46 * out2 - output file which will contain the macros which define
47 * the predeclared numbers. (pd.h)
48 * out3 - output file which will contain the macros which define
49 * the 'INTAST' numbers; names are of the form 'I_<name>'. (ast.d)
50 * out4 - output file which will contain the initializations for mapping
51 * the 'INTAST" numbers to their corresponding symtab table
52 * entries. (astdf.d)
53 * out5 - output file which will contain ILMs (ilmtp.h)
54 *---------------------------------------------------------------------*/
55
56 STB stb;
57
58 /**
59 * .IN name pcnt atyp dtype ILM pname arrayf
60 * .GN name siname iname rname dname cname cdname i8name qname cqname
61 * .PD name pname dtype
62 */
63 class SyminiFE90 : public UtilityApplication
64 {
65
66 enum {
67 LT_IN = 1,
68 LT_GN,
69 LT_PD,
70 LT_sh,
71 LT_AT,
72 LT_H1,
73 LT_H2,
74 LT_H3,
75 LT_H4,
76 LT_H5,
77 LT_H6,
78 LT_H7,
79 LT_H8, // F2008 iso_c_binding module procedure, mark as ST_ISOC
80 LT_H9 // F2008 iso_fortran_env module procedure, mark as ST_FTNENV
81 };
82
83 static const char *init_names0[];
84 static const char *init_names1[];
85 static const char *init_names2[];
86 static const char *init_names3[];
87 static const size_t init_names0_size;
88 static const size_t init_names1_size;
89 static const size_t init_names2_size;
90 static const size_t init_names3_size;
91
92 std::vector<std::string> intr_kwd;
93 std::vector<std::string> ilms;
94 std::vector<int> intast_sym;
95 std::map<std::string, DTYPE> argtype;
96 NroffMap elt;
97 std::string sphinx_filename;
98
99 FILE *out1;
100 FILE *out2;
101 FILE *out3;
102 FILE *out4;
103 FILE *out5;
104
105 int hpf_lib_first;
106 int hpf_lib_last;
107 int hpf_local_lib_first;
108 int hpf_local_lib_last;
109 int craft_first;
110 int craft_last;
111 int cray_first;
112 int cray_last;
113 int iso_c_first;
114 int iso_c_last;
115 int ieeearith_first;
116 int ieeearith_last;
117 int ieeeexcept_first;
118 int ieeeexcept_last;
119 SPTR sptr;
120 int npd;
121 int star_str;
122
123 public:
SyminiFE90(int argc,char ** argv)124 SyminiFE90(int argc, char **argv)
125 {
126 hpf_lib_first = 0;
127 hpf_lib_last = 0;
128 hpf_local_lib_first = 0;
129 hpf_local_lib_last = 0;
130 craft_first = 0;
131 craft_last = 0;
132 cray_first = 0;
133 cray_last = 0;
134 iso_c_first = 0;
135 iso_c_last = 0;
136 ieeearith_first = 0;
137 ieeearith_last = 0;
138 ieeeexcept_first = 0;
139 ieeeexcept_last = 0;
140 npd = 0;
141 star_str = 0;
142 argtype["W"] = DT_WORD;
143 argtype["I"] = DT_INT4;
144 argtype["RH"] = DT_REAL2;
145 argtype["R"] = DT_REAL4;
146 argtype["D"] = DT_REAL8;
147 argtype["CH"] = DT_CMPLX4;
148 argtype["C"] = DT_CMPLX8;
149 argtype["CD"] = DT_CMPLX16;
150 argtype["SI"] = DT_SINT;
151 argtype["H"] = DT_CHAR;
152 argtype["N"] = DT_NUMERIC;
153 argtype["A"] = DT_ANY;
154 argtype["L"] = DT_LOG4;
155 argtype["SL"] = DT_SLOG;
156 argtype["I8"] = DT_INT8;
157 argtype["L8"] = DT_LOG8;
158 argtype["K"] = DT_NCHAR;
159 argtype["Q"] = DT_QUAD;
160 argtype["CQ"] = DT_QCMPLX;
161 argtype["BI"] = DT_BINT;
162 argtype["AD"] = DT_ADDR;
163 elt[".IN"] = LT_IN;
164 elt[".GN"] = LT_GN;
165 elt[".PD"] = LT_PD;
166 elt[".sh"] = LT_sh;
167 elt[".AT"] = LT_AT;
168 elt[".H1"] = LT_H1;
169 elt[".H2"] = LT_H2;
170 elt[".H3"] = LT_H3;
171 elt[".H4"] = LT_H4;
172 elt[".H5"] = LT_H5;
173 elt[".H6"] = LT_H6;
174 elt[".H7"] = LT_H7;
175 elt[".H8"] = LT_H8;
176 elt[".H9"] = LT_H9;
177
178 // FIXME this initializes the global variable stb. In the future
179 // STB should become a class with normal C++ class constructors,
180 // and this call will not be necessary.
181 sym_init_first();
182
183 int output_file_argument = 0;
184 for (int arg = 1; arg < argc; ++arg) {
185 if (strcmp(argv[arg], "-o") == 0) {
186 output_file_argument = 1;
187 } else if (strcmp(argv[arg], "-s") == 0) {
188 sphinx_filename = argv[++arg];
189 } else if (argv[arg][0] == '-') {
190 usage("unknown option");
191 } else if (0 == output_file_argument) {
192 ifs.open(argv[arg]);
193 } else {
194 switch (output_file_argument) {
195 case 1:
196 out1 = fopen(argv[arg], "w");
197 ++output_file_argument;
198 break;
199 case 2:
200 out2 = fopen(argv[arg], "w");
201 ++output_file_argument;
202 break;
203 case 3:
204 out3 = fopen(argv[arg], "w");
205 ++output_file_argument;
206 break;
207 case 4:
208 out4 = fopen(argv[arg], "w");
209 ++output_file_argument;
210 break;
211 case 5:
212 out5 = fopen(argv[arg], "w");
213 ++output_file_argument;
214 break;
215 default:
216 usage("too many output files");
217 }
218 }
219 }
220 if (output_file_argument < 5) {
221 usage("missing some output file names");
222 }
223 if (!sphinx_filename.empty()) {
224 sphinx.setOutputFile(sphinx_filename);
225 }
226 }
227
228 int
run()229 run()
230 {
231 process_intrinsics();
232 process_generics();
233 process_predeclared();
234 consume_macros(LT_H1, hpf_lib_first, hpf_lib_last);
235 consume_macros(LT_H2, hpf_local_lib_first, hpf_local_lib_last);
236 consume_macros(LT_H3, craft_first, craft_last);
237 // FIXME: further refactoring is necessary. The following are
238 // variants of the previous three process_*() functions.
239 process_cray(); // process_predeclared
240 process_iso(); // process_intrinsics
241 process_ieeearith(); // process_predeclared
242 process_ieeeexcept(); // process_predeclared
243 process_miscellaneous(); // process_predeclared
244
245 write_symfile();
246 write_out4();
247 write_out5();
248
249 return 0;
250 }
251
252 private:
253 void
usage(const char * error=0)254 usage(const char *error = 0)
255 {
256 printf("Usage: symini input_file -o output_files\n\n");
257 printf("input_file -- input file with symbol definitions\n");
258 printf("-o output_files -- generated C header files.\n\n");
259 if (error) {
260 fprintf(stderr, "Invalid command line: %s\n\n", error);
261 exit(1);
262 }
263 }
264
265 /**
266 \brief find a symbol in the symbol table if any.
267
268 \param name is a symbol to find
269
270 \return pointer if there is an entry for name in symbol table,
271 otherwise return SPTR_NULL.
272 */
273 SPTR
find_symbol(const std::string & name)274 find_symbol(const std::string &name)
275 {
276 auto length = name.length();
277 if (length > MAXIDLEN) {
278 length = MAXIDLEN;
279 }
280 INT hashval; /* index into hashtb. */
281 HASH_ID(hashval, name.c_str(), length);
282 for (SPTR sptr = stb.hashtb[hashval]; sptr; sptr = HASHLKG(sptr)) {
283 if (name == SYMNAME(sptr))
284 return sptr;
285 }
286 return SPTR_NULL;
287 }
288
289 std::string
nodollar(const std::string & s)290 nodollar(const std::string &s)
291 {
292 std::string result;
293 for (auto c = s.begin(), E = s.end(); c != E; ++c) {
294 result.push_back(*c == '$' ? '_' : *c);
295 }
296 return result;
297 }
298
299 int
get_ilm(const std::string & ilmn)300 get_ilm(const std::string &ilmn)
301 {
302 if (ilmn == "" || ilmn[0] == '-') {
303 return 0;
304 }
305 auto it = std::find(ilms.begin(), ilms.end(), ilmn);
306 if (it == ilms.end()) {
307 ilms.push_back(ilmn);
308 return (int)ilms.size();
309 }
310 return it - ilms.begin() + 1;
311 }
312
313 void
emit_i_intr(SPTR sptr)314 emit_i_intr(SPTR sptr)
315 {
316 fprintf(out3, "#define I_");
317 const char *p = SYMNAME(sptr);
318 if (*p == '.') {
319 ++p;
320 }
321 for (; *p != '\0'; ++p) {
322 fputc(*p == '$' ? '_' : (islower(*p) ? toupper(*p) : *p), out3);
323 }
324 int index = (int)intast_sym.size();
325 INTASTP(sptr, index);
326 fprintf(out3, " %d\n", index);
327 intast_sym.push_back(sptr);
328 }
329
330 DTYPE
search_atyp(const std::string & atyp)331 search_atyp(const std::string &atyp)
332 {
333 auto it = argtype.find(atyp);
334 if (it != argtype.end()) {
335 return it->second;
336 }
337 return DT_NONE;
338 }
339
340 void
consume_macros(int code,int & first,int & last)341 consume_macros(int code, int &first, int &last)
342 {
343 first = 0;
344 auto lt = getLineAndTokenize(elt);
345 while (lt == code) {
346 lt = getLineAndTokenize(elt);
347 if (lt == LT_AT) {
348 lt = getLineAndTokenize(elt);
349 }
350 }
351 last = sptr;
352 }
353
354 void
process_at(SPTR sptr)355 process_at(SPTR sptr)
356 {
357 auto tok = makeLower(getToken());
358 switch (tok[0]) {
359 case 'e':
360 INKINDP(sptr, IK_ELEMENTAL);
361 break;
362 case 'i':
363 INKINDP(sptr, IK_INQUIRY);
364 break;
365 case 's':
366 INKINDP(sptr, IK_SUBROUTINE);
367 break;
368 case 't':
369 INKINDP(sptr, IK_TRANSFORM);
370 break;
371 default:
372 printError(WARN, "Illegal intrinsic kind in .AT");
373 return;
374 }
375
376 int kindpos = 0;
377 std::string buf;
378 for (int pos = 1;; ++pos) {
379 tok = getToken();
380 if (tok.empty()) {
381 break;
382 }
383 buf += std::string(" ") + tok;
384 // look for optional KIND argument
385 if (tok.substr(0, 5) == "*kind") {
386 kindpos = pos;
387 }
388 }
389 if (!buf.empty()) {
390 auto it = std::find(intr_kwd.begin(), intr_kwd.end(), buf.substr(1));
391 if (it == intr_kwd.end()) {
392 intr_kwd.push_back(buf.substr(1));
393 it = intr_kwd.end() - 1;
394 }
395 KWDARGP(sptr, it - intr_kwd.begin());
396 } else {
397 KWDARGP(sptr, 0);
398 }
399 int len = 0;
400 int i = 1;
401 for (std::string::const_iterator c = buf.begin(), E = buf.end(); c != E;
402 ++c) {
403 if (*c == '.') {
404 len--;
405 break;
406 }
407 if (*c == ' ') {
408 i = 1;
409 continue;
410 }
411 if (i) {
412 len++;
413 i = 0;
414 }
415 }
416 KWDCNTP(sptr, len);
417 if (STYPEG(sptr) == ST_GENERIC) {
418 KINDPOSP(sptr, kindpos);
419 }
420 }
421
422 void
oldsyms(const char ** init_names,int init_syms_size,int index)423 oldsyms(const char **init_names, int init_syms_size, int index)
424 {
425 int i, k;
426 SPTR j;
427 short *map_init = (short *)malloc(init_syms_size * sizeof(short));
428 if (map_init == NULL)
429 printError(FATAL, "oldsyms: malloc no space");
430 for (i = 0; i < init_syms_size; ++i) {
431 for (j = SPTR(0); j < stb.stg_avail; ++j) {
432 const char *p, *q;
433 p = init_names[i];
434 q = SYMNAME(j);
435 if (p[0] == '.')
436 p++;
437 if (q[0] == '.')
438 q++;
439 if (strcmp(p, q) == 0)
440 goto found;
441 }
442 printError(INFO, "no map for ", init_names[i]);
443 found:
444 map_init[i] = j;
445 }
446 fprintf(out1, "\n");
447 fprintf(out1, "static int init_syms%d_size = %d;\n", index, init_syms_size);
448 fprintf(out1, "\n");
449 fprintf(out1, "static short map_init%d[%d] = {\n ", index,
450 init_syms_size);
451 k = 0;
452 for (i = 0; i < init_syms_size; i++) {
453 if (k >= 16) {
454 fprintf(out1, "\n ");
455 k = 0;
456 }
457 fprintf(out1, "%3d,", map_init[i]);
458 k++;
459 }
460 fprintf(out1, "\n};\n");
461 free(map_init);
462 }
463
464 std::string
create_symbol(SYMTYPE ST,SPTR * sptr,const char * category,bool ignore_dot=false)465 create_symbol(SYMTYPE ST, SPTR *sptr, const char *category,
466 bool ignore_dot = false)
467 {
468 auto t = makeLower(getToken());
469 *sptr = installsym(t.c_str(), t.length());
470 if (STYPEG(*sptr) != ST_UNKNOWN) {
471 printError(SEVERE, "Redefinition of ", category);
472 }
473 STYPEP(*sptr, ST);
474 if (ignore_dot || t[0] != '.') {
475 emit_i_intr(*sptr);
476 }
477 return t;
478 }
479
480 DTYPE
get_type(const std::string & token)481 get_type(const std::string &token)
482 {
483 DTYPE type = search_atyp(token);
484 if (type == DT_NONE) {
485 printError(SEVERE, "bad type, assumed to be DT_INT");
486 type = DT_INT;
487 }
488 return type;
489 }
490
491 /* .IN name pcnt atyp dtype ILM pname arrayf */
492 void
process_intrinsics()493 process_intrinsics()
494 {
495 auto lt = getLineAndTokenize(elt);
496 if (lt != LT_sh) {
497 printError(FATAL, "missing .sh before intrinsics");
498 }
499 lt = getLineAndTokenize(elt);
500 while (lt == LT_IN) {
501 auto tok = create_symbol(ST_INTRIN, &sptr, "intrinsic");
502 /* pcnt */
503 tok = getToken();
504 if (!isdigit(tok[0])) {
505 printError(SEVERE, "param count missing, assumed to be 1");
506 PARAMCTP(sptr, 1);
507 } else {
508 PARAMCTP(sptr, atoi(tok.c_str()));
509 }
510 /* atyp */
511 ARGTYPP(sptr, get_type(getToken()));
512 /* dtype */
513 INTTYPP(sptr, get_type(getToken()));
514 /* ILM */
515 tok = getToken();
516 ILMP(sptr, tok == "tc" ? 0 : get_ilm(tok));
517 /* pname */
518 tok = getToken();
519 if (tok.empty()) {
520 PNMPTRP(sptr, 0);
521 ARRAYFP(sptr, 0);
522 } else {
523 if (tok[0] == '-') {
524 if (tok.length() == 1)
525 PNMPTRP(sptr, 0);
526 else
527 PNMPTRP(sptr, putsname(tok.c_str(), tok.length()));
528 } else if (tok[0] == '*') {
529 if (tok.length() == 1) {
530 if (star_str == 0)
531 star_str = putsname("*", 1);
532 PNMPTRP(sptr, star_str);
533 } else
534 PNMPTRP(sptr, putsname(tok.c_str(), tok.length()));
535 } else
536 PNMPTRP(sptr, putsname(tok.c_str(), tok.length()));
537 /* aflag */
538 ARRAYFP(sptr, get_ilm(getToken()));
539 tok = getToken();
540 NATIVEP(sptr, tok.empty() || tok == "native" ? 0 : 1);
541 }
542 lt = getLineAndTokenize(elt);
543 if (lt == LT_AT) {
544 process_at(sptr);
545 lt = getLineAndTokenize(elt);
546 } else {
547 printError(WARN, "missing .AT after .IN");
548 }
549 }
550 if (lt != LT_sh) {
551 printError(FATAL, "missing .sh after intrinsics");
552 }
553 }
554
555 /* .GN name siname iname rname dname cname cdname i8name qname cqname */
556 void
process_generics()557 process_generics()
558 {
559 auto lt = getLineAndTokenize(elt);
560 while (lt == LT_GN) {
561 auto tok = create_symbol(ST_GENERIC, &sptr, "generic");
562
563 /* should make sure types are correct here, but ... */
564 /* siname */
565 tok = makeLower(getToken());
566 if (tok.empty() || tok[0] == '-')
567 GSINTP(sptr, SPTR_NULL);
568 else {
569 SPTR sptr1 = installsym(tok.c_str(), tok.length());
570 if (STYPEG(sptr1) != ST_INTRIN)
571 printError(SEVERE, "Non-existent SI intrinsic");
572 GSINTP(sptr, sptr1);
573 if (tok[0] == '.') {
574 INTASTP(sptr1, intast_sym.size() - 1);
575 }
576 }
577 /* iname */
578 tok = makeLower(getToken());
579 if (tok.empty() || tok[0] == '-')
580 GINTP(sptr, SPTR_NULL);
581 else {
582 SPTR sptr1 = installsym(tok.c_str(), tok.length());
583 if (STYPEG(sptr1) != ST_INTRIN)
584 printError(SEVERE, "Non-existent I intrinsic");
585 GINTP(sptr, sptr1);
586 if (tok[0] == '.') {
587 INTASTP(sptr1, intast_sym.size() - 1);
588 }
589 }
590 /* rname */
591 tok = makeLower(getToken());
592 if (tok.length() <= 0 || tok[0] == '-')
593 GREALP(sptr, SPTR_NULL);
594 else {
595 SPTR sptr1 = installsym(tok.c_str(), tok.length());
596 if (STYPEG(sptr1) != ST_INTRIN)
597 printError(SEVERE, "Non-existent R intrinsic");
598 GREALP(sptr, sptr1);
599 if (tok[0] == '.') {
600 INTASTP(sptr1, intast_sym.size() - 1);
601 }
602 }
603 /* dname */
604 tok = makeLower(getToken());
605 if (tok.empty() || tok[0] == '-')
606 GDBLEP(sptr, SPTR_NULL);
607 else {
608 SPTR sptr1 = installsym(tok.c_str(), tok.length());
609 if (STYPEG(sptr1) != ST_INTRIN)
610 printError(SEVERE, "Non-existent D intrinsic");
611 GDBLEP(sptr, sptr1);
612 if (tok[0] == '.') {
613 INTASTP(sptr1, intast_sym.size() - 1);
614 }
615 }
616 /* cname */
617 tok = makeLower(getToken());
618 if (tok.empty() || tok[0] == '-')
619 GCMPLXP(sptr, SPTR_NULL);
620 else {
621 SPTR sptr1 = installsym(tok.c_str(), tok.length());
622 if (STYPEG(sptr1) != ST_INTRIN)
623 printError(SEVERE, "Non-existent C intrinsic");
624 GCMPLXP(sptr, sptr1);
625 if (tok[0] == '.') {
626 INTASTP(sptr1, intast_sym.size() - 1);
627 }
628 }
629 /* cdname */
630 tok = makeLower(getToken());
631 if (tok.empty() || tok[0] == '-')
632 GDCMPLXP(sptr, SPTR_NULL);
633 else {
634 SPTR sptr1 = installsym(tok.c_str(), tok.length());
635 if (STYPEG(sptr1) != ST_INTRIN)
636 printError(SEVERE, "Non-existent CD intrinsic");
637 GDCMPLXP(sptr, sptr1);
638 if (tok[0] == '.') {
639 INTASTP(sptr1, intast_sym.size() - 1);
640 }
641 }
642 /* i8name */
643 tok = makeLower(getToken());
644 if (tok.empty() || tok[0] == '-')
645 GINT8P(sptr, SPTR_NULL);
646 else {
647 SPTR sptr1 = installsym(tok.c_str(), tok.length());
648 if (STYPEG(sptr1) != ST_INTRIN)
649 printError(SEVERE, "Non-existent I8 intrinsic");
650 GINT8P(sptr, sptr1);
651 if (tok[0] == '.') {
652 INTASTP(sptr1, intast_sym.size() - 1);
653 }
654 }
655 /* qname */
656 tok = makeLower(getToken());
657 if (tok.empty() || tok[0] == '-')
658 GQUADP(sptr, SPTR_NULL);
659 else {
660 SPTR sptr1 = installsym(tok.c_str(), tok.length());
661 if (STYPEG(sptr1) != ST_INTRIN)
662 printError(SEVERE, "Non-existent Q intrinsic");
663 GQUADP(sptr, sptr1);
664 if (tok[0] == '.') {
665 INTASTP(sptr1, intast_sym.size() - 1);
666 }
667 }
668 /* cqname */
669 tok = makeLower(getToken());
670 if (tok.empty() || tok[0] == '-')
671 GQCMPLXP(sptr, SPTR_NULL);
672 else {
673 SPTR sptr1 = installsym(tok.c_str(), tok.length());
674 if (STYPEG(sptr1) != ST_INTRIN)
675 printError(SEVERE, "Non-existent CQ intrinsic");
676 GQCMPLXP(sptr, sptr1);
677 if (tok[0] == '.') {
678 INTASTP(sptr1, intast_sym.size() - 1);
679 }
680 }
681 /* gsame */
682 SPTR sptr1 = find_symbol(std::string(".") + SYMNAME(sptr));
683 if (sptr1 != 0 && STYPEG(sptr1) == ST_INTRIN) {
684 GSAMEP(sptr, sptr1);
685 INTASTP(sptr1, intast_sym.size() - 1);
686 } else
687 GSAMEP(sptr, SPTR_NULL);
688 lt = getLineAndTokenize(elt);
689 if (lt == LT_AT) {
690 process_at(sptr);
691 lt = getLineAndTokenize(elt);
692 } else
693 printError(WARN, "missing .AT after .GN");
694 }
695 if (lt != LT_sh) {
696 printError(FATAL, "missing .sh after generics");
697 }
698 }
699
700 /* .PD name pname dtype */
701 void
process_predeclared()702 process_predeclared()
703 {
704 auto lt = getLineAndTokenize(elt);
705 while (lt == LT_PD) {
706 ++npd;
707 auto tok = create_symbol(ST_PD, &sptr, "predeclared", true);
708 /* output predeclared line */
709 auto s =
710 nodollar(std::string("PD_") + (tok[0] == '.' ? tok.substr(1) : tok));
711 fprintf(out2, "#define %-20s%6d\n", s.c_str(), npd);
712
713 /* init PD sym */
714 DTYPEP(sptr, 0);
715 PDNUMP(sptr, npd);
716
717 tok = getToken(); /* get pname */
718 if (tok.empty()) {
719 printError(WARN, ".PD, no pname for ", SYMNAME(sptr));
720 } else {
721 if (tok[0] == '-')
722 PNMPTRP(sptr, 0);
723 else {
724 makeLower(tok);
725 PNMPTRP(sptr, putsname(tok.c_str(), tok.length()));
726 }
727 tok = getToken(); /* get dtype */
728 if (tok.empty()) {
729 printError(WARN, ".PD, no dtype for ", SYMNAME(sptr));
730 } else if (tok[0] != '-') {
731 INTTYPP(sptr, get_type(tok));
732 }
733 }
734
735 tok = getToken();
736 NATIVEP(sptr, tok.empty() || tok == "native" ? 0 : 1);
737
738 lt = getLineAndTokenize(elt);
739 if (lt == LT_AT) {
740 process_at(sptr);
741 lt = getLineAndTokenize(elt);
742 } else
743 printError(WARN, "missing .AT after .PD");
744 }
745 }
746
747 /* .H4 name pname dtype */
748 void
process_cray()749 process_cray()
750 {
751 cray_first = 0;
752 auto lt = getLineAndTokenize(elt);
753 while (lt == LT_H4) {
754 ++npd;
755 auto tok = create_symbol(ST_CRAY, &sptr, "predeclared");
756 if (cray_first == 0)
757 cray_first = sptr;
758 if (tok[0] != '.') {
759 /* output predeclared line */
760 auto s = nodollar(std::string("PD_") + tok);
761 fprintf(out2, "#define %-20s%6d\n", s.c_str(), npd);
762 }
763
764 /* init PD sym */
765 DTYPEP(sptr, 0);
766 PDNUMP(sptr, npd);
767
768 tok = makeLower(getToken()); /* get pname */
769 if (tok.empty()) {
770 printError(WARN, ".H4, no pname for ", SYMNAME(sptr));
771 } else {
772 PNMPTRP(sptr, tok[0] == '-' ? 0 : putsname(tok.c_str(), tok.length()));
773 tok = getToken(); /* get dtype */
774 if (tok.empty()) {
775 printError(WARN, ".H4, no dtype for ", SYMNAME(sptr));
776 } else if (tok[0] != '-') {
777 INTTYPP(sptr, get_type(tok));
778 }
779 }
780
781 lt = getLineAndTokenize(elt);
782 if (lt == LT_AT) {
783 process_at(sptr);
784 lt = getLineAndTokenize(elt);
785 } else
786 printError(WARN, "missing .AT after .H4");
787 }
788 cray_last = sptr;
789 }
790
791 /* ISO_C_BINDING intrinsics */
792 /* .IN name pcnt atyp dtype ILM pname arrayf */
793 void
process_iso()794 process_iso()
795 {
796 iso_c_first = 0;
797 auto lt = getLineAndTokenize(elt);
798
799 while (lt == LT_IN) {
800 auto tok = create_symbol(ST_ISOC, &sptr, "intrinsic");
801 if (iso_c_first == 0)
802 iso_c_first = sptr;
803
804 /* pcnt */
805 tok = getToken();
806 if (!isdigit(tok[0])) {
807 printError(SEVERE, "param count missing, assumed to be 1");
808 PARAMCTP(sptr, 1);
809 } else {
810 PARAMCTP(sptr, atoi(tok.c_str()));
811 }
812 /* atyp */
813 ARGTYPP(sptr, get_type(getToken()));
814 /* dtype */
815 INTTYPP(sptr, get_type(getToken()));
816 /* hard code the dtypes for c_loc, c_funloc
817 for easier type checking */
818 if (INTTYPG(sptr) == DT_ANY)
819 DTYPEP(sptr, DT_ADDR);
820 /* ILM */
821 tok = getToken();
822 ILMP(sptr, tok == "tc" ? 0 : get_ilm(tok));
823 /* pname */
824 tok = getToken();
825 if (tok.empty()) {
826 PNMPTRP(sptr, 0);
827 ARRAYFP(sptr, 0);
828 } else {
829 if (tok[0] == '-') {
830 if (tok.length() == 1)
831 PNMPTRP(sptr, 0);
832 else
833 PNMPTRP(sptr, putsname(tok.c_str(), tok.length()));
834 } else if (tok[0] == '*') {
835 if (tok.length() == 1) {
836 if (star_str == 0)
837 star_str = putsname("*", 1);
838 PNMPTRP(sptr, star_str);
839 } else
840 PNMPTRP(sptr, putsname(tok.c_str(), tok.length()));
841 } else
842 PNMPTRP(sptr, putsname(tok.c_str(), tok.length()));
843 /* aflag */
844 ARRAYFP(sptr, get_ilm(getToken()));
845 tok = getToken();
846 NATIVEP(sptr, tok.empty() || tok == "native" ? 0 : 1);
847 }
848
849 lt = getLineAndTokenize(elt);
850 if (lt == LT_AT) {
851 process_at(sptr);
852 lt = getLineAndTokenize(elt);
853 } else
854 printError(WARN, "missing .AT after .IN");
855 } /* end while */
856
857 iso_c_last = sptr;
858 }
859
860 /* .H5 name pname dtype */
861 void
process_ieeearith()862 process_ieeearith()
863 {
864 ieeearith_first = 0;
865 auto lt = getLineAndTokenize(elt);
866 while (lt == LT_H5) {
867 ++npd;
868 auto tok = create_symbol(ST_IEEEARITH, &sptr, "predeclared");
869 if (ieeearith_first == 0)
870 ieeearith_first = sptr;
871 /* output predeclared line */
872 auto s = nodollar(std::string("PD_") + tok);
873 fprintf(out2, "#define %-20s%6d\n", s.c_str(), npd);
874
875 /* init PD sym */
876 DTYPEP(sptr, 0);
877 PDNUMP(sptr, npd);
878
879 tok = makeLower(getToken()); /* get pname */
880 if (tok.empty()) {
881 printError(WARN, ".H5, no pname for ", SYMNAME(sptr));
882 } else {
883 PNMPTRP(sptr, tok[0] == '-' ? 0 : putsname(tok.c_str(), tok.length()));
884 tok = getToken(); /* get dtype */
885 if (tok.empty()) {
886 printError(WARN, ".H5, no dtype for ", SYMNAME(sptr));
887 } else if (tok[0] != '-') {
888 INTTYPP(sptr, get_type(tok));
889 }
890 }
891
892 lt = getLineAndTokenize(elt);
893 if (lt == LT_AT) {
894 process_at(sptr);
895 lt = getLineAndTokenize(elt);
896 } else
897 printError(WARN, "missing .AT after .H5");
898 }
899 ieeearith_last = sptr;
900 }
901
902 /* .H6 name pname dtype */
903 void
process_ieeeexcept()904 process_ieeeexcept()
905 {
906 ieeeexcept_first = 0;
907 auto lt = getLineAndTokenize(elt);
908 while (lt == LT_H6) {
909 ++npd;
910 auto tok = create_symbol(ST_IEEEEXCEPT, &sptr, "predeclared");
911 if (ieeeexcept_first == 0)
912 ieeeexcept_first = sptr;
913 /* output predeclared line */
914 auto s = nodollar(std::string("PD_") + tok);
915 fprintf(out2, "#define %-20s%6d\n", s.c_str(), npd);
916
917 /* init PD sym */
918 DTYPEP(sptr, 0);
919 PDNUMP(sptr, npd);
920
921 tok = makeLower(getToken()); /* get pname */
922 if (tok.empty()) {
923 printError(WARN, ".H6, no pname for", SYMNAME(sptr));
924 } else {
925 PNMPTRP(sptr, tok[0] == '-' ? 0 : putsname(tok.c_str(), tok.length()));
926 tok = getToken(); /* get dtype */
927 if (tok.empty()) {
928 printError(WARN, ".H6, no dtype for", SYMNAME(sptr));
929 } else if (tok[0] != '-') {
930 INTTYPP(sptr, get_type(tok));
931 }
932 }
933
934 lt = getLineAndTokenize(elt);
935 if (lt == LT_AT) {
936 process_at(sptr);
937 lt = getLineAndTokenize(elt);
938 } else
939 printError(WARN, "missing .AT after .H6");
940 }
941 ieeeexcept_last = sptr;
942 }
943
944 /* .H7 name pname dtype */
945 void
process_miscellaneous()946 process_miscellaneous()
947 {
948 auto lt = getLineAndTokenize(elt);
949 while (lt == LT_H7 || lt == LT_H8 || lt == LT_H9) {
950 ++npd;
951 auto tok = create_symbol(ST_ISOFTNENV, &sptr, "predeclared");
952 if (tok[0] == '.') { // FIXME: not clear why this
953 INTASTP(sptr, intast_sym.size()); // is needed, but it's what
954 intast_sym.push_back(0); // the original symini
955 } // appears to be doing.
956 if (lt == LT_H7) {
957 STYPEP(sptr, ST_PD);
958 } else if (lt == LT_H8) {
959 STYPEP(sptr, ST_ISOC);
960 }
961 if (tok[0] != '.') {
962 /* output predeclared line */
963 auto s = nodollar(std::string("PD_") + tok);
964 fprintf(out2, "#define %-20s%6d\n", s.c_str(), npd);
965 }
966
967 /* init PD sym */
968 DTYPEP(sptr, 0);
969 PDNUMP(sptr, npd);
970
971 tok = makeLower(getToken()); /* get pname */
972 if (tok.empty())
973 printError(WARN, ".H7, no pname for ", SYMNAME(sptr));
974 else {
975 PNMPTRP(sptr, tok[0] == '-' ? 0 : putsname(tok.c_str(), tok.length()));
976 tok = getToken(); /* get dtype */
977 if (tok.empty()) {
978 printError(WARN, ".H7, no dtype for ", SYMNAME(sptr));
979 } else if (tok[0] != '-') {
980 INTTYPP(sptr, get_type(tok));
981 }
982 }
983
984 lt = getLineAndTokenize(elt);
985 if (lt == LT_AT) {
986 process_at(sptr);
987 lt = getLineAndTokenize(elt);
988 } else
989 printError(WARN, "missing .AT after .H7");
990 }
991 }
992
993 /* now write symfile */
994 void
write_symfile()995 write_symfile()
996 {
997 fprintf(out1, "#define HPF_LIB_FIRST %d\n", hpf_lib_first);
998 fprintf(out1, "#define HPF_LIB_LAST %d\n", hpf_lib_last);
999 fprintf(out1, "#define HPF_LOCAL_LIB_FIRST %d\n", hpf_local_lib_first);
1000 fprintf(out1, "#define HPF_LOCAL_LIB_LAST %d\n", hpf_local_lib_last);
1001 fprintf(out1, "#define CRAFT_FIRST %d\n", craft_first);
1002 fprintf(out1, "#define CRAFT_LAST %d\n", craft_last);
1003 fprintf(out1, "#define CRAY_FIRST %d\n", cray_first);
1004 fprintf(out1, "#define CRAY_LAST %d\n", cray_last);
1005 fprintf(out1, "#define ISO_C_FIRST %d\n", iso_c_first);
1006 fprintf(out1, "#define ISO_C_LAST %d\n", iso_c_last);
1007 fprintf(out1, "#define IEEEARITH_FIRST %d\n", ieeearith_first);
1008 fprintf(out1, "#define IEEEARITH_LAST %d\n", ieeearith_last);
1009 fprintf(out1, "#define IEEEEXCEPT_FIRST %d\n", ieeeexcept_first);
1010 fprintf(out1, "#define IEEEEXCEPT_LAST %d\n", ieeeexcept_last);
1011 fprintf(out1, "#define INIT_SYMTAB_SIZE %d\n", stb.stg_avail);
1012 fprintf(out1, "#define INIT_NAMES_SIZE %d\n", stb.namavl);
1013 fprintf(out1, "static SYM init_sym[INIT_SYMTAB_SIZE] = {\n");
1014 BZERO(stb.stg_base + 0, SYM, 1);
1015 stb.n_base[0] = '\0';
1016 for (SPTR i = SPTR(0); i < stb.stg_avail; ++i) {
1017 SYM *xp = &stb.stg_base[i];
1018 assert(xp->stype <= ST_MAX);
1019 assert(xp->sc <= SC_MAX);
1020 fprintf(out1, "\t{%s, %s, %3d, %3d,\t/* %s */\n",
1021 SYMTYPE_names[xp->stype], SC_KIND_names[xp->sc], xp->b3, xp->b4,
1022 SYMNAME(i));
1023 fprintf(out1, "\t %3d, %3d, %3d, %3d, %5d,\n", xp->dtype, xp->hashlk,
1024 xp->symlk, xp->scope, xp->nmptr);
1025
1026 fprintf(out1, "\t ");
1027 for (int i = 1; i != 33; ++i) {
1028 fprintf(out1, "%d,", 0 /*xp->f*/);
1029 }
1030 fprintf(out1, "\n");
1031 fprintf(out1, "#ifdef INTIS64\n");
1032 fprintf(out1, "\t 0,\n");
1033 fprintf(out1, "#endif\n");
1034 fprintf(out1, "\t ");
1035 for (int i = 33; i != 65; ++i) {
1036 fprintf(out1, "%d,", 0 /*xp->f*/);
1037 }
1038 fprintf(out1, "\n");
1039 fprintf(out1, "#ifdef INTIS64\n");
1040 fprintf(out1, "\t 0,\n");
1041 fprintf(out1, "#endif\n");
1042
1043 fprintf(out1, "\t %5d, %5ld, %5d, %5d, %5d, %5ld, %5d, %5d,\n", xp->w9,
1044 xp->w10, xp->w11, xp->w12, xp->w13, xp->w14, xp->w15, xp->w16);
1045 fprintf(out1, "\t %5d, %5d, %5d, %5d, %5d, %5d, %5d, %5d,\n", xp->w17,
1046 xp->w18, xp->w19, xp->w20, xp->w21, xp->w22, xp->w23, xp->w24);
1047 fprintf(out1, "\t %5d, %5d, %5d, %5d, %5d, %5d, %5d, %5d,\n", xp->w25,
1048 xp->w26, xp->w27, xp->w28, xp->uname, xp->w30, xp->w31, xp->w32);
1049
1050 fprintf(out1, "\t ");
1051 for (int i = 65; i != 97; ++i) {
1052 fprintf(out1, "%d,", 0 /*xp->f*/);
1053 }
1054 fprintf(out1, "\n");
1055 fprintf(out1, "#ifdef INTIS64\n");
1056 fprintf(out1, "\t 0,\n");
1057 fprintf(out1, "#endif\n");
1058
1059 fprintf(out1, "\t %5d, %5d, %5d,\n", xp->w34, xp->w35, xp->w36);
1060
1061 fprintf(out1, "\t ");
1062 for (int i = 97; i != 129; ++i) {
1063 fprintf(out1, "%d,", 0 /*xp->f*/);
1064 }
1065 fprintf(out1, "\n");
1066 fprintf(out1, "#ifdef INTIS64\n");
1067 fprintf(out1, "\t 0,\n");
1068 fprintf(out1, "#endif\n");
1069
1070 fprintf(out1, "\t %5d, %5d, %5d\n", xp->lineno, xp->w39, xp->w40);
1071
1072 fprintf(out1, "\t},\n");
1073 }
1074 fprintf(out1, "};\n\n");
1075 fprintf(out1, "static char init_names[INIT_NAMES_SIZE] = {");
1076 int j = 16;
1077 for (int i = 0; i < stb.namavl; ++i) {
1078 if (j == 16) {
1079 fprintf(out1, "\n\t");
1080 j = 0;
1081 }
1082 ++j;
1083 if (stb.n_base[i])
1084 fprintf(out1, "'%c',", stb.n_base[i]);
1085 else
1086 fprintf(out1, "0, ");
1087 }
1088 fprintf(out1, "\n};\n\n");
1089 fprintf(out1, "static int init_hashtb[HASHSIZE] = {");
1090 j = 10;
1091 for (int i = 0; i < HASHSIZE; ++i) {
1092 if (j == 10) {
1093 fprintf(out1, "\n\t");
1094 j = 0;
1095 }
1096 ++j;
1097 fprintf(out1, "%5d, ", stb.hashtb[i]);
1098 }
1099 fprintf(out1, "\n};\n\n");
1100
1101 fprintf(out1, "char *intrinsic_kwd[%d] = {\n", (int)intr_kwd.size());
1102 for (int i = 0; i != (int)intr_kwd.size(); ++i)
1103 fprintf(out1, " /*%5d */ \"%s\",\n", i, intr_kwd[i].c_str());
1104 fprintf(out1, "\n};\n");
1105
1106 oldsyms(init_names0, init_names0_size, 0);
1107 oldsyms(init_names1, init_names1_size, 1);
1108 oldsyms(init_names2, init_names2_size, 2);
1109 oldsyms(init_names3, init_names3_size, 3);
1110 }
1111
1112 void
write_out4()1113 write_out4()
1114 {
1115 fprintf(out4, "int intast_sym[%d] = {", (int)intast_sym.size());
1116 int j = 10;
1117 for (int i = 0; i != (int)intast_sym.size(); ++i) {
1118 if (j == 10) {
1119 fprintf(out4, "\n\t");
1120 j = 0;
1121 }
1122 ++j;
1123 fprintf(out4, "%5d, ", intast_sym[i]);
1124 }
1125 fprintf(out4, "\n};\n");
1126 }
1127
1128 void
write_out5()1129 write_out5()
1130 {
1131 fprintf(out5, "#define N_ILM %d\n", (int)ilms.size() + 1);
1132 for (int i = 0; i != (int)ilms.size(); ++i)
1133 fprintf(out5, "#define IM_%s %d\n", ilms[i].c_str(), i + 1);
1134 }
1135 };
1136
1137 int
main(int argc,char ** argv)1138 main(int argc, char **argv)
1139 {
1140 SyminiFE90 app(argc, argv);
1141 return app.run();
1142 }
1143
1144 /**
1145 * 6.1 names
1146 */
1147 const char *SyminiFE90::init_names0[] = {
1148 "",
1149 "..sqrt",
1150 ".sqrt",
1151 ".dsqrt",
1152 "dsqrt",
1153 ".qsqrt",
1154 ".csqrt",
1155 "csqrt",
1156 ".cdsqrt",
1157 "cdsqrt",
1158 ".cqsqrt",
1159 ".alog",
1160 "alog",
1161 ".dlog",
1162 "dlog",
1163 ".qlog",
1164 ".clog",
1165 "clog",
1166 ".cdlog",
1167 "cdlog",
1168 ".cqlog",
1169 ".alog10",
1170 "alog10",
1171 ".dlog10",
1172 "dlog10",
1173 ".qlog10",
1174 "..exp",
1175 ".exp",
1176 ".dexp",
1177 "dexp",
1178 ".qexp",
1179 ".cexp",
1180 "cexp",
1181 ".cdexp",
1182 "cdexp",
1183 ".cqexp",
1184 "..sin",
1185 ".sin",
1186 ".dsin",
1187 "dsin",
1188 ".qsin",
1189 ".csin",
1190 "csin",
1191 ".cdsin",
1192 "cdsin",
1193 ".cqsin",
1194 "..sind",
1195 ".sind",
1196 ".dsind",
1197 "dsind",
1198 ".qsind",
1199 "..cos",
1200 ".cos",
1201 ".dcos",
1202 "dcos",
1203 ".qcos",
1204 ".ccos",
1205 "ccos",
1206 ".cdcos",
1207 "cdcos",
1208 ".cqcos",
1209 "..cosd",
1210 ".cosd",
1211 ".dcosd",
1212 "dcosd",
1213 ".qcosd",
1214 "..tan",
1215 ".tan",
1216 ".dtan",
1217 "dtan",
1218 ".qtan",
1219 "..tand",
1220 ".tand",
1221 ".dtand",
1222 "dtand",
1223 ".qtand",
1224 "..asin",
1225 ".asin",
1226 ".dasin",
1227 "dasin",
1228 ".qasin",
1229 "..asind",
1230 ".asind",
1231 ".dasind",
1232 "dasind",
1233 ".qasind",
1234 "..acos",
1235 ".acos",
1236 ".dacos",
1237 "dacos",
1238 ".qacos",
1239 "..acosd",
1240 ".acosd",
1241 ".dacosd",
1242 "dacosd",
1243 ".qacosd",
1244 "..atan",
1245 ".atan",
1246 ".datan",
1247 "datan",
1248 ".qatan",
1249 "..atand",
1250 ".atand",
1251 ".datand",
1252 "datand",
1253 ".qatand",
1254 "..atan2",
1255 ".atan2",
1256 ".datan2",
1257 "datan2",
1258 ".qatan2",
1259 "..atan2d",
1260 ".atan2d",
1261 ".datan2d",
1262 "datan2d",
1263 ".qatan2d",
1264 "..sinh",
1265 ".sinh",
1266 ".dsinh",
1267 "dsinh",
1268 ".qsinh",
1269 "..cosh",
1270 ".cosh",
1271 ".dcosh",
1272 "dcosh",
1273 ".qcosh",
1274 "..tanh",
1275 ".tanh",
1276 ".dtanh",
1277 "dtanh",
1278 ".qtanh",
1279 "iiabs",
1280 "jiabs",
1281 "kiabs",
1282 ".iabs",
1283 "iabs",
1284 "..abs",
1285 ".abs",
1286 ".dabs",
1287 "dabs",
1288 ".qabs",
1289 ".cabs",
1290 "cabs",
1291 ".cdabs",
1292 "cdabs",
1293 ".cqabs",
1294 "..aimag",
1295 ".aimag",
1296 ".dimag",
1297 "dimag",
1298 ".qimag",
1299 "..conjg",
1300 ".conjg",
1301 ".dconjg",
1302 "dconjg",
1303 ".qconjg",
1304 "dprod",
1305 "imax0",
1306 ".max0",
1307 "max0",
1308 ".amax1",
1309 "amax1",
1310 ".dmax1",
1311 "dmax1",
1312 ".kmax",
1313 "kmax0",
1314 ".qmax",
1315 "jmax0",
1316 "aimax0",
1317 "amax0",
1318 "max1",
1319 "imax1",
1320 "jmax1",
1321 "kmax1",
1322 "ajmax0",
1323 "imin0",
1324 ".min0",
1325 "min0",
1326 ".amin1",
1327 "amin1",
1328 ".dmin1",
1329 "dmin1",
1330 ".kmin",
1331 "kmin0",
1332 ".qmin",
1333 "jmin0",
1334 "amin0",
1335 "aimin0",
1336 "min1",
1337 "imin1",
1338 "jmin1",
1339 "kmin1",
1340 "ajmin0",
1341 "iidim",
1342 "jidim",
1343 ".idim",
1344 "idim",
1345 "kidim",
1346 "..dim",
1347 ".dim",
1348 ".ddim",
1349 "ddim",
1350 ".qdim",
1351 "imod",
1352 "jmod",
1353 "..mod",
1354 ".mod",
1355 "kmod",
1356 ".amod",
1357 "amod",
1358 ".dmod",
1359 "dmod",
1360 ".qmod",
1361 ".imodulo",
1362 "..modulo",
1363 ".modulo",
1364 ".kmodulo",
1365 "..amodulo",
1366 ".amodulo",
1367 "..dmodulo",
1368 ".dmodulo",
1369 ".qmodulo",
1370 "iisign",
1371 "jisign",
1372 ".isign",
1373 "isign",
1374 "kisign",
1375 "..sign",
1376 ".sign",
1377 ".dsign",
1378 "dsign",
1379 ".qsign",
1380 "iiand",
1381 ".jiand",
1382 "jiand",
1383 ".kiand",
1384 "iior",
1385 ".jior",
1386 "jior",
1387 ".kior",
1388 "iieor",
1389 ".jieor",
1390 "jieor",
1391 ".kieor",
1392 "inot",
1393 ".jnot",
1394 "jnot",
1395 ".knot",
1396 "iishft",
1397 ".jishft",
1398 "jishft",
1399 "kishft",
1400 "iibits",
1401 ".jibits",
1402 "jibits",
1403 "kibits",
1404 "iibset",
1405 ".jibset",
1406 "jibset",
1407 "kibset",
1408 "bitest",
1409 ".bjtest",
1410 "bjtest",
1411 "bktest",
1412 "iibclr",
1413 ".jibclr",
1414 "jibclr",
1415 "kibclr",
1416 "iishftc",
1417 ".jishftc",
1418 "jishftc",
1419 "kishftc",
1420 ".ilshift",
1421 ".jlshift",
1422 ".klshift",
1423 ".irshift",
1424 ".jrshift",
1425 ".krshift",
1426 ".2sch",
1427 ".char",
1428 ".2kch",
1429 "ichar",
1430 "lge",
1431 "lgt",
1432 "lle",
1433 "llt",
1434 "nchar",
1435 "nlen",
1436 "nindex",
1437 "loc",
1438 "idint",
1439 "jidint",
1440 ".2i",
1441 "ifix",
1442 "jifix",
1443 ".jint",
1444 "iifix",
1445 ".iint",
1446 ".2si",
1447 "int8",
1448 "iidint",
1449 "floati",
1450 "floatj",
1451 "float",
1452 "sngl",
1453 ".2r",
1454 "dfloti",
1455 "dfloat",
1456 "dflotj",
1457 "dreal",
1458 ".2d",
1459 ".2c",
1460 ".2cd",
1461 "dint",
1462 "dnint",
1463 "..inint",
1464 ".inint",
1465 "iidnnt",
1466 "idnint",
1467 "..jnint",
1468 ".jnint",
1469 "jidnnt",
1470 "knint",
1471 "kidnnt",
1472 "iand",
1473 "ior",
1474 "ieor",
1475 "xor",
1476 "not",
1477 "ishft",
1478 "iint",
1479 "jint",
1480 "dble",
1481 "dcmplx",
1482 "imag",
1483 "aimag",
1484 "conjg",
1485 "inint",
1486 "jnint",
1487 "abs",
1488 "mod",
1489 "sign",
1490 "dim",
1491 "max",
1492 "min",
1493 "sqrt",
1494 "exp",
1495 "log",
1496 "log10",
1497 "sin",
1498 "sind",
1499 "cos",
1500 "cosd",
1501 "tan",
1502 "tand",
1503 "asin",
1504 "asind",
1505 "acos",
1506 "acosd",
1507 "atan",
1508 "atand",
1509 "atan2",
1510 "atan2d",
1511 "sinh",
1512 "cosh",
1513 "tanh",
1514 "ibits",
1515 "ibset",
1516 "btest",
1517 "ibclr",
1518 "ishftc",
1519 "lshift",
1520 "rshift",
1521 "modulo",
1522 "date",
1523 "exit",
1524 "idate",
1525 "time",
1526 "mvbits",
1527 "real",
1528 "cmplx",
1529 "int",
1530 "aint",
1531 "anint",
1532 "nint",
1533 "char",
1534 "zext",
1535 "izext",
1536 "jzext",
1537 "ceiling",
1538 "floor",
1539 "all",
1540 "and",
1541 "any",
1542 "compl",
1543 "count",
1544 "dot_product",
1545 "eqv",
1546 "matmul",
1547 "matmul_transpose",
1548 "maxloc",
1549 "maxval",
1550 "minloc",
1551 "minval",
1552 "merge",
1553 "neqv",
1554 "or",
1555 "pack",
1556 "product",
1557 "ran",
1558 "secnds",
1559 "shift",
1560 "sum",
1561 "spread",
1562 "transpose",
1563 "unpack",
1564 "number_of_processors",
1565 "lbound",
1566 "ubound",
1567 "cshift",
1568 "eoshift",
1569 "reshape",
1570 "shape",
1571 "size",
1572 "allocated",
1573 "date_and_time",
1574 "cpu_time",
1575 "random_number",
1576 "random_seed",
1577 "system_clock",
1578 "present",
1579 "kind",
1580 "selected_int_kind",
1581 "selected_real_kind",
1582 "dlbound",
1583 "dubound",
1584 "dshape",
1585 "dsize",
1586 "achar",
1587 "adjustl",
1588 "adjustr",
1589 "bit_size",
1590 "digits",
1591 "epsilon",
1592 "exponent",
1593 "fraction",
1594 "huge",
1595 "iachar",
1596 "index",
1597 "kindex",
1598 "logical",
1599 "maxexponent",
1600 "minexponent",
1601 "nearest",
1602 "precision",
1603 "radix",
1604 "range",
1605 "repeat",
1606 "rrspacing",
1607 "scale",
1608 "set_exponent",
1609 "spacing",
1610 "tiny",
1611 "transfer",
1612 "trim",
1613 "verify",
1614 "scan",
1615 "len",
1616 "klen",
1617 "len_trim",
1618 "dotproduct",
1619 "ilen",
1620 "null",
1621 "processors_shape",
1622 ".lastval",
1623 ".reduce_sum",
1624 ".reduce_product",
1625 ".reduce_any",
1626 ".reduce_all",
1627 ".reduce_parity",
1628 ".reduce_iany",
1629 ".reduce_iall",
1630 ".reduce_iparity",
1631 ".reduce_minval",
1632 ".reduce_maxval",
1633 ".reduce_firstmax",
1634 ".reduce_lastmax",
1635 ".reduce_firstmin",
1636 ".reduce_lastmin",
1637 "associated",
1638 ".ptr2_assign",
1639 ".nullify",
1640 ".ptr_copyin",
1641 ".ptr_copyout",
1642 ".copyin",
1643 ".copyout",
1644 "ranf",
1645 "ranget",
1646 "ranset",
1647 "unit",
1648 "length",
1649 "int_mult_upper",
1650 "cot",
1651 "dcot",
1652 "shiftl",
1653 "shiftr",
1654 "dshiftl",
1655 "dshiftr",
1656 "mask",
1657 };
1658
1659 /**
1660 * 6.2 names
1661 */
1662 const char *SyminiFE90::init_names1[] = {
1663 "",
1664 "..sqrt",
1665 ".sqrt",
1666 ".dsqrt",
1667 "dsqrt",
1668 ".qsqrt",
1669 ".csqrt",
1670 "csqrt",
1671 ".cdsqrt",
1672 "cdsqrt",
1673 ".cqsqrt",
1674 ".alog",
1675 "alog",
1676 ".dlog",
1677 "dlog",
1678 ".qlog",
1679 ".clog",
1680 "clog",
1681 ".cdlog",
1682 "cdlog",
1683 ".cqlog",
1684 ".alog10",
1685 "alog10",
1686 ".dlog10",
1687 "dlog10",
1688 ".qlog10",
1689 "..exp",
1690 ".exp",
1691 ".dexp",
1692 "dexp",
1693 ".qexp",
1694 ".cexp",
1695 "cexp",
1696 ".cdexp",
1697 "cdexp",
1698 ".cqexp",
1699 "..sin",
1700 ".sin",
1701 ".dsin",
1702 "dsin",
1703 ".qsin",
1704 ".csin",
1705 "csin",
1706 ".cdsin",
1707 "cdsin",
1708 ".cqsin",
1709 "..sind",
1710 ".sind",
1711 ".dsind",
1712 "dsind",
1713 ".qsind",
1714 "..cos",
1715 ".cos",
1716 ".dcos",
1717 "dcos",
1718 ".qcos",
1719 ".ccos",
1720 "ccos",
1721 ".cdcos",
1722 "cdcos",
1723 ".cqcos",
1724 "..cosd",
1725 ".cosd",
1726 ".dcosd",
1727 "dcosd",
1728 ".qcosd",
1729 "..tan",
1730 ".tan",
1731 ".dtan",
1732 "dtan",
1733 ".qtan",
1734 "..tand",
1735 ".tand",
1736 ".dtand",
1737 "dtand",
1738 ".qtand",
1739 "..asin",
1740 ".asin",
1741 ".dasin",
1742 "dasin",
1743 ".qasin",
1744 "..asind",
1745 ".asind",
1746 ".dasind",
1747 "dasind",
1748 ".qasind",
1749 "..acos",
1750 ".acos",
1751 ".dacos",
1752 "dacos",
1753 ".qacos",
1754 "..acosd",
1755 ".acosd",
1756 ".dacosd",
1757 "dacosd",
1758 ".qacosd",
1759 "..atan",
1760 ".atan",
1761 ".datan",
1762 "datan",
1763 ".qatan",
1764 "..atand",
1765 ".atand",
1766 ".datand",
1767 "datand",
1768 ".qatand",
1769 "..atan2",
1770 ".atan2",
1771 ".datan2",
1772 "datan2",
1773 ".qatan2",
1774 "..atan2d",
1775 ".atan2d",
1776 ".datan2d",
1777 "datan2d",
1778 ".qatan2d",
1779 "..sinh",
1780 ".sinh",
1781 ".dsinh",
1782 "dsinh",
1783 ".qsinh",
1784 "..cosh",
1785 ".cosh",
1786 ".dcosh",
1787 "dcosh",
1788 ".qcosh",
1789 "..tanh",
1790 ".tanh",
1791 ".dtanh",
1792 "dtanh",
1793 ".qtanh",
1794 "iiabs",
1795 "jiabs",
1796 "kiabs",
1797 ".iabs",
1798 "iabs",
1799 "..abs",
1800 ".abs",
1801 ".dabs",
1802 "dabs",
1803 ".qabs",
1804 ".cabs",
1805 "cabs",
1806 ".cdabs",
1807 "cdabs",
1808 ".cqabs",
1809 "..aimag",
1810 ".aimag",
1811 ".dimag",
1812 "dimag",
1813 ".qimag",
1814 "..conjg",
1815 ".conjg",
1816 ".dconjg",
1817 "dconjg",
1818 ".qconjg",
1819 "dprod",
1820 "imax0",
1821 ".max0",
1822 "max0",
1823 ".amax1",
1824 "amax1",
1825 ".dmax1",
1826 "dmax1",
1827 ".kmax",
1828 "kmax0",
1829 ".qmax",
1830 "jmax0",
1831 "aimax0",
1832 "amax0",
1833 "max1",
1834 "imax1",
1835 "jmax1",
1836 "kmax1",
1837 "ajmax0",
1838 "imin0",
1839 ".min0",
1840 "min0",
1841 ".amin1",
1842 "amin1",
1843 ".dmin1",
1844 "dmin1",
1845 ".kmin",
1846 "kmin0",
1847 ".qmin",
1848 "jmin0",
1849 "amin0",
1850 "aimin0",
1851 "min1",
1852 "imin1",
1853 "jmin1",
1854 "kmin1",
1855 "ajmin0",
1856 "iidim",
1857 "jidim",
1858 ".idim",
1859 "idim",
1860 "kidim",
1861 "..dim",
1862 ".dim",
1863 ".ddim",
1864 "ddim",
1865 ".qdim",
1866 "imod",
1867 "jmod",
1868 "..mod",
1869 ".mod",
1870 "kmod",
1871 ".amod",
1872 "amod",
1873 ".dmod",
1874 "dmod",
1875 ".qmod",
1876 ".imodulo",
1877 "..modulo",
1878 ".modulo",
1879 ".kmodulo",
1880 "..amodulo",
1881 ".amodulo",
1882 "..dmodulo",
1883 ".dmodulo",
1884 ".qmodulo",
1885 "iisign",
1886 "jisign",
1887 ".isign",
1888 "isign",
1889 "kisign",
1890 "..sign",
1891 ".sign",
1892 ".dsign",
1893 "dsign",
1894 ".qsign",
1895 "iiand",
1896 ".jiand",
1897 "jiand",
1898 ".kiand",
1899 "iior",
1900 ".jior",
1901 "jior",
1902 ".kior",
1903 "iieor",
1904 ".jieor",
1905 "jieor",
1906 ".kieor",
1907 "inot",
1908 ".jnot",
1909 "jnot",
1910 ".knot",
1911 "iishft",
1912 ".jishft",
1913 "jishft",
1914 "kishft",
1915 "iibits",
1916 ".jibits",
1917 "jibits",
1918 "kibits",
1919 "iibset",
1920 ".jibset",
1921 "jibset",
1922 "kibset",
1923 "bitest",
1924 ".bjtest",
1925 "bjtest",
1926 "bktest",
1927 "iibclr",
1928 ".jibclr",
1929 "jibclr",
1930 "kibclr",
1931 "iishftc",
1932 ".jishftc",
1933 "jishftc",
1934 "kishftc",
1935 ".ilshift",
1936 ".jlshift",
1937 ".klshift",
1938 ".irshift",
1939 ".jrshift",
1940 ".krshift",
1941 ".2sch",
1942 ".char",
1943 ".2kch",
1944 "ichar",
1945 "lge",
1946 "lgt",
1947 "lle",
1948 "llt",
1949 "nchar",
1950 "nlen",
1951 "nindex",
1952 "loc",
1953 "idint",
1954 "jidint",
1955 ".2i",
1956 "ifix",
1957 "jifix",
1958 ".jint",
1959 "iifix",
1960 ".iint",
1961 ".2si",
1962 "int1",
1963 "int2",
1964 "int4",
1965 "int8",
1966 "iidint",
1967 "floati",
1968 "floatj",
1969 "float",
1970 "sngl",
1971 ".2r",
1972 "dfloti",
1973 "dfloat",
1974 "dflotj",
1975 "dreal",
1976 ".2d",
1977 ".2c",
1978 ".2cd",
1979 "dint",
1980 "dnint",
1981 "..inint",
1982 ".inint",
1983 "iidnnt",
1984 "idnint",
1985 "..jnint",
1986 ".jnint",
1987 "jidnnt",
1988 "knint",
1989 "kidnnt",
1990 "iand",
1991 "ior",
1992 "ieor",
1993 "xor",
1994 "not",
1995 "ishft",
1996 "iint",
1997 "jint",
1998 "dble",
1999 "dcmplx",
2000 "imag",
2001 "aimag",
2002 "conjg",
2003 "inint",
2004 "jnint",
2005 "abs",
2006 "mod",
2007 "sign",
2008 "dim",
2009 "max",
2010 "min",
2011 "sqrt",
2012 "exp",
2013 "log",
2014 "log10",
2015 "sin",
2016 "sind",
2017 "cos",
2018 "cosd",
2019 "tan",
2020 "tand",
2021 "asin",
2022 "asind",
2023 "acos",
2024 "acosd",
2025 "atan",
2026 "atand",
2027 "atan2",
2028 "atan2d",
2029 "sinh",
2030 "cosh",
2031 "tanh",
2032 "ibits",
2033 "ibset",
2034 "btest",
2035 "ibclr",
2036 "ishftc",
2037 "lshift",
2038 "rshift",
2039 "modulo",
2040 "date",
2041 "exit",
2042 "idate",
2043 "time",
2044 "mvbits",
2045 "real",
2046 "cmplx",
2047 "int",
2048 "aint",
2049 "anint",
2050 "nint",
2051 "char",
2052 "zext",
2053 "izext",
2054 "jzext",
2055 "ceiling",
2056 "floor",
2057 "all",
2058 "and",
2059 "any",
2060 "compl",
2061 "count",
2062 "dot_product",
2063 "eqv",
2064 "matmul",
2065 "matmul_transpose",
2066 "maxloc",
2067 "maxval",
2068 "minloc",
2069 "minval",
2070 "merge",
2071 "neqv",
2072 "or",
2073 "pack",
2074 "product",
2075 "ran",
2076 "secnds",
2077 "shift",
2078 "sum",
2079 "spread",
2080 "transpose",
2081 "unpack",
2082 "number_of_processors",
2083 "lbound",
2084 "ubound",
2085 "cshift",
2086 "eoshift",
2087 "reshape",
2088 "shape",
2089 "size",
2090 "allocated",
2091 "date_and_time",
2092 "cpu_time",
2093 "random_number",
2094 "random_seed",
2095 "system_clock",
2096 "present",
2097 "kind",
2098 "selected_int_kind",
2099 "selected_real_kind",
2100 "dlbound",
2101 "dubound",
2102 "dshape",
2103 "dsize",
2104 "achar",
2105 "adjustl",
2106 "adjustr",
2107 "bit_size",
2108 "digits",
2109 "epsilon",
2110 "exponent",
2111 "fraction",
2112 "huge",
2113 "iachar",
2114 "index",
2115 "kindex",
2116 "logical",
2117 "maxexponent",
2118 "minexponent",
2119 "nearest",
2120 "precision",
2121 "radix",
2122 "range",
2123 "repeat",
2124 "rrspacing",
2125 "scale",
2126 "set_exponent",
2127 "spacing",
2128 "tiny",
2129 "transfer",
2130 "trim",
2131 "verify",
2132 "scan",
2133 "len",
2134 "klen",
2135 "len_trim",
2136 "dotproduct",
2137 "ilen",
2138 "null",
2139 "int_ptr_kind",
2140 "processors_shape",
2141 ".lastval",
2142 ".reduce_sum",
2143 ".reduce_product",
2144 ".reduce_any",
2145 ".reduce_all",
2146 ".reduce_parity",
2147 ".reduce_iany",
2148 ".reduce_iall",
2149 ".reduce_iparity",
2150 ".reduce_minval",
2151 ".reduce_maxval",
2152 ".reduce_firstmax",
2153 ".reduce_lastmax",
2154 ".reduce_firstmin",
2155 ".reduce_lastmin",
2156 "associated",
2157 ".ptr2_assign",
2158 ".nullify",
2159 ".ptr_copyin",
2160 ".ptr_copyout",
2161 ".copyin",
2162 ".copyout",
2163 "ranf",
2164 "ranget",
2165 "ranset",
2166 "unit",
2167 "length",
2168 "int_mult_upper",
2169 "cot",
2170 "dcot",
2171 "shiftl",
2172 "shiftr",
2173 "dshiftl",
2174 "dshiftr",
2175 "mask",
2176 };
2177
2178 /**
2179 * 7.0 names
2180 */
2181 const char *SyminiFE90::init_names2[] = {
2182 "",
2183 "..sqrt",
2184 ".sqrt",
2185 ".dsqrt",
2186 "dsqrt",
2187 ".qsqrt",
2188 ".csqrt",
2189 "csqrt",
2190 ".cdsqrt",
2191 "cdsqrt",
2192 ".cqsqrt",
2193 ".alog",
2194 "alog",
2195 ".dlog",
2196 "dlog",
2197 ".qlog",
2198 ".clog",
2199 "clog",
2200 ".cdlog",
2201 "cdlog",
2202 ".cqlog",
2203 ".alog10",
2204 "alog10",
2205 ".dlog10",
2206 "dlog10",
2207 ".qlog10",
2208 "..exp",
2209 ".exp",
2210 ".dexp",
2211 "dexp",
2212 ".qexp",
2213 ".cexp",
2214 "cexp",
2215 ".cdexp",
2216 "cdexp",
2217 ".cqexp",
2218 "..sin",
2219 ".sin",
2220 ".dsin",
2221 "dsin",
2222 ".qsin",
2223 ".csin",
2224 "csin",
2225 ".cdsin",
2226 "cdsin",
2227 ".cqsin",
2228 "..sind",
2229 ".sind",
2230 ".dsind",
2231 "dsind",
2232 ".qsind",
2233 "..cos",
2234 ".cos",
2235 ".dcos",
2236 "dcos",
2237 ".qcos",
2238 ".ccos",
2239 "ccos",
2240 ".cdcos",
2241 "cdcos",
2242 ".cqcos",
2243 "..cosd",
2244 ".cosd",
2245 ".dcosd",
2246 "dcosd",
2247 ".qcosd",
2248 "..tan",
2249 ".tan",
2250 ".dtan",
2251 "dtan",
2252 ".qtan",
2253 "..tand",
2254 ".tand",
2255 ".dtand",
2256 "dtand",
2257 ".qtand",
2258 "..asin",
2259 ".asin",
2260 ".dasin",
2261 "dasin",
2262 ".qasin",
2263 "..asind",
2264 ".asind",
2265 ".dasind",
2266 "dasind",
2267 ".qasind",
2268 "..acos",
2269 ".acos",
2270 ".dacos",
2271 "dacos",
2272 ".qacos",
2273 "..acosd",
2274 ".acosd",
2275 ".dacosd",
2276 "dacosd",
2277 ".qacosd",
2278 "..atan",
2279 ".atan",
2280 ".datan",
2281 "datan",
2282 ".qatan",
2283 "..atand",
2284 ".atand",
2285 ".datand",
2286 "datand",
2287 ".qatand",
2288 "..atan2",
2289 ".atan2",
2290 ".datan2",
2291 "datan2",
2292 ".qatan2",
2293 "..atan2d",
2294 ".atan2d",
2295 ".datan2d",
2296 "datan2d",
2297 ".qatan2d",
2298 "..sinh",
2299 ".sinh",
2300 ".dsinh",
2301 "dsinh",
2302 ".qsinh",
2303 "..cosh",
2304 ".cosh",
2305 ".dcosh",
2306 "dcosh",
2307 ".qcosh",
2308 "..tanh",
2309 ".tanh",
2310 ".dtanh",
2311 "dtanh",
2312 ".qtanh",
2313 "iiabs",
2314 "jiabs",
2315 "kiabs",
2316 ".iabs",
2317 "iabs",
2318 "..abs",
2319 ".abs",
2320 ".dabs",
2321 "dabs",
2322 ".qabs",
2323 ".cabs",
2324 "cabs",
2325 ".cdabs",
2326 "cdabs",
2327 ".cqabs",
2328 "..aimag",
2329 ".aimag",
2330 ".dimag",
2331 "dimag",
2332 ".qimag",
2333 "..conjg",
2334 ".conjg",
2335 ".dconjg",
2336 "dconjg",
2337 ".qconjg",
2338 "dprod",
2339 "imax0",
2340 ".max0",
2341 "max0",
2342 ".amax1",
2343 "amax1",
2344 ".dmax1",
2345 "dmax1",
2346 ".kmax",
2347 "kmax0",
2348 ".qmax",
2349 "jmax0",
2350 "aimax0",
2351 "amax0",
2352 "max1",
2353 "imax1",
2354 "jmax1",
2355 "kmax1",
2356 "ajmax0",
2357 "imin0",
2358 ".min0",
2359 "min0",
2360 ".amin1",
2361 "amin1",
2362 ".dmin1",
2363 "dmin1",
2364 ".kmin",
2365 "kmin0",
2366 ".qmin",
2367 "jmin0",
2368 "amin0",
2369 "aimin0",
2370 "min1",
2371 "imin1",
2372 "jmin1",
2373 "kmin1",
2374 "ajmin0",
2375 "iidim",
2376 "jidim",
2377 ".idim",
2378 "idim",
2379 "kidim",
2380 "..dim",
2381 ".dim",
2382 ".ddim",
2383 "ddim",
2384 ".qdim",
2385 "imod",
2386 "jmod",
2387 "..mod",
2388 ".mod",
2389 "kmod",
2390 ".amod",
2391 "amod",
2392 ".dmod",
2393 "dmod",
2394 ".qmod",
2395 ".imodulo",
2396 "..modulo",
2397 ".modulo",
2398 ".kmodulo",
2399 "..amodulo",
2400 ".amodulo",
2401 "..dmodulo",
2402 ".dmodulo",
2403 ".qmodulo",
2404 "iisign",
2405 "jisign",
2406 ".isign",
2407 "isign",
2408 "kisign",
2409 "..sign",
2410 ".sign",
2411 ".dsign",
2412 "dsign",
2413 ".qsign",
2414 "iiand",
2415 ".jiand",
2416 "jiand",
2417 ".kiand",
2418 "iior",
2419 ".jior",
2420 "jior",
2421 ".kior",
2422 "iieor",
2423 ".jieor",
2424 "jieor",
2425 ".kieor",
2426 "inot",
2427 ".jnot",
2428 "jnot",
2429 ".knot",
2430 "iishft",
2431 ".jishft",
2432 "jishft",
2433 "kishft",
2434 "iibits",
2435 ".jibits",
2436 "jibits",
2437 "kibits",
2438 "iibset",
2439 ".jibset",
2440 "jibset",
2441 "kibset",
2442 "bitest",
2443 ".bjtest",
2444 "bjtest",
2445 "bktest",
2446 "iibclr",
2447 ".jibclr",
2448 "jibclr",
2449 "kibclr",
2450 "iishftc",
2451 ".jishftc",
2452 "jishftc",
2453 "kishftc",
2454 ".ilshift",
2455 ".jlshift",
2456 ".klshift",
2457 ".irshift",
2458 ".jrshift",
2459 ".krshift",
2460 ".2sch",
2461 ".char",
2462 ".2kch",
2463 "ichar",
2464 "lge",
2465 "lgt",
2466 "lle",
2467 "llt",
2468 "nchar",
2469 "nlen",
2470 "nindex",
2471 "loc",
2472 "idint",
2473 "jidint",
2474 ".2i",
2475 "ifix",
2476 "jifix",
2477 ".jint",
2478 "iifix",
2479 ".iint",
2480 ".2si",
2481 "int1",
2482 "int2",
2483 "int4",
2484 "int8",
2485 "iidint",
2486 "floati",
2487 "floatj",
2488 "float",
2489 "sngl",
2490 ".2r",
2491 "dfloti",
2492 "dfloat",
2493 "dflotj",
2494 "dreal",
2495 ".2d",
2496 ".2c",
2497 ".2cd",
2498 "dint",
2499 "dnint",
2500 "..inint",
2501 ".inint",
2502 "iidnnt",
2503 "idnint",
2504 "..jnint",
2505 ".jnint",
2506 "jidnnt",
2507 "knint",
2508 "kidnnt",
2509 "iand",
2510 "ior",
2511 "ieor",
2512 "xor",
2513 "not",
2514 "ishft",
2515 "iint",
2516 "jint",
2517 "dble",
2518 "dcmplx",
2519 "imag",
2520 "aimag",
2521 "conjg",
2522 "inint",
2523 "jnint",
2524 "abs",
2525 "mod",
2526 "sign",
2527 "dim",
2528 "max",
2529 "min",
2530 "sqrt",
2531 "exp",
2532 "log",
2533 "log10",
2534 "sin",
2535 "sind",
2536 "cos",
2537 "cosd",
2538 "tan",
2539 "tand",
2540 "asin",
2541 "asind",
2542 "acos",
2543 "acosd",
2544 "atan",
2545 "atand",
2546 "atan2",
2547 "atan2d",
2548 "sinh",
2549 "cosh",
2550 "tanh",
2551 "ibits",
2552 "ibset",
2553 "btest",
2554 "ibclr",
2555 "ishftc",
2556 "lshift",
2557 "rshift",
2558 "modulo",
2559 "date",
2560 "exit",
2561 "idate",
2562 "time",
2563 "mvbits",
2564 "real",
2565 "cmplx",
2566 "int",
2567 "aint",
2568 "anint",
2569 "nint",
2570 "char",
2571 "zext",
2572 "izext",
2573 "jzext",
2574 "ceiling",
2575 "floor",
2576 "all",
2577 "and",
2578 "any",
2579 "compl",
2580 "count",
2581 "dot_product",
2582 "eqv",
2583 "matmul",
2584 "matmul_transpose",
2585 "maxloc",
2586 "maxval",
2587 "minloc",
2588 "minval",
2589 "merge",
2590 "neqv",
2591 "or",
2592 "pack",
2593 "product",
2594 "ran",
2595 "secnds",
2596 "shift",
2597 "sum",
2598 "spread",
2599 "transpose",
2600 "unpack",
2601 "number_of_processors",
2602 "lbound",
2603 "ubound",
2604 "cshift",
2605 "eoshift",
2606 "reshape",
2607 "shape",
2608 "size",
2609 "allocated",
2610 "date_and_time",
2611 "cpu_time",
2612 "random_number",
2613 "random_seed",
2614 "system_clock",
2615 "present",
2616 "kind",
2617 "selected_int_kind",
2618 "selected_real_kind",
2619 "dlbound",
2620 "dubound",
2621 "dshape",
2622 "dsize",
2623 "achar",
2624 "adjustl",
2625 "adjustr",
2626 "bit_size",
2627 "digits",
2628 "epsilon",
2629 "exponent",
2630 "fraction",
2631 "huge",
2632 "iachar",
2633 "index",
2634 "kindex",
2635 "logical",
2636 "maxexponent",
2637 "minexponent",
2638 "nearest",
2639 "precision",
2640 "radix",
2641 "range",
2642 "repeat",
2643 "rrspacing",
2644 "scale",
2645 "set_exponent",
2646 "spacing",
2647 "tiny",
2648 "transfer",
2649 "trim",
2650 "verify",
2651 "scan",
2652 "len",
2653 "klen",
2654 "len_trim",
2655 "dotproduct",
2656 "ilen",
2657 "null",
2658 "int_ptr_kind",
2659 "processors_shape",
2660 ".lastval",
2661 ".reduce_sum",
2662 ".reduce_product",
2663 ".reduce_any",
2664 ".reduce_all",
2665 ".reduce_parity",
2666 ".reduce_iany",
2667 ".reduce_iall",
2668 ".reduce_iparity",
2669 ".reduce_minval",
2670 ".reduce_maxval",
2671 ".reduce_firstmax",
2672 ".reduce_lastmax",
2673 ".reduce_firstmin",
2674 ".reduce_lastmin",
2675 "associated",
2676 ".ptr2_assign",
2677 ".nullify",
2678 ".ptr_copyin",
2679 ".ptr_copyout",
2680 ".copyin",
2681 ".copyout",
2682 ".selected_char_kind",
2683 ".extends_type_of",
2684 "new_line",
2685 ".same_type_as",
2686 ".move_alloc",
2687 ".command_argument_count",
2688 ".get_command",
2689 ".get_command_argument",
2690 ".get_environment_variable",
2691 "is_iostat_end",
2692 "is_iostat_eor",
2693 ".sizeof",
2694 "ranf",
2695 "ranget",
2696 "ranset",
2697 "unit",
2698 "length",
2699 "int_mult_upper",
2700 "cot",
2701 "dcot",
2702 "shiftl",
2703 "shiftr",
2704 "dshiftl",
2705 "dshiftr",
2706 "mask",
2707 "c_loc",
2708 "c_funloc",
2709 "c_associated",
2710 "c_f_pointer",
2711 "c_f_procpointer",
2712 "ieee_support_datatype",
2713 "ieee_support_denormal",
2714 "ieee_support_divide",
2715 "ieee_support_inf",
2716 "ieee_support_io",
2717 "ieee_support_nan",
2718 "ieee_support_rounding",
2719 "ieee_support_sqrt",
2720 "ieee_support_standard",
2721 "ieee_support_underflow_control",
2722 "ieee_class",
2723 "ieee_copy_sign",
2724 "ieee_is_finite",
2725 "ieee_is_nan",
2726 "ieee_is_normal",
2727 "ieee_is_negative",
2728 "ieee_logb",
2729 "ieee_next_after",
2730 "ieee_rem",
2731 "ieee_rint",
2732 "ieee_scalb",
2733 "ieee_unordered",
2734 "ieee_value",
2735 "ieee_selected_real_kind",
2736 "ieee_get_rounding_mode",
2737 "ieee_get_underflow_mode",
2738 "ieee_set_rounding_mode",
2739 "ieee_set_underflow_mode",
2740 "ieee_support_flag",
2741 "ieee_support_halting",
2742 "ieee_get_flag",
2743 "ieee_get_halting_mode",
2744 "ieee_get_status",
2745 "ieee_set_flag",
2746 "ieee_set_halting_mode",
2747 "ieee_set_status",
2748 };
2749
2750 /**
2751 * Fortran 2008 names
2752 */
2753 const char *SyminiFE90::init_names3[] = {
2754 "",
2755 "..sqrt",
2756 ".sqrt",
2757 ".dsqrt",
2758 "dsqrt",
2759 ".qsqrt",
2760 ".csqrt",
2761 "csqrt",
2762 ".cdsqrt",
2763 "cdsqrt",
2764 ".cqsqrt",
2765 ".alog",
2766 "alog",
2767 ".dlog",
2768 "dlog",
2769 ".qlog",
2770 ".clog",
2771 "clog",
2772 ".cdlog",
2773 "cdlog",
2774 ".cqlog",
2775 ".alog10",
2776 "alog10",
2777 ".dlog10",
2778 "dlog10",
2779 ".qlog10",
2780 "..exp",
2781 ".exp",
2782 ".dexp",
2783 "dexp",
2784 ".qexp",
2785 ".cexp",
2786 "cexp",
2787 ".cdexp",
2788 "cdexp",
2789 ".cqexp",
2790 "..sin",
2791 ".sin",
2792 ".dsin",
2793 "dsin",
2794 ".qsin",
2795 ".csin",
2796 "csin",
2797 ".cdsin",
2798 "cdsin",
2799 ".cqsin",
2800 "..sind",
2801 ".sind",
2802 ".dsind",
2803 "dsind",
2804 ".qsind",
2805 "..cos",
2806 ".cos",
2807 ".dcos",
2808 "dcos",
2809 ".qcos",
2810 ".ccos",
2811 "ccos",
2812 ".cdcos",
2813 "cdcos",
2814 ".cqcos",
2815 "..cosd",
2816 ".cosd",
2817 ".dcosd",
2818 "dcosd",
2819 ".qcosd",
2820 "..tan",
2821 ".tan",
2822 ".dtan",
2823 "dtan",
2824 ".qtan",
2825 "..tand",
2826 ".tand",
2827 ".dtand",
2828 "dtand",
2829 ".qtand",
2830 "..asin",
2831 ".asin",
2832 ".dasin",
2833 "dasin",
2834 ".qasin",
2835 "..asind",
2836 ".asind",
2837 ".dasind",
2838 "dasind",
2839 ".qasind",
2840 "..acos",
2841 ".acos",
2842 ".dacos",
2843 "dacos",
2844 ".qacos",
2845 "..acosd",
2846 ".acosd",
2847 ".dacosd",
2848 "dacosd",
2849 ".qacosd",
2850 "..atan",
2851 ".atan",
2852 ".datan",
2853 "datan",
2854 ".qatan",
2855 "..atand",
2856 ".atand",
2857 ".datand",
2858 "datand",
2859 ".qatand",
2860 "..atan2",
2861 ".atan2",
2862 ".datan2",
2863 "datan2",
2864 ".qatan2",
2865 "..atan2d",
2866 ".atan2d",
2867 ".datan2d",
2868 "datan2d",
2869 ".qatan2d",
2870 "..sinh",
2871 ".sinh",
2872 ".dsinh",
2873 "dsinh",
2874 ".qsinh",
2875 "..cosh",
2876 ".cosh",
2877 ".dcosh",
2878 "dcosh",
2879 ".qcosh",
2880 "..tanh",
2881 ".tanh",
2882 ".dtanh",
2883 "dtanh",
2884 ".qtanh",
2885 "iiabs",
2886 "jiabs",
2887 "kiabs",
2888 ".iabs",
2889 "iabs",
2890 "..abs",
2891 ".abs",
2892 ".dabs",
2893 "dabs",
2894 ".qabs",
2895 ".cabs",
2896 "cabs",
2897 ".cdabs",
2898 "cdabs",
2899 ".cqabs",
2900 "..aimag",
2901 ".aimag",
2902 ".dimag",
2903 "dimag",
2904 ".qimag",
2905 "..conjg",
2906 ".conjg",
2907 ".dconjg",
2908 "dconjg",
2909 ".qconjg",
2910 "dprod",
2911 "imax0",
2912 ".max0",
2913 "max0",
2914 ".amax1",
2915 "amax1",
2916 ".dmax1",
2917 "dmax1",
2918 ".kmax",
2919 "kmax0",
2920 ".qmax",
2921 "jmax0",
2922 "aimax0",
2923 "amax0",
2924 "max1",
2925 "imax1",
2926 "jmax1",
2927 "kmax1",
2928 "ajmax0",
2929 "imin0",
2930 ".min0",
2931 "min0",
2932 ".amin1",
2933 "amin1",
2934 ".dmin1",
2935 "dmin1",
2936 ".kmin",
2937 "kmin0",
2938 ".qmin",
2939 "jmin0",
2940 "amin0",
2941 "aimin0",
2942 "min1",
2943 "imin1",
2944 "jmin1",
2945 "kmin1",
2946 "ajmin0",
2947 "iidim",
2948 "jidim",
2949 ".idim",
2950 "idim",
2951 "kidim",
2952 "..dim",
2953 ".dim",
2954 ".ddim",
2955 "ddim",
2956 ".qdim",
2957 "imod",
2958 "jmod",
2959 "..mod",
2960 ".mod",
2961 "kmod",
2962 ".amod",
2963 "amod",
2964 ".dmod",
2965 "dmod",
2966 ".qmod",
2967 ".imodulo",
2968 "..modulo",
2969 ".modulo",
2970 ".kmodulo",
2971 "..amodulo",
2972 ".amodulo",
2973 "..dmodulo",
2974 ".dmodulo",
2975 ".qmodulo",
2976 "iisign",
2977 "jisign",
2978 ".isign",
2979 "isign",
2980 "kisign",
2981 "..sign",
2982 ".sign",
2983 ".dsign",
2984 "dsign",
2985 ".qsign",
2986 "iiand",
2987 ".jiand",
2988 "jiand",
2989 ".kiand",
2990 "iior",
2991 ".jior",
2992 "jior",
2993 ".kior",
2994 "iieor",
2995 ".jieor",
2996 "jieor",
2997 ".kieor",
2998 "inot",
2999 ".jnot",
3000 "jnot",
3001 ".knot",
3002 "iishft",
3003 ".jishft",
3004 "jishft",
3005 "kishft",
3006 "iibits",
3007 ".jibits",
3008 "jibits",
3009 "kibits",
3010 "iibset",
3011 ".jibset",
3012 "jibset",
3013 "kibset",
3014 "bitest",
3015 ".bjtest",
3016 "bjtest",
3017 "bktest",
3018 "iibclr",
3019 ".jibclr",
3020 "jibclr",
3021 "kibclr",
3022 "iishftc",
3023 ".jishftc",
3024 "jishftc",
3025 "kishftc",
3026 ".ilshift",
3027 ".jlshift",
3028 ".klshift",
3029 ".irshift",
3030 ".jrshift",
3031 ".krshift",
3032 ".2sch",
3033 ".char",
3034 ".2kch",
3035 "ichar",
3036 "lge",
3037 "lgt",
3038 "lle",
3039 "llt",
3040 "nchar",
3041 "nlen",
3042 "nindex",
3043 "loc",
3044 "idint",
3045 "jidint",
3046 ".2i",
3047 "ifix",
3048 "jifix",
3049 ".jint",
3050 "iifix",
3051 ".iint",
3052 ".2si",
3053 "int1",
3054 "int2",
3055 "int4",
3056 "int8",
3057 "iidint",
3058 "floati",
3059 "floatj",
3060 "float",
3061 "sngl",
3062 ".2r",
3063 "dfloti",
3064 "dfloat",
3065 "dflotj",
3066 "dreal",
3067 ".2d",
3068 ".2c",
3069 ".2cd",
3070 "dint",
3071 "dnint",
3072 "..inint",
3073 ".inint",
3074 "iidnnt",
3075 "idnint",
3076 "..jnint",
3077 ".jnint",
3078 "jidnnt",
3079 "knint",
3080 "kidnnt",
3081 "iand",
3082 "ior",
3083 "ieor",
3084 "xor",
3085 "not",
3086 "ishft",
3087 "iint",
3088 "jint",
3089 "dble",
3090 "dcmplx",
3091 "imag",
3092 "aimag",
3093 "conjg",
3094 "inint",
3095 "jnint",
3096 "abs",
3097 "mod",
3098 "sign",
3099 "dim",
3100 "max",
3101 "min",
3102 "sqrt",
3103 "exp",
3104 "log",
3105 "log10",
3106 "sin",
3107 "sind",
3108 "cos",
3109 "cosd",
3110 "tan",
3111 "tand",
3112 "asin",
3113 "asind",
3114 "acos",
3115 "acosd",
3116 "atan",
3117 "atand",
3118 "atan2",
3119 "atan2d",
3120 "sinh",
3121 "cosh",
3122 "tanh",
3123 "ibits",
3124 "ibset",
3125 "btest",
3126 "ibclr",
3127 "ishftc",
3128 "lshift",
3129 "rshift",
3130 "modulo",
3131 "date",
3132 "exit",
3133 "idate",
3134 "time",
3135 "mvbits",
3136 "real",
3137 "cmplx",
3138 "int",
3139 "aint",
3140 "anint",
3141 "nint",
3142 "char",
3143 "zext",
3144 "izext",
3145 "jzext",
3146 "ceiling",
3147 "floor",
3148 "all",
3149 "and",
3150 "any",
3151 "compl",
3152 "count",
3153 "dot_product",
3154 "eqv",
3155 "matmul",
3156 "matmul_transpose",
3157 "maxloc",
3158 "maxval",
3159 "minloc",
3160 "minval",
3161 "merge",
3162 "neqv",
3163 "or",
3164 "pack",
3165 "product",
3166 "ran",
3167 "secnds",
3168 "shift",
3169 "sum",
3170 "spread",
3171 "transpose",
3172 "unpack",
3173 "number_of_processors",
3174 "lbound",
3175 "ubound",
3176 "cshift",
3177 "eoshift",
3178 "reshape",
3179 "shape",
3180 "size",
3181 "allocated",
3182 "date_and_time",
3183 "cpu_time",
3184 "random_number",
3185 "random_seed",
3186 "system_clock",
3187 "present",
3188 "kind",
3189 "selected_int_kind",
3190 "selected_real_kind",
3191 "dlbound",
3192 "dubound",
3193 "dshape",
3194 "dsize",
3195 "achar",
3196 "adjustl",
3197 "adjustr",
3198 "bit_size",
3199 "digits",
3200 "epsilon",
3201 "exponent",
3202 "fraction",
3203 "huge",
3204 "iachar",
3205 "index",
3206 "kindex",
3207 "logical",
3208 "maxexponent",
3209 "minexponent",
3210 "nearest",
3211 "precision",
3212 "radix",
3213 "range",
3214 "repeat",
3215 "rrspacing",
3216 "scale",
3217 "set_exponent",
3218 "spacing",
3219 "tiny",
3220 "transfer",
3221 "trim",
3222 "verify",
3223 "scan",
3224 "len",
3225 "klen",
3226 "len_trim",
3227 "dotproduct",
3228 "ilen",
3229 "null",
3230 "int_ptr_kind",
3231 "processors_shape",
3232 ".lastval",
3233 ".reduce_sum",
3234 ".reduce_product",
3235 ".reduce_any",
3236 ".reduce_all",
3237 ".reduce_parity",
3238 ".reduce_iany",
3239 ".reduce_iall",
3240 ".reduce_iparity",
3241 ".reduce_minval",
3242 ".reduce_maxval",
3243 ".reduce_firstmax",
3244 ".reduce_lastmax",
3245 ".reduce_firstmin",
3246 ".reduce_lastmin",
3247 "associated",
3248 ".ptr2_assign",
3249 ".nullify",
3250 ".ptr_copyin",
3251 ".ptr_copyout",
3252 ".copyin",
3253 ".copyout",
3254 ".selected_char_kind",
3255 ".extends_type_of",
3256 "new_line",
3257 ".same_type_as",
3258 ".move_alloc",
3259 ".command_argument_count",
3260 ".get_command",
3261 ".get_command_argument",
3262 ".get_environment_variable",
3263 "is_iostat_end",
3264 "is_iostat_eor",
3265 ".sizeof",
3266 "ranf",
3267 "ranget",
3268 "ranset",
3269 "unit",
3270 "length",
3271 "int_mult_upper",
3272 "cot",
3273 "dcot",
3274 "shiftl",
3275 "shiftr",
3276 "dshiftl",
3277 "dshiftr",
3278 "mask",
3279 "c_loc",
3280 "c_funloc",
3281 "c_associated",
3282 "c_f_pointer",
3283 "c_f_procpointer",
3284 "ieee_support_datatype",
3285 "ieee_support_denormal",
3286 "ieee_support_divide",
3287 "ieee_support_inf",
3288 "ieee_support_io",
3289 "ieee_support_nan",
3290 "ieee_support_rounding",
3291 "ieee_support_sqrt",
3292 "ieee_support_standard",
3293 "ieee_support_underflow_control",
3294 "ieee_class",
3295 "ieee_copy_sign",
3296 "ieee_is_finite",
3297 "ieee_is_nan",
3298 "ieee_is_normal",
3299 "ieee_is_negative",
3300 "ieee_logb",
3301 "ieee_next_after",
3302 "ieee_rem",
3303 "ieee_rint",
3304 "ieee_scalb",
3305 "ieee_unordered",
3306 "ieee_value",
3307 "ieee_selected_real_kind",
3308 "ieee_get_rounding_mode",
3309 "ieee_get_underflow_mode",
3310 "ieee_set_rounding_mode",
3311 "ieee_set_underflow_mode",
3312 "ieee_support_flag",
3313 "ieee_support_halting",
3314 "ieee_get_flag",
3315 "ieee_get_halting_mode",
3316 "ieee_get_status",
3317 "ieee_set_flag",
3318 "ieee_set_halting_mode",
3319 "ieee_set_status",
3320 "leadz",
3321 "popcnt",
3322 "poppar",
3323 };
3324
3325 const size_t SyminiFE90::init_names0_size =
3326 sizeof(SyminiFE90::init_names0) / sizeof(char *);
3327 const size_t SyminiFE90::init_names1_size =
3328 sizeof(SyminiFE90::init_names1) / sizeof(char *);
3329 const size_t SyminiFE90::init_names2_size =
3330 sizeof(SyminiFE90::init_names2) / sizeof(char *);
3331 const size_t SyminiFE90::init_names3_size =
3332 sizeof(SyminiFE90::init_names3) / sizeof(char *);
3333