char* decodify(const char *name0) { const unsigned char *cp; unsigned int c; char* name; if(init == 0) initdecodify(); bbClear(newname); cp = (const unsigned char*) name0; if('0' <= *cp && *cp <= '9') { /* handle initial digit, if any */ char tmp[16]; snprintf(tmp,sizeof(tmp),"DIGIT_%c_", *cp); bbCat(newname,tmp); cp++; } while((c=*cp++)) { /* copy name to newname, replacing special chars */ ASSERT(c <= 256); bbCat(newname,repls[c]); } /* If FORTRAN, remove leading _, if any */ name = bbContents(newname); if(bbGet(newname,0) == '_') name++; return pooldup(name); }
/* Result is pool'd*/ char* prefixtostring(List* prefix, char* separator) { int slen=0; int plen; int i; char* result; if(prefix == NULL) return pooldup(""); plen = prefixlen(prefix); if(plen == 0) { /* root prefix*/ slen=0; /* slen += strlen(separator);*/ slen++; /* for null terminator*/ result = poolalloc(slen); result[0] = '\0'; /*strcat(result,separator);*/ } else { for(i=0;i<plen;i++) { Symbol* sym = (Symbol*)listget(prefix,i); slen += (strlen(separator)+strlen(sym->name)); } slen++; /* for null terminator*/ result = poolalloc(slen); result[0] = '\0'; for(i=0;i<plen;i++) { Symbol* sym = (Symbol*)listget(prefix,i); strcat(result,separator); strcat(result,sym->name); /* append "/<prefix[i]>"*/ } } return result; }
char* xescapify(char* s0, int quote, size_t len) { int i; char* result; Bytebuffer* escaped = bbNew(); for(i=0;i<len;i++) { xescapifychar((unsigned int)s0[i],quote,escaped); } result = pooldup(bbContents(escaped)); bbFree(escaped); return result; }
/* Result is a pool string or a constant => do not free*/ char* f77data_const(Constant* ci) { char tmp[64]; char* result = NULL; tmp[0] = '\0'; switch (ci->nctype) { case NC_CHAR: { strcpy(tmp,"'"); escapifychar(ci->value.charv,tmp+1,'\''); strcat(tmp,"'"); } break; case NC_BYTE: sprintf(tmp,"%hhd",ci->value.int8v); break; case NC_SHORT: sprintf(tmp,"%hd",ci->value.int16v); break; case NC_INT: sprintf(tmp,"%d",ci->value.int32v); break; case NC_FLOAT: sprintf(tmp,"%.8g",ci->value.floatv); break; case NC_DOUBLE: { char* p = tmp; /* FORTRAN requires e|E->D */ sprintf(tmp,"%.16g",ci->value.doublev); while(*p) {if(*p == 'e' || *p == 'E') {*p = 'D';}; p++;} } break; case NC_STRING: { Bytebuffer* buf = bbNew(); bbAppendn(buf,ci->value.stringv.stringv,ci->value.stringv.len); f77quotestring(buf); result = bbDup(buf); bbFree(buf); goto done; } break; default: PANIC1("ncstype: bad type code: %d",ci->nctype); } result = pooldup(tmp); done: return result; /*except for NC_STRING and NC_OPAQUE*/ }
/* Result is a pool string or a constant => do not free*/ char* cdata_const(Constant* ci) { Bytebuffer* codetmp = bbNew(); char* result; switch (ci->nctype) { case NC_CHAR: { char tmp[64]; tmp[0] = '\0'; escapifychar(ci->value.charv,tmp,'\''); bbCat(codetmp,"'"); bbCat(codetmp,tmp); bbCat(codetmp,"'"); } break; case NC_BYTE: bbprintf(codetmp,"%hhd",ci->value.int8v); break; case NC_SHORT: bbprintf(codetmp,"%hd",ci->value.int16v); break; case NC_INT: bbprintf(codetmp,"%d",ci->value.int32v); break; case NC_FLOAT: bbprintf(codetmp,"%f",ci->value.floatv); break; case NC_DOUBLE: bbprintf(codetmp,"%lf",ci->value.doublev); break; case NC_UBYTE: bbprintf(codetmp,"%hhu",ci->value.uint8v); break; case NC_USHORT: bbprintf(codetmp,"%hu",ci->value.uint16v); break; case NC_UINT: bbprintf(codetmp,"%uU",ci->value.uint32v); break; case NC_INT64: bbprintf(codetmp,"%lldLL",ci->value.int64v); break; case NC_UINT64: bbprintf(codetmp,"%lluLLU",ci->value.uint64v); break; case NC_ECONST: bbprintf(codetmp,"%s",cname(ci->value.enumv)); break; case NC_STRING: { /* handle separately */ char* escaped = escapify(ci->value.stringv.stringv, '"',ci->value.stringv.len); result = poolalloc(1+2+strlen(escaped)); strcpy(result,"\""); strcat(result,escaped); strcat(result,"\""); goto done; } break; case NC_OPAQUE: { char* p; int bslen; bslen=(4*ci->value.opaquev.len); result = poolalloc(bslen+2+1); strcpy(result,"\""); p = ci->value.opaquev.stringv; while(*p) { strcat(result,"\\x"); strncat(result,p,2); p += 2; } strcat(result,"\""); goto done; } break; default: PANIC1("ncstype: bad type code: %d",ci->nctype); } result = pooldup(bbContents(codetmp)); /*except for NC_STRING and NC_OPAQUE*/ bbFree(codetmp); done: return result; }