/* 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;
}
