Octopus
varinfo_low.c
Go to the documentation of this file.
1/*
2 Copyright (C) 2002 M. Marques, A. Castro, A. Rubio, G. Bertsch
3
4 This program is free software; you can redistribute it and/or modify
5 it under the terms of the GNU General Public License as published by
6 the Free Software Foundation; either version 2, or (at your option)
7 any later version.
8
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 GNU General Public License for more details.
13
14 You should have received a copy of the GNU General Public License
15 along with this program; if not, write to the Free Software
16 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
17 02110-1301, USA.
18
19*/
20
21#include <config.h>
22
23#define _GNU_SOURCE
24#include <ctype.h>
25#include <fortran_types.h>
26#include <stdio.h>
27#include <stdlib.h>
28#include <string.h>
29
30#include "string_f.h" /* fortran <-> c string compatibility issues */
31
32typedef struct opt_type {
33 char *name;
34 char *value;
35 char *desc;
36 struct opt_type *next;
37} opt_type;
38
39typedef struct var_type {
40 char *name;
41 char *type;
42 char *default_str; /* default is a reserved keyword */
43 char *section;
44 char *desc;
46 struct var_type *next;
47} var_type;
48
49static var_type *vars = NULL;
50
51/* --------------------------------------------------------- */
52char *get_token(char *s, char **dest) {
53 char *s1;
54 size_t len;
55 /* get rid of initial whitespace */
56 for (; *s != '\0' && isspace(*s); s++)
57 ;
58 if (!isalnum(*s) && *s != '-') {
59 *dest = NULL;
60 return s;
61 }
63 for (s1 = s; isalnum(*s1) || *s1 == '_' || *s1 == '-' || *s1 == '('; s1++)
64 ;
65 len = s1 - s;
66
67 *dest = (char *)strndup(s, len);
69 return s1;
70}
71
72/* --------------------------------------------------------- */
73void get_text(FILE *in, char **dest) {
74 char c, line[256];
75 int b;
77 for (;;) {
78 /* check if the next line starts by a space */
79 if ((b = getc(in)) == EOF)
80 return;
81 c = (char)b;
82 ungetc(c, in);
83
84 if (!isspace(c))
85 return;
87 fgets(line, 256, in);
88 if (c == '\n') {
89 line[0] = ' ';
90 line[1] = '\n';
91 line[2] = '\0';
92 }
93
94 if (!*dest)
95 *dest = strdup(line + 1);
96 else {
97 *dest = realloc(*dest, strlen(*dest) + strlen(line + 1) + 1);
98 strcat(*dest, line + 1);
99 }
100 }
101}
102
103/* --------------------------------------------------------- */
104void FC_FUNC_(varinfo_init, VARINFO_INIT)(STR_F_TYPE const fname STR_ARG1) {
105 char line[256], *fname_c;
107 var_type *lvar = NULL;
108 opt_type *lopt;
110 TO_C_STR1(fname, fname_c);
112 in = fopen(fname_c, "r");
113 free(fname_c);
114 if (!in) {
115 return;
118 while (fgets(line, 256, in)) {
120 if (strncasecmp("Variable", line, 8) == 0) {
121 char *s;
123 get_token(line + 9, &s);
124 if (s) { /* found a token */
125 if (!lvar) {
126 lvar = (var_type *)malloc(sizeof(var_type));
127 vars = lvar;
128 } else {
129 lvar->next = (var_type *)malloc(sizeof(var_type));
130 lvar = lvar->next;
132 lvar->name = s;
133 lvar->desc = NULL;
134 lvar->type = NULL;
135 lvar->default_str = NULL;
136 lvar->section = NULL;
137 lvar->opt = NULL;
138 lvar->next = NULL;
140 lopt = NULL;
141 }
142 continue;
145 /* if no variable was found continue */
146 if (!lvar)
147 continue;
149 if (strncasecmp("Type", line, 4) == 0)
150 get_token(line + 5, &(lvar->type));
152 if (strncasecmp("Default", line, 7) == 0)
153 get_token(line + 8, &(lvar->default_str));
154
155 if (strncasecmp("Section", line, 7) == 0) {
156 char *s = line + 7;
157 for (; *s != '\0' && isspace(*s); s++)
159 lvar->section = strdup(s);
160 }
161
162 if (strncasecmp("Description", line, 11) == 0) {
163 if (lvar->desc) { /* if repeated delete old description */
164 free(lvar->desc);
165 lvar->desc = NULL;
167 get_text(in, &(lvar->desc));
168 }
170 if (strncasecmp("Option", line, 6) == 0) {
171 char *name, *value, *s;
172 s = get_token(line + 6, &name);
173 if (name)
174 get_token(s, &value);
175
176 if (name) { /* found an option */
177 if (!lopt) {
178 lopt = (opt_type *)malloc(sizeof(opt_type));
179 lvar->opt = lopt;
180 } else {
181 lopt->next = (opt_type *)malloc(sizeof(var_type));
182 lopt = lopt->next;
183 }
184 lopt->name = name;
185 lopt->value = value;
186 lopt->desc = NULL;
187 get_text(in, &(lopt->desc));
188 lopt->next = NULL;
189 }
190 }
191 }
195/* --------------------------------------------------------- */
196void FC_FUNC_(varinfo_end, VARINFO_END)() {
198 for (; v;) {
199 var_type *v1 = v->next;
200 opt_type *o = v->opt;
202 if (v->name)
203 free(v->name);
204 if (v->type)
205 free(v->type);
207 free(v->default_str);
208 if (v->section)
209 free(v->section);
210 if (v->desc)
211 free(v->desc);
212 for (; o;) {
213 opt_type *o1 = o->next;
214 if (o->name)
215 free(o->name);
216 if (o->value)
217 free(o->value);
218 if (o->desc)
219 free(o->desc);
220
221 free(o);
222 o = o1;
223 }
224
225 free(v);
226 v = v1;
227 }
228}
229
230/* --------------------------------------------------------- */
231void FC_FUNC_(varinfo_getvar, VARINFO_GETVAR)(STR_F_TYPE const name,
232 var_type **var STR_ARG1) {
233 char *name_c;
234 var_type *lvar;
235
236 TO_C_STR1(name, name_c);
237 for (lvar = vars; (lvar != NULL) && (strcasecmp(name_c, lvar->name) != 0);
238 lvar = lvar->next)
239 ;
240 free(name_c);
241
242 *var = lvar;
243}
244
245/* --------------------------------------------------------- */
246void FC_FUNC_(varinfo_getinfo, VARINFO_GETINFO)(const var_type **var,
247 char **name, char **type,
248 char **default_str,
249 char **section, char **desc) {
250 if (var == NULL) {
251 *name = NULL;
252 *type = NULL;
253 *default_str = NULL;
254 *section = NULL;
255 *desc = NULL;
256 } else {
257 *name = (*var)->name;
258 *type = (*var)->type;
259 *default_str = (*var)->default_str;
260 *section = (*var)->section;
261 *desc = (*var)->desc;
262 }
263}
264
265/* --------------------------------------------------------- */
266void FC_FUNC_(varinfo_getopt, VARINFO_GETOPT)(const var_type **var,
267 opt_type **opt) {
268 if (*var == NULL)
269 *opt = NULL;
270 else if (*opt == NULL)
271 *opt = (*var)->opt;
272 else
273 *opt = (*opt)->next;
274}
275
276/* --------------------------------------------------------- */
277
278void FC_FUNC_(varinfo_opt_getinfo,
279 VARINFO_OPT_GETINFO)(const opt_type **opt, char **name,
280 fint8 *value, char **desc) {
281 if (opt == NULL) {
282 *name = NULL;
283 *desc = NULL;
284 *value = 0;
285 } else {
286 *name = (*opt)->name;
287 *desc = (*opt)->desc;
288 if ((*opt)->value) {
289 if (strncmp("bit", (*opt)->value, 3) == 0) {
290 *value = ((int64_t)1) << strtoll((*opt)->value + 4, NULL, 10);
291 } else {
292 *value = strtoll((*opt)->value, NULL, 10);
293 }
294
295 } else {
296 *value = 0;
297 }
298 }
299}
300
301/* ---------------------------------------------------------
302
303This function searches for a substring in the name of a variable. If
304var is set to NULL, it starts from the beginning of the list. If it is
305different from NULL, it assumes it is the result of a previous search and
306it starts searching from that point. It returns NULL if nothing is
307found.
308
309 --------------------------------------------------------- */
310
311/* used by liboct_parser/symbols.c */
312int varinfo_variable_exists(const char *var_name) {
313 var_type *lvar;
314 for (lvar = vars; (lvar != NULL) && (strcasecmp(var_name, lvar->name) != 0);
315 lvar = lvar->next)
316 ;
317 return (lvar != NULL);
318}
319
320void FC_FUNC_(varinfo_search_var, VARINFO_SEARCH_VAR)(const STR_F_TYPE name,
321 var_type **var STR_ARG1) {
322 char *name_c;
323 var_type *lvar;
324
325 if (*var == NULL)
326 lvar = vars;
327 else
328 lvar = (*var)->next;
329
330 TO_C_STR1(name, name_c);
331 for (; (lvar != NULL) && (strcasestr(lvar->name, name_c) == 0);
332 lvar = lvar->next)
333 ;
334 free(name_c);
335
336 *var = lvar;
337}
338
339void FC_FUNC_(varinfo_search_option,
340 VARINFO_SEARCH_OPTION)(const var_type **var,
341 const STR_F_TYPE name, int *value,
342 int *ierr STR_ARG1) {
343 char *name_c;
344 opt_type *opt;
345
346 TO_C_STR1(name, name_c);
347
348 opt = (*var)->opt;
349 *ierr = -1;
350
351 while (opt != NULL) {
352 if (strcmp(opt->name, name_c) == 0) {
353 *value = atoi(opt->value);
354 printf("%s|%s|\n", opt->name, name_c);
355 *ierr = 0;
356 break;
357 }
358 opt = opt->next;
359 }
360
361 free(name_c);
362}
long long int fint8
Definition: fortran_types.h:16
__int64_t int64_t
Definition: io_binary.c:1328
integer, parameter in
Definition: pes_mask.F90:258
real(real64) function s()
char * default_str
Definition: varinfo_low.c:2756
char * type
Definition: varinfo_low.c:2755
char * section
Definition: varinfo_low.c:2757
char * desc
Definition: varinfo_low.c:2758
char * name
Definition: varinfo_low.c:2754
opt_type * opt
Definition: varinfo_low.c:2759
struct var_type * next
Definition: varinfo_low.c:2760
int varinfo_variable_exists(const char *var_name)
Definition: varinfo_low.c:3171
char * get_token(char *s, char **dest)
Definition: varinfo_low.c:2770
int fclose(FILE *__stream)
struct var_type var_type
static var_type * vars
Definition: varinfo_low.c:2763
void get_text(FILE *in, char **dest)
Definition: varinfo_low.c:2819
opt_type
Definition: varinfo_low.c:2751