/* 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*/ }
static int f77_constant(Generator* generator, NCConstant* ci, Bytebuffer* codebuf,...) { char tmp[64]; char* special = NULL; switch (ci->nctype) { case NC_CHAR: if(ci->value.charv == '\'') sprintf(tmp,"'\\''"); else sprintf(tmp,"'%c'",ci->value.charv); 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); special = bbDup(buf); bbFree(buf); } break; default: PANIC1("f77data: bad type code: %d",ci->nctype); } if(special != NULL) bbCat(codebuf,special); else bbCat(codebuf,tmp); return 1; }