void GFieldSCB( inttarg size ) {
//=================================
// Setup an SCB for a character field.
PushConst( size );
EmitOp( FC_FLIP );
}
void GNullRetIdx( void ) {
//=====================
// No alternate return.
PushConst( 0 );
EmitOp( FC_ASSIGN_ALT_RET );
DumpType( FT_INTEGER, TypeSize( FT_INTEGER ) );
}
void PushOpn( itnode *itptr ) {
//================================
// Generate a push of an operand.
// Also called for target of character assignment.
unsigned_16 flags;
TYPE typ;
USOPN what;
USOPN where;
where = itptr->opn.us & USOPN_WHERE;
if( ( itptr->opn.ds != DSOPN_PHI ) && ( where != USOPN_SAFE ) ) {
typ = itptr->typ;
flags = itptr->flags;
what = itptr->opn.us & USOPN_WHAT;
if( where != 0 ) {
EmitOp( FC_PUSH );
SymRef( itptr );
} else if( itptr->opn.us & USOPN_FLD ) {
PushConst( itptr->value.intstar4 );
} else if( ( flags & SY_CLASS ) == SY_SUBPROGRAM ) {
// 1. it's a statement function
// 2. it's a subprogram passed as an argument
EmitOp( FC_PUSH );
SymRef( itptr );
} else if( what == USOPN_CON ) {
if( typ == FT_CHAR ) {
EmitOp( FC_PUSH_LIT );
if( itptr->sym_ptr->u.lt.flags & LT_SCB_TMP_REFERENCE ) {
itptr->sym_ptr->u.lt.flags |= LT_SCB_REQUIRED;
} else {
// in case string optimizations use value directly,
// LT_SCB_TMP_REFERENCE will be turned off
itptr->sym_ptr->u.lt.flags |= LT_SCB_TMP_REFERENCE;
}
} else {
EmitOp( FC_PUSH_CONST );
}
SymRef( itptr );
} else {
EmitOp( FC_PUSH );
SymRef( itptr );
}
SetOpn( itptr, USOPN_SAFE );
}
}
static void DataDo( TYPE do_type ) {
//=====================================
// Process an implied-DO for DATA statements.
sym_id do_var;
do_type = do_type;
do_var = CITNode->sym_ptr;
AdvanceITPtr();
DoExpr(); // process e1
if( ReqComma() ) {
DoExpr(); // process e2
if( RecComma() ) {
DoExpr(); // process e3
} else {
PushConst( 1 ); // indicate unit incrementation
}
}
EmitOp( FC_DATA_DO_LOOP );
OutPtr( do_var );
}
static void DoLoop( TYPE do_type ) {
//=====================================
// Generate code for DO statement or implied-DO.
do_entry *doptr;
uint do_size;
intstar4 incr;
intstar4 limit;
sym_id loop_ctrl;
TYPE e1_type;
uint e1_size;
itnode *e2_node;
itnode *e3_node;
bool e2_const;
doptr = CSHead->cs_info.do_parms;
do_size = CITNode->sym_ptr->u.ns.xt.size;
doptr->do_parm = CITNode->sym_ptr; // save ptr to do variable
AdvanceITPtr(); // bump past the '='
EatDoParm(); // process e1
PushOpn( CITNode );
e1_type = CITNode->typ;
e1_size = CITNode->size;
AdvanceITPtr();
if( ReqComma() ) {
EatDoParm(); // process e2
e2_const = CITNode->opn.us == USOPN_CON;
PushOpn( CITNode );
e2_node = CITNode;
AdvanceITPtr();
e3_node = NULL;
if( RecComma() ) {
EatDoParm(); // process e3
e3_node = CITNode;
if( !AError ) {
if( (CITNode->opn.us == USOPN_CON) && _IsTypeInteger( do_type ) ) {
incr = GetIntValue( CITNode );
doptr->incr_value = incr;
doptr->increment = NULL;
if( (OZOpts & OZOPT_O_FASTDO) == 0 ) {
if( e2_const ) {
limit = GetIntValue( e2_node );
if( NeedIncrement( limit, incr, do_type ) ) {
PushOpn( CITNode );
doptr->increment = StaticAlloc( do_size, do_type );
}
} else {
PushOpn( CITNode );
doptr->increment = StaticAlloc( do_size, do_type );
}
}
} else {
PushOpn( CITNode );
doptr->increment = StaticAlloc( do_size, do_type );
}
AdvanceITPtr();
}
} else {
if( _IsTypeInteger( do_type ) ) {
doptr->increment = NULL;
doptr->incr_value = 1;
if( (OZOpts & OZOPT_O_FASTDO) == 0 ) {
if( e2_const ) {
limit = GetIntValue( e2_node );
if( NeedIncrement( limit, 1, do_type ) ) {
PushConst( 1 );
doptr->increment = StaticAlloc( do_size, do_type );
}
} else {
PushConst( 1 );
doptr->increment = StaticAlloc( do_size, do_type );
}
}
} else {
PushConst( 1 );
doptr->increment = StaticAlloc( do_size, do_type );
}
}
EmitOp( FC_DO_BEGIN );
OutPtr( doptr->do_parm );
OutPtr( doptr->increment );
if( doptr->increment == NULL ) { // INTEGER do-loop with constant incr
loop_ctrl = StaticAlloc( do_size, do_type );
OutConst32( doptr->incr_value );
OutPtr( loop_ctrl );
} else {
if( _IsTypeInteger( do_type ) ) {
loop_ctrl = StaticAlloc( do_size, do_type );
} else {
loop_ctrl = StaticAlloc( sizeof( intstar4 ), FT_INTEGER );
}
doptr->iteration = loop_ctrl;
OutPtr( loop_ctrl );
if( e3_node == NULL ) {
DumpType( FT_INTEGER, TypeSize( FT_INTEGER ) );
} else {
GenType( e3_node );
}
}
GenType( e2_node );
DumpType( e1_type, e1_size );
OutU16( CSHead->branch );
OutU16( CSHead->bottom );
}
}