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 );
}
}
static void Equivalent( cg_op op_code ) {
//===========================================
cg_name op1;
cg_name op2;
unsigned_16 typ_info;
cg_type typ1;
cg_type typ2;
typ_info = GetU16();
typ1 = GetType1( typ_info );
typ2 = GetType2( typ_info );
op1 = XPopValue( typ1 );
op2 = XPopValue( typ2 );
typ1 = CGType( op1 );
if( typ1 != TY_BOOLEAN ) {
op1 = CGCompare( O_NE, op1, CGInteger( 0, typ1 ), typ1 );
}
typ2 = CGType( op2 );
if( typ2 != TY_BOOLEAN ) {
op2 = CGCompare( O_NE, op2, CGInteger( 0, typ2 ), typ2 );
}
XPush( CGCompare( op_code, op1, op2, TY_UINT_1 ) );
}
static void CCCmp( cg_op op, cg_name a, cg_name b, cg_name c, cg_name d ) {
//=============================================================================
// Complex/Complex compare.
cg_type res_type;
cg_op flow_op;
res_type = ResCGType( CGType( a ), CGType( c ) );
if( op == O_EQ ) {
flow_op = O_FLOW_AND;
} else {
flow_op = O_FLOW_OR;
}
XPush( CGFlow( flow_op, CGCompare( op, a, c, res_type ),
CGCompare( op, b, d, res_type ) ) );
}
void FCIfArith( void ) {
//===================
// Set up control structure for arithmetic if.
cg_name if_expr;
sym_id lt;
sym_id eq;
sym_id gt;
cg_type typ;
typ = GetType( GetU16() );
if_expr = XPopValue( typ );
lt = GetPtr();
eq = GetPtr();
gt = GetPtr();
if( lt == gt ) {
CGControl( O_IF_TRUE,
CGCompare( O_EQ, if_expr, CGInteger( 0, typ ), typ ),
GetStmtLabel( eq ) );
CGControl( O_GOTO, NULL, GetStmtLabel( lt ) );
} else if( lt == eq ) {
CGControl( O_IF_TRUE,
CGCompare( O_GT, if_expr, CGInteger( 0, typ ), typ ),
GetStmtLabel( gt ) );
CGControl( O_GOTO, NULL, GetStmtLabel( eq ) );
} else if( eq == gt ) {
CGControl( O_IF_TRUE,
CGCompare( O_LT, if_expr, CGInteger( 0, typ ), typ ),
GetStmtLabel( lt ) );
CGControl( O_GOTO, NULL, GetStmtLabel( eq ) );
} else {
CG3WayControl( if_expr, GetStmtLabel( lt ), GetStmtLabel( eq ),
GetStmtLabel( gt ) );
}
RefStmtLabel( lt );
RefStmtLabel( eq );
RefStmtLabel( gt );
}
void FCAllocated( void ) {
//=====================
// Generate code for ALLOCATED intrinsic function.
uint type;
cg_name fl;
type = GetU16();
fl = XPop();
if( type & ALLOC_STRING ) {
fl = CGUnary( O_POINTS, fl, T_POINTER );
}
XPush( CGCompare( O_NE, fl, CGInteger( 0, T_POINTER ), T_POINTER ) );
}
void FCJmpFalse( void ) {
//====================
unsigned_16 typ_info;
cg_type typ;
cg_name bool_expr;
typ_info = GetU16();
typ = GetType( typ_info );
if( IntType( typ_info ) ) {
bool_expr = CGCompare( O_NE, XPopValue( typ ),
CGInteger( 0, typ ), typ );
} else {
bool_expr = XPopValue( typ );
}
CGControl( O_IF_FALSE, bool_expr, GetLabel( GetU16() ) );
}
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 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 ) );
}
