/*
Locate enums whose name is a prefix of ident
and contains the suffix as an enum const
and capture that enum constant.
*/
static List*
findecmatches(char* ident)
{
List* matches = listnew();
int i;
for(i=0;i<listlength(typdefs);i++) {
int len;
Symbol* ec;
Symbol* en = (Symbol*)listget(typdefs,i);
if(en->subclass != NC_ENUM)
continue;
/* First, assume that the ident is the econst name only */
ec = checkeconst(en,ident);
if(ec != NULL)
listpush(matches,ec);
/* Second, do the prefix check */
len = strlen(en->name);
if(strncmp(ident,en->name,len) == 0) {
Symbol *ec;
/* Find the matching ec constant, if any */
if(*(ident+len) != '.') continue;
ec = checkeconst(en,ident+len+1); /* +1 for the dot */
if(ec != NULL)
listpush(matches,ec);
}
}
if(listlength(matches) == 0) {
listfree(matches);
matches = NULL;
}
return matches;
}
static void
processenums(void)
{
unsigned long i,j;
#if 0 /* Unused? */
List* enumids = listnew();
#endif
for(i=0;i<listlength(typdefs);i++) {
Symbol* sym = (Symbol*)listget(typdefs,i);
ASSERT(sym->objectclass == NC_TYPE);
if(sym->subclass != NC_ENUM) continue;
for(j=0;j<listlength(sym->subnodes);j++) {
Symbol* esym = (Symbol*)listget(sym->subnodes,j);
ASSERT(esym->subclass == NC_ECONST);
#if 0 /* Unused? */
listpush(enumids,(void*)esym);
#endif
}
}
/* Convert enum values to match enum type*/
for(i=0;i<listlength(typdefs);i++) {
Symbol* tsym = (Symbol*)listget(typdefs,i);
ASSERT(tsym->objectclass == NC_TYPE);
if(tsym->subclass != NC_ENUM) continue;
for(j=0;j<listlength(tsym->subnodes);j++) {
Symbol* esym = (Symbol*)listget(tsym->subnodes,j);
NCConstant* newec = nullconst();
ASSERT(esym->subclass == NC_ECONST);
newec->nctype = esym->typ.typecode;
convert1(esym->typ.econst,newec);
reclaimconstant(esym->typ.econst);
esym->typ.econst = newec;
}
}
}
static void
processattributes(void)
{
int i,j;
/* process global attributes*/
for(i=0;i<listlength(gattdefs);i++) {
Symbol* asym = (Symbol*)listget(gattdefs,i);
/* If the attribute has a zero length, then default it */
if(asym->data == NULL || asym->data->length == 0) {
asym->data = builddatalist(1);
emptystringconst(asym->lineno,&asym->data->data[asym->data->length]);
/* force type to be NC_CHAR */
asym->typ.basetype = primsymbols[NC_CHAR];
}
if(asym->typ.basetype == NULL) inferattributetype(asym);
/* fill in the typecode*/
asym->typ.typecode = asym->typ.basetype->typ.typecode;
}
/* process per variable attributes*/
for(i=0;i<listlength(attdefs);i++) {
Symbol* asym = (Symbol*)listget(attdefs,i);
/* If the attribute has a zero length, then default it */
if(asym->data == NULL || asym->data->length == 0) {
asym->data = builddatalist(1);
emptystringconst(asym->lineno,&asym->data->data[asym->data->length]);
/* force type to be NC_CHAR */
asym->typ.basetype = primsymbols[NC_CHAR];
}
/* If no basetype is specified, then try to infer it;
the exception if _Fillvalue, whose type is that of the
containing variable.
*/
if(strcmp(asym->name,specialname(_FILLVALUE_FLAG)) == 0) {
/* This is _Fillvalue */
asym->typ.basetype = asym->att.var->typ.basetype; /* its basetype is same as its var*/
/* put the datalist into the specials structure */
if(asym->data == NULL) {
/* Generate a default fill value */
asym->data = getfiller(asym->typ.basetype);
}
asym->att.var->var.special._Fillvalue = asym->data;
} else if(asym->typ.basetype == NULL) {
inferattributetype(asym);
}
/* fill in the typecode*/
asym->typ.typecode = asym->typ.basetype->typ.typecode;
}
/* collect per-variable attributes per variable*/
for(i=0;i<listlength(vardefs);i++) {
Symbol* vsym = (Symbol*)listget(vardefs,i);
List* list = listnew();
for(j=0;j<listlength(attdefs);j++) {
Symbol* asym = (Symbol*)listget(attdefs,j);
ASSERT(asym->att.var != NULL);
if(asym->att.var != vsym) continue;
listpush(list,(void*)asym);
}
vsym->var.attributes = list;
}
}
static void
fill(Symbol* tvsym, Datalist* filler)
{
int i;
Constant con;
Datalist* sublist;
/* NC_TYPE case*/
switch (tvsym->subclass) {
case NC_ENUM: case NC_OPAQUE: case NC_PRIM:
con.nctype = tvsym->typ.typecode;
nc_getfill(&con);
break;
case NC_COMPOUND:
sublist = builddatalist(listlength(tvsym->subnodes));
for(i=0;i<listlength(tvsym->subnodes);i++) {
Symbol* field = (Symbol*)listget(tvsym->subnodes,i);
if(field->typ.dimset.ndims > 0) {
fillarray(field->typ.basetype,&field->typ.dimset,0,filler);
} else
filllist(field->typ.basetype,sublist);
}
con = builddatasublist(sublist);
break;
case NC_VLEN:
sublist = builddatalist(0);
filllist(tvsym->typ.basetype,sublist); /* generate a single instance*/
con = builddatasublist(sublist);
break;
default: PANIC1("fill: unexpected subclass %d",tvsym->subclass);
}
dlappend(filler,&con);
}
/* clisnew - initialize a new class */
LVAL clisnew(void)
{
LVAL self,ivars,cvars,super;
int n;
/* get self, the ivars, cvars and superclass */
self = xlgaobject();
ivars = xlgalist();
cvars = (moreargs() ? xlgalist() : NIL);
super = (moreargs() ? xlgaobject() : object);
xllastarg();
/* store the instance and class variable lists and the superclass */
setivar(self,IVARS,ivars);
setivar(self,CVARS,cvars);
setivar(self,CVALS,(cvars ? newvector(listlength(cvars)) : NIL));
setivar(self,SUPERCLASS,super);
/* compute the instance variable count */
n = listlength(ivars);
setivar(self,IVARCNT,cvfixnum((FIXTYPE)n));
n += getivcnt(super,IVARTOTAL);
setivar(self,IVARTOTAL,cvfixnum((FIXTYPE)n));
/* return the new class object */
return (self);
}
static void
filllist(Symbol* tsym, Datalist* dl)
{
int i;
Datalist* sublist;
NCConstant con;
con.filled = 0;
ASSERT(tsym->objectclass == NC_TYPE);
switch (tsym->subclass) {
case NC_ENUM: case NC_OPAQUE: case NC_PRIM:
con.nctype = tsym->typ.typecode;
nc_getfill(&con);
dlappend(dl,&con);
break;
case NC_COMPOUND:
sublist = builddatalist(listlength(tsym->subnodes));
for(i=0;i<listlength(tsym->subnodes);i++) {
Symbol* field = (Symbol*)listget(tsym->subnodes,i);
filllist(field->typ.basetype,sublist);
}
con = builddatasublist(sublist);
dlappend(dl,&con);
break;
case NC_VLEN:
sublist = builddatalist(0);
filllist(tsym->typ.basetype,sublist); /* generate a single instance*/
con = builddatasublist(sublist);
dlappend(dl,&con);
break;
default: PANIC1("fill: unexpected subclass %d",tsym->subclass);
}
}
List*
prefixdup(List* prefix)
{
List* dupseq;
int i;
if(prefix == NULL) return listnew();
dupseq = listnew();
listsetalloc(dupseq,listlength(prefix));
for(i=0;i<listlength(prefix);i++) listpush(dupseq,listget(prefix,i));
return dupseq;
}
/*
Compute the fqn for every top-level definition symbol
*/
static void
computefqns(void)
{
unsigned long i,j;
/* Groups first */
for(i=0;i<listlength(grpdefs);i++) {
Symbol* sym = (Symbol*)listget(grpdefs,i);
topfqn(sym);
}
/* Dimensions */
for(i=0;i<listlength(dimdefs);i++) {
Symbol* sym = (Symbol*)listget(dimdefs,i);
topfqn(sym);
}
/* types */
for(i=0;i<listlength(typdefs);i++) {
Symbol* sym = (Symbol*)listget(typdefs,i);
topfqn(sym);
}
/* variables */
for(i=0;i<listlength(vardefs);i++) {
Symbol* sym = (Symbol*)listget(vardefs,i);
topfqn(sym);
}
/* fill in the fqn names of econsts */
for(i=0;i<listlength(typdefs);i++) {
Symbol* sym = (Symbol*)listget(typdefs,i);
if(sym->subclass == NC_ENUM) {
for(j=0;j<listlength(sym->subnodes);j++) {
Symbol* econ = (Symbol*)listget(sym->subnodes,j);
nestedfqn(econ);
}
}
}
/* fill in the fqn names of fields */
for(i=0;i<listlength(typdefs);i++) {
Symbol* sym = (Symbol*)listget(typdefs,i);
if(sym->subclass == NC_COMPOUND) {
for(j=0;j<listlength(sym->subnodes);j++) {
Symbol* field = (Symbol*)listget(sym->subnodes,j);
nestedfqn(field);
}
}
}
/* fill in the fqn names of attributes */
for(i=0;i<listlength(gattdefs);i++) {
Symbol* sym = (Symbol*)listget(gattdefs,i);
attfqn(sym);
}
for(i=0;i<listlength(attdefs);i++) {
Symbol* sym = (Symbol*)listget(attdefs,i);
attfqn(sym);
}
}
static void
processtypesizes(void)
{
int i;
/* use touch flag to avoid circularity*/
for(i=0;i<listlength(typdefs);i++) {
Symbol* tsym = (Symbol*)listget(typdefs,i);
tsym->touched = 0;
}
for(i=0;i<listlength(typdefs);i++) {
Symbol* tsym = (Symbol*)listget(typdefs,i);
computesize(tsym); /* this will recurse*/
}
}
int
prefixeq(List* x1, List* x2)
{
Symbol** l1;
Symbol** l2;
int len,i;
if((len=listlength(x1)) != listlength(x2)) return 0;
l1=(Symbol**)listcontents(x1);
l2=(Symbol**)listcontents(x2);
for(i=0;i<len;i++) {
if(strcmp(l1[i]->name,l2[i]->name) != 0) return 0;
}
return 1;
}
void
processvars(void)
{
int i,j;
for(i=0;i<listlength(vardefs);i++) {
Symbol* vsym = (Symbol*)listget(vardefs,i);
Symbol* basetype = vsym->typ.basetype;
/* If we are in classic mode, then convert long -> int32 */
if(usingclassic) {
if(basetype->typ.typecode == NC_LONG || basetype->typ.typecode == NC_INT64) {
vsym->typ.basetype = primsymbols[NC_INT];
basetype = vsym->typ.basetype;
}
}
/* fill in the typecode*/
vsym->typ.typecode = basetype->typ.typecode;
/* validate uses of NIL */
validateNIL(vsym);
for(j=0;j<vsym->typ.dimset.ndims;j++) {
/* validate the dimensions*/
/* UNLIMITED must only be in first place if using classic */
if(vsym->typ.dimset.dimsyms[j]->dim.declsize == NC_UNLIMITED) {
if(usingclassic && j != 0)
semerror(vsym->lineno,"Variable: %s: UNLIMITED must be in first dimension only",fullname(vsym));
}
}
}
}
void
dumpgroup(Symbol* g)
{
if(debug <= 1) return;
fdebug("group %s {\n",(g==NULL?"null":g->name));
if(g != NULL && g->subnodes != NULL) {
int i;
for(i=0;i<listlength(g->subnodes);i++) {
Symbol* sym = (Symbol*)listget(g->subnodes,i);
char* tname;
if(sym->objectclass == NC_PRIM
|| sym->objectclass == NC_TYPE) {
tname = nctypename(sym->subclass);
} else
tname = nctypename(sym->objectclass);
fdebug(" %3d: %s\t%s\t%s\n",
i,
sym->name,
tname,
(sym->ref.is_ref?"ref":"")
);
}
}
fdebug("}\n");
}
static int
bin_reclaim_compound(Symbol* tsym, Reclaim* reclaimer)
{
int stat = NC_NOERR;
int nfields;
size_t fid, i, arraycount;
ptrdiff_t saveoffset;
reclaimer->offset = read_alignment(reclaimer->offset,tsym->typ.cmpdalign);
saveoffset = reclaimer->offset;
/* Get info about each field in turn and reclaim it */
nfields = listlength(tsym->subnodes);
for(fid=0;fid<nfields;fid++) {
Symbol* field = listget(tsym->subnodes,fid);
int ndims = field->typ.dimset.ndims;
/* compute the total number of elements in the field array */
for(i=0;i<ndims;i++) arraycount *= field->typ.dimset.dimsyms[i]->dim.declsize;
reclaimer->offset = read_alignment(reclaimer->offset,field->typ.alignment);
for(i=0;i<arraycount;i++) {
if((stat = bin_reclaim_datar(field->typ.basetype, reclaimer))) goto done;
}
}
reclaimer->offset = saveoffset;
reclaimer->offset += tsym->typ.size;
done:
return stat;
}
Handle_ptr DefineCommand::execute( Context &ctx, Environment *env, Handle_ptr expr)
{
MCAssertValidInstance();
if (3 != listlength( expr))
throw ArgumentCountException( 3, __FILE__, __LINE__);
Handle_ptr args = expr->cdr();
if (args->car()->hasType( Handle::ntSYMBOL)) {
// Variablenbindung
ctx.toplevel->put( args->car()->stringValue(),
ctx.eval->eval( args->cdr()->car()));
return args->car();
} else {
if (args->car()->hasType( Handle::ntCONS) && !args->car()->isNilRep()) {
// Funktionsdefinition
std::cerr << "error: function definitions aren't supported right now" << std::endl;
return ctx.NIL;
} else
throw TypeException( "symbol or list", __FILE__, __LINE__);
}
MCAssertNotReached( 0);
return 0;
}
static void
processunlimiteddims(void)
{
int i;
/* Set all unlimited dims to size 0; */
for(i=0;i<listlength(dimdefs);i++) {
Symbol* dim = (Symbol*)listget(dimdefs,i);
if(dim->dim.isunlimited)
dim->dim.declsize = 0;
}
/* Walk all variables */
for(i=0;i<listlength(vardefs);i++) {
Symbol* var = (Symbol*)listget(vardefs,i);
int first,ischar;
Dimset* dimset = &var->typ.dimset;
if(dimset->ndims == 0) continue; /* ignore scalars */
if(var->data == NULL) continue; /* no data list to walk */
ischar = (var->typ.basetype->typ.typecode == NC_CHAR);
first = findunlimited(dimset,0);
if(first == dimset->ndims) continue; /* no unlimited dims */
if(first == 0) {
computeunlimitedsizes(dimset,first,var->data,ischar);
} else {
int j;
for(j=0;j<var->data->length;j++) {
NCConstant* con = var->data->data[j];
if(con->nctype != NC_COMPOUND)
semerror(con->lineno,"UNLIMITED dimension (other than first) must be enclosed in {}");
else
computeunlimitedsizes(dimset,first,con->value.compoundv,ischar);
}
}
}
#ifdef GENDEBUG1
/* print unlimited dim size */
if(listlength(dimdefs) == 0)
fprintf(stderr,"unlimited: no unlimited dimensions\n");
else for(i=0;i<listlength(dimdefs);i++) {
Symbol* dim = (Symbol*)listget(dimdefs,i);
if(dim->dim.isunlimited)
fprintf(stderr,"unlimited: %s = %lu\n",
dim->name,
(unsigned long)dim->dim.declsize);
}
#endif
}
static void cparams(JF, js_Ast *list)
{
F->numparams = listlength(list);
while (list) {
addlocal(J, F, list->a, 0);
list = list->b;
}
}
static int
checkfill(Symbol* tsym, Datasrc* src)
{
int i,iscmpd,result;
Constant* con;
Symbol* original = tsym;
result = 1;
switch (tsym->subclass) {
case NC_ENUM: case NC_OPAQUE: case NC_PRIM:
con = srcnext(src);
if(src == NULL) {
semerror(srcline(src),"%s: malformed _FillValue",original->name);
result = 0;
} else if(con->nctype != tsym->typ.typecode) result = 0; /* wrong type*/
break;
case NC_COMPOUND:
if(!issublist(src)) {/* fail on no compound*/
semerror(srcline(src),"Compound constants must be enclosed in {..}");
}
srcpush(src);
for(i=0;i<listlength(tsym->subnodes);i++) {
Symbol* field = (Symbol*)listget(tsym->subnodes,i);
result = checkfill(field,src,original);
if(!result) break;
}
srcpop(src);
break;
case NC_VLEN:
if(!issublist(src)) {
semerror(srcline(src),"%s: vlen instances in _FillValue must be enclosed in {...}",original->name);
result = 0;
} else {
srcpush(src);
while(srcmore(src)) {
result = checkfill(tsym->typ.basetype,src,original);
if(!result) break;
}
srcpop(src);
}
break;
case NC_FIELD:
/* Braces are optional */
if((iscmpd=issublist(src))) srcpush(src);
if(tsym->typ.dimset.ndims > 0) {
result = checkarray(tsym->typ.basetype,&tsym->typ.dimset,0,src,original,!TOPLEVEL);
} else
result = checkfill(tsym->typ.basetype,src,original);
if(iscmpd) srcpop(src);
break;
default: PANIC1("checkfillvalue: unexpected subclass %d",tsym->subclass);
}
return result;
}
int
listcontains(List* l, void* elem)
{
unsigned long i;
for(i=0;i<listlength(l);i++) {
if(elem == listget(l,i)) return 1;
}
return 0;
}
static void
processspecials(void)
{
int i;
for(i=0;i<listlength(vardefs);i++) {
Symbol* vsym = (Symbol*)listget(vardefs,i);
processspecial1(vsym);
}
}
static void
validate(void)
{
int i;
for(i=0;i<listlength(vardefs);i++) {
Symbol* sym = (Symbol*)listget(vardefs,i);
if(sym->var.special._Fillvalue != NULL) {
}
}
}
/* Make sure all typecodes are set if basetype is set*/
static void
filltypecodes(void)
{
int i;
for(i=0;i<listlength(symlist);i++) {
Symbol* sym = listget(symlist,i);
if(sym->typ.basetype != NULL && sym->typ.typecode == NC_NAT)
sym->typ.typecode = sym->typ.basetype->typ.typecode;
}
}
/* index of match */
static int
verify(List* all, Datalist* dl)
{
int i;
for(i=0;i<listlength(all);i++) {
void* pi = listget(all,i);
if(pi == dl)
return i;
}
return -1;
}
bool_t
varchunkspec_exists(int igrpid, int ivarid)
{
int i;
for(i=0;i<listlength(varchunkspecs);i++) {
struct VarChunkSpec* spec = listget(varchunkspecs,i);
if(spec->igrpid == igrpid && spec->ivarid == ivarid)
return true;
}
return false;
}
bool_t
varchunkspec_omit(int igrpid, int ivarid)
{
int i;
for(i=0;i<listlength(varchunkspecs);i++) {
struct VarChunkSpec* spec = listget(varchunkspecs,i);
if(spec->igrpid == igrpid && spec->ivarid == ivarid)
return spec->omit;
}
return dimchunkspecs.omit;
}
Handle_ptr IfCommand::execute( Context &ctx, Environment *env, Handle_ptr expr)
{
Handle_ptr args = expr->cdr();
if (3 != listlength( args))
throw ArgumentCountException( 3, __FILE__, __LINE__);
if (ctx.eval->eval( args->car()) != ctx.FALSE)
return ctx.eval->eval( args->cdr()->car());
else
return ctx.eval->eval( args->cdr()->cdr()->car());
}
size_t*
varchunkspec_chunksizes(int igrpid, int ivarid)
{
int i;
for(i=0;i<listlength(varchunkspecs);i++) {
struct VarChunkSpec* spec = listget(varchunkspecs,i);
if(spec->igrpid == igrpid && spec->ivarid == ivarid)
return spec->chunksizes;
}
return NULL;
}
size_t
varchunkspec_rank(int igrpid, int ivarid)
{
int i;
for(i=0;i<listlength(varchunkspecs);i++) {
struct VarChunkSpec* spec = listget(varchunkspecs,i);
if(spec->igrpid == igrpid && spec->ivarid == ivarid)
return spec->rank;
}
return 0;
}
static Symbol*
checkeconst(Symbol* en, const char* refname)
{
int i;
for(i=0;i<listlength(en->subnodes);i++) {
Symbol* ec = (Symbol*)listget(en->subnodes,i);
if(strcmp(ec->name,refname) == 0)
return ec;
}
return NULL;
}
static int
sqContains(List* seq, Symbol* sym)
{
int i;
if(seq == NULL) return 0;
for(i=0;i<listlength(seq);i++) {
Symbol* sub = (Symbol*)listget(seq,i);
if(sub == sym) return 1;
}
return 0;
}
/* Find name within group structure*/
Symbol*
lookupgroup(List* prefix)
{
#ifdef USE_NETCDF4
if(prefix == NULL || listlength(prefix) == 0)
return rootgroup;
else
return (Symbol*)listtop(prefix);
#else
return rootgroup;
#endif
}
