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