OpenAD-docs-20140315/htmlOpenADFortTkPlain/wn2xaif_8cxx_source.html

00001 #include <alloca.h>
00002 #include <stdlib.h>
00003 #include <string>
00004 #include <set>
00005 #include <vector>
00006
00007 #include "OpenAnalysis/CFG/ManagerCFG.hpp"
00008
00009 #include "Open64IRInterface/Open64BasicTypes.h"
00010 #include "Open64IRInterface/SymTab.h"
00011 #include "Open64IRInterface/Open64IRInterface.hpp"
00012
00013 #include "wn2xaif.i"
00014 #include "wn2xaif.h"
00015 #include "wn2xaif_stmt.h"
00016 #include "wn2xaif_expr.h"
00017 #include "wn2xaif_mem.h"
00018 #include "wn2xaif_io.h"
00019 #include "st2xaif.h"
00020 #include "ty2xaif.h"
00021 #include "Args.h"
00022
00023
00024 namespace whirl2xaif {
00025
00026   static void
00027   xlate_EntryPoint(xml::ostream& xos, WN *wn, PUXlationContext& ctxt);
00028
00029   static set<OA::SymHandle>*
00030   GetParamSymHandleSet(WN* wn_pu);
00031
00032   static const char*
00033   xlate_intent(WN* parm);
00034
00035   static void
00036   xlate_BBStmt(xml::ostream& xos, WN *wn, PUXlationContext& ctxt);
00037
00038   static void
00039   xlate_CFCondition(xml::ostream& xos, WN *wn, PUXlationContext& ctxt);
00040
00041   static void
00042   xlate_LoopInitialization(xml::ostream& xos, WN *wn, PUXlationContext& ctxt);
00043
00044   static void
00045   xlate_LoopUpdate(xml::ostream& xos, WN *wn, PUXlationContext& ctxt);
00046
00047   static void
00048   DumpCFGraphEdge(xml::ostream& xos, UINT eid,
00049                   OA::OA_ptr<OA::CFG::EdgeInterface> edge);
00050
00051   static const char*
00052   GetLoopReversalType(OA::OA_ptr<OA::CFG::CFGInterface> cfg,
00053                       OA::OA_ptr<OA::CFG::NodeInterface> n);
00054
00055   static std::string
00056   GetIDsForStmtsInBB(OA::OA_ptr<OA::CFG::NodeInterface> node,
00057                      PUXlationContext& ctxt);
00058
00059   // NOTE: removed static for Sun's compiler (supposed to be in unnamed
00060   // namespace now)
00061   pair<bool, INT64>
00062   GetCFGEdgeCondVal(const OA::OA_ptr<OA::CFG::EdgeInterface> edge);
00063
00064   // lt_CFGEdge: Used to sort CFG::Edges by src, sink and condition value.
00065   struct lt_CFGEdge
00066   {
00067     // return true if e1 < e2; false otherwise
00068     bool operator()(const OA::OA_ptr<OA::CFG::EdgeInterface> e1,
00069                     const OA::OA_ptr<OA::CFG::EdgeInterface> e2) const
00070     {
00071       unsigned int src1 = e1->getSource()->getId();
00072       unsigned int src2 = e2->getSource()->getId();
00073       if (src1 == src2) {
00074         unsigned int sink1 = e1->getSink()->getId();
00075         unsigned int sink2 = e2->getSink()->getId();
00076         if (sink1 == sink2) {
00077           pair<bool, INT64> ret1 = GetCFGEdgeCondVal(e1);
00078           bool hasCondVal1 = ret1.first;
00079           INT64 condVal1 = ret1.second;
00080
00081           pair<bool, INT64> ret2 = GetCFGEdgeCondVal(e2);
00082           bool hasCondVal2 = ret2.first;
00083           INT64 condVal2 = ret2.second;
00084
00085           if (hasCondVal1 && hasCondVal2) {
00086             return (condVal1 < condVal2);
00087           }
00088           else if (hasCondVal1 /* && !hasCondVal2 */) {
00089             return false;  // e1 > e2
00090           }
00091           else if (hasCondVal2 /* && !hasCondVal1 */) {
00092             return true; // e1 < e2
00093           }
00094           else /* !hasCondVal1 && !hasCondVal2 */ {
00095             return false; // e1 == e2
00096           }
00097         }
00098         else {
00099           return (sink1 < sink2);
00100         }
00101       }
00102       else {
00103         return (src1 < src2);
00104       }
00105     }
00106
00107   };
00108
00109   // the handlers
00110   typedef void (*Handler)(xml::ostream&, WN*, PUXlationContext&);
00111   static std::map<int,Handler> ourHandlerTable;
00112   static bool ourHandlerTableInit=false;
00113   void initOurHandlerTable();
00114
00115   // TranslateWN: see header. The task of translation is dispatched to
00116   // the appropriate handler registered in the handler table.
00117   void
00118   TranslateWN(xml::ostream& xos, WN *wn, PUXlationContext& ctxt)
00119   {
00120
00121     if (!wn) { return; }
00122
00123     OPERATOR opr = WN_operator(wn);
00124
00125 #if 0
00126     //xos << BegComment << "Translating " << OPERATOR_name(opr) << EndComment;
00127     fortTkSupport::WNId id = ctxt.findWNId(wn);
00128 #endif
00129
00130     // Determine whether we are in a context where we expect this
00131     // expression to have logically valued arguments, or whether we are
00132     // entering a context where we expect this expression to be a
00133     // logically valued argument.
00134     OPCODE opc = WN_opcode(wn);
00135     if (OPCODE_is_boolean(opc) && WN2F_expr_has_boolean_arg(opc)) {
00136       // We expect logical operands to this operator.  Note that this
00137       // may also be a logical argument, so
00138       // ctxt.currentXlationContext().isFlag(XlationContext::IS_LOGICAL_ARG) may also be true.
00139       ctxt.currentXlationContext().setFlag(XlationContext::HAS_LOGICAL_ARG);
00140     }
00141     else if (ctxt.currentXlationContext().isFlag(XlationContext::HAS_LOGICAL_ARG)) {
00142       // This is a logical argument.  This is the only place where we
00143       // should need to check whether this is expected to be a logical
00144       // valued expression. I.e. the only place where we apply
00145       // PUXlationContext_XlationContext::HAS_LOGICAL_ARG(context).  However, it may be
00146       // set at other places (e.g. in wn2f_stmt.c).
00147       ctxt.currentXlationContext().unsetFlag(XlationContext::HAS_LOGICAL_ARG);
00148       ctxt.currentXlationContext().setFlag(XlationContext::IS_LOGICAL_ARG);
00149     }
00150     else {
00151       ctxt.currentXlationContext().unsetFlag(XlationContext::HAS_LOGICAL_ARG);
00152       ctxt.currentXlationContext().unsetFlag(XlationContext::IS_LOGICAL_ARG);
00153     }
00154
00155     // Dispatch to the appropriate handler for this construct.
00156     if (!ourHandlerTableInit)
00157       initOurHandlerTable();
00158     return ourHandlerTable[opr](xos, wn, ctxt);
00159   }
00160
00161
00162   // Function entry handlers
00163
00164
00165   // xlate_FUNC_ENTRY: Given the root of a WHIRL tree, and an
00166   // appropriate context 'ctxt', emits XAIF for the tree to the 'xos'
00167   // stream.  Assumes that Open64 symbol table globals are already set.
00168   void
00169   xlate_FUNC_ENTRY(xml::ostream& xos, WN *wn, PUXlationContext& ctxt)
00170   {
00171     using namespace OA::CFG;
00172     using namespace OA::DGraph;
00173
00174     FORTTK_ASSERT(WN_operator(wn) == OPR_FUNC_ENTRY, fortTkSupport::Diagnostics::UnexpectedInput);
00175
00176     WN* fbody = WN_func_body(wn);
00177
00178     // -------------------------------------------------------
00179     // Collect auxillary data
00180     // -------------------------------------------------------
00181
00182     // 0. WHIRL parent map (FIXME: compute at callgraph)
00183     fortTkSupport::WhirlParentMap wnParentMap(wn);
00184     ctxt.setWNParentMap(&wnParentMap);
00185
00186     // 1. OpenAnalysis info
00187     OA::ProcHandle proc((OA::irhandle_t)Current_PU_Info);
00188
00189     fortTkSupport::IntraOAInfo* oaAnal = Whirl2Xaif::getOAAnalMap().Find(Current_PU_Info);
00190     OA::OA_ptr<OA::CFG::CFGInterface> cfg =
00191       Whirl2Xaif::getOAAnalMap().getCFGEach()->getCFGResults(proc);
00192     ctxt.setUDDUChains(oaAnal->getUDDUChainsXAIF());
00193     ctxt.setAliasMapXAIF(oaAnal->getAliasXAIF());
00194     ctxt.setDoChains(oaAnal->getReachDefsOverwriteXAIF());
00195
00196     // 2. Non-scalar symbol table
00197     fortTkSupport::ScalarizedRefTab_W2X* tab = Whirl2Xaif::getScalarizedRefTableMap().Find(Current_PU_Info);
00198     ctxt.setScalarizedRefTab(tab);
00199
00200     // 3. WHIRL<->ID maps
00201     fortTkSupport::WNToWNIdMap* wnmap = Whirl2Xaif::getWNToWNIdTableMap().Find(Current_PU_Info);
00202     ctxt.setWNToIdMap(wnmap);
00203
00204     // -------------------------------------------------------
00205     // Translate the function header
00206     // -------------------------------------------------------
00207     xlate_EntryPoint(xos, wn, ctxt);
00208     xos << std::endl;
00209
00210     // -------------------------------------------------------
00211     // Translate CFG (et al.) to XAIF
00212     // -------------------------------------------------------
00213     ctxt.createXlationContext(XlationContext::NOFLAG, wn);
00214
00215     // Dump CFG vertices (basic blocks) in sorted order ('normalized')
00216     // Note: It might seem that instead of sorting, we could simply use
00217     // DGraphStandard::DFSIterator.  However, procedures can have
00218     // unreachable code that will not be found with a DFS.  A simple
00219     // example of this is that WHIRL often has two OPR_RETURNs at the
00220     // end of a procedure.
00221 #if 0 // FIXME
00222     //     DGraphNodeVec* nodes = SortDGraphNodes(&cfg);
00223     //     for (DGraphNodeVec::iterator nodeIt = nodes->begin();
00224     //   nodeIt != nodes->end(); ++nodeIt) {
00225 #endif
00226
00227     // try a BFS iterator.  too bad for dead code. (actually DFS-- BFS
00228     // not yet implmented) -- toposort FIXME
00229     std::set<OA::OA_ptr<OA::CFG::NodeInterface> > usedNodes;
00230
00231     OA::OA_ptr<OA::CFG::NodeInterface> entry = cfg->getEntry();
00232     OA::OA_ptr<OA::DGraph::NodesIteratorInterface> nodeItPtr = cfg->getDFSIterator(entry);
00233     for (; nodeItPtr->isValid(); ++(*nodeItPtr)) {
00234       OA::OA_ptr<OA::DGraph::NodeInterface> dn = nodeItPtr->current();
00235       OA::OA_ptr<OA::CFG::Node> n = dn.convert<OA::CFG::Node>();
00236       usedNodes.insert(n);
00237       // std::cout << "visiting " << n->getId() << std::endl;
00238       const char* vtype = fortTkSupport::GetCFGVertexType(cfg, n);
00239       fortTkSupport::SymTabId scopeId = ctxt.findSymTabId(Scope_tab[CURRENT_SYMTAB].st_tab);
00240       std::string ids = GetIDsForStmtsInBB(n, ctxt);
00241       // 1. BB element begin tag
00242       xos << xml::BegElem(vtype) << xml::Attr("vertex_id", n->getId());
00243       if (vtype == XAIFStrings.elem_BB()) {
00244         xos << xml::Attr("scope_id", scopeId);
00245       }
00246       else if (vtype == XAIFStrings.elem_BBForLoop()) {
00247         xos << xml::Attr("reversal", GetLoopReversalType(cfg,n));
00248       }
00249       if (vtype == XAIFStrings.elem_BBForLoop()
00250           ||
00251           vtype == XAIFStrings.elem_BBPreLoop()
00252           ||
00253           vtype == XAIFStrings.elem_BBPostLoop()
00254           ||
00255           vtype == XAIFStrings.elem_BBBranch()) {
00256         // to get the line number we need to get
00257         // the whirl node which appears to be quite a chore
00258         OA::OA_ptr<OA::CFG::NodeStatementsIteratorInterface> stmtIt = n->getNodeStatementsIterator();
00259         bool found=false;
00260         for (; stmtIt->isValid() && !found; ++(*stmtIt)) {
00261           OA::StmtHandle st = stmtIt->current();
00262           WN* wstmt = (WN*)st.hval();
00263           // now we need to figure out which one of these it actually is:
00264           OPERATOR opr = WN_operator(wstmt);
00265           switch (opr) {
00266           case OPR_DO_LOOP:
00267           case OPR_DO_WHILE:
00268           case OPR_WHILE_DO:
00269           case OPR_IF:
00270           case OPR_SWITCH: {
00271             USRCPOS srcpos;
00272             USRCPOS_srcpos(srcpos) = WN_Get_Linenum(wstmt);
00273             xos << xml::Attr("lineNumber",USRCPOS_linenum(srcpos));
00274             found=true;
00275             break;
00276           }
00277           default:
00278             break; // fall through
00279           }
00280         }
00281       }
00282       // 2. BB element contents
00283       ctxt.createXlationContext();
00284       OA::OA_ptr<OA::CFG::NodeStatementsIteratorInterface> stmtItPtr
00285         = n->getNodeStatementsIterator();
00286       for (; stmtItPtr->isValid(); ++(*stmtItPtr)) {
00287         WN* wstmt = (WN *)stmtItPtr->current().hval();
00288         xlate_BBStmt(xos, wstmt, ctxt);
00289       }
00290       ctxt.deleteXlationContext();
00291       // 3. BB element end tag
00292       xos << xml::EndElem << std::endl;
00293     }
00294 #if 0
00295     delete nodes;
00296 #endif
00297
00298     // Dump CFG edges (only those within the XAIF graph)
00299     CFGEdgeVec* edges = SortCFGEdges(cfg);
00300     for (CFGEdgeVec::iterator edgeIt = edges->begin();
00301          edgeIt != edges->end(); ++edgeIt) {
00302       OA::OA_ptr<OA::CFG::EdgeInterface> e = (*edgeIt);
00303
00304       OA::OA_ptr<OA::DGraph::NodeInterface> dsrc = e->getSource();
00305       OA::OA_ptr<OA::CFG::Node> src = dsrc.convert<OA::CFG::Node>();
00306       OA::OA_ptr<OA::DGraph::NodeInterface> dsnk = e->getSink();
00307       OA::OA_ptr<OA::CFG::Node> snk = dsnk.convert<OA::CFG::Node>();
00308       if (usedNodes.find(src) != usedNodes.end() &&
00309           usedNodes.find(snk) != usedNodes.end()) {
00310         DumpCFGraphEdge(xos, ctxt.currentXlationContext().getNewEdgeId(), e);
00311       }
00312     }
00313
00314     delete edges;
00315
00316     // -------------------------------------------------------
00317     // Cleanup
00318     // -------------------------------------------------------
00319     ctxt.deleteXlationContext();
00320
00321
00322   }
00323
00324   // xlate_ALTENTRY:
00325   void
00326   xlate_ALTENTRY(xml::ostream& xos, WN *wn, PUXlationContext& ctxt)
00327   {
00328     // Similar to a FUNC_ENTRY, but without the function body.
00329     FORTTK_ASSERT(WN_operator(wn) == OPR_ALTENTRY, fortTkSupport::Diagnostics::UnexpectedInput);
00330
00331     // Translate the function entry point (FIXME)
00332     xlate_EntryPoint(xos, wn, ctxt);
00333
00334
00335   }
00336
00337
00338   void
00339   xlate_ignore(xml::ostream& xos, WN *wn, PUXlationContext& ctxt)
00340   {
00341
00342   }
00343
00344   void
00345   xlate_STRCTFLD(xml::ostream& xos,
00346                  WN *wn,
00347                  PUXlationContext& ctxt) {
00348     xlate_MemRef(xos,
00349                  wn,
00350                  WN_Tree_Type(wn),
00351                  WN_Tree_Type(wn),
00352                  0,
00353                  ctxt);
00354   }
00355
00356   void
00357   xlate_unknown(xml::ostream& xos, WN *wn, PUXlationContext& ctxt) {
00358     OPERATOR opr = WN_operator(wn);
00359     FORTTK_DIE(fortTkSupport::Diagnostics::UnexpectedOpr << OPERATOR_name(opr));
00360   }
00361
00362
00363   // FIXME: MOVE elsewhere
00364   bool
00365   IsActiveStmt(WN* wn, PUXlationContext& ctxt)
00366   {
00367     bool active = false;
00368
00369     OPERATOR opr = WN_operator(wn);
00370
00371     // if (OPERATOR_is_store(opr) || OPERATOR_is_call(opr)) { }
00372
00373     if (OPERATOR_is_call(opr)) {
00374       // FIXME: For now we punt on calls and assume they are active.
00375       active = true;
00376     }
00377     else if (OPERATOR_is_store(opr)) {
00378       TY_IDX ty = WN_Tree_Type(wn);
00379       const char* ty_str = TranslateTYToSymType(ty); // FIXME
00380       active = (strcmp(ty_str, "real") == 0 || strcmp(ty_str, "complex") == 0);
00381     }
00382
00383     return active;
00384   }
00385
00386
00387   // Variable references: xlate_SymRef, xlate_MemRef
00388
00389   // Helper for xlate_MemRef
00390   /* just used to maintain the state of the recursions when */
00391   /* marking FLDs in nested addresses                       */
00392   class LOC_INFO {
00393   private:
00394     FLD_PATH_INFO * _flds_left;   /* points to tail of fld_path */
00395     STAB_OFFSET _off;             /* offset of last FLD used in fld_path */
00396     BOOL   _base_is_array;        /* was ST of address an array? */
00397
00398   public:
00399     WN * _nested_addr;
00400
00401     LOC_INFO(FLD_PATH_INFO * path)
00402       : _flds_left(path), _off(0), _base_is_array(FALSE), _nested_addr(NULL) { }
00403
00404     void WN2F_Find_And_Mark_Nested_Address(WN * addr);
00405   };
00406
00407
00408   // xlate_PregRef: [FIXME: can we abstract witih xlate_SymRef]
00409   void
00410   xlate_PregRef(xml::ostream& xos, ST* st, TY_IDX preg_ty,
00411                 PREG_IDX preg_idx, PUXlationContext& ctxt)
00412   {
00413     bool closeVarRef = false;
00414     if (!ctxt.currentXlationContext().isFlag(XlationContext::VARREF)) {
00415       xos << xml::BegElem(XAIFStrings.elem_VarRef())
00416           << xml::Attr("vertex_id", ctxt.currentXlationContext().getNewVertexId())
00417           << xml::Attr("du_ud", ctxt.findUDDUChainId(ctxt.getMostRecentWN()))
00418           << xml::Attr("alias", ctxt.getAliasMapKey(ctxt.getMostRecentWN()));
00419       closeVarRef = true;
00420     }
00421
00422     ST_TAB* sttab = Scope_tab[ST_level(st)].st_tab;
00423     fortTkSupport::SymTabId scopeid = ctxt.findSymTabId(sttab);
00424
00425     xos << xml::BegElem("xaif:SymbolReference")
00426         << xml::Attr("vertex_id", ctxt.currentXlationContext().getNewVertexId())
00427         << xml::Attr("scope_id", scopeid) << AttrSymId(st) << PregIdAnnot(preg_idx)
00428         << xml::EndElem;
00429
00430     if (closeVarRef) {
00431       xos << xml::EndElem /* elem_VarRef() */;
00432     }
00433
00434
00435   }
00436
00437
00438   // xlate_SymRef: see header.
00439   void
00440   xlate_SymRef(xml::ostream& xos,
00441                ST* base_st,        // base symbol
00442                TY_IDX baseptr_ty,  // type of base symbol ptr
00443                TY_IDX ref_ty,      // type of referenced object
00444                STAB_OFFSET offset, // offset within 'base_st'
00445                PUXlationContext& ctxt)
00446   {
00447     // FIXME: ugly, ugly, ugly
00448     /* The base symbol 'base_st' will be treated as having a lvalue
00449      * (address) type of 'baseptr_ty', except when "deref" is TRUE, when
00450      * the rvalue of 'base_st' is assumed to have the 'base_ty'
00451      * and must either explicitly (for POINTER variables) or implicitly
00452      * (for pass by reference arguments) be dereferenced.
00453
00454      * Note that a compatible 'base_ty' and 'ref_ty' simply translates
00455      * into a reference to the given 'base_st'.  In all other cases we
00456      * expect 'ref_ty' to be a field or offset within the 'base_ty'
00457      * (structure or array).
00458      *
00459      * Note that we must have special handling for common-blocks and
00460      * equivalences.  Note that "base_ty" may be different from
00461      * "Stab_Pointer_To(ST_type(base_st))", both for "deref" cases and
00462      * ptr_as_array variables.  */
00463
00464     WN* ref_wn = ctxt.getMostRecentWN();
00465     TY_IDX base_ty = TY_pointed(baseptr_ty);
00466
00467     // -------------------------------------------------------
00468     // If we are not already within xaif:VariableReference... (FIXME: abstract)
00469     // -------------------------------------------------------
00470     bool constant = (ST_class(base_st) == CLASS_CONST);
00471     bool newContext = false;
00472     if (!constant && !ctxt.currentXlationContext().isFlag(XlationContext::VARREF)) {
00473       xos << xml::BegElem(XAIFStrings.elem_VarRef())
00474           << xml::Attr("vertex_id", ctxt.currentXlationContext().getNewVertexId())
00475           << xml::Attr("du_ud", ctxt.findUDDUChainId(ref_wn))
00476           << xml::Attr("alias", ctxt.getAliasMapKey(ref_wn));
00477       ctxt.createXlationContext(XlationContext::VARREF);
00478       newContext = true;
00479     }
00480
00481     /* Select variable-reference translation function */
00482     const BOOL deref_val = ctxt.currentXlationContext().isFlag(XlationContext::DEREF_ADDR);
00483     void (*translate_var_ref)(xml::ostream&, ST*, PUXlationContext&);
00484
00485     if (deref_val && (ST_sclass(base_st) != SCLASS_FORMAL)
00486         && TY_Is_Pointer(ST_type(base_st))
00487         && !TY_is_f90_pointer(ST_type(base_st))) {
00488       /* An explicit dereference */
00489       translate_var_ref = &ST2F_deref_translate;
00490     }
00491     else {
00492       /* A direct reference or an implicit dereference */
00493       translate_var_ref = &TranslateSTUse;
00494     }
00495
00496
00497     // FIXME: for now, make sure this is only used for data refs
00498     if (ST_class(base_st) == CLASS_FUNC) {
00499       std::cerr << "xlate_SymRef: translating function ref\n";
00500     }
00501     else if (ST_class(base_st) == CLASS_BLOCK) { // FIXME
00502       TranslateSTUse(xos, base_st, ctxt);
00503       xos << "+ " << Num2Str(offset, "%lld");
00504     }
00505
00506     // Note: top-var-refs will can be classified according to
00507     // IsRefSimple*() functions.  Things are a little more complicated
00508     // with sub-var-refs; hence the need for two tests in each 'if'.
00509
00510     fortTkSupport::ScalarizedRef* sym = ctxt.findScalarizedRef(ref_wn);
00511     if (sym) {
00512       // 1. A scalarized symbol
00513       ST_TAB* sttab = Scope_tab[CURRENT_SYMTAB].st_tab;
00514       fortTkSupport::SymTabId scopeid = ctxt.findSymTabId(sttab);
00515
00516       xos << xml::BegElem("xaif:SymbolReference")
00517           << xml::Attr("vertex_id", ctxt.currentXlationContext().getNewVertexId())
00518           << xml::Attr("scope_id", scopeid)
00519           << xml::Attr("symbol_id", sym->getName()) << xml::EndElem;
00520     }
00521     else if (fortTkSupport::ScalarizedRef::isRefScalar(base_ty, ref_ty)
00522              ||
00523              fortTkSupport::ScalarizedRef::isRefSimpleScalar(ref_wn)) {
00524       // 2. Reference to a scalar symbol (==> offset into 'base_st' is zero)
00525       translate_var_ref(xos, base_st, ctxt);
00526     }
00527     else if (TY_Is_Array(ref_ty)
00528              ||
00529              fortTkSupport::ScalarizedRef::isRefSimpleArray(ref_wn)) {
00530       // 3. Reference to an array of scalars
00531       translate_var_ref(xos, base_st, ctxt);
00532     }
00533     else if (TY_Is_Array(base_ty)
00534              ||
00535              fortTkSupport::ScalarizedRef::isRefSimpleArrayElem(ref_wn)) {
00536       // 4. Array element reference to a scalar
00537       translate_var_ref(xos, base_st, ctxt);
00538       if (!ctxt.currentXlationContext().isFlag(XlationContext::HAS_NO_ARR_ELMT)) { // FIXME: we expect arr elmt!
00539         TY2F_Translate_ArrayElt(xos, base_ty, offset);
00540         ctxt.currentXlationContext().unsetFlag(XlationContext::HAS_NO_ARR_ELMT);
00541       }
00542     }
00543     else {
00544       // 5.
00545       //FORTTK_DIE("Unknown ref type.");
00546       translate_var_ref(xos, base_st, ctxt);
00547
00548 #if 0 // FIXME:REMOVE
00549       /* We only dereference a field when the base need not be
00550        * dereferenced.  We never need to have both dereferenced,
00551        * since pointers cannot occur in RECORDS and common/
00552        * equivalence blocks cannot be referenced through pointer
00553        * identifiers. */
00554       FLD_PATH_INFO *fld_path = NULL;
00555       BOOL deref_fld;
00556       if ( !(TY_IsRecord(ref_ty) /* && FIXME*/) ) {
00557         deref_fld = (deref_val && !TY_Is_Pointer(ST_type(base_st))) ? TRUE:FALSE;
00558         if (deref_fld) { ref_ty = Stab_Pointer_To(ref_ty); }
00559         fld_path = TY2F_Get_Fld_Path(base_ty, ref_ty, offset);
00560       }
00561
00562       if (fld_path == NULL) {
00563         translate_var_ref(xos, base_st, ctxt);
00564       }
00565       else if (Stab_Is_Common_Block(base_st)) {
00566         // Common block reference (do not translate as field ref)
00567         // FIXME: make sure the fld_path is length 1
00568         ST_IDX st_idx = fld_path->fld.Entry()->st;
00569         ST* st = (st_idx != 0) ? ST_ptr(st_idx) : NULL;
00570         if (st) {
00571           translate_var_ref(xos, st, ctxt);
00572         }
00573         else { // FIXME
00574           TY2F_Translate_Fld_Path(xos, fld_path, deref_fld,
00575                                   // (Stab_Is_Common_Block(base_st) ||
00576                                   //  Stab_Is_Equivalence_Block(base_st)),
00577                                   TRUE, FALSE/*as_is*/, ctxt);
00578         }
00579
00580       } else {
00581
00582         // Structure:
00583         /* Base the path at the 'base_st' object, and separate it from
00584          * the remainder of the path with the field selection operator. */
00585         translate_var_ref(xos, base_st, ctxt);
00586         TY2F_Fld_Separator(xos);
00587         TY2F_Translate_Fld_Path(xos, fld_path, deref_fld,
00588                                 // (Stab_Is_Common_Block(base_st) ||
00589                                 //  Stab_Is_Equivalence_Block(base_st)),
00590                                 FALSE, FALSE/*as_is*/, ctxt);
00591       }
00592       if (fld_path) { TY2F_Free_Fld_Path(fld_path); }
00593 #endif
00594
00595     }
00596
00597     if (newContext) {
00598       ctxt.deleteXlationContext();
00599       xos << xml::EndElem /* elem_VarRef() */;
00600     }
00601
00602
00603   } /* xlate_SymRef */
00604
00605
00606   // xlate_MemRef:
00607   void
00608   xlate_MemRef(xml::ostream& xos,
00609                WN*    addr,        // base-address expr
00610                TY_IDX addr_ty,     // type of base-address
00611                TY_IDX ref_ty,      // type of referenced object
00612                STAB_OFFSET offset, // offset from base-address
00613                PUXlationContext& ctxt)
00614   {
00615     /* Given an address expression and an offset from this address,
00616      * append a Fortran expression to "xos" to reference an object of
00617      * type 'ref_ty' at this offset address.  In effect, we dereference
00618      * the address to 'ref_ty'.
00619
00620      FIXME
00621      * is a dereferencing operation on the base-address. The resultant
00622      * value (e.g. after a struct-field access) may be further
00623      * dereferenced.
00624      *
00625      * The address expression is unconditionally treated as an expression
00626      * of the addr_ty.
00627      *
00628      * For non-zero offsets, or when "!WN2F_Can_Assign_Types(ref_ty,
00629      * TY_pointed(addr_ty))", we expect the base-address to denote the
00630      * address of a structure or an array, where an object of the given
00631      * ref_ty can be found at the given offset.
00632      *
00633      * Since Fortran does not have an explicit (only implicit) dereference
00634      * operation we cannot first calculate the address and then
00635      * dereference. This constrains the kind of expression we may handle
00636      * here.  Note that equivalences and common-blocks always should be
00637      * accessed through an LDID or an LDA(?) node.  */
00638
00639     WN* ref_wn = ctxt.getMostRecentWN();
00640     TY_IDX base_ty = TY_pointed(addr_ty);
00641     const BOOL deref_fld = ctxt.currentXlationContext().isFlag(XlationContext::DEREF_ADDR);
00642
00643     // -------------------------------------------------------
00644     //
00645     // -------------------------------------------------------
00646     bool constant = (WN_operator(addr) == OPR_LDA
00647                      && ST_class(WN_st(addr)) == CLASS_CONST);
00648     bool newContext = false;
00649     if (!constant && !ctxt.currentXlationContext().isFlag(XlationContext::VARREF)) {
00650       // FIXME: for du_ud numbers; ARRAY, not ILOAD, is top of ref
00651       WN* wn = ref_wn;
00652       if (WN_operator(wn) == OPR_ILOAD
00653           && WN_operator(WN_kid0(wn)) == OPR_ARRAY) {
00654         wn = WN_kid0(wn);
00655       }
00656
00657       xos << xml::BegElem(XAIFStrings.elem_VarRef())
00658           << xml::Attr("vertex_id", ctxt.currentXlationContext().getNewVertexId())
00659           << xml::Attr("du_ud", ctxt.findUDDUChainId(wn))
00660           << xml::Attr("alias", ctxt.getAliasMapKey(wn));
00661       ctxt.createXlationContext(XlationContext::VARREF); // FIXME: do we need wn?
00662       newContext = true;
00663     }
00664
00665
00666     // -------------------------------------------------------
00667     //
00668     // -------------------------------------------------------
00669
00670     // FIXME: for now, make sure this is only used for data refs
00671     if (TY_kind(base_ty) == KIND_FUNCTION) {
00672       FORTTK_DIE(fortTkSupport::Diagnostics::Unimplemented << "memref FIXME");
00673     }
00674
00675
00676     /* Prepare to dereference the base-address expression */
00677     ctxt.currentXlationContext().setFlag(XlationContext::DEREF_ADDR);
00678
00679     if (WN2F_Is_Address_Preg(addr, addr_ty)) { // FIXME
00680       /* Optimizer may put address PREGS into ARRAYs */
00681       /* and high level type is more or less useless */
00682       /* just go with WN tree ADDs etc.              */
00683       TranslateWN(xos, addr, ctxt);
00684       if (offset != 0) {
00685         xos << '+' << offset /* "%lld" */;
00686       }
00687     }
00688     else {
00689       fortTkSupport::ScalarizedRef* sym = ctxt.findScalarizedRef(ref_wn);
00690       if (!sym && WN_operator(addr) == OPR_STRCTFLD) {
00691         sym = ctxt.findScalarizedRef(addr);
00692       }
00693       if (sym) {
00694         // 1. A scalarized symbol
00695         ST_TAB* sttab = Scope_tab[CURRENT_SYMTAB].st_tab;
00696         fortTkSupport::SymTabId scopeid = ctxt.findSymTabId(sttab);
00697
00698         xos << xml::BegElem("xaif:SymbolReference")
00699             << xml::Attr("vertex_id", ctxt.currentXlationContext().getNewVertexId())
00700             << xml::Attr("scope_id", scopeid)
00701             << xml::Attr("symbol_id", sym->getName().c_str()) << xml::EndElem;
00702       }
00703       else if (fortTkSupport::ScalarizedRef::isRefScalar(base_ty, ref_ty)
00704                ||
00705                fortTkSupport::ScalarizedRef::isRefSimpleScalar(ref_wn)) {
00706         // 2. Reference to a scalar symbol (==> offset into 'base_st' is zero)
00707         TranslateWN(xos, addr, ctxt);
00708       }
00709       else if (TY_Is_Array(ref_ty) || TY_Is_Array(base_ty)) { // FIXME
00710         // 3. Array reference (non-scalar)
00711         bool hasArrayElmt = !ctxt.currentXlationContext().isFlag(XlationContext::HAS_NO_ARR_ELMT);
00712         if (TY_Is_Character_String(base_ty)) {
00713           TranslateWN(xos, addr, ctxt); /* String lvalue */
00714           if (hasArrayElmt) {
00715             TY2F_Translate_ArrayElt(xos, base_ty, offset);
00716           }
00717         }
00718         else {
00719           TranslateWN(xos, addr, ctxt); /* Array */
00720           if (hasArrayElmt) {
00721             TY2F_Translate_ArrayElt(xos, base_ty, offset);
00722           }
00723           else {
00724             ctxt.currentXlationContext().unsetFlag(XlationContext::HAS_NO_ARR_ELMT);
00725           }
00726         }
00727       }
00728       else if ((WN_operator(addr) == OPR_LDA || WN_operator(addr) == OPR_LDID)
00729                && (TY_kind(base_ty) != KIND_STRUCT)
00730                && (Stab_Is_Common_Block(WN_st(addr))
00731                    || Stab_Is_Equivalence_Block(WN_st(addr)))) {
00732
00733         // 4. A common-block or equivalence-block, both of which we
00734         // handle only in xlate_SymRef().
00735         FORTTK_ASSERT_WARN(WN2F_Can_Assign_Types(ST_type(WN_st(addr)), base_ty),
00736                            "Incompatible types");
00737
00738         if (WN_operator(addr) == OPR_LDA) {
00739           ctxt.currentXlationContext().unsetFlag(XlationContext::DEREF_ADDR);
00740         }
00741         xlate_SymRef(xos, WN_st(addr), addr_ty, ref_ty,
00742                      offset + WN_lda_offset(addr) /*offset*/, ctxt);
00743       }
00744       else {
00745         // 5. Field access (Neither common-block nor equivalence)
00746         // Find the path to the field we wish to access and append
00747         // this path to the base-object reference.
00748
00749         /* Get any offset given by an address ADDition node.  The type
00750          * of the addition, as given by WN_Tree_Type(), is the type
00751          * of base-object within which we are accessing, so the addr_ty
00752          * is already set up correctly to handle the combined offsets.
00753          */
00754         TranslateWN(xos, addr, ctxt);
00755
00756 #if 0 // FIXME:REMOVE
00757         WN_OFFSET tmp = WN2F_Sum_Offsets(addr);
00758         if (tmp < TY_size(TY_pointed(addr_ty)))
00759           offset += tmp;
00760         else
00761           offset = tmp;
00762
00763         FLD_PATH_INFO* fld_path = TY2F_Get_Fld_Path(base_ty, ref_ty, offset);
00764         FORTTK_ASSERT_WARN(fld_path != NULL, "Non-existent FLD path");
00765
00766         /* May have ARRAY(ADD(ARRAY(LDA),CONST)) or some such. */
00767         /* The deepest ARRAY (with the address) is handled     */
00768         /* by the xlate_ARRAY processing, but the others        */
00769         /* are field references with array components.         */
00770         LOC_INFO det(fld_path);
00771         det.WN2F_Find_And_Mark_Nested_Address(addr);
00772         addr = det._nested_addr;
00773
00774         /* Get the base expression to precede the path */
00775         TranslateWN(xos, addr, ctxt);
00776         TY2F_Fld_Separator(xos);
00777
00778         /* Append the path-name, perhaps w/o array subscripts. */
00779         if (fld_path != NULL) {
00780           TY2F_Translate_Fld_Path(xos, fld_path, deref_fld,
00781                                   FALSE/*common*/, FALSE/*as_is*/, ctxt);
00782           TY2F_Free_Fld_Path(fld_path);
00783         }
00784         else {
00785           xos << "field-at-offset=" << offset /* %lld */;
00786         }
00787 #endif
00788       }
00789     }
00790
00791     if (newContext) {
00792       ctxt.deleteXlationContext();
00793       xos << xml::EndElem /* elem_VarRef() */;
00794     }
00795
00796
00797   } /* xlate_MemRef */
00798
00799
00800   void
00801   LOC_INFO::WN2F_Find_And_Mark_Nested_Address(WN * addr)
00802   {
00803     /* If this address expression contains nested ARRAY nodes */
00804     /* (and isn't a character expression), the ARRAYs refer   */
00805     /* to structure components, eg: aaa(1).kkk(3) yields      */
00806     /* ARRAY(ADD(const,ARRAY(LDA)). Add a pointer to the      */
00807     /* array elements of the fld path, associating each with  */
00808     /* corresponding OPC_ARRAY. TY2F_Translate_Fld_Path will  */
00809     /* write the subscript list.                              */
00810
00811     /* In general, just the lowest LDID/LDA remains to be     */
00812     /* processed, however if the lowest ARRAY node is not a   */
00813     /* fld, and belongs to the address ST, then return that   */
00814     /* ARRAY.                                                 */
00815     OPERATOR opr = WN_operator(addr);
00816     switch (opr)
00817       {
00818       case OPR_ARRAY:
00819       case OPR_ARRAYEXP:
00820       case OPR_ARRSECTION:
00821         {
00822           WN * kid;
00823
00824           if (WN_operator(addr)==OPR_ARRAYEXP)
00825             addr = WN_kid0(addr);
00826
00827           kid = WN_kid0(addr);
00828           WN2F_Find_And_Mark_Nested_Address(kid);
00829
00830           if ((_flds_left && _flds_left->arr_elt) &&
00831               (!(_base_is_array)))
00832             {
00833               _flds_left-> arr_wn = addr;
00834               _flds_left = TY2F_Point_At_Path(_flds_left,_off);
00835             }
00836           else
00837             _nested_addr = addr;
00838
00839           _base_is_array = FALSE;
00840         }
00841         break;
00842
00843
00844       case OPR_ADD:
00845         {
00846           WN * cnst = WN_kid0(addr);
00847           WN * othr = WN_kid1(addr);
00848
00849           if (WN_operator(cnst) != OPR_INTCONST)
00850             {
00851               cnst = WN_kid1(addr);
00852               othr = WN_kid0(addr);
00853             }
00854           WN2F_Find_And_Mark_Nested_Address(othr);
00855           _off = WN_const_val(cnst);
00856           _flds_left = TY2F_Point_At_Path(_flds_left,_off);
00857           _base_is_array = FALSE;
00858         }
00859         break;
00860
00861       case OPR_LDID:
00862         _off = 0;
00863         _nested_addr = addr;
00864         _flds_left = TY2F_Point_At_Path(_flds_left,_off);
00865         _base_is_array = ((TY_kind(WN_ty(addr)) == KIND_POINTER) &&
00866                           (TY_kind(TY_pointed(WN_ty(addr))) == KIND_ARRAY));
00867         break;
00868
00869       case OPR_LDA:
00870         _off = WN_lda_offset(addr);
00871         _nested_addr = addr;
00872         _flds_left = TY2F_Point_At_Path(_flds_left,_off);
00873         _base_is_array = ((TY_kind(WN_ty(addr)) == KIND_POINTER) &&
00874                           (TY_kind(TY_pointed(WN_ty(addr))) == KIND_ARRAY));
00875         break;
00876
00877       case OPR_ILOAD:
00878         _off = 0;
00879         _nested_addr = addr;
00880         _flds_left = TY2F_Point_At_Path(_flds_left,0);
00881         _base_is_array = ((TY_kind(WN_ty(addr)) == KIND_POINTER) &&
00882                           (TY_kind(TY_pointed(WN_ty(addr))) == KIND_ARRAY));
00883         break;
00884
00885       default:
00886         FORTTK_DIE(fortTkSupport::Diagnostics::UnexpectedOpr << OPERATOR_name(opr));
00887         break;
00888       }
00889     return;
00890   }
00891
00892
00893   WN_OFFSET
00894   WN2F_Sum_Offsets(WN *addr)
00895   {
00896     /* Accumulate any offsets (ADDs) in this address   */
00897     /* tree. Used for computing Fld paths              */
00898     BOOL sum = 0;
00899
00900     switch (WN_operator(addr)) {
00901     case OPR_ARRAY:
00902     case OPR_ARRAYEXP:
00903     case OPR_ARRSECTION:
00904       if (WN_operator(addr)==OPR_ARRAYEXP)
00905         addr = WN_kid0(addr);
00906
00907       sum += WN2F_Sum_Offsets(WN_kid0(addr));
00908       break;
00909
00910     case OPR_ADD:
00911       sum += WN2F_Sum_Offsets(WN_kid0(addr));
00912       sum += WN2F_Sum_Offsets(WN_kid1(addr));
00913       break;
00914
00915     case OPR_INTCONST:
00916       sum = WN_const_val(addr);
00917       break;
00918
00919     default:
00920       break; // fall through
00921     }
00922     return sum;
00923   }
00924
00925
00926   void
00927   WN2F_Address_Of(xml::ostream& xos)
00928   {
00929     //REMOVE Prepend_Token_Special(xos, '(');
00930     //REMOVE Prepend_Token_String(xos, "loc%");
00931     xos << "loc%()"; // FIXME
00932   }
00933
00934   DGraphNodeVec*
00935   SortDGraphNodes(OA::OA_ptr<OA::DGraph::DGraphInterface> g)
00936   {
00937     DGraphNodeVec* vec = new DGraphNodeVec(g->getNumNodes());
00938
00939     OA::OA_ptr<OA::DGraph::NodesIteratorInterface> it = g->getNodesIterator();
00940     for (int i = 0; it->isValid(); ++(*it), ++i) {
00941       (*vec)[i] = it->current();
00942     }
00943
00944     // Sort by id (ascending)
00945     //std::sort(vec->begin(), vec->end(), (*(g->getNodeCompare())));
00946     std::sort(vec->begin(), vec->end(), OA::DGraph::lt_Node());
00947
00948     return vec;
00949   }
00950
00951   DGraphEdgeVec*
00952   SortDGraphEdges(OA::OA_ptr<OA::DGraph::DGraphInterface> g)
00953   {
00954     DGraphEdgeVec* vec = new DGraphEdgeVec(g->getNumEdges());
00955
00956     OA::OA_ptr<OA::DGraph::EdgesIteratorInterface> it = g->getEdgesIterator();
00957     for (int i = 0; it->isValid(); ++(*it), ++i) {
00958       (*vec)[i] = it->current();
00959     }
00960
00961     // Sort by source/target node ids (ascending)
00962     std::sort(vec->begin(), vec->end(), OA::DGraph::lt_Edge());
00963
00964     return vec;
00965   }
00966
00967
00968   CFGEdgeVec*
00969   SortCFGEdges(OA::OA_ptr<OA::CFG::CFGInterface> g)
00970   {
00971     CFGEdgeVec* vec = new CFGEdgeVec(g->getNumEdges());
00972
00973     OA::OA_ptr<OA::DGraph::EdgesIteratorInterface> it = g->getEdgesIterator();
00974     for (int i = 0; it->isValid(); ++(*it), ++i) {
00975       (*vec)[i] = it->current().convert<OA::CFG::Edge>();
00976     }
00977
00978     // Sort by source/target node ids (ascending)
00979     std::sort(vec->begin(), vec->end(), lt_CFGEdge());
00980
00981     return vec;
00982   }
00983
00984
00985   // DumpGraphEdge: see header.
00986   void
00987   DumpGraphEdge(xml::ostream& xos, const char* nm,
00988                 UINT eid, UINT srcid, UINT targid, UINT pos)
00989   {
00990     xos << xml::BegElem(nm)
00991         << xml::Attr("edge_id", eid)
00992         << xml::Attr("source", srcid) << xml::Attr("target", targid);
00993     if (pos >= 1) {
00994       xos << xml::Attr("position", pos);
00995     }
00996     xos << xml::EndElem;
00997   }
00998
00999
01000   // DumpCFGraphEdge: Dump a CFG edge
01001   static void
01002   DumpCFGraphEdge(xml::ostream& xos, UINT eid,
01003                   OA::OA_ptr<OA::CFG::EdgeInterface> edge)
01004   {
01005     using namespace OA::CFG;
01006
01007     OA::OA_ptr<OA::DGraph::NodeInterface> dn1 = edge->getSource();
01008     OA::OA_ptr<OA::CFG::Node> n1 = dn1.convert<OA::CFG::Node>();
01009     OA::OA_ptr<OA::DGraph::NodeInterface> dn2 = edge->getSink();
01010     OA::OA_ptr<OA::CFG::Node> n2 = dn2.convert<OA::CFG::Node>();
01011
01012     pair<bool, INT64> ret = GetCFGEdgeCondVal(edge);
01013     bool hasCondVal = ret.first;
01014     INT64 condVal = ret.second;
01015
01016     xos << xml::BegElem("xaif:ControlFlowEdge")
01017         << xml::Attr("edge_id", eid)
01018         << xml::Attr("source", n1->getId()) << xml::Attr("target", n2->getId());
01019     if (hasCondVal) {
01020       xos << xml::Attr("has_condition_value", "true")
01021           << xml::Attr("condition_value", condVal);
01022     }
01023     xos << xml::EndElem;
01024   }
01025
01026   typedef std::set<ST *> SymbolPointerSet;
01027
01028   void
01029   xlate_SideEffectLocationPrint(ST* st,
01030                                 SymbolPointerSet& coveredSymbols,
01031                                 fortTkSupport::SymTabId scopeid,
01032                                 xml::ostream& xos) {
01033     if (coveredSymbols.find(st)==coveredSymbols.end())
01034       coveredSymbols.insert(st);
01035     else {
01036       const char* nm=ST_name(st);
01037       FORTTK_MSG(2, "xlate_SideEffectLocationPrint: ignoring duplicate symbol " << nm);
01038       return;
01039     }
01040     // the wrapper for the VariableReference:
01041     xos << xml::BegElem("xaif:SideEffectReference")
01042         << xml::Attr("vertex_id", "1");
01043
01044     // the contents, i.e. the SymbolReference
01045     xos << xml::BegElem("xaif:SymbolReference")
01046         << xml::Attr("vertex_id", "1")
01047         << xml::Attr("scope_id", scopeid)
01048         << AttrSymId(st)
01049         << xml::EndElem;
01050     xos << xml::EndElem;
01051   }
01052
01053
01054   void
01055   xlate_SideEffectNamedLocation(OA::OA_ptr<OA::NamedLoc> theNamedLoc,
01056                                 SymbolPointerSet& coveredSymbols,
01057                                 xml::ostream& xos,
01058                                 WN *wn,
01059                                 PUXlationContext& ctxt,
01060                                 OA::OA_ptr<OA::SymHandleIterator> formalArgSymHandleI)
01061   {
01062     // OA may include constants in the location lists.  We filter them
01063     // out because they are not in the XAIF symbol table.
01064     ST* st = (ST*)theNamedLoc->getSymHandle().hval();
01065     ST_TAB* sttab = Scope_tab[ST_level(st)].st_tab;
01066     fortTkSupport::SymTabId scopeid = ctxt.findSymTabId(sttab);
01067     // this is a temporary fix to a problem in the analysis
01068     // for the following case:
01069     // a symbol SY occurs in the sideffect list of routine R
01070     // as a consequence of R calling FOO, SY is declared within
01071     // FOO (i.e. ST_level is 2) and referenced in BAR that is
01072     // contained in FOO.  Because SY is from the enclosing scope
01073     // it is considered "not" local to BAR
01074     // (see also comments in Open64IRInterface.cpp:3715 ff.)
01075     // Presumably somewhere in OA then the assumption is made
01076     // that anything not local is global and it ends up
01077     // in the R's side effect list. To be global, however,
01078     // it would have to have ST_level 1 or at least
01079     // a level higher than the current PU. If it is not
01080     // we will assume the above case and just return.
01081     // A similar problem also occurs when sideeffects are
01082     // transferred from a module procedure to the place where the
01083     // module is used.
01084     UINT32 anIndex=ST_index(st);
01085     // we may not even have that index because the symbol comes from a large symbol table:
01086     if (anIndex>=sttab->Size()){
01087       ST* puStP = ST_ptr(PU_Info_proc_sym(Current_PU_Info));
01088       const char* puName = ST_name(puStP);
01089       FORTTK_WMSG("xlate_SideEffectNamedLocation: ignoring symbol " << ST_name(st) << " (symbol index " << anIndex << " is out of bounds of current symbol table indicating it is invisible in " << puName << ")");
01090       return;
01091     }
01092     // if the symbol is visible we should find it in sttab via level/index:
01093     ST& anotherST=St_Table[ST_st_idx(*st)];
01094     if (&anotherST != st) {
01095       ST* puStP = ST_ptr(PU_Info_proc_sym(Current_PU_Info));
01096       const char* puName = ST_name(puStP);
01097       FORTTK_WMSG("xlate_SideEffectNamedLocation: ignoring symbol " << ST_name(st) << " (resolves in the current symbol table to " << ST_name(&anotherST) << " indicating it is invisible in " << puName << ")");
01098       return;
01099     }
01100     if (ST_class(st) == CLASS_CONST) {
01101       return;
01102     }
01103
01104     if (theNamedLoc->isLocal()) {
01105       // we don't want local variables except
01106       // if it is a formal parameter
01107       bool foundAsFormalArgument=false;
01108       formalArgSymHandleI->reset();
01109       while (formalArgSymHandleI->isValid()) {
01110         //       // JU: debugging prepare begin
01111         //       const char* nm=ST_name(st);
01112         //       ST* st1=(ST*)formalArgSymHandleI->current().hval();
01113         //       const char* nm1=ST_name(st1);
01114         //       // JU: debugging prepare end
01115         if (formalArgSymHandleI->current()==theNamedLoc->getSymHandle()) {
01116           // is a formal paramter
01117           foundAsFormalArgument=true;
01118           //    // JU: debugging begin
01119           //    std::cout << "xlate_SideEffectNamedLocation: matched " << nm << " with " << nm1 << std::endl;
01120           //    // JU: debugging end
01121           break;
01122         }
01123         //       // JU: debugging begin
01124         //       else {
01125         //      std::cout << "xlate_SideEffectNamedLocation: did not match " << nm << " with " << nm1 << std::endl;
01126         //       }
01127         //       // JU: debugging end
01128         ++(*formalArgSymHandleI);
01129       }
01130       if (!foundAsFormalArgument) {
01131         return;
01132       }
01133     }
01134     else {
01135       ST_IDX stLevel=ST_level(st), puStLevel=PU_lexical_level(ST_ptr(PU_Info_proc_sym(Current_PU_Info)));
01136       bool inCurrentSt=false;
01137       // third spot of weeding out invisible symbols:
01138       if (stLevel==puStLevel) {
01139         // see if we can find it...
01140         for (INT i = 1;
01141              i < ST_Table_Size(stLevel) ;
01142              ++i) {
01143           // get the symbol from the table
01144           ST* an_ST_p=&(St_Table(stLevel,i));
01145           if (an_ST_p==st) {// same (not just equal) instance
01146             inCurrentSt=true;
01147             break;
01148           }
01149         }
01150       }
01151       if((stLevel==puStLevel && !inCurrentSt) || stLevel>puStLevel) {
01152         ST* puStP = ST_ptr(PU_Info_proc_sym(Current_PU_Info));
01153         const char* puName = ST_name(puStP);
01154         FORTTK_WMSG("xlate_SideEffectNamedLocation: ignoring symbol " << ST_name(st) << " (nesting level " << (unsigned short)stLevel << ") which is invisible in " << puName << " (nesting level " << (unsigned short)puStLevel << ")");
01155         return;
01156       }
01157     }
01158     xlate_SideEffectLocationPrint(st,coveredSymbols,scopeid, xos);
01159   }
01160
01161   void
01162   xlate_SideEffectEntry(OA::OA_ptr<OA::Location> theTopLocation,
01163                         OA::OA_ptr<OA::Location> theLocation,
01164                         SymbolPointerSet& coveredSymbols,
01165                         xml::ostream& xos,
01166                         WN *wn,
01167                         PUXlationContext& ctxt,
01168                         OA::OA_ptr<OA::SymHandleIterator> formalArgSymHandleI) {
01169     if (theLocation->isaNamed()) {
01170       // get the named location
01171       OA::OA_ptr<OA::NamedLoc> namedLoc=
01172         theLocation.convert<OA::NamedLoc>();
01173       xlate_SideEffectNamedLocation(namedLoc,
01174                                     coveredSymbols,
01175                                     xos,
01176                                     wn,
01177                                     ctxt,
01178                                     formalArgSymHandleI);
01179     }
01180     else if (theLocation->isaInvisible()) {
01181       // get the invisible location's symbol
01182       OA::OA_ptr<OA::InvisibleLoc> theInvisibleLoc=
01183         theLocation.convert<OA::InvisibleLoc>();
01184       ST* st = (ST*)theInvisibleLoc->getBaseSym().hval();
01185       ST_TAB* sttab = Scope_tab[ST_level(st)].st_tab;
01186       fortTkSupport::SymTabId scopeid = ctxt.findSymTabId(sttab);
01187       xlate_SideEffectLocationPrint(st,coveredSymbols,scopeid, xos);
01188     }
01189     else if (theLocation->isaSubSet()) {
01190       OA::OA_ptr<OA::LocSubSet> subSetLoc=
01191         theLocation.convert<OA::LocSubSet>();
01192       xlate_SideEffectEntry(theTopLocation,
01193                             subSetLoc->getLoc(),
01194                             coveredSymbols,
01195                             xos,
01196                             wn,
01197                             ctxt,
01198                             formalArgSymHandleI);
01199     }
01200     else if (theLocation->isaUnnamed()) {
01201       OA::OA_ptr<OA::UnnamedLoc> theUnnamedLoc=
01202         theLocation.convert<OA::UnnamedLoc>();
01203       // save the context because "toString" may change it
01204       PU_Info* thisPU=Current_PU_Info;
01205       WN* wn_p((WN*)theUnnamedLoc->getExprHandle().hval());
01206       if (wn_p
01207           &&
01208           (WN_operator(wn_p)==OPR_CONST
01209            ||
01210            WN_operator(wn_p)==OPR_INTCONST
01211            ||
01212            (WN_has_sym(wn_p)
01213             &&
01214             ST_class(WN_st(wn_p))==CLASS_CONST))) {
01215         FORTTK_MSG(2, "xlate_SideEffectEntry: side effect list contains an unnamed location for: " << ctxt.getIrInterface().toString(theUnnamedLoc->getExprHandle()));
01216       }
01217       else {
01218         FORTTK_MSG(1, "xlate_SideEffectEntry: side effect list contains an unnamed location for: " << ctxt.getIrInterface().toString(theUnnamedLoc->getExprHandle()));
01219       }
01220       if (Current_PU_Info!=thisPU)
01221         PU_SetGlobalState(thisPU);
01222     }
01223     else if (theLocation->isaUnknown()) {
01224       ST* pu_st = ST_ptr(PU_Info_proc_sym(Current_PU_Info));
01225       const char* pu_nm = ST_name(pu_st);
01226       FORTTK_MSG(2,"xlate_SideEffectEntry: side effect list for " << pu_nm << " contains an unknown location.");
01227     }
01228     else {
01229       ST* pu_st = ST_ptr(PU_Info_proc_sym(Current_PU_Info));
01230       const char* pu_nm = ST_name(pu_st);
01231       FORTTK_MSG(0,"xlate_SideEffectEntry: descended from top location:");
01232       theTopLocation->dump(std::cerr);
01233       FORTTK_MSG(0,"xlate_SideEffectEntry: down to locaton:");
01234       theLocation->dump(std::cerr);
01235       FORTTK_DIE(fortTkSupport::Diagnostics::Unimplemented << "side effect list for " << pu_nm << " contains an unexpected location (see location dumps above)");
01236     }
01237   }
01238
01243   static void findVarSymbolsInTree(WN *wn,
01244                                    SymbolPointerSet& requiredSymbols) {
01245     if (WN_has_sym(wn)) {
01246       ST* st=WN_st(wn);
01247       if ( ST_class(st)==CLASS_VAR && !ST_is_temp_var(st))
01248         // we need to avoid picking up things like integer conversion calls
01249         requiredSymbols.insert(st);
01250     }
01251     for (INT kid = 0; kid < WN_kid_count(wn); kid++) {
01252       WN *kidWN_p=WN_kid(wn,kid);
01253       if (kidWN_p)
01254         findVarSymbolsInTree(kidWN_p,
01255                              requiredSymbols);
01256     }
01257   }
01258
01264   static void findRequiredProgramSymbols(WN* wn,
01265                                          PUXlationContext& ctxt,
01266                                          SymbolPointerSet& requiredTempSymbols,
01267                                          SymbolPointerSet& requiredProgramSymbols) {
01268     FORTTK_ASSERT(WN_operator(wn) == OPR_FUNC_ENTRY, fortTkSupport::Diagnostics::UnexpectedInput);
01269     // go to the body
01270     WN* theLastBlock=WN_kid(wn,WN_kid_count(wn)-1);
01271     FORTTK_ASSERT(WN_operator(theLastBlock)==OPR_BLOCK, fortTkSupport::Diagnostics::UnexpectedInput);
01272     if (WN_first(theLastBlock)==0)
01273       return;
01274     WN* childWN=WN_first(theLastBlock);
01275     while (childWN!=0) {
01276       OPERATOR childOpr=WN_operator(childWN);
01277       if (childOpr==OPR_STID) {
01278         ST* st=WN_st(childWN);
01279         if (requiredTempSymbols.find(st)!=requiredTempSymbols.end()) {
01280           findVarSymbolsInTree(childWN,
01281                             requiredProgramSymbols);
01282           requiredTempSymbols.erase(st);
01283         }
01284       }
01285       childWN=WN_next(childWN);
01286     }
01287   }
01288
01289
01295   class SearchSymbolTableEntry {
01296   public:
01297     SearchSymbolTableEntry(PUXlationContext& ctxt,
01298                            SymbolPointerSet& requiredSymbols) :
01299       myCtxt(ctxt),
01300       myRequiredSymbols(requiredSymbols){
01301     }
01302
01307     void operator()(UINT32 idx, ST* st) const {
01308       // must be formal parameter of local variable declaration
01309       if (ST_class(st)!=CLASS_VAR)
01310         return;
01311       TY_IDX tyIdx=ST_type(st);
01312       TY_KIND tyKind=TY_kind(tyIdx);
01313       // must be a local array or a pointer to an array (for formal parameters)
01314       // except for strings
01315       if (tyKind!=KIND_ARRAY && tyKind!=KIND_POINTER
01316           ||
01317           TY_Is_Character_String(tyIdx))
01318         return;
01319       while (tyKind==KIND_POINTER) {
01320         tyIdx=TY_pointed(tyIdx);
01321         tyKind=TY_kind(tyIdx);
01322         if (tyKind!=KIND_POINTER) {
01323           if (tyKind==KIND_ARRAY
01324               &&
01325               !TY_Is_Character_String(tyIdx))
01326             break;
01327           else
01328             return;
01329         }
01330       }
01331       // now we are looking at an array and can search the array bounds
01332       TY& ty = Ty_Table[tyIdx];
01333       ARB_HANDLE arbBaseHandle = TY_arb(ty);
01334       INT32 dim = ARB_dimension(arbBaseHandle) ;
01335       INT32 coDim = ARB_co_dimension(arbBaseHandle);
01336       FORTTK_ASSERT(coDim == 0,
01337                     fortTkSupport::Diagnostics::UnexpectedInput);
01338       for (int i=0; i<dim; i++) {
01339         // lbound:
01340         if (!ARB_const_lbnd(arbBaseHandle[i])
01341             &&
01342             !ARB_empty_lbnd(arbBaseHandle[i])) {
01343           // get the array bounds entry
01344           ST_IDX stIdx=ARB_lbnd_var(arbBaseHandle[i]);
01345           if (stIdx!=0) {
01346             myRequiredSymbols.insert(&(St_Table[stIdx]));
01347           }
01348         }
01349         // ubound:
01350         if (!ARB_const_ubnd(arbBaseHandle[i])
01351             &&
01352             !ARB_empty_ubnd(arbBaseHandle[i])) {
01353           // get the array bounds entry
01354           ST_IDX stIdx=ARB_ubnd_var(arbBaseHandle[i]);
01355           if (stIdx!=0) {
01356             myRequiredSymbols.insert(&(St_Table[stIdx]));
01357           }
01358         }
01359         // stride:
01360         if (!ARB_const_stride(arbBaseHandle[i])
01361             &&
01362             !ARB_empty_stride(arbBaseHandle[i])) {
01363           // get the array bounds entry
01364           ST_IDX stIdx=ARB_stride_var(arbBaseHandle[i]);
01365           if (stIdx!=0) {
01366             myRequiredSymbols.insert(&(St_Table[stIdx]));
01367           }
01368         }
01369       }
01370     }
01371
01372   private:
01373     SYMTAB_IDX      mySymtab;
01374     PUXlationContext& myCtxt;
01375     SymbolPointerSet& myRequiredSymbols;
01376   };
01377
01383   static void findRequiredSymbolsInSymbolTable(SYMTAB_IDX symtab_lvl,
01384                                                PUXlationContext& ctxt,
01385                                                SymbolPointerSet& requiredSymbols) {
01386     For_all(St_Table, symtab_lvl, SearchSymbolTableEntry(ctxt,
01387                                                          requiredSymbols));
01388   }
01389
01390
01391   // xlate_EntryPoint: Translates a function entry or alternate entry
01392   // point, with parameter declarations.
01393   // FIXME: XAIF doesn't support alt-entry.
01394   static void
01395   xlate_EntryPoint(xml::ostream& xos, WN *wn, PUXlationContext& ctxt) {
01396     OPERATOR opr = WN_operator(wn);
01397     FORTTK_ASSERT(opr == OPR_ALTENTRY || opr == OPR_FUNC_ENTRY,
01398                   fortTkSupport::Diagnostics::UnexpectedInput);
01399
01400     ST* func_st = &St_Table[WN_entry_name(wn)];
01401     TY_IDX func_ty = ST_pu_type(func_st);
01402     TY_IDX return_ty = Func_Return_Type(func_ty);
01403
01404     // Accumulate the parameter ST entries  // FIXME: GetParamSymHandleSet
01405     INT nparam = (opr == OPR_ALTENTRY) ? WN_kid_count(wn) : WN_num_formals(wn);
01406     ST** params_st = (ST **)alloca((nparam + 1) * sizeof(ST *));
01407     for (INT parm = 0; parm < nparam; parm++) {
01408       params_st[parm] = WN_st(WN_formal(wn, parm));
01409     }
01410     params_st[nparam] = NULL; // terminate the list
01411
01412     // Parameter name-list. Skip any implicit "length" parameters
01413     // associated with character strings.  Such implicit parameters
01414     // should be at the end of the parameter list. FIXME
01415     xos << xml::BegElem("xaif:ArgumentList");
01416
01417     INT first_parm = ST2F_FIRST_PARAM_IDX(func_ty);
01418     INT implicit_parms = 0;
01419     UINT position = 1;
01420     for (INT parm = first_parm; parm < (nparam - implicit_parms); parm++) {
01421
01422       WN* parm_wn = WN_formal(wn, parm);
01423       ST* parm_st = params_st[parm]; //WN_st(parm_wn);
01424
01425       if (!ST_is_return_var(parm_st)) {
01426         ST_TAB* sttab = Scope_tab[ST_level(parm_st)].st_tab;
01427         fortTkSupport::SymTabId scopeid = ctxt.findSymTabId(sttab);
01428         xos << xml::BegElem("xaif:ArgumentSymbolReference")
01429             << xml::Attr("position", position)
01430             << xml::Attr("scope_id", scopeid)
01431             << AttrSymId(parm_st)
01432             << xml::Attr("intent", xlate_intent(parm_wn))
01433             << WhirlIdAnnot(ctxt.findWNId(parm_wn))
01434             << xml::EndElem;
01435         position++;
01436       }
01437
01438       if (STAB_PARAM_HAS_IMPLICIT_LENGTH(parm_st)) {
01439         implicit_parms++;
01440
01441         /* FIXME: is function returning character_TY? if length follows */
01442         /* address - skip over it, but account for ',' in arg list */
01443         if ( ((parm == first_parm) && (params_st[parm+1] != NULL))
01444              && (ST_is_value_parm(parm_st)
01445                  && ST_is_value_parm(params_st[parm+1]))
01446              && (return_ty != (TY_IDX)0 && TY_kind(return_ty) == KIND_VOID) ) {
01447           parm++;
01448           params_st[parm] = NULL;
01449           implicit_parms--;
01450         }
01451       }
01452     }
01453
01454     xos << xml::EndElem /* xaif:ArgumentList */;
01455
01456     // add the side effect lists here:
01457     // the analysis result:
01458     OA::OA_ptr<OA::SideEffect::InterSideEffectStandard> interSideEffects=
01459       Whirl2Xaif::getOAAnalMap().getInterSideEffect();
01460
01461     // an iterator over locations:
01462     OA::OA_ptr<OA::LocIterator> anOALocIterOAPtr;
01463     OA::ProcHandle proc((OA::irhandle_t)Current_PU_Info);
01464
01465     // symbol handle iterator from parameter bindings to distinguish the formal parameters
01466     // from the strictly local variables
01467     OA::OA_ptr<OA::SymHandleIterator> symHandleI=Whirl2Xaif::getOAAnalMap().
01468       getParamBindings()->getFormalIterator(proc);
01469
01470     //   // begin debugging stuff
01471     //   ST* st = ST_ptr(PU_Info_proc_sym(Current_PU_Info));
01472     //   const char* nm = ST_name(st);
01473     //   if (!symHandleI->isValid())
01474     //     std::cout << "Note: in xlate_EntryPoint empty symHandleI for " << nm << std::endl;
01475     //   else
01476     //     std::cout << "Note: in xlate_EntryPoint non-empty symHandleI for " << nm << std::endl;
01477     //   // end debugging stuff
01478
01479     symHandleI->reset();
01480     xos << xml::BegElem("xaif:ModLocal");
01481     anOALocIterOAPtr = interSideEffects->getLMODIterator(proc);
01482     SymbolPointerSet coveredSymbols;
01483     for ( ; anOALocIterOAPtr->isValid(); ++(*anOALocIterOAPtr) ) {
01484       xlate_SideEffectEntry(anOALocIterOAPtr->current(),
01485                             anOALocIterOAPtr->current(),
01486                             coveredSymbols,
01487                             xos,
01488                             wn,
01489                             ctxt,
01490                             symHandleI);
01491     }
01492     xos << xml::EndElem; // xaif:ModLocal
01493     coveredSymbols.clear();
01494     symHandleI->reset();
01495     xos << xml::BegElem("xaif:Mod");
01496     anOALocIterOAPtr = interSideEffects->getMODIterator(proc);
01497     for ( ; anOALocIterOAPtr->isValid(); ++(*anOALocIterOAPtr) ) {
01498       xlate_SideEffectEntry(anOALocIterOAPtr->current(),
01499                             anOALocIterOAPtr->current(),
01500                             coveredSymbols,
01501                             xos,
01502                             wn,
01503                             ctxt,
01504                             symHandleI);
01505     }
01506     xos << xml::EndElem; // xaif:ModLocal
01507     coveredSymbols.clear();
01508     symHandleI->reset();
01509     xos << xml::BegElem("xaif:ReadLocal");
01510     anOALocIterOAPtr = interSideEffects->getLUSEIterator(proc);
01511     for ( ; anOALocIterOAPtr->isValid(); ++(*anOALocIterOAPtr)) {
01512       xlate_SideEffectEntry(anOALocIterOAPtr->current(),
01513                             anOALocIterOAPtr->current(),
01514                             coveredSymbols,
01515                             xos,
01516                             wn,
01517                             ctxt,
01518                             symHandleI);
01519     }
01520     xos << xml::EndElem; // xaif:ModLocal
01521     coveredSymbols.clear();
01522     symHandleI->reset();
01523     xos << xml::BegElem("xaif:Read");
01524     anOALocIterOAPtr = interSideEffects->getUSEIterator(proc);
01525     for ( ; anOALocIterOAPtr->isValid(); ++(*anOALocIterOAPtr)) {
01526       xlate_SideEffectEntry(anOALocIterOAPtr->current(),
01527                             anOALocIterOAPtr->current(),
01528                             coveredSymbols,
01529                             xos,
01530                             wn,
01531                             ctxt,
01532                             symHandleI);
01533     }
01534     xos << xml::EndElem; // xaif:ModLocal
01535     // populate the onEntry list:
01536     SymbolPointerSet requiredTempSymbols;
01537     findRequiredSymbolsInSymbolTable(CURRENT_SYMTAB,
01538                                      ctxt,
01539                                      requiredTempSymbols);
01540     // now look at all the variables we found which
01541     // presumably are all temporaries like t__1, t__2, ...
01542     // which are defined somewhere in the beginning of
01543     // the body
01544     SymbolPointerSet requiredProgramSymbols;
01545     findRequiredProgramSymbols(wn,
01546                                ctxt,
01547                                requiredTempSymbols,
01548                                requiredProgramSymbols);
01549     if (!requiredTempSymbols.empty()) {
01550       ST* st = ST_ptr(PU_Info_proc_sym(Current_PU_Info));
01551       const char* puName = ST_name(st);
01552       const char* symbolName = ST_name(*(requiredTempSymbols.begin()));
01553       FORTTK_MSG(1,"cannot find a definition for temporary symbol \"" << symbolName << "\" in " << puName);
01554     }
01555     FORTTK_ASSERT(requiredTempSymbols.empty(),fortTkSupport::Diagnostics::UnexpectedInput << " not all symbols required in local declarations have a definition");
01556     if (!requiredProgramSymbols.empty()) {
01557       coveredSymbols.clear();
01558       xos << xml::BegElem("xaif:OnEntry");
01559       for (SymbolPointerSet::iterator si=requiredProgramSymbols.begin();
01560            si!=requiredProgramSymbols.end();
01561            ++si) {
01562         ST_TAB* sttab = Scope_tab[ST_level(*si)].st_tab;
01563         fortTkSupport::SymTabId scopeid = ctxt.findSymTabId(sttab);
01564         xlate_SideEffectLocationPrint(*si,
01565                                       coveredSymbols,
01566                                       scopeid,
01567                                       xos);
01568       }
01569       xos << xml::EndElem; // xaif:OnEntry
01570     }
01571   }
01572
01573   // GetParamSymHandleSet: Return a set of SymHandles representing the
01574   // parameters of the OPR_FUNC_ENTRY.
01575   static set<OA::SymHandle>*
01576   GetParamSymHandleSet(WN* wn_pu)
01577   {
01578     // Accumulate the ST* for parameters
01579     set<OA::SymHandle>* params = new set<OA::SymHandle>;
01580     INT nparam = WN_num_formals(wn_pu);
01581     for (int i = 0; i < nparam; ++i) {
01582       ST* st = WN_st(WN_formal(wn_pu, i));
01583       params->insert(OA::SymHandle((OA::irhandle_t)st));
01584     }
01585     return params;
01586   }
01587
01588   static const char*
01589   xlate_intent(WN* parm)
01590   {
01591     // Note: WN_parm flags are typically not set
01592     // WN_parm_flag(parm), WN_Parm_Dummy(parm)
01593     ST* st = WN_st(parm);
01594     if (ST_is_intent_in_argument(st) || WN_Parm_In(parm)) {
01595       return "in";
01596     }
01597     else if (ST_is_intent_out_argument(st) || WN_Parm_Out(parm)) {
01598       return "out";
01599     }
01600     else { // WN_Parm_By_Reference(parm)
01601       return "inout";
01602     }
01603   }
01604
01605   // xlate_BBStmt: Given a statement within an XAIF basic block,
01606   // properly translate it.
01607   static void
01608   xlate_BBStmt(xml::ostream& xos, WN *wn, PUXlationContext& ctxt)
01609   {
01610     if (!wn) { return; }
01611
01612     // If a structured statement, it must be translated specially.
01613     // Otherwise simply dispatch to TranslateWN(...).
01614     const char* vty = fortTkSupport::GetCFGControlFlowVertexType(wn);
01615     OPERATOR opr = WN_operator(wn);
01616     const char* opr_str = OPERATOR_name(opr);
01617
01618     if (vty == XAIFStrings.elem_BBForLoop()) {
01619       if (WN_operator(WN_end(wn))==OPR_NE) {
01620         FORTTK_WMSG("xlate_BBStmt: loop with variable stride");
01621       }
01622       xlate_LoopInitialization(xos, WN_start(wn), ctxt);
01623       xlate_CFCondition(xos, WN_end(wn), ctxt);
01624       xlate_LoopUpdate(xos, WN_step(wn), ctxt);
01625     }
01626     else if (vty == XAIFStrings.elem_BBPostLoop() ||
01627              vty == XAIFStrings.elem_BBPreLoop()) {
01628       xlate_CFCondition(xos, WN_while_test(wn), ctxt);
01629     }
01630     else if (vty == XAIFStrings.elem_BBBranch()) {
01631       WN* condWN = NULL;
01632       if (opr == OPR_IF || opr == OPR_TRUEBR || opr == OPR_FALSEBR) {
01633         condWN = WN_if_test(wn);
01634       }
01635       else if (opr == OPR_SWITCH || opr == OPR_COMPGOTO) {
01636         condWN = WN_switch_test(wn);
01637       }
01638       FORTTK_ASSERT(condWN, fortTkSupport::Diagnostics::UnexpectedOpr << OPERATOR_name(opr));
01639       xlate_CFCondition(xos, condWN, ctxt);
01640     }
01641     else if (vty == XAIFStrings.elem_BBEndBranch() ||
01642              vty == XAIFStrings.elem_BBEndLoop()) {
01643       // skip bogus comment statement
01644       //xos << Comment(vty);
01645     }
01646     else {
01647       if (IsActiveStmt(wn, ctxt) || (opr==OPR_STID && ! ST_is_temp_var(WN_st(wn)))) {
01648         TranslateWN(xos, wn, ctxt);
01649       }
01650       else {
01651         xlate_PassiveStmt(xos, wn, ctxt);
01652       }
01653     }
01654   }
01655
01656
01657   // xlate_CFCondition: Translate the BB's control flow condition (Loops, Ifs)
01658   static void
01659   xlate_CFCondition(xml::ostream& xos, WN *wn, PUXlationContext& ctxt)
01660   {
01661     xos << xml::BegElem("xaif:Condition");
01662     ctxt.createXlationContext();
01663     TranslateWN(xos, wn, ctxt);
01664     ctxt.deleteXlationContext();
01665     xos << xml::EndElem;
01666   }
01667
01668
01669   // xlate_LoopInitialization:
01670   static void
01671   xlate_LoopInitialization(xml::ostream& xos, WN *wn, PUXlationContext& ctxt)
01672   {
01673     xos << xml::BegElem("xaif:Initialization")
01674         << xml::Attr("statement_id", ctxt.findWNId(wn))
01675         << xml::Attr("do_chain", ctxt.findDoChainId(wn));
01676     ctxt.createXlationContext(XlationContext::ASSIGN); // implicit for this element
01677     TranslateWN(xos, wn, ctxt);
01678     ctxt.deleteXlationContext();
01679     xos << xml::EndElem;
01680   }
01681
01682   // xlate_LoopUpdate:
01683   static void
01684   xlate_LoopUpdate(xml::ostream& xos, WN *wn, PUXlationContext& ctxt)
01685   {
01686     xos << xml::BegElem("xaif:Update")
01687         << xml::Attr("statement_id", ctxt.findWNId(wn))
01688         << xml::Attr("do_chain", ctxt.findDoChainId(wn));
01689     ctxt.createXlationContext(XlationContext::ASSIGN); // implicit for this element
01690     TranslateWN(xos, wn, ctxt);
01691     ctxt.deleteXlationContext();
01692     xos << xml::EndElem;
01693   }
01694
01695   // GetLoopReversalType:
01696   static const char*
01697   GetLoopReversalType(OA::OA_ptr<OA::CFG::CFGInterface> cfg,
01698                       OA::OA_ptr<OA::CFG::NodeInterface> n)
01699   {
01700     const char* loopTy = "anonymous";
01701
01702     // Find the WN corresponding to xaif:ForLoop
01703     WN* loopWN = NULL;
01704     OA::OA_ptr<OA::CFG::NodeStatementsIteratorInterface> stmtIt
01705       = n->getNodeStatementsIterator();
01706     for (; stmtIt->isValid(); ++(*stmtIt)) {
01707       OA::StmtHandle st = stmtIt->current();
01708       WN* wstmt = (WN*)st.hval();
01709       const char* vty = fortTkSupport::GetCFGControlFlowVertexType(wstmt);
01710       if (vty == XAIFStrings.elem_BBForLoop()) {
01711         loopWN = wstmt;
01712         break;
01713       }
01714     }
01715
01716     FORTTK_ASSERT(loopWN, "Could not find WN corresponding to xaif:ForLoop");
01717
01718     // Check for a PRAGMA  right before the loop node
01719     // but skip possible STID nodes assigning temporaries
01720     // that the front-end may have inserted between the
01721     // loop node and the pragma:
01722     WN* prevWN_p=WN_prev(loopWN);
01723     while (prevWN_p
01724            &&
01725            WN_operator(prevWN_p) == OPR_STID
01726            &&
01727            ST_is_temp_var(WN_st(prevWN_p)))
01728       prevWN_p=WN_prev(prevWN_p);
01729     if (prevWN_p && WN_operator(prevWN_p) == OPR_PRAGMA) {
01730       WN_PRAGMA_ID prag = (WN_PRAGMA_ID)WN_pragma(prevWN_p);
01731       if (prag == WN_PRAGMA_OPENAD_XXX) {
01732         static const char* TXT = "\"simple loop";
01733         const char* txt = Targ_Print(NULL, WN_val(prevWN_p)); // CLASS_CONST
01734         if (strncasecmp(txt, TXT, strlen(TXT)) == 0) {
01735           loopTy = "explicit";
01736         }
01737       }
01738     }
01739
01740     if (Args::ourSimpleLoopFlag)
01741       loopTy = "explicit";
01742
01743     return loopTy;
01744   }
01745
01746   // GetIDsForStmtsInBB: Returns a colon separated list for ids of
01747   // statements within the basic block.  In the event that a statement
01748   // id maps to zero, it is *not* included in the list.
01749   static std::string
01750   GetIDsForStmtsInBB(OA::OA_ptr<OA::CFG::NodeInterface> node,
01751                      PUXlationContext& ctxt)
01752   {
01753     using namespace OA::CFG;
01754
01755     std::string idstr;
01756     bool emptystr = true;
01757
01758     OA::OA_ptr<OA::CFG::NodeStatementsIteratorInterface> stmtItPtr
01759       = node->getNodeStatementsIterator();
01760     for (; stmtItPtr->isValid(); ++(*stmtItPtr)) {
01761       WN* wstmt = (WN *)stmtItPtr->current().hval();
01762       fortTkSupport::WNId id = ctxt.findWNId(wstmt);
01763
01764       // Skip statements without a valid id
01765       if (id == 0) { continue; }
01766
01767       const char* str = Num2Str(id, "%lld");
01768       //std::cout << id << " --> " << str << " // ";
01769
01770       if (!emptystr) {
01771         idstr += ":";
01772       }
01773       idstr += str;
01774       emptystr = false;
01775     }
01776
01777     return idstr;
01778   }
01779
01780
01781   // GetCFGEdgeCondVal: Given a CFG edge, returns a pair indicating
01782   // whether the edge has a condition value, and if so, its value.
01783   // (There is no reserved NULL value for the condition value; it should
01784   // only be used when the first part of the pair is true!)
01785   pair<bool, INT64>
01786   GetCFGEdgeCondVal(const OA::OA_ptr<OA::CFG::EdgeInterface> edge)
01787   {
01788     using namespace OA::CFG;
01789
01790     EdgeType ety = edge->getType();
01791     WN* eexpr = (WN*)edge->getExpr().hval();
01792
01793     bool hasCondVal = false;
01794     INT64 condVal = 0;
01795     if (ety == TRUE_EDGE) {
01796       hasCondVal = true;
01797       condVal = 1;
01798     }
01799     else if (ety == MULTIWAY_EDGE && eexpr) {
01800       hasCondVal = true;
01801       OPERATOR opr = WN_operator(eexpr);
01802       if (opr == OPR_CASEGOTO) { // from an OPR_SWITCH
01803         condVal = WN_const_val(eexpr);
01804       }
01805       else if (opr == OPR_GOTO) { // from an OPR_COMPGOTO
01806         // to find condVal, must find parent COMPGOTO and then find the
01807         // index of this GOTO in the jumptable.
01808         FORTTK_DIE(fortTkSupport::Diagnostics::Unimplemented << "Conditions for COMPGOTO");
01809       }
01810       else {
01811         FORTTK_DIE(fortTkSupport::Diagnostics::Unimplemented << "Unknown multiway branch");
01812       }
01813     }
01814     return pair<bool, INT64>(hasCondVal, condVal);
01815   }
01816
01817   void initOurHandlerTable() {
01818
01819     // Note: Organization generally corresponds to that in
01820     // Open64/documentation/whirl.tex
01821
01822     // Structured control flow
01823     ourHandlerTable[OPR_FUNC_ENTRY]=           &xlate_FUNC_ENTRY ;
01824     ourHandlerTable[OPR_BLOCK]=                &xlate_BLOCK ;
01825     ourHandlerTable[OPR_REGION]=               &WN2F_region ;
01826     ourHandlerTable[OPR_REGION_EXIT]=          &xlate_GOTO ;
01827     ourHandlerTable[OPR_DO_LOOP]=              &xlate_DO_LOOP ;
01828     ourHandlerTable[OPR_DO_WHILE]=             &xlate_DO_WHILE ;
01829     ourHandlerTable[OPR_WHILE_DO]=             &xlate_WHILE_DO ;
01830     ourHandlerTable[OPR_IF]=                   &xlate_IF ;
01831
01832     // Other control flow
01833     ourHandlerTable[OPR_IMPLIED_DO]=           &WN2F_noio_implied_do ;
01834     ourHandlerTable[OPR_GOTO]=                 &xlate_GOTO ;
01835     ourHandlerTable[OPR_SWITCH]=               &xlate_SWITCH ;
01836     ourHandlerTable[OPR_CASEGOTO]=             &xlate_unknown ;
01837     ourHandlerTable[OPR_COMPGOTO]=             &xlate_unknown ;
01838     ourHandlerTable[OPR_AGOTO]=                &xlate_unknown ;
01839     ourHandlerTable[OPR_ALTENTRY]=             &xlate_ALTENTRY ;
01840     ourHandlerTable[OPR_TRUEBR]=               &xlate_condBR ;
01841     ourHandlerTable[OPR_FALSEBR]=              &xlate_condBR ;
01842     ourHandlerTable[OPR_RETURN]=               &xlate_RETURN ;
01843     ourHandlerTable[OPR_RETURN_VAL]=           &xlate_RETURN_VAL ;
01844     ourHandlerTable[OPR_LABEL]=                &xlate_LABEL ;
01845
01846     // Statements: Calls
01847     ourHandlerTable[OPR_CALL]=                 &xlate_CALL ;
01848     ourHandlerTable[OPR_ICALL]=                &xlate_CALL ;
01849     ourHandlerTable[OPR_PICCALL]=              &xlate_CALL ;
01850     ourHandlerTable[OPR_INTRINSIC_CALL]=       &xlate_INTRINSIC_CALL ;
01851     ourHandlerTable[OPR_IO]=                   &xlate_IO ;
01852
01853     // Statements: Other
01854     ourHandlerTable[OPR_EVAL]=                 &WN2F_eval ;
01855     ourHandlerTable[OPR_PRAGMA]=               &xlate_PRAGMA ;
01856     ourHandlerTable[OPR_XPRAGMA]=              &xlate_PRAGMA ;
01857     ourHandlerTable[OPR_PREFETCH]=             &xlate_PREFETCH ;
01858     ourHandlerTable[OPR_PREFETCHX]=            &xlate_PREFETCH ;
01859     ourHandlerTable[OPR_COMMENT]=              &xlate_COMMENT ;
01860     ourHandlerTable[OPR_TRAP]=                 &xlate_ignore ; // FIXME
01861     ourHandlerTable[OPR_ASSERT]=               &xlate_ignore ; // FIXME
01862     ourHandlerTable[OPR_FORWARD_BARRIER]=      &xlate_ignore ; // FIXME
01863     ourHandlerTable[OPR_BACKWARD_BARRIER]=     &xlate_ignore ; // FIXME
01864     ourHandlerTable[OPR_DEALLOCA]=             &WN2F_dealloca ;
01865
01866     ourHandlerTable[OPR_USE]=                  &xlate_USE ;
01867     ourHandlerTable[OPR_NAMELIST]=             &WN2F_namelist_stmt ;
01868     ourHandlerTable[OPR_IMPLICIT_BND]=         &WN2F_implicit_bnd ;
01869     ourHandlerTable[OPR_NULLIFY]=              &WN2F_nullify_stmt ;
01870     ourHandlerTable[OPR_INTERFACE]=            &WN2F_interface_blk ;
01871     ourHandlerTable[OPR_ARRAY_CONSTRUCT]=      &WN2F_ar_construct ;
01872
01873     // Memory Access (or assignment and variable references)
01874     ourHandlerTable[OPR_LDA]=                  &xlate_LDA ;    // Leaf
01875     ourHandlerTable[OPR_LDID]=                 &xlate_LDID ;
01876     ourHandlerTable[OPR_STID]=                 &xlate_STID ;
01877     ourHandlerTable[OPR_ILOAD]=                &xlate_ILOAD ;
01878     ourHandlerTable[OPR_ILOADX]=               &xlate_ILOADX ;
01879     ourHandlerTable[OPR_MLOAD]=                &WN2F_mload ;
01880     ourHandlerTable[OPR_ISTORE]=               &xlate_ISTORE ;
01881     ourHandlerTable[OPR_ISTOREX]=              &xlate_ISTOREX ;
01882     ourHandlerTable[OPR_MSTORE]=               &WN2F_mstore ;
01883     ourHandlerTable[OPR_STRCTFLD]=             &xlate_STRCTFLD ;
01884     ourHandlerTable[OPR_PSTID]=                &WN2F_pstid ;  // pointer STID
01885     ourHandlerTable[OPR_PSTORE]=               &WN2F_pstore ; // pointer STORE
01886
01887     // Type conversion
01888     ourHandlerTable[OPR_CVT]=                  &WN2F_cvt ;
01889     ourHandlerTable[OPR_CVTL]=                 &WN2F_cvtl ;
01890     ourHandlerTable[OPR_TAS]=                  &WN2F_tas ;
01891
01892     // Expressions: Unary operations
01893     ourHandlerTable[OPR_INTCONST]=             &xlate_INTCONST ; // Leaf
01894     ourHandlerTable[OPR_CONST]=                &xlate_CONST ;    // Leaf
01895
01896     ourHandlerTable[OPR_NEG]=                  &xlate_UnaryOp ;
01897     ourHandlerTable[OPR_ABS]=                  &xlate_UnaryOp ;
01898     ourHandlerTable[OPR_SQRT]=                 &xlate_UnaryOp ;
01899     ourHandlerTable[OPR_RSQRT]=                &WN2F_rsqrt ;
01900     ourHandlerTable[OPR_RECIP]=                &xlate_RECIP ;
01901     ourHandlerTable[OPR_REALPART]=             &WN2F_realpart ; // OPR_FIRSTPART
01902     ourHandlerTable[OPR_IMAGPART]=             &WN2F_imagpart ; // OPR_SECONDPART
01903     ourHandlerTable[OPR_PAREN]=                &xlate_PAREN ;
01904     ourHandlerTable[OPR_RND]=                  &xlate_UnaryOp ;
01905     ourHandlerTable[OPR_TRUNC]=                &xlate_UnaryOp ;
01906     ourHandlerTable[OPR_CEIL]=                 &xlate_UnaryOp ;
01907     ourHandlerTable[OPR_FLOOR]=                &xlate_UnaryOp ;
01908     ourHandlerTable[OPR_BNOT]=                 &xlate_UnaryOp ;
01909     ourHandlerTable[OPR_LNOT]=                 &xlate_UnaryOp ;
01910     ourHandlerTable[OPR_PARM]=                 &WN2F_parm ;
01911     ourHandlerTable[OPR_ALLOCA]=               &WN2F_alloca ;
01912
01913     // Expressions: Binary operations
01914     ourHandlerTable[OPR_COMPLEX]=              &xlate_BinaryOp ; // OPR_PAIR
01915     ourHandlerTable[OPR_ADD]=                  &xlate_BinaryOp ;
01916     ourHandlerTable[OPR_SUB]=                  &xlate_BinaryOp ;
01917     ourHandlerTable[OPR_MPY]=                  &xlate_BinaryOp ;
01918     ourHandlerTable[OPR_DIV]=                  &xlate_BinaryOp ;
01919     ourHandlerTable[OPR_MOD]=                  &xlate_BinaryOp ;
01920     ourHandlerTable[OPR_REM]=                  &xlate_BinaryOp ;
01921     ourHandlerTable[OPR_MAX]=                  &xlate_BinaryOp ;
01922     ourHandlerTable[OPR_MIN]=                  &xlate_BinaryOp ;
01923     ourHandlerTable[OPR_EQ]=                   &xlate_BinaryOp ;
01924     ourHandlerTable[OPR_NE]=                   &xlate_BinaryOp ;
01925     ourHandlerTable[OPR_GE]=                   &xlate_BinaryOp ;
01926     ourHandlerTable[OPR_GT]=                   &xlate_BinaryOp ;
01927     ourHandlerTable[OPR_LE]=                   &xlate_BinaryOp ;
01928     ourHandlerTable[OPR_LT]=                   &xlate_BinaryOp ;
01929     ourHandlerTable[OPR_BAND]=                 &xlate_BinaryOp ;
01930     ourHandlerTable[OPR_BIOR]=                 &xlate_BinaryOp ;
01931     ourHandlerTable[OPR_BNOR]=                 &WN2F_bnor ;
01932     ourHandlerTable[OPR_BXOR]=                 &xlate_BinaryOp ;
01933     ourHandlerTable[OPR_LAND]=                 &xlate_BinaryOp ;
01934     ourHandlerTable[OPR_LIOR]=                 &xlate_BinaryOp ;
01935     ourHandlerTable[OPR_CAND]=                 &xlate_BinaryOp ;
01936     ourHandlerTable[OPR_CIOR]=                 &xlate_BinaryOp ;
01937     ourHandlerTable[OPR_SHL]=                  &xlate_BinaryOp ;
01938     ourHandlerTable[OPR_ASHR]=                 &xlate_BinaryOp ;
01939     ourHandlerTable[OPR_LSHR]=                 &WN2F_lshr ;
01940
01941     // Expressions: Ternary operations
01942     ourHandlerTable[OPR_SELECT]=               &WN2F_select ;
01943     ourHandlerTable[OPR_MADD]=                 &WN2F_madd ;
01944     ourHandlerTable[OPR_MSUB]=                 &WN2F_msub ;
01945     ourHandlerTable[OPR_NMADD]=                &WN2F_nmadd ;
01946     ourHandlerTable[OPR_NMSUB]=                &WN2F_nmsub ;
01947
01948     // Expressions: N-ary operations
01949     ourHandlerTable[OPR_ARRAY]=                &xlate_ARRAY ;
01950     ourHandlerTable[OPR_INTRINSIC_OP]=         &xlate_INTRINSIC_OP ;
01951     ourHandlerTable[OPR_TRIPLET]=              &WN2F_triplet ;
01952     ourHandlerTable[OPR_SRCTRIPLET]=           &WN2F_src_triplet ;
01953     ourHandlerTable[OPR_ARRAYEXP]=             &WN2F_arrayexp ;
01954     ourHandlerTable[OPR_ARRSECTION]=           &WN2F_arrsection ;
01955     ourHandlerTable[OPR_WHERE]=                &WN2F_where ;
01956
01957     // just for convenience
01958     ourHandlerTable[OPERATOR_UNKNOWN]=         &xlate_unknown;
01959   }
01960 }