1 /*********************************************************************
2 Copyright 2008, 2010 Sandia Corporation. Under the terms of Contract
3 DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government
4 retains certain rights in this software.
5
6 Redistribution and use in source and binary forms, with or without
7 modification, are permitted provided that the following conditions
8 are met:
9
10 * Redistributions of source code must retain the above copyright
11 notice, this list of conditions and the following disclaimer.
12
13 * Redistributions in binary form must reproduce the above copyright
14 notice, this list of conditions and the following disclaimer in the
15 documentation and/or other materials provided with the distribution.
16
17 * Neither the name of Sandia Corporation nor the names of its
18 contributors may be used to endorse or promote products derived from
19 this software without specific prior written permission.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
27 LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
28 DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
29 THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
30 (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
31 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 ***********************************************************************/
33
34 /* nidr.c */
35
36 #ifndef NIDR_H /* for $DAKOTA/src/nidr.c */
37 #include "nidr.h"
38 #endif
39 #include <stdarg.h>
40 #include <stdlib.h>
41 #include <string.h>
42 #include <ctype.h>
43 #include <stdio.h>
44 #include <sys/types.h>
45 #include <sys/stat.h>
46 #include "avltree.h"
47
48 #ifndef NIDR_SQUAWKMAX
49 #define NIDR_SQUAWKMAX 10
50 #endif
51
52 /* for isatty(), getegid() */
53 #if defined(_WIN32) || defined(_WIN64)
54 #include <io.h>
55 #else
56 #include <unistd.h>
57 #endif
58
59 #ifndef NO_NIDR_DYNLIB /*{*/
60 typedef KeyWord *(*KW_ADD)(void);
61 static KeyWord *kwfind(const char *, KeyWord *, int, int *);
62 static KeyWord *toomany(const char *, KeyWord *, int);
63 #ifdef _WIN32 /*{{*/
64 #include <windows.h>
65 #define dlopen(x,y) LoadLibrary(x)
66 #define find_dlsym(a,b,c) (a = (KW_ADD)GetProcAddress((HINSTANCE)(b),c))
67 #define dlclose(x) FreeLibrary((HMODULE)x)
68 #define NO_DLERROR
69 #else /*}{*/
70 #include <dlfcn.h>
71 #define find_dlsym(a,b,c) (a = (KW_ADD)dlsym(b,c))
72 #undef NO_DLERROR
73 #endif /*}}*/
74 #endif /*}*/
75
76 extern KeyWord Dakota_Keyword_Top;
77 extern int nidrLineNumber;
78 static KeyWord* Keyword_Top = &Dakota_Keyword_Top;
79 static void *KW_g;
80 void (*nidr_comment)(const char*);
81 static void nidr_keyword_finish(void);
82 static Comment *OutsideComment;
83 static void kw_finish2(void), kw_finish3(void);
84 static void kw_setup1(KeyWord *);
85 static FILE *dumpfile;
86 static KeyWord **ToClear, **ToClear0, **ToClearEnd;
87 static int dumplev, nsquawk, nparse_errors, primary, strict;
88
89 int NIDR_disallow_missing_start = 1;
90
91 enum {n_KWStack0 = 64};
92
93 static KWinfo KWStack0[n_KWStack0];
94
95 static Uint n_KWStack = n_KWStack0;
96
97 static KeyWord *curid, *curkw;
98 static KWinfo *KWStack = KWStack0,
99 *KWStackBot = KWStack0,
100 *KWStackEnd = KWStack0 + n_KWStack0;
101
102 static Values KWval, KWvalmax;
103 static Real *KWvalbuf;
104 static Uint nKWvalbuf;
105
106 typedef struct Sbuf Sbuf;
107 enum { n_KWsbuf = 8192 };
108 struct Sbuf {
109 char buf[n_KWsbuf];
110 Sbuf *next;
111 };
112
113 typedef struct KWseen KWseen;
114
115 struct
116 KWseen {
117 const char *name;
118 KeyWord *kw;
119 KWseen *mnext, *mprev; /* for identifiers so far unrequited when kw == 0 */
120 /* kw != 0 ==> mprev = first child, and mnext = next sibling */
121 KWseen *parent;
122 KWseen **lcn; /* &mprev field of last child; lcn == 0 when this */
123 /* keyword was entered into the AVL tree because */
124 /* its parent was seen. */
125 Comment *comment;
126 char **svals;
127 Real *rvals;
128 size_t nvals;
129 };
130
131 static KWseen *KW_cur;
132 NIDR_KWlib *NIDR_Libs;
133
134 void
nidr_lib_cleanup(void)135 nidr_lib_cleanup(void)
136 {
137 KeyWord *kw;
138 NIDR_KWlib *L, *L1;
139
140 L1 = NIDR_Libs;
141 NIDR_Libs = 0;
142 while((L = L1)) {
143 if (L->oldtop)
144 Keyword_Top = L->oldtop;
145 if ((kw = L->kw0)) {
146 kw->f.vs = 0;
147 kw->kind &= ~KWKind_Loaded;
148 }
149 #ifndef NO_NIDR_DYNLIB /*{{*/
150 dlclose(L->h);
151 #else /*}{*/
152 /* botch("dlclose is NOT SUPPORTED for current configuration"); */
153 fprintf(stderr, "\ndlclose is NOT SUPPORTED for current configuration");
154 #endif /*}}*/
155 L1 = L->next;
156 free(L);
157 }
158 }
159
160 static Sbuf KWsbuf0, *KWsbuf = &KWsbuf0;
161 static char *KWsbuf1 = KWsbuf0.buf, *KWsbufe = KWsbuf0.buf + n_KWsbuf;
162 static KWseen *curkws;
163 static const char *valkind[3] = {"integer","numeric","string"};
164
165 int
nidr_parse_error(void)166 nidr_parse_error(void)
167 {
168 int n;
169 if ((n = nsquawk - NIDR_SQUAWKMAX) > 0)
170 fprintf(stderr, "\n%d error message%s suppressed.\n",
171 n, "s" + (n == 1));
172 return nsquawk + nparse_errors;
173 }
174
175 void
nidr_signal_parse_error(void)176 nidr_signal_parse_error(void)
177 { ++nparse_errors; }
178
179 void
nidr_tolower(char * s)180 nidr_tolower(char *s)
181 {
182 for(; *s; ++s)
183 *s = tolower(*s);
184 }
185
186 static void
botch(const char * fmt,...)187 botch(const char *fmt, ...)
188 {
189 va_list ap;
190 va_start(ap, fmt);
191 fprintf(stderr, "\nBotch: ");
192 vfprintf(stderr, fmt, ap);
193 fputs(".\n", stderr);
194 va_end(ap);
195 exit(1);
196 }
197
198 static void
squawk(const char * fmt,...)199 squawk(const char *fmt, ...)
200 {
201 va_list ap;
202 if (++nsquawk <= NIDR_SQUAWKMAX) {
203 fprintf(stderr, "Input line %d: ", nidrLineNumber);
204 va_start(ap, fmt);
205 vfprintf(stderr, fmt, ap);
206 fputs(".\n", stderr);
207 va_end(ap);
208 }
209 }
210
211 #ifdef NIDR_MALLOC_DEBUG
212 typedef struct MallocDebug MallocDebug;
213 struct MallocDebug
214 {
215 MallocDebug *next, *prev;
216 char *where;
217 int nalloc;
218 };
219
220 static MallocDebug MDtop = {&MDtop, &MDtop, 0, 0};
221 int MallocDebugCount, MallocDebugCount1;
222
223 static void*
Alloc(const char * where,size_t len)224 Alloc(const char *where, size_t len)
225 {
226 MallocDebug *md = malloc(len + sizeof(MallocDebug));
227 if (!md) {
228 fprintf(stderr, "malloc(%lu) failure in %s\n", (unsigned long)len, where);
229 exit(1);
230 }
231 (md->next = MDtop.next)->prev = md;
232 (md->prev = &MDtop)->next = md;
233 md->where = where;
234 if ((md->nalloc = ++MallocDebugCount) == MallocDebugCount1)
235 printf("Hit %d\n", md->nalloc);
236 return (void*)(md + 1);
237 }
238
239 static void
MallocDebugFree(void * v)240 MallocDebugFree(void *v)
241 {
242 MallocDebug *md = (MallocDebug *)v - 1;
243 md->next->prev = md->prev;
244 md->prev->next = md->next;
245 free(md);
246 }
247 #define free MallocDebugFree
248
249 #else //!NIDR_MALLOC_DEBUG
250 static void*
Alloc(const char * where,size_t len)251 Alloc(const char *where, size_t len)
252 {
253 void *rv = malloc(len);
254 if (!rv) {
255 fprintf(stderr, "malloc(%lu) failure in %s\n", (unsigned long)len, where);
256 exit(1);
257 }
258 return rv;
259 }
260 #endif //NIDR_MALLOC_DEBUG
261
262 const char *
nidr_basename(const char * p)263 nidr_basename(const char *p)
264 {
265 const char *b;
266
267 #ifdef _WIN32
268 if (p[0] && p[1] == ':')
269 p += 2;
270 else if (p[0] == '\\' && p[1] == '\\')
271 for(p += 2; *p; )
272 switch(*p++) {
273 case '/':
274 case '\\':
275 goto break2;
276 }
277 break2:
278 #endif
279 b = p;
280 while(*p)
281 switch(*p++) {
282 case '/':
283 #ifdef _WIN32
284 case '\\':
285 #endif
286 b = p;
287 }
288 return b;
289 }
290
291 const char *nidr_exedir;
292 int nidr_exedir_len = -1; /* allow resetting to -1 for debugging */
293
294 #ifndef _WIN32
295 static int
Is_executable(uid_t myuid,gid_t mygid,struct stat * sb)296 Is_executable(uid_t myuid, gid_t mygid, struct stat *sb)
297 {
298 if (sb->st_uid == myuid) {
299 if (sb->st_mode & S_IXUSR)
300 return 1;
301 }
302 else if (sb->st_gid == mygid) {
303 if (sb->st_mode & S_IXGRP)
304 return 1;
305 }
306 else if (sb->st_mode & S_IXOTH)
307 return 1;
308 return 0;
309 }
310 #endif
311
312 int
nidr_save_exedir(const char * argv0,int pathadj)313 nidr_save_exedir(const char *argv0, int pathadj)
314 {
315 /* pathadj & 1 ==> add exedir to $PATH */
316 /* pathadj & 2 ==> add . to $PATH */
317 /* (in both cases if not already there) */
318
319 /* These conditionals don't seem to work (perhaps expected) for Cygwin
320 binaries run from Windows command prompt as the compile-time is
321 unix-style, but runtime the path is windows-like. For now comment
322 out warning when on Cygwin build */
323 #ifdef _WIN32
324 #define Pathname "Path"
325 #define Sep ';'
326 #define Slash '\\'
327 #define Executable(x) !stat(x,&sb)
328 #else
329 #define Pathname "PATH"
330 #define Sep ':'
331 #define Slash '/'
332 #define Executable(x) !stat(x,&sb) && Is_executable(myuid, mygid, &sb)
333 #endif
334 char *buf, buf0[4096], *s;
335 const char *av0, *p, *p0, *p1, *p2;
336 int dotseen, finaldot, rc;
337 size_t buflen, L, L1, L2, L3;
338 struct stat sb;
339 static const char dotslash[3] = { '.', Slash, 0 };
340 #ifdef _WIN32
341 int c;
342 pathadj &= 1; /* . is implicitly in $PATH under _WIN32 */
343 #else
344 gid_t mygid;
345 uid_t myuid;
346 #endif
347 if (nidr_exedir_len != -1) {
348 fprintf(stderr, "\nIgnoring extra call on nidr_save_argv0()\n");
349 return 1;
350 }
351 nidr_exedir_len = 0;
352 if (!(av0 = argv0))
353 return 2;
354 if (!(p = getenv(Pathname))) {
355 fprintf(stderr, "\nnidr_save_exedir: no $%s\n", Pathname);
356 return 3;
357 }
358 dotseen = finaldot = rc = 0;
359 buf = buf0;
360 buflen = sizeof(buf0);
361 p0 = p2 = p;
362 p1 = nidr_basename(av0);
363 if ((L = p1 - av0) > 0) {
364 memcpy(s = (char*)Alloc("nidr_save_argv0", L+1), av0, L);
365 s[L] = 0;
366 nidr_exedir = s;
367 nidr_exedir_len = (int)L;
368 #ifdef _WIN32
369 for(L1 = 0; L1 < L; ++L1)
370 if (s[L1] == '/')
371 s[L1] = '\\';
372 #endif
373 if (!pathadj)
374 return 0;
375 if (*p == Sep)
376 dotseen = 1;
377 while(*p) {
378 if (*p == Sep && (p[1] == Sep || p[1] == 0)) {
379 dotseen = 1;
380 break;
381 }
382 ++p;
383 }
384 if (s[0] == '.' && s[1] == Slash && L == 2) {
385 #ifdef _WIN32
386 return 0;
387 #else
388 if (!dotseen)
389 goto dot_add;
390 #endif
391 }
392 L1 = L - 1;
393 for(p = p0;;) {
394 while(*p == Sep)
395 ++p;
396 if (!*p)
397 break;
398 if (!strncmp(p, s, L1)) {
399 #ifdef _WIN32
400 return 0;
401 #else
402 if (!(pathadj &= ~1) || *p0 == Sep)
403 return 0;
404 for(p = p0;;) {
405 if (*p == Sep || (*p == '.' && p[1] == Sep))
406 return 0;
407 while(*p != Sep) {
408 if (!*p)
409 goto dot_add;
410 ++p;
411 }
412 if (!*++p)
413 return 0;
414 }
415 #endif
416 }
417 while(*++p != Sep)
418 if (!*p)
419 goto break2;
420 if (!*++p) {
421 #ifdef _WIN32
422 finaldot = 1; /* leave at 0 for !_WIN32 */
423 #endif
424 break;
425 }
426 }
427 break2:
428 L1 = strlen(Pathname);
429 L2 = strlen(p0);
430 if (!pathadj & 2)
431 dotseen = 1;
432 L3 = L1 + L2 + L + 3;
433 s = (char*)Alloc("nidr_save_argv0", L3);
434 memcpy(s, Pathname, L1);
435 s[L1++] = '=';
436 memcpy(s+L1, p0, L2);
437 L1 += L2;
438 if (!finaldot)
439 s[L1++] = Sep;
440 memcpy(s+L1, nidr_exedir, --L);
441 L1 += L;
442 if (!dotseen)
443 s[L1++] = Sep;
444 s[L1] = 0; /* omit final slash */
445 putenv(s);
446 return 0;
447 }
448 L = strlen(av0);
449 #ifdef _WIN32
450 if (L < 5 || av0[L-4] != '.'
451 || ((c = av0[L-3]) != 'e' && c != 'E')
452 || ((c = av0[L-2]) != 'x' && c != 'X')
453 || ((c = av0[L-1]) != 'e' && c != 'E')) {
454 memcpy(s = (char*)Alloc("nidr_save_argv0", L + 5), av0, L);
455 strcpy(s+L, ".exe");
456 L += 4;
457 av0 = s;
458 }
459 if (Executable(av0)) {
460 /* handle implicit . */
461 dotseen = 1;
462 nidr_exedir = dotslash;
463 }
464 else /* do for loop */
465 #else
466 myuid = geteuid();
467 mygid = getegid();
468 #endif
469 for(; *p; p = p2) {
470 for(p1 = p;; ++p1) {
471 if (*p1 == Sep) {
472 p2 = p1 + 1;
473 if (!*p2)
474 finaldot = 1;
475 break;
476 }
477 if (!*p1) {
478 p2 = p1;
479 break;
480 }
481 }
482 if (p1 == p || (*p == '.' && p1 == p + 1)) {
483 if (!dotseen) {
484 dotseen = 1;
485 if (Executable(av0)) {
486 nidr_exedir = dotslash;
487 break;
488 }
489 }
490 }
491 else {
492 L1 = p1 - p;
493 L2 = L + L1 + 2;
494 if (L2 > buflen) {
495 if (buf != buf0)
496 free(buf);
497 buf = (char*)Alloc("nidr_save_argv0", L2);
498 buflen = L2;
499 }
500 memcpy(buf, p, L1);
501 buf[L1++] = Slash;
502 strcpy(buf+L1, av0);
503 if (Executable(buf)) {
504 s = (char*)Alloc("nidr_save_argv0", L1+1);
505 memcpy(s, buf, L1);
506 s[L1] = 0;
507 nidr_exedir = s;
508 nidr_exedir_len = (int)L1;
509 pathadj &= ~1;
510 break;
511 }
512 }
513 }
514 if (dotseen)
515 pathadj &= ~2;
516 if (!finaldot && *p2) {
517 while(p2[1])
518 ++p2;
519 if (*p2 == Sep)
520 finaldot = 1;
521 }
522 if (finaldot && !dotseen && !nidr_exedir) {
523 dotseen = 1;
524 if (Executable(av0))
525 nidr_exedir = dotslash;
526 }
527 if (nidr_exedir == dotslash)
528 nidr_exedir_len = 2;
529 else {
530 if (pathadj & 2 && !finaldot) {
531 #ifndef _WIN32
532 dot_add:
533 #endif
534 L = strlen(p0);
535 L1 = strlen(Pathname);
536 L2 = L + L1 + 3;
537 s = (char*)Alloc("nidr_save_argv0", L2);
538 memcpy(s, Pathname, L1);
539 s[L1++] = '=';
540 memcpy(s+L1, p0, L);
541 s[L += L1] = Sep;
542 s[L+1] = 0;
543 putenv(s);
544 }
545 if (!nidr_exedir) {
546 /* Suppress warning for Cygwin and Windows, where path isn't resolved correctly above */
547 #if !defined(__CYGWIN__) && !defined(_MSC_VER)
548 fprintf(stderr, "\nnidr_save_exedir: could not find \"%s\" in $%s\n",
549 av0, Pathname);
550 #endif
551 rc = 4;
552 }
553 }
554 if (buf != buf0)
555 free(buf);
556 return rc;
557 }
558
559 void *
nidr_dlopen(const char * libname)560 nidr_dlopen(const char *libname)
561 {
562 #ifdef NO_NIDR_DYNLIB /*{{*/
563 botch("dlopen for \"%s\" is NOT SUPPORTED", libname);
564 return (void*)libname;
565 #else /*}{*/
566 char buf0[4096], *buf;
567 const char *b;
568 size_t buflen, L, L1;
569 void *h;
570
571 b = nidr_basename(libname);
572 if (b > libname)
573 return dlopen(libname, RTLD_NOW);
574 buf = buf0;
575 buflen = sizeof(buf0);
576 L = strlen(libname);
577 if (nidr_exedir) {
578 L1 = L + nidr_exedir_len + 1;
579 if (L1 > buflen) {
580 buf = (char*)Alloc("nidr_dlopen", L1);
581 buflen = L1;
582 }
583 memcpy(buf, nidr_exedir, nidr_exedir_len);
584 strcpy(buf + nidr_exedir_len, libname);
585 if ((h = dlopen(buf, RTLD_NOW)))
586 goto ret;
587 }
588 if (!(h = dlopen(libname, RTLD_NOW))) {
589 L1 = L + 3;
590 if (L1 > buflen) {
591 buf = (char*)Alloc("nidr_dlopen", L1);
592 buflen = L1;
593 }
594 buf[0] = '.';
595 buf[1] = Slash;
596 strcpy(buf+2, libname);
597 if (!(h = dlopen(buf, RTLD_NOW)))
598 h = dlopen(libname, RTLD_NOW); /* for dlerror */
599 }
600 ret:
601 if (buf != buf0)
602 free(buf);
603 return h;
604 #endif /*}}*/
605 }
606
607 #undef Executable
608 #undef Slash
609 #undef Sep
610 #undef Pathname
611
612
613 struct
614 Comment {
615 int k; /* subscript for comfree */
616 size_t avail; /* bytes left (from tnext) */
617 char *text; /* text of comment */
618 char *tnext; /* null byte at end of comment */
619 Comment *fnext; /* next free Comment */
620 };
621
622 enum { Comment_kmax = 7 };
623
624 static Comment *comfree[Comment_kmax+1];
625 static size_t Comment_maxlen[Comment_kmax+1];
626
627 static void
comment_free(Comment * c)628 comment_free(Comment *c)
629 {
630 int k = c->k;
631
632 if (k > Comment_kmax)
633 free(c);
634 else {
635 c->fnext = comfree[k];
636 comfree[k] = c;
637 }
638 }
639
640 static Comment*
alloc_comment(int k,size_t L)641 alloc_comment(int k, size_t L)
642 {
643 Comment *c;
644
645 for(; k <= Comment_kmax; ++k) {
646 if (L <= Comment_maxlen[k]) {
647 L = Comment_maxlen[k];
648 if ((c = comfree[k])) {
649 comfree[k] = c->fnext;
650 goto have_c;
651 }
652 break;
653 }
654 }
655 c = (Comment*)Alloc("save_comment", L + sizeof(Comment) + 1);
656 c->k = k;
657 c->text = (char*)(c+1);
658 have_c:
659 c->avail = L;
660 c->tnext = c->text;
661 return c;
662 }
663
664 static void
save_comment(const char * s)665 save_comment(const char *s)
666 {
667 Comment *c, *c1, **cp;
668 size_t L, L1;
669
670 L = strlen(s);
671 cp = curid ? &curid->comment : curkws ? &curkws->comment : &OutsideComment;
672 if ((c = *cp)) {
673 if (c->avail >= L)
674 goto cupdate;
675 L1 = c->tnext - c->text;
676 c1 = alloc_comment(c->k + 1, L + L1);
677 memcpy(c1->text, c->text, L1);
678 c1->tnext = c1->text + L1;
679 c1->avail -= L1;
680 comment_free(c);
681 c = c1;
682 }
683 else
684 c = alloc_comment(0, L);
685 cupdate:
686 memcpy(c->tnext, s, L+1);
687 c->tnext += L;
688 c->avail -= L;
689 *cp = c;
690 }
691
692 static void
comment_setup(void)693 comment_setup(void)
694 {
695 int i;
696 size_t L;
697 nidr_comment = save_comment;
698 /* "- 1" to allow for terminating '\0' */
699 for(L = 64; L <= sizeof(Comment) - 1; L <<= 1);
700 for(i = 0; i <= Comment_kmax; ++i, L <<= 1)
701 Comment_maxlen[i] = L - sizeof(Comment) - 1;
702 }
703
704 static void
comment_reset(void)705 comment_reset(void)
706 {
707 Comment *c, *c1;
708 int i;
709
710 for(i = 0; i <= Comment_kmax; ++i) {
711 c1 = comfree[i];
712 comfree[i] = 0;
713 while((c = c1)) {
714 c1 = c->fnext;
715 free(c);
716 }
717 }
718 nidr_comment = 0;
719 }
720
721 static void
dumpcomment(Comment ** cp)722 dumpcomment(Comment **cp)
723 {
724 Comment *c = *cp;
725 *cp = 0;
726 fprintf(dumpfile, "%s", c->text);
727 comment_free(c);
728 }
729
730 static void
dumpname(int hasval,KeyWord * kw)731 dumpname(int hasval, KeyWord *kw)
732 {
733 const char *fmt[2] = { "%s", "%s =" };
734 int i;
735 if (OutsideComment)
736 dumpcomment(&OutsideComment);
737 if (primary)
738 kw += kw->paoff;
739 for(i = 0; i < dumplev; ++i)
740 putc(' ', dumpfile);
741 fprintf(dumpfile,fmt[hasval],kw->name);
742 if (!hasval) {
743 if (kw->comment)
744 dumpcomment(&kw->comment);
745 else if (kw != curkw)
746 putc('\n', dumpfile);
747 }
748 }
749
750 static void
dumpstring(const char * s0)751 dumpstring(const char *s0)
752 {
753 const char *s;
754 int c, n1, n2, q;
755
756 n1 = n2 = 0;
757 for(s = s0;;)
758 switch(*s++) {
759 case 0: goto break2;
760 case '\'':
761 ++n1;
762 break;
763 case '"':
764 ++n2;
765 }
766 break2:
767 q = '\'';
768 if (n1 > n2)
769 q = '"';
770 putc(' ', dumpfile);
771 putc(q, dumpfile);
772 s = s0;
773 while((c = *s++)) {
774 if (c == q)
775 putc(q, dumpfile);
776 putc(c, dumpfile);
777 }
778 putc(q, dumpfile);
779 }
780
781 static void
dumpvals0(KeyWord * kw)782 dumpvals0(KeyWord *kw)
783 {
784 Real *r;
785 const char **sp;
786 int i, *ip, indent, j, n;
787
788 ip = 0; /* shut up warning of possible use without initialization */
789 sp = 0; /* ditto */
790 if (!(r = KWval.r) && !(ip = KWval.i) && !(sp = KWval.s))
791 return;
792 n = KWval.n;
793 putc((indent = n > 1) ? '\n' : ' ', dumpfile);
794 for(i = 0;;) {
795 if (indent) {
796 putc('\t', dumpfile);
797 for(j = 0; j < dumplev; ++j)
798 putc(' ', dumpfile);
799 }
800 if (r)
801 fprintf(dumpfile, "%.15g", r[i]);
802 else if (ip)
803 fprintf(dumpfile, "%d", ip[i]);
804 else
805 dumpstring(sp[i]);
806 if (++i >= n)
807 break;
808 indent = 1;
809 putc('\n', dumpfile);
810 }
811 if (kw->comment)
812 dumpcomment(&kw->comment);
813 else
814 putc('\n', dumpfile);
815 }
816
817 static void (*dumpvals)(KeyWord *kw) = dumpvals0;
818
819 static void
dumpvals1(KeyWord * kw)820 dumpvals1(KeyWord *kw)
821 {
822 Real *r;
823 const char **sp;
824 int i, *ip, n;
825
826 ip = 0; /* shut up warning of possible use without initialization */
827 sp = 0; /* ditto */
828 if ((r = KWval.r) || (ip = KWval.i) || (sp = KWval.s)) {
829 n = KWval.n;
830 for(i = 0; i < n; ++i) {
831 if (r)
832 fprintf(dumpfile, " %.15g", r[i]);
833 else if (ip)
834 fprintf(dumpfile, " %d", ip[i]);
835 else
836 dumpstring(sp[i]);
837 }
838 }
839 if (kw->comment)
840 dumpcomment(&kw->comment);
841 else
842 putc('\n', dumpfile);
843 }
844
845 char *
nidr_KWscopy(const char * s)846 nidr_KWscopy(const char *s)
847 {
848 Sbuf *sb;
849 char *rv;
850
851 size_t L = strlen(s) + 1;
852 if (L >= n_KWsbuf)
853 botch("String too long in KWscopy");
854 if (KWsbufe - KWsbuf1 < L) {
855 if (!KWsbuf->next) {
856 KWsbuf->next = sb = (Sbuf*)Alloc("KWscopy", sizeof(Sbuf));
857 sb->next = 0;
858 }
859 KWsbuf = KWsbuf->next;
860 KWsbuf1 = KWsbuf->buf;
861 KWsbufe = KWsbuf1 + n_KWsbuf;
862 }
863 strcpy(KWsbuf1, s);
864 rv = KWsbuf1;
865 KWsbuf1 += L;
866 return rv;
867 }
868
869 static void
KWvalbuf_inc(void)870 KWvalbuf_inc(void)
871 {
872 Real *r;
873 Uint n;
874
875 n = nKWvalbuf << 1;
876 r = (Real*)Alloc("KWvalbuf", n*sizeof(Real));
877 memcpy(r, KWvalbuf, nKWvalbuf*sizeof(Real));
878 free(KWvalbuf);
879 KWvalbuf = r;
880 nKWvalbuf = n;
881 KWvalmax.n <<= 1;
882 if (KWval.r) {
883 KWval.r = r;
884 KWvalmax.r = r + n;
885 }
886 else if (KWval.i) {
887 KWval.i = (int*) r;
888 KWvalmax.i = (int*)(r + n);
889 }
890 else if (KWval.s) {
891 KWval.s = (const char**)r;
892 KWvalmax.s = (const char**)(r + n);
893 }
894 else
895 botch("Unexpected case in KWvalbuf_inc");
896 }
897
898 /* KWval.rstate values...
899 * value form seen
900 * 0 v
901 * 1 L:u
902 * 2 L:s:u
903 * 3 n*v
904 * 4 n*L:u
905 * 5 n*L:s:u
906 */
907
908 static void
finish_rexpand(void)909 finish_rexpand(void)
910 {
911 int i, k, n, os;
912 Real sgn, st, u, v, x;
913
914 os = KWval.rstate;
915 KWval.rstate = 0;
916 n = KWval.n;
917 k = 1;
918 if (os >= 3) {
919 KWval.n = n -= os-1;
920 k = KWval.r[n];
921 if (k != KWval.r[n]) {
922 squawk("Noninteger replication factor %.17g", KWval.r[n]);
923 return;
924 }
925 else if (k < 1) {
926 squawk("Nonpositive replication factor %d", k);
927 return;
928 }
929 ++n;
930 os -= 3;
931 }
932 else
933 KWval.n = n -= os + 1;
934 v = KWval.r[n++];
935 u = st = 0.; /* Shut up warning of not being initialized. */
936 /* Both will be assigned before being used. */
937 switch(os) {
938 case 0:
939 n = KWval.n;
940 for(i = 0; i < k; ++i) {
941 if (n >= KWvalmax.n)
942 KWvalbuf_inc();
943 KWval.r[n++] = v;
944 }
945 KWval.n = n;
946 return;
947 case 1:
948 st = 1;
949 u = KWval.r[n];
950 break;
951 case 2:
952 st = KWval.r[n];
953 if (st == 0.) {
954 squawk("Invalid stride == zero.");
955 return;
956 }
957 u = KWval.r[n+1];
958 }
959 sgn = 1.;
960 if (st < 0.)
961 sgn = -1.;
962 if (sgn*(u - v) < 0.) {
963 squawk("Empty sequence.");
964 return;
965 }
966 n = KWval.n;
967 do {
968 for(i = 0; sgn*(u - (x = v + i*st)) >= 0.; ++i) {
969 if (n >= KWvalmax.n)
970 KWvalbuf_inc();
971 KWval.r[n++] = x;
972 }
973 }
974 while(--k > 0);
975 KWval.n = n;
976 }
977
978 static void
rexpand(int state)979 rexpand(int state)
980 {
981 int os;
982
983 os = KWval.rstate;
984 KWval.rstate = 0;
985 switch(state) {
986 case 1: /* just saw *v */
987 if (os == 0)
988 KWval.rstate = 3;
989 else
990 squawk("Unexpected '*'");
991 break;
992 case 2: /* just saw :v */
993 if (os == 2 || os == 5)
994 squawk("Unexpected ':'");
995 else
996 KWval.rstate = os + 1;
997 break;
998 }
999 }
1000
1001 static void
nidr_bufr_strict(Real r,int state)1002 nidr_bufr_strict(Real r, int state)
1003 {
1004 int k, n;
1005
1006 if (KWval.s) {
1007 squawk("expected a quoted string, but found a number");
1008 return;
1009 }
1010 if (KWval.rstate && !state)
1011 finish_rexpand();
1012 if (!KWval.r && !KWval.i) {
1013 squawk("No values may be specified for %s", KWStack->kw->name);
1014 return;
1015 }
1016 if ((n = KWval.n) >= KWvalmax.n)
1017 KWvalbuf_inc();
1018 if (KWval.r)
1019 KWval.r[n] = r;
1020 else {
1021 k = (int)r;
1022 if (k != r)
1023 squawk("truncating %.17g to %d", r, k);
1024 KWval.i[n] = k;
1025 }
1026 ++KWval.n;
1027 if (state | KWval.rstate)
1028 rexpand(state);
1029 }
1030
1031 static void
nidr_bufs_strict(const char * s)1032 nidr_bufs_strict(const char *s)
1033 {
1034 if (!KWval.s) {
1035 if (KWval.r)
1036 squawk("Expected a number, but found a quoted string");
1037 else
1038 squawk("Misplaced quoted string");
1039 return;
1040 }
1041 if (KWval.n >= KWvalmax.n)
1042 KWvalbuf_inc();
1043 KWval.s[KWval.n++] = s;
1044 }
1045
1046 void
nidr_reset(void)1047 nidr_reset(void)
1048 {
1049 /* Originally did this in case KWKind_Str of kw_setup(), */
1050 /* but this leads to confusion with erroneous input. */
1051 if (curkw)
1052 nidr_keyword_finish();
1053 KWsbuf = &KWsbuf0;
1054 KWsbuf1 = KWsbuf0.buf;
1055 KWsbufe = KWsbuf0.buf + n_KWsbuf;
1056 }
1057
1058 NIDR_KWlib *
nidr_lib_record(void * h,const char * libname)1059 nidr_lib_record(void *h, const char *libname)
1060 {
1061 NIDR_KWlib *Lib;
1062 size_t L;
1063
1064 L = strlen(libname) + 1;
1065 Lib = (NIDR_KWlib*)Alloc("NIDR_lib_record", sizeof(NIDR_KWlib) + L);
1066 memset(Lib, 0, sizeof(NIDR_KWlib));
1067 memcpy(Lib->libname = (char*)(Lib+1), libname, L);
1068 if (!(Lib->next = NIDR_Libs))
1069 atexit(nidr_lib_cleanup);
1070 NIDR_Libs = Lib;
1071 Lib->h = h;
1072 return Lib;
1073 }
1074
1075 static KeyWord*
kw_insert(KeyWord * kw,int * tryagain)1076 kw_insert(KeyWord *kw, int *tryagain)
1077 {
1078 #ifdef NO_NIDR_DYNLIB /*{{*/
1079 botch("Loading library \"%s\" for %s is disallowed",
1080 kw->f.vf, kw->name);
1081 #else /*}{*/
1082 KW_ADD kwa;
1083 KeyWord *kw0, *kw1, *kw2;
1084 NIDR_KWlib *Lib;
1085 Uint u1, ui;
1086 const char *lname, *s;
1087 int newtop, nmatch;
1088 void *h;
1089
1090 if (tryagain)
1091 *tryagain = 0;
1092 if (kw->kind & KWKind_Loaded)
1093 return (KeyWord*)kw->f.vs;
1094 h = nidr_dlopen(lname = (const char*)kw->f.vf);
1095 if (!h) {
1096 #ifndef NO_DLERROR
1097 if ((s = dlerror()))
1098 botch("Cannot open library \"%s\" for %s:\n\t%s",
1099 lname, kw->name, s);
1100 else
1101 #endif
1102 botch("Cannot open library \"%s\" for %s",
1103 lname, kw->name);
1104 }
1105 if (!find_dlsym(kwa, h, "keyword_add"))
1106 botch("dlsym(\"keyword_add\") failed for %s", lname);
1107 kw1 = (*kwa)();
1108 if (!(s = kw1->name)) {
1109 s = "<NULL>";
1110 goto namebotch;
1111 }
1112 newtop = 0;
1113 if (strcmp(s, kw->name)) {
1114 if (!KW_cur && !strcmp(s,"KeywordTop") && kw1->kind & KWKind_Dynmult)
1115 newtop = 1;
1116 else if (tryagain && kw1->nkw > 0
1117 && (kw2 = kwfind(kw->name, kw1->kw, kw1->nkw, &nmatch))) {
1118 if (nmatch > 1) {
1119 toomany(kw->name, kw1, nmatch);
1120 botch("Too many matches in library %s", lname);
1121 }
1122 *tryagain = 1;
1123 }
1124 else
1125 namebotch:
1126 botch("Library %s: expected top keyword to be %s but got %s",
1127 lname, kw->name, s);
1128 }
1129 ui = kw->kind & (KWKind_Mask|KWKind_List);
1130 u1 = kw1->kind & (KWKind_Mask|KWKind_List);
1131 if (ui != u1)
1132 botch("Library %s: expected kind %u for %s, but got %u",
1133 lname, ui, s, u1);
1134 Lib = nidr_lib_record(h, lname);
1135 Lib->kw0 = kw0 = kw;
1136 memcpy(&Lib->kw, kw, sizeof(KeyWord));
1137 kw = &Lib->kw;
1138 kw->kw = kw1->kw;
1139 kw->nkw = kw1->nkw;
1140 kw->f = kw1->f;
1141 kw0->f.vs = (void*)kw;
1142 kw0->kind |= KWKind_Loaded;
1143 if (newtop) {
1144 Lib->oldtop = Keyword_Top;
1145 Keyword_Top = kw;
1146 kw->kind |= KWKind_Dynmult;
1147 }
1148 #endif /*}}*/
1149 return kw;
1150 }
1151
1152 static void
kwnext_setup(KeyWord * kw,Uint n)1153 kwnext_setup(KeyWord *kw, Uint n)
1154 {
1155 KeyWord *kwe;
1156
1157 if (kw->kwnext || (n <= 1 && kw->name))
1158 return;
1159 #ifndef NO_NIDR_DYNLIB /*{*/
1160 if (kw->kind & KWKind_Extended) {
1161 KeyWordx *kx1, *kxe;
1162 for(kx1 = (KeyWordx*)kw; !kx1->kw.name; ++kx1)
1163 kx1->kw.kwnext = (KeyWord*)(kx1 + 1);
1164 for(kxe = kx1 + n - 1; kx1 < kxe; ++kx1)
1165 kx1->kw.kwnext = (KeyWord*)(kx1 + 1);
1166 return;
1167 }
1168 #endif
1169 for(; !kw->name; ++kw)
1170 kw->kwnext = kw + 1;
1171 for(kwe = kw + n - 1; kw < kwe; ++kw)
1172 kw->kwnext = kw + 1;
1173 }
1174
1175 static void
KWStack_inc(void)1176 KWStack_inc(void)
1177 {
1178 KWinfo *kwi;
1179 Uint nn;
1180 size_t len;
1181
1182 nn = n_KWStack << 1;
1183 kwi = (KWinfo*)Alloc("kw_setup", len = nn*sizeof(KWinfo));
1184 memcpy(kwi, KWStackBot, len >> 1);
1185 if (KWStackBot != KWStack0)
1186 free(KWStackBot);
1187 KWStackBot = kwi;
1188 KWStackEnd = kwi + nn;
1189 KWStack = kwi + n_KWStack;
1190 n_KWStack = nn;
1191 }
1192
1193 static KeyWord*
kw_setup(KeyWord * kw,void * g,const char * name)1194 kw_setup(KeyWord *kw, void *g, const char *name)
1195 {
1196 KWinfo *kwi;
1197 KeyWord **alt, *kw1, **req;
1198
1199 Uint k, nalt, nn, nreq;
1200 int *altct, deferred;
1201 size_t len;
1202
1203 deferred = 0;
1204 if (kw->kind & KWKind_Dynlib) {
1205 if (kw->kw)
1206 deferred = 1;
1207 else
1208 kw = kw_insert(kw, 0);
1209 }
1210 top:
1211 if ((kw1 = kw->kw)) {
1212 kwnext_setup(kw1, kw->nkw);
1213 if (kw->kind & KWKind_Dynmult)
1214 return kw;
1215 while(!kw1->name) {
1216 if (!(kw1->kind & KWKind_Stacked)) {
1217 kw1->kind |= KWKind_Stacked;
1218 kw_setup(kw1, g, name);
1219 }
1220 kw1 = kw1->kwnext;
1221 }
1222 }
1223 if (!curkw) {
1224 KWStack = KWStackBot = KWStack0;
1225 KWStackEnd = KWStack0 + n_KWStack0;
1226 curkw = kw;
1227 }
1228 else if (++KWStack >= KWStackEnd)
1229 KWStack_inc();
1230 kwi = KWStack;
1231 kwi->name = name;
1232 kwi->kw = kw;
1233 kwi->kw1 = kw1;
1234 nalt = nreq = 0;
1235 if (kw1)
1236 for(; kw1; kw1 = kw1->kwnext) {
1237 if (nalt < kw1->alt)
1238 nalt = kw1->alt;
1239 if (nreq < kw1->req)
1240 nreq = kw1->req;
1241 }
1242 kwi->nalt = nalt;
1243 kwi->nreq = nreq;
1244 alt = req = 0;
1245 altct = 0;
1246 if ((nn = nalt + nreq) > 0) {
1247 nn += 2;
1248 alt = (KeyWord**)Alloc("kw_setup(alt)",
1249 len = nn*sizeof(KeyWord*) + (nalt+1)*sizeof(int));
1250 memset(alt, 0, len);
1251 req = alt + nalt + 1;
1252 altct = (int*)(req + nreq + 1);
1253 /* altct[0], alt[0] and req[0] = "don't care" slots */
1254 }
1255 kwi->alt = alt;
1256 kwi->req = req;
1257 kwi->altct = altct;
1258 if (nreq)
1259 for(kw1 = kwi->kw1; kw1; kw1 = kw1->kwnext)
1260 req[kw1->req] = kw1;
1261 if (nalt)
1262 for(kw1 = kwi->kw1; kw1; kw1 = kw1->kwnext)
1263 if (kw1->kind & KWKind_primary)
1264 ++altct[kw1->alt];
1265 kwi->g = g;
1266 KWval.n = 0;
1267 KWval.i = 0;
1268 KWval.r = 0;
1269 KWval.s = 0;
1270 if ((k = kw->kind & KWKind_Mask)) {
1271 if (!KWvalmax.r)
1272 KWvalbuf = (Real *)Alloc("kw_setup(KWvalbuf)",
1273 (nKWvalbuf = 128)*sizeof(Real));
1274 switch(k) {
1275
1276 case KWKind_Int:
1277 KWval.i = (int*)KWvalbuf;
1278 KWvalmax.n = (nKWvalbuf*sizeof(Real))/sizeof(int);
1279 KWvalmax.i = KWval.i + KWvalmax.n;
1280 break;
1281
1282 case KWKind_Real:
1283 KWval.r = KWvalbuf;
1284 KWvalmax.r = KWvalbuf + (KWvalmax.n = nKWvalbuf);
1285 break;
1286
1287 case KWKind_Str:
1288 KWval.s = (const char**)KWvalbuf;
1289 KWvalmax.n = (nKWvalbuf*sizeof(Real))/sizeof(char*);
1290 KWvalmax.s = KWval.s + KWvalmax.n;
1291 }
1292 }
1293 if (deferred) {
1294 kw = kw_insert(kw, 0);
1295 deferred = 0;
1296 goto top;
1297 }
1298 if (!(kwi->needstart = kw->kind & KWKind_Mask)) {
1299 if (kw->name) {
1300 if (dumpfile)
1301 dumpname(0, kw);
1302 ++dumplev;
1303 }
1304 if (kw->f.start)
1305 (*kw->f.start)(kw->name, 0, &KWStack->g, kw->f.vs);
1306 }
1307 else if (!kw->f.start && NIDR_disallow_missing_start)
1308 botch("No start routine for %s", kw->name);
1309 return kw;
1310 }
1311
1312 static KeyWord *
kwfind(const char * name,KeyWord * keywds,int n,int * nmatch)1313 kwfind(const char *name, KeyWord *keywds, int n, int *nmatch)
1314 {
1315 KeyWord *kn, *kn1;
1316 int k, n0, n1, n2, nn;
1317 size_t L;
1318
1319 *nmatch = 0;
1320 if (n <= 0)
1321 return 0;
1322 L = strlen(name);
1323 n0 = 0;
1324 nn = n;
1325 #ifndef NO_NIDR_DYNLIB /*{*/
1326 if (n > 0 && keywds->kind & KWKind_Extended) {
1327 while(n > 0) {
1328 n1 = n >> 1;
1329 kn = (KeyWord*)((KeyWordx*)keywds + n1);
1330 k = strncmp(name, kn->name, L);
1331 if (k < 0)
1332 n = n1;
1333 else if (k > 0) {
1334 n -= ++n1;
1335 n0 += n1;
1336 keywds = (KeyWord*)((KeyWordx*)kn + 1);
1337 }
1338 else {
1339 /* Found -- check for range of matches. */
1340 /* Here we use linear search, as we expect */
1341 /* the range to be small. */
1342 n = n1 + n0;
1343 n2 = n + 1;
1344 if (kn->name[L]) {
1345 for(kn1 = kn; n2 < nn; ++n2) {
1346 kn1 = (KeyWord*)((KeyWordx*)kn1 + 1);
1347 if (strncmp(name, kn1->name, L))
1348 break;
1349 if (!kn1->name[L])
1350 goto found1;
1351 }
1352 kn1 = kn;
1353 while(n > 0) {
1354 kn1 = (KeyWord*)((KeyWordx*)kn1 - 1);
1355 if (strncmp(name, kn1->name, L))
1356 break;
1357 if (!kn1->name[L])
1358 goto found1;
1359 --n;
1360 kn = kn1;
1361 }
1362 }
1363 *nmatch = n2 - n;
1364 return kn;
1365 }
1366 }
1367 }
1368 else
1369 #endif /*}*/
1370 while(n > 0) {
1371 n1 = n >> 1;
1372 kn = keywds + n1;
1373 k = strncmp(name, kn->name, L);
1374 if (k < 0)
1375 n = n1;
1376 else if (k > 0) {
1377 n -= ++n1;
1378 n0 += n1;
1379 keywds = kn + 1;
1380 }
1381 else {
1382 /* Found -- check for range of matches. */
1383 /* Here we use linear search, as we expect */
1384 /* the range to be small. */
1385 n = n1 + n0;
1386 n2 = n + 1;
1387 if (kn->name[L]) {
1388 for(kn1 = kn; n2 < nn; ++n2) {
1389 ++kn1;
1390 if (strncmp(name, kn1->name, L))
1391 break;
1392 if (!kn1->name[L])
1393 goto found1;
1394 }
1395 kn1 = kn;
1396 while(n > 0) {
1397 --kn1;
1398 if (strncmp(name, kn1->name, L))
1399 break;
1400 if (!kn1->name[L]) {
1401 found1:
1402 *nmatch = 1;
1403 return kn1;
1404 }
1405 --n;
1406 kn = kn1;
1407 }
1408 }
1409 *nmatch = n2 - n;
1410 return kn;
1411 }
1412 }
1413 return 0; /* not found */
1414 }
1415
1416 static KeyWord *
toomany(const char * name,KeyWord * kw,int nmatch)1417 toomany(const char *name, KeyWord *kw, int nmatch)
1418 {
1419 int i;
1420 squawk("\"%s\" is ambiguous; possible matches..", name);
1421 if (nsquawk <= NIDR_SQUAWKMAX)
1422 for(i = 0; i < nmatch; i++, kw++)
1423 fprintf(stderr, "\t%s\n", kw->name);
1424 return 0;
1425 }
1426
1427 KeyWord *
nidr_keyword(const char * name)1428 nidr_keyword(const char *name)
1429 {
1430 int nmatch;
1431 KeyWord *kw, *kw1;
1432
1433 kw = kwfind(name, Keyword_Top->kw, Keyword_Top->nkw, &nmatch);
1434 if (nmatch > 1)
1435 return toomany(name, kw, nmatch);
1436 else if (kw) {
1437 if (!(kw1 = curkw)) {
1438 kw = kw_setup(kw, KW_g, name);
1439 if (kw->kind & KWKind_Dynmult)
1440 return kw;
1441 }
1442 if (!strict) {
1443 if (kw1)
1444 nidr_keyword_finish();
1445 kw_setup1(kw);
1446 }
1447 }
1448 return kw;
1449 }
1450
1451 static void
valcheck(KeyWord * kw)1452 valcheck(KeyWord *kw)
1453 {
1454 Real *r;
1455 int *z;
1456 int i, k, n;
1457
1458 n = KWval.n;
1459 switch(k = kw->kind & KWKind_Mask) {
1460 case KWKind_Int:
1461 z = KWval.i;
1462 if (kw->kind & KWKind_strictLb) {
1463 for(i = 0; i < n; ++i)
1464 if (z[i] <= kw->Lb) {
1465 squawk("%s must be > %.0f", kw->name, kw->Lb);
1466 break;
1467 }
1468 }
1469 else if (kw->kind & KWKind_caneqLb) {
1470 for(i = 0; i < n; ++i)
1471 if (z[i] < kw->Lb) {
1472 squawk("%s must be >= %.0f", kw->name, kw->Lb);
1473 break;
1474 }
1475 }
1476 if (kw->kind & KWKind_strictUb) {
1477 for(i = 0; i < n; ++i)
1478 if (z[i] >= kw->Ub) {
1479 squawk("%s must be < %.0f", kw->name, kw->Ub);
1480 break;
1481 }
1482 }
1483 else if (kw->kind & KWKind_caneqUb) {
1484 for(i = 0; i < n; ++i)
1485 if (z[i] > kw->Ub) {
1486 squawk("%s must be >= %.0f", kw->name, kw->Ub);
1487 break;
1488 }
1489 }
1490 break;
1491 case KWKind_Real:
1492 r = KWval.r;
1493 if (kw->kind & KWKind_strictLb) {
1494 for(i = 0; i < n; ++i)
1495 if (r[i] <= kw->Lb) {
1496 squawk("%s must be > %g", kw->name, kw->Lb);
1497 break;
1498 }
1499 }
1500 else if (kw->kind & KWKind_caneqLb) {
1501 for(i = 0; i < n; ++i)
1502 if (r[i] < kw->Lb) {
1503 squawk("%s must be >= %g", kw->name, kw->Lb);
1504 break;
1505 }
1506 }
1507 if (kw->kind & KWKind_strictUb) {
1508 for(i = 0; i < n; ++i)
1509 if (r[i] >= kw->Ub) {
1510 squawk("%s must be < %g", kw->name, kw->Ub);
1511 break;
1512 }
1513 }
1514 else if (kw->kind & KWKind_caneqUb) {
1515 for(i = 0; i < n; ++i)
1516 if (r[i] > kw->Ub) {
1517 squawk("%s must be >= %g", kw->name, kw->Ub);
1518 break;
1519 }
1520 }
1521 break;
1522 default:
1523 botch("Bug: unexpected (kw->kind & KWKind_Mask) = %d in valcheck",n);
1524 }
1525 }
1526
1527 static void
read_lib(const char * libname,KeyWord * kw)1528 read_lib(const char *libname, KeyWord *kw)
1529 {
1530 #ifdef NO_NIDR_DYNLIB /*{{*/
1531 botch("LIBNAME is disallowed: cannot read \"%s\"", libname);
1532 #else /*}{*/
1533 KeyWord *kw1;
1534 KW_ADD kwa;
1535 NIDR_KWlib *Lib;
1536 void *h;
1537
1538 h = nidr_dlopen(libname);
1539 if (!h) {
1540 #ifndef NO_DLERROR
1541 const char *s;
1542 if ((s = dlerror()))
1543 botch("Cannot open library \"%s\":\n\t%s", libname, s);
1544 else
1545 #endif
1546 botch("Cannot open library \"%s\"", libname);
1547 }
1548 if (!find_dlsym(kwa, h, "keyword_add"))
1549 botch("dlsym(\"keyword_add\") failed for %s", libname);
1550 kw1 = (*kwa)();
1551 Lib = nidr_lib_record(h, libname);
1552 kw->nkw = kw1->nkw;
1553 kw->kw = kw1->kw;
1554 kw->f = kw1->f;
1555 kw->kind |= KWKind_Loaded;
1556 #endif /*}}*/
1557 }
1558
1559 static void
nidr_id_strict_finish(KWinfo * kwi,KeyWord * kw,const char * name)1560 nidr_id_strict_finish(KWinfo *kwi, KeyWord *kw, const char *name)
1561 {
1562 KeyWord *kw1;
1563 int n;
1564
1565 if (kw->alt) {
1566 if ((kw1 = kwi->alt[n = kw->alt])) {
1567 if (strcmp(kw1->name, name))
1568 squawk("%s and %s are mutually exclusive",
1569 kw1->name, name);
1570 else
1571 squawk("%s was already specified", name);
1572 }
1573 else
1574 kwi->alt[n] = kw;
1575 }
1576 if (kw->req) {
1577 if (kwi->req[n = kw->req])
1578 kwi->req[n] = 0;
1579 else if (!kw->alt)
1580 squawk("%s specified more than once", name);
1581 }
1582 }
1583
1584 static KWinfo *
dispatch_val(KWinfo * kwi)1585 dispatch_val(KWinfo *kwi)
1586 {
1587 KeyWord *kw = kwi->kw;
1588
1589 kwi->needstart = 0;
1590 if (KWval.n) {
1591 if (KWval.rstate)
1592 finish_rexpand();
1593 if (dumpfile) {
1594 dumpname(1, kw);
1595 dumpvals(kw);
1596 }
1597 if (kw->kind & (KWKind_Lb|KWKind_Ub))
1598 valcheck(kw);
1599 if (kw->f.start)
1600 (*kw->f.start)(kw->name, &KWval, &kwi->g, kw->f.vs);
1601 else if ((kw->kind & (KWKind_Libname | KWKind_Loaded)) == KWKind_Libname) {
1602 read_lib(KWval.s[0], kw);
1603 kw = kw_setup(kw, kwi->g, kw->name);
1604 if (kw->f.start)
1605 (*kw->f.start)(kw->name, &KWval, &kwi->g, kw->f.vs);
1606 if (kw == kwi->kw) {
1607 *kwi = *KWStack;
1608 --KWStack;
1609 }
1610 else
1611 kwi = KWStack;
1612 }
1613 KWval.n = 0;
1614 }
1615 else if ((kw->kind & (KWKind_Libname|KWKind_Loaded))
1616 != (KWKind_Libname|KWKind_Loaded))
1617 squawk("expected %sone %s value for %s",
1618 kw->kind & KWKind_List ? "at least " : "",
1619 valkind[(kw->kind & KWKind_Mask)-1], kw->name);
1620 ++dumplev;
1621 return kwi;
1622 }
1623
1624 static void
oneof(KeyWord * kw,int alt,int n)1625 oneof(KeyWord *kw, int alt, int n)
1626 {
1627 KeyWord *kw1;
1628
1629 squawk("One of the following %d entities\nmust be specified for %s..",
1630 n, kw->name);
1631 for(kw1 = kw->kw; !kw1->name; kw1 = kw1->kwnext);
1632 for(; kw1; kw1 = kw1->kwnext)
1633 if (kw1->alt == alt && kw1->kind & KWKind_primary)
1634 fprintf(stderr, "\t%s\n", kw1->name);
1635 }
1636
1637 static void
missing_chk(KeyWord * kw1,KWinfo * kwi)1638 missing_chk(KeyWord *kw1, KWinfo *kwi)
1639 {
1640 KeyWord *kw0, *kw2, **req;
1641 Uint a;
1642 char seen0[1024], *seen;
1643 const char *kwname;
1644 int n;
1645 size_t nreq;
1646
1647 /* only issue one error message per missing keyword */
1648
1649 nreq = 0;
1650 for(kw0 = kw1; kw1; kw1 = kw1->kwnext)
1651 if (nreq < kw1->req)
1652 nreq = kw1->req;
1653 seen = seen0;
1654 if (++nreq > sizeof(seen0))
1655 seen = (char*)Alloc("missing_chk", nreq);
1656 memset(seen, 0, nreq);
1657 req = kwi->req;
1658 for(kw1 = kw0; kw1; kw1 = kw1->kwnext) {
1659 if (kw1->req && req[kw1->req] && !seen[kw1->req] && kw1->kind & KWKind_primary) {
1660 seen[kw1->req] = 1;
1661 a = -1;
1662 if (!kw1->alt || (n = kwi->altct[a = kw1->alt]) <= 1) {
1663 if (!(kwname = kwi->name))
1664 kwname = "<NIDRBUG>";
1665 for(kw2 = kw1;;) {
1666 if (kw2->alt == a && kw2->kind & KWKind_primary)
1667 break;
1668 if (!(kw2 = kw2->kwnext))
1669 botch("Bug in missing_chk");
1670 }
1671 squawk("%s must be specified for %s",
1672 kw2->name, kwname);
1673 }
1674 else
1675 oneof(kwi->kw, kw1->alt, n);
1676 }
1677 }
1678 if (seen != seen0)
1679 free(seen);
1680 }
1681
1682 static void
finalize(KWinfo * kwi)1683 finalize(KWinfo *kwi)
1684 {
1685 KeyWord *kw, *kw1, **req;
1686
1687 kw = kwi->kw;
1688 kw->kind &= ~KWKind_Stacked;
1689 if (kwi->needstart)
1690 kwi = dispatch_val(kwi);
1691 if (kw->name)
1692 --dumplev;
1693 if (kw->f.final)
1694 (*kw->f.final)(kw->name, 0, &kwi->g, kw->f.vf);
1695 if (kwi->alt) {
1696 if (kwi->nreq) {
1697 req = kwi->req;
1698 for(kw1 = kwi->kw1; kw1; kw1 = kw1->kwnext)
1699 if (kw1->req && req[kw1->req]) {
1700 missing_chk(kw1, kwi);
1701 break;
1702 }
1703 }
1704 free(kwi->alt);
1705 }
1706 }
1707
1708 static KeyWord *
nidr_identifier_strict(const char * name)1709 nidr_identifier_strict(const char *name)
1710 {
1711 KWinfo *kwi, *kwi1;
1712 KeyWord *kw, *kw1;
1713 int nmatch;
1714 size_t height;
1715
1716 if (!curkw)
1717 botch("curkw = 0 in nidr_identifier");
1718 kwi = KWStack;
1719 if (kwi->needstart)
1720 kwi = dispatch_val(kwi);
1721 for(kwi1 = kwi;;) {
1722 kw1 = kwi->kw;
1723 if ((kw = kwfind(name, kwi->kw1, kw1->nkw, &nmatch)))
1724 break;
1725 if (kwi == KWStackBot)
1726 return 0;
1727 if ((--kwi)->kw->name && !(kwi->kw->kind & KWKind_Loaded))
1728 kwi1 = kwi;
1729 }
1730 if (nmatch > 1)
1731 return toomany(name, kw, nmatch);
1732 while(KWStack > kwi1)
1733 finalize(KWStack--);
1734 if ((kw->kind & (KWKind_Libname | KWKind_Loaded)) == KWKind_Libname) {
1735 nidr_id_strict_finish(kwi, kw, name);
1736 if (!KWvalmax.r)
1737 KWvalbuf = (Real *)Alloc("nidr_identifier_strict",
1738 (nKWvalbuf = 128)*sizeof(Real));
1739 if (++KWStack >= KWStackEnd)
1740 KWStack_inc();
1741 kwi = KWStack;
1742 kwi->kw = kw;
1743 kwi->needstart = 1;
1744 KWval.s = (const char**)KWvalbuf;
1745 KWvalmax.n = (nKWvalbuf*sizeof(Real))/sizeof(char*);
1746 KWvalmax.s = KWval.s + KWvalmax.n;
1747 }
1748 else {
1749 height = kwi - KWStackBot;
1750 kw = kw_setup(kw, kwi->g, name);
1751 kwi = KWStackBot + height; /* in case kw_setup reallocated KWStack */
1752 nidr_id_strict_finish(kwi, kw, name);
1753 }
1754 return kw;
1755 }
1756
1757 static void
nidr_keyword_finish(void)1758 nidr_keyword_finish(void)
1759 {
1760 if (!strict)
1761 kw_finish2();
1762 for(;;--KWStack) {
1763 finalize(KWStack);
1764 if (KWStack == KWStackBot)
1765 break;
1766 }
1767 if (!strict)
1768 kw_finish3();
1769 curid = curkw = 0;
1770 }
1771
1772 const char*
nidr_keyword_name(void)1773 nidr_keyword_name(void)
1774 { return curkw ? curkw->name : "<none>"; }
1775
1776 /* Some of the above assumes strict nesting according to dakota.input.nspec. */
1777 /* Code here is meant to relax this assumption, allowing more flexibility in */
1778 /* the order of identifiers within a DAKOTA "keyword". */
1779
1780 typedef struct KWpair KWpair;
1781 typedef struct KWmblk KWmblk;
1782
1783 struct
1784 KWmblk {
1785 KWmblk *next;
1786 size_t len;
1787 /* memory of length len immediately follows */
1788 };
1789
1790 struct
1791 KWpair {
1792 KeyWord *kw;
1793 KWseen *kws;
1794 };
1795
1796 enum{ KWmblk_gulp = 32000 };
1797
1798 static AVL_Tree *AVLT, *AVLKWP;
1799 static KWseen **KW_p, **KW_pe, KWmissing, *KWs0;
1800 static KWmblk *KWmblk0, *KWmblk1;
1801 static const char *KWmem0, *KWmem1;
1802
1803 typedef struct
1804 AVLCmpInfo {
1805 KWseen **found[2];
1806 int nfound;
1807 int inexact;
1808 } AVLCmpInfo;
1809
1810 static int
avlcmp(void * v,KWseen ** a,KWseen ** b)1811 avlcmp(void *v, KWseen **a, KWseen **b)
1812 {
1813 AVLCmpInfo *AI = (AVLCmpInfo*)v;
1814 KWseen *ksa, *ksb;
1815 const char *s, *t;
1816
1817 s = (ksa = *a)->name;
1818 t = (ksb = *b)->name;
1819 for(; *s == *t; ++s, ++t)
1820 if (!*s)
1821 return 0;
1822 if ((!*s && !ksa->kw && ksb->kw)
1823 ||(!*t && !ksb->kw && ksa->kw)) {
1824 /* inexact match */
1825 if (AI->nfound == 0
1826 || (AI->nfound == 1 && AI->found[0] != b))
1827 AI->found[AI->nfound++] = b;
1828 return AI->inexact;
1829 }
1830 return *s - *t;
1831 }
1832
1833 static int
kwpcmp(void * v,KWpair * a,KWpair * b)1834 kwpcmp(void *v, KWpair *a, KWpair *b)
1835 {
1836 if (a->kw == b->kw)
1837 return 0;
1838 return a->kw > b->kw ? 1 : -1;
1839 }
1840
1841 static void
KWmeminit(void)1842 KWmeminit(void)
1843 {
1844 KWmblk0 = KWmblk1 = (KWmblk*)Alloc("KWmeminit",
1845 sizeof(KWmblk) + KWmblk_gulp);
1846 KWmem0 = (char*)(KWmblk0 + 1);
1847 KWmem1 = KWmem0 + KWmblk_gulp;
1848 KWmblk0->len = KWmblk_gulp;
1849 KWmblk0->next = 0;
1850 KWmissing.mnext = KWmissing.mprev = &KWmissing;
1851 KW_cur = 0;
1852 memset(&KWval, 0, sizeof(KWval));
1853 KWvalbuf = (Real *)Alloc("kw_setup(KWValbuf)", (nKWvalbuf = 128)*sizeof(Real));
1854 ToClear = ToClear0 = (KeyWord**)Alloc("kw_setup(ToClear)", 256*sizeof(KeyWord*));
1855 ToClearEnd = ToClear0 + 256;
1856 }
1857
1858 static void
KWmembump(size_t L)1859 KWmembump(size_t L)
1860 {
1861 KWmblk *mb, *mb1;
1862 size_t L1;
1863
1864 for(L1 = KWmblk_gulp; L1 < L; L1 <<= 1);
1865 if ((mb = mb1 = KWmblk1->next) && L1 <= mb->len)
1866 L1 = mb->len;
1867 else {
1868 KWmblk1->next = mb = (KWmblk*)Alloc("KWmembump", L1 + sizeof(KWmblk));
1869 mb->len = L1;
1870 mb->next = mb1;
1871 }
1872 KWmblk1 = mb;
1873 KWmem0 = (char*)(mb+1);
1874 KWmem1 = KWmem0 + L1;
1875 }
1876
1877 static void *
KWgetmem(size_t L)1878 KWgetmem(size_t L) /* for aligned memory */
1879 {
1880 void *rv;
1881
1882 L = (L + sizeof(Real) - 1) & ~(sizeof(Real) - 1);
1883 if (KWmem1 - KWmem0 < L)
1884 KWmembump(L);
1885 rv = (void*)KWmem0;
1886 KWmem0 += L;
1887 return rv;
1888 }
1889
1890 static KWseen **
KWhash(const char * s,KeyWord * kw)1891 KWhash(const char *s, KeyWord *kw)
1892 {
1893 AVLCmpInfo AI;
1894 KWseen KW0, *KW0p, *kws, **kwsp;
1895 char **ps;
1896 const char *sa, *sb;
1897
1898 AI.nfound = 0;
1899 AI.inexact = -1;
1900 AVL_setv(AVLT, &AI);
1901 KW0.name = s;
1902 KW0.kw = kw;
1903 KW0p = &KW0;
1904 curkws = 0;
1905 if ((kwsp = (KWseen**)AVL_find((const Element*)&KW0p, AVLT)))
1906 return kwsp;
1907 if (AI.nfound) {
1908 if (AI.nfound == 1) {
1909 AI.inexact = 1;
1910 AVL_find((const Element*)&KW0p, AVLT);
1911 if (AI.nfound == 1) {
1912 if (kw && (kw->kind & (KWKind_Libname | KWKind_Loaded))
1913 == KWKind_Libname
1914 && (ps = (*AI.found[0])->svals))
1915 read_lib(ps[0], kw);
1916 return AI.found[0];
1917 }
1918 }
1919 sa = (*AI.found[0])->name;
1920 sb = (*AI.found[1])->name;
1921 if (kw)
1922 squawk("Both '%s' and '%s' match '%s'",
1923 sa, sb, s);
1924 else
1925 squawk("'%s' is ambiguous:\n\tit matches both '%s' and '%s'",
1926 s, sa, sb);
1927 return AI.found[0];
1928 }
1929 kws = (KWseen*)KWgetmem(sizeof(KWseen));
1930 memset(kws, 0, sizeof(KWseen));
1931 if ((kws->kw = kw))
1932 s = kw->name;
1933 else {
1934 curkws = kws;
1935 kws->mnext = &KWmissing;
1936 KWmissing.mprev = (kws->mprev = KWmissing.mprev)->mnext = kws;
1937 s = nidr_KWscopy(s);
1938 }
1939 kws->name = s;
1940 if (KW_p >= KW_pe) {
1941 KW_p = (KWseen**)KWgetmem(32*sizeof(KWseen*));
1942 KW_pe = KW_p + 32;
1943 }
1944 *(kwsp = KW_p++) = kws;
1945 AVL_insert((const Element*)kwsp, AVLT);
1946 return kwsp;
1947 }
1948
1949 static void
mixed_squawk(void)1950 mixed_squawk(void)
1951 {
1952 squawk("values for %s cannot be both strings and numbers",
1953 KW_cur->name);
1954 }
1955
1956 static void
nidr_bufr_relaxed(Real r,int state)1957 nidr_bufr_relaxed(Real r, int state)
1958 {
1959 int n;
1960
1961 if (KWval.rstate && !state)
1962 finish_rexpand();
1963 if (!(n = KWval.n)) {
1964 KWval.r = KWvalbuf;
1965 KWvalmax.r = KWvalbuf + (KWvalmax.n = nKWvalbuf);
1966 }
1967 else if (KWval.s) {
1968 mixed_squawk();
1969 return;
1970 }
1971 if (n >= KWvalmax.n)
1972 KWvalbuf_inc();
1973 KWval.r[KWval.n++] = r;
1974 if (state | KWval.rstate)
1975 rexpand(state);
1976 }
1977
1978 static void
nidr_bufs_relaxed(const char * s)1979 nidr_bufs_relaxed(const char *s)
1980 {
1981 int n;
1982
1983 if (!(n = KWval.n)) {
1984 KWval.s = (const char**)KWvalbuf;
1985 KWvalmax.n = (nKWvalbuf*sizeof(Real))/sizeof(char*);
1986 KWvalmax.s = KWval.s + KWvalmax.n;
1987 }
1988 else if (KWval.r) {
1989 mixed_squawk();
1990 return;
1991 }
1992 if (n >= KWvalmax.n)
1993 KWvalbuf_inc();
1994 KWval.s[KWval.n++] = s;
1995 }
1996
1997 static void kw_setup2(KWseen*);
1998
1999 static void
kw_finish1(KWseen * kws)2000 kw_finish1(KWseen *kws)
2001 {
2002 KeyWord *kw;
2003 int n;
2004 size_t L;
2005
2006 if (KWval.rstate)
2007 finish_rexpand();
2008 kws->nvals = n = KWval.n;
2009 KWval.n = 0;
2010 if (KWval.r) {
2011 L = n*sizeof(Real);
2012 memcpy(kws->rvals = (Real*)KWgetmem(L), KWval.r, L);
2013 KWval.r = 0;
2014 }
2015 else if (KWval.s) {
2016 L = n*sizeof(char*);
2017 memcpy(kws->svals = (char**)KWgetmem(L), KWval.s, L);
2018 if ((kw = kws->kw) && kw->kind & KWKind_Libname) {
2019 read_lib(KWval.s[0], kw);
2020 if (kw->kw)
2021 kw_setup2(kws);
2022 }
2023 KWval.s = 0;
2024 }
2025 }
2026
2027 static void*
Alloc1(size_t len)2028 Alloc1(size_t len)
2029 {
2030 void *rv = malloc(len);
2031 if (!rv) {
2032 fprintf(stderr, "malloc(%lu) failure in Alloc1\n", (unsigned long)len);
2033 exit(1);
2034 }
2035 return rv;
2036 }
2037
2038 static void
AVL_Clear(void)2039 AVL_Clear(void)
2040 {
2041 while(ToClear > ToClear0)
2042 (*--ToClear)->kind &= ~KWKind_Hashed;
2043 AVL_Tree_free(&AVLT);
2044 if (AVLKWP)
2045 AVL_Tree_free(&AVLKWP);
2046 }
2047
2048 static void
kw_setup1(KeyWord * kw)2049 kw_setup1(KeyWord *kw)
2050 {
2051 KWseen *kws, *kws1;
2052 KeyWord *kw1;
2053
2054 if ((kw1 = kw->kw))
2055 kwnext_setup(kw1, kw->nkw);
2056 if (!KWmblk0)
2057 KWmeminit();
2058 if (AVLT)
2059 AVL_Clear();
2060 AVLT = AVL_Tree_alloc(0, (AVL_Elcomp)avlcmp, Alloc1);
2061 KW_cur = KWs0 = kws = (KWseen*)KWgetmem(sizeof(KWseen));
2062 memset(kws, 0, sizeof(KWseen));
2063 kws->name = kw->name;
2064 kws->kw = kw;
2065 kws->lcn = &kws->mprev;
2066 if (kw1) {
2067 while(!kw1->name)
2068 kw1 = kw1->kwnext;
2069 for(; kw1; kw1 = kw1->kwnext) {
2070 kws1 = *KWhash(kw1->name, kw1);
2071 kws1->parent = kws;
2072 }
2073 }
2074 }
2075
2076 static KWseen**
kw_setup3(KWseen ** kwtodo1,KWseen * kws,KeyWord * kw)2077 kw_setup3(KWseen **kwtodo1, KWseen *kws, KeyWord *kw)
2078 {
2079 KWseen *kws1, **kwsp;
2080
2081 for(; kw; kw = kw->kwnext) {
2082 kwsp = KWhash(kw->name, kw);
2083 kws1 = *kwsp;
2084 if (kws1->comment) {
2085 kw->comment = kws1->comment;
2086 kws1->comment = 0;
2087 }
2088 if (kws1->parent) {
2089 kws1 = (KWseen*)KWgetmem(sizeof(KWseen));
2090 memset(kws1, 0, sizeof(KWseen));
2091 kws1->kw = kw;
2092 kws1->name = kw->name;
2093 *kwsp = kws1;
2094 }
2095 kws1->parent = kws;
2096 if (!kws1->kw) {
2097 kws1->mprev->mnext = kws1->mnext;
2098 kws1->mnext->mprev = kws1->mprev;
2099 *kwtodo1 = kws1;
2100 kwtodo1 = kws1->lcn = &kws1->mprev;
2101 *kws->lcn = kws1;
2102 kws->lcn = &kws1->mnext;
2103 }
2104 kws1->kw = kw;
2105 }
2106 return kwtodo1;
2107 }
2108
2109 static void
bumpToClear(void)2110 bumpToClear(void)
2111 {
2112 KeyWord **ntc;
2113 size_t L, L1;
2114
2115 L = ToClearEnd - ToClear0;
2116 L1 = L << 1;
2117 ntc = (KeyWord**)Alloc("bumpToClear", L1*sizeof(KeyWord*));
2118 memcpy(ntc, ToClear0, L*sizeof(KeyWord*));
2119 free(ToClear0);
2120 ToClear0 = ntc;
2121 ToClear = ntc + L;
2122 ToClearEnd = ntc + L1;
2123 }
2124
2125 static void
kw_setup2(KWseen * kws)2126 kw_setup2(KWseen *kws)
2127 {
2128 KWpair kwp, *pkwp;
2129 KWseen *kws1, *kws2, *kws3, *kwtodo, **kwtodo1, **pkws;
2130 KeyWord *kw, *kw1;
2131
2132 kwtodo1 = &kwtodo;
2133 for(;;) {
2134 kw = kws->kw;
2135 if ((kw1 = kw->kw)) {
2136 kwnext_setup(kw1, kw->nkw);
2137 kws2 = kws;
2138 while(!kw1->name) {
2139 if (!AVLKWP)
2140 AVLKWP = AVL_Tree_alloc(0, (AVL_Elcomp)kwpcmp, Alloc1);
2141 if (kw1->kind & KWKind_Hashed) {
2142 kwp.kw = kw1->kw;
2143 kwp.kws = 0;
2144 pkwp = (KWpair*)AVL_find((const Element*)&kwp, AVLKWP);
2145 kws2 = pkwp->kws;
2146 }
2147 else {
2148 if (ToClear >= ToClearEnd)
2149 bumpToClear();
2150 *ToClear++ = kw1;
2151 kw1->kind |= KWKind_Hashed;
2152 pkwp = (KWpair*)KWgetmem(sizeof(KWpair) + sizeof(KWseen));
2153 kws1 = (KWseen*)(pkwp + 1);
2154 pkwp->kw = kw1->kw;
2155 pkwp->kws = kws1;
2156 memset(kws1, 0, sizeof(KWseen));
2157 kws1->kw = kw1;
2158 kws1->name = kws->name;
2159 kws1->lcn = &kws1->mprev;
2160 kws1->parent = kws2;
2161 *kws2->lcn = 0;
2162 for(pkws = &kws2->mprev;
2163 (kws3 = *pkws) && !kws3->name;
2164 pkws = &kws3->mnext);
2165 kws1->mnext = *pkws;
2166 if (pkws == kws2->lcn)
2167 kws2->lcn = &kws1->mnext;
2168 kws2 = *pkws = kws1;
2169 kwnext_setup(kw1->kw, kw1->nkw);
2170 kwtodo1 = kw_setup3(kwtodo1, kws1, kw1->kw);
2171 AVL_insert((const Element*)pkwp, AVLKWP);
2172 }
2173 kw1 = kw1->kwnext;
2174 }
2175 if (kw->nkw)
2176 kwtodo1 = kw_setup3(kwtodo1, kws2, kw1);
2177 }
2178 *kwtodo1 = 0;
2179 if (!kwtodo)
2180 break;
2181 kws = kwtodo;
2182 kw = kws->kw;
2183 if (!(kwtodo = kwtodo->mprev))
2184 kwtodo1 = &kwtodo;
2185 }
2186 }
2187
2188 static KeyWord *
nidr_identifier_relaxed(const char * name)2189 nidr_identifier_relaxed(const char *name)
2190 {
2191 KWseen *kws, *kws1;
2192 KeyWord *kw;
2193 int tryagain;
2194
2195 kw_finish1(KW_cur);
2196 top:
2197 KW_cur = kws = *KWhash(name, 0);
2198 if ((kw = kws->kw)) {
2199 curid = kw;
2200 if (kws->lcn)
2201 squawk("'%s' already seen", kw->name);
2202 else {
2203 if (kws->comment) {
2204 kw->comment = kws->comment;
2205 kws->comment = 0;
2206 }
2207 kws->lcn = &kws->mprev;
2208 kws1 = kws->parent;
2209 *kws1->lcn = kws;
2210 kws1->lcn = &kws->mnext;
2211 if (kw->kw)
2212 kw_setup2(kws);
2213 if (kw->kind & KWKind_Dynlib) {
2214 kw = kw_insert(kw, &tryagain);
2215 if (kw->kw) {
2216 kws->kw = kw;
2217 kw_setup2(kws);
2218 }
2219 if (tryagain)
2220 goto top;
2221 }
2222 }
2223 }
2224 return (KeyWord*)kws; /* just needs to be nonzero; won't be dereferenced */
2225 }
2226
2227 static void
num_expected(KeyWord * kw,int n)2228 num_expected(KeyWord *kw, int n)
2229 {
2230 squawk("expected numerical value%s for %s, not quoted strings",
2231 "s" + (n == 1), kw->name);
2232 }
2233
2234 static void
kw_process(KWseen * kws)2235 kw_process(KWseen *kws)
2236 {
2237 KWseen *kws1;
2238 KeyWord *kw;
2239 Real *r;
2240 Uint k;
2241 int i, n;
2242
2243 kw = kws->kw;
2244 if (kw->name) {
2245 if (kws != KWs0 && !nidr_identifier_strict(kw->name))
2246 botch("nidr_identifier_strict did not find \"%s\"", kw->name);
2247 if ((n = KWval.n = kws->nvals)) {
2248 KWval.i = 0;
2249 KWval.r = 0;
2250 KWval.s = 0;
2251 KWval.rstate = 0;
2252 switch(k = kw->kind & KWKind_Mask) {
2253 case 0:
2254 squawk("No values may be specified for %s", kw->name);
2255 break;
2256
2257 case KWKind_Int:
2258 if (!(r = kws->rvals)) {
2259 num_expected(kw,n);
2260 break;
2261 }
2262 KWval.i = (int*)KWvalbuf;
2263 for(i = 0; i < n; i++)
2264 KWval.i[i] = (int)r[i];
2265 break;
2266
2267 case KWKind_Real:
2268 if (!(r = kws->rvals)) {
2269 num_expected(kw,n);
2270 break;
2271 }
2272 KWval.r = r;
2273 break;
2274
2275 case KWKind_Str:
2276 if (!(KWval.s = (const char **)kws->svals))
2277 squawk("expected string value%s for %s",
2278 "s" + (n == 1), kw->name);
2279 }
2280 }
2281 }
2282 *kws->lcn = 0;
2283 for(kws1 = kws->mprev; kws1; kws1 = kws1->mnext)
2284 kw_process(kws1);
2285 }
2286
2287 static void
kw_finish2(void)2288 kw_finish2(void)
2289 {
2290 KWseen *kws, *kwe;
2291
2292 kw_finish1(KW_cur);
2293 kwe = &KWmissing;
2294 for(kws = KWmissing.mnext; kws != kwe; kws = kws->mnext) {
2295 squawk("unrecognized identifier '%s'", kws->name);
2296 }
2297 KWmissing.mnext = KWmissing.mprev = &KWmissing;
2298 kw_process(KWs0);
2299 KWs0 = 0;
2300 AVL_Clear();
2301 }
2302
2303 static void
kw_finish3(void)2304 kw_finish3(void)
2305 {
2306 KWmblk1 = KWmblk0;
2307 KWmem0 = (char*)(KWmblk0 + 1);
2308 KWmem1 = KWmem0 + KWmblk_gulp;
2309 KW_p = KW_pe = 0;
2310 }
2311
2312 void (*nidr_bufr)(Real,int) = nidr_bufr_relaxed;
2313 void (*nidr_bufs)(const char*) = nidr_bufs_relaxed;
2314 KeyWord *(*nidr_identifier)(const char*) = nidr_identifier_relaxed;
2315
2316 void
nidr_set_strict(int n)2317 nidr_set_strict(int n)
2318 {
2319 if ((strict = n)) {
2320 nidr_bufr = nidr_bufr_strict;
2321 nidr_bufs = nidr_bufs_strict;
2322 nidr_identifier = nidr_identifier_strict;
2323 }
2324 else {
2325 nidr_bufr = nidr_bufr_relaxed;
2326 nidr_bufs = nidr_bufs_relaxed;
2327 nidr_identifier = nidr_identifier_relaxed;
2328 }
2329 }
2330
2331 int
nidr_cleanup(void)2332 nidr_cleanup(void)
2333 {
2334 KWmblk *mb, *mb1;
2335 Sbuf *sb, *sb1;
2336
2337 if (curkw)
2338 nidr_keyword_finish();
2339 if (dumpfile) {
2340 if (OutsideComment)
2341 dumpcomment(&OutsideComment);
2342 if (dumpfile != stdout) {
2343 fclose(dumpfile);
2344 dumpfile = 0;
2345 }
2346 if (nidr_comment)
2347 comment_reset();
2348 }
2349 if (ToClear0) {
2350 free(ToClear0);
2351 ToClear = ToClear0 = 0;
2352 }
2353 if ((mb1 = KWmblk0)) {
2354 KWmblk0 = 0;
2355 do {
2356 mb = mb1;
2357 mb1 = mb->next;
2358 free(mb);
2359 } while(mb1);
2360 }
2361 if (KWvalbuf) {
2362 free(KWvalbuf);
2363 KWvalbuf = 0;
2364 }
2365 if ((sb1 = KWsbuf0.next)) {
2366 KWsbuf0.next = 0;
2367 do {
2368 sb = sb1;
2369 sb1 = sb->next;
2370 free(sb);
2371 } while(sb1);
2372 }
2373 if (AVLT)
2374 AVL_Clear();
2375 return nidr_parse_error();
2376 }
2377
2378 void
nidr_setup(const char * parser,FILE * df)2379 nidr_setup(const char *parser, FILE *df)
2380 {
2381 const char *s;
2382 int comkeep, oneline;
2383
2384 if (!(s = parser))
2385 return;
2386 if (!strncmp(s,"nidr",4))
2387 s += 4;
2388 if (!strncmp(parser,"strict",6)) {
2389 nidr_set_strict(1);
2390 s += 6;
2391 }
2392 comkeep = oneline = 0;
2393 if (*s == '-') for(;;) {
2394 switch(*++s) {
2395 case '1':
2396 ++oneline;
2397 continue;
2398 case 'p':
2399 ++primary;
2400 continue;
2401 case 'c':
2402 ++comkeep;
2403 continue;
2404 }
2405 break;
2406 }
2407 if (df)
2408 dumpfile = df;
2409 else if (s[0] == ':' && s[1]) {
2410 if (s[1] == '-' && !s[2])
2411 dumpfile = df = stdout;
2412 else {
2413 dumpfile = df = fopen(++s,"w");
2414 if (!dumpfile) {
2415 fprintf(stderr, "Cannot open \"%s\"\n", s);
2416 exit(1);
2417 }
2418 }
2419 }
2420 if (df) {
2421 if (oneline)
2422 dumpvals = dumpvals1;
2423 if (comkeep)
2424 comment_setup();
2425 }
2426 }
2427