void PushCmplxConst( sym_id sym ) {
//============================================
// Push a complex constant.
char fmt_buff[80];
if( sym->u.cn.typ == FT_COMPLEX ) {
CnvS2S( &sym->u.cn.value.scomplex.imagpart, fmt_buff );
XPush( CGFloat( fmt_buff, TY_SINGLE ) );
CnvS2S( &sym->u.cn.value.scomplex.realpart, fmt_buff );
XPush( CGFloat( fmt_buff, TY_SINGLE ) );
} else if( sym->u.cn.typ == FT_DCOMPLEX ) {
CnvD2S( &sym->u.cn.value.dcomplex.imagpart, fmt_buff );
XPush( CGFloat( fmt_buff, TY_DOUBLE ) );
CnvD2S( &sym->u.cn.value.dcomplex.realpart, fmt_buff );
XPush( CGFloat( fmt_buff, TY_DOUBLE ) );
} else {
CnvX2S( &sym->u.cn.value.xcomplex.imagpart, fmt_buff );
XPush( CGFloat( fmt_buff, TY_LONGDOUBLE ) );
CnvX2S( &sym->u.cn.value.xcomplex.realpart, fmt_buff );
XPush( CGFloat( fmt_buff, TY_LONGDOUBLE ) );
}
}
void FCPushConst( void ) {
//=====================
// Process PUSH_CONST F-Code.
sym_id sym;
char fmt_buff[CONVERSION_BUFFER+1];
sym = GetPtr();
switch( sym->cn.typ ) {
case FT_INTEGER_1 :
case FT_INTEGER_2 :
case FT_INTEGER :
XPush( IntegerConstant( &sym->cn.value, sym->cn.size ) );
break;
case FT_LOGICAL_1 :
case FT_LOGICAL :
XPush( CGInteger( sym->cn.value.logstar4, TY_UINT_1 ) );
break;
case FT_REAL :
CnvS2S( &sym->cn.value.single, fmt_buff );
XPush( CGFloat( fmt_buff, TY_SINGLE ) );
break;
case FT_DOUBLE :
CnvD2S( &sym->cn.value.dble, fmt_buff );
XPush( CGFloat( fmt_buff, TY_DOUBLE ) );
break;
case FT_TRUE_EXTENDED :
CnvX2S( &sym->cn.value.extended, fmt_buff );
XPush( CGFloat( fmt_buff, TY_LONGDOUBLE ) );
break;
case FT_COMPLEX :
PushCmplxConst( sym );
break;
case FT_DCOMPLEX :
PushCmplxConst( sym );
break;
case FT_TRUE_XCOMPLEX :
PushCmplxConst( sym );
break;
}
}
static void DoDataInit( PTYPE var_type ) {
//==========================================
// Do data initialization.
int const_size;
int var_size;
int size;
byte *const_ptr;
segment_id seg;
seg_offset offset;
byte const_buff[sizeof(ftn_type)];
if( ( DtConstType == PT_CHAR ) || ( DtConstType == PT_NOTYPE ) ) {
const_size = DtConst->u.lt.length;
const_ptr = &DtConst->u.lt.value;
} else {
const_size = DtConst->u.cn.size;
const_ptr = (byte *)(&DtConst->u.cn.value);
}
var_size = DtItemSize;
seg = GetDataSegId( InitVar );
offset = GetDataOffset( InitVar );
DtInit( seg, offset );
if( DtConstType == PT_CHAR ) {
if( const_size >= var_size ) {
DtBytes( const_ptr, var_size );
} else {
DtBytes( const_ptr, const_size );
DtIBytes( ' ', var_size - const_size );
}
} else if( ( var_type == PT_CHAR ) && IntType( DtConstType ) ) {
DtBytes( const_ptr, sizeof( char ) );
if( var_size > sizeof( char ) ) {
DtIBytes( ' ', var_size - sizeof( char ) );
}
} else if( DtConstType == PT_NOTYPE ) {
if( var_type != PT_CHAR ) {
size = var_size;
while( size > const_size ) {
size--;
const_buff[ size ] = 0;
}
while( size > 0 ) {
size--;
const_buff[ size ] = *const_ptr;
const_ptr++;
}
const_ptr = const_buff;
const_size = var_size;
}
if( const_size < var_size ) {
DtIBytes( 0, var_size - const_size );
var_size = const_size;
} else {
const_ptr += const_size - var_size;
}
DtBytes( const_ptr, var_size );
} else if( DtConstType <= PT_LOG_4 ) {
DtBytes( const_ptr, var_size );
} else { // numeric to numeric
if( DtConstType != var_type ) {
DataCnvTab[ ( var_type - PT_INT_1 ) * CONST_TYPES +
( DtConstType - PT_INT_1 ) ]( (ftn_type *)const_ptr, (ftn_type *)&const_buff );
const_ptr = const_buff;
}
// Temporary fix for identical precision between front end and code generator.
{
char fmt_buff[CONVERSION_BUFFER+1];
float_handle cf;
if( (var_type == PT_REAL_4) || (var_type == PT_CPLX_8) ) {
CnvS2S( (single *)const_ptr, fmt_buff );
cf = BFCnvSF( fmt_buff );
BFCnvTarget( cf, const_buff, BETypeLength( TY_SINGLE ) );
BFFree( cf );
} else if( (var_type == PT_REAL_8) || (var_type == PT_CPLX_16) ) {
CnvD2S( (double *)const_ptr, fmt_buff );
cf = BFCnvSF( fmt_buff );
BFCnvTarget( cf, const_buff, BETypeLength( TY_DOUBLE ) );
BFFree( cf );
} else if( (var_type == PT_REAL_16) || (var_type == PT_CPLX_32) ) {
CnvX2S( (extended *)const_ptr, fmt_buff );
cf = BFCnvSF( fmt_buff );
BFCnvTarget( cf, const_buff, BETypeLength( TY_LONGDOUBLE ) );
BFFree( cf );
}
if( var_type == PT_CPLX_8 ) {
CnvS2S( (single *)(const_ptr + sizeof( single )), fmt_buff );
cf = BFCnvSF( fmt_buff );
BFCnvTarget( cf, const_buff + sizeof( single ), BETypeLength( TY_SINGLE ) );
BFFree( cf );
} else if( var_type == PT_CPLX_16 ) {
CnvD2S( (double *)(const_ptr + sizeof( double )), fmt_buff );
cf = BFCnvSF( fmt_buff );
BFCnvTarget( cf, const_buff + sizeof( double ), BETypeLength( TY_DOUBLE ) );
BFFree( cf );
} else if( var_type == PT_CPLX_32 ) {
CnvX2S( (extended *)(const_ptr + sizeof( extended )), fmt_buff );
cf = BFCnvSF( fmt_buff );
BFCnvTarget( cf, const_buff + sizeof( extended ), BETypeLength( TY_LONGDOUBLE ) );
BFFree( cf );
}
if( (var_type >= PT_REAL_4) && (var_type <= PT_CPLX_32) ) {
const_ptr = const_buff;
}
}
// End of temporary fix.
DtBytes( const_ptr, var_size );
}
DtItemSize = 0;
}