static bool UnaryMul( TYPE typ1, TYPE typ2 ) { //============================================ if( typ1 > FT_EXTENDED ) return( FALSE ); if( !_IsTypeInteger( typ2 ) ) return( FALSE ); if( CITNode->link->opn.us != USOPN_CON ) return( FALSE ); if( ITIntValue( CITNode->link ) < 0 ) return( FALSE ); if( ITIntValue( CITNode->link ) > 8 ) return( FALSE ); return( TRUE ); }
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 void ExpOp( TYPE typ1, TYPE typ2, OPTR op ) { //====================================================== op = op; if( !_IsTypeInteger( typ2 ) ) { Convert(); GenExp( ResultType ); } else { CnvTo( CITNode, ResultType, TypeSize( ResultType ) ); ExpI( typ1, &CITNode->value, ITIntValue( CITNode->link ) ); } }
static intstar4 GetIntValue( itnode *node ) { //=========================================== if( node->typ == FT_REAL ) { return( node->value.single ); } else if( node->typ == FT_DOUBLE ) { return( node->value.dble ); } else if( node->typ == FT_EXTENDED ) { return( node->value.extended ); } else { return( ITIntValue( node ) ); } }
static int SameScripts( itnode *op1, itnode *op2 ) { //======================================================= if( !SimpleScript( op1 ) ) return( 0 ); if( (op1->opn.us & USOPN_WHAT) == USOPN_NONE ) { if( (op2->opn.us & USOPN_WHAT) == USOPN_CON ) { return( ITIntValue( op2 ) ); } else { return( 0 ); } } if( (op1->opn.us & USOPN_WHAT) != (op2->opn.us & USOPN_WHAT) ) { return( 0 ); } if( (op1->opn.us & USOPN_WHAT) == USOPN_NNL ) { if( op1->sym_ptr == op2->sym_ptr ) { return( 1 ); } } else if( (op1->opn.us & USOPN_WHAT) == USOPN_CON ) { return( ITIntValue( op2 ) - ITIntValue( op1 ) + 1 ); } return( 0 ); }
void ExpOp( TYPE typ1, TYPE typ2, OPTR opr ) { //=============================================== // Generate code to perform exponentiation. if( UnaryMul( typ1, typ2 ) ) { PushOpn( CITNode ); EmitOp( FC_UNARY_MUL ); GenType( CITNode ); OutU16( ITIntValue( CITNode->link ) ); SetOpn( CITNode, USOPN_SAFE ); } else { BinOp( typ1, typ2, opr ); } }
static bool SubStr2( intstar4 *subscripts ) { //=============================================== // Get the second component of a substring expression. bool got_colon; bool hi; subscripts++; got_colon = RecColon(); hi = FALSE; if( !RecNOpn() ) { CIntExpr(); *subscripts = ITIntValue( CITNode ); hi = TRUE; } if( got_colon ) { AdvanceITPtr(); } ReqCloseParen(); ReqNOpn(); AdvanceITPtr(); return( hi ); }
void CpEquivalence(void) { //======================= // Compile EQUIVALENCE statement. // EQUIVALENCE (A1,...,An) {,(B1,...,Bm)} . . . sym_id sym; int num_equived; intstar4 *subscripts; int eq_size; act_eq_entry *new_eq; act_eq_entry *eqv_entry; act_eq_entry *eq_head; act_eq_entry *eq_set; bool ill_name; bool sub_strung; act_eq_entry equiv; eq_set = EquivSets; if( EquivSets != NULL ) { while( eq_set->next_eq_set != NULL ) { eq_set = eq_set->next_eq_set; } } for(;;) { if( RecNOpn() ) { AdvanceITPtr(); } ReqOpenParen(); eqv_entry = NULL; eq_head = NULL; num_equived = 0; for(;;) { AError = FALSE; if( ReqName( NAME_VAR_OR_ARR ) ) { num_equived++; sym = LkSym(); ill_name = TRUE; if( ( sym->ns.flags & SY_CLASS ) == SY_VARIABLE ) { if( sym->ns.flags & SY_DATA_INIT ) { NameErr( ST_DATA_ALREADY, sym ); } else if( sym->ns.flags & SY_SUB_PARM ) { IllName( sym ); } else if( ( sym->ns.flags & SY_SUBSCRIPTED ) && _Allocatable( sym ) ) { IllName( sym ); } else { sym->ns.flags |= SY_IN_EQUIV; ill_name = FALSE; } } else { IllName( sym ); } AdvanceITPtr(); equiv.name_equived = sym; equiv.next_eq_entry = NULL; equiv.next_eq_set = NULL; equiv.subs_no = 0; equiv.substr = 0; equiv.substr1 = 1; equiv.substr2 = 0; subscripts = equiv.subscrs; if( RecOpenParen() ) { if( !RecNOpn() || !RecNextOpr( OPR_COL ) ) { sub_strung = FALSE; for(;;) { CIntExpr(); *subscripts = ITIntValue( CITNode ); AdvanceITPtr(); if( RecColon() ) { sub_strung = TRUE; break; } subscripts++; equiv.subs_no++; if( equiv.subs_no == MAX_DIM ) break; if( !RecComma() ) break; } if( !sub_strung ) { ReqCloseParen(); ReqNOpn(); AdvanceITPtr(); if( RecOpenParen() ) { *subscripts = 1; if( !RecNOpn() ) { CIntExpr(); *subscripts = ITIntValue( CITNode ); } AdvanceITPtr(); sub_strung = ReqColon(); } } } else { sub_strung = TRUE; } if( sub_strung ) { equiv.substr = 1; if( SubStr2( subscripts ) ) { equiv.substr = 2; } } } if( AError ) { equiv.subs_no = 0; equiv.substr = 0; } if( ( ( SgmtSw & SG_SYMTAB_RESOLVED ) == 0 ) && !ill_name ) { eq_size = sizeof( eq_entry ) + equiv.subs_no * sizeof( intstar4 ); if( equiv.substr != 0 ) { eq_size += 2 * sizeof( intstar4 ); } new_eq = FMemAlloc( eq_size ); memcpy( new_eq, &equiv, eq_size ); if( eqv_entry == NULL ) { eq_head = new_eq; eqv_entry = new_eq; } else { eqv_entry->next_eq_entry = new_eq; eqv_entry = new_eq; } if( sym->ns.si.va.vi.ec_ext == NULL ) { sym->ns.si.va.vi.ec_ext = STComEq(); } } } else { AdvanceITPtr(); } if( !RecComma() ) break; } if( num_equived < 2 ) { Error( EV_EQUIV_LIST ); } if( eq_set == NULL ) { eq_set = eq_head; EquivSets = eq_head; } else { eq_set->next_eq_set = eq_head; eq_set = eq_head; } ReqCloseParen(); ReqNOpn(); AdvanceITPtr(); if( !RecComma() ) break; } ReqEOS(); }