Polaris: Statement.cc Source File

Statement.cc Go to the documentation of this file. /// #ifdef POLARIS_GNU_PRAGMAS #pragma implementation "Statement.h" #pragma implementation "AllocateStmt.h" #pragma implementation "ArithmeticIfStmt.h" #pragma implementation "AssignStmt.h" #pragma implementation "AssignedGotoStmt.h" #pragma implementation "AssignmentStmt.h" #pragma implementation "BlockEntryStmt.h" #pragma implementation "BlockExitStmt.h" #pragma implementation "CallStmt.h" #pragma implementation "ComputedGotoStmt.h" #pragma implementation "DeallocateStmt.h" #pragma implementation "DirectiveStmt.h" #pragma implementation "DoStmt.h" #pragma implementation "ElseIfStmt.h" #pragma implementation "ElseStmt.h" #pragma implementation "EndDoStmt.h" #pragma implementation "EndIfStmt.h" #pragma implementation "EntryStmt.h" #pragma implementation "FlowEntryStmt.h" #pragma implementation "FlowExitStmt.h" #pragma implementation "GotoStmt.h" #pragma implementation "IOStmt.h" #pragma implementation "IfStmt.h" #pragma implementation "ImpliedGotoStmt.h" #pragma implementation "LabelStmt.h" #pragma implementation "NullifyStmt.h" #pragma implementation "PauseStmt.h" #pragma implementation "ReturnStmt.h" #pragma implementation "StmtPointer.h" #pragma implementation "StopStmt.h" #pragma implementation "WhileStmt.h" #endif /// #include <stream.h> #include <ctype.h> #include <stdlib.h> #include "../BinRep.h" #include "../Collection/Iterator.h" #include "../Collection/KeyIterator.h" #include "../Collection/List.h" #include "../Dictionary.h" #include "../Directive/Assertion.h" #include "../Directive/StringAssertion.h" #include "../Directive/Assertion.all.h" #include "../Directive/AssertionList.h" #include "../Directive/Directive.h" #include "../ExprTable.h" #include "../Expression/Expression.h" #include "../Expression/FormatExpr.h" #include "../Expression/LabelExpr.h" #include "../Expression/StmtLabelExpr.h" #include "../ProgramUnit.h" #include "../String.h" #include "../Symbol/Symbol.h" #include "../SymbolAccessMap.h" #include "../SymbolAccessRefMap.h" #include "../Symtab.h" #include "../VDL.h" #include "../VoidPtrDef.h" #include "../wide_output.h" #include "../debug.h" #include "../utilities/switches_util.h" #include "AllocateStmt.h" #include "ArithmeticIfStmt.h" #include "AssignStmt.h" #include "AssignedGotoStmt.h" #include "AssignmentStmt.h" #include "BlockEntryStmt.h" #include "BlockExitStmt.h" #include "CallStmt.h" #include "ComputedGotoStmt.h" #include "DeallocateStmt.h" #include "DirectiveStmt.h" #include "DoStmt.h" #include "ElseIfStmt.h" #include "ElseStmt.h" #include "EndDoStmt.h" #include "EndIfStmt.h" #include "EntryStmt.h" #include "FlowEntryStmt.h" #include "FlowExitStmt.h" #include "GotoStmt.h" #include "IOStmt.h" #include "IfStmt.h" #include "ImpliedGotoStmt.h" #include "LabelStmt.h" #include "NullifyStmt.h" #include "PauseStmt.h" #include "ReturnStmt.h" #include "StmtPointer.h" #include "StopStmt.h" #include "WhileStmt.h" #include "../Collection/RefMap.h" #include "../macros.h" #include "../p-assert.h" template class Map<Statement,StringElem>; template class RefMap<Statement,ProgramUnit>; template class TypedBaseMap<Statement,StringElem>; template class TypedBaseRefMap<Statement,ProgramUnit>; template class ProtoMap<Statement,StringElem>; template class ProtoRefMap<Statement,ProgramUnit>; template class KeyIterator<Statement,ProgramUnit>; template class KeyIterator<Statement,StringElem>; /// NextEntry functions void NextEntry::print(ostream & o) const { o << "<" << _tag << ", " << _next << ">"; } NextEntry::~NextEntry() { /// Nothing to do } int NextEntry::structures_OK() const { p_assert(0, "ERROR"); return 1; } Definition * NextEntry::definition_clone() const { p_assert(0, "ERROR"); return 0; } /// STATEMENT PRINTING UTILLITY FUNCTIONS /// Print a list of statements in FORTRAN form /// --Avoid printing the main entry point statement, which is /// --printed via print_main_entry_stmt(). void print_stmt_list(ostream &o, Iterator<Statement> &iter) { int indent = 0; if (!(iter.valid())) return; int print_accreg = switch_value("print_accreg"); if (iter.current().stmt_class() == FLOW_ENTRY_STMT) { /// ... _ Statement &s = iter.current(); for (Iterator<StringElem> pre_iter = s.pre_directives(); pre_iter.valid(); ++pre_iter) { wide_output( o, 0 ); o << (String) pre_iter.current() << endl; } for (Iterator<StringElem> post_iter = s.post_directives(); post_iter.valid(); ++post_iter) { wide_output( o, 0 ); o << (String) post_iter.current() << endl; } /// ... _ FLOW_ENTRY directives are printed. ++iter; if (!(iter.valid())) return; if (iter.current().stmt_class() == ENTRY_STMT) { /// ... Avoid this ENTRY_STMT if (print_accreg) { ((EntryStmt &)iter.current()).write_access_summary( o ); } ++iter; } } for (; iter.valid(); ++iter) { Statement &s = iter.current(); if (s.stmt_class() == BLOCK_ENTRY_STMT) { wide_output( o, 0 ); o << "CSRD$ BEGIN BLOCK" << endl; } for (Iterator<StringElem> pre_iter = s.pre_directives(); pre_iter.valid(); ++pre_iter) { wide_output( o, 0 ); o << (String) pre_iter.current() << endl; } if (s.stmt_class() == ENDDO_STMT) pop_wide_loop(); else if (s.stmt_class() == WHILE_STMT) push_wide_loop( 0 ); else if (s.stmt_class() == DO_STMT) { DoStmt & ds = (DoStmt &) s; push_wide_loop( ds.target_label() ); } switch (s.stmt_class()) { case IMPLIED_GOTO_STMT: case FLOW_ENTRY_STMT: case FLOW_EXIT_STMT: case BLOCK_ENTRY_STMT: case BLOCK_EXIT_STMT: break; default: wide_output( o, s.line() ); break; } s.write(o, indent); if (print_accreg) { s.write_access_table( o ); } for (Iterator<StringElem> post_iter = s.post_directives(); post_iter.valid(); ++post_iter) { wide_output( o, 0 ); o << (String) post_iter.current() << endl; } if (s.stmt_class() == BLOCK_EXIT_STMT) { wide_output( o, 0 ); o << "CSRD$ END BLOCK" << endl; } } } /// Print the tags of the statements in the list void print_stmt_tags(ostream & o, Iterator<Statement> &iter) { if (iter.valid()) { if (iter.current_valid()) o << iter.current().tag(); else o << "<INVALID>"; for (iter.next(); iter.valid(); iter.next()) { if (iter.current_valid()) o << ", " << iter.current().tag(); else o << "<INVALID>"; } } } /// Print the labels of the statements in the list void print_target_labels(ostream & o, Iterator<Statement> &iter) { if (iter.valid()) { if (! iter.current_valid()) o << "<INVALID>"; else { p_assert(iter.current().stmt_class() == LABEL_STMT, "not a label"); o << iter.current().value(); } for (iter.next(); iter.valid(); iter.next()) { if (! iter.current_valid()) o << "<INVALID>"; else { p_assert(iter.current().stmt_class() == LABEL_STMT, "not a label"); o << ", " << iter.current().value(); } } } } void print_expr_list(ostream &o, Iterator<Expression> &iter) { if (iter.valid()) { if (iter.current_valid()) o << iter.current(); else o << "<INVALID>"; } for (iter.next(); iter.valid(); iter.next()) { o << ", " ; if (iter.current_valid()) o << iter.current(); else o << "<INVALID>"; } } void print_stmt_list(ostream & o, const RefSet<Statement> &stmts) { Iterator<Statement> iter = stmts; print_stmt_list( o, iter ); } void print_stmt_list(ostream & o, const RefList<Statement> &stmts) { Iterator<Statement> iter = stmts; print_stmt_list( o, iter ); } void print_stmt_list(ostream & o, const List<Statement> &stmts) { Iterator<Statement> iter = stmts; print_stmt_list( o, iter ); } void print_stmt_tags(ostream & o, const RefSet<Statement> &stmts) { Iterator<Statement> iter = stmts; print_stmt_tags( o, iter ); } void print_stmt_tags(ostream & o, const RefList<Statement> &stmts) { Iterator<Statement> iter = stmts; print_stmt_tags( o, iter ); } void print_stmt_tags(ostream & o, const List<Statement> &stmts) { Iterator<Statement> iter = stmts; print_stmt_tags( o, iter ); } void print_target_labels(ostream & o, RefSet<Statement> &stmts) { Iterator<Statement> iter = stmts; print_target_labels( o, iter ); } void print_target_labels(ostream & o, RefList<Statement> &stmts) { Iterator<Statement> iter = stmts; print_target_labels( o, iter ); } void print_target_labels(ostream & o, List<Statement> &stmts) { Iterator<Statement> iter = stmts; print_target_labels( o, iter ); } void print_expr_list(ostream &o, const RefSet<Expression> &exprs) { Iterator<Expression> iter = exprs; print_expr_list( o, iter ); } void print_expr_list(ostream &o, const RefList<Expression> &exprs) { Iterator<Expression> iter = exprs; print_expr_list( o, iter ); } void print_expr_list(ostream &o, const List<Expression> &exprs) { Iterator<Expression> iter = exprs; print_expr_list( o, iter ); } static void fortran_indent( ostream &o, int indent ) { while (indent-- > 0) o << " "; } /// WE SHOULDN\'T NEED THIS void print_string_list(ostream & o, const List<StringElem> & strings) { Iterator<StringElem>iter = strings; if (iter.valid()) o << iter.current(); for (iter.next(); iter.valid(); iter.next()) o << ", " << iter.current(); } s_control_type::s_control_type (String & key, Expression *expr) : keyword(key) { this->expr.make_static_list(1); this->expr.modify(0, expr); } s_control_type::s_control_type() { this->expr.make_static_list(1); } s_control_type::~s_control_type() { this->expr.clear(); } Listable * s_control_type::listable_clone() const { s_control_type *hold = new s_control_type; hold->keyword = keyword; hold->expr = this->expr; return hold; } int s_control_type::structures_OK() const { p_abort("can not call structures_OK() on s_control_type"); return 1; } ostream & operator << (ostream & o, const s_control_type & sct) { sct.print(o); return o; } void s_control_type::print(ostream & o) const { o << "["; o << keyword << ", " << this->expr[0]; o << "]"; } void s_control_type::write(ostream & o) const { o << keyword << " = " << this->expr[0]; } /// //// OTHER HELPER FUNCTIONS void StmtPointer::_setptrs(Dictionary<VoidPtrDef> & NOTUSED(tags), const FormatDB & NOTUSED(formats)) { cerr << "StmtPointer::_setptrs: Method inappropriate\n"; } int StmtPointer::structures_OK() const { return 1; } void StmtPointer::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "STMT_PTR" )); S.ins( br ); } void StmtPointer::convert(BinRep & NOTUSED(stmt), ExprTable & NOTUSED(etable), Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> * NOTUSED(next_table)) { p_abort( "StmtPointer::convert: Can't convert a StmtPtr" ); } StmtPointer::StmtPointer(const char *l) : Statement(l, STMT_PTR) { /// ... nothing to do } StmtPointer::StmtPointer(const StmtPointer & stmt) : Statement(stmt.tag(), STMT_PTR) { copy_base(stmt); } StmtPointer & StmtPointer::operator = (const StmtPointer & stmt) { copy_base(stmt); return *this; } Statement * StmtPointer::clone() const { return new StmtPointer(*this); } StmtPointer::~StmtPointer() { /// ... nothing to do } void StmtPointer::fortran_write(ostream & NOTUSED(o), int & NOTUSED(indent), char * NOTUSED(type)) const { /// ... nothing to do } void StmtPointer::print_debug(ostream & o, int NOTUSED(debug)) const { o << "PTR TO " << _tag; } Statement * temp_stmt_ptr(BinRep & name) { p_assert(name.is_string(), "not a string"); String name_str; name.to_string(name_str); return (new StmtPointer(name_str)); } /// Given a BinRep (which should be a set of strings) and a list /// of Statement *, insert dummy statements into the list with the /// tagss indicated in the set. Stype is used for error messages. void convert_stmt_list(BinRep & set, List<Statement> &slist, const char *stype) { if (set.is_set()) { for (Iterator<BinRep> iter = set.to_set(); iter.valid(); ++iter) { BinRep & st_name = iter.current(); if (st_name.is_string()) slist.ins_last( temp_stmt_ptr(st_name) ); else { cerr << stype << "::convert:convert_stmt_list: " << "non-string encountered" << endl; p_abort( "(see above message)" ); } } } else if (set.is_tuple()) { for (Iterator<BinRep> iter = set.to_tuple(); iter.valid(); ++iter) { BinRep & st_name = iter.current(); if (st_name.is_string()) slist.ins_last( temp_stmt_ptr(st_name) ); else { cerr << stype << "::convert:convert_stmt_list: " << "non-string encountered" << endl; p_abort( "(see above message)" ); } } } else { cerr << "convert_stmt_list called with non-list in " << stype << ":convert" << endl; p_abort( "(see above message)" ); } } /// Given a BinRep (which should be a set of strings) and a list /// of Statement *, insert dummy statements into the list with the /// tags indicated in the set. Stype is used for error messages. void convert_stmt_list(BinRep &set, RefList<Statement> &sreflist, List<Statement> &slist, const char *stype) { if (set.is_set()) { for (Iterator<BinRep> iter = set.to_set(); iter.valid(); ++iter) { BinRep & st_name = iter.current(); if (st_name.is_string()) slist.ins_last(temp_stmt_ptr(st_name)); else { cerr << stype << "::convert:convert_stmt_list: " << "non-string encountered" << endl; p_abort( "(see above message)" ); } } for (Iterator<Statement> siter = slist; siter.valid(); ++siter) sreflist.ins_last(siter.current()); } else if (set.is_tuple()) { for (Iterator<BinRep> iter = set.to_tuple(); iter.valid(); ++iter) { BinRep & st_name = iter.current(); if (st_name.is_string()) slist.ins_last(temp_stmt_ptr(st_name)); else { cerr << stype << "::convert:convert_stmt_list: " << "non-string encountered" << endl; p_abort( "(see above message)" ); } } for (Iterator<Statement> siter = slist; siter.valid(); ++siter) sreflist.ins_last(siter.current()); } else { cerr << "convert_stmt_list called with non-list in " << stype << ":convert" << endl; p_abort( "(see above message)" ); } } void convert_stmt_list(BinRep & set, RefSet<Statement> & srefset, List<Statement> &slist, const char *stype) { if (set.is_set()) { for (Iterator<BinRep> iter = set.to_set(); iter.valid(); ++iter) { BinRep & st_name = iter.current(); if (st_name.is_string()) slist.ins_last(temp_stmt_ptr(st_name)); else { cerr << stype << "::convert:convert_stmt_list: " << "non-string encountered" << endl; p_abort( "(see above message)" ); } } for (Iterator<Statement> siter = slist; siter.valid(); ++siter) srefset.ins(siter.current()); } else if (set.is_tuple()) { for (Iterator<BinRep> iter = set.to_tuple(); iter.valid(); ++iter) { BinRep & st_name = iter.current(); if (st_name.is_string()) slist.ins_last(temp_stmt_ptr(st_name)); else { cerr << stype << "::convert:convert_stmt_list: " << "non-string encountered" << endl; p_abort( "(see above message)" ); } } for (Iterator<Statement> siter = slist; siter.valid(); ++siter) srefset.ins(siter.current()); } else { cerr << "convert_stmt_list called with non-list in " << stype << ":convert" << endl; p_abort( "(see above message)" ); } } /// Convert a binstr from a set of entries into the expression table /// into a list of pointers to expressions. void convert_expr_list(BinRep &entry_set, RefList<Expression> &exprs, ExprTable &expr_table, const char *caller) { for (Iterator<BinRep> iter = entry_set.to_set(); iter.valid(); ++iter) { BinRep & entry = iter.current(); if (entry.is_integer()) exprs.ins_last(*expr_table[entry.to_integer()]); else { cerr << caller << ":convert_expr_list: expression set contains non-int\n"; p_abort( "(see above message)" ); } } } /// Convert a binstr from a set of entries into the expression table /// into a list of pointers to expressions. void convert_expr_list(BinRep &entry_set, RefSet<Expression> &exprs, List<Expression> &exprs_list, ExprTable &expr_table, const char *caller) { for (Iterator<BinRep> iter = entry_set.to_set(); iter.valid(); ++iter) { BinRep & entry = iter.current(); if (entry.is_integer()) exprs_list.ins_last(expr_table[entry.to_integer()]); else { cerr << caller << ":convert_expr_list: expression set contains non-int\n"; p_abort( "(see above message)" ); } } for (Iterator<Expression> eiter = exprs_list; eiter.valid(); ++eiter) exprs.ins(eiter.current()); } /// Convert a binstr which is a tuple of strings into a list void convert_string_list(BinRep & string_tup, List<StringElem> &strings, const char *caller) { for (Iterator<BinRep> iter = string_tup.to_tuple(); iter.valid(); ++iter) { BinRep & str = iter.current(); if (!str.is_string()) { cerr << caller << ":convert_string_list: set contains non-string\n"; p_abort( "(see above message)" ); } else { StringElem *holder_str = new StringElem; str.to_string(*holder_str); strings.ins_last(holder_str); } } } /// Convert a binstr which is a tuple of set assertions into a list void convert_assert_list(BinRep & binstr, List<Assertion> & assertions, ExprTable & etable, const char * caller) { for (Iterator<BinRep> b_iter = binstr.to_tuple(); b_iter.valid(); ++b_iter) { BinRep & bp = b_iter.current(); if (! bp.is_set()) { cerr << caller << ":convert_assert_list: set contains non-map\n"; p_abort( "(see above message)" ); } else { String key; bp["key"].to_string( key ); Assertion *ap = 0; if (key == "CSRD$PRIVATE" || key == "CSRD$ PRIVATE") ap = new AssertPrivate; else if (key == "CSRD$PARALLEL" || key == "CSRD$ PARALLEL") ap = new AssertParallel; else if (key == "CSRD$LASTVALUE" || key == "CSRD$LAST_VALUE" || key == "CSRD$ LASTVALUE" || key == "CSRD$ LAST_VALUE") ap = new AssertLastValue; else if (key == "CSRD$REDUCTION" || key == "CSRD$ REDUCTION") ap = new AssertReduction; p_assert( ap, "unrecognized directive" ); assertions.ins_last( ap ); if (bp.find_ref("expr") != 0) { Expression *e = convert_expr(bp["expr"], etable, caller); if (e->op() != COMMA_OP) ap->arg_list_guarded().ins_first( e ); else { for (Mutator<Expression> e_iter = e->arg_list(); e_iter.valid(); ++e_iter) ap->arg_list_guarded().ins_last( e_iter.pull() ); } } } } } /// Change stmt * from a StmtPtr dummy to a pointer to a real statement /// (except in the case where the Statement pointer points to a Format statement) Boolean makeptr_ptr(Statement **ptr, Dictionary<VoidPtrDef> &tags) { p_assert((*ptr)->stmt_class() == STMT_PTR, "Object not a STMT_PTR"); VoidPtrDef *v = tags.find_ref((*ptr)->tag()); if (v == 0) { /// ... Check whether this is a Format statement (probably for an /// ... ASSIGN with a format label) if ( ((*ptr)->tag())[0] != 'F' ) p_abort("Label not found in program"); return False; } Statement *holder = (Statement *) (tags[(*ptr)->tag()]).ptr_ref(); delete *ptr; *ptr = holder; return True; } /// Determine if the statement expr1 = expr2 is in shape conformance /// (i.e. they are the same rank or expr2 is a scalar) Boolean shape_conformance(Expression & expr1, Expression & expr2) { return ((expr1.type().rank() == expr2.type().rank()) || (expr2.type().rank() == 0)); } /// VARIOUS PRIVATE FUNCTIONS void Statement::exchange_convert( VDL &vdl ) { BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->to_set(); BinRep *br = new BinRep( new List<BinRep> ); BinRep *bs = new BinRep( tag() ); BinRep *bt = new BinRep( new Set<BinRep> ); br->to_tuple().ins_last( bs ); br->to_tuple().ins_last( bt ); S.ins( br ); Set<BinRep> & T = b->find_ref("statements")->find_ref( tag() )->to_set(); /// ... Fill in the common fields. if (next_ref() != 0) { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "next" )); br->to_tuple().ins_last( new BinRep( next_ref()->tag() )); T.ins( br ); } if (prev_ref() != 0) { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "prev" )); br->to_tuple().ins_last( new BinRep( prev_ref()->tag() )); T.ins( br ); } if (line() > 0) { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "line" )); br->to_tuple().ins_last( new BinRep( line() )); T.ins( br ); } /// ... successors { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "successors" )); br->to_tuple().ins_last( new BinRep( new Set<BinRep> )); for (Iterator<Statement> iter = succ(); iter.valid(); ++iter) br->to_tuple()[1].to_set().ins(new BinRep(iter.current().tag())); T.ins( br ); } /// ... predecessors { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "predecessors" )); br->to_tuple().ins_last( new BinRep( new Set<BinRep> )); for (Iterator<Statement> iter = pred(); iter.valid(); ++iter) br->to_tuple()[1].to_set().ins(new BinRep(iter.current().tag())); T.ins( br ); } /// ... in_refs { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "in_refs" )); br->to_tuple().ins_last( new BinRep( new Set<BinRep> )); for (Iterator<Expression> iter = in_refs(); iter.valid(); ++iter) { br->to_tuple()[1].to_set().ins( new BinRep( iter.current().exchange_expr(vdl))); } T.ins( br ); } /// ... out_refs { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "out_refs" )); br->to_tuple().ins_last( new BinRep( new Set<BinRep> )); for (Iterator<Expression> iter = out_refs(); iter.valid(); ++iter) { br->to_tuple()[1].to_set().ins( new BinRep( iter.current().exchange_expr(vdl))); } T.ins( br ); } /// ... act_refs { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "act_refs" )); br->to_tuple().ins_last( new BinRep( new Set<BinRep> )); for (Iterator<Expression> iter = act_refs(); iter.valid(); ++iter) { br->to_tuple()[1].to_set().ins( new BinRep( iter.current().exchange_expr(vdl))); } T.ins( br ); } if (outer_ref() != 0) { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "outer" )); br->to_tuple().ins_last( new BinRep( outer_ref()->tag() )); T.ins( br ); } if (follow_ref() != 0) { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "follow" )); br->to_tuple().ins_last( new BinRep( follow_ref()->tag() )); T.ins( br ); } if (lead_ref() != 0) { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "lead" )); br->to_tuple().ins_last( new BinRep( lead_ref()->tag() )); T.ins( br ); } } Boolean Statement::marked_parallel() const { p_abort( "Statement::marked_parallel() called for " "wrong type of statement"); return false; } Boolean Statement::marked_serial() const { p_abort( "Statement::marked_serial() called for " "wrong type of statement"); return false; } RefSet<Symbol> * Statement::private_vars_ref() const /// Expressions from PRIVATE assertion { p_abort( "Statement::private_vars_ref() called for " "wrong type of statement"); return NULL; } void Statement::convert(BinRep & NOTUSED(stmt), ExprTable & NOTUSED(etable), Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> * NOTUSED(next_table) ) { /// ... All of the subclasses define this, so this is never called p_abort( "Statement::convert should never be called " "(should be over-ridden in all sub-classes)"); } /// _add_act_refs: checks whether the given expression is a FUNCTION_CALL_OP. /// If so, sends the parameter list to add_act_params to check whether /// any of the parameters may be included in the _act_refs set. If not, /// the expression's subexpressions are checked for FUNCTION_CALL_OPs /// recursively. void Statement::_add_act_refs (Expression &expr) { if (expr.op() == FUNCTION_CALL_OP) { if (expr.parameters_valid()) { _add_act_params (expr.parameters_guarded()); return; } } else { for (Iterator<Expression> iter = expr.arg_list(); iter.valid(); ++iter) _add_act_refs (iter.current()); } } /// _add_act_params: called with COMMA_OP or OMEGA_OP which is the /// parameter list of a function call. Looks at each /// argument in turn. If it is a simple ID_OP, or ARRAY_REF_OP, /// then it is put in the _act_refs set. Otherwise, it is just /// checked for embedded FUNCTION_CALL_OPs. void Statement::_add_act_params (Expression &expr) { p_assert (expr.op() == COMMA_OP || expr.op() == OMEGA_OP, "add_act_params called with non-COMMA_OP"); if (expr.op() == OMEGA_OP) return; for (Iterator<Expression> iter = expr.arg_list(); iter.valid(); ++iter) { if (iter.current().op() == ID_OP) _act_refs.ins (iter.current()); else if (iter.current().op() == ARRAY_REF_OP) { _act_refs.ins (iter.current()); _add_act_refs (iter.current().subscript()); } else if (iter.current().op() == SUBSTRING_OP) { _act_refs.ins (iter.current()); _add_act_refs (iter.current().bound()); } else { _add_act_refs (iter.current()); } } } /// _add_ioread_sets: This routine adds the appropriate members /// to each of the _in_refs, _out_refs, and _act_refs sets. /// The expression which is the argument MUST be an element of /// the CommaExpr which is the _iolist of a READ statement. /// This is a special case, because each "top-level" ID or ARRAY /// is taken to be written-to (by the READ statement), while /// everything else is read from. One complication is due to /// the fact that a function call with parameters may appear in /// a subscript, or in the iteration space expressions, so these /// parameters must be added to the _out_refs. /// /// NOTE that the _out_refs are not complete after this is through- /// the caller still needs to add all members of the _act_refs /// set to the _out_refs set upon return. void Statement::_add_ioread_sets (Expression &expr) { if (expr.op() == ID_OP) { _out_refs.ins (expr); return; } else if (expr.op() == ARRAY_REF_OP) { _out_refs.ins (expr); _add_in_refs (expr.subscript()); _add_act_refs (expr.subscript()); } else if (expr.op() == SUBSTRING_OP) { _out_refs.ins (expr); _add_in_refs (expr.bound()); _add_act_refs (expr.bound()); } else if (expr.op() == DO_OP) { _add_ioread_sets (expr.iolist()); _add_ioread_sets (expr.iterator()); } else if (expr.op() == EQUAL_OP) { _out_refs.ins (expr.index_id()); _add_in_refs (expr.iteration_space()); _add_act_refs(expr.iteration_space()); } else { for(Iterator<Expression> iter = expr.arg_list(); iter.valid(); ++iter) _add_ioread_sets (iter.current()); } } /// _add_in_refs: Check the given expression to see whether it /// is an ID_OP, or an ARRAY_REF_OP. If so, add it to the _in_refs /// set. If not, whether it is a call of some kind, so as to /// carefully ignore the ID_OP of the name of the function, but /// still check the parameters. For all other types of expressions, /// recursively check them for IDs and ARRAY_REFs to add to the set. void Statement::_add_in_refs (Expression &expr) { switch(expr.op()) { case ID_OP: _in_refs.ins(expr); break; case ARRAY_REF_OP: _in_refs.ins (expr); _add_in_refs (expr.subscript()); break; case SUBSTRING_OP: _in_refs.ins (expr); _add_in_refs (expr.bound()); break; case FUNCTION_CALL_OP: case INTRINSIC_CALL_OP: case LAMBDA_CALL_OP: /// ... Ignore the function_exp ID_OP !! if (expr.parameters_valid()) _add_in_refs (expr.parameters_guarded()); break; case GAMMA_OP: _add_in_refs (expr.gate()); /// ... Fall through into other psuedo-assignments case MU_OP: case ALPHA_OP: if (expr.parameters_valid()) _add_in_refs (expr.parameters_guarded()); break; case EQUAL_OP: /// ... Ignore the index_id_expression ID_OP !! (this is written) _add_in_refs (expr.iteration_space()); break; default: for (Iterator<Expression> iter = expr.arg_list(); iter.valid(); ++iter) _add_in_refs (iter.current()); } } /// _add_out_refs: This is only called when we are working with IOStmts, /// since they are the only ones which can have a DoExpr (A(I),I=1,N), /// and therefore can write to the loop index (I). /// /// EqualExpr is the ONLY case where you can tell from the expression alone /// that a variable is being written to. void Statement::_add_out_refs (Expression &expr) { if (expr.op() == EQUAL_OP) { _out_refs.ins (expr.index_id()); return; } else { for (Iterator<Expression> iter = expr.arg_list(); iter.valid(); ++iter) _add_out_refs (iter.current()); } } Mutator<Expression> Statement::iterate_expressions() { return Mutator<Expression> (_exprlist); } int Statement::iterate_in_exprs_valid() const { return (_exprlist.entries() > 0); } Mutator<Expression> Statement::iterate_in_exprs_guarded() { return Mutator<Expression> (_exprlist); } int Statement::iterate_out_exprs_valid() const { return 0; } Mutator<Expression> Statement::iterate_out_exprs_guarded() { static List<Expression> *_dummy = new List<Expression>; p_abort( "Statement::iterate_out_exprs_guarded should never be called " "(should be over-ridden in all usable sub-classes)"); return Mutator<Expression> (*_dummy); } int Statement::iterate_in_out_exprs_valid() const { return 0; } Mutator<Expression> Statement::iterate_in_out_exprs_guarded() { static List<Expression> *_dummy = new List<Expression>; p_abort( "Statement::iterate_in_out_exprs_guarded should never be called " "(should be over-ridden in all usable sub-classes)"); return Mutator<Expression> (*_dummy); } void Statement::simplify_expressions() { for (Mutator<Expression> iter = iterate_expressions() ; iter.valid() ; ++iter) { Assign<Expression> expr_as(iter.assign()); expr_as = simplify( iter.pull() ); } // rebuild the IN/OUT/ACT refs. build_refs(); } void Statement::relink_lptrs( ProgramUnit &p ) { for (Iterator<Assertion> a_iter = _assertion_list; a_iter.valid(); ++a_iter) if (a_iter.current_valid()) a_iter.current().relink_aptrs( p ); for (Iterator<Expression> e_iter = _exprlist; e_iter.valid(); ++e_iter) if (e_iter.current_valid()) e_iter.current().relink_eptrs( p ); SymbolAccessMap * map = new SymbolAccessMap; if (_access_table) { for (KeyIterator<Symbol, SymbolAccess> iter = *_access_table; iter.valid(); ++iter) { iter.current_data().relink_eptrs( p ); SymbolAccess * sa = _access_table->grab(iter.current_key()); Symbol * sym = p.symtab().find_ref(iter.current_key().name_ref()); map->ins(*sym, sa); } access_table( map ); } relink_sptrs(p); } void Statement::relink_sptrs( ProgramUnit & NOTUSED(p) ) { /// ... Default to doing nothing } /// Helper function: insert leftovers into the overflow void Statement::make_overflow(Iterator<BinRep> & iter, const char *exname) { warn_overflow_map(exname, iter.current()); if (!_overflow) { _overflow = new BinRep; Set<BinRep> *S = new Set<BinRep>; _overflow->put_set( S ); } _overflow->ins(iter.current()); } /// Helper function: Make sure overflow is empty void Statement::empty_overflow() { if (_overflow) delete _overflow; _overflow = 0; } /// Helper function: Copies other's base fields into *this. void Statement::copy_base(const Statement & other) { _exprlist.make_static_list(other._exprlist.entries()); for (int i=0; i< other._exprlist.entries(); ++i) if (other._exprlist.valid(i)) _exprlist.modify(i, other._exprlist[i].clone()); _type = other._type; _outer = other._outer; _state = other._state; _tag = other._tag; _line = other._line; if (other._access_table) { if (_access_table) { delete _access_table; } _access_table = other._access_table->clone( ); } else { _access_table = NULL; } /// ... _loop_info = other._loop_info; if (other._overflow) _overflow = new BinRep(*(other._overflow)); else _overflow = 0; _successors.clear(); _predecessors.clear(); _in_refs.clear(); _out_refs.clear(); _act_refs.clear(); _pre_directives = other._pre_directives; _post_directives = other._post_directives; _assertion_list = other._assertion_list; } void Statement::write_access_table( ostream & o) { if (_access_table) { _access_table->write( o, *this ); } } Boolean Statement::access_table_exists( ) { if (_access_table) { return True; } else { return False; } } Boolean Statement::symbol_access_exists( Symbol & sym ) { if (_access_table) { SymbolAccess * sa = _access_table->find_ref( sym ); if (sa) { return True; } } return False; } SymbolAccessMap & Statement::access_table( ) { return (SymbolAccessMap &) *_access_table; } void Statement::incorporate_access_table( const SymbolAccessMap & sam ) { this->_access_table->incorporate( sam ); } void Statement::ins_access( SymbolAccessMap & map ) { for (KeyIterator<Symbol, SymbolAccess> iter = map; iter.valid(); ++iter) { Symbol & sym = iter.current_key(); SymbolAccess & sym_acc = iter.current_data(); for (Mutator<AbstractAccess> muter_r = sym_acc.muter_read(); muter_r.valid(); ++muter_r) { ins_read_access(sym, muter_r.grab()); } for (Mutator<AbstractAccess> muter_w = sym_acc.muter_write(); muter_w.valid(); ++muter_w) { ins_write_access(sym, muter_w.grab()); } for (Mutator<AbstractAccess> muter_rw = sym_acc.muter_readwrite(); muter_rw.valid(); ++muter_rw) { ins_readwrite_access(sym, muter_rw.grab()); } } } void Statement::ins_read_access( Symbol & sym, List<AbstractAccess> & list ) { for (Mutator<AbstractAccess> muter_r = list; muter_r.valid(); ++muter_r) { ins_read_access( sym, muter_r.grab()); } } void Statement::ins_readwrite_access( Symbol & sym, List<AbstractAccess> & list ) { for (Mutator<AbstractAccess> muter_r = list; muter_r.valid(); ++muter_r) { ins_readwrite_access( sym, muter_r.grab()); } } void Statement::ins_write_access( Symbol & sym, List<AbstractAccess> & list ) { for (Mutator<AbstractAccess> muter_r = list; muter_r.valid(); ++muter_r) { ins_write_access( sym, muter_r.grab()); } } void Statement::ins_read_access( Symbol & sym, AbstractAccess * aa ) { SymbolAccess * sa = _access_table->find_ref( sym ); if (sa) { sa->add_read( aa ); } else { /// ... Didn't have a SymbolAccess for this symbol before SymbolAccess *new_sa = new SymbolAccess; new_sa->add_read( aa ); _access_table->ins( sym, new_sa ); } } void Statement::ins_write_access( Symbol & sym, AbstractAccess * aa ) { SymbolAccess * sa = _access_table->find_ref( sym ); if (sa) { sa->add_write( aa ); } else { /// ... Didn't have a SymbolAccess for this symbol before SymbolAccess *new_sa = new SymbolAccess; new_sa->add_write( aa ); _access_table->ins( sym, new_sa ); } } void Statement::ins_readwrite_access( Symbol & sym, AbstractAccess * aa ) { SymbolAccess * sa = _access_table->find_ref( sym ); if (sa) { sa->add_readwrite( aa ); } else { /// ... Didn't have a SymbolAccess for this symbol before SymbolAccess *new_sa = new SymbolAccess; new_sa->add_readwrite( aa ); _access_table->ins( sym, new_sa ); } } KeyIterator<Symbol, SymbolAccess> Statement::iter_access_table_guarded( ) { p_assert(_access_table, "No access table for this statement - use access_table_exists first"); KeyIterator<Symbol, SymbolAccess> iter = *_access_table; return iter; } /// Before calling one of these routines, call symbol_access_exists /// to be sure an access table exists and there is data for the /// symbol in it. Iterator<AbstractAccess> Statement::iter_read_guarded( Symbol & sym ) { p_assert(_access_table, "No access table for this statement - use symbol_access_exists first"); SymbolAccess * sa = _access_table->find_ref( sym ); p_assert(sa, "No symbol access for this statement - use symbol_access_exists first"); Iterator<AbstractAccess> iter = sa->iter_read(); return iter; } Iterator<AbstractAccess> Statement::iter_write_guarded( Symbol & sym ) { p_assert(_access_table, "No access table for this statement - use symbol_access_exists first"); SymbolAccess * sa = _access_table->find_ref( sym ); p_assert(sa, "No symbol access for this statement - use symbol_access_exists first"); Iterator<AbstractAccess> iter = sa->iter_write(); return iter; } Iterator<AbstractAccess> Statement::iter_readwrite_guarded( Symbol & sym ) { p_assert(_access_table, "No access table for this statement - use symbol_access_exists first"); SymbolAccess * sa = _access_table->find_ref( sym ); p_assert(sa, "No symbol access for this statement - use symbol_access_exists first"); Iterator<AbstractAccess> iter = sa->iter_readwrite(); return iter; } /// Converts an objects stmt-pointer fields from dummy\'s to actual pointers void Statement::_setptrs(Dictionary<VoidPtrDef> &tags, const FormatDB & NOTUSED(formats)) { Iterator<Statement> iter = _successors; /// ... set successors for (; iter.valid(); ++iter) _successors._modify( _successors._member(iter.current()), *((Statement *)tags[ iter.current().tag() ].ptr_ref())); /// ... THIS IS VERY BAD FORM! The _member function should NOT be used /// ... outside of the RefSet<T> implementation. /// ... set predecessors for (iter = _predecessors; iter.valid(); ++iter) _predecessors._modify( _predecessors._member(iter.current()), *((Statement *)tags[ iter.current().tag() ].ptr_ref())); /// ... THIS IS VERY BAD FORM! The _member function should NOT be used /// ... outside of the RefSet<T> implementation. /// ... Set outer field if (_outer) { makeptr_ptr(&_outer, tags); } } /// Convert the common fields of a statement return true if a match /// is found int Statement::check_common_fields(String & field, BinRep & second, ExprTable & etable, Dictionary<NextEntry> *next_table, char *caller) { if (field == "successors") { convert_stmt_list(second, _successors, _successors_list, caller); return 1; } else if (field == "predecessors") { convert_stmt_list(second, _predecessors, _predecessors_list, caller); return 1; } else if (field == "in_refs") { /// Discard (rebuild later) /// convert_expr_list(second, _in_refs, _in_refs_list, etable, caller); return 1; } else if (field == "out_refs") { /// Discard (rebuild later) /// convert_expr_list(second, _out_refs, _out_refs_list, etable, caller); return 1; } else if (field == "act_refs") { /// Discard (rebuild later) /// convert_expr_list(second, _act_refs, _act_refs_list, etable, caller); return 1; } else if (field == "outer") { _outer = temp_stmt_ptr(second); return 1; } else if (field == "assertions") { if (second.is_tuple()) { List<BinRep> & S = second.to_tuple(); if (S.entries() > 0) { if (S[0].is_string()) convert_string_list(second, _pre_directives, caller); else { convert_assert_list(second, _assertion_list, etable, caller); } } } return 1; } else if (field == "directives") { if (second.is_tuple()) { List<BinRep> & S = second.to_tuple(); if (S.entries() > 0) { if (S[0].is_string()) convert_string_list(second, _pre_directives, caller); else { convert_assert_list(second, _assertion_list, etable, caller); } } } return 1; } else if (field == "next") if (! second.is_string()) { cerr << "Statement::convert: 'next' field in " << _tag << " is not a string\n"; p_abort( "(see above message)" ); } else { NextEntry *next = new NextEntry(_tag, second); next_table->ins(next); return 1; } else if (field == "line") { p_assert(second.is_integer(), "line number is not an integer"); _line = second.to_integer(); return 1; } return 0; } /// Print all base fields followed by a close brace (in debugging /// mode, printing a statement prints an open backet) void Statement::print_fields(ostream & o) const { if (_successors.entries() > 0) { o << "succ = "; print_stmt_tags(o, (RefSet<Statement> &) _successors); o << ", "; } if (_predecessors.entries() > 0) { o << "pred = "; print_stmt_tags(o, (RefSet<Statement> &) _predecessors); o << ", "; } if (_in_refs.entries() > 0) { o << "in_refs = "; print_expr_list(o, (RefSet<Expression> &) _in_refs); o << ", "; } if (_out_refs.entries() > 0) { o << "out_refs = "; print_expr_list(o, (RefSet<Expression> &) _out_refs); o << ", "; } if (_act_refs.entries() > 0) { o << "act_refs = "; print_expr_list(o, (RefSet<Expression> &) _act_refs); o << ", "; } if (_outer) o << "outer = " << _outer->tag() << ", "; if (_pre_directives.entries() > 0) { o << "pre-dir = "; print_string_list(o, (List<StringElem> &) _pre_directives); o << ", "; } if (_post_directives.entries()>0) { o << "post-dir = "; print_string_list(o, (List<StringElem> &) _post_directives); o << ", "; } if (_line != -1) o << "line = " << _line << ", "; if (_work_stack.entries() > 0) { o << "work-stack = " << _work_stack << ", "; } if (assertions().entries() > 0) o << "assertions = " << assertions(); if (_overflow) o << "overflow = " << *_overflow; if (_access_table) { o << "access table = " << *_access_table; } if ((_type == ENTRY_STMT) && (((EntryStmt *) this)->access_summary_exists())) { o << "access summary = " << ((EntryStmt *)this)->access_summary(); } /// ... comment '{' o << " }"; } /// This outputs the statement with all debugging info (ie-all fields!) ostream & operator << (ostream & o, const Statement & st) { ostrstream o_src, o_dbg; st.print_debug(o_src, 0); st.print_debug(o_dbg, 1); st.print_fields(o_dbg); o_src << '\0'; o_dbg << '\0'; char *src_line = o_src.str(); char *dbg_line = o_dbg.str(); int poss_value = -1; if (st._type == LABEL_STMT) poss_value = st.value(); split_line(o, 6, st._tag, poss_value, src_line); split_line(o, 9, "", -1, dbg_line); /// ... delete src_line; /// ... delete dbg_line; /// ... silvius: fixed above o_src.freeze(0); o_dbg.freeze(0); return o; } inline void print_expr_ptr(ostream & o, const Expression * e) { if (e) o << *e; else o << "<UNDEF>"; } static char *type_string[] = { "UNDEFINED_STMT", "DO_STMT", "ENDDO_STMT", "WHILE_STMT", "ASSIGNMENT_STMT", "IF_STMT", "ELSEIF_STMT", "IMPLIED_GOTO_STMT", "ENDIF_STMT", "ELSE_STMT", "ASSIGN_STMT", "READ_STMT", "WRITE_STMT", "PRINT_STMT", "OPEN_STMT", "CLOSE_STMT", "REWIND_STMT", "BACKSPACE_STMT", "ENDFILE_STMT", "INQUIRE_STMT", "STOP_STMT", "PAUSE_STMT", "FLOW_ENTRY_STMT", "FLOW_EXIT_STMT", "BLOCK_ENTRY_STMT", "BLOCK_EXIT_STMT", "ENTRY_STMT", "CALL_STMT", "RETURN_STMT", "LABEL_STMT", "GOTO_STMT", "ARITHMETIC_IF_STMT", "COMPUTED_GOTO_STMT", "ASSIGNED_GOTO_STMT", "ALLOCATE_STMT", "DEALLOCATE_STMT", "NULLIFY_STMT", "DIRECTIVE_STMT", "STMT_PTR"}; void Statement::error(char *method_name) const { cerr << "A(n) '" << type_string[(int) _type] << "' object attempted to call the undefined method '" << method_name << "'.\n"; p_abort("(see above mesage)"); } /// Statement constructor takes two arguments: /// The statement type and the statement tag Statement::Statement(const char *l, STMT_TYPE st) : _type(st), _tag(l) { #ifdef CLASS_INSTANCE_REGISTRY register_instance(STATEMENT, sizeof(Statement), this); #endif _outer = 0; _overflow = 0; _access_table = NULL; #ifdef PERFORMANCE_EVAL _perf_estimator = NULL; _stmtProfile = 0L; #endif _line = -1; } Statement::~Statement() { #ifdef CLASS_INSTANCE_REGISTRY unregister_instance(STATEMENT, this); #endif if (_access_table) { delete _access_table; } if (_overflow) delete _overflow; _overflow = 0; } /// Check in/out/act _refs sets by saving them and /// recomputing them, then checking the saved one against /// the new one. int Statement::in_out_refs_structures_OK() const { const RefSet<Expression> act_refs_old = _act_refs; const RefSet<Expression> in_refs_old = _in_refs; const RefSet<Expression> out_refs_old = _out_refs; (CASTAWAY(Statement *) this)->build_refs(); /// ... Check _act_refs: int OK = 1; if ( !(_act_refs == act_refs_old) ) { cerr << "For statement: " << endl; cerr << *this << endl; cerr << "_act_refs set was: " << endl; cerr << " " << act_refs_old << endl; cerr << "Should have been: " << endl; cerr << " " << _act_refs << endl; OK = 0; } /// ... Check _in_refs: if ( !(_in_refs == in_refs_old) ) { if (OK) { cerr << "For statement: " << endl; cerr << *this << endl; } cerr << "_in_refs set was: " << endl; cerr << " " << in_refs_old << endl; cerr << "Should have been: " << endl; cerr << " " << _in_refs << endl; OK = 0; } /// ... Check _out_refs: if ( !(_out_refs == out_refs_old) ) { if (OK) { cerr << "For statement: " << endl; cerr << *this << endl; } cerr << "_out_refs set was: " << endl; cerr << " " << out_refs_old << endl; cerr << "Should have been: " << endl; cerr << " " << _out_refs << endl; OK = 0; } return OK; } Listable * Statement::listable_clone() const { Statement *new_stmt = clone(); if (dbx_statement_cloning_debug_level >= 100) { cout << "**Cloned statement:\n" << flush << *this << "** into new statement:\n" << flush << *new_stmt; } return new_stmt; } int Statement::io_list_valid() const { return 0; } const Expression & Statement::lhs() const { error("lhs()"); return DUMMY_EXPR; } Expression & Statement::lhs() { error("lhs()"); return DUMMY_EXPR; } const Expression & Statement::rhs() const { error("rhs()"); return DUMMY_EXPR; } Expression & Statement::rhs() { error("rhs()"); return DUMMY_EXPR; } Statement * Statement::follow_ref() const { return NULL; } Statement * Statement::lead_ref() const { return NULL; } Statement * Statement::matching_if_ref() const { return NULL; } Statement * Statement::matching_endif_ref() const { return NULL; } const Expression & Statement::index() const { error("index()"); return DUMMY_EXPR; } Expression & Statement::index() { error("index()"); return DUMMY_EXPR; } const Expression & Statement::init() const { error("init()"); return DUMMY_EXPR; } Expression & Statement::init() { error("init()"); return DUMMY_EXPR; } const Expression & Statement::limit() const { error("limit()"); return DUMMY_EXPR; } Expression & Statement::limit() { error("limit()"); return DUMMY_EXPR; } const Expression & Statement::step() const { error("step()"); return DUMMY_EXPR; } Expression & Statement::step() { error("step()"); return DUMMY_EXPR; } const Expression & Statement::expr() const { error("expr()"); return DUMMY_EXPR; } Expression & Statement::expr() { error("expr()"); return DUMMY_EXPR; } const Expression & Statement::expr_guarded() const { error("expr_guarded()"); return DUMMY_EXPR; } Expression & Statement::expr_guarded() { error("expr_guarded()"); return DUMMY_EXPR; } int Statement::expr_valid() const { return 0; } const Statement * Statement::target_ref() const { return NULL; } Statement * Statement::target_ref() { return NULL; } ASSIGN_TYPE Statement::atype() const { return INVALID_ASSIGN; } const Format * Statement::format_ref() const { return NULL; } Format * Statement::format_ref() { return NULL; } const RefList<Statement> & Statement::label_list() const { error("label_list()"); return *((RefList<Statement> *) 0); } RefList<Statement> & Statement::label_list() { error("label_list()"); return *((RefList<Statement> *) 0); } const List<s_control_type> & Statement::s_control_guarded() const { error("s_control_guarded()"); return *((List<s_control_type> *) 0); } List<s_control_type> & Statement::s_control_guarded() { error("s_control_guarded()"); return *((List<s_control_type> *) 0); } int Statement::s_control_valid() const { return False; } const Expression & Statement::io_list_guarded() const { error("io_list_guarded()"); return DUMMY_EXPR; } Expression & Statement::io_list_guarded() { error("io_list_guarded()"); return DUMMY_EXPR; } const Expression & Statement::routine_guarded() const { error("routine_guarded()"); return DUMMY_EXPR; } Expression & Statement::routine_guarded() { error("routine_guarded()"); return DUMMY_EXPR; } int Statement::routine_valid() const { return 0; } const Expression & Statement::parameters_guarded() const { error("parameters_guarded()"); return DUMMY_EXPR; } Expression & Statement::parameters_guarded() { error("parameters_guarded()"); return DUMMY_EXPR; } int Statement::parameters_valid() const { return 0; } int Statement::value() const { error("value()"); return -1; } /// will be redefined by sub-classes if field exists void Statement::lhs(Expression * NOTUSED(e)) { error("lhs(Expression)"); } void Statement::rhs(Expression * NOTUSED(e)) { error("rhs(Expression)"); } void Statement::index(Expression * NOTUSED(e)) { error("index(Expression)"); } void Statement::init(Expression * NOTUSED(e)) { error("init(Expression)"); } void Statement::limit(Expression * NOTUSED(e)) { error("limit(Expression)"); } void Statement::step(Expression * NOTUSED(e)) { error("step(Expression)"); } void Statement::expr(Expression * NOTUSED(e)) { error("expr(Expression)"); } void Statement::target(Statement * NOTUSED(s)) { error("target(Expression)"); } void Statement::io_list(Expression * NOTUSED(e)) { error("io_list(Expression)"); } void Statement::routine(Expression * NOTUSED(e)) { error("routine(Expression)"); } void Statement::parameters(Expression * NOTUSED(e)) { error("parameters(Expression)"); } void Statement::value(int NOTUSED(i)) { error("value(Expression)"); } String Statement::get_loop_name() { error("get_loop_name()"); return "ERROR"; } /// This one is to satisfy Listable void Statement::print(ostream & o) const { o << *this; } void Statement::write(ostream & o, int &indent, char *type GIV("")) const { ostrstream o_src; fortran_write(o_src, indent, type); o_src << '\0'; char *src_line = o_src.str(); int poss_value = -1; if (_type == LABEL_STMT) poss_value = value(); split_line(o, 0, "", poss_value, src_line); /// ... delete src_line; /// ... silvius: fixed above o_src.freeze(0); /// ... Take care of printing the loop private variables /// ... for parallel DO loops for Cedar Fortran if ((this->stmt_class() == DO_STMT) && (switch_value( "output_lang" ) == DT_CEDAR_FORTRAN) && this->marked_parallel() ) { Symtab privatesyms; RefSet<Symbol> *privates = this->private_vars_ref(); for (Iterator<Symbol> piter = *privates; piter.valid(); ++piter) { privatesyms.ins(piter.current().clone()); } delete privates; privatesyms.write(o, indent); /// ... Print the private symbol table } } RefSet<Statement> * Statement::build_succ(const StmtList & NOTUSED(stmts)) const { RefSet<Statement> *new_succ = new RefSet<Statement>; new_succ->ins(*next_ref()); return new_succ; } void Statement::build_refs() { _in_refs.clear(); _out_refs.clear(); _act_refs.clear(); } /// Assume that the flowgraph for statement <s> has changed. Update the /// pred() and succ() fields of all affected statements. void Statement::fix_flow( StmtList & stmts ) { RefSet<Statement> &old_succ = _successors; RefSet<Statement> *new_succ = build_succ(stmts); for (Iterator<Statement> iter_a = old_succ; iter_a.valid(); ++iter_a) { if (! new_succ->member( iter_a.current() )) iter_a.current()._predecessors.del( *this ); } for (Iterator<Statement> iter_b = *new_succ; iter_b.valid(); ++iter_b) { if (! old_succ.member( iter_b.current() )) iter_b.current()._predecessors.ins( *this ); } _successors = (*new_succ); delete new_succ; } /// To delete a statement <s>: (StmtList::del(Statement) does all this!) /// (1) create a list <l> of all predecessors of the statement <s>. /// (2) delete the entry <s> from the pred() lists of all successors of <s>. /// (3) delete the statement [ links are now inconsistant ]. /// (4) call fix_flow( statements in <l> ). void Statement::del_flow( StmtList & NOTUSED(stmts)) { for (Iterator<Statement> iter_a = succ(); iter_a.valid(); ++iter_a) iter_a.current()._predecessors.del( *this ); for (Iterator<Statement> iter_b = pred(); iter_b.valid(); ++iter_b) iter_b.current()._successors.del( *this ); _successors.clear(); _predecessors.clear(); } void AssignmentStmt::build_refs() { /// ... _in_refs and _act_refs come from the right-hand side and /// ... any array subscripting on the left-hand side _in_refs.clear(); _add_in_refs(this->rhs()); if (this->lhs().op() == ARRAY_REF_OP) _add_in_refs(this->lhs().subscript()); else if (this->lhs().op() == SUBSTRING_OP) _add_in_refs(this->lhs().bound()); _act_refs.clear(); _add_act_refs(this->rhs()); if (this->lhs().op() == ARRAY_REF_OP) _add_act_refs(this->lhs().subscript()); if (this->lhs().op() == SUBSTRING_OP) _add_act_refs(this->lhs().bound()); /// ... _out_refs are the act_refs plus the left-hand side expression _out_refs = _act_refs; _out_refs.ins(this->lhs()); } int AssignmentStmt::iterate_in_exprs_valid() const { return (_exprlist.valid(RHS) == True && _exprlist[RHS].op() != OMEGA_OP); } Mutator<Expression> AssignmentStmt::iterate_in_exprs_guarded() { /// input expr is rhs return Mutator<Expression>(_exprlist,&_exprlist[RHS],&_exprlist[RHS]); } int AssignmentStmt::iterate_out_exprs_valid() const { return (_exprlist.valid(LHS) == True && _exprlist[LHS].op() != OMEGA_OP); } Mutator<Expression> AssignmentStmt::iterate_out_exprs_guarded() { /// output expr is lhs return Mutator<Expression>(_exprlist,&_exprlist[LHS],&_exprlist[LHS]); } void AssignmentStmt::lhs(Expression *e) { _exprlist.modify(LHS, e); build_refs(); } void AssignmentStmt::rhs(Expression *e) { _exprlist.modify(RHS, e); build_refs(); } AssignmentStmt::AssignmentStmt(const char *l) : Statement(l, ASSIGNMENT_STMT) { _exprlist.make_static_list(2); _exprlist.modify(LHS, omega()); _exprlist.modify(RHS, omega()); } AssignmentStmt::AssignmentStmt(const char *l, Expression *lhs_exp, Expression *rhs_exp) : Statement(l, ASSIGNMENT_STMT) { if (!shape_conformance(*lhs_exp, *rhs_exp)) { cerr << "Assignment statement not in shape conformance!" << endl << "LHS: " << *lhs_exp << " (" << lhs_exp->type() << ")\n"; cerr << "RHS: " << *rhs_exp << " (" << rhs_exp->type() << ")\n"; p_assert(0, "AssignmentStatement::AssignmentStmt(char*, Expr, Expr):" "Exprs not in shape conformance"); } _exprlist.make_static_list(2); _exprlist.modify(LHS, null_to_omega(lhs_exp)); _exprlist.modify(RHS, null_to_omega(rhs_exp)); build_refs(); } AssignmentStmt::AssignmentStmt(const AssignmentStmt & stmt) : Statement(stmt.tag(), ASSIGNMENT_STMT) { copy_base(stmt); _exprlist.modify(LHS, stmt._exprlist[LHS].clone() ); _exprlist.modify(RHS, stmt._exprlist[RHS].clone() ); build_refs(); } AssignmentStmt & AssignmentStmt:: operator = (const AssignmentStmt & stmt) { copy_base(stmt); _exprlist.modify(LHS, stmt._exprlist[LHS].clone() ); _exprlist.modify(RHS, stmt._exprlist[RHS].clone() ); build_refs(); return *this; } Statement * AssignmentStmt::clone() const { return new AssignmentStmt(*this); } AssignmentStmt::~AssignmentStmt() { /// ... nothing to do } void AssignmentStmt::fortran_write(ostream &o, int &indent, char *NOTUSED(type)) const { fortran_indent( o, indent ); print_expr_ptr(o, &_exprlist[LHS]); o << " = "; print_expr_ptr(o, &_exprlist[RHS]); } void AssignmentStmt::print_debug(ostream & o, int debug) const { if (!debug) { print_expr_ptr(o, &_exprlist[LHS]); o << " = "; print_expr_ptr(o, &_exprlist[RHS]); } else o << " {"; /// ... comment '}' } int AssignmentStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void AssignmentStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "ASSIGNMENT" )); S.ins( br ); br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "lhs" )); br->to_tuple().ins_last( new BinRep( this->lhs().exchange_expr(vdl) )); S.ins( br ); br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "rhs" )); br->to_tuple().ins_last( new BinRep( this->rhs().exchange_expr(vdl) )); S.ins( br ); } void AssignmentStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "AssignmentStmt")) if (field == "lhs") _exprlist.modify(LHS, convert_expr(second, etable, "AssignmentStmt")); else if (field == "rhs") _exprlist.modify(RHS, convert_expr(second, etable, "AssignmentStmt")); else if ((field != "prev") && (field != "st")) make_overflow(iter, "AssignmentStmt"); } if (!shape_conformance(lhs(), rhs())) { cerr << "Assignment statement not in shape conformance!" << endl << "LHS: " << lhs() << " (" << lhs().type() << ")\n"; cerr << "RHS: " << rhs() << " (" << rhs().type() << ")\n"; p_assert(0, "AssignmentStatement::convert( ):" "Expressions not in shape conformance"); } } void DoStmt::build_refs() { /// ... _in_refs and _act_refs come from the _init, _limit, and _step exprs _in_refs.clear(); _add_in_refs(this->init()); _add_in_refs(this->limit()); _add_in_refs(this->step()); _act_refs.clear(); _add_act_refs(this->init()); _add_act_refs(this->limit()); _add_act_refs(this->step()); /// ... _out_refs are the act_refs plus the index expression _out_refs = _act_refs; _out_refs.ins(this->index()); } void DoStmt::index(Expression *e) { p_assert(e->op() == ID_OP, "DoStmt::index(Expression *): IDExpr expected"); _exprlist.modify(DO_INDEX, e); build_refs(); } void DoStmt::init(Expression *e) { _exprlist.modify(DO_INIT, e); build_refs(); } void DoStmt::limit(Expression *e) { _exprlist.modify(DO_LIMIT, e); build_refs(); } void DoStmt::step(Expression *e) { _exprlist.modify(DO_STEP, e); build_refs(); } DoStmt::DoStmt(const char *l) : Statement(l, DO_STMT) { _exprlist.make_static_list(4); _exprlist.modify(DO_INDEX, omega()); _exprlist.modify(DO_INIT, omega()); _exprlist.modify(DO_LIMIT, omega()); _exprlist.modify(DO_STEP, omega()); _follow = NULL; _target_label = 0; } DoStmt::DoStmt(const char *l, Expression *index_exp, Expression *init_exp, Expression *limit_exp, Expression *step_exp) : Statement(l, DO_STMT) { _exprlist.make_static_list(4); _follow = NULL; _target_label = 0; p_assert(index_exp->op() == ID_OP, "DoStmt( ): 'index' must be an IDExpr"); _exprlist.modify(DO_INDEX, null_to_omega(index_exp)); _exprlist.modify(DO_INIT, null_to_omega(init_exp)); _exprlist.modify(DO_LIMIT, null_to_omega(limit_exp)); _exprlist.modify(DO_STEP, null_to_omega(step_exp)); build_refs(); } DoStmt::DoStmt(const DoStmt & stmt) : Statement(stmt.tag(), DO_STMT) { copy_base(stmt); _follow = stmt._follow; _target_label = stmt._target_label; _exprlist.modify(DO_INDEX, stmt._exprlist[DO_INDEX].clone() ); _exprlist.modify(DO_INIT , stmt._exprlist[DO_INIT ].clone() ); _exprlist.modify(DO_LIMIT, stmt._exprlist[DO_LIMIT].clone() ); if (stmt._exprlist.valid(DO_STEP)) _exprlist.modify(DO_STEP, stmt._exprlist[DO_STEP].clone() ); build_refs(); } DoStmt & DoStmt::operator = (const DoStmt & stmt) { copy_base(stmt); _follow = stmt._follow; _target_label = stmt._target_label; _exprlist.modify(DO_INDEX, stmt._exprlist[DO_INDEX].clone() ); _exprlist.modify(DO_INIT , stmt._exprlist[DO_INIT ].clone() ); _exprlist.modify(DO_LIMIT, stmt._exprlist[DO_LIMIT].clone() ); if (stmt._exprlist.valid(DO_STEP)) _exprlist.modify(DO_STEP, stmt._exprlist[DO_STEP].clone() ); else _exprlist.modify(DO_STEP, NULL); build_refs(); return *this; } Statement * DoStmt::clone() const { return new DoStmt(*this); } DoStmt::~DoStmt() { /// ... nothing to do } void DoStmt::fortran_write(ostream & o, int & indent, char * NOTUSED(type)) const { fortran_indent( o, indent ); if ((switch_value( "output_lang" ) == DT_CEDAR_FORTRAN) && this->marked_parallel() ) { o << "XDOALL "; } else { o << "DO "; } print_expr_ptr(o, &_exprlist[DO_INDEX]); o << " = "; print_expr_ptr(o, &_exprlist[DO_INIT]); o << ", "; print_expr_ptr(o, &_exprlist[DO_LIMIT]); if (_exprlist.valid(DO_STEP)) o << ", " << _exprlist[DO_STEP]; ++indent; } void DoStmt::print_debug(ostream & o, int debug) const { if (debug) { o << " {"; /// ... comment '}' if (_follow) o << " follow = " << _follow->tag() << ", "; else o << " follow = UNDEF, "; } else { o << "DO "; print_expr_ptr(o, &_exprlist[DO_INDEX]); o << " = "; print_expr_ptr(o, &_exprlist[DO_INIT]); o << ", "; print_expr_ptr(o, &_exprlist[DO_LIMIT]); if (_exprlist.valid(DO_STEP)) o << ", " << _exprlist[DO_STEP]; } } int DoStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } String DoStmt::get_loop_name() { for(Iterator<Assertion> iter = this->assertions(); iter.valid(); ++iter) { if (iter.current().type() == AS_LOOPLABEL) { AssertLoopLabel &a = (AssertLoopLabel &) iter.current(); p_assert(a.string_arg_list_valid(), "Loop Label assertion with no valid name"); p_assert(a.string_arg_list_guarded().entries() == 1, "Only supporting Loop Label assertions with 1 field"); /// ... Returns the first LOOPLABEL it finds return (String) a.string_arg_list_guarded()[0]; } } return (String) ""; } RefSet<Symbol> * DoStmt::private_vars_ref() const { RefSet<Symbol> * privates = new RefSet<Symbol>; for(Iterator<Assertion> iter = this->assertions(); iter.valid(); ++iter) { if (iter.current().type() == AS_PRIVATE) { if (iter.current().arg_list_valid()) { for(Iterator<Expression> aiter = iter.current().arg_list_guarded(); aiter.valid(); ++aiter) { privates->ins(*(aiter.current().base_variable_ref())); } } } } return privates; } Boolean DoStmt::marked_parallel() const { for(Iterator<Assertion> iter = this->assertions(); iter.valid(); ++iter) { if (iter.current().type() == AS_PARALLEL) { return True; } } return False; } Boolean DoStmt::marked_serial() const { for(Iterator<Assertion> iter = this->assertions(); iter.valid(); ++iter) { if (iter.current().type() == AS_SERIAL) { return True; } } return False; } void DoStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "DO" )); S.ins( br ); br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "index" )); br->to_tuple().ins_last( new BinRep( this->index().exchange_expr(vdl) )); S.ins( br ); br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "init_expr" )); br->to_tuple().ins_last( new BinRep( this->init().exchange_expr(vdl) )); S.ins( br ); br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "limit_expr" )); br->to_tuple().ins_last( new BinRep( this->limit().exchange_expr(vdl) )); S.ins( br ); br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "step_expr" )); br->to_tuple().ins_last( new BinRep( this->step().exchange_expr(vdl) )); S.ins( br ); } void DoStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "DoStmt")) { if (field == "index") _exprlist.modify(DO_INDEX, convert_expr(second, etable, "DoStmt")); else if (field == "init_expr") _exprlist.modify(DO_INIT, convert_expr(second, etable, "DoStmt")); else if (field == "limit_expr") _exprlist.modify(DO_LIMIT, convert_expr(second, etable, "DoStmt")); else if (field == "step_expr") _exprlist.modify(DO_STEP, convert_expr(second, etable, "DoStmt")); else if (field == "target_label") _target_label = second.to_integer(); else if (field == "follow") _follow = temp_stmt_ptr(second); else if ((field != "prev") && (field != "st")) make_overflow(iter, "DoStmt"); } } } int DoStmt::target_label() const { return _target_label; } void DoStmt::target_label(int label) { _target_label = label; } void DoStmt::_setptrs(Dictionary<VoidPtrDef> &tags, const FormatDB &formats) { Statement::_setptrs(tags, formats); if (_follow) { makeptr_ptr(&_follow, tags); } } RefSet<Statement> * DoStmt::build_succ(const StmtList & NOTUSED(stmts)) const { RefSet<Statement> *new_succ = new RefSet<Statement>; new_succ->ins(*next_ref()); new_succ->ins(*follow_ref()->next_ref()); return new_succ; } EndDoStmt::EndDoStmt(const char *l) : Statement(l, ENDDO_STMT) { _follow = NULL; } EndDoStmt::EndDoStmt(const EndDoStmt & stmt) : Statement(stmt.tag(), ENDDO_STMT) { copy_base(stmt); _follow = stmt._follow; } EndDoStmt & EndDoStmt::operator = (const EndDoStmt & stmt) { copy_base(stmt); _follow = stmt._follow; return *this; } EndDoStmt::~EndDoStmt() { /// ... nothing to do } Statement * EndDoStmt::clone() const { return new EndDoStmt(*this); } void EndDoStmt::fortran_write(ostream &o, int &indent, char *NOTUSED(type)) const { --indent; fortran_indent( o, indent ); /// ... If we are producing Cedar Fortran, and the corresponding /// ... DO statement was marked parallel, use the corresponding /// ... type of ENDDO statement if ((switch_value( "output_lang") == DT_CEDAR_FORTRAN) && this->outer_ref()->marked_parallel()) { o << "ENDXDOALL"; } else { o << "ENDDO"; } } void EndDoStmt::print_debug(ostream & o, int debug) const { if (!debug) { o << "ENDDO"; } else { o << " {"; /// ... comment '}' if (_follow) o << " follow = " << _follow->tag() << ", "; else o << " follow = UNDEF, "; } } int EndDoStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void EndDoStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "ENDDO" )); S.ins( br ); } void EndDoStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "EndDoStmt")) { if (field == "follow") _follow = temp_stmt_ptr(second); else if ((field != "prev") && (field != "st")) make_overflow(iter, "EndDoStmt"); } } } void EndDoStmt::_setptrs(Dictionary<VoidPtrDef> &tags, const FormatDB &formats) { Statement::_setptrs(tags, formats); if (_follow) { makeptr_ptr(&_follow, tags); } } RefSet<Statement> * EndDoStmt::build_succ(const StmtList & NOTUSED(stmt)) const { RefSet<Statement> *new_succ = new RefSet<Statement>; new_succ->ins(*follow_ref()); return new_succ; } void IfStmt::build_refs() { /// ... _in_refs and _act_refs come from the If expression _in_refs.clear(); _add_in_refs(this->expr()); _act_refs.clear(); _add_act_refs(this->expr()); /// ... _out_refs are just the same as the act_refs _out_refs = _act_refs; } void IfStmt::expr(Expression *e) { _exprlist.modify(IF_EXPR, e); build_refs(); } IfStmt::IfStmt(const char *l) : Statement(l, IF_STMT) { _exprlist.make_static_list(1); _exprlist.modify(IF_EXPR, omega()); _follow = NULL; _matching_endif = NULL; } IfStmt::IfStmt(const char *l, Expression * expr_exp) : Statement(l, IF_STMT) { _exprlist.make_static_list(1); _follow = NULL; _matching_endif = NULL; _exprlist.modify(IF_EXPR, null_to_omega(expr_exp)); build_refs(); } IfStmt::IfStmt(const IfStmt & stmt) : Statement(stmt.tag(), IF_STMT) { copy_base(stmt); _follow = stmt._follow; _matching_endif = stmt._matching_endif; _exprlist.modify(IF_EXPR, stmt._exprlist[IF_EXPR].clone() ); build_refs(); } IfStmt & IfStmt::operator = (const IfStmt & stmt) { copy_base(stmt); _follow = stmt._follow; _matching_endif = stmt._matching_endif; _exprlist.modify(IF_EXPR, stmt._exprlist[IF_EXPR].clone() ); build_refs(); return *this; } Statement * IfStmt::clone() const { return new IfStmt(*this); } IfStmt::~IfStmt() { /// ... nothing to do } void IfStmt::fortran_write(ostream & o, int & indent, char * NOTUSED(type)) const { fortran_indent( o, indent ); o << "IF ("; print_expr_ptr(o, &_exprlist[IF_EXPR]); o << ") THEN"; ++indent; } void IfStmt::print_debug(ostream & o, int debug) const { if (!debug) { o << "IF ("; print_expr_ptr(o, &_exprlist[IF_EXPR]); o << ") THEN"; } else { o << " {"; /// ... comment '}' if (_follow) o << " follow = " << _follow->tag() << ", "; else o << " follow = UNDEF, "; if (_matching_endif) o << " matching_endif = " << _matching_endif->tag() << ", "; else o << " matching_endif = UNDEF, "; } } int IfStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void IfStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "IF" )); S.ins( br ); br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "expr" )); br->to_tuple().ins_last( new BinRep( this->expr().exchange_expr(vdl) )); S.ins( br ); } void IfStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "IfStmt")) { if (field == "follow") _follow = temp_stmt_ptr(second); else if (field == "expr") _exprlist.modify(IF_EXPR, convert_expr(second, etable, "IfStmt")); else if ((field != "prev") && (field != "st")) make_overflow(iter, "IfStmt"); } } } void IfStmt::_setptrs(Dictionary<VoidPtrDef> &tags, const FormatDB &formats) { Statement::_setptrs(tags, formats); if (_follow) { makeptr_ptr(&_follow, tags); } } RefSet<Statement> * IfStmt::build_succ(const StmtList & NOTUSED(stmt)) const { RefSet<Statement> *new_succ = new RefSet<Statement>; new_succ->ins(*next_ref()); new_succ->ins(*follow_ref()); return new_succ; } void ElseIfStmt::build_refs() { /// ... _in_refs and _act_refs come from the If expression _in_refs.clear(); _add_in_refs(this->expr()); _act_refs.clear(); _add_act_refs(this->expr()); /// ... _out_refs are just the same as the act_refs _out_refs = _act_refs; } void ElseIfStmt::expr(Expression *e) { _exprlist.modify(ELSEIF_EXPR, e); build_refs(); } ElseIfStmt::ElseIfStmt(const char *l) : Statement(l, ELSEIF_STMT) { _exprlist.make_static_list(1); _exprlist.modify(ELSEIF_EXPR, omega()); _follow = NULL; _lead = NULL; } ElseIfStmt::ElseIfStmt(const char *l, Expression * expr_exp) : Statement(l, ELSEIF_STMT) { _exprlist.make_static_list(1); _follow = NULL; _lead = NULL; _exprlist.modify(ELSEIF_EXPR, null_to_omega(expr_exp)); build_refs(); } ElseIfStmt::ElseIfStmt(const ElseIfStmt & stmt) : Statement(stmt.tag(), ELSEIF_STMT) { copy_base(stmt); _follow = stmt._follow; _lead = stmt._lead; _exprlist.modify(ELSEIF_EXPR, stmt._exprlist[ELSEIF_EXPR].clone() ); build_refs(); } ElseIfStmt & ElseIfStmt::operator = (const ElseIfStmt & stmt) { copy_base(stmt); _follow = stmt._follow; _lead = stmt._lead; _exprlist.modify(ELSEIF_EXPR, stmt._exprlist[ELSEIF_EXPR].clone() ); build_refs(); return *this; } Statement * ElseIfStmt::clone() const { return new ElseIfStmt(*this); } ElseIfStmt::~ElseIfStmt() { /// ... nothing to do } void ElseIfStmt::fortran_write(ostream & o, int & indent, char * NOTUSED(type)) const { --indent; fortran_indent( o, indent ); o << "ELSEIF ("; print_expr_ptr(o, &_exprlist[ELSEIF_EXPR]); o << ") THEN "; ++indent; } void ElseIfStmt::print_debug(ostream & o, int debug) const { if (!debug) { o << "ELSEIF ("; print_expr_ptr(o, &_exprlist[ELSEIF_EXPR]); o << ") THEN"; } else { o << " {"; /// ... comment '}' if (_follow) o << " follow = " << _follow->tag() << ", "; else o << " follow = UNDEF, "; if (_lead) o << "lead = " << _lead->tag() << ", "; else o << "lead = UNDEF, "; } } int ElseIfStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void ElseIfStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "ELSEIF" )); S.ins( br ); br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "expr" )); br->to_tuple().ins_last( new BinRep( this->expr().exchange_expr(vdl) )); S.ins( br ); } void ElseIfStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "ElseIfStmt")) { if (field == "follow") _follow = temp_stmt_ptr(second); else if (field == "expr") _exprlist.modify(ELSEIF_EXPR, convert_expr(second, etable, "ElseIfStmt")); else if ((field != "prev") && (field != "st")) make_overflow(iter, "ElseIfStmt"); } } } void ElseIfStmt::_setptrs(Dictionary<VoidPtrDef> &tags, const FormatDB &formats) { Statement::_setptrs(tags, formats); if (_follow) { makeptr_ptr(&_follow, tags); } } RefSet<Statement> * ElseIfStmt::build_succ(const StmtList & NOTUSED(stmts)) const { RefSet<Statement> *new_succ = new RefSet<Statement>; new_succ->ins(*next_ref()); new_succ->ins(*follow_ref()); return new_succ; } ImpliedGotoStmt::ImpliedGotoStmt(const char *l) : Statement(l, IMPLIED_GOTO_STMT) { _follow = NULL; } ImpliedGotoStmt::ImpliedGotoStmt(const ImpliedGotoStmt & stmt) : Statement(stmt.tag(), IMPLIED_GOTO_STMT) { copy_base(stmt); _follow = stmt._follow; } ImpliedGotoStmt & ImpliedGotoStmt::operator = (const ImpliedGotoStmt & stmt) { copy_base(stmt); _follow = stmt._follow; return *this; } Statement * ImpliedGotoStmt::clone() const { return new ImpliedGotoStmt(*this); } ImpliedGotoStmt::~ImpliedGotoStmt() { /// ... nothing to do } void ImpliedGotoStmt::fortran_write(ostream & NOTUSED(o), int & NOTUSED(indent), char * NOTUSED(type)) const { /// ... nothing to do } void ImpliedGotoStmt::print_debug(ostream & o, int debug) const { if (!debug) o << "IMPLIED_GOTO "; else { o << " {"; /// ... comment '}' if (_follow) o << " follow = " << _follow->tag() << ", "; else o << " follow = UNDEF, "; } } int ImpliedGotoStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void ImpliedGotoStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "IMPLIED_GOTO" )); S.ins( br ); } void ImpliedGotoStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "ImpliedGotoStmt")) { if (field == "follow") _follow = temp_stmt_ptr(second); else if ((field != "prev") && (field != "st")) make_overflow(iter, "ImpliedGotoStmt"); } } } void ImpliedGotoStmt::_setptrs(Dictionary<VoidPtrDef> &tags, const FormatDB &formats) { Statement::_setptrs(tags, formats); if (_follow) { makeptr_ptr(&_follow, tags); } } RefSet<Statement> * ImpliedGotoStmt::build_succ(const StmtList & NOTUSED(stmts)) const { RefSet<Statement> *new_succ = new RefSet<Statement>; new_succ->ins(*(this->follow_ref())); return new_succ; } EndIfStmt::EndIfStmt(const char *l) : Statement(l, ENDIF_STMT) { _matching_if = NULL; _lead = NULL; } EndIfStmt::EndIfStmt(const EndIfStmt & stmt) : Statement(stmt.tag(), ENDIF_STMT) { copy_base(stmt); _matching_if = stmt._matching_if; _lead = stmt._lead; } EndIfStmt & EndIfStmt::operator = (const EndIfStmt & stmt) { copy_base(stmt); _matching_if = stmt._matching_if; _lead = stmt._lead; return *this; } Statement * EndIfStmt::clone() const { return new EndIfStmt(*this); } EndIfStmt::~EndIfStmt() { /// ... nothing to do } void EndIfStmt::fortran_write(ostream & o, int & indent, char * NOTUSED(type)) const { --indent; fortran_indent( o, indent ); o << "ENDIF "; } void EndIfStmt::print_debug(ostream & o, int debug) const { if (!debug) o << "ENDIF "; else { o << " {"; /// ... comment '}' if (_matching_if) o << " matching_if = " << _matching_if->tag() << ", "; else o << " matching_if = UNDEF, "; if (_matching_if) o << "lead = " << _matching_if->tag() << ", "; else o << "lead = UNDEF, "; } } int EndIfStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void EndIfStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "ENDIF" )); S.ins( br ); } void EndIfStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "EndIfStmt")) { if ((field != "prev") && (field != "st") && (field != "lead")) make_overflow(iter, "EndIfStmt"); } } } ElseStmt::ElseStmt(const char *l) : Statement(l, ELSE_STMT) { _follow = NULL; _lead = NULL; } ElseStmt::ElseStmt(const ElseStmt & stmt) : Statement(stmt.tag(), ELSE_STMT) { copy_base(stmt); _follow = stmt._follow; _lead = stmt._lead; } ElseStmt & ElseStmt::operator = (const ElseStmt & stmt) { copy_base(stmt); _follow = stmt._follow; _lead = stmt._lead; return *this; } Statement * ElseStmt::clone() const { return new ElseStmt(*this); } ElseStmt::~ElseStmt() { /// ... nothing to do } void ElseStmt::fortran_write(ostream & o, int & indent, char * NOTUSED(type)) const { --indent; fortran_indent( o, indent ); o << "ELSE "; ++indent; } void ElseStmt::print_debug(ostream & o, int debug) const { if (!debug) o << "ELSE "; else { o << " {"; /// ... comment '}' if (_follow) o << " follow = " << _follow->tag() << ", "; else o << " follow = UNDEF, "; if (_lead) o << "lead = " << _lead->tag() << ", "; else o << "lead = UNDEF, "; } } int ElseStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void ElseStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "ELSE" )); S.ins( br ); } void ElseStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "ElseStmt")) { if (field == "follow") _follow = temp_stmt_ptr(second); else if ((field != "prev") && (field != "st") && (field != "lead")) make_overflow(iter, "ElseStmt"); } } } void ElseStmt::_setptrs(Dictionary<VoidPtrDef> &tags, const FormatDB &formats) { Statement::_setptrs(tags, formats); if (_follow) { makeptr_ptr(&_follow, tags); } } RefSet<Statement> * ElseStmt::build_succ(const StmtList & NOTUSED(stmts)) const { RefSet<Statement> *new_succ = new RefSet<Statement>; new_succ->ins(*next_ref()); /// ... The ELSE statement does not flow to the ENDIF. This causes problems /// ... with the constant propagation and the privatization. // /// ... But, if it did use the following line. /// ... new_succ->ins(*follow_ref()); return new_succ; } void AssignStmt::relink_sptrs(ProgramUnit &p) { /// ... Relink format pointer if (this->atype() == FORMAT_ASSIGN) { int label = this->format_ref()->value(); this->format(p.formats().find_ref(label)); } } void AssignStmt::build_refs() { /// ... _in_refs and _act_refs can only occur if we are assigning an array, /// ... via the subscripting expressions _in_refs.clear(); if (this->lhs().op() == ARRAY_REF_OP) _add_in_refs(this->lhs().subscript()); else if (this->lhs().op() == SUBSTRING_OP) _add_in_refs(this->lhs().bound()); _act_refs.clear(); if (this->lhs().op() == ARRAY_REF_OP) _add_act_refs(this->lhs().subscript()); else if (this->lhs().op() == SUBSTRING_OP) _add_act_refs(this->lhs().bound()); /// ... _out_refs are the act_refs plus the left-hand side expression _out_refs = _act_refs; _out_refs.ins(this->lhs()); } AssignStmt::AssignStmt(const char *l) : Statement(l, ASSIGN_STMT) { _exprlist.make_static_list(1); _exprlist.modify(LHS, omega()); _target = NULL; } AssignStmt::AssignStmt(const char *l, Expression *lhs_exp, Statement *target_stmt) : Statement(l, ASSIGN_STMT) { p_assert(target_stmt->stmt_class() == LABEL_STMT, "AssignStmt( ): the target statement must be a LabelStmt"); _exprlist.make_static_list(1); _exprlist.modify(LHS, null_to_omega(lhs_exp)); _target = target_stmt; _format = 0; _atype = EXECUTABLE_ASSIGN; build_refs(); } AssignStmt::AssignStmt(const AssignStmt & stmt) : Statement(stmt.tag(), ASSIGN_STMT) { copy_base(stmt); _target = stmt._target; _format = stmt._format; _atype = stmt._atype; _exprlist.modify(LHS, stmt._exprlist[LHS].clone() ); build_refs(); } AssignStmt & AssignStmt::operator = (const AssignStmt & stmt) { copy_base(stmt); _target = stmt._target; _format = stmt._format; _atype = stmt._atype; _exprlist.modify(LHS, stmt._exprlist[LHS].clone() ); build_refs(); return *this; } Statement * AssignStmt::clone() const { return new AssignStmt(*this); } AssignStmt::~AssignStmt() { /// ... nothing to do } void AssignStmt::lhs(Expression *ex) { _exprlist.modify(LHS, ex); build_refs(); } void AssignStmt::atype(ASSIGN_TYPE t) { _atype = t; } void AssignStmt::target(Statement *t) { if (t != 0) { p_assert(t->stmt_class() == LABEL_STMT, "AssignStmt::target(Statement *) LabelStmt expected"); } _target = t; } void AssignStmt::format(const Format *f) { _format = f->clone(); } void AssignStmt::fortran_write(ostream & o, int & indent, char * NOTUSED(type)) const { fortran_indent( o, indent ); o << "ASSIGN "; if (_atype == EXECUTABLE_ASSIGN) { if (_target) o << _target->value(); else o << "<UNDEF>"; } else { if (_format) o << _format->value(); else o << "<UNDEF>"; } o << " TO "; print_expr_ptr(o, &_exprlist[LHS]); } void AssignStmt::print_debug(ostream & o, int debug) const { if (!debug) { o << "ASSIGN "; if (_atype == EXECUTABLE_ASSIGN) { if (_target) o << _target->value(); else o << "<UNDEF>"; } else { if (_format) o << _format->value() << "[ " << _format->format_ref() << " ]"; else o << "<UNDEF>"; } o << " TO "; print_expr_ptr(o, &_exprlist[LHS]); } else o << " {"; /// ... comment '}' } int AssignStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void AssignStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "ASSIGN" )); S.ins( br ); br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "lhs" )); br->to_tuple().ins_last( new BinRep( this->lhs().exchange_expr(vdl) )); S.ins( br ); } void AssignStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "AssignStmt")) { if (field == "target") _target = temp_stmt_ptr(second); else if (field == "lhs") _exprlist.modify(LHS, convert_expr(second, etable, "AssignStmt")); else if ((field != "prev") && (field != "st")) make_overflow(iter, "AssignStmt"); } } } void AssignStmt::_setptrs(Dictionary<VoidPtrDef> &tags, const FormatDB &formats) { Statement::_setptrs(tags, formats); if (_target) { Boolean ok = makeptr_ptr(&_target, tags); if (ok) this->atype(EXECUTABLE_ASSIGN); else { this->atype(FORMAT_ASSIGN); const char *t = _target->tag(); int label = atoi(t+1); const Format *f = formats.find_ref(label); this->format(f); this->target(0); } } } void IOStmt::relink_sptrs(ProgramUnit &p) { /// ... Relink all expressions on the s_control list Iterator<s_control_type> iter = _s_control; while (iter.valid()) { iter.current().expr[0].relink_eptrs( p ); ++iter; } } void IOStmt::build_refs() { /// ... Clear out all sets: _in_refs.clear(); _out_refs.clear(); _act_refs.clear(); // First, build the in/out/act sets for the IO list switch (_type) { case WRITE_STMT: case PRINT_STMT: if (io_list_valid()) { for (Iterator<Expression> iter = io_list_guarded().arg_list(); iter.valid(); ++iter) { _add_in_refs(iter.current()); _add_act_refs(iter.current()); _add_out_refs(iter.current()); /// ... Gets any EQUAL_OPs in the iolist } } break; case READ_STMT: if (io_list_valid()) { for (Iterator<Expression> iter = io_list_guarded().arg_list(); iter.valid(); ++iter) { _add_ioread_sets (iter.current()); /// ... Special case where top-level vars /// ... are assumed to be WRITTEN } } break; /// ... The following have no IO list: case OPEN_STMT: case CLOSE_STMT: case REWIND_STMT: case BACKSPACE_STMT: case ENDFILE_STMT: case INQUIRE_STMT: break; default: break; } // Build the in/out/act sets for the control list for (Iterator<s_control_type> iter = s_control_guarded(); iter.valid(); ++iter) { s_control_type &s = iter.current(); if ((s.keyword == "IOSTAT") || (s.keyword == "ACCESS") || (s.keyword == "BLANK") || (s.keyword == "CARRIAGECONTROL") || (s.keyword == "DIRECT") || (s.keyword == "EXIST") || (s.keyword == "FORM") || (s.keyword == "FORMATTED") || (s.keyword == "NAME") || (s.keyword == "NAMED") || (s.keyword == "KEYED") || (s.keyword == "NEXTREC") || (s.keyword == "OPENED") || (s.keyword == "ORGANIZATION") || (s.keyword == "RECL") || (s.keyword == "RECORDTYPE") || (s.keyword == "SEQUENTIAL") || (s.keyword == "UNFORMATTED") || ((_type == INQUIRE_STMT) && (s.keyword == "UNIT"))) { if (s.expr[0].op() == ID_OP) _out_refs.ins ( s.expr[0] ); else if (s.expr[0].op() == ARRAY_REF_OP) { _out_refs.ins ( s.expr[0] ); _add_in_refs ( s.expr[0].subscript() ); _add_act_refs ( s.expr[0].subscript() ); } else if (s.expr[0].op() == SUBSTRING_OP) { _out_refs.ins ( s.expr[0] ); _add_in_refs ( s.expr[0].bound() ); _add_act_refs ( s.expr[0].bound() ); } } else if (s.keyword == "NML") { p_assert( _namelist, "read statement uses NML, but no namelist pointer set"); if (_type == READ_STMT) { for (Iterator<Expression> iter3 = _namelist->iolist(); iter3.valid(); ++iter3) { _out_refs.ins(iter3.current()); } } else if (_type == WRITE_STMT) { for (Iterator<Expression> iter3 = _namelist->iolist(); iter3.valid(); ++iter3) { _in_refs.ins(iter3.current()); } } } else { _add_in_refs ( s.expr[0] ); _add_act_refs( s.expr[0] ); } } /// ... _out_refs += _act_refs for (Iterator<Expression> iter2 = _act_refs; iter2.valid(); ++iter2) _out_refs.ins (iter2.current()); } IOStmt::IOStmt(STMT_TYPE st, const char *l) : Statement(l, st) { _exprlist.make_static_list(1); _exprlist.modify(IO_LIST, omega()); _namelist = 0; } IOStmt::IOStmt(STMT_TYPE st, const char *l, Expression * io_list_exp, s_control_type * s_1, s_control_type * s_2, s_control_type * s_3, s_control_type * s_4, s_control_type * s_5, s_control_type * s_6) : Statement(l, st) { p_assert(io_list_exp->op() == COMMA_OP, "IOStmt( ): 'io_list' must be a CommaExpr"); _exprlist.make_static_list(1); _exprlist.modify(IO_LIST, null_to_omega(io_list_exp)); _namelist = 0; if (s_1) _s_control.ins_last(s_1); if (s_2) _s_control.ins_last(s_2); if (s_3) _s_control.ins_last(s_3); if (s_4) _s_control.ins_last(s_4); if (s_5) _s_control.ins_last(s_5); if (s_6) _s_control.ins_last(s_6); build_refs(); } IOStmt::IOStmt(const IOStmt & stmt) : Statement(stmt.tag(), stmt._type) { copy_base(stmt); _s_control = stmt._s_control; _namelist = stmt._namelist; /// ... Make an alias to the NAMELIST, this does not own the object if (stmt._exprlist.valid(IO_LIST)) _exprlist.modify(IO_LIST, stmt._exprlist[IO_LIST].clone() ); build_refs(); } IOStmt & IOStmt::operator = (const IOStmt & stmt) { copy_base(stmt); _s_control = stmt._s_control; _namelist = stmt._namelist; /// ... Make an alias to the NAMELIST, this does not own the object if (stmt._exprlist.valid(IO_LIST)) _exprlist.modify(IO_LIST, stmt._exprlist[IO_LIST].clone() ); else _exprlist.modify(IO_LIST, NULL); build_refs(); return *this; } Statement * IOStmt::clone() const { return new IOStmt(*this); } IOStmt::~IOStmt() { _namelist = 0; } void IOStmt::io_list(Expression *e) { p_assert(e->op() == COMMA_OP, "IOStmt::io_list(Expression *): CommaExpr expected"); _exprlist.modify(IO_LIST, e); build_refs(); } List<s_control_type> & IOStmt::s_control_guarded() { return (List<s_control_type> &) _s_control; } const List<s_control_type> & IOStmt::s_control_guarded() const { return (const List<s_control_type> &) _s_control; } int IOStmt::s_control_valid() const { return True; } void IOStmt::fortran_write(ostream & o, int & indent, char * NOTUSED(type)) const { fortran_indent( o, indent ); switch (_type) { case READ_STMT: o << "READ "; break; case WRITE_STMT: o << "WRITE "; break; case PRINT_STMT: o << "PRINT "; break; case OPEN_STMT: o << "OPEN "; break; case CLOSE_STMT: o << "CLOSE "; break; case REWIND_STMT: o << "REWIND "; break; case BACKSPACE_STMT: o << "BACKSPACE "; break; case ENDFILE_STMT: o << "ENDFILE "; break; case INQUIRE_STMT: o << "INQUIRE "; break; default: break; } Iterator<s_control_type> iter = CASTAWAY(List<s_control_type> &) _s_control; if (_type == PRINT_STMT) { p_assert(iter.valid() && (_s_control.entries() == 1) && (iter.current().keyword == "FMT"), "PRINT statement can only have a FMT s_control_type entry"); o << iter.current().expr[0]; } else if (iter.valid()) { o << "(" ; s_control_type *s_unit = 0; s_control_type *s_fmt = 0; RefList<s_control_type> s_rest; for ( ; iter.valid(); ++iter) { if (iter.current().keyword == "UNIT") s_unit = &iter.current(); else if (iter.current().keyword == "FMT") s_fmt = &iter.current(); else s_rest.ins_last( iter.current() ); } /// ANSI Fortran 77 says you must have exactly ONE unit spec /// in a parenthesized control info list: READ (<control info list>) . . . Boolean wrote_something = True; if (s_unit == 0) { if (_type != INQUIRE_STMT) { o << "UNIT = *"; /// ... Represent the default unit } else { wrote_something = False; } if (s_fmt != 0) { s_rest.ins_first( *s_fmt ); s_fmt = 0; } } else { o << s_unit->expr[0]; if (s_fmt != 0) { o << ", " << s_fmt->expr[0]; s_fmt = 0; } } iter = s_rest; if (iter.valid()) { if (wrote_something) { o << ", "; } iter.current().write(o); ++iter; } for ( ; iter.valid(); ++iter) { o << ", "; iter.current().write(o); } o << ")"; } if (_exprlist.valid(IO_LIST)) { /// ... If there is one, print the IO list if (_exprlist[IO_LIST].arg_list().entries() > 0) { o << (_type == PRINT_STMT ? ", " : " "); _exprlist[IO_LIST].print(o); } } } void IOStmt::print_debug(ostream & o, int debug) const { if (debug) o << " {"; /// ... comment '}' else { switch (_type) { case READ_STMT: o << "READ "; break; case WRITE_STMT: o << "WRITE "; break; case PRINT_STMT: o << "PRINT "; break; case OPEN_STMT: o << "OPEN "; break; case CLOSE_STMT: o << "CLOSE "; break; case REWIND_STMT: o << "REWIND "; break; case BACKSPACE_STMT: o << "BACKSPACE "; break; case ENDFILE_STMT: o << "ENDFILE "; break; case INQUIRE_STMT: o << "INQUIRE "; break; default: break; } Iterator<s_control_type>iter = (List<s_control_type> &) _s_control; if (iter.valid()) { o << "(" << iter.current(); for (iter.next(); iter.valid(); iter.next()) o << ", " << iter.current(); o << ")"; } if (_exprlist.valid(IO_LIST)) { /// ... If there is one, print the IO list o << " "; _exprlist[IO_LIST].print(o); } } } int IOStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void IOStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); String st; switch (_type) { case READ_STMT: st = "READ"; break; case WRITE_STMT: st = "WRITE"; break; case PRINT_STMT: st = "PRINT"; break; case OPEN_STMT: st = "OPEN"; break; case CLOSE_STMT: st = "CLOSE"; break; case REWIND_STMT: st = "REWIND"; break; case BACKSPACE_STMT: st = "BACKSPACE"; break; case ENDFILE_STMT: st = "ENDFILE"; break; case INQUIRE_STMT: st = "INQUIRE"; break; default: st = "UNEXPECTED IOSTMT"; break;} BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( st )); S.ins( br ); } /// When converting IO Statements the structure of the s_control field is /// changed. In SETL, a FMT could be either an index in the expression /// table (an expression) or a string (an index in the format table). /// In the C++ version, s_control structs always contain an expression /// (along with the keyword). This is made possible by a new Expression /// called FormatExpr which simply contains the string found in SETL. void IOStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict &namelists, const FormatDB &formats, Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "IOStmt")) { if (field == "io_list") { _exprlist.modify(IO_LIST, convert_expr(second, etable, "IOStmt")); } else if (field == "s_control") { for (Iterator<BinRep> io_iter = second.to_set(); io_iter.valid(); ++io_iter) { s_control_type *sc = new s_control_type; io_iter.current()[0].to_string(sc->keyword); BinRep & ex = io_iter.current()[1]; if (ex.is_string()) { String ex_string; ex.to_string(ex_string); if (ex_string[0] == 'F') { /// ... We have a Format reference, such as 'F201' /// ... Check to make sure that it is in the correct /// ... format first int len = strlen((const char *) ex_string + 1); for (int i = 1; i < len; ++i) { p_assert( isdigit(ex_string[i]), "IOStmt::convert(): Format reference" " did not follow the format of 'Fxxx'" " where xxx is non-negative number" ); } char *format_tag = (char *) ((const char *) ex_string) + 1; int number = atoi(format_tag); p_assert(number > 0, "Format line number is zero"); sc->expr.modify(0, new FormatExpr(*formats.find_ref(number))); } else { /// ... What we want here is a LabelExpr. /// ... However, we don't yet know what the /// ... Statement pointer is--we just have its /// ... tag, which is ex_string. /// ... So, we'll just create a StmtLabelExpr for /// ... now and count on the _setptrs() method /// ... of IOStmt to change it into a LabelExpr. sc->expr.modify(0, new StmtLabelExpr(ex_string)); } } else if (ex.is_integer()) sc->expr.modify(0, etable[ex.to_integer()]); else { cerr << "IOStmt::convert: " << "Unrecognized s_control entry in statement " << _tag << " in " << io_iter.current() << endl; p_abort( "(see above message)" ); } _s_control.ins_last(sc); if (sc->keyword == "NML") { _namelist = CASTAWAY(Namelist *)namelists.find_ref(sc->expr[0].symbol().name_ref()); } } } else if ((field != "prev") && (field != "st")) { make_overflow(iter, "IOStmt"); } } } } void IOStmt::_setptrs(Dictionary<VoidPtrDef> &tags, const FormatDB &formats) { Statement::_setptrs(tags, formats); /// ... iterate through s_control: replace all StmtLabelExpr's with /// ... LabelExpr's for (Iterator<s_control_type>iter = _s_control; iter.valid(); ++iter) { if (iter.current().expr[0].op() == STMT_LABEL_OP) { Expression &stmt_label_expr = iter.current().expr[0]; Statement &stmt_ref = * (Statement *) tags[stmt_label_expr.data_ref()].ptr_ref(); iter.current().expr.modify(0, new LabelExpr(stmt_ref)); } } } RefSet<Statement> * IOStmt::build_succ(const StmtList & NOTUSED(stmts)) const { RefSet<Statement> *new_succ = new RefSet<Statement>; new_succ->ins(*next_ref()); for (Iterator<s_control_type>iter = _s_control; iter.valid(); ++iter) { if ((iter.current().keyword == "END") || (iter.current().keyword == "ERR")) { Expression &label_expr = iter.current().expr[0]; new_succ->ins(label_expr.stmt()); } } return new_succ; } StopStmt::StopStmt(const char *l) : Statement(l, STOP_STMT) { _exprlist.make_static_list(1); _exprlist.modify(STOP_EXPR, omega()); } StopStmt::StopStmt(const char *l, Expression * expr_exp) : Statement(l, STOP_STMT) { _exprlist.make_static_list(1); _exprlist.modify(STOP_EXPR, null_to_omega(expr_exp)); } StopStmt::StopStmt(const StopStmt & stmt) : Statement(stmt.tag(), STOP_STMT) { copy_base(stmt); if (stmt._exprlist.valid(STOP_EXPR)) _exprlist.modify(STOP_EXPR, stmt._exprlist[STOP_EXPR].clone() ); } StopStmt & StopStmt::operator = (const StopStmt & stmt) { copy_base(stmt); if (stmt._exprlist.valid(STOP_EXPR)) _exprlist.modify(STOP_EXPR, stmt._exprlist[STOP_EXPR].clone() ); else _exprlist.modify(STOP_EXPR, NULL); return *this; } Statement * StopStmt::clone() const { return new StopStmt(*this); } StopStmt::~StopStmt() { /// ... nothing to do } void StopStmt::expr(Expression * e) { _exprlist.modify(STOP_EXPR, e); } void StopStmt::fortran_write(ostream & o, int & indent, char * NOTUSED(type)) const { fortran_indent( o, indent ); o << "STOP "; if (_exprlist.valid(STOP_EXPR)) o << _exprlist[STOP_EXPR]; } void StopStmt::print_debug(ostream & o, int debug) const { if (debug) o << " {"; /// ... comment '}' else { o << "STOP "; if (_exprlist.valid(STOP_EXPR)) o << _exprlist[STOP_EXPR]; } } int StopStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void StopStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "STOP" )); S.ins( br ); if (expr_valid()) { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "expr" )); br->to_tuple().ins_last( new BinRep( this->expr_guarded().exchange_expr(vdl) )); S.ins( br ); } } void StopStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "StopStmt")) { if (field == "expr") _exprlist.modify(STOP_EXPR, convert_expr(second, etable, "StopStmt")); else if ((field != "prev") && (field != "st")) make_overflow(iter, "StopStmt"); } } } RefSet<Statement> * StopStmt::build_succ(const StmtList & stmts) const { RefSet<Statement> *new_succ = new RefSet<Statement>; Statement * fes = stmts._last_ref(); if (fes && fes->stmt_class() == FLOW_EXIT_STMT) new_succ->ins( *fes ); return new_succ; } void PauseStmt::expr(Expression * e) { _exprlist.modify(PAUSE_EXPR, e); } PauseStmt::PauseStmt(const char *l) : Statement(l, PAUSE_STMT) { _exprlist.make_static_list(1); _exprlist.modify(PAUSE_EXPR, omega()); } PauseStmt::PauseStmt(const char *l, Expression * expr_exp) : Statement(l, PAUSE_STMT) { _exprlist.make_static_list(1); _exprlist.modify(PAUSE_EXPR, null_to_omega(expr_exp)); } PauseStmt::PauseStmt(const PauseStmt & stmt) : Statement(stmt.tag(), PAUSE_STMT) { copy_base(stmt); if (stmt._exprlist.valid(PAUSE_EXPR)) _exprlist.modify(PAUSE_EXPR, stmt._exprlist[PAUSE_EXPR].clone() ); } PauseStmt & PauseStmt::operator = (const PauseStmt & stmt) { copy_base(stmt); if (stmt._exprlist.valid(PAUSE_EXPR)) _exprlist.modify(PAUSE_EXPR, stmt._exprlist[PAUSE_EXPR].clone() ); else _exprlist.modify(PAUSE_EXPR, NULL); return *this; } Statement * PauseStmt::clone() const { return new PauseStmt(*this); } PauseStmt::~PauseStmt() { /// ... nothing to do } void PauseStmt::fortran_write(ostream & o, int & indent, char * NOTUSED(type)) const { fortran_indent( o, indent ); o << "PAUSE "; if (_exprlist.valid(PAUSE_EXPR)) o << _exprlist[PAUSE_EXPR]; } void PauseStmt::print_debug(ostream & o, int debug) const { if (debug) o << " {"; /// ... comment '}' else { o << "PAUSE "; if (_exprlist.valid(PAUSE_EXPR)) o << _exprlist[PAUSE_EXPR]; } } int PauseStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void PauseStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "PAUSE" )); S.ins( br ); if (expr_valid()) { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "expr" )); br->to_tuple().ins_last( new BinRep( this->expr_guarded().exchange_expr(vdl) )); S.ins( br ); } } void PauseStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "PauseStmt")) { if (field == "expr") _exprlist.modify(PAUSE_EXPR, convert_expr(second, etable, "StopStmt")); else if ((field != "prev") && (field != "st")) make_overflow(iter, "PauseStmt"); } } } FlowEntryStmt::FlowEntryStmt(const char *l) : Statement(l, FLOW_ENTRY_STMT) { /// ... nothing to do } FlowEntryStmt::FlowEntryStmt(const FlowEntryStmt & stmt) : Statement(stmt.tag(), FLOW_ENTRY_STMT) { copy_base(stmt); } FlowEntryStmt & FlowEntryStmt::operator = (const FlowEntryStmt & stmt) { copy_base(stmt); return *this; } Statement * FlowEntryStmt::clone() const { return new FlowEntryStmt(*this); } FlowEntryStmt::~FlowEntryStmt() { /// ... nothing to do } void FlowEntryStmt::fortran_write(ostream & NOTUSED(o), int & NOTUSED(indent), char * NOTUSED(type)) const { /// ... nothing to do } void FlowEntryStmt::print_debug(ostream & o, int debug) const { if (!debug) o << "FLOWENTRY"; else o << " {"; /// ... comment '}' } int FlowEntryStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void FlowEntryStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "FLOW_ENTRY" )); S.ins( br ); } void FlowEntryStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "FlowEntryStmt")) { if ((field != "prev") && (field != "st") && (field != "follow")) make_overflow(iter, "FlowEntryStmt"); } } } RefSet<Statement> * FlowEntryStmt::build_succ(const StmtList &stmts) const { RefSet<Statement> *new_succ = new RefSet<Statement>; Iterator<Statement> iter = stmts.iterate_entry_points(); for( ; iter.valid(); ++iter) { if (iter.current().stmt_class() == ENTRY_STMT) new_succ->ins( iter.current() ); } if (next_ref() != 0) new_succ->ins(*next_ref()); return new_succ; } FlowExitStmt::FlowExitStmt(const char *l) : Statement(l, FLOW_EXIT_STMT) { /// ... nothing to do } FlowExitStmt::FlowExitStmt(const FlowExitStmt & stmt) : Statement(stmt.tag(), FLOW_EXIT_STMT) { copy_base(stmt); } FlowExitStmt & FlowExitStmt::operator = (const FlowExitStmt & stmt) { copy_base(stmt); return *this; } Statement * FlowExitStmt::clone() const { return new FlowExitStmt(*this); } FlowExitStmt::~FlowExitStmt() { /// ... nothing to do } void FlowExitStmt::fortran_write(ostream & NOTUSED(o), int & NOTUSED(indent), char * NOTUSED(type)) const { /// ... nothing to do } void FlowExitStmt::print_debug(ostream & o, int debug) const { if (!debug) o << "FLOWEXIT"; else o << " {"; /// ... comment '}' } int FlowExitStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void FlowExitStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "FLOW_EXIT" )); S.ins( br ); } void FlowExitStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "FlowExitStmt")) { if ((field != "prev") && (field != "st")) make_overflow(iter, "FlowExitStmt"); } } } RefSet<Statement> * FlowExitStmt::build_succ(const StmtList & NOTUSED(stmts) ) const { RefSet<Statement> *new_succ = new RefSet<Statement>; return new_succ; } void CallStmt::relink_sptrs( ProgramUnit & NOTUSED(p) ) { #if 0 _routine = p.symtab().find_ref(_routine->name_ref()); #endif } void CallStmt::build_refs() { /// ... Scoot through the call arguments to calc in_refs and _act_refs _in_refs.clear(); _act_refs.clear(); if (parameters_valid()) { _add_act_params (parameters_guarded()); for (Iterator<Expression> iter = parameters_guarded().arg_list(); iter.valid(); ++iter) { _add_in_refs(iter.current()); } } /// ... _out_refs are the same as the act_refs _out_refs = _act_refs; } int CallStmt::iterate_in_exprs_valid() const { return routine_valid(); } Mutator<Expression> CallStmt::iterate_in_exprs_guarded() { /// input expr is routine return Mutator<Expression>(_exprlist, &_exprlist[ROUTINE_EXPR], &_exprlist[ROUTINE_EXPR]); } int CallStmt::iterate_in_out_exprs_valid() const { return parameters_valid(); } Mutator<Expression> CallStmt::iterate_in_out_exprs_guarded() { /// in-out exprs are those on parameter list return Mutator<Expression>(parameters_guarded().arg_list()); } void CallStmt::parameters(Expression *e) { p_assert(e->op() == COMMA_OP, "CallStmt::parameters(Expression *): CommaExpr expected"); _exprlist.modify(PARAMETERS, e); build_refs(); } void CallStmt::routine(Expression *e) { p_assert(e->op() == ID_OP, "CallStmt::routine(Expression *): IdExpr expected"); _exprlist.modify(ROUTINE_EXPR, e); build_refs(); } CallStmt::CallStmt(const char *l) : Statement(l, CALL_STMT) { _exprlist.make_static_list(2); _exprlist.modify(ROUTINE_EXPR, omega()); _exprlist.modify(PARAMETERS, omega()); } CallStmt::CallStmt(const char *l, Expression *routine_exp, Expression *parameters_exp) : Statement(l, CALL_STMT) { p_assert(routine_exp->op() == ID_OP, "CallStmt( ): 'routine' must be a IdExpr"); p_assert(parameters_exp->op() == COMMA_OP, "CallStmt( ): 'parameters' must be a CommaExpr"); _exprlist.make_static_list(2); _exprlist.modify(ROUTINE_EXPR, null_to_omega(routine_exp)); _exprlist.modify(PARAMETERS, null_to_omega(parameters_exp)); build_refs(); } CallStmt::CallStmt(const CallStmt & stmt) : Statement(stmt.tag(), CALL_STMT) { copy_base(stmt); if (stmt._exprlist.valid(ROUTINE_EXPR)) _exprlist.modify(ROUTINE_EXPR, stmt._exprlist[ROUTINE_EXPR].clone() ); else _exprlist.modify(ROUTINE_EXPR, NULL); if (stmt._exprlist.valid(PARAMETERS)) _exprlist.modify(PARAMETERS, stmt._exprlist[PARAMETERS].clone() ); else _exprlist.modify(PARAMETERS, NULL); build_refs(); } CallStmt & CallStmt::operator = (const CallStmt & stmt) { copy_base(stmt); if (stmt._exprlist.valid(ROUTINE_EXPR)) _exprlist.modify(ROUTINE_EXPR, stmt._exprlist[ROUTINE_EXPR].clone() ); else _exprlist.modify(ROUTINE_EXPR, NULL); if (stmt._exprlist.valid(PARAMETERS)) _exprlist.modify(PARAMETERS, stmt._exprlist[PARAMETERS].clone() ); else _exprlist.modify(PARAMETERS, NULL); build_refs(); return *this; } Statement * CallStmt::clone() const { return new CallStmt(*this); } CallStmt::~CallStmt() { /// ... nothing to do } void CallStmt::fortran_write(ostream & o, int & indent, char * NOTUSED(type)) const { fortran_indent( o, indent ); o << "CALL "; if (_exprlist.valid(ROUTINE_EXPR)) o << _exprlist[ROUTINE_EXPR]; else o << "<INVALID>"; if (_exprlist.valid(PARAMETERS)) o << "(" << _exprlist[PARAMETERS] << ")"; } void CallStmt::print_debug(ostream & o, int debug) const { if (debug) o << " {"; /// ... comment '}' else { o << "CALL "; if (_exprlist.valid(ROUTINE_EXPR)) o << _exprlist[ROUTINE_EXPR]; else o << "<INVALID>"; if (_exprlist.valid(PARAMETERS)) o << "(" << _exprlist[PARAMETERS] << ")"; } } int CallStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void CallStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "CALL" )); S.ins( br ); if (parameters_valid()) { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "parameters" )); br->to_tuple().ins_last( new BinRep( this->parameters_guarded().exchange_expr(vdl) )); S.ins( br ); } } void CallStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & symtab, const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "CallStmt")) { if (field == "routine") { String second_str; second.to_string(second_str); _exprlist.modify(ROUTINE_EXPR, id(*symtab.find_ref(second_str))); } else if (field == "parameters") _exprlist.modify(PARAMETERS, convert_expr(second, etable, "CallStmt")); else if ((field != "prev") && (field != "st")) make_overflow(iter, "CallStmt"); } } } RefSet<Statement> * CallStmt::build_succ(const StmtList & NOTUSED(stmts)) const { RefSet<Statement> *new_succ = new RefSet<Statement>; new_succ->ins(*next_ref()); return new_succ; } void EntryStmt::relink_sptrs( ProgramUnit & NOTUSED(p) ) { #if 0 _routine = p.symtab().find_ref(_routine->name_ref()); #endif } Boolean EntryStmt::access_summary_exists() { if (_access_summary) { return True; } else { return False; } } SymbolAccessRefMap & EntryStmt::access_summary( ) { return (SymbolAccessRefMap &) *_access_summary; } void EntryStmt::write_access_summary( ostream & o) { if (_access_table) { _access_table->write( o, *this ); } else if (_access_summary) { _access_summary->write( o, *this ); } } void EntryStmt::access_summary( SymbolAccessRefMap * sarm ) { if (_access_summary) { delete _access_summary; } _access_summary = sarm; } void EntryStmt::parameters(Expression * e) { p_assert(e->op() == COMMA_OP, "EntryStmt::parameters(Expression *): CommaExpr expected"); _exprlist.modify(PARAMETERS, e); } void EntryStmt::routine(Expression *e) { p_assert(e->op() == ID_OP, "EntryStmt::routine(Expression *): IdExpr expected"); _exprlist.modify(ROUTINE_EXPR, e); } EntryStmt::EntryStmt(const char *l) : Statement(l, ENTRY_STMT) { _access_summary = 0; _exprlist.make_static_list(2); _exprlist.modify(ROUTINE_EXPR, omega()); _exprlist.modify(PARAMETERS, omega()); } EntryStmt::EntryStmt(const char *l, Expression *routine_exp, Expression *parameters_exp) : Statement(l, ENTRY_STMT) { p_assert(routine_exp && routine_exp->op() == ID_OP, "EntryStmt( ): 'routine' must be a IdExpr"); p_assert(parameters_exp && parameters_exp->op() == COMMA_OP, "EntryStmt( ): 'parameters' must be a CommaExpr"); _access_summary = 0; _exprlist.make_static_list(2); _exprlist.modify(ROUTINE_EXPR, null_to_omega(routine_exp)); _exprlist.modify(PARAMETERS, null_to_omega(parameters_exp)); } EntryStmt::EntryStmt(const char *l, Expression *routine_exp, Expression *parameters_exp, SymbolAccessRefMap * refmap) : Statement(l, ENTRY_STMT) { p_assert(routine_exp && routine_exp->op() == ID_OP, "EntryStmt( ): 'routine' must be a IdExpr"); p_assert(parameters_exp && parameters_exp->op() == COMMA_OP, "EntryStmt( ): 'parameters' must be a CommaExpr"); _access_summary = refmap; _exprlist.make_static_list(2); _exprlist.modify(ROUTINE_EXPR, null_to_omega(routine_exp)); _exprlist.modify(PARAMETERS, null_to_omega(parameters_exp)); } EntryStmt::EntryStmt(const EntryStmt & stmt) : Statement(stmt.tag(), ENTRY_STMT) { copy_base(stmt); if (stmt._access_summary) { _access_summary = new SymbolAccessRefMap(); _access_summary->incorporate(*stmt._access_summary); } else { _access_summary = 0; } if (stmt._exprlist.valid(ROUTINE_EXPR)) _exprlist.modify(ROUTINE_EXPR, stmt._exprlist[ROUTINE_EXPR].clone() ); if (stmt._exprlist.valid(PARAMETERS)) _exprlist.modify(PARAMETERS, stmt._exprlist[PARAMETERS].clone() ); } EntryStmt & EntryStmt::operator = (const EntryStmt & stmt) { copy_base(stmt); if (stmt._access_summary) { _access_summary = new SymbolAccessRefMap(); _access_summary->incorporate(*stmt._access_summary); } if (stmt._exprlist.valid(ROUTINE_EXPR)) _exprlist.modify(ROUTINE_EXPR, stmt._exprlist[ROUTINE_EXPR].clone() ); else _exprlist.modify(ROUTINE_EXPR, NULL); if (stmt._exprlist.valid(PARAMETERS)) _exprlist.modify(PARAMETERS, stmt._exprlist[PARAMETERS].clone() ); else _exprlist.modify(PARAMETERS, NULL); return *this; } Statement * EntryStmt::clone() const { return new EntryStmt(*this); } EntryStmt::~EntryStmt() { if (_access_summary) { delete _access_summary; } } void EntryStmt::fortran_write(ostream & o, int & indent, char * type) const { fortran_indent( o, indent ); if (type == "") { o << "ENTRY "; } else { o << type << " "; /// ... Main entry point of program unit } if (_exprlist.valid(ROUTINE_EXPR)) o << _exprlist[ROUTINE_EXPR]; if (_exprlist.valid(PARAMETERS)) { const Expression &e = _exprlist[PARAMETERS]; if (e.op() == COMMA_OP && e.arg_list().entries() > 0) { o << "(" << _exprlist[PARAMETERS] << ")"; } else { if (routine_guarded().op()==ID_OP){ switch(routine_guarded().symbol().sym_class()){ case FUNCTION_CLASS: /// ... silvius: f77 on Linux complains about functions like this: /// ... FUNCTION f /// ... It needs: /// ... FUNCTION f() o << "(" << ")"; } } } } else { if (routine_guarded().op()==ID_OP){ switch(routine_guarded().symbol().sym_class()){ case FUNCTION_CLASS: // silvius: f77 on Linux complains about functions like this: // FUNCTION f // It needs: // FUNCTION f() o << "(" << ")"; } } } } void EntryStmt::print_debug(ostream & o, int debug) const { if (!debug) { o << "ENTRY "; if (_exprlist.valid(ROUTINE_EXPR)) o << _exprlist[ROUTINE_EXPR]; if (_exprlist.valid(PARAMETERS)) o << "(" << _exprlist[PARAMETERS] << ")"; if (_access_summary) { o << " _access_summary={" << *_access_summary << "}"; } } else { o << " {"; /// ... comment '}' } } int EntryStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void EntryStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "ENTRY" )); S.ins( br ); if (parameters_valid()) { br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "parameters" )); br->to_tuple().ins_last( new BinRep( this->parameters_guarded().exchange_expr(vdl) )); S.ins( br ); } } void EntryStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & symtab, const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "EntryStmt")) { if (field == "routine") { String second_str; second.to_string(second_str); _exprlist.modify(ROUTINE_EXPR, id(*symtab.find_ref(second_str))); } else if (field == "parameters") _exprlist.modify(PARAMETERS, convert_expr(second, etable, "EntryStmt")); else if ((field != "prev") && (field != "st")) make_overflow(iter, "EntryStmt"); } } } void ReturnStmt::build_refs() { _in_refs.clear(); _act_refs.clear(); if (expr_valid()) { _add_in_refs(expr_guarded()); _add_act_refs(expr_guarded()); } /// ... _out_refs are the same as the act_refs _out_refs = _act_refs; } void ReturnStmt::expr(Expression * e) { _exprlist.modify(RETURN_EXPR, e); build_refs(); } ReturnStmt::ReturnStmt(const char *l) : Statement(l, RETURN_STMT) { _exprlist.make_static_list(1); _exprlist.modify(RETURN_EXPR, omega()); } ReturnStmt::ReturnStmt(const char *l, Expression * expr_exp) : Statement(l, RETURN_STMT) { _exprlist.make_static_list(1); _exprlist.modify(RETURN_EXPR, null_to_omega(expr_exp)); build_refs(); } ReturnStmt::ReturnStmt(const ReturnStmt & stmt) : Statement(stmt.tag(), RETURN_STMT) { copy_base(stmt); build_refs(); } ReturnStmt & ReturnStmt::operator = (const ReturnStmt & stmt) { copy_base(stmt); _exprlist.modify(RETURN_EXPR, NULL); build_refs(); return *this; } Statement * ReturnStmt::clone() const { return new ReturnStmt(*this); } ReturnStmt::~ReturnStmt() { /// ... nothing to do } void ReturnStmt::fortran_write(ostream & o, int & indent, char * NOTUSED(type)) const { fortran_indent( o, indent ); o << "RETURN "; if (_exprlist.valid(RETURN_EXPR)) o << _exprlist[RETURN_EXPR]; } void ReturnStmt::print_debug(ostream & o, int debug) const { if (!debug) { o << "RETURN "; if (_exprlist.valid(RETURN_EXPR)) o << _exprlist[RETURN_EXPR]; } else o << " {"; /// ... comment '}' } int ReturnStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void ReturnStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "RETURN" )); S.ins( br ); } void ReturnStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "ReturnStmt")) { if (field == "expr") _exprlist.modify(RETURN_EXPR, convert_expr(second, etable, "ReturnStmt")); else if ((field != "prev") && (field != "st")) make_overflow(iter, "ReturnStmt"); } } } RefSet<Statement> * ReturnStmt::build_succ(const StmtList & stmts) const { RefSet<Statement> *new_succ = new RefSet<Statement>; Statement *fes = stmts._last_ref(); if (fes && fes->stmt_class() == FLOW_EXIT_STMT) new_succ->ins( *fes ); return new_succ; } LabelStmt::LabelStmt(const char *l) : Statement(l, LABEL_STMT) { /// ... nothing to do } LabelStmt::LabelStmt(const char *l, int long_value) : Statement(l, LABEL_STMT) { _value = long_value; } LabelStmt::LabelStmt(const LabelStmt & stmt) : Statement(stmt.tag(), LABEL_STMT) { copy_base(stmt); _value = stmt._value; } LabelStmt & LabelStmt::operator = (const LabelStmt & stmt) { copy_base(stmt); _value = stmt._value; return *this; } Statement * LabelStmt::clone() const { return new LabelStmt(*this); } LabelStmt::~LabelStmt() { /// ... nothing to do } void LabelStmt::fortran_write(ostream & o, int & indent, char * NOTUSED(type)) const { fortran_indent( o, indent ); o << "CONTINUE "; } void LabelStmt::print_debug(ostream & o, int debug) const { if (!debug) o << "LABEL " << _value; else o << " {"; /// ... comment '}' } int LabelStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void LabelStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "LABEL" )); S.ins( br ); br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "label" )); br->to_tuple().ins_last( new BinRep( this->value() )); S.ins( br ); } void LabelStmt::convert(BinRep & stmt, ExprTable & etable, Symtab & NOTUSED(symtab), const NamelistDict & NOTUSED(namelists), const FormatDB & NOTUSED(formats), Dictionary<NextEntry> *next_table) { empty_overflow(); for (Iterator<BinRep> iter = stmt.to_set(); iter.valid(); ++iter) { List<BinRep> & t = iter.current().to_tuple(); BinRep & second = t[1]; /// ... The second argument of tuple pairs String field; t[0].to_string( field ); if (!check_common_fields(field, second, etable, next_table, "LabelStmt")) { if (field == "label") _value = (second.to_integer()); else if ((field != "prev") && (field != "st")) make_overflow(iter, "LabelStmt"); } } } GotoStmt::GotoStmt(const char *l) : Statement(l, GOTO_STMT) { _target = NULL; } GotoStmt::GotoStmt(const char *l, Statement * target_stmt) : Statement(l, GOTO_STMT) { p_assert(target_stmt->stmt_class() == LABEL_STMT, "GotoStmt( ): the target statement must be a LabelStmt"); _target = target_stmt; } GotoStmt::GotoStmt(const GotoStmt & stmt) : Statement(stmt.tag(), GOTO_STMT) { copy_base(stmt); _target = stmt._target; } GotoStmt & GotoStmt::operator = (const GotoStmt & stmt) { copy_base(stmt); _target = stmt._target; return *this; } void GotoStmt::target(Statement * s) { p_assert(s->stmt_class() == LABEL_STMT, "GotoStmt::target(Statement *): LabelStmt expected"); _target = s; } Statement * GotoStmt::clone() const { return new GotoStmt(*this); } GotoStmt::~GotoStmt() { /// ... nothing to do } void GotoStmt::fortran_write(ostream & o, int & indent, char * NOTUSED(type)) const { fortran_indent( o, indent ); o << "GOTO "; if (_target) o << _target->value(); else o << "<UNDEF>"; } void GotoStmt::print_debug(ostream & o, int debug) const { if (!debug) { o << "GOTO "; if (_target) o << _target->tag(); else o << "<UNDEF>"; } else { o << " {"; /// ... comment '}' } } int GotoStmt::structures_OK() const { int OK = Statement::in_out_refs_structures_OK(); return OK; } void GotoStmt::exchange_convert( VDL &vdl ) { Statement::exchange_convert( vdl ); BinRep *b = CASTAWAY(BinRep *) vdl.data_ref(); Set<BinRep> & S = b->find_ref("statements")->find_ref( tag() )->to_set(); BinRep *br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "st" )); br->to_tuple().ins_last( new BinRep( "UNCONDITIONAL_GOTO" )); S.ins( br ); br = new BinRep( new List<BinRep> ); br->to_tuple().ins_last( new BinRep( "target" )); br->to_tuple().ins_last( new BinRep( target_ref()->tag() )); S.