dump() { FRAME *frp; ADDRESS prevpc; LINENO line; SYM *f; if (pc == 0) { error("program is not active"); } prevpc = pc; for (frp = curframe(); frp != NIL; frp = nextframe(frp)) { f = whatblock(entry(frp)); line = srcline(prevpc); printf("%s", name(f)); printparams(f, frp); printf(", "); printwhere(line, srcfilename(prevpc)); printf("\n"); dumpvars(f, frp); putchar('\n'); prevpc = frp->save_pc; } line = srcline(prevpc); printf("%s, ", name(program)); printwhere(line, srcfilename(prevpc)); printf("\n"); dumpvars(program, NIL); }
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; }
static void genbin_data(Symbol* tsym, Datasrc* datasrc, Datalist* fillsrc, Bytebuffer* memory) { int usecmpd; Constant* con = srcpeek(datasrc); if(con == NULL || con->nctype == NC_FILLVALUE) { srcnext(datasrc); genbin_fillvalue(tsym,fillsrc,datasrc,memory); return; } switch (tsym->subclass) { case NC_ENUM: case NC_OPAQUE: case NC_PRIM: if(issublist(datasrc)) { semerror(srcline(datasrc),"Expected primitive found {..}"); } genbin_primdata(tsym,datasrc,fillsrc,memory); break; case NC_COMPOUND: genbin_compound(tsym,datasrc,fillsrc,memory); break; case NC_VLEN: { Constant* cp; nc_vlen_t ptr; if(!issublist(datasrc)) { semerror(srcline(datasrc),"Vlen data must be enclosed in {..}"); } cp = srcnext(datasrc); /* generate the nc_vlen_t instance*/ ptr.p = vlendata[cp->value.compoundv->vlen.uid].data; ptr.len = vlendata[cp->value.compoundv->vlen.uid].count; bbAppendn(memory,(char*)&ptr,sizeof(ptr)); } break; case NC_FIELD: /* enclose in braces if and only if field is an array */ usecmpd = (issublist(datasrc) && tsym->typ.dimset.ndims > 0); if(usecmpd) srcpush(datasrc); if(tsym->typ.dimset.ndims > 0) { genbin_fieldarray(tsym->typ.basetype,datasrc,&tsym->typ.dimset,0,memory); } else { genbin_data(tsym->typ.basetype,datasrc,NULL,memory); } if(usecmpd) srcpop(datasrc); break; default: PANIC1("genbin_data: unexpected subclass %d",tsym->subclass); } }
void gen_charattr(Symbol* asym, Bytebuffer* databuf) { Datasrc* src; Constant* con; if(asym->data == NULL) return; src = datalist2src(asym->data); while((con=srcnext(src))) { switch (con->nctype) { /* Following list should be consistent with isstringable */ case NC_CHAR: bbAppend(databuf,con->value.charv); break; case NC_BYTE: bbAppend(databuf,con->value.int8v); break; case NC_UBYTE: bbAppend(databuf,con->value.uint8v); break; case NC_STRING: bbCat(databuf,con->value.stringv.stringv); bbNull(databuf); break; case NC_FILL: bbAppend(databuf,NC_FILL_CHAR); break; default: semerror(srcline(src), "Encountered non-string constant in attribute: %s", asym->name); return; } } }
printerror() { register PROCESS *p; char *filename; int c; p = process; if (p->signo != ESIGNAL && p->signo != SIGINT) { error("signal %d at px pc %d, lc %d", p->signo, p->pc, pc); } curline = srcline(pc); curfunc = whatblock(pc); skimsource(srcfilename(pc)); if (p->signo == ESIGNAL) { printf("\nerror at "); printwhere(curline, cursource); if (errnum != 0) { printf(": %s", pxerrmsg[errnum]); } } else { printf("\n\ninterrupt at "); printwhere(curline, cursource); } putchar('\n'); printlines(curline, curline); erecover(); }
static void genbin_arraydatar(Symbol* vsym, Bytebuffer* memory, nciter_t iter, Iterodom* iterodom, int index) { int i; int rank = iterodom->rank; int lastdim = (index == (rank - 1)); /* last dimension*/ int firstdim = (index == 0); int declsize = odom->dims[index].declsize; int isunlimited = (declsize == 0); Symbol* basetype = vsym->typ.basetype; Datalist* fillsrc = vsym->var.special._Fillvalue; Constant* con; ASSERT(index >= 0 && index < rank); odom->dims[index].index = 0; /* reset*/ if(isunlimited) { Constant* con; if(!firstdim) { if(!issublist(src)) { semerror(srcline(src),"Unlimited data must be enclosed in {..}"); return; } srcpush(src); /* enter the unlimited data */ } while((con=srcpeek(src))!=NULL) { if(lastdim) { genbin_data(basetype,src,fillsrc,memory); } else { genbin_arraydatar(vsym,src,odom,index+1, checkpoint,memory); } odom->dims[index].index++; if(docheckpoint) { closure->putvar(closure,odom,memory); } } odom->dims[index].datasize = odom->dims[index].index; if(!firstdim) srcpop(src); } else { /* !isunlimited*/ for(i=0;i<declsize;i++) { con = srcpeek(src); if(lastdim) { genbin_data(basetype,src,fillsrc,memory); } else { /* ! lastdim*/ (void)genbin_arraydatar(vsym,src,odom, index+1,checkpoint,memory); } odom->dims[index].index++; if(docheckpoint) { closure->putvar(closure,odom,memory); } } } }
void gen_charfield(Datasrc* src, Odometer* odom, int index, Bytebuffer* fieldbuf) { int i; int lastdim = (index == (odom->rank - 1)); size_t declsize = odom->declsize[index]; Constant* con; ASSERT(declsize != 0); if(lastdim) { for(i=0;i<declsize;) { con = srcnext(src); if(con == NULL) break; if(!isstringable(con->nctype)) { semerror(srcline(src), "Encountered non-string constant in compound field"); return; } i += collectstring(con,declsize,fieldbuf); } if(i < declsize) i=fillstring(declsize,i,fieldbuf); } else { /* ! lastdim*/ int exploded = 0; size_t slicesize; /* Compute subslice size */ slicesize = 1; for(i=index+1;i<odom->rank;i++) slicesize *= MAX(odom->declsize[i],odom->unlimitedsize[i]); con = srcpeek(src); if(con != NULL && !isstringable(con->nctype)) { semerror(srcline(src), "Encountered non-string constant in compound field"); return; } if(con != NULL && con->value.stringv.len > slicesize) { /* Constant is larger than just our slice */ /* Explode the constant into subchunks */ exploded = stringexplode(src,slicesize); } for(i=0;i<declsize;i++) { gen_charfield(src,odom,index+1,fieldbuf); } if(exploded) srcpop(src); } }
static int stringexplode(Datasrc* src, size_t chunksize) { Constant* con; Datalist* charlist; if(!isstring(src)) return 0; con = srcnext(src); charlist = buildstringlist(con->value.stringv.stringv,chunksize,srcline(src)); srcpushlist(src,charlist); return 1; }
/* Specialty wrappers for genbin_data */ void genbin_attrdata(Symbol* asym, Bytebuffer* memory) { Datasrc* src; int chartype = (asym->typ.basetype->typ.typecode == NC_CHAR); if(asym->data == NULL) return; if(chartype) {gen_charattr(asym,memory); return;} src = datalist2src(asym->data); while(srcmore(src)) { genbin_data(asym->typ.basetype,src,NULL,memory); } } #if 0 /* Apparently not used */ void genbin_scalardata(Symbol* vsym, Bytebuffer* memory) { Datasrc* src; if(vsym->data == NULL) return; src = datalist2src(vsym->data); genbin_data(vsym->typ.basetype,src, vsym->var.special._Fillvalue,memory); if(srcmore(src)) { semerror(srcline(src),"Extra data at end of datalist"); } }
/* Generate an instance of the basetype using datasrc */ void f77data_basetype(Symbol* tsym, Datasrc* datasrc, Bytebuffer* codebuf, Datalist* fillsrc) { switch (tsym->subclass) { case NC_PRIM: if(issublist(datasrc)) { semerror(srcline(datasrc),"Expected primitive found {..}"); } bbAppend(codebuf,' '); f77data_primdata(tsym,datasrc,codebuf,fillsrc); break; default: PANIC1("f77data_basetype: unexpected subclass %d",tsym->subclass); } }
static int checkarray(Symbol* basetype, Dimset* dimset, int index, Datasrc* src, Symbol* original, int toplevel) { int i,result; Symbol* dim = dimset->dimsyms[index]; unsigned int size = dim->dim.declsize; int lastdim = (index == (dimset->ndims - 1)); int isunlimited = (size == 0); result = 1; if(isunlimited) { if(!toplevel) { if(!issublist(src)) { semerror(srcline(src),"UNLIMITED dimension constants (other than top level) must be enclosed in {...}"); result = 0; goto done; } else srcpush(src); } if(lastdim) { while(srcmore(src) && result) { result = checkfill(basetype,src,original); } } else { /*!lastdim*/ while(srcmore(src) && result) { result = checkarray(basetype,dimset,index+1,src,original,toplevel); } } } else { /* bounded*/ if(lastdim) { for(i=0;i<size && result;i++) { result = checkfill(basetype,src,original); } } else { /* !lastdim*/ for(i=0;i<size && result;i++) { result = checkarray(basetype,dimset,index+1,src,original,toplevel); } } } done: return result; }
void gen_charvlen(Datasrc* vlensrc, Bytebuffer* databuf) { int count; Bytebuffer* vlenbuf = bbNew(); Constant* con; count = 0; while((con=srcnext(vlensrc)) != NULL) { if(!isstringable(con->nctype)) { semerror(srcline(vlensrc), "Encountered non-string constant in vlen constant"); goto done; } count += collectstring(con,0,vlenbuf); } done: bbFree(vlenbuf); }
printnews() { if (ss_variables) { prvarnews(); } if (trcond()) { if (ss_lines && curline > 0) { skimsource(srcfilename(pc)); printf("trace: "); printlines(curline, curline); } if (ss_instructions) { printf("inst trace: "); printinst(pc, pc); } } bpact(); if (stopcond()) { isstopped = TRUE; curline = srcline(pc); printstatus(); } }
/* Used for compound instances */ static void genbin_compound(Symbol* tsym, Datasrc* datasrc, Datalist* fillsrc, Bytebuffer* memory) { int i; int base = bblength(memory); if(!issublist(datasrc)) { semerror(srcline(datasrc),"Compound data must be enclosed in {..}"); } /* Use this datasrc list to get values for compound fields */ srcpush(datasrc); for(i=0;i<listlength(tsym->subnodes);i++) { Symbol* field = (Symbol*)listget(tsym->subnodes,i); if(!srcmore(datasrc)) { /* generate a fill value*/ Datalist* fillsrc = getfiller(tsym); genbin_data(field,datasrc,fillsrc,memory); } else genbin_data(field,datasrc,NULL,memory); } srcpop(datasrc); /* Re: github issue 323: we may need to pad the end of the structure to make its size be a multiple of the largest alignment. */ alignto(tsym->cmpdalignment,buf,base); }
static void gen_chararraysuffix(Symbol* vsym, Bytebuffer* databuf, Datasrc* src, Odometer* odom, int index) { int i; int rank = odom->rank; int lastdim = (index == (rank - 1)); /* last dimension*/ int firstdim = (index == 0); size_t declsize = odom->declsize[index]; int isunlimited = (declsize==NC_UNLIMITED); Constant* con; ASSERT(index >= 0 && index < rank); odom->index[index] = odom->start[index]; /* reset*/ con = srcpeek(src); if(!isunlimited) { if(con != NULL && !isstringable(con->nctype)) { semerror(srcline(src), "Encountered non-string constant in char data: %s", vsym->name); return; } if(lastdim) { /* To mimic ncgen original, it appears we have to hack. I think firstdim==lastdim may work. */ for(i=0;i<declsize;) { int slen; con = srcnext(src); if(con == NULL) break; slen = collectstring(con,declsize,databuf); if(!firstdim && slen < declsize) slen=fillstring(declsize,slen,databuf); i += slen; } if(firstdim && i < declsize) i = fillstring(declsize,i,databuf); odom->index[index] = i; } else { /* ! lastdim*/ int exploded = 0; size_t slicesize = odometertotal(odom,index+1); if(con != NULL && con->nctype == NC_STRING && con->value.stringv.len > slicesize) { /* Constant is larger than just our slice */ /* Explode the constant into subchunks */ exploded = stringexplode(src,slicesize); } for(i=0;i<odom->declsize[index];i++) { gen_chararraysuffix(vsym,databuf,src,odom,index+1); odom->index[index]++; } if(exploded) srcpop(src); } } else { /* unlimited => lastdim*/ Constant* con; if(!firstdim) { if(!issublist(src)) { semerror(srcline(src),"Unlimited data must be enclosed in {..}"); return; } srcpush(src); /* enter the unlimited data */ } /* Basically, collect all the strings until we run out */ i = 0; while((con=srcnext(src))!=NULL) { i += collectstring(con,0,databuf); } odom->index[index] = i; odom->unlimitedsize[index] = odom->index[index]; if(!firstdim) srcpop(src); } }
/* Generate an instance of the basetype using datasrc */ void cdata_basetype(Symbol* tsym, Datasrc* datasrc, Bytebuffer* codebuf, Datalist* fillsrc) { int usecmpd; switch (tsym->subclass) { case NC_ENUM: case NC_OPAQUE: case NC_PRIM: if(issublist(datasrc)) { semerror(srcline(datasrc),"Expected primitive found {..}"); } bbAppend(codebuf,' '); cdata_primdata(tsym,datasrc,codebuf,fillsrc); break; case NC_COMPOUND: { int i; Constant* con; if(!isfillvalue(datasrc) && !issublist(datasrc)) {/* fail on no compound*/ semerror(srcline(datasrc),"Compound data must be enclosed in {..}"); } con = srcnext(datasrc); if(con->nctype == NC_FILLVALUE) { Datalist* filler = getfiller(tsym,fillsrc); ASSERT(filler->length == 1); con = &filler->data[0]; if(con->nctype != NC_COMPOUND) { semerror(con->lineno,"Compound data fill value is not enclosed in {..}"); } } srcpushlist(datasrc,con->value.compoundv); /* enter the sublist*/ bbAppend(codebuf,'{'); for(i=0;i<listlength(tsym->subnodes);i++) { Symbol* field = (Symbol*)listget(tsym->subnodes,i); bbAppend(codebuf,' '); cdata_basetype(field,datasrc,codebuf,NULL); } bbAppend(codebuf,'}'); srcpop(datasrc); } break; case NC_VLEN: { Constant* con; if(!isfillvalue(datasrc) && !issublist(datasrc)) {/* fail on no compound*/ semerror(con->lineno,"Vlen data must be enclosed in {..}"); } con = srcnext(datasrc); if(con->nctype == NC_FILLVALUE) { Datalist* filler = getfiller(tsym,fillsrc); ASSERT(filler->length == 1); con = &filler->data[0]; if(con->nctype != NC_COMPOUND) { semerror(con->lineno,"Vlen data fill value is not enclosed in {..}"); } } /* generate the nc_vlen_t instance*/ bbprintf0(stmt,"{%u (void*)vlen_%u}", con->value.compoundv->vlen.count, con->value.compoundv->vlen.uid); bbCatbuf(codebuf,stmt); } break; case NC_FIELD: /* enclose in braces if and only if field is an array */ usecmpd = (issublist(datasrc) && tsym->typ.dimset.ndims > 0); if(usecmpd) srcpush(datasrc); if(tsym->typ.dimset.ndims > 0) { Odometer* fullodom = newodometer(&tsym->typ.dimset,NULL,NULL); cdata_fieldarray(tsym->typ.basetype,datasrc,fullodom,0,codebuf); odometerfree(fullodom); } else { cdata_basetype(tsym->typ.basetype,datasrc,codebuf,NULL); } if(usecmpd) srcpop(datasrc); break; default: PANIC1("cdata_basetype: unexpected subclass %d",tsym->subclass); } }
void gen_chararray(Symbol* vsym, Bytebuffer* databuf, Datasrc* src, Odometer* odom, int index) { /* Assume that all dimensions from index+1 to rank-1 are !unlimited */ int i; int rank = odom->rank; int lastdim = (index == (rank - 1)); /* last dimension*/ int firstdim = (index == 0); int isunlimited = (odom->declsize[index] == NC_UNLIMITED); int exploded = 0; Constant* con; if(lastdim) { gen_chararraysuffix(vsym,databuf,src,odom,index); return; } ASSERT(index >= 0 && index < rank); odom->index[index] = odom->start[index]; /* reset */ if(isunlimited) { size_t slicesize; Constant* con; if(!firstdim) { if(!issublist(src)) { semerror(srcline(src),"Unlimited data must be enclosed in {..}"); return; } srcpush(src); /* enter the unlimited data */ } con=srcpeek(src); /* Break up the constant if it is too large */ slicesize = odomsubarray(odom,index+1); if(con != NULL && con->value.stringv.len > slicesize) { /* Constant is larger than just our slice */ /* Explode the constant into subchunks */ exploded = stringexplode(src,slicesize); } while((con=srcpeek(src))!=NULL) { gen_chararray(vsym,databuf,src,odom,index+1); odom->index[index]++; } odom->unlimitedsize[index] = odom->index[index]; if(exploded) srcpop(src); if(!firstdim) srcpop(src); } else { /* !isunlimited*/ size_t slicesize; con = srcpeek(src); ASSERT(!lastdim); /* Break up the constant if it is too large */ slicesize = odomsubarray(odom,index+1); if(con != NULL && con->value.stringv.len > slicesize) { /* Constant is larger than just our slice */ /* Explode the constant into subchunks */ exploded = stringexplode(src,slicesize); } for(i=0;i<odom->declsize[index];i++) { gen_chararray(vsym,databuf,src,odom,index+1); } if(exploded) srcpop(src); } }