void GEndSubScr( itnode *arr ) {
//=================================
// Finish off a subscripting operation.
itnode *arg;
int dim_cnt;
if( arr->opn.us & USOPN_FLD ) {
PushOpn( arr );
EmitOp( FC_FIELD_SUBSCRIPT );
OutPtr( arr->sym_ptr );
dim_cnt = _DimCount( arr->sym_ptr->u.fd.dim_ext->dim_flags );
} else {
EmitOp( FC_SUBSCRIPT );
OutPtr( arr->sym_ptr );
dim_cnt = _DimCount( arr->sym_ptr->u.ns.si.va.u.dim_ext->dim_flags );
}
arg = arr->list;
while( dim_cnt-- > 0 ) {
GenType( arg );
arg = arg->link;
}
if( ( arr->opn.us & USOPN_FLD ) == 0 ) {
if( ( StmtSw & SS_DATA_INIT ) == 0 ) {
if( arr->sym_ptr->u.ns.u1.s.typ == FT_CHAR ) {
OutPtr( GTempString( 0 ) );
}
}
}
SetOpn( arr, USOPN_SAFE );
}
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 DetSubList(void) {
//====================
itnode *cit;
int count;
byte no_subs;
itnode *save_cit;
uint ch_size;
if( CITNode->opn.us & USOPN_FLD ) {
no_subs = _DimCount( CITNode->sym_ptr->u.fd.dim_ext->dim_flags );
} else {
no_subs = _DimCount( CITNode->sym_ptr->u.ns.si.va.u.dim_ext->dim_flags );
}
count = 0;
cit = CITNode;
AdvanceITPtr();
while( RecComma() || RecFBr() ) {
if( CheckColon() ) {
if( count == 0 ) {
save_cit = CITNode;
CITNode = cit;
OpndErr( SV_TRIED_SSTR );
CITNode = save_cit;
} else if( count != no_subs ) {
Error( SV_INV_SSCR );
}
SubStrArgs( cit );
cit->opn.us &= ~USOPN_WHAT;
cit->opn.us |= USOPN_ASS;
Detach( cit );
return;
}
if( RecNOpn() ) break;
++count;
CkScrStr();
AdvanceITPtr();
}
if( !RecCloseParen() ) {
Error( PC_NO_CLOSEPAREN );
}
if( count != no_subs ) {
Error( SV_INV_SSCR );
}
// we must make sure the array isn't substrung before we can set OPN_SS1
if( !( cit->opn.us & USOPN_FLD ) && ( cit->sym_ptr->u.ns.u1.s.typ == FT_CHAR ) ) {
ch_size = cit->sym_ptr->u.ns.xt.size;
if( ch_size > 0 ) {
cit->opn.us |= USOPN_SS1;
cit->value.st.ss_size = ch_size;
}
}
Detach( cit );
}
static intstar4 CheckSubscr( act_eq_entry *eqv_entry ) {
//==============================================================
// Check that array is properly subscripted.
sym_id sym;
act_dim_list *dims;
int dims_no;
intstar4 offset;
sym = eqv_entry->name_equived;
dims_no = 0;
if( sym->ns.flags & SY_SUBSCRIPTED ) {
dims = sym->ns.si.va.dim_ext;
dims_no = _DimCount( dims->dim_flags );
dims->dim_flags &= ~DIM_PVD;
}
if( eqv_entry->subs_no == 0 ) {
offset = 0;
} else if( dims_no != eqv_entry->subs_no ) {
if( eqv_entry->subs_no == 1 ) {
offset = eqv_entry->subscrs[0] - 1;
} else {
offset = 0;
NameStmtErr( EV_SSCR_INVALID, sym, PR_EQUIV );
}
} else if( !DoSubscript( dims, eqv_entry->subscrs, &offset ) ) {
offset = 0;
NameStmtErr( EV_SSCR_INVALID, sym, PR_EQUIV );
}
return( offset * _SymSize( sym ) );
}
act_dim_list *STSubsList( act_dim_list *subs_ptr ) {
//======================================================
// Allocate a dimension extension.
int size;
act_dim_list *ste_ptr;
size = sizeof( dim_list ) + ( 2 * sizeof( intstar4 ) ) * _DimCount( subs_ptr->dim_flags );
ste_ptr = FMemAlloc( size );
memcpy( ste_ptr, subs_ptr, size );
return( ste_ptr );
}
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 ArrayNumElts( sym_id arr ) {
//==================================
// Get number of elements in an array.
cg_name num_elts;
act_dim_list *dim;
dim = arr->u.ns.si.va.u.dim_ext;
if( _AdvRequired( dim ) ) {
num_elts = Multiplier( arr, _DimCount( dim->dim_flags ) );
} else {
num_elts = CGInteger( dim->num_elts, TY_INT_4 );
}
return( num_elts );
}
static bool Subscript( act_dim_list *dim, intstar4 *offset ) {
//================================================================
// Data initialize an array element.
int dims_no;
intstar4 subscrs[MAX_DIM];
dims_no = 0;
while( dims_no < _DimCount( dim->dim_flags ) ) {
subscrs[ dims_no ] = DXPop();
GetU16(); // skip typing information
dims_no++;
}
return( DoSubscript( dim, subscrs, offset ) );
}
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 ) );
}
static dw_handle BIGetArrayType( sym_id ste_ptr ) {
//=================================================
// Get An array type of a named symbol
int dim = _DimCount( ste_ptr->u.ns.si.va.u.dim_ext->dim_flags );
int x = 0;
dw_dim_info data;
intstar4 *sub;
dw_handle ret;
data.index_type = BIGetBaseType( FT_INTEGER );
sub = &( ste_ptr->u.ns.si.va.u.dim_ext->subs_1_lo );
ret = DWBeginArray( cBIId, BIGetType( ste_ptr ), 0, NULL, 0, 0 );
for( x = 0; x < dim; x++ ) {
data.lo_data = *sub++;
data.hi_data = *sub++;
DWArrayDimension( cBIId, &data );
}
DWDeclPos( cBIId, CurrFile->rec, 0 );
DWEndArray( cBIId );
return( ret );
}
void FCAllocate( void ) {
//============================
call_handle handle;
sym_id arr;
act_dim_list *dim;
uint num;
unsigned_16 alloc_flags;
cg_name expr_stat;
cg_name expr_loc;
cg_name fl;
label_handle label;
num = 0;
SymPush( NULL );
for(;;) {
arr = GetPtr();
if( arr == NULL ) break;
// check if array is already allocated before filling in ADV
label = BENewLabel();
fl = getFlags( arr );
fl = CGBinary( O_AND, fl, CGInteger( ALLOC_MEM, T_UINT_2 ), T_UINT_2 );
CGControl( O_IF_TRUE, CGCompare( O_NE, fl,
CGInteger( 0, T_UINT_2 ), T_UINT_2 ), label );
FCodeSequence(); // fill in the ADV, SCB or RCB
CGControl( O_LABEL, NULL, label );
BEFiniLabel( label );
SymPush( arr );
++num;
}
alloc_flags = GetU16();
if( alloc_flags & ALLOC_NONE ) {
expr_loc = CGInteger( 0, T_POINTER );
} else {
FCodeSequence();
if( alloc_flags & ALLOC_LOC ) {
expr_loc = XPopValue( T_INT_4 );
if( alloc_flags & ALLOC_STAT ) {
FCodeSequence();
expr_stat = XPop();
}
} else {
expr_stat = XPop();
}
}
handle = InitCall( RT_ALLOCATE );
for(;;) {
arr = SymPop();
if( arr == NULL ) break;
if( arr->ns.flags & SY_SUBSCRIPTED ) {
dim = arr->ns.si.va.dim_ext;
CGAddParm( handle, CGInteger( _SymSize( arr ), T_INT_4 ),
T_INT_4 );
CGAddParm( handle, CGInteger( _DimCount( dim->dim_flags ),
T_INTEGER ),
T_INTEGER );
CGAddParm( handle, GetAdv( arr ), T_LOCAL_POINTER );
}
CGAddParm( handle, CGFEName( arr, T_POINTER ), T_POINTER );
CGAddParm( handle, getFlags( arr ), FLAG_PARM_TYPE );
}
if( alloc_flags & ALLOC_NONE ) {
CGAddParm( handle, expr_loc, T_POINTER );
} else {
if( alloc_flags & ALLOC_LOC ) {
CGAddParm( handle, expr_loc, T_INT_4 );
}
if( alloc_flags & ALLOC_STAT ) {
CGAddParm( handle, expr_stat, T_POINTER );
}
}
CGAddParm( handle, CGInteger( num, T_INTEGER ), T_INTEGER );
CGAddParm( handle, CGInteger( alloc_flags, T_UINT_2 ), FLAG_PARM_TYPE );
CGDone( CGCall( handle ) );
}