void InitDo( signed_32 term ) { // Initialize a DO or implied DO. // Process "do i=e1,e2,e3" where e1, e2 and e3 are numeric expressions. // do_entry *do_pointer; sym_id do_var; if( ( StmtSw & SS_DATA_INIT ) == 0 ) { CSHead->branch = NextLabel(); CSHead->bottom = NextLabel(); CSHead->cycle = NextLabel(); } do_pointer = FMemAlloc( sizeof( do_entry ) ); CSHead->cs_info.do_parms = do_pointer; do_pointer->do_term = term; do_pointer->do_parm = NULL; if( ReqDoVar() ) { CkTypeDeclared(); do_var = CITNode->sym_ptr; BIOutSymbol( do_var ); do_var->u.ns.flags |= SY_REFERENCED; do_var->u.ns.u1.s.xflags |= SY_DEFINED; if( do_var->u.ns.flags & SY_DO_PARM ) { Error( DO_PARM_REDEFINED ); } do_pointer->do_parm = do_var; // remember id of "i" ReqNextOpr( OPR_EQU, EQ_NO_EQUALS ); if( StmtSw & SS_DATA_INIT ) { if( !_IsTypeInteger( do_var->u.ns.u1.s.typ ) ) { NameErr( DA_BAD_DO_VAR, do_var ); } do_var = STShadow( do_var ); CITNode->flags = do_var->u.ns.flags; } CITNode->sym_ptr = do_var; GDoInit( do_var->u.ns.u1.s.typ ); do_var->u.ns.flags |= SY_DO_PARM; } }
void SFPrologue( void ) { //==================== // Generate code for statement function prologue. sym_id sym; itnode *func_node; itnode *arg_list; sf_parm **parm; StmtSw |= SS_SF_REFERENCED; CkTypeDeclared(); SFSymId = CITNode->sym_ptr; if( ( SFSymId->ns.typ == FT_CHAR ) && ( SFSymId->ns.xt.size == 0 ) ) { Error( SF_ILL_CHAR_LEN ); } else if( SFSymId->ns.typ == FT_STRUCTURE ) { Error( SF_ILL_TYPE ); } GStartSF(); SFSymId->ns.flags = SY_USAGE | SY_TYPE | SY_SUBPROGRAM | SY_STMT_FUNC; CITNode->flags = SFSymId->ns.flags; func_node = CITNode; AdvanceITPtr(); ReqOpenParen(); SFSymId->ns.si.sf.header = FMemAlloc( sizeof( sf_header ) ); SFSymId->ns.si.sf.header->ref_count = 1; parm = &SFSymId->ns.si.sf.header->parm_list; *parm = NULL; if( RecNOpn() ) { AdvanceITPtr(); } else { for(;;) { if( ReqName( NAME_SF_DUMMY ) ) { sym = LkSym(); sym->ns.xflags |= SY_DEFINED; CkTypeDeclared(); if( ( ( sym->ns.flags & SY_CLASS ) == SY_VARIABLE ) && ( ( sym->ns.flags & SY_SUBSCRIPTED ) == 0 ) && ( ( sym->ns.typ != FT_CHAR ) || ( sym->ns.xt.size != 0 ) ) && ( sym->ns.typ != FT_STRUCTURE ) ) { if( sym->ns.flags & SY_SPECIAL_PARM ) { Error( SF_DUPLICATE_DUMMY_PARM ); } else { *parm = FMemAlloc( sizeof( sf_parm ) ); (*parm)->link = NULL; (*parm)->actual = sym; (*parm)->shadow = STShadow( sym ); parm = &((*parm)->link); } } else { Error( SF_ILL_DUMMY_PARM ); } } AdvanceITPtr(); if( !RecComma() ) break; } } ReqCloseParen(); ReqNOpn(); arg_list = func_node->link; func_node->link = CITNode->link; CITNode->link = NULL; CITNode = func_node; FreeITNodes( arg_list ); }