1 /*********************************************************************
2  *   Copyright 2009, UCAR/Unidata
3  *   See netcdf/COPYRIGHT file for copying and redistribution conditions.
4  *********************************************************************/
5 /* $Id: semantics.c,v 1.4 2010/05/24 19:59:58 dmh Exp $ */
6 /* $Header: /upc/share/CVS/netcdf-3/ncgen/semantics.c,v 1.4 2010/05/24 19:59:58 dmh Exp $ */
7 
8 #include        "includes.h"
9 #include        "dump.h"
10 #include        "ncoffsets.h"
11 #include        "netcdf_aux.h"
12 
13 /* Forward*/
14 static void filltypecodes(void);
15 static void processenums(void);
16 static void processeconstrefs(void);
17 static void processtypes(void);
18 static void processtypesizes(void);
19 static void processvars(void);
20 static void processattributes(void);
21 static void processunlimiteddims(void);
22 static void processeconstrefs(void);
23 static void processeconstrefsR(Symbol*,Datalist*);
24 static void processroot(void);
25 
26 static void computefqns(void);
27 static void fixeconstref(Symbol*,NCConstant* con);
28 static void inferattributetype(Symbol* asym);
29 static void validateNIL(Symbol* sym);
30 static void checkconsistency(void);
31 static int tagvlentypes(Symbol* tsym);
32 static void computefqns(void);
33 static Symbol* uniquetreelocate(Symbol* refsym, Symbol* root);
34 static char* createfilename(void);
35 
36 #if 0
37 static Symbol* locateenumtype(Symbol* econst, Symbol* group, NCConstant*);
38 static List* findecmatches(char* ident);
39 static List* ecsearchgrp(Symbol* grp, List* candidates);
40 static Symbol* checkeconst(Symbol* en, const char* refname);
41 #endif
42 
43 List* vlenconstants;  /* List<Constant*>;*/
44 			  /* ptr to vlen instances across all datalists*/
45 
46 /* Post-parse semantic checks and actions*/
47 void
processsemantics(void)48 processsemantics(void)
49 {
50     /* Fix up the root name to match the chosen filename */
51     processroot();
52     /* Fill in the fqn for every defining symbol */
53     computefqns();
54     /* Process each type and sort by dependency order*/
55     processtypes();
56     /* Make sure all typecodes are set if basetype is set*/
57     filltypecodes();
58     /* Process each type to compute its size*/
59     processtypesizes();
60     /* Process each var to fill in missing fields, etc*/
61     processvars();
62     /* Process attributes to connect to corresponding variable*/
63     processattributes();
64     /* Fix up enum constant values*/
65     processenums();
66     /* Fix up enum constant references*/
67     processeconstrefs();
68     /* Compute the unlimited dimension sizes */
69     processunlimiteddims();
70     /* check internal consistency*/
71     checkconsistency();
72 }
73 
74 /*
75 Given a reference symbol, produce the corresponding
76 definition symbol; return NULL if there is no definition
77 Note that this is somewhat complicated to conform to
78 various scoping rules, namely:
79 1. look into parent hierarchy for un-prefixed dimension names.
80 2. look in whole group tree for un-prefixed type names;
81    search is depth first. MODIFIED 5/26/2009: Search is as follows:
82    a. search parent hierarchy for matching type names.
83    b. search whole tree for unique matching type name
84    c. complain and require prefixed name.
85 3. look in the same group as ref for un-prefixed variable names.
86 4. ditto for group references
87 5. look in whole group tree for un-prefixed enum constants;
88    result must be unique
89 */
90 
91 Symbol*
locate(Symbol * refsym)92 locate(Symbol* refsym)
93 {
94     Symbol* sym = NULL;
95     switch (refsym->objectclass) {
96     case NC_DIM:
97 	if(refsym->is_prefixed) {
98 	    /* locate exact dimension specified*/
99 	    sym = lookup(NC_DIM,refsym);
100 	} else { /* Search for matching dimension in all parent groups*/
101 	    Symbol* parent = lookupgroup(refsym->prefix);/*get group for refsym*/
102 	    while(parent != NULL) {
103 		/* search this parent for matching name and type*/
104 		sym = lookupingroup(NC_DIM,refsym->name,parent);
105 		if(sym != NULL) break;
106 		parent = parent->container;
107 	    }
108 	}
109 	break;
110     case NC_TYPE:
111 	if(refsym->is_prefixed) {
112 	    /* locate exact type specified*/
113 	    sym = lookup(NC_TYPE,refsym);
114 	} else {
115 	    Symbol* parent;
116 	    int i; /* Search for matching type in all groups (except...)*/
117 	    /* Short circuit test for primitive types*/
118 	    for(i=NC_NAT;i<=NC_STRING;i++) {
119 		Symbol* prim = basetypefor(i);
120 		if(prim == NULL) continue;
121 	        if(strcmp(refsym->name,prim->name)==0) {
122 		    sym = prim;
123 		    break;
124 		}
125 	    }
126 	    if(sym == NULL) {
127 	        /* Added 5/26/09: look in parent hierarchy first */
128 	        parent = lookupgroup(refsym->prefix);/*get group for refsym*/
129 	        while(parent != NULL) {
130 		    /* search this parent for matching name and type*/
131 		    sym = lookupingroup(NC_TYPE,refsym->name,parent);
132 		    if(sym != NULL) break;
133 		    parent = parent->container;
134 		}
135 	    }
136 	    if(sym == NULL) {
137 	        sym = uniquetreelocate(refsym,rootgroup); /* want unique */
138 	    }
139 	}
140 	break;
141     case NC_VAR:
142 	if(refsym->is_prefixed) {
143 	    /* locate exact variable specified*/
144 	    sym = lookup(NC_VAR,refsym);
145 	} else {
146 	    Symbol* parent = lookupgroup(refsym->prefix);/*get group for refsym*/
147    	    /* search this parent for matching name and type*/
148 	    sym = lookupingroup(NC_VAR,refsym->name,parent);
149 	}
150         break;
151     case NC_GRP:
152 	if(refsym->is_prefixed) {
153 	    /* locate exact group specified*/
154 	    sym = lookup(NC_GRP,refsym);
155 	} else {
156  	    Symbol* parent = lookupgroup(refsym->prefix);/*get group for refsym*/
157    	    /* search this parent for matching name and type*/
158 	    sym = lookupingroup(NC_GRP,refsym->name,parent);
159 	}
160 	break;
161 
162     default: PANIC1("locate: bad refsym type: %d",refsym->objectclass);
163     }
164     if(debug > 1) {
165 	char* ncname;
166 	if(refsym->objectclass == NC_TYPE)
167 	    ncname = ncclassname(refsym->subclass);
168 	else
169 	    ncname = ncclassname(refsym->objectclass);
170 	fdebug("locate: %s: %s -> %s\n",
171 		ncname,fullname(refsym),(sym?fullname(sym):"NULL"));
172     }
173     return sym;
174 }
175 
176 /*
177 Search for an object in all groups using preorder depth-first traversal.
178 Return NULL if symbol is not unique or not found at all.
179 */
180 static Symbol*
uniquetreelocate(Symbol * refsym,Symbol * root)181 uniquetreelocate(Symbol* refsym, Symbol* root)
182 {
183     unsigned long i;
184     Symbol* sym = NULL;
185     /* search the root for matching name and major type*/
186     sym = lookupingroup(refsym->objectclass,refsym->name,root);
187     if(sym == NULL) {
188 	for(i=0;i<listlength(root->subnodes);i++) {
189 	    Symbol* grp = (Symbol*)listget(root->subnodes,i);
190 	    if(grp->objectclass == NC_GRP && !grp->ref.is_ref) {
191 		Symbol* nextsym = uniquetreelocate(refsym,grp);
192 		if(nextsym != NULL) {
193 		    if(sym != NULL) return NULL; /* not unique */
194 		    sym = nextsym;
195 		}
196 	    }
197 	}
198     }
199     return sym;
200 }
201 
202 /*
203 Compute the fqn for every top-level definition symbol
204 */
205 static void
computefqns(void)206 computefqns(void)
207 {
208     unsigned long i,j;
209     /* Groups first */
210     for(i=0;i<listlength(grpdefs);i++) {
211         Symbol* sym = (Symbol*)listget(grpdefs,i);
212 	topfqn(sym);
213     }
214     /* Dimensions */
215     for(i=0;i<listlength(dimdefs);i++) {
216         Symbol* sym = (Symbol*)listget(dimdefs,i);
217 	topfqn(sym);
218     }
219     /* types */
220     for(i=0;i<listlength(typdefs);i++) {
221         Symbol* sym = (Symbol*)listget(typdefs,i);
222 	topfqn(sym);
223     }
224     /* variables */
225     for(i=0;i<listlength(vardefs);i++) {
226         Symbol* sym = (Symbol*)listget(vardefs,i);
227 	topfqn(sym);
228     }
229     /* fill in the fqn names of econsts */
230     for(i=0;i<listlength(typdefs);i++) {
231         Symbol* sym = (Symbol*)listget(typdefs,i);
232 	if(sym->subclass == NC_ENUM) {
233 	    for(j=0;j<listlength(sym->subnodes);j++) {
234 		Symbol* econ = (Symbol*)listget(sym->subnodes,j);
235 		nestedfqn(econ);
236 	    }
237 	}
238     }
239     /* fill in the fqn names of fields */
240     for(i=0;i<listlength(typdefs);i++) {
241         Symbol* sym = (Symbol*)listget(typdefs,i);
242 	if(sym->subclass == NC_COMPOUND) {
243 	    for(j=0;j<listlength(sym->subnodes);j++) {
244 		Symbol* field = (Symbol*)listget(sym->subnodes,j);
245 		nestedfqn(field);
246 	    }
247 	}
248     }
249     /* fill in the fqn names of attributes */
250     for(i=0;i<listlength(gattdefs);i++) {
251         Symbol* sym = (Symbol*)listget(gattdefs,i);
252         attfqn(sym);
253     }
254     for(i=0;i<listlength(attdefs);i++) {
255         Symbol* sym = (Symbol*)listget(attdefs,i);
256         attfqn(sym);
257     }
258 }
259 
260 /**
261 Process the root group.
262 Currently mean:
263 1. Compute and store the filename
264 */
265 static void
processroot(void)266 processroot(void)
267 {
268     rootgroup->file.filename = createfilename();
269 }
270 
271 /* 1. Do a topological sort of the types based on dependency*/
272 /*    so that the least dependent are first in the typdefs list*/
273 /* 2. fill in type typecodes*/
274 /* 3. mark types that use vlen*/
275 static void
processtypes(void)276 processtypes(void)
277 {
278     unsigned long i,j;
279     int keep,added;
280     List* sorted = listnew(); /* hold re-ordered type set*/
281     /* Prime the walk by capturing the set*/
282     /*     of types that are dependent on primitive types*/
283     /*     e.g. uint vlen(*) or primitive types*/
284     for(i=0;i<listlength(typdefs);i++) {
285         Symbol* sym = (Symbol*)listget(typdefs,i);
286 	keep=0;
287 	switch (sym->subclass) {
288 	case NC_PRIM: /*ignore pre-defined primitive types*/
289 	    sym->touched=1;
290 	    break;
291 	case NC_OPAQUE:
292 	case NC_ENUM:
293 	    keep=1;
294 	    break;
295         case NC_VLEN: /* keep if its basetype is primitive*/
296 	    if(sym->typ.basetype->subclass == NC_PRIM) keep=1;
297 	    break;
298 	case NC_COMPOUND: /* keep if all fields are primitive*/
299 	    keep=1; /*assume all fields are primitive*/
300 	    for(j=0;j<listlength(sym->subnodes);j++) {
301 		Symbol* field = (Symbol*)listget(sym->subnodes,j);
302 		ASSERT(field->subclass == NC_FIELD);
303 		if(field->typ.basetype->subclass != NC_PRIM) {keep=0;break;}
304 	    }
305 	    break;
306 	default: break;/* ignore*/
307 	}
308 	if(keep) {
309 	    sym->touched = 1;
310 	    listpush(sorted,(void*)sym);
311 	}
312     }
313     /* 2. repeated walk to collect level i types*/
314     do {
315         added=0;
316         for(i=0;i<listlength(typdefs);i++) {
317 	    Symbol* sym = (Symbol*)listget(typdefs,i);
318 	    if(sym->touched) continue; /* ignore already processed types*/
319 	    keep=0; /* assume not addable yet.*/
320 	    switch (sym->subclass) {
321 	    case NC_PRIM:
322 	    case NC_OPAQUE:
323 	    case NC_ENUM:
324 		PANIC("type re-touched"); /* should never happen*/
325 	        break;
326             case NC_VLEN: /* keep if its basetype is already processed*/
327 	        if(sym->typ.basetype->touched) keep=1;
328 	        break;
329 	    case NC_COMPOUND: /* keep if all fields are processed*/
330 	        keep=1; /*assume all fields are touched*/
331 	        for(j=0;j<listlength(sym->subnodes);j++) {
332 		    Symbol* field = (Symbol*)listget(sym->subnodes,j);
333 		    ASSERT(field->subclass == NC_FIELD);
334 		    if(!field->typ.basetype->touched) {keep=1;break;}
335 	        }
336 	        break;
337 	    default: break;
338 	    }
339 	    if(keep) {
340 		listpush(sorted,(void*)sym);
341 		sym->touched = 1;
342 		added++;
343 	    }
344 	}
345     } while(added > 0);
346     /* Any untouched type => circular dependency*/
347     for(i=0;i<listlength(typdefs);i++) {
348 	Symbol* tsym = (Symbol*)listget(typdefs,i);
349 	if(tsym->touched) continue;
350 	semerror(tsym->lineno,"Circular type dependency for type: %s",fullname(tsym));
351     }
352     listfree(typdefs);
353     typdefs = sorted;
354     /* fill in type typecodes*/
355     for(i=0;i<listlength(typdefs);i++) {
356         Symbol* sym = (Symbol*)listget(typdefs,i);
357 	if(sym->typ.basetype != NULL && sym->typ.typecode == NC_NAT)
358 	    sym->typ.typecode = sym->typ.basetype->typ.typecode;
359     }
360     /* Identify types containing vlens */
361     for(i=0;i<listlength(typdefs);i++) {
362         Symbol* tsym = (Symbol*)listget(typdefs,i);
363 	tagvlentypes(tsym);
364     }
365 }
366 
367 /* Recursively check for vlens*/
368 static int
tagvlentypes(Symbol * tsym)369 tagvlentypes(Symbol* tsym)
370 {
371     int tagged = 0;
372     unsigned long j;
373     switch (tsym->subclass) {
374         case NC_VLEN:
375 	    tagged = 1;
376 	    tagvlentypes(tsym->typ.basetype);
377 	    break;
378 	case NC_COMPOUND: /* keep if all fields are primitive*/
379 	    for(j=0;j<listlength(tsym->subnodes);j++) {
380 		Symbol* field = (Symbol*)listget(tsym->subnodes,j);
381 		ASSERT(field->subclass == NC_FIELD);
382 		if(tagvlentypes(field->typ.basetype)) tagged = 1;
383 	    }
384 	    break;
385 	default: break;/* ignore*/
386     }
387     if(tagged) tsym->typ.hasvlen = 1;
388     return tagged;
389 }
390 
391 /* Make sure all typecodes are set if basetype is set*/
392 static void
filltypecodes(void)393 filltypecodes(void)
394 {
395     int i;
396     for(i=0;i<listlength(symlist);i++) {
397         Symbol* sym = listget(symlist,i);
398 	if(sym->typ.basetype != NULL && sym->typ.typecode == NC_NAT)
399 	    sym->typ.typecode = sym->typ.basetype->typ.typecode;
400     }
401 }
402 
403 static void
processenums(void)404 processenums(void)
405 {
406     unsigned long i,j;
407 #if 0 /* Unused? */
408     List* enumids = listnew();
409 #endif
410     for(i=0;i<listlength(typdefs);i++) {
411 	Symbol* sym = (Symbol*)listget(typdefs,i);
412 	ASSERT(sym->objectclass == NC_TYPE);
413 	if(sym->subclass != NC_ENUM) continue;
414 	for(j=0;j<listlength(sym->subnodes);j++) {
415 	    Symbol* esym = (Symbol*)listget(sym->subnodes,j);
416 	    ASSERT(esym->subclass == NC_ECONST);
417 #if 0 /* Unused? */
418 	    listpush(enumids,(void*)esym);
419 #endif
420 	}
421     }
422     /* Convert enum values to match enum type*/
423     for(i=0;i<listlength(typdefs);i++) {
424 	Symbol* tsym = (Symbol*)listget(typdefs,i);
425 	ASSERT(tsym->objectclass == NC_TYPE);
426 	if(tsym->subclass != NC_ENUM) continue;
427 	for(j=0;j<listlength(tsym->subnodes);j++) {
428 	    Symbol* esym = (Symbol*)listget(tsym->subnodes,j);
429 	    NCConstant* newec = nullconst();
430 	    ASSERT(esym->subclass == NC_ECONST);
431 	    newec->nctype = esym->typ.typecode;
432 	    convert1(esym->typ.econst,newec);
433 	    reclaimconstant(esym->typ.econst);
434 	    esym->typ.econst = newec;
435 	}
436     }
437 }
438 
439 /* Walk all data lists looking for econst refs
440    and convert to point to actual definition
441 */
442 static void
processeconstrefs(void)443 processeconstrefs(void)
444 {
445     unsigned long i;
446     /* locate all the datalist and walk them recursively */
447     for(i=0;i<listlength(gattdefs);i++) {
448 	Symbol* att = (Symbol*)listget(gattdefs,i);
449 	if(att->data != NULL && listlength(att->data) > 0)
450 	    processeconstrefsR(att,att->data);
451     }
452     for(i=0;i<listlength(attdefs);i++) {
453 	Symbol* att = (Symbol*)listget(attdefs,i);
454 	if(att->data != NULL && listlength(att->data) > 0)
455 	    processeconstrefsR(att,att->data);
456     }
457     for(i=0;i<listlength(vardefs);i++) {
458 	Symbol* var = (Symbol*)listget(vardefs,i);
459 	if(var->data != NULL && listlength(var->data) > 0)
460 	    processeconstrefsR(var,var->data);
461 	if(var->var.special->_Fillvalue != NULL)
462 	    processeconstrefsR(var,var->var.special->_Fillvalue);
463     }
464 }
465 
466 /* Recursive helper for processeconstrefs */
467 static void
processeconstrefsR(Symbol * avsym,Datalist * data)468 processeconstrefsR(Symbol* avsym, Datalist* data)
469 {
470     NCConstant** dlp = NULL;
471     int i;
472     for(i=0,dlp=data->data;i<data->length;i++,dlp++) {
473 	NCConstant* con = *dlp;
474 	if(con->nctype == NC_COMPOUND) {
475 	    /* Iterate over the sublists */
476 	    processeconstrefsR(avsym,con->value.compoundv);
477 	} else if(con->nctype == NC_ECONST || con->nctype == NC_FILLVALUE) {
478 	    fixeconstref(avsym,con);
479 	}
480     }
481 }
482 
483 static void
fixeconstref(Symbol * avsym,NCConstant * con)484 fixeconstref(Symbol* avsym, NCConstant* con)
485 {
486     Symbol* basetype = NULL;
487     Symbol* refsym = con->value.enumv;
488     Symbol* varsym = NULL;
489     int i;
490 
491     /* Figure out the proper type associated with avsym */
492     ASSERT(avsym->objectclass == NC_VAR || avsym->objectclass == NC_ATT);
493 
494     if(avsym->objectclass == NC_VAR) {
495         basetype = avsym->typ.basetype;
496 	varsym = avsym;
497     } else { /*(avsym->objectclass == NC_ATT)*/
498         basetype = avsym->typ.basetype;
499 	varsym = avsym->container;
500 	if(varsym->objectclass == NC_GRP)
501 	    varsym = NULL;
502     }
503 
504     if(basetype->objectclass != NC_TYPE && basetype->subclass != NC_ENUM)
505         semerror(con->lineno,"Enumconstant associated with a non-econst type");
506 
507     if(con->nctype == NC_FILLVALUE) {
508 	Datalist* filllist = NULL;
509 	NCConstant* filler = NULL;
510 	filllist = getfiller(varsym == NULL?basetype:varsym);
511 	if(filllist == NULL)
512 	    semerror(con->lineno, "Cannot determine enum constant fillvalue");
513 	filler = datalistith(filllist,0);
514 	con->value.enumv = filler->value.enumv;
515 	return;
516     }
517 
518     for(i=0;i<listlength(basetype->subnodes);i++) {
519 	Symbol* econst = listget(basetype->subnodes,i);
520 	ASSERT(econst->subclass == NC_ECONST);
521 	if(strcmp(econst->name,refsym->name)==0) {
522 	    con->value.enumv = econst;
523 	    return;
524 	}
525     }
526     semerror(con->lineno,"Undefined enum or enum constant reference: %s",refsym->name);
527 }
528 
529 #if 0
530 /* If we have an enum-valued group attribute, then we need to do
531 extra work to find the containing enum type
532 */
533 static Symbol*
534 locateenumtype(Symbol* refsym, Symbol* parent, NCConstant* con)
535 {
536     Symbol* match = NULL;
537     List* grpmatches;
538 
539     /* Locate all possible matching enum constant definitions */
540     List* candidates = findecmatches(refsym->name);
541     if(candidates == NULL) {
542 	semerror(con->lineno,"Undefined enum or enum constant reference: %s",refsym->name);
543 	return NULL;
544     }
545     /* One hopes that 99% of the time, the match is unique */
546     if(listlength(candidates) == 1) {
547 	match = listget(candidates,0);
548 	goto done;
549     }
550     /* If this ref has a specified group prefix, then find that group
551        and search only within it for matches to the candidates */
552     if(refsym->is_prefixed && refsym->prefix != NULL) {
553 	parent = lookupgroup(refsym->prefix);
554 	if(parent == NULL) {
555 	    semerror(con->lineno,"Undefined group reference: ",fullname(refsym));
556 	    goto done;
557 	}
558 	/* Search this group only for matches */
559 	grpmatches = ecsearchgrp(parent,candidates);
560 	switch (listlength(grpmatches)) {
561 	case 0:
562 	    semerror(con->lineno,"Undefined enum or enum constant reference: ",refsym->name);
563 	    listfree(grpmatches);
564 	    goto done;
565 	case 1:
566 	    break;
567 	default:
568 	    semerror(con->lineno,"Ambiguous enum constant reference: %s", fullname(refsym));
569 	}
570 	match = listget(grpmatches,0);
571 	listfree(grpmatches);
572 	goto done;
573     }
574     /* Sigh, we have to search up the tree to see if any of our candidates are there */
575     assert(parent == NULL || parent->objectclass == NC_GRP);
576     while(parent != NULL && match == NULL) {
577 	grpmatches = ecsearchgrp(parent,candidates);
578 	switch (listlength(grpmatches)) {
579 	case 0: break;
580 	case 1: match = listget(grpmatches,0); break;
581 	default:
582 	    semerror(con->lineno,"Ambiguous enum constant reference: %s", fullname(refsym));
583 	    match = listget(grpmatches,0);
584 	    break;
585 	}
586 	listfree(grpmatches);
587     }
588     if(match != NULL) goto done;
589     /* Not unique and not in the parent tree, so complains and pick the first candidate */
590     semerror(con->lineno,"Ambiguous enum constant reference: %s", fullname(refsym));
591     match = (Symbol*)listget(candidates,0);
592 done:
593     listfree(candidates);
594     return match;
595 }
596 
597 /*
598 Locate enums whose name is a prefix of ident
599 and contains the suffix as an enum const
600 and capture that enum constant.
601 */
602 static List*
603 findecmatches(char* ident)
604 {
605     List* matches = listnew();
606     int i;
607 
608     for(i=0;i<listlength(typdefs);i++) {
609 	int len;
610 	Symbol* ec;
611 	Symbol* en = (Symbol*)listget(typdefs,i);
612 	if(en->subclass != NC_ENUM)
613 	    continue;
614         /* First, assume that the ident is the econst name only */
615 	ec = checkeconst(en,ident);
616 	if(ec != NULL)
617 	    listpush(matches,ec);
618 	/* Second, do the prefix check */
619 	len = strlen(en->name);
620 	if(strncmp(ident,en->name,len) == 0) {
621 		Symbol *ec;
622 		/* Find the matching ec constant, if any */
623 	    if(*(ident+len) != '.') continue;
624 	    ec = checkeconst(en,ident+len+1); /* +1 for the dot */
625 	    if(ec != NULL)
626 		listpush(matches,ec);
627 	}
628     }
629     if(listlength(matches) == 0) {
630 	listfree(matches);
631         matches = NULL;
632     }
633     return matches;
634 }
635 
636 static List*
637 ecsearchgrp(Symbol* grp, List* candidates)
638 {
639     List* matches = listnew();
640     int i,j;
641     /* do the intersection of grp subnodes and candidates */
642     for(i=0;i<listlength(grp->subnodes);i++) {
643 	Symbol* sub= (Symbol*)listget(grp->subnodes,i);
644 	if(sub->subclass != NC_ENUM)
645 	    continue;
646 	for(j=0;j<listlength(candidates);j++) {
647 	    Symbol* ec = (Symbol*)listget(candidates,j);
648 	    if(ec->container == sub)
649 		listpush(matches,ec);
650 	}
651     }
652     if(listlength(matches) == 0) {
653         listfree(matches);
654 	matches = NULL;
655     }
656     return matches;
657 }
658 
659 static Symbol*
660 checkeconst(Symbol* en, const char* refname)
661 {
662     int i;
663     for(i=0;i<listlength(en->subnodes);i++) {
664 	Symbol* ec = (Symbol*)listget(en->subnodes,i);
665 	if(strcmp(ec->name,refname) == 0)
666 	    return ec;
667     }
668     return NULL;
669 }
670 #endif
671 
672 /* Compute type sizes and compound offsets*/
673 void
computesize(Symbol * tsym)674 computesize(Symbol* tsym)
675 {
676     int i;
677     int offset = 0;
678     int largealign;
679     unsigned long totaldimsize;
680     if(tsym->touched) return;
681     tsym->touched=1;
682     switch (tsym->subclass) {
683         case NC_VLEN: /* actually two sizes for vlen*/
684 	    computesize(tsym->typ.basetype); /* first size*/
685 	    tsym->typ.size = ncsize(tsym->typ.typecode);
686 	    tsym->typ.alignment = ncaux_class_alignment(tsym->typ.typecode);
687 	    tsym->typ.nelems = 1; /* always a single compound datalist */
688 	    break;
689 	case NC_PRIM:
690 	    tsym->typ.size = ncsize(tsym->typ.typecode);
691 	    tsym->typ.alignment = ncaux_class_alignment(tsym->typ.typecode);
692 	    tsym->typ.nelems = 1;
693 	    break;
694 	case NC_OPAQUE:
695 	    /* size and alignment already assigned*/
696 	    tsym->typ.nelems = 1;
697 	    break;
698 	case NC_ENUM:
699 	    computesize(tsym->typ.basetype); /* first size*/
700 	    tsym->typ.size = tsym->typ.basetype->typ.size;
701 	    tsym->typ.alignment = tsym->typ.basetype->typ.alignment;
702 	    tsym->typ.nelems = 1;
703 	    break;
704 	case NC_COMPOUND: /* keep if all fields are primitive*/
705 	    /* First, compute recursively, the size and alignment of fields*/
706             for(i=0;i<listlength(tsym->subnodes);i++) {
707 		Symbol* field = (Symbol*)listget(tsym->subnodes,i);
708                 ASSERT(field->subclass == NC_FIELD);
709 		computesize(field);
710 		if(i==0) tsym->typ.alignment = field->typ.alignment;
711             }
712             /* now compute the size of the compound based on what user specified*/
713             offset = 0;
714             largealign = 1;
715             for(i=0;i<listlength(tsym->subnodes);i++) {
716                 Symbol* field = (Symbol*)listget(tsym->subnodes,i);
717                 /* only support 'c' alignment for now*/
718                 int alignment = field->typ.alignment;
719                 int padding = getpadding(offset,alignment);
720                 offset += padding;
721                 field->typ.offset = offset;
722                 offset += field->typ.size;
723                 if (alignment > largealign) {
724                     largealign = alignment;
725                 }
726             }
727 	    tsym->typ.cmpdalign = largealign; /* total structure size alignment */
728             offset += (offset % largealign);
729 	    tsym->typ.size = offset;
730 	    break;
731         case NC_FIELD: /* Compute size assume no unlimited dimensions*/
732 	    if(tsym->typ.dimset.ndims > 0) {
733 	        computesize(tsym->typ.basetype);
734 	        totaldimsize = crossproduct(&tsym->typ.dimset,0,rankfor(&tsym->typ.dimset));
735 	        tsym->typ.size = tsym->typ.basetype->typ.size * totaldimsize;
736 	        tsym->typ.alignment = tsym->typ.basetype->typ.alignment;
737 	        tsym->typ.nelems = 1;
738 	    } else {
739 	        tsym->typ.size = tsym->typ.basetype->typ.size;
740 	        tsym->typ.alignment = tsym->typ.basetype->typ.alignment;
741 	        tsym->typ.nelems = tsym->typ.basetype->typ.nelems;
742 	    }
743 	    break;
744 	default:
745 	    PANIC1("computesize: unexpected type class: %d",tsym->subclass);
746 	    break;
747     }
748 }
749 
750 void
processvars(void)751 processvars(void)
752 {
753     int i,j;
754     for(i=0;i<listlength(vardefs);i++) {
755 	Symbol* vsym = (Symbol*)listget(vardefs,i);
756 	Symbol* basetype = vsym->typ.basetype;
757         /* If we are in classic mode, then convert long -> int32 */
758 	if(usingclassic) {
759 	    if(basetype->typ.typecode == NC_LONG || basetype->typ.typecode == NC_INT64) {
760 	        vsym->typ.basetype = primsymbols[NC_INT];
761 		basetype = vsym->typ.basetype;
762 	    }
763         }
764 	/* fill in the typecode*/
765 	vsym->typ.typecode = basetype->typ.typecode;
766 	/* validate uses of NIL */
767         validateNIL(vsym);
768 	for(j=0;j<vsym->typ.dimset.ndims;j++) {
769 	    /* validate the dimensions*/
770             /* UNLIMITED must only be in first place if using classic */
771 	    if(vsym->typ.dimset.dimsyms[j]->dim.declsize == NC_UNLIMITED) {
772 	        if(usingclassic && j != 0)
773 		    semerror(vsym->lineno,"Variable: %s: UNLIMITED must be in first dimension only",fullname(vsym));
774 	    }
775 	}
776     }
777 }
778 
779 static void
processtypesizes(void)780 processtypesizes(void)
781 {
782     int i;
783     /* use touch flag to avoid circularity*/
784     for(i=0;i<listlength(typdefs);i++) {
785 	Symbol* tsym = (Symbol*)listget(typdefs,i);
786 	tsym->touched = 0;
787     }
788     for(i=0;i<listlength(typdefs);i++) {
789 	Symbol* tsym = (Symbol*)listget(typdefs,i);
790 	computesize(tsym); /* this will recurse*/
791     }
792 }
793 
794 static void
processattributes(void)795 processattributes(void)
796 {
797     int i,j;
798     /* process global attributes*/
799     for(i=0;i<listlength(gattdefs);i++) {
800 	Symbol* asym = (Symbol*)listget(gattdefs,i);
801 	if(asym->typ.basetype == NULL) inferattributetype(asym);
802         /* fill in the typecode*/
803 	asym->typ.typecode = asym->typ.basetype->typ.typecode;
804 	if(asym->data != NULL && asym->data->length == 0) {
805 	    NCConstant* empty = NULL;
806 	    /* If the attribute has a zero length, then default it;
807                note that it must be of type NC_CHAR */
808 	    if(asym->typ.typecode != NC_CHAR)
809 	        semerror(asym->lineno,"Empty datalist can only be assigned to attributes of type char",fullname(asym));
810 	    empty = emptystringconst(asym->lineno);
811 	    dlappend(asym->data,empty);
812 	}
813 	validateNIL(asym);
814     }
815     /* process per variable attributes*/
816     for(i=0;i<listlength(attdefs);i++) {
817 	Symbol* asym = (Symbol*)listget(attdefs,i);
818 	/* If no basetype is specified, then try to infer it;
819            the exception is _Fillvalue, whose type is that of the
820            containing variable.
821         */
822         if(strcmp(asym->name,specialname(_FILLVALUE_FLAG)) == 0) {
823 	    /* This is _Fillvalue */
824 	    asym->typ.basetype = asym->att.var->typ.basetype; /* its basetype is same as its var*/
825 	    /* put the datalist into the specials structure */
826 	    if(asym->data == NULL) {
827 		/* Generate a default fill value */
828 	        asym->data = getfiller(asym->typ.basetype);
829 	    }
830 	    if(asym->att.var->var.special->_Fillvalue != NULL)
831 	    	reclaimdatalist(asym->att.var->var.special->_Fillvalue);
832 	    asym->att.var->var.special->_Fillvalue = clonedatalist(asym->data);
833 	} else if(asym->typ.basetype == NULL) {
834 	    inferattributetype(asym);
835 	}
836 	/* fill in the typecode*/
837 	asym->typ.typecode = asym->typ.basetype->typ.typecode;
838 	if(asym->data->length == 0) {
839 	    NCConstant* empty = NULL;
840 	    /* If the attribute has a zero length, and is char type, then default it */
841 	    if(asym->typ.typecode != NC_CHAR)
842 	        semerror(asym->lineno,"Empty datalist can only be assigned to attributes of type char",fullname(asym));
843 	    empty = emptystringconst(asym->lineno);
844 	    dlappend(asym->data,empty);
845 	}
846 	validateNIL(asym);
847     }
848     /* collect per-variable attributes per variable*/
849     for(i=0;i<listlength(vardefs);i++) {
850 	Symbol* vsym = (Symbol*)listget(vardefs,i);
851 	List* list = listnew();
852         for(j=0;j<listlength(attdefs);j++) {
853 	    Symbol* asym = (Symbol*)listget(attdefs,j);
854 	    if(asym->att.var == NULL)
855 		continue; /* ignore globals for now */
856 	    if(asym->att.var != vsym) continue;
857             listpush(list,(void*)asym);
858 	}
859 	vsym->var.attributes = list;
860     }
861 }
862 
863 /*
864 Given two types, attempt to upgrade to the "bigger type"
865 Rules:
866 - type size has precedence over signed/unsigned:
867    e.g. NC_INT over NC_UBYTE
868 */
869 static nc_type
infertype(nc_type prior,nc_type next,int hasneg)870 infertype(nc_type prior, nc_type next, int hasneg)
871 {
872     nc_type sp, sn;
873     /* assert isinttype(prior) && isinttype(next) */
874     if(prior == NC_NAT) return next;
875     if(prior == next) return next;
876     sp = signedtype(prior);
877     sn = signedtype(next);
878     if(sp <= sn)
879 	return next;
880     if(sn < sp)
881 	return prior;
882     return NC_NAT; /* all other cases illegal */
883 }
884 
885 /*
886 Collect info by repeated walking of the attribute value list.
887 */
888 static nc_type
inferattributetype1(Datalist * adata)889 inferattributetype1(Datalist* adata)
890 {
891     nc_type result = NC_NAT;
892     int hasneg = 0;
893     int stringcount = 0;
894     int charcount = 0;
895     int forcefloat = 0;
896     int forcedouble = 0;
897     int forceuint64 = 0;
898     int i;
899 
900     /* Walk the top level set of attribute values to ensure non-nesting */
901     for(i=0;i<datalistlen(adata);i++) {
902 	NCConstant* con = datalistith(adata,i);
903 	if(con == NULL) return NC_NAT;
904 	if(con->nctype > NC_MAX_ATOMIC_TYPE) { /* illegal */
905 	    return NC_NAT;
906 	}
907     }
908 
909     /* Walk repeatedly to get info for inference (loops could be combined) */
910     /* Compute: all strings or chars? */
911     stringcount = 0;
912     charcount = 0;
913     for(i=0;i<datalistlen(adata);i++) {
914 	NCConstant* con = datalistith(adata,i);
915 	if(con->nctype == NC_STRING) stringcount++;
916 	else if(con->nctype == NC_CHAR) charcount++;
917     }
918     if((stringcount+charcount) > 0) {
919         if((stringcount+charcount) < datalistlen(adata))
920 	    return NC_NAT; /* not all textual */
921 	return NC_CHAR;
922     }
923 
924     /* Compute: any floats/doubles? */
925     forcefloat = 0;
926     forcedouble = 0;
927     for(i=0;i<datalistlen(adata);i++) {
928 	NCConstant* con = datalistith(adata,i);
929 	if(con->nctype == NC_FLOAT) forcefloat = 1;
930 	else if(con->nctype == NC_DOUBLE) {forcedouble=1; break;}
931     }
932     if(forcedouble) return NC_DOUBLE;
933     if(forcefloat)  return NC_FLOAT;
934 
935     /* At this point all the constants should be integers */
936 
937     /* Compute: are there any uint64 values > NC_MAX_INT64? */
938     forceuint64 = 0;
939     for(i=0;i<datalistlen(adata);i++) {
940 	NCConstant* con = datalistith(adata,i);
941 	if(con->nctype != NC_UINT64) continue;
942 	if(con->value.uint64v > NC_MAX_INT64) {forceuint64=1; break;}
943     }
944     if(forceuint64)
945 	return NC_UINT64;
946 
947     /* Compute: are there any negative constants? */
948     hasneg = 0;
949     for(i=0;i<datalistlen(adata);i++) {
950 	NCConstant* con = datalistith(adata,i);
951 	switch (con->nctype) {
952 	case NC_BYTE :   if(con->value.int8v < 0)   {hasneg = 1;} break;
953 	case NC_SHORT:   if(con->value.int16v < 0)  {hasneg = 1;} break;
954 	case NC_INT:     if(con->value.int32v < 0)  {hasneg = 1;} break;
955 	}
956     }
957 
958     /* Compute: inferred integer type */
959     result = NC_NAT;
960     for(i=0;i<datalistlen(adata);i++) {
961 	NCConstant* con = datalistith(adata,i);
962 	result = infertype(result,con->nctype,hasneg);
963 	if(result == NC_NAT) break; /* something wrong */
964     }
965     return result;
966 }
967 
968 static void
inferattributetype(Symbol * asym)969 inferattributetype(Symbol* asym)
970 {
971     Datalist* datalist;
972     nc_type nctype;
973     ASSERT(asym->data != NULL);
974     datalist = asym->data;
975     if(datalist->length == 0) {
976         /* Default for zero length attributes */
977 	asym->typ.basetype = basetypefor(NC_CHAR);
978 	return;
979     }
980     nctype = inferattributetype1(datalist);
981     if(nctype == NC_NAT) { /* Illegal attribute value list */
982 	semerror(asym->lineno,"Non-simple list of values for untyped attribute: %s",fullname(asym));
983 	return;
984     }
985     /* get the corresponding primitive type built-in symbol*/
986     /* special case for string*/
987     if(nctype == NC_STRING)
988         asym->typ.basetype = basetypefor(NC_CHAR);
989     else if(usingclassic) {
990         /* If we are in classic mode, then restrict the inferred type
991            to the classic or cdf5 atypes */
992 	switch (nctype) {
993 	case NC_OPAQUE:
994 	case NC_ENUM:
995 	    nctype = NC_INT;
996 	    break;
997 	default: /* leave as is */
998 	    break;
999 	}
1000 	asym->typ.basetype = basetypefor(nctype);
1001     } else
1002 	asym->typ.basetype = basetypefor(nctype);
1003 }
1004 
1005 #ifdef USE_NETCDF4
1006 /* recursive helper for validataNIL */
1007 static void
validateNILr(Datalist * src)1008 validateNILr(Datalist* src)
1009 {
1010     int i;
1011     for(i=0;i<src->length;i++) {
1012 	NCConstant* con = datalistith(src,i);
1013 	if(isnilconst(con))
1014             semerror(con->lineno,"NIL data can only be assigned to variables or attributes of type string");
1015 	else if(islistconst(con)) /* recurse */
1016 	    validateNILr(con->value.compoundv);
1017     }
1018 }
1019 #endif
1020 
1021 static void
validateNIL(Symbol * sym)1022 validateNIL(Symbol* sym)
1023 {
1024 #ifdef USE_NETCDF4
1025     Datalist* datalist = sym->data;
1026     if(datalist == NULL || datalist->length == 0) return;
1027     if(sym->typ.typecode == NC_STRING) return;
1028     validateNILr(datalist);
1029 #endif
1030 }
1031 
1032 
1033 /* Find name within group structure*/
1034 Symbol*
lookupgroup(List * prefix)1035 lookupgroup(List* prefix)
1036 {
1037 #ifdef USE_NETCDF4
1038     if(prefix == NULL || listlength(prefix) == 0)
1039 	return rootgroup;
1040     else
1041 	return (Symbol*)listtop(prefix);
1042 #else
1043     return rootgroup;
1044 #endif
1045 }
1046 
1047 /* Find name within given group*/
1048 Symbol*
lookupingroup(nc_class objectclass,char * name,Symbol * grp)1049 lookupingroup(nc_class objectclass, char* name, Symbol* grp)
1050 {
1051     int i;
1052     if(name == NULL) return NULL;
1053     if(grp == NULL) grp = rootgroup;
1054 dumpgroup(grp);
1055     for(i=0;i<listlength(grp->subnodes);i++) {
1056 	Symbol* sym = (Symbol*)listget(grp->subnodes,i);
1057 	if(sym->ref.is_ref) continue;
1058 	if(sym->objectclass != objectclass) continue;
1059 	if(strcmp(sym->name,name)!=0) continue;
1060 	return sym;
1061     }
1062     return NULL;
1063 }
1064 
1065 /* Find symbol within group structure*/
1066 Symbol*
lookup(nc_class objectclass,Symbol * pattern)1067 lookup(nc_class objectclass, Symbol* pattern)
1068 {
1069     Symbol* grp;
1070     if(pattern == NULL) return NULL;
1071     grp = lookupgroup(pattern->prefix);
1072     if(grp == NULL) return NULL;
1073     return lookupingroup(objectclass,pattern->name,grp);
1074 }
1075 
1076 
1077 /* return internal size for values of specified netCDF type */
1078 size_t
nctypesize(nc_type type)1079 nctypesize(
1080      nc_type type)			/* netCDF type code */
1081 {
1082     switch (type) {
1083       case NC_BYTE: return sizeof(char);
1084       case NC_CHAR: return sizeof(char);
1085       case NC_SHORT: return sizeof(short);
1086       case NC_INT: return sizeof(int);
1087       case NC_FLOAT: return sizeof(float);
1088       case NC_DOUBLE: return sizeof(double);
1089       case NC_UBYTE: return sizeof(unsigned char);
1090       case NC_USHORT: return sizeof(unsigned short);
1091       case NC_UINT: return sizeof(unsigned int);
1092       case NC_INT64: return sizeof(long long);
1093       case NC_UINT64: return sizeof(unsigned long long);
1094       case NC_STRING: return sizeof(char*);
1095       default:
1096 	PANIC("nctypesize: bad type code");
1097     }
1098     return 0;
1099 }
1100 
1101 static int
sqContains(List * seq,Symbol * sym)1102 sqContains(List* seq, Symbol* sym)
1103 {
1104     int i;
1105     if(seq == NULL) return 0;
1106     for(i=0;i<listlength(seq);i++) {
1107         Symbol* sub = (Symbol*)listget(seq,i);
1108 	if(sub == sym) return 1;
1109     }
1110     return 0;
1111 }
1112 
1113 static void
checkconsistency(void)1114 checkconsistency(void)
1115 {
1116     int i;
1117     for(i=0;i<listlength(grpdefs);i++) {
1118 	Symbol* sym = (Symbol*)listget(grpdefs,i);
1119 	if(sym == rootgroup) {
1120 	    if(sym->container != NULL)
1121 	        PANIC("rootgroup has a container");
1122 	} else if(sym->container == NULL && sym != rootgroup)
1123 	    PANIC1("symbol with no container: %s",sym->name);
1124 	else if(sym->container->ref.is_ref != 0)
1125 	    PANIC1("group with reference container: %s",sym->name);
1126 	else if(sym != rootgroup && !sqContains(sym->container->subnodes,sym))
1127 	    PANIC1("group not in container: %s",sym->name);
1128 	if(sym->subnodes == NULL)
1129 	    PANIC1("group with null subnodes: %s",sym->name);
1130     }
1131     for(i=0;i<listlength(typdefs);i++) {
1132 	Symbol* sym = (Symbol*)listget(typdefs,i);
1133         if(!sqContains(sym->container->subnodes,sym))
1134 	    PANIC1("type not in container: %s",sym->name);
1135     }
1136     for(i=0;i<listlength(dimdefs);i++) {
1137 	Symbol* sym = (Symbol*)listget(dimdefs,i);
1138         if(!sqContains(sym->container->subnodes,sym))
1139 	    PANIC1("dimension not in container: %s",sym->name);
1140     }
1141     for(i=0;i<listlength(vardefs);i++) {
1142 	Symbol* sym = (Symbol*)listget(vardefs,i);
1143         if(!sqContains(sym->container->subnodes,sym))
1144 	    PANIC1("variable not in container: %s",sym->name);
1145 	if(!(isprimplus(sym->typ.typecode)
1146 	     || sqContains(typdefs,sym->typ.basetype)))
1147 	    PANIC1("variable with undefined type: %s",sym->name);
1148     }
1149 }
1150 
1151 static void
computeunlimitedsizes(Dimset * dimset,int dimindex,Datalist * data,int ischar)1152 computeunlimitedsizes(Dimset* dimset, int dimindex, Datalist* data, int ischar)
1153 {
1154     int i;
1155     size_t xproduct, unlimsize;
1156     int nextunlim,lastunlim;
1157     Symbol* thisunlim = dimset->dimsyms[dimindex];
1158     size_t length;
1159 
1160     ASSERT(thisunlim->dim.isunlimited);
1161     nextunlim = findunlimited(dimset,dimindex+1);
1162     lastunlim = (nextunlim == dimset->ndims);
1163 
1164     xproduct = crossproduct(dimset,dimindex+1,nextunlim);
1165 
1166     if(!lastunlim) {
1167 	/* Compute candidate size of this unlimited */
1168         length = data->length;
1169 	unlimsize = length / xproduct;
1170 	if(length % xproduct != 0)
1171 	    unlimsize++; /* => fill requires at some point */
1172 #ifdef GENDEBUG2
1173 fprintf(stderr,"unlimsize: dim=%s declsize=%lu xproduct=%lu newsize=%lu\n",
1174 thisunlim->name,
1175 (unsigned long)thisunlim->dim.declsize,
1176 (unsigned long)xproduct,
1177 (unsigned long)unlimsize);
1178 #endif
1179 	if(thisunlim->dim.declsize < unlimsize) /* want max length of the unlimited*/
1180             thisunlim->dim.declsize = unlimsize;
1181         /*!lastunlim => data is list of sublists, recurse on each sublist*/
1182 	for(i=0;i<data->length;i++) {
1183 	    NCConstant* con = data->data[i];
1184 	    if(con->nctype != NC_COMPOUND) {
1185 		semerror(con->lineno,"UNLIMITED dimension (other than first) must be enclosed in {}");
1186 	    }
1187 	    computeunlimitedsizes(dimset,nextunlim,con->value.compoundv,ischar);
1188 	}
1189     } else {			/* lastunlim */
1190 	if(ischar) {
1191 	    /* Char case requires special computations;
1192 	       compute total number of characters */
1193 	    length = 0;
1194 	    for(i=0;i<data->length;i++) {
1195 		NCConstant* con = data->data[i];
1196 		switch (con->nctype) {
1197 	        case NC_CHAR: case NC_BYTE: case NC_UBYTE:
1198 		    length++;
1199 		    break;
1200 		case NC_STRING:
1201 		    length += con->value.stringv.len;
1202 	            break;
1203 		case NC_COMPOUND:
1204 		    semwarn(datalistline(data),"Expected character constant, found {...}");
1205 		    break;
1206 		default:
1207 		    semwarn(datalistline(data),"Illegal character constant: %d",con->nctype);
1208 	        }
1209 	    }
1210 	} else { /* Data list should be a list of simple non-char constants */
1211    	    length = data->length;
1212 	}
1213 	unlimsize = length / xproduct;
1214 	if(length % xproduct != 0)
1215 	    unlimsize++; /* => fill requires at some point */
1216 #ifdef GENDEBUG2
1217 fprintf(stderr,"unlimsize: dim=%s declsize=%lu xproduct=%lu newsize=%lu\n",
1218 thisunlim->name,
1219 (unsigned long)thisunlim->dim.declsize,
1220 (unsigned long)xproduct,
1221 (unsigned long)unlimsize);
1222 #endif
1223 	if(thisunlim->dim.declsize < unlimsize) /* want max length of the unlimited*/
1224             thisunlim->dim.declsize = unlimsize;
1225     }
1226 }
1227 
1228 static void
processunlimiteddims(void)1229 processunlimiteddims(void)
1230 {
1231     int i;
1232     /* Set all unlimited dims to size 0; */
1233     for(i=0;i<listlength(dimdefs);i++) {
1234 	Symbol* dim = (Symbol*)listget(dimdefs,i);
1235 	if(dim->dim.isunlimited)
1236 	    dim->dim.declsize = 0;
1237     }
1238     /* Walk all variables */
1239     for(i=0;i<listlength(vardefs);i++) {
1240 	Symbol* var = (Symbol*)listget(vardefs,i);
1241 	int first,ischar;
1242 	Dimset* dimset = &var->typ.dimset;
1243 	if(dimset->ndims == 0) continue; /* ignore scalars */
1244 	if(var->data == NULL) continue; /* no data list to walk */
1245 	ischar = (var->typ.basetype->typ.typecode == NC_CHAR);
1246 	first = findunlimited(dimset,0);
1247 	if(first == dimset->ndims) continue; /* no unlimited dims */
1248 	if(first == 0) {
1249 	    computeunlimitedsizes(dimset,first,var->data,ischar);
1250 	} else {
1251 	    int j;
1252 	    for(j=0;j<var->data->length;j++) {
1253 	        NCConstant* con = var->data->data[j];
1254 	        if(con->nctype != NC_COMPOUND)
1255 		    semerror(con->lineno,"UNLIMITED dimension (other than first) must be enclosed in {}");
1256 		else
1257 	            computeunlimitedsizes(dimset,first,con->value.compoundv,ischar);
1258 	    }
1259 	}
1260     }
1261 #ifdef GENDEBUG1
1262     /* print unlimited dim size */
1263     if(listlength(dimdefs) == 0)
1264         fprintf(stderr,"unlimited: no unlimited dimensions\n");
1265     else for(i=0;i<listlength(dimdefs);i++) {
1266 	Symbol* dim = (Symbol*)listget(dimdefs,i);
1267 	if(dim->dim.isunlimited)
1268 	    fprintf(stderr,"unlimited: %s = %lu\n",
1269 		    dim->name,
1270 	            (unsigned long)dim->dim.declsize);
1271     }
1272 #endif
1273 }
1274 
1275 
1276 /* Rules for specifying the dataset name:
1277 	1. use -o name
1278 	2. use the datasetname from the .cdl file
1279 	3. use input cdl file name (with .cdl removed)
1280 	It would be better if there was some way
1281 	to specify the datasetname independently of the
1282 	file name, but oh well.
1283 */
1284 static char*
createfilename(void)1285 createfilename(void)
1286 {
1287     char filename[4096];
1288     filename[0] = '\0';
1289     if(netcdf_name) { /* -o flag name */
1290       strlcat(filename,netcdf_name,sizeof(filename));
1291     } else { /* construct a usable output file name */
1292 	if (cdlname != NULL && strcmp(cdlname,"-") != 0) {/* cmd line name */
1293 	    char* p;
1294 	    strlcat(filename,cdlname,sizeof(filename));
1295 	    /* remove any suffix and prefix*/
1296 	    p = strrchr(filename,'.');
1297 	    if(p != NULL) {*p= '\0';}
1298 	    p = strrchr(filename,'/');
1299 	    if(p != NULL) {
1300 		char* q = filename;
1301 		p++; /* skip the '/' */
1302 		while((*q++ = *p++));
1303 	    }
1304        } else {/* construct name from dataset name */
1305 	    strlcat(filename,datasetname,sizeof(filename));
1306         }
1307         /* Append the proper extension */
1308 	strlcat(filename,binary_ext,sizeof(filename));
1309     }
1310     return strdup(filename);
1311 }
1312