OpenAD-docs-20140315/htmlOpenADFortTkPlain/XlateStmt_8cxx_source.html

00001 // -*-Mode: C++;-*-
00002 // $Header: /Volumes/cvsrep/developer/OpenADFortTk/src/xaif2whirl/XlateStmt.cxx,v 1.2 2006/05/12 16:12:24 utke Exp $
00003 #include <stdlib.h> // ANSI: cstdlib // for strtol
00004 #include <string.h> // ANSI: cstring // for strcmp, etc.
00005 #include <iostream>
00006
00007 #include <xercesc/dom/DOMDocument.hpp>
00008 #include <xercesc/dom/DOMNode.hpp>
00009 #include <xercesc/dom/DOMElement.hpp>
00010
00011 #include "Open64IRInterface/Open64BasicTypes.h"
00012 #include "Open64IRInterface/Open64IRInterface.hpp"
00013 #include "Open64IRInterface/SymTab.h"
00014 #include "Open64IRInterface/wn_attr.h"
00015 #include "Open64IRInterface/stab_attr.h"
00016
00017 #include <WhirlIDMaps.h>
00018 #include <XAIFStrings.h>
00019 #include "Diagnostics.h"
00020
00021 #include "xaif2whirl.h"
00022 #include "XlateStmt.h"
00023 #include "XlateExpression.h"
00024 #include "XAIF_DOMFilters.h"
00025 #include "XercesStrX.h"
00026
00027
00028 namespace xaif2whirl {
00029
00030   WN* XlateStmt::translateStmt(const DOMElement* stmt,
00031                                PUXlationContext& ctxt) {
00032     WN* wn = NULL;
00033     const XMLCh* name = stmt->getNodeName();
00034     if (XMLString::equals(name, XAIFStrings.elem_Assign_x())) {
00035       wn = xlate_Assignment(stmt, ctxt);
00036     }
00037     else if (XMLString::equals(name, XAIFStrings.elem_LpInit_x()) ||
00038              XMLString::equals(name, XAIFStrings.elem_LpUpdate_x())) {
00039       wn = translateAssignmentSimple(stmt, ctxt);
00040     }
00041     else if (XMLString::equals(name, XAIFStrings.elem_SubCall_x())) {
00042       wn = xlate_SubroutineCall(stmt, ctxt);
00043     }
00044     else if (XMLString::equals(name, XAIFStrings.elem_InlinableSubCall_x())) {
00045       wn = xlate_InlinableSubroutineCall(stmt, ctxt);
00046     }
00047     else if (XMLString::equals(name, XAIFStrings.elem_Marker_x())) {
00048       // nothing
00049     }
00050     else if (XMLString::equals(name, XAIFStrings.elem_DerivProp_x())) {
00051       wn = xlate_DerivativePropagator(stmt, ctxt);
00052     }
00053     else {
00054       FORTTK_DIE("Unknown XAIF statement:\n" << *stmt);
00055     }
00056     return wn;
00057   }
00058
00059   WN* XlateStmt::translateAssignmentSimple(const DOMElement* elem,
00060                                            PUXlationContext& ctxt) {
00061     DOMElement* lhs_elem = GetChildElement(elem, XAIFStrings.elem_AssignLHS_x());
00062     DOMElement* rhs_elem = GetChildElement(elem, XAIFStrings.elem_AssignRHS_x());
00063     DOMElement* lhsref = GetFirstChildElement(lhs_elem);
00064     std::pair<ST*, WN_OFFSET> lhspair = XlateExpression::translateVarRefSimple(lhsref, ctxt);
00065     ST* lhsst = lhspair.first;
00066     WN_OFFSET lhsoset = lhspair.second;
00067     ctxt.createXlationContext(XlationContext::EXPRSIMPLE);
00068     WN* rhs = xlate_AssignmentRHS(rhs_elem, ctxt);
00069     ctxt.deleteXlationContext();
00070     WN* wn = createAssignment(lhsst, lhsoset, rhs);
00071     return wn;
00072   }
00073
00074   WN* XlateStmt::patchWNStmt(WN* wn,
00075                              PUXlationContext& ctxt) {
00076     WN* patchedWN = NULL;
00077     OPERATOR opr = WN_operator(wn);
00078     if (opr == OPR_IO) {
00079       patchWN_IO(wn, ctxt);
00080       patchedWN = wn;
00081     }
00082     else if (OPERATOR_is_call(opr)) {
00083       // FIXME: for now, no need to do anything.  all calls are active
00084       // and all arguments are variables
00085     }
00086     else if (OPERATOR_is_store(opr) && opr!=OPR_PSTORE && opr!=OPR_PSTID) {
00087       patchedWN = XlateExpression::patchWNExpr(wn, 0 /* kid */, ctxt);
00088     }
00089     return patchedWN;
00090   }
00091
00092   WN* XlateStmt::xlate_Assignment(const DOMElement* elem,
00093                                   PUXlationContext& ctxt) {
00094     DOMElement* lhs_elem = GetChildElement(elem, XAIFStrings.elem_AssignLHS_x());
00095     DOMElement* rhs_elem = GetChildElement(elem, XAIFStrings.elem_AssignRHS_x());
00096     ctxt.createXlationContext(XlationContext::NOFLAG);
00097     WN* lhs = xlate_AssignmentLHS(lhs_elem, ctxt);
00098     WN* rhs = xlate_AssignmentRHS(rhs_elem, ctxt);
00099     ctxt.deleteXlationContext();
00100     // Special case to handle PREGS
00101     WN* wn = NULL;
00102     if (WN_operator(lhs) == OPR_LDID && ST_class(WN_st(lhs)) == CLASS_PREG) {
00103       wn = createAssignment(WN_st(lhs), WN_load_offset(lhs), rhs);
00104       WN_Delete(lhs); // not recursive
00105     } else {
00106       wn = createAssignment(lhs, rhs);
00107     }
00108     return wn;
00109   }
00110
00111   WN* XlateStmt::xlate_AssignmentLHS(const DOMElement* elem,
00112                                      PUXlationContext& ctxt) {
00113     // VariableReferenceType
00114     bool deriv = GetDerivAttr(elem);
00115     DOMElement* varref = GetFirstChildElement(elem);
00116     ctxt.createXlationContext((deriv) ? XlationContext::DERIVSELECTOR : XlationContext::VALUESELECTOR);
00117     ctxt.currentXlationContext().setFlag(XlationContext::LVALUE);
00118     WN* wn = XlateExpression::translateVarRef(varref, ctxt);
00119     ctxt.deleteXlationContext();
00120     return wn;
00121   }
00122
00123   WN* XlateStmt::xlate_AssignmentRHS(const DOMElement* elem,
00124                                      PUXlationContext& ctxt) {
00125     // ExpressionType
00126     DOMElement* child = GetFirstChildElement(elem);
00127     ctxt.createXlationContext(XlationContext::NOFLAG);
00128     WN* wn = XlateExpression::translateExpression(child, ctxt);
00129     ctxt.deleteXlationContext();
00130     return wn;
00131   }
00132
00133   WN* XlateStmt::xlate_SubroutineCall(const DOMElement* elem,
00134                                       PUXlationContext& ctxt) {
00135     // -------------------------------------------------------
00136     // 1. Gather the arguments, sorted by "position" attribute and
00137     // translate them into a WHIRL expression tree.
00138     // -------------------------------------------------------
00139     unsigned int numArgs = GetIntAttr(elem, XAIFStrings.attr_formalArgCount_x(), 0 /* default */);
00140     unsigned int numiArgs = 0; // implicit args
00141     std::vector<std::pair<WN*,fortTkSupport::SymId > >
00142       args_wn(numArgs, std::pair<WN*,fortTkSupport::SymId > (NULL,NULL));
00143     for (DOMElement* arg = GetFirstChildElement(elem); (arg);
00144          arg = GetNextSiblingElement(arg)) {
00145       // VariableReferenceType
00146       const XMLCh* nmX = arg->getNodeName();
00147       FORTTK_ASSERT(XMLString::equals(nmX, XAIFStrings.elem_Argument_x()),
00148                     "Expected " << XAIFStrings.elem_Argument() << "; found:\n"
00149                     << *arg);
00150       unsigned int pos = GetPositionAttr(arg); // 1-based
00151       FORTTK_ASSERT(1 <= pos && pos <= numArgs,
00152                     "Unexpected position attribute value:\n" << *arg << " out of range [1," << numArgs << "]");
00153       fortTkSupport::SymId symId = GetSymId(arg);
00154       if (symId) // non-zero for a keyword Argument
00155         args_wn[pos-1].second=symId;
00156       // Note: We do *not* check the deriv flag; any active variable
00157       // references should be passed as is.
00158       DOMElement* argExpr = GetFirstChildElement(arg);
00159       // this one can be a VariableReference or a Constant
00160       // figure out which it is:
00161       const XMLCh* nameArgExpr = argExpr->getNodeName();
00162       if (XMLString::equals(nameArgExpr, XAIFStrings.elem_VarRef_x())) {
00163         DOMElement* varRef = GetFirstChildElement(argExpr);
00164         ctxt.createXlationContext(XlationContext::DERIVSELECTOR);
00165         WN* varRefWN = XlateExpression::translateVarRef(varRef, ctxt);
00166         ctxt.deleteXlationContext();
00167         args_wn[pos - 1].first = varRefWN;
00168         // Determine whether WHIRL needs an implicit argument
00169         // (cf. WN2F_call() in wn2f_stmt.cxx)
00170         TY_IDX ty = WN_Tree_Type(varRefWN);
00171         if (TY_Is_Character_Reference(ty) || TY_Is_Chararray_Reference(ty)) {
00172           numiArgs++;
00173         }
00174       }
00175       else if (XMLString::equals(nameArgExpr, XAIFStrings.elem_Constant_x())) {
00176         ctxt.createXlationContext(XlationContext::DERIVSELECTOR);
00177         WN* constWN = XlateExpression::translateConstant(argExpr, ctxt);
00178         ctxt.deleteXlationContext();
00179         args_wn[pos - 1].first = constWN;
00180         // Determine whether WHIRL needs an implicit argument
00181         // (cf. WN2F_call() in wn2f_stmt.cxx)
00182         TY_IDX ty = WN_Tree_Type(constWN);
00183         if (TY_Is_Character_Reference(ty) || TY_Is_Chararray_Reference(ty)) {
00184           numiArgs++;
00185         }
00186       }
00187       else {
00188         FORTTK_DIE("Unknown XAIF subroutine call argument:\n" << *argExpr);
00189       }
00190     }
00191     // -------------------------------------------------------
00192     // 2. Gather WHIRL implicit arguments (e.g., for strings)
00193     // -------------------------------------------------------
00194     std::vector<WN*> iargs_wn(numiArgs, NULL);
00195     for (unsigned i = 0; i < numiArgs; ++i) {
00196       // Create bogus values, knowing that we only want to unparse the WHIRL
00197       iargs_wn[i] = WN_CreateIntconst(OPC_I4INTCONST, 0); // a white lie
00198     }
00199     // -------------------------------------------------------
00200     // 3. Create function call
00201     // -------------------------------------------------------
00202     TYPE_ID rtype = MTYPE_V; // void type for subroutine call
00203     fortTkSupport::Symbol* sym = GetSymbol(elem, ctxt);
00204     WN* callWN = WN_Call(rtype, MTYPE_V, numArgs + numiArgs, sym->GetST());
00205     WN_Set_Call_Default_Flags(callWN); // set conservative assumptions
00206     for (unsigned i = 0; i < numArgs; ++i) {
00207       if (args_wn[i].first) {
00208         // conservatively assume pass by reference
00209         WN_actual(callWN, i) = CreateParm(args_wn[i].first, WN_PARM_BY_REFERENCE);
00210         if (args_wn[i].second) {
00211           WN_actual(callWN, i)->u3.ty_fields.ty=args_wn[i].second;
00212         }
00213       }
00214     }
00215     for (unsigned i = 0, j = numArgs; i < numiArgs; ++i, ++j) {
00216       WN_actual(callWN, j) = CreateParm(iargs_wn[i], WN_PARM_BY_VALUE);
00217     }
00218     return callWN;
00219   }
00220
00221   WN* XlateStmt::xlate_InlinableSubroutineCall(const DOMElement* elem,
00222                                                PUXlationContext& ctxt) {
00223     // FIXME: abstract with above code
00224     // -------------------------------------------------------
00225     // 1. Gather the arguments, sorted by "position" attribute and
00226     // translate them into a WHIRL expression tree.
00227     // -------------------------------------------------------
00228     unsigned int numArgs = GetChildElementCount(elem);
00229     std::vector<WN*> args_wn(numArgs);
00230     for (DOMElement* arg = GetFirstChildElement(elem); (arg);
00231          arg = GetNextSiblingElement(arg) ) {
00232       // VariableReferenceType
00233       const XMLCh* nmX = arg->getNodeName();
00234       FORTTK_ASSERT(XMLString::equals(nmX, XAIFStrings.elem_Argument_x()),
00235                     "Expected " << XAIFStrings.elem_Argument()
00236                     << "; found\n" << *arg);
00237       unsigned int pos = GetPositionAttr(arg); // 1-based
00238       FORTTK_ASSERT(1 <= pos, "Unexpected position attribute:\n" << *arg);
00239       if (pos > args_wn.size()) { args_wn.resize(pos); } // must resize
00240       // Note: We do *not* check the deriv flag; any active variable
00241       // references should be passed as is.
00242       DOMElement* argExpr = GetFirstChildElement(arg);
00243       // this one can be a VariableReference or a Constant
00244       // figure out which it is:
00245       const XMLCh* nameArgExpr = argExpr->getNodeName();
00246       if (XMLString::equals(nameArgExpr, XAIFStrings.elem_VarRef_x())) {
00247         DOMElement* varRef = GetFirstChildElement(argExpr);
00248         ctxt.createXlationContext(XlationContext::DERIVSELECTOR);
00249         WN* varRefWN = XlateExpression::translateVarRef(varRef, ctxt);
00250         ctxt.deleteXlationContext();
00251         args_wn[pos - 1] = varRefWN;
00252       }
00253       else if (XMLString::equals(nameArgExpr, XAIFStrings.elem_Constant_x())) {
00254         ctxt.createXlationContext(XlationContext::DERIVSELECTOR);
00255         WN* constWN = XlateExpression::translateConstant(argExpr, ctxt);
00256         ctxt.deleteXlationContext();
00257         args_wn[pos - 1] = constWN;
00258       }
00259       else {
00260         FORTTK_DIE("Unknown XAIF subroutine call argument:\n" << *argExpr);
00261       }
00262     }
00263     // -------------------------------------------------------
00264     // 2. Create block containing OpenAD pragma and call
00265     // -------------------------------------------------------
00266     const XMLCh* subnameX = elem->getAttribute(XAIFStrings.attr_subname_x());
00267     XercesStrX subname = XercesStrX(subnameX);
00268     // Create OpenAD pragma (locate before creating placeholder nodes!)
00269     WN* comWN = createOpenADInline(subname.c_str(), args_wn);
00270     // Create placeholder nodes for arguments not found above
00271     for (unsigned int i = 0; i < args_wn.size(); ++i) {
00272       if (!args_wn[i]) {
00273         fortTkSupport::Symbol* sym = GetOrCreateBogusTmpSymbol(ctxt);
00274         ST* st = sym->GetST();
00275         TYPE_ID rty = ST_mtype(st), dty = ST_mtype(st);
00276         args_wn[i] = WN_CreateLdid(OPR_LDID, rty, dty, 0, st, ST_type(st), 0);
00277       }
00278     }
00279     // Create call (with placeholder nodes)
00280     TYPE_ID rtype = MTYPE_V; // void type for subroutine call
00281     WN* callWN = CreateCallToIntrin(rtype, subname.c_str(), args_wn);
00282     WN* blkWN = WN_CreateBlock();
00283     WN_INSERT_BlockFirst(blkWN, comWN);
00284     WN_INSERT_BlockLast(blkWN, callWN);
00285     return blkWN;
00286   }
00287
00288   WN* XlateStmt::xlate_DerivativePropagator(const DOMElement* elem,
00289                                             PUXlationContext& ctxt) {
00290     WN* blckWN = WN_CreateBlock();
00291     // Accumulate derivative propagator statements and add to block
00292     XAIF_DerivPropStmt filt;
00293     for (DOMElement* stmt = GetChildElement(elem, &filt);
00294          (stmt); stmt = GetNextSiblingElement(stmt, &filt)) {
00295       WN* wn = NULL;
00296       if (XAIF_DerivPropStmt::IsSetDeriv(stmt)) {
00297         wn = xlate_SetDeriv(stmt, ctxt);
00298       }
00299       else if (XAIF_DerivPropStmt::IsSetNegDeriv(stmt)) {
00300         wn = xlate_SetNegDeriv(stmt, ctxt);
00301       }
00302       else if (XAIF_DerivPropStmt::IsIncDeriv(stmt)) {
00303         wn = xlate_IncDeriv(stmt, ctxt);
00304       }
00305       else if (XAIF_DerivPropStmt::IsDecDeriv(stmt)) {
00306         wn = xlate_DecDeriv(stmt, ctxt);
00307       }
00308       else if (XAIF_DerivPropStmt::IsZeroDeriv(stmt) ) {
00309         wn = xlate_ZeroDeriv(stmt, ctxt);
00310       }
00311       else if (XAIF_DerivPropStmt::IsSax(stmt)) {
00312         wn = xlate_Saxpy(stmt, ctxt, false);
00313       }
00314       else if (XAIF_DerivPropStmt::IsSaxpy(stmt) ) {
00315         wn = xlate_Saxpy(stmt, ctxt, true);
00316       }
00317       else {
00318         FORTTK_DIE("Unknown XAIF derivative propagator statement:\n" << *stmt);
00319       }
00320       WN_INSERT_BlockLast(blckWN, wn);
00321     }
00322     // Do not return an empty block
00323     if (WN_first(blckWN) == NULL)  {
00324       WN_Delete(blckWN);
00325       blckWN = NULL;
00326     }
00327     return blckWN;
00328   }
00329
00330   WN* XlateStmt::xlate_SetDeriv(const DOMElement* elem,
00331                                 PUXlationContext& ctxt) {
00332     DOMElement* tgt = GetChildElement(elem, XAIFStrings.elem_Tgt_x());
00333     DOMElement* src = GetChildElement(elem, XAIFStrings.elem_Src_x());
00334     // Note: This should always be DERIVSELECTOR (FIXME)
00335     bool deriv = GetDerivAttr(tgt);
00336     ctxt.createXlationContext((deriv) ? XlationContext::DERIVSELECTOR : XlationContext::VALUESELECTOR);
00337     WN* tgtWN = XlateExpression::translateVarRef(GetFirstChildElement(tgt), ctxt);
00338     ctxt.deleteXlationContext();
00339     // Note: This should always be DERIVSELECTOR (FIXME)
00340     deriv = GetDerivAttr(src);
00341     ctxt.createXlationContext((deriv) ? XlationContext::DERIVSELECTOR : XlationContext::VALUESELECTOR);
00342     WN* srcWN = XlateExpression::translateVarRef(GetFirstChildElement(src), ctxt);
00343     ctxt.deleteXlationContext();
00344     WN* callWN = CreateCallToIntrin(MTYPE_V, "setderiv", 2);
00345     WN_actual(callWN, 0) = CreateParm(tgtWN, WN_PARM_BY_REFERENCE);
00346     WN_actual(callWN, 1) = CreateParm(srcWN, WN_PARM_BY_VALUE);
00347     return callWN;
00348   }
00349
00350   WN* XlateStmt::xlate_SetNegDeriv(const DOMElement* elem,
00351                                    PUXlationContext& ctxt) {
00352     DOMElement* tgt = GetChildElement(elem, XAIFStrings.elem_Tgt_x());
00353     DOMElement* src = GetChildElement(elem, XAIFStrings.elem_Src_x());
00354     // Note: This should always be DERIVSELECTOR (FIXME)
00355     bool deriv = GetDerivAttr(tgt);
00356     ctxt.createXlationContext((deriv) ? XlationContext::DERIVSELECTOR : XlationContext::VALUESELECTOR);
00357     WN* tgtWN = XlateExpression::translateVarRef(GetFirstChildElement(tgt), ctxt);
00358     ctxt.deleteXlationContext();
00359     // Note: This should always be DERIVSELECTOR (FIXME)
00360     deriv = GetDerivAttr(src);
00361     ctxt.createXlationContext((deriv) ? XlationContext::DERIVSELECTOR : XlationContext::VALUESELECTOR);
00362     WN* srcWN = XlateExpression::translateVarRef(GetFirstChildElement(src), ctxt);
00363     ctxt.deleteXlationContext();
00364     WN* callWN = CreateCallToIntrin(MTYPE_V, "set_neg_deriv", 2);
00365     WN_actual(callWN, 0) = CreateParm(tgtWN, WN_PARM_BY_REFERENCE);
00366     WN_actual(callWN, 1) = CreateParm(srcWN, WN_PARM_BY_VALUE);
00367     return callWN;
00368   }
00369
00370   WN* XlateStmt::xlate_IncDeriv(const DOMElement* elem,
00371                                 PUXlationContext& ctxt) {
00372     DOMElement* tgt = GetChildElement(elem, XAIFStrings.elem_Tgt_x());
00373     DOMElement* src = GetChildElement(elem, XAIFStrings.elem_Src_x());
00374     // Note: This should always be DERIVSELECTOR (FIXME)
00375     bool deriv = GetDerivAttr(tgt);
00376     ctxt.createXlationContext((deriv) ? XlationContext::DERIVSELECTOR : XlationContext::VALUESELECTOR);
00377     WN* tgtWN = XlateExpression::translateVarRef(GetFirstChildElement(tgt), ctxt);
00378     ctxt.deleteXlationContext();
00379     // Note: This should always be DERIVSELECTOR (FIXME)
00380     deriv = GetDerivAttr(src);
00381     ctxt.createXlationContext((deriv) ? XlationContext::DERIVSELECTOR : XlationContext::VALUESELECTOR);
00382     WN* srcWN = XlateExpression::translateVarRef(GetFirstChildElement(src), ctxt);
00383     ctxt.deleteXlationContext();
00384     WN* callWN = CreateCallToIntrin(MTYPE_V, "inc_deriv", 2);
00385     WN_actual(callWN, 0) = CreateParm(tgtWN, WN_PARM_BY_REFERENCE);
00386     WN_actual(callWN, 1) = CreateParm(srcWN, WN_PARM_BY_VALUE);
00387     return callWN;
00388   }
00389
00390   WN* XlateStmt::xlate_DecDeriv(const DOMElement* elem,
00391                                 PUXlationContext& ctxt) {
00392     DOMElement* tgt = GetChildElement(elem, XAIFStrings.elem_Tgt_x());
00393     DOMElement* src = GetChildElement(elem, XAIFStrings.elem_Src_x());
00394     // Note: This should always be DERIVSELECTOR (FIXME)
00395     bool deriv = GetDerivAttr(tgt);
00396     ctxt.createXlationContext((deriv) ? XlationContext::DERIVSELECTOR : XlationContext::VALUESELECTOR);
00397     WN* tgtWN = XlateExpression::translateVarRef(GetFirstChildElement(tgt), ctxt);
00398     ctxt.deleteXlationContext();
00399     // Note: This should always be DERIVSELECTOR (FIXME)
00400     deriv = GetDerivAttr(src);
00401     ctxt.createXlationContext((deriv) ? XlationContext::DERIVSELECTOR : XlationContext::VALUESELECTOR);
00402     WN* srcWN = XlateExpression::translateVarRef(GetFirstChildElement(src), ctxt);
00403     ctxt.deleteXlationContext();
00404     WN* callWN = CreateCallToIntrin(MTYPE_V, "dec_deriv", 2);
00405     WN_actual(callWN, 0) = CreateParm(tgtWN, WN_PARM_BY_REFERENCE);
00406     WN_actual(callWN, 1) = CreateParm(srcWN, WN_PARM_BY_VALUE);
00407     return callWN;
00408   }
00409
00410   WN* XlateStmt::xlate_ZeroDeriv(const DOMElement* elem,
00411                                  PUXlationContext& ctxt) {
00412     WN* x = xlate_AssignmentLHS(elem, ctxt); // functionally equivalent
00413     WN* callWN = CreateCallToIntrin(MTYPE_V, "zero_deriv", 1);
00414     WN_actual(callWN, 0) = CreateParm(x, WN_PARM_BY_REFERENCE);
00415     return callWN;
00416   }
00417
00418   WN* XlateStmt::xlate_Saxpy(const DOMElement* elem,
00419                              PUXlationContext& ctxt,
00420                              bool saxpy) {
00421     // count the children
00422     int elemCount=GetChildElementCount(elem);
00423     // create a WHIRL call
00424     const char* fnm = (saxpy) ? "saxpy" : "sax";
00425     MTYPE rtype = MTYPE_V;
00426     // one child element for 'y'; all other child elements are pairs of 'a' and 'x'
00427     WN* callWN = CreateCallToIntrin(rtype, fnm, 2*(elemCount-1)+1);
00428     int parameterPosition=0;
00429     // get the a/x pairs
00430     DOMElement* aChildElem(GetFirstChildElement(elem));
00431     while (aChildElem) {
00432       if (XAIF_ElemFilter(XAIFStrings.elem_AX_x()).acceptNode(aChildElem) == DOMNodeFilter::FILTER_ACCEPT) {
00433         DOMElement* theA = GetChildElement(aChildElem, XAIFStrings.elem_A_x());
00434         DOMElement* theX = GetChildElement(aChildElem, XAIFStrings.elem_X_x());
00435         // A
00436         WN* a_wn = XlateExpression::translateExpression(GetFirstChildElement(theA), ctxt);
00437         // X
00438         bool deriv = GetDerivAttr(theX);
00439         ctxt.createXlationContext((deriv) ? XlationContext::DERIVSELECTOR : XlationContext::VALUESELECTOR);
00440         WN* x_wn = XlateExpression::translateVarRef(GetFirstChildElement(theX), ctxt);
00441         ctxt.deleteXlationContext();
00442         // add the parameters
00443         WN_actual(callWN, parameterPosition++) = CreateParm(a_wn, WN_PARM_BY_VALUE);
00444         WN_actual(callWN, parameterPosition++) = CreateParm(x_wn, WN_PARM_BY_VALUE);
00445       }
00446       aChildElem=GetNextSiblingElement(aChildElem);
00447     }
00448     // Y
00449     DOMElement* Y = GetChildElement(elem, XAIFStrings.elem_Y_x());
00450     bool deriv = GetDerivAttr(Y);
00451     ctxt.createXlationContext((deriv) ? XlationContext::DERIVSELECTOR : XlationContext::VALUESELECTOR);
00452     WN* y_wn = XlateExpression::translateVarRef(GetFirstChildElement(Y), ctxt);
00453     ctxt.deleteXlationContext();
00454     WN_actual(callWN, parameterPosition) = CreateParm(y_wn, WN_PARM_BY_REFERENCE);
00455     return callWN;
00456   }
00457
00458   void XlateStmt::patchWN_IO(WN* wn,
00459                              PUXlationContext& ctxt) {
00460     // FIXME: only handle cray read/write for now
00461     patchWN_IO_cray(wn, ctxt);
00462   }
00463
00464   void XlateStmt::patchWN_IO_cray(WN* wn,
00465                                   PUXlationContext& ctxt) {
00466     IOSTATEMENT iostmt = WN_io_statement(wn);
00467     FORTTK_ASSERT_WARN(iostmt == IOS_CR_FWF || iostmt == IOS_CR_FWU
00468                        || iostmt == IOS_CR_FRF || iostmt == IOS_CR_FRU
00469                        || iostmt == IOS_CR_OPEN || iostmt == IOS_CR_CLOSE
00470                        || iostmt == IOS_INQUIRE || iostmt == IOS_CR_INQUIRE
00471                        || iostmt == IOS_REWIND  || iostmt == IOS_CR_REWIND,
00472                        fortTkSupport::Diagnostics::UnexpectedInput << IOSTATEMENT_name(iostmt));
00473     // Iterate over IO_ITEMs and translate IOLs (io lists)
00474     for (INT kidno = 0; kidno < WN_kid_count(wn); ++kidno) {
00475       WN* kid = WN_kid(wn, kidno);
00476       if (IS_IO_ITEM_IOL(kid)) {
00477         patchWN_IO_ITEM_list(kid, ctxt);
00478       }
00479     }
00480   }
00481
00482   void XlateStmt::patchWN_IO_ITEM_list(WN* wn,
00483                                        PUXlationContext& ctxt) {
00484     // cf. xlate_IO_ITEM_list
00485     IOITEM kind = WN_io_item(wn);
00486     switch (kind) {
00487     case IOL_VAR:
00488     case IOL_ARRAY:
00489     case IOL_RECORD:
00490       XlateExpression::patchWNExpr(wn, 0 /* kid */, ctxt);
00491       break;
00492     case IOL_CHAR_ARRAY:
00493     case IOL_CHAR:       // skip
00494       break;
00495     case IOL_EXPR: // patch
00496       XlateExpression::patchWNExpr(wn, 0 /* kid */, ctxt);
00497       break;
00498     case IOL_IMPLIED_DO: // patch
00499     case IOL_IMPLIED_DO_1TRIP:
00500       XlateExpression::patchWNExpr(wn, 2 /* kid */, ctxt);
00501       for (int kid = 4; kid < WN_kid_count(wn); ++kid) {
00502         patchWN_IO_ITEM_list(WN_kid(wn, kid), ctxt);
00503       }
00504       break;
00505     case IOL_LOGICAL: // skip
00506     case IOL_DOPE:    // skip
00507       break;
00508     default:
00509       FORTTK_DIE(fortTkSupport::Diagnostics::UnexpectedOpr << IOITEM_name(kind));
00510       break;
00511     }
00512   }
00513
00514   WN* XlateStmt::createAssignment(WN* lhs,
00515                                   WN* rhs) {
00516     // We always use ISTORE (instead of e.g. STID) for generality.  This
00517     // will not be an issue because the intension is for this WHIRL to
00518     // be translated to source code.
00519     TY_IDX ty = WN_Tree_Type(lhs); // should be a pointer type
00520     TY_IDX rhs_ty = WN_Tree_Type(rhs);
00521     if (TY_is_f90_pointer(rhs_ty) || TY_Is_Pointer(rhs_ty))
00522       rhs_ty=TY_pointed(rhs_ty);
00523     if (TY_Is_Array(rhs_ty) || TY_Is_Pointer(rhs_ty))
00524       rhs_ty=TY_etype(rhs_ty);
00525     TYPE_ID dtype = TY_mtype(rhs_ty);
00526     if (dtype == MTYPE_STR) {
00527       dtype = MTYPE_U1;
00528     }
00529     WN* wn = WN_Istore(dtype, 0, ty, lhs, rhs, 0);
00530     return wn;
00531   }
00532
00533   WN* XlateStmt::createAssignment(ST* lhs,
00534                                   WN_OFFSET oset,
00535                                   WN* rhs) {
00536     // A special version of the above for situations in which WHIRL
00537     // requires STID assignments (e.g. loop initialization and updates).
00538     TY_IDX ty = WN_Tree_Type(rhs); // referenced-obj = base-obj
00539     WN* wn = WN_Stid(TY_mtype(ty), oset, lhs, ty, rhs, 0);
00540     return wn;
00541   }
00542
00543   WN* XlateStmt::createZeroConst(TYPE_ID ty) {
00544     return Make_Const(Targ_Conv(ty, Host_To_Targ(MTYPE_I4, 0)));
00545   }
00546
00547   WN* XlateStmt::createOpenADInline(const char* fname,
00548                                     std::vector<WN*>& args) {
00549     // $OpenAD$ INLINE subname(argpos1, argpos2..)
00550     std::string com = "$OpenAD$ INLINE ";
00551     com.reserve(128);
00552     com += fname;
00553     com += "(";
00554     for (unsigned int i = 0; i < args.size(); ++i) {
00555       const char* argdesc = (args[i]) ? "subst" : "nosubst";
00556       com += argdesc;
00557       if (i < (args.size() - 1)) { com += ","; }
00558     }
00559     com += ")";
00560     WN* comWN = WN_CreateComment((char*)com.c_str());
00561     return comWN;
00562   }
00563 }