static void ChkIOErr( cg_name io_stat ) {
//===========================================
// Check for i/o errors.
label_handle eq_label;
io_stat = CGUnary( O_POINTS, io_stat, TY_INTEGER );
if( ( EndEqLabel != 0 ) && ( ErrEqLabel != 0 ) ) {
eq_label = BENewLabel();
CG3WayControl( io_stat, GetLabel( EndEqLabel ), eq_label,
GetLabel( ErrEqLabel ) );
CGControl( O_LABEL, NULL, eq_label );
BEFiniLabel( eq_label );
} else if( EndEqLabel != 0 ) {
CGControl( O_IF_TRUE,
CGCompare( O_LT, io_stat, CGInteger( 0, TY_INTEGER ),
TY_INTEGER ),
GetLabel( EndEqLabel ) );
} else if( ErrEqLabel != 0 ) {
CGControl( O_IF_TRUE,
CGCompare( O_NE, io_stat, CGInteger( 0, TY_INTEGER ),
TY_INTEGER ),
GetLabel( ErrEqLabel ) );
} else if( IOStatSpecified ) {
IOSLabel = BENewLabel();
CGControl( O_IF_TRUE,
CGCompare( O_NE, io_stat, CGInteger( 0, TY_INTEGER ),
TY_INTEGER ),
IOSLabel );
} else {
CGDone( io_stat );
}
}
label_handle GetLabel( label_id label ) {
//==========================================
// Get a label.
label_entry *le;
le = FindLabel( label );
if( le->handle == NULL ) {
le->handle = BENewLabel();
}
return( le->handle );
}
static label_handle switch_label( // PLANT SWITCH LABEL
void )
{
label_handle tmp_label; // - new label handle
label_handle *stacked; // - stacked label handle
tmp_label = BENewLabel();
CgLabel( tmp_label );
++ switch_ctl()->cases;
stacked = VstkPush( &stack_labs_sw );
*stacked = tmp_label;
return( tmp_label );
}
label_handle CgSwitchBeg // GENERATE CODE FOR START OF SWITCH STMT
( FN_CTL* fctl ) // - function control
{
SW_CTL *ctl; // - control for switch
cg_name sw_expr; // - switch expression
cg_type sw_type; // - switch type
sw_expr = CgExprPopType( &sw_type );
CgExprDtored( sw_expr, sw_type, DGRP_TEMPS, fctl );
sw_expr = CgExprPopType( &sw_type );
ctl = VstkPush( &stack_switches );
ctl->id = CGSelInit();
ctl->cases = 0;
ctl->temp = CGTemp( sw_type );
ctl->type = sw_type;
ctl->label = BENewLabel();
CgAssign( CGTempName( ctl->temp, sw_type ), sw_expr, sw_type );
return ctl->label;
}
static void DoStructArrayIO( tmp_handle num_elts, struct field *fieldz ) {
//============================================================================
// Perform structure array i/o.
label_handle label;
label = BENewLabel();
CGControl( O_LABEL, NULL, label );
StructIO( fieldz );
CGControl( O_IF_TRUE,
CGCompare( O_NE,
CGAssign( TmpPtr( num_elts, TY_INT_4 ),
CGBinary( O_MINUS,
TmpVal( num_elts, TY_INT_4 ),
CGInteger( 1, TY_INTEGER ),
TY_INT_4 ),
TY_INT_4 ),
CGInteger( 0, TY_INTEGER ), TY_INT_4 ),
label );
BEFiniLabel( label );
}
void FCAssignedGOTOList( void ) {
//============================
// Perform assigned GOTO with list.
sel_handle s;
label_handle label;
sym_id sn;
sym_id var;
obj_ptr curr_obj;
var = GetPtr();
curr_obj = FCodeTell( 0 );
s = CGSelInit();
for(;;) {
sn = GetPtr();
if( sn == NULL ) break;
if( ( sn->u.st.flags & SN_IN_GOTO_LIST ) == 0 ) {
sn->u.st.flags |= SN_IN_GOTO_LIST;
label = GetStmtLabel( sn );
CGSelCase( s, label, sn->u.st.address );
}
}
label = BENewLabel();
CGSelOther( s, label );
CGSelect( s, CGUnary( O_POINTS, CGFEName( var, TY_INTEGER ), TY_INTEGER ) );
CGControl( O_LABEL, NULL, label );
BEFiniLabel( label );
FCodeSeek( curr_obj );
for(;;) {
sn = GetPtr();
if( sn == NULL ) break;
sn->u.st.flags &= ~SN_IN_GOTO_LIST;
RefStmtLabel( sn );
}
}
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 ) );
}