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


HyperKWIC - Version 7.20DA executed at 11:37 on 27 Oct 2017 | Polyhedron Solutions - INTERNAL USE | COMMERCIAL (Any O/S) SN 4AKIed