2 Copyright (C) 1995 Free Software Foundation, Inc.
3 Contributed by James Craig Burley.
5 This file is part of GNU Fortran.
7 GNU Fortran is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Fortran is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Fortran; see the file COPYING. If not, write to
19 the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
28 #define MAXNAMELEN 100
30 typedef struct _name_
*name
;
40 char kwname
[MAXNAMELEN
];
41 char name_uc
[MAXNAMELEN
];
42 char name_lc
[MAXNAMELEN
];
43 char name_ic
[MAXNAMELEN
];
62 static char prefix
[32];
63 static char postfix
[32];
64 static char storage
[32];
65 static const char *xspaces
[]
101 "\t\t\t\t ", /* 33 */
102 "\t\t\t\t ", /* 34 */
103 "\t\t\t\t ", /* 35 */
104 "\t\t\t\t ", /* 36 */
105 "\t\t\t\t ", /* 37 */
106 "\t\t\t\t ", /* 38 */
107 "\t\t\t\t ", /* 39 */
108 "\t\t\t\t\t", /* 40 */
109 "\t\t\t\t\t ", /* 41 */
110 "\t\t\t\t\t ", /* 42 */
111 "\t\t\t\t\t ", /* 43 */
112 "\t\t\t\t\t ", /* 44 */
113 "\t\t\t\t\t ", /* 45 */
114 "\t\t\t\t\t ", /* 46 */
115 "\t\t\t\t\t ", /* 47 */
116 "\t\t\t\t\t\t", /* 48 */
117 "\t\t\t\t\t\t ", /* 49 */
118 "\t\t\t\t\t\t ", /* 50 */
119 "\t\t\t\t\t\t ", /* 51 */
120 "\t\t\t\t\t\t ", /* 52 */
121 "\t\t\t\t\t\t ", /* 53 */
122 "\t\t\t\t\t\t ", /* 54 */
123 "\t\t\t\t\t\t ", /* 55 */
124 "\t\t\t\t\t\t\t", /* 56 */
125 "\t\t\t\t\t\t\t ", /* 57 */
126 "\t\t\t\t\t\t\t ", /* 58 */
127 "\t\t\t\t\t\t\t ", /* 59 */
128 "\t\t\t\t\t\t\t ", /* 60 */
129 "\t\t\t\t\t\t\t ", /* 61 */
130 "\t\t\t\t\t\t\t ", /* 62 */
131 "\t\t\t\t\t\t\t ", /* 63 */
132 "\t\t\t\t\t\t\t\t", /* 64 */
133 "\t\t\t\t\t\t\t\t ", /* 65 */
134 "\t\t\t\t\t\t\t\t ", /* 66 */
135 "\t\t\t\t\t\t\t\t ", /* 67 */
136 "\t\t\t\t\t\t\t\t ", /* 68 */
137 "\t\t\t\t\t\t\t\t ", /* 69 */
138 "\t\t\t\t\t\t\t\t ", /* 70 */
139 "\t\t\t\t\t\t\t\t ", /* 71 */
140 "\t\t\t\t\t\t\t\t\t", /* 72 */
141 "\t\t\t\t\t\t\t\t\t ", /* 73 */
142 "\t\t\t\t\t\t\t\t\t ", /* 74 */
143 "\t\t\t\t\t\t\t\t\t ", /* 75 */
144 "\t\t\t\t\t\t\t\t\t ", /* 76 */
145 "\t\t\t\t\t\t\t\t\t ", /* 77 */
146 "\t\t\t\t\t\t\t\t\t ", /* 78 */
147 "\t\t\t\t\t\t\t\t\t ", /* 79 */
148 "\t\t\t\t\t\t\t\t\t\t", /* 80 */
149 "\t\t\t\t\t\t\t\t\t\t ", /* 81 */
150 "\t\t\t\t\t\t\t\t\t\t ", /* 82 */
151 "\t\t\t\t\t\t\t\t\t\t ", /* 83 */
152 "\t\t\t\t\t\t\t\t\t\t ", /* 84 */
153 "\t\t\t\t\t\t\t\t\t\t ", /* 85 */
154 "\t\t\t\t\t\t\t\t\t\t ", /* 86 */
155 "\t\t\t\t\t\t\t\t\t\t ",/* 87 */
156 "\t\t\t\t\t\t\t\t\t\t\t", /* 88 */
157 "\t\t\t\t\t\t\t\t\t\t\t ", /* 89 */
158 "\t\t\t\t\t\t\t\t\t\t\t ", /* 90 */
159 "\t\t\t\t\t\t\t\t\t\t\t ", /* 91 */
160 "\t\t\t\t\t\t\t\t\t\t\t ", /* 92 */
161 "\t\t\t\t\t\t\t\t\t\t\t ",/* 93 */
162 "\t\t\t\t\t\t\t\t\t\t\t ", /* 94 */
163 "\t\t\t\t\t\t\t\t\t\t\t ", /* 95 */
164 "\t\t\t\t\t\t\t\t\t\t\t\t", /* 96 */
165 "\t\t\t\t\t\t\t\t\t\t\t\t ", /* 97 */
166 "\t\t\t\t\t\t\t\t\t\t\t\t ", /* 98 */
167 "\t\t\t\t\t\t\t\t\t\t\t\t ",/* 99 */
168 "\t\t\t\t\t\t\t\t\t\t\t\t ", /* 100 */
169 "\t\t\t\t\t\t\t\t\t\t\t\t ", /* 101 */
170 "\t\t\t\t\t\t\t\t\t\t\t\t ", /* 102 */
171 "\t\t\t\t\t\t\t\t\t\t\t\t ", /* 103 */
172 "\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 104 */
173 "\t\t\t\t\t\t\t\t\t\t\t\t\t ",/* 105 */
174 "\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 106 */
175 "\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 107 */
176 "\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 108 */
177 "\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 109 */
178 "\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 110 */
179 "\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 111 */
180 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 112 */
181 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 113 */
182 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 114 */
183 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 115 */
184 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 116 */
185 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 117 */
186 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 118 */
187 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 119 */
188 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 120 */
189 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 121 */
190 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 122 */
191 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 123 */
192 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 124 */
193 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 125 */
194 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 126 */
195 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 127 */
196 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 128 */
197 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 129 */
198 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 130 */
199 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 131 */
200 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 132 */
201 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 133 */
202 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 134 */
203 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 135 */
204 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 136 */
205 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 137 */
206 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 138 */
207 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 139 */
208 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 140 */
209 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 141 */
210 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 142 */
211 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 143 */
212 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 144 */
213 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 145 */
214 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 146 */
215 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 147 */
216 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 148 */
217 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 149 */
218 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 150 */
219 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 151 */
220 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t", /* 152 */
221 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 153 */
222 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 154 */
223 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 155 */
224 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 156 */
225 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 157 */
226 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 158 */
227 "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ", /* 159 */
230 void testname (bool nested
, int indent
, name first
, name last
);
231 void testnames (bool nested
, int indent
, int len
, name first
, name last
);
234 main (int argc
, char **argv
)
236 char buf
[MAXNAMELEN
];
237 char last_buf
[MAXNAMELEN
] = "";
238 char kwname
[MAXNAMELEN
];
244 struct _name_root_ names
[200];
245 struct _name_alpha_ names_alpha
;
254 int do_name
; /* TRUE if token may be NAME. */
255 int do_names
; /* TRUE if token may be NAMES. */
257 bool do_exit
= FALSE
;
259 for (i
= 0; ((size_t) i
) < ARRAY_SIZE (names
); ++i
)
260 { /* Initialize length/name ordered list roots. */
261 names
[i
].first
= (name
) &names
[i
];
262 names
[i
].last
= (name
) &names
[i
];
264 names_alpha
.first
= (name
) &names_alpha
; /* Initialize name order. */
265 names_alpha
.last
= (name
) &names_alpha
;
269 fprintf (stderr
, "Command form: fini input output-code output-include\n");
273 input_name
= argv
[1];
274 output_name
= argv
[2];
275 include_name
= argv
[3];
277 in
= fopen (input_name
, "r");
280 fprintf (stderr
, "Cannot open \"%s\"\n", input_name
);
283 out
= fopen (output_name
, "w");
287 fprintf (stderr
, "Cannot open \"%s\"\n", output_name
);
290 incl
= fopen (include_name
, "w");
294 fprintf (stderr
, "Cannot open \"%s\"\n", include_name
);
298 /* Get past the initial block-style comment (man, this parsing code is just
299 _so_ lame, but I'm too lazy to improve it). */
306 while (((cc
= getc (in
)) != '}') && (cc
!= EOF
))
311 while (((cc
= getc (in
)) != EOF
) && (! ISALNUM (cc
)))
318 assert ("EOF too soon!" == NULL
);
323 fscanf (in
, "%s %s %s %s %s %d %d", prefix
, postfix
, storage
, type
, routine
,
324 &do_name
, &do_names
);
326 if (storage
[0] == '\0')
329 /* Assume string is quoted somehow, replace ending quote with space. */
331 if (storage
[2] == '\0')
334 storage
[strlen (storage
) - 1] = ' ';
337 if (postfix
[0] == '\0')
339 else /* Assume string is quoted somehow, strip off
341 postfix
[strlen (postfix
) - 1] = '\0';
343 for (i
= 1; storage
[i
] != '\0'; ++i
)
344 storage
[i
- 1] = storage
[i
];
345 storage
[i
- 1] = '\0';
347 for (i
= 1; postfix
[i
] != '\0'; ++i
)
348 postfix
[i
- 1] = postfix
[i
];
349 postfix
[i
- 1] = '\0';
351 fixlengths
= strlen (prefix
) + strlen (postfix
);
355 count
= fscanf (in
, "%s %s", buf
, kwname
);
360 continue; /* Skip empty lines. */
362 continue; /* Skip commented-out lines. */
363 for (i
= strlen (buf
) - 1; i
> 0; --i
)
366 /* Make new name object to store name and its keyword. */
368 newname
= (name
) malloc (sizeof (*newname
));
369 newname
->namelen
= strlen (buf
);
370 newname
->kwlen
= strlen (kwname
);
371 total_length
= newname
->kwlen
+ fixlengths
;
372 if (total_length
>= 32) /* Else resulting keyword name too long. */
374 fprintf (stderr
, "%s: %s%s%s is 31+%d chars long\n", input_name
,
375 prefix
, kwname
, postfix
, total_length
- 31);
378 strcpy (newname
->kwname
, kwname
);
379 for (i
= 0; i
< newname
->namelen
; ++i
)
384 newname
->name_uc
[i
] = TOUPPER (cc
);
385 newname
->name_lc
[i
] = TOLOWER (cc
);
386 newname
->name_ic
[i
] = cc
;
389 newname
->name_uc
[i
] = newname
->name_lc
[i
] = newname
->name_ic
[i
]
392 newname
->name_uc
[i
] = newname
->name_lc
[i
] = newname
->name_ic
[i
] = '\0';
394 /* Warn user if names aren't alphabetically ordered. */
396 if ((last_buf
[0] != '\0')
397 && (strcmp (last_buf
, newname
->name_uc
) >= 0))
399 fprintf (stderr
, "%s: \"%s\" precedes \"%s\"\n", input_name
,
400 last_buf
, newname
->name_uc
);
403 strcpy (last_buf
, newname
->name_uc
);
405 /* Append name to end of alpha-sorted list (assumes names entered in
406 alpha order wrt name, not kwname, even though kwname is output from
409 n
= names_alpha
.last
;
410 newname
->next_alpha
= n
->next_alpha
;
411 newname
->previous_alpha
= n
;
412 n
->next_alpha
->previous_alpha
= newname
;
413 n
->next_alpha
= newname
;
415 /* Insert name in appropriate length/name ordered list. */
417 n
= (name
) &names
[len
];
418 while ((n
->next
!= (name
) &names
[len
])
419 && (strcmp (buf
, n
->next
->name_uc
) > 0))
421 if (strcmp (buf
, n
->next
->name_uc
) == 0)
423 fprintf (stderr
, "%s: extraneous \"%s\"\n", input_name
, buf
);
426 newname
->next
= n
->next
;
427 newname
->previous
= n
;
428 n
->next
->previous
= newname
;
433 for (len
= 0; len
< ARRAY_SIZE (name
); ++len
)
435 if (names
[len
].first
== (name
) &names
[len
])
437 printf ("Length %d:\n", len
);
438 for (n
= names
[len
].first
; n
!= (name
) &names
[len
]; n
= n
->next
)
439 printf (" %s %s %s\n", n
->name_uc
, n
->name_lc
, n
->name_ic
);
446 /* First output the #include file. */
448 for (n
= names_alpha
.first
; n
!= (name
) &names_alpha
; n
= n
->next_alpha
)
450 fprintf (incl
, "#define %sl%s%s %d\n", prefix
, n
->kwname
, postfix
,
461 type
, prefix
, postfix
);
463 for (n
= names_alpha
.first
; n
!= (name
) &names_alpha
; n
= n
->next_alpha
)
469 prefix
, n
->kwname
, postfix
);
476 typedef enum %s_ %s;\n\
478 prefix
, postfix
, type
, type
);
480 /* Now output the C program. */
485 %s (ffelexToken t)\n\
490 p = ffelex_token_text (t);\n\
493 storage
, type
, routine
, '{');
500 if (ffelex_token_type (t) == FFELEX_typeNAME)\n\
502 switch (ffelex_token_length (t))\n\
509 assert (ffelex_token_type (t) == FFELEX_typeNAME);\n\
511 switch (ffelex_token_length (t))\n\
516 /* Now output the length as a case, followed by the binary search within that length. */
518 for (len
= 0; ((size_t) len
) < ARRAY_SIZE (names
); ++len
)
520 if (names
[len
].first
!= (name
) &names
[len
])
534 testname (FALSE
, do_names
? 10 : 6, names
[len
].first
, names
[len
].last
);
573 assert (ffelex_token_type (t) == FFELEX_typeNAMES);\n\
575 switch (ffelex_token_length (t))\n\
581 /* Find greatest non-empty length list. */
583 for (len
= ARRAY_SIZE (names
) - 1;
584 names
[len
].first
== (name
) &names
[len
];
588 /* Now output the length as a case, followed by the binary search within that length. */
592 for (; len
!= 0; --len
)
599 if (names
[len
].first
!= (name
) &names
[len
])
600 testnames (FALSE
, 6, len
, names
[len
].first
, names
[len
].last
);
602 if (names
[1].first
== (name
) &names
[1])
607 ); /* Need empty statement after an empty case
631 testname (bool nested
, int indent
, name first
, name last
)
638 assert (!nested
|| indent
>= 2);
639 assert (((size_t) indent
) + 4 < ARRAY_SIZE (xspaces
));
643 for (n
= first
, nhalf
= first
; n
!= last
->next
; n
= n
->next
)
645 if ((++num
& 1) == 0)
657 xspaces
[indent
- 2]);
661 %sif ((c = ffesrc_strcmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\")) == 0)\n\
664 xspaces
[indent
], nhalf
->name_uc
, nhalf
->name_lc
, nhalf
->name_ic
,
665 xspaces
[indent
+ 2], prefix
, nhalf
->kwname
, postfix
);
680 xspaces
[indent
+ 2]);
682 testname (TRUE
, indent
+ 4, first
, nhalf
->previous
);
684 if (num
- numhalf
> 1)
692 testname (TRUE
, indent
+ 4, nhalf
->next
, last
);
701 xspaces
[indent
- 2]);
705 testnames (bool nested
, int indent
, int len
, name first
, name last
)
712 assert (!nested
|| indent
>= 2);
713 assert (((size_t) indent
) + 4 < ARRAY_SIZE (xspaces
));
717 for (n
= first
, nhalf
= first
; n
!= last
->next
; n
= n
->next
)
719 if ((++num
& 1) == 0)
731 xspaces
[indent
- 2]);
735 %sif ((c = ffesrc_strncmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\", %d)) == 0)\n\
738 xspaces
[indent
], nhalf
->name_uc
, nhalf
->name_lc
, nhalf
->name_ic
,
739 len
, xspaces
[indent
+ 2], prefix
, nhalf
->kwname
, postfix
);
754 xspaces
[indent
+ 2]);
756 testnames (TRUE
, indent
+ 4, len
, first
, nhalf
->previous
);
758 if (num
- numhalf
> 1)
766 testnames (TRUE
, indent
+ 4, len
, nhalf
->next
, last
);
775 xspaces
[indent
- 2]);