static void DbSubscript( sym_id arr ) {
//=========================================
// Generate call to debugging subscript routine.
act_dim_list *dim_ptr;
int dims_no;
int i;
call_handle call;
cg_name offset;
cg_name subscripts[MAX_DIM];
dim_ptr = arr->u.ns.si.va.u.dim_ext;
dims_no = _DimCount( dim_ptr->dim_flags );
call = InitCall( RT_SUBSCRIPT );
for( i = 0; i < dims_no; ++i ) {
subscripts[ i ] = GetTypedValue();
}
for( i = 1; i <= dims_no; ++i ) {
CGAddParm( call, subscripts[ dims_no - i ], TY_INT_4 );
}
CGAddParm( call, GetAdv( arr ), TY_LOCAL_POINTER );
CGAddParm( call, CGInteger( _DimCount( dim_ptr->dim_flags ), TY_INTEGER ), TY_INTEGER );
offset = CGUnary( O_POINTS, CGCall( call ), TY_INT_4 );
Index( arr, offset );
}
void FCNot( void ) {
//===============
// Logical .NOT. F-Code processor.
XPush( CGFlow( O_FLOW_NOT, GetTypedValue(), NULL ) );
}
void TYPBLK<TYPE>::SetMax(PVAL valp, int n)
{
CheckParms(valp, n)
TYPE tval = GetTypedValue(valp);
TYPE& tmin = Typp[n];
if (tval > tmin)
tmin = tval;
} // end of SetMax
static void IOCallValue( RTCODE rtn ) {
//=========================================
// Call i/o run-time routine with one argument.
call_handle handle;
handle = InitCall( rtn );
CGAddParm( handle, GetTypedValue(), TY_INT_4 );
CGDone( CGCall( handle ) );
}
int TYPBLK<TYPE>::CompVal(PVAL vp, int n)
{
#if defined(_DEBUG)
ChkIndx(n);
ChkTyp(vp);
#endif // _DEBUG
TYPE mlv = Typp[n];
TYPE vlv = GetTypedValue(vp);
return (vlv > mlv) ? 1 : (vlv < mlv) ? (-1) : 0;
} // end of CompVal
int TYPBLK<TYPE>::Find(PVAL vp)
{
ChkTyp(vp);
int i;
TYPE n = GetTypedValue(vp);
for (i = 0; i < Nval; i++)
if (n == Typp[i])
break;
return (i < Nval) ? i : (-1);
} // end of Find
void FCSetSCBLen( void ) {
//=====================
// Fill scb length
sym_id scb;
cg_name len;
// Get general information
scb = GetPtr();
len = GetTypedValue();
CGTrash( CGAssign( SCBLenAddr( CGFEName( scb, TY_CHAR ) ), len, TY_INTEGER ) );
}
void TYPBLK<TYPE>::SetValue(PVBLK pv, int n1, int n2)
{
bool b;
ChkIndx(n1);
ChkTyp(pv);
if (!(b = pv->IsNull(n2) && Nullable))
Typp[n1] = GetTypedValue(pv, n2);
else
Reset(n1);
SetNull(n1, b);
} // end of SetValue
void TYPBLK<TYPE>::SetValue(PVAL valp, int n)
{
bool b;
ChkIndx(n);
ChkTyp(valp);
if (!(b = valp->IsNull()))
Typp[n] = GetTypedValue(valp);
else
Reset(n);
SetNull(n, b && Nullable);
} // end of SetValue
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 ) );
}
}
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 ) );
}
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 ) );
}
}
static void VariableDims( sym_id arr ) {
//==========================================
// Subscript an array that has a variable array declarator.
act_dim_list *dim_ptr;
int dims_no;
int ss_offset;
cg_name offset;
cg_name c_offset;
dim_ptr = arr->u.ns.si.va.u.dim_ext;
dims_no = _DimCount( dim_ptr->dim_flags );
offset = CGInteger( 0, TY_INT_4 );
c_offset = CGInteger( 0, TY_INT_4 );
ss_offset = 0;
while( ss_offset < dims_no ) {
// offset += ( ss - lo ) * multiplier;
// or
// offset += ss*multiplier
// c_offset -= lo*multiplier
offset = CGBinary( O_PLUS,
offset,
CGBinary( O_TIMES,
GetTypedValue(),
Multiplier( arr, ss_offset ),
TY_INT_4 ),
TY_INT_4 );
c_offset = CGBinary( O_MINUS,
c_offset,
CGBinary( O_TIMES,
LoBound( arr, ss_offset ),
Multiplier( arr, ss_offset ),
TY_INT_4 ),
TY_INT_4 );
ss_offset++;
}
Index( arr, CGBinary( O_PLUS, c_offset, offset, TY_INT_4 ) );
}
cg_name ConstArrayOffset( act_dim_list *dims ) {
//==============================================
int dims_no;
cg_name hi_off;
intstar4 multiplier;
intstar4 hi;
intstar4 lo;
intstar4 *bounds;
intstar4 lo_off;
dims_no = _DimCount( dims->dim_flags );
bounds = &dims->subs_1_lo;
multiplier = 1;
hi_off = CGInteger( 0, TY_INT_4 );
lo_off = 0;
for(;;) {
lo = *bounds;
bounds++;
hi = *bounds;
bounds++;
// offset += ( ss - lo ) * multiplier;
// or
// hi_off += ss*multiplier
// lo_off -= lo*multiplier
hi_off = CGBinary( O_PLUS,
hi_off,
CGBinary( O_TIMES,
GetTypedValue(),
CGInteger( multiplier, TY_INT_4 ),
TY_INT_4 ),
TY_INT_4 );
lo_off -= lo * multiplier;
if( --dims_no == 0 ) break;
multiplier *= ( hi - lo + 1 );
}
return( CGBinary( O_PLUS, CGInteger( lo_off, TY_INT_4 ), hi_off, TY_INT_4 ) );
}
