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 ); }