static cg_name HiBound( sym_id arr, int ss_offset ) {
//====================================================
// Get hi bound from ADV.
ss_offset = BETypeLength( TY_ADV_LO ) * ( ss_offset + 1 ) +
BETypeLength( TY_ADV_HI ) * ss_offset;
return( CGUnary( O_POINTS, StructRef( GetAdv( arr ), ss_offset ), TY_ADV_HI ) );
}
void FCAdvFillHi( void ) {
//=====================
// Fill hi bound of a dimension (actually computes # of elements in dimension).
sym_id arr;
act_dim_list *dim_ptr;
uint lo_size;
uint hi_size;
int hi_offset;
int ss;
cg_name num_elts;
cg_name hi;
cg_name adv;
call_handle call;
arr = GetPtr();
dim_ptr = arr->u.ns.si.va.u.dim_ext;
adv = GetAdv( arr );
hi_size = BETypeLength( TY_ADV_HI );
lo_size = BETypeLength( TY_ADV_LO );
ss = GetU16();
hi = GetTypedValue();
if( CGOpts & CGOPT_DI_CV ) {
hi_offset = _DimCount( dim_ptr->dim_flags ) * BETypeLength( TY_ADV_ENTRY );
if( Options & OPT_BOUNDS ) {
hi_offset += BETypeLength( TY_POINTER );
}
hi_offset += (ss - 1) * (lo_size + BETypeLength( TY_ADV_HI_CV )) + lo_size;
hi = CGAssign( StructRef( adv, hi_offset ), hi, TY_ADV_HI_CV );
adv = GetAdv( arr );
}
if( Options & OPT_BOUNDS ) {
call = InitCall( RT_ADV_FILL_HI );
CGAddParm( call, hi, TY_INT_4 );
CGAddParm( call, CGInteger( ss, TY_UNSIGNED ), TY_UNSIGNED );
CGAddParm( call, adv, TY_LOCAL_POINTER );
CGDone( CGUnary( O_POINTS, CGCall( call ), TY_INT_4 ) );
} else {
hi_offset = (ss - 1) * ( lo_size + hi_size ) + lo_size;
num_elts = CGBinary( O_PLUS, hi,
CGBinary( O_MINUS, CGInteger( 1, TY_INTEGER ),
LoBound( arr, ss - 1 ),
TY_ADV_HI ),
TY_ADV_HI );
CGDone( CGAssign( StructRef( adv, hi_offset ), num_elts, TY_ADV_HI ) );
}
}
cg_name SCBFlagsAddr( cg_name scb ) {
//===================================
// Get pointer to flags in SCB.
return( StructRef( scb, BETypeLength( TY_CHAR ) ) );
}
cg_name SCBLenAddr( cg_name scb ) {
//=================================
// Get pointer to length in SCB.
return( StructRef( scb, BETypeLength( TY_GLOBAL_POINTER ) ) );
}
static cg_name getFlags( sym_id sym ) {
//======================================
int tlen;
cg_name fl;
cg_type typ;
if( sym->ns.flags & SY_SUBSCRIPTED ) {
typ = ArrayPtrType( sym );
tlen = BETypeLength( typ );
} else {
tlen = BETypeLength( T_CHAR );
typ = T_CHAR;
}
fl = StructRef( CGFEName( sym, typ ), tlen );
return( CGUnary( O_POINTS, fl, T_UINT_2 ) );
}
cg_name ImagPtr( cg_name dest, cg_type typ ) {
//============================================
// Get pointer to imaginary part of complex number.
dest = StructRef( dest, BETypeLength( typ ) );
if( OZOpts & OZOPT_O_VOLATILE ) {
dest = CGVolatile( dest );
}
return( dest );
}
static void addAutoLocn( sym s, cg_type type )
{
AUTO_LOCN* curr;
curr = CGAlloc( sizeof( AUTO_LOCN ) );
curr->s = s;
curr->offset = next_auto_offset;
curr->next = auto_locations;
auto_locations = curr;
next_auto_offset += _RoundUp( BETypeLength( type ), AUTO_PACK );
}
void FCAdvFillHiLo1( void ) {
//========================
// Fill hi and lo=1 bound of a dimension.
sym_id arr;
cg_name lo;
cg_name hi;
cg_name adv;
unsigned ss;
uint lo_size;
uint hi_size;
int lo_offset;
int hi_offset;
call_handle call;
// Get general information
arr = GetPtr();
ss = GetU16();
adv = GetAdv( arr );
hi_size = BETypeLength( TY_ADV_HI );
lo_size = BETypeLength( TY_ADV_LO );
hi = GetTypedValue();
if( Options & OPT_BOUNDS ) {
call = InitCall( RT_ADV_FILL_HI_LO1 );
CGAddParm( call, hi, TY_INT_4 );
CGAddParm( call, CGInteger( ss, TY_UNSIGNED ), TY_UNSIGNED );
CGAddParm( call, adv, TY_LOCAL_POINTER );
CGDone( CGUnary( O_POINTS, CGCall( call ), TY_INT_4 ) );
} else {
hi_offset = (ss - 1) * ( lo_size + hi_size ) + lo_size;
CGDone( CGAssign( StructRef( adv, hi_offset ), hi, TY_ADV_HI ) );
// set lo bound of the adv
lo = CGInteger( 1, TY_INT_4 );
lo_offset = (ss - 1) * BETypeLength( TY_ADV_ENTRY );
adv = GetAdv( arr );
CGDone( CGAssign( StructRef( adv, lo_offset ), lo, TY_ADV_LO ) );
}
}
// The following can be extended for more types, if required
//
TYPE TypeFromCgType( // GET C++ TYPE FOR cg_type
cg_type cgtype ) // - code-gen type
{
TYPE type; // - C++ type
switch( cgtype ) {
case TY_UINT_1 :
type = GetBasicType( TYP_UCHAR );
break;
case TY_INT_1 :
type = GetBasicType( TYP_SCHAR );
break;
case TY_UINT_2 :
type = GetBasicType( TYP_USHORT );
break;
case TY_INT_2 :
type = GetBasicType( TYP_SSHORT );
break;
case TY_UINT_4 :
#if( TARGET_INT == 4 )
type = GetBasicType( TYP_UINT );
#else
type = GetBasicType( TYP_ULONG );
#endif
break;
case TY_INT_4 :
#if( TARGET_INT == 4 )
type = GetBasicType( TYP_SINT );
#else
type = GetBasicType( TYP_SLONG );
#endif
break;
case TY_INT_8 :
type = GetBasicType( TYP_SLONG64 );
break;
case TY_UINT_8 :
type = GetBasicType( TYP_ULONG64 );
break;
case TY_BOOLEAN :
case TY_INTEGER :
type = GetBasicType( TYP_SINT );
break;
case TY_UNSIGNED :
type = GetBasicType( TYP_UINT );
break;
default :
type = MakeInternalType( BETypeLength( cgtype ) );
break;
}
return type;
}
void FCAdvFillLo( void ) {
//=====================
// Fill lo bound of a dimension.
sym_id arr;
int lo_offset;
cg_name adv;
cg_name lo;
unsigned ss;
arr = GetPtr();
adv = GetAdv( arr );
ss = GetU16();
lo = GetTypedValue();
lo_offset = (ss - 1) * BETypeLength( TY_ADV_ENTRY );
CGDone( CGAssign( StructRef( adv, lo_offset ), lo, TY_ADV_LO ) );
}
static cg_name LoBound( sym_id arr, int ss_offset ) {
//====================================================
// Get lo bound from ADV.
cg_name lo_bound;
act_dim_list *dim_ptr;
dim_ptr = arr->u.ns.si.va.u.dim_ext;
if( _LoConstBound( dim_ptr->dim_flags, ss_offset + 1 ) ) {
lo_bound = CGInteger( ((intstar4 *)(&dim_ptr->subs_1_lo))[2*ss_offset],
TY_INT_4 );
} else {
lo_bound = CGUnary( O_POINTS,
StructRef( GetAdv( arr ),
ss_offset*BETypeLength( TY_ADV_ENTRY ) ),
TY_ADV_LO );
}
return( lo_bound );
}
static SYMBOL getExprTempSym( // EMIT CGDone, CGTrash, OR COPY TO TEMP
cg_name expr, // - expression
cg_type type, // - type of expression
FN_CTL* fctl, // - function control
DGRP_FLAGS pop_type ) // - type of popping destruction
{
SYMBOL temp; // - NULL or copied temp
if( pop_type & DGRP_DONE ) {
CGDone( expr );
temp = NULL;
} else if( pop_type & DGRP_TRASH ) {
CGTrash( expr );
temp = NULL;
} else if( fctl->temp_dtoring ) {
temp = CgVarTemp( BETypeLength( type ) );
CGDone( CGLVAssign( CgSymbol( temp ), expr, type ) );
} else {
temp = NULL;
}
fctl->temp_dtoring = FALSE;
return temp;
}
void SetSegs( void )
/*********************/
{
int seg;
struct user_seg *useg;
struct textsegment *tseg;
int flags;
char *name;
CompFlags.low_on_memory_printed = 0;
flags = GLOBAL | INIT | EXEC;
if( *TextSegName == '\0' ) {
name = TS_SEG_CODE;
} else {
name = TextSegName;
flags |= GIVEN_NAME;
}
BEDefSeg( SEG_CODE, flags, name,
SegAlign( (OptSize == 0) ? BETypeLength( TY_INTEGER ) : 1 ) );
BEDefSeg( SEG_CONST, BACK|INIT|ROM, TS_SEG_CONST,
SegAlign( SegAlignment[SEG_CONST] ) );
BEDefSeg( SEG_CONST2, INIT | ROM, TS_SEG_CONST2,
SegAlign( SegAlignment[SEG_CONST2] ) );
BEDefSeg( SEG_DATA, GLOBAL | INIT, TS_SEG_DATA,
SegAlign( SegAlignment[SEG_DATA] ) );
if( CompFlags.ec_switch_used ) { /* 04-apr-92 */
BEDefSeg( SEG_YIB, GLOBAL | INIT, TS_SEG_YIB, 2 );
BEDefSeg( SEG_YI, GLOBAL | INIT, TS_SEG_YI, 2 );
BEDefSeg( SEG_YIE, GLOBAL | INIT, TS_SEG_YIE, 2 );
}
if( CompFlags.bss_segment_used ) {
BEDefSeg( SEG_BSS, GLOBAL, TS_SEG_BSS,
SegAlign( SegAlignment[ SEG_BSS ] ) );
}
if( CompFlags.far_strings ) {
FarStringSegment = SegmentNum; /* 10-mar-95 */
++SegmentNum;
}
for( seg = FIRST_PRIVATE_SEGMENT; seg < SegmentNum; ++seg ) {
sprintf( Buffer, "%s%d_DATA", ModuleName, seg );
BEDefSeg( seg, INIT | PRIVATE, Buffer, SegAlign( 16 ) );
}
for( useg = UserSegments; useg != NULL ; useg = useg->next ) {
seg = useg->segment;
switch( useg->segtype ) {
// case SEGTYPE_CODE:
// BEDefSeg( seg, INIT | GLOBAL | EXEC, useg->name, 1 );
// break;
case SEGTYPE_DATA: /* created through #pragma data_seg */
BEDefSeg( seg, INIT | GLOBAL | NOGROUP, useg->name, SegAlign( TARGET_INT ) );
break;
case SEGTYPE_BASED:
BEDefSeg( seg, INIT | PRIVATE | GLOBAL, useg->name, SegAlign( TARGET_INT ) );
break;
case SEGTYPE_INITFINI:
BEDefSeg( seg, INIT | GLOBAL, useg->name, SegAlign( 1 ) );
break;
case SEGTYPE_INITFINITR:
BEDefSeg( seg, INIT | GLOBAL| THREAD_LOCAL, useg->name, SegAlign( 1 ) );
break;
}
}
for( tseg = TextSegList; tseg != NULL; tseg = tseg->next ) {
tseg->segment_number = ++SegmentNum;
BEDefSeg( tseg->segment_number, GLOBAL | INIT | EXEC | GIVEN_NAME,
tseg->segname,
SegAlign( (OptSize == 0) ? BETypeLength( TY_INTEGER ) : 1 ) );
}
}
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;
}
