void CpRead( void ) {
//================
// Compile READ statement.
itnode *cit;
Remember.read = true;
InitIO();
cit = CITNode;
AdvanceITPtr();
if( RecOpenParen() && ReadKWList() ) {
KeywordList();
ReqCloseParen();
} else {
CITNode = cit;
Form();
if( !RecEOS() ) {
ReqComma();
}
}
if( !Remember.end_equals ) {
GNullEofStmt();
}
IOList();
ReqEOS();
FiniIO();
}
void CpData(void) {
//================
// Compile DATA statement.
label_id end_data;
int data_sets;
bool error;
// so that we can issue ST_DATA_TOO_EARLY later
SgmtSw |= SG_SEEN_DATA;
error = false;
data_sets = 0;
CITNode->opr = OPR_COM; // prevent call to FinishImpDo first time
end_data = GDataProlog();
for(;;) {
DoData();
error |= AError;
++data_sets;
if( RecNOpn() ) {
AdvanceITPtr();
if( RecTrmOpr() )
break;
ReqComma();
}
if( RecTrmOpr() || error ) {
break;
}
}
if( !error ) {
DumpDataSets( data_sets, ITHead );
}
GDataEpilog( end_data );
CITNode->opr = OPR_TRM;
}
void CpPrint( void ) {
//=================
// Compile PRINT statement.
itnode *cit;
InitIO();
Form();
if( !RecEOS() ) {
ReqComma();
if( RecNOpn() ) {
cit = CITNode;
AdvanceITPtr();
if( RecEOS() ) {
CITNode = cit;
Error( SX_SURP_OPR );
}
CITNode = cit;
}
}
IOList();
ReqEOS();
FiniIO();
}
static void ConList( void ) {
//=========================
// Collect constants for data initialization.
OPR opr;
itnode *last_node;
opr = FindSlash( &last_node );
for(;;) {
if( RecNextOpr( OPR_MUL ) ) {
ProcDataRepExpr();
if( ITIntValue( CITNode ) <= 0 ) {
Error( DA_BAD_RPT_SPEC );
}
AddConst( CITNode );
AdvanceITPtr();
}
if( !HexConst() ) {
GetSConst();
AddConst( CITNode );
}
AdvanceITPtr();
if( CITNode == last_node )
break;
ReqComma();
if( AError ) {
break;
}
}
CITNode->opr = opr;
ReqDiv();
}
static bool FormatIdentifier( void ) {
//====================================
if( RecComma() && RecNextOpr( OPR_EQU ) )
return false;
if( RecCloseParen() )
return false;
if( RecTrmOpr() )
return false;
ReqComma();
return true;
}
void ProcessList( void ) {
//=====================
// This procedure will process one 'thing' from the i/o list. A 'thing' is:
// 1) initializing an implied DO
// 2) finishing an implied DO
// 3) an i/o list item
if( RecTrmOpr() ) {
FinishImpDo();
if( !RecTrmOpr() ) {
ReqComma();
}
} else if( !StartImpDo() ) {
ProcIOExpr();
ListItem();
if( !RecTrmOpr() ) {
ReqComma();
}
}
}
static void VarList( void ) {
//=========================
// Process one variable list in a DATA statement.
OPR last_opr;
OPR opr;
int do_level;
itnode *last_node;
do_level = 0;
last_opr = FindSlash( &last_node );
while( CITNode != last_node ) {
if( AError )
break;
if( RecTrmOpr() && ( CITNode != ITHead ) ) {
--do_level;
FinishImpDo();
} else if( StartImpDo() ) {
++do_level;
} else if( ReqName( NAME_VAR_OR_ARR ) ) {
InitVar = LkSym();
if( InitVar->u.ns.u1.s.typ == FT_STRUCTURE ) {
// make sure structure size is calculated - normally
// structure size is calculated by StructResolve() which
// is not called until the first executable statement
CalcStructSize( InitVar->u.ns.xt.sym_record );
}
CkFlags();
opr = CITNode->opr;
ProcDataExpr();
CITNode->opr = opr;
ListItem();
if( !RecTrmOpr() ) {
ReqComma();
}
} else {
AdvanceITPtr();
AError = true;
break;
}
}
if( AError ) {
while( do_level != 0 ) { // clean up hanging do entrys
TermDo();
--do_level;
}
} else {
CITNode->opr = last_opr;
ReqDiv();
}
}
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 );
}
}
static brkp *SetPoint( memory_expr def_seg, mad_type_handle th )
{
brkp *bp;
const char *start;
size_t len;
address loc;
cmd_list *cmds;
char *condition;
long countdown;
bool resume;
bool active;
int index;
mad_type_info mti;
unsigned old;
bool unmapped;
bool mapaddress;
bool symaddress;
char *image_name;
char *mod_name;
char *sym_name;
long cue_diff;
long addr_diff;
int cmd;
resume = false;
index = 0;
active = true;
unmapped = false;
mapaddress = false;
symaddress = false;
while( CurrToken == T_DIV ) {
Scan();
cmd = ScanCmd( PointNameTab );
if( cmd < 0 )
break;
switch( cmd ) {
case B_RESUME:
resume = true;
break;
case B_UNRESUME:
resume = false;
break;
case B_ACTIVATE:
active = true;
break;
case B_DEACTIVATE:
active = false;
break;
case B_UNMAPPED:
unmapped = true;
break;
case B_MAPADDRESS:
mapaddress = true;
ScanItem( true, &start, &len );
image_name = DupStrLen( start, len );
loc.mach.segment = ReqLongExpr();
loc.mach.offset = ReqLongExpr();
ReqComma();
break;
case B_SYMADDRESS:
symaddress = true;
ScanItem( true, &start, &len );
image_name = DupStrLen( start, len );
ScanItem( true, &start, &len );
mod_name = DupStrLen( start, len );
ScanItem( true, &start, &len );
sym_name = DupStrLen( start, len );
cue_diff = ReqLongExpr();
addr_diff = ReqLongExpr();
loc = NilAddr;
ReqComma();
break;
case B_INDEX:
old = NewCurrRadix( 10 );
index = ReqExpr();
NewCurrRadix( old );
ReqComma();
break;
/* fall thru */
default:
Error( ERR_LOC, LIT_ENG( ERR_BAD_OPTION ), GetCmdName( CMD_BREAK ) );
break;
}
}
if( !unmapped ) {
ReqMemAddr( def_seg, &loc );
}
for( bp = BrkList; bp != NULL; bp = bp->next ) {
if( AddrComp( bp->loc.addr, loc ) == 0 ) {
Error( ERR_NONE, LIT_ENG( ERR_POINT_EXISTS ) );
}
}
cmds = NULL;
condition = NULL;
countdown = 0;
if( ScanQuote( &start, &len ) ) {
if( len != 0 )
cmds = AllocCmdList( start, len );
if( ScanQuote( &start, &len ) ) {
if( len != 0 )
condition = DupStrLen( start, len );
if( !ScanEOC() ) {
countdown = ReqExpr();
}
}
}
ReqEOC();
if( !IS_BP_EXECUTE( th ) ) {
MADTypeInfo( th, &mti );
switch( mti.b.bits / BITS_PER_BYTE ) {
case 1:
case 2:
case 4:
break;
case 8:
if( Is8ByteBreakpointsSupported() )
break;
default:
Error( ERR_NONE, LIT_ENG( ERR_NOT_WATCH_SIZE ) );
break;
}
}
bp = AddPoint( loc, th, unmapped );
if( bp == NULL )
return( NULL );
bp->status.b.unmapped = unmapped;
if( mapaddress ) {
bp->loc.image_name = image_name;
}
if( symaddress ) {
bp->image_name = image_name;
bp->mod_name = mod_name;
bp->sym_name = sym_name;
bp->cue_diff = cue_diff;
bp->addr_diff = addr_diff;
}
bp->cmds = cmds;
if( cmds != NULL )
bp->status.b.use_cmds = true;
bp->condition = condition;
if( condition != NULL )
bp->status.b.use_condition = true;
SetBPCountDown( bp, countdown );
bp->status.b.resume = resume;
bp->status.b.active = active;
if( index != 0 )
bp->index = index;
RecordBreakEvent( bp, B_SET );
return( bp );
}
