|
OpenADFortTk (basic)
|
|
OpenADFortTk (basic)
|
00001 // -*-Mode: C++;-*- 00002 // $Header: /Volumes/cvsrep/developer/OpenADFortTk/src/xaif2whirl/XlateExpression.cxx,v 1.2 2006/05/12 16:12:23 utke Exp $ 00003 00004 #include <stdlib.h> // ANSI: cstdlib // for strtol 00005 #include <string.h> // ANSI: cstring // for strcmp, etc. 00006 #include <iostream> 00007 #include <vector> 00008 #include <algorithm> 00009 00010 #include "Open64IRInterface/Open64BasicTypes.h" 00011 #include "Open64IRInterface/Open64IRInterface.hpp" 00012 #include "Open64IRInterface/SymTab.h" 00013 #include "Open64IRInterface/wn_attr.h" 00014 #include "Open64IRInterface/stab_attr.h" 00015 00016 #include "ScalarizedRefTab.h" 00017 #include "WhirlIDMaps.h" 00018 #include "XAIFStrings.h" 00019 #include "Diagnostics.h" 00020 00021 #include "xaif2whirl.h" 00022 #include "Args.h" 00023 #include "XlateExpression.h" 00024 #include "XAIF_DOMFilters.h" 00025 #include "XercesStrX.h" 00026 00027 namespace xaif2whirl { 00028 extern TY_IDX ActiveTypeTyIdx; // FIXME 00029 extern TY_IDX ActiveTypeInitializedTyIdx; // FIXME 00030 00031 00032 WN* XlateExpression::translateExpression(const DOMElement* elem, 00033 PUXlationContext& ctxt) { 00034 FORTTK_ASSERT(elem, fortTkSupport::Diagnostics::UnexpectedInput); 00035 // Slurp expression into a graph (DAG) and translate it 00036 OA::OA_ptr<OA::DGraph::DGraphImplement> g = createExpressionGraph(elem); 00037 // xaif2whirl::DDumpDotGraph(g); 00038 OA::OA_ptr<OA::DGraph::NodeInterface> root = g->getExprGraphRootNode(); 00039 OA::OA_ptr<MyDGNode> n = root.convert<MyDGNode>(); 00040 WN* wn = xlate_Expression(g, n, ctxt); 00041 return wn; 00042 } 00043 00044 WN* XlateExpression::translateExpressionSimple(const DOMElement* elem, 00045 PUXlationContext& ctxt) { 00046 ctxt.createXlationContext(XlationContext::EXPRSIMPLE); 00047 WN* wn = translateExpression(elem, ctxt); 00048 ctxt.deleteXlationContext(); 00049 return wn; 00050 } 00051 00052 WN* XlateExpression::translateVarRef(const DOMElement* elem, 00053 PUXlationContext& ctxt) { 00054 FORTTK_ASSERT(elem, fortTkSupport::Diagnostics::UnexpectedInput); 00055 // Slurp expression into a graph (DAG) and translate it 00056 ctxt.createXlationContext(XlationContext::VARREF); 00057 OA::OA_ptr<OA::DGraph::DGraphImplement> g = 00058 createExpressionGraph(elem, true /* varRef */); 00059 // xaif2whirl::DDumpDotGraph(g); 00060 OA::OA_ptr<OA::DGraph::NodeInterface> root = g->getExprGraphRootNode(); 00061 OA::OA_ptr<MyDGNode> n = root.convert<MyDGNode>(); 00062 WN* wn = xlate_VarRef(g, n, ctxt); 00063 ctxt.deleteXlationContext(); 00064 // If we are not already within another VarRef and we translated an 00065 // active symbol, select the appropriate portion of the active type 00066 if (!ctxt.currentXlationContext().isFlag(XlationContext::VARREF) 00067 || 00068 ctxt.currentXlationContext().isFlag(XlationContext::ARRAYIDX)) { 00069 if (ctxt.currentXlationContext().isFlag(XlationContext::ACTIVETYPE)) { 00070 if (ctxt.currentXlationContext().isFlag(XlationContext::VALUESELECTOR)) { 00071 wn = createValueSelector(wn); // active 00072 } else if (ctxt.currentXlationContext().isFlag(XlationContext::DERIVSELECTOR)) { 00073 wn = createDerivSelector(wn); // deriv 00074 } 00075 ctxt.currentXlationContext().unsetFlag(XlationContext::ACTIVETYPE); // halt up-inheritance 00076 } 00077 } 00078 return wn; 00079 } 00080 00081 std::pair<ST*, WN_OFFSET> XlateExpression::translateVarRefSimple(const DOMElement* elem, 00082 PUXlationContext& ctxt) { 00083 FORTTK_ASSERT(elem, fortTkSupport::Diagnostics::UnexpectedInput); 00084 // This must be a plain XAIF symbol reference (a one-vertex graph) 00085 const XMLCh* nameX = elem->getNodeName(); 00086 if ( !(XMLString::equals(nameX, XAIFStrings.elem_SymRef_x()) && 00087 GetNextSiblingElement(elem) == NULL) ) { 00088 FORTTK_DIE("Expected a simple var ref but found:\n" << *elem); 00089 } 00090 ctxt.createXlationContext(XlationContext::NOFLAG); 00091 pair<ST*, WN_OFFSET> stpair = xlate_SymbolReferenceSimple(elem, ctxt); 00092 ctxt.deleteXlationContext(); 00093 return stpair; 00094 } 00095 00096 WN* XlateExpression::patchWNExpr(WN* parent, 00097 INT kidno, 00098 PUXlationContext& ctxt) { 00099 // Simple Base cases 00100 if (!parent) { return NULL; } 00101 WN* wn = WN_kid(parent, kidno); 00102 if (!wn) { return NULL; } 00103 OPERATOR opr = WN_operator(wn); 00104 if (!OPERATOR_is_expression(opr) && !OPERATOR_is_call(opr)) { return parent; } 00105 // Base case: a variable reference 00106 if (fortTkSupport::ScalarizedRef::isRefTranslatableToXAIF(wn)) { 00107 if (hasActiveSymbolType(wn)) { 00108 WN* newwn = createValueSelector(wn); 00109 WN_kid(parent, kidno) = newwn; 00110 } 00111 } 00112 else { 00113 // Recursive case 00114 for (INT i = 0; i < WN_kid_count(wn); ++i) { 00115 patchWNExpr(wn, i /* kid */, ctxt); 00116 } 00117 } 00118 return parent; 00119 } 00120 00121 bool XlateExpression::hasActiveSymbolType(WN* aWNp) { 00122 if (WN_has_sym(aWNp)) { 00123 if (WN_operator(aWNp)==OPR_IMPLICIT_BND) 00124 return false; 00125 ST* st = WN_st(aWNp); 00126 TY_IDX tyIdx = ST_type(st); 00127 if (TY_kind(tyIdx) == KIND_POINTER) { 00128 tyIdx = TY_pointed(tyIdx); 00129 } 00130 if (TY_kind(tyIdx) == KIND_ARRAY) { 00131 tyIdx = TY_etype(tyIdx); 00132 } 00133 if (tyIdx == ActiveTypeTyIdx || tyIdx == ActiveTypeInitializedTyIdx) { 00134 return true; 00135 } 00136 } 00137 else if( WN_operator(aWNp)==OPR_STRCTFLD) { 00138 TY_IDX base_ty = WN_GetBaseObjType(aWNp); 00139 UINT field_id = WN_field_id(aWNp); 00140 UINT cur_field_id=0; 00141 FLD_HANDLE fld = FLD_get_to_field (base_ty, field_id, cur_field_id); 00142 TY_IDX tyIdx = FLD_type(fld); 00143 if (TY_kind(tyIdx) == KIND_POINTER) { 00144 tyIdx = TY_pointed(tyIdx); 00145 } 00146 if (TY_kind(tyIdx) == KIND_ARRAY) { 00147 tyIdx = TY_etype(tyIdx); 00148 } 00149 if (tyIdx == ActiveTypeTyIdx || tyIdx == ActiveTypeInitializedTyIdx) { 00150 return true; 00151 } 00152 } 00153 else { 00154 // Recursive case 00155 for (INT i = 0; i < WN_kid_count(aWNp); ++i) { 00156 if (hasActiveSymbolType(WN_kid(aWNp, i))) 00157 return true; 00158 } 00159 } 00160 return false; 00161 } 00162 00163 WN* XlateExpression::translateConstant(const DOMElement* elem, 00164 PUXlationContext& ctxt) { 00165 FORTTK_ASSERT(elem, fortTkSupport::Diagnostics::UnexpectedInput); 00166 const XMLCh* typeX = elem->getAttribute(XAIFStrings.attr_type_x()); 00167 const XMLCh* fetypeX = elem->getAttribute(XAIFStrings.attr_feType_x()); 00168 const XMLCh* valX = elem->getAttribute(XAIFStrings.attr_value_x()); 00169 XercesStrX type = XercesStrX(typeX); 00170 XercesStrX fetype = XercesStrX(fetypeX); 00171 TYPE_ID mtype=XAIFFETypeToWHIRLMTy(fetype.c_str()); 00172 XercesStrX value = XercesStrX(valX); 00173 WN* wn = NULL; 00174 if ((strcmp(type.c_str(), "real") == 0) || 00175 (strcmp(type.c_str(), "double") == 0)) { 00176 // Floating point constant 00177 double val = strtod(value.c_str(), (char **)NULL); 00178 if (mtype==MTYPE_UNKNOWN) 00179 mtype=Args::ourDefaultMTypeReal; 00180 TCON tcon = Host_To_Targ_Float(mtype, val); 00181 wn = Make_Const(tcon); 00182 } 00183 else if (strcmp(type.c_str(), "integer") == 0) { 00184 // Integer constant: Note that we have turned off WHIRL's 00185 // expression simplifier, which can cause problems with our code. 00186 // Also note that certain special expressions need an I4INTCONST. 00187 // E.g.: array indices, loop updates. 00188 INT64 val = strtol(value.c_str(), (char **)NULL, 10); 00189 if (ctxt.currentXlationContext().isFlag(XlationContext::ARRAYIDX) || 00190 ctxt.currentXlationContext().isFlag(XlationContext::EXPRSIMPLE)) { 00191 wn = WN_CreateIntconst(OPC_I4INTCONST, (INT32)val); 00192 } else { 00193 if (mtype==MTYPE_UNKNOWN) 00194 mtype=Args::ourDefaultMTypeInt; 00195 OPCODE opc = OPCODE_make_op(OPR_INTCONST, mtype, MTYPE_V); 00196 wn = WN_CreateIntconst(opc, val); 00197 } 00198 } 00199 else if (strcmp(type.c_str(), "bool") == 0) { 00200 // Boolean constant: boolean values can be true/false or 1/0. 00201 unsigned int val = 1; 00202 const char* v = value.c_str(); 00203 if ((strcmp(v, "false") == 0) || (strcmp(v, "0") == 0)) { 00204 val = 0; 00205 } 00206 wn = CreateBoolConst(val); 00207 } 00208 else if (strcmp(type.c_str(), "char") == 0) { 00209 // Character constant. Cf. cwh_stmt.cxx:349 00210 // wn = WN_CreateIntconst(OPC_I4INTCONST, (INT64)val); 00211 FORTTK_DIE(fortTkSupport::Diagnostics::Unimplemented << "creation of character constant"); 00212 } 00213 else if (strcmp(type.c_str(), "string") == 0) { 00214 // String constant. A string constant reference to "S" looks like: 00215 // U4U1ILOAD 0 T<43,.character.,1> T<175,anon_ptr.,8> 00216 // U8LDA 0 <1,596,(1_bytes)_"S"> T<127,anon_ptr.,8> 00217 // cf. fei_pattern_con(..) in cwh_stab.cxx 00218 TY_IDX ty = MTYPE_To_TY(MTYPE_STRING); 00219 TY_IDX ty_ptr = Stab_Pointer_To(ty); 00220 UINT32 len = strlen(value.c_str()); 00221 TCON tcon = Host_To_Targ_String(MTYPE_STRING, (char*)value.c_str(), len); 00222 ST* st = Gen_String_Sym(&tcon, ty, FALSE); 00223 TYPE_ID rty = TY_mtype(ty_ptr); // Pointer_Mtype 00224 WN* lda = WN_CreateLda(OPR_LDA, rty, MTYPE_V, 0, ty_ptr, st, 0); 00225 wn = WN_CreateIload(OPR_ILOAD, MTYPE_U4, MTYPE_U1, 0, ty, ty_ptr, lda, 0); 00226 } 00227 return wn; 00228 } 00229 00230 WN* XlateExpression::xlate_Intrinsic(OA::OA_ptr<OA::DGraph::DGraphImplement> g, 00231 OA::OA_ptr<MyDGNode> n, 00232 PUXlationContext& ctxt) { 00233 FORTTK_ASSERT(!g.ptrEqual(NULL) && !n.ptrEqual(NULL), fortTkSupport::Diagnostics::UnexpectedInput); 00234 DOMElement* elem = n->GetElem(); 00235 const XMLCh* nmX = elem->getAttribute(XAIFStrings.attr_name_x()); 00236 XercesStrX nm = XercesStrX(nmX); 00237 std::string key = GetIntrinsicKey(elem); 00238 bool suppressIt=(std::string("allocated")==nm.c_str() 00239 || 00240 std::string("lbound")==nm.c_str() 00241 || 00242 std::string("ubound")==nm.c_str() 00243 || 00244 std::string("size")==nm.c_str()); 00245 if (suppressIt) { 00246 ctxt.currentXlationContext().setFlag(XlationContext::SUPPRESSSELECTOR); 00247 } 00248 WN* wn = xlate_ExprOpUsingIntrinsicTable(fortTkSupport::IntrinsicXlationTable::XAIFIntrin, 00249 nm.c_str(), 00250 key.c_str(), 00251 g, 00252 n, 00253 ctxt); 00254 if (suppressIt) { 00255 ctxt.currentXlationContext().unsetFlag(XlationContext::SUPPRESSSELECTOR); 00256 } 00257 return wn; 00258 } 00259 00260 WN* XlateExpression::xlate_Expression(OA::OA_ptr<OA::DGraph::DGraphImplement> g, 00261 OA::OA_ptr<MyDGNode> n, 00262 PUXlationContext& ctxt) { 00263 // Recursively translate the DAG (tree) rooted at this node 00264 DOMElement* elem = n->GetElem(); 00265 const XMLCh* nameX = elem->getNodeName(); 00266 XercesStrX name = XercesStrX(nameX); 00267 WN* wn = NULL; 00268 if (XMLString::equals(nameX, XAIFStrings.elem_VarRef_x())) { 00269 // VariableReference 00270 wn = xlate_VarRef(elem, ctxt); 00271 } 00272 else if (XMLString::equals(nameX, XAIFStrings.elem_Constant_x())) { 00273 // Constant 00274 wn = translateConstant(elem, ctxt); 00275 } 00276 else if (XMLString::equals(nameX, XAIFStrings.elem_Intrinsic_x())) { 00277 // Intrinsic 00278 wn = xlate_Intrinsic(g, n, ctxt); 00279 } 00280 else if (XMLString::equals(nameX, XAIFStrings.elem_FuncCall_x())) { 00281 // FunctionCall 00282 wn = xlate_FunctionCall(g, n, ctxt); 00283 } 00284 else if (XMLString::equals(nameX, XAIFStrings.elem_BoolOp_x())) { 00285 // BooleanOperation 00286 wn = xlate_BooleanOperation(g, n, ctxt); 00287 } 00288 else { 00289 FORTTK_DIE("Unknown XAIF expression:\n" << *elem); 00290 } 00291 return wn; 00292 } 00293 00294 WN* XlateExpression::xlate_VarRef(const DOMElement* elem, PUXlationContext& ctxt) { 00295 FORTTK_ASSERT(elem, fortTkSupport::Diagnostics::UnexpectedInput); 00296 // VariableReferenceType 00297 bool deriv = GetDerivAttr(elem); 00298 // skip the xaif:VariableReference node 00299 DOMElement* varref = GetFirstChildElement(elem); 00300 if (ctxt.currentXlationContext().isFlag(XlationContext::SUPPRESSSELECTOR)) { 00301 ctxt.createXlationContext(); 00302 // to make sure: 00303 ctxt.currentXlationContext().unsetFlag(XlationContext::DERIVSELECTOR); 00304 ctxt.currentXlationContext().unsetFlag(XlationContext::VALUESELECTOR); 00305 } 00306 else 00307 ctxt.createXlationContext((deriv) ? XlationContext::DERIVSELECTOR : XlationContext::VALUESELECTOR); 00308 WN* wn = translateVarRef(varref, ctxt); 00309 ctxt.deleteXlationContext(); 00310 return wn; 00311 } 00312 00313 WN* XlateExpression::xlate_VarRef(OA::OA_ptr<OA::DGraph::DGraphImplement> g, 00314 OA::OA_ptr<MyDGNode> n, 00315 PUXlationContext& ctxt) { 00316 FORTTK_ASSERT(!g.ptrEqual(NULL) && !n.ptrEqual(NULL), fortTkSupport::Diagnostics::UnexpectedInput); 00317 // Recursively translate the DAG (tree) rooted at this node 00318 DOMElement* elem = n->GetElem(); 00319 FORTTK_ASSERT(elem, "Internal error: var-ref graph contains null DOM elem."); 00320 WN* wn = NULL; 00321 const XMLCh* nameX = elem->getNodeName(); 00322 if (XMLString::equals(nameX, XAIFStrings.elem_SymRef_x())) { 00323 // SymbolReference 00324 wn = xlate_SymbolReference(elem, ctxt); 00325 } 00326 else if (XMLString::equals(nameX, XAIFStrings.elem_ArrayElemRef_x())) { 00327 // ArrayElementReference 00328 wn = xlate_ArrayElementReference(g, n, ctxt); 00329 } 00330 else { 00331 FORTTK_DIE("Unknown XAIF variable reference:\n" << *elem); 00332 } 00333 return wn; 00334 } 00335 00336 WN* XlateExpression::xlate_FunctionCall(OA::OA_ptr<OA::DGraph::DGraphImplement> g, 00337 OA::OA_ptr<MyDGNode> n, 00338 PUXlationContext& ctxt) { 00339 FORTTK_ASSERT(!g.ptrEqual(NULL) && !n.ptrEqual(NULL), fortTkSupport::Diagnostics::UnexpectedInput); 00340 DOMElement* elem = n->GetElem(); 00341 // FIXME: children are expr; find num of args (use Intrinsic function above) 00342 FORTTK_DIE(fortTkSupport::Diagnostics::Unimplemented << "xaif:FunctionCall"); 00343 return NULL; 00344 } 00345 00346 WN* XlateExpression::xlate_BooleanOperation(OA::OA_ptr<OA::DGraph::DGraphImplement> g, 00347 OA::OA_ptr<MyDGNode> n, 00348 PUXlationContext& ctxt) { 00349 FORTTK_ASSERT(!g.ptrEqual(NULL) && !n.ptrEqual(NULL), fortTkSupport::Diagnostics::UnexpectedInput); 00350 DOMElement* elem = n->GetElem(); 00351 const XMLCh* nmX = elem->getAttribute(XAIFStrings.attr_name_x()); 00352 XercesStrX nm = XercesStrX(nmX); 00353 WN* wn = xlate_ExprOpUsingIntrinsicTable(fortTkSupport::IntrinsicXlationTable::XAIFBoolOp, 00354 nm.c_str(), 00355 NULL, 00356 g, 00357 n, 00358 ctxt); 00359 return wn; 00360 } 00361 00362 struct XAIFEdgePositionCompare { 00363 // return true if e1 < e2; false otherwise 00364 bool operator()(const OA::OA_ptr<MyDGEdge> e1, 00365 const OA::OA_ptr<MyDGEdge> e2) const { 00366 unsigned int pos1 = GetPositionAttr(e1->GetElem()); 00367 unsigned int pos2 = GetPositionAttr(e2->GetElem()); 00368 return (pos1 < pos2); 00369 } 00370 }; 00371 00372 bool conversionToReal(fortTkSupport::IntrinsicXlationTable::WHIRLInfo& info) { 00373 if (info.opr==OPR_CALL) { 00374 const std::string oprName(info.name); 00375 if ( 00376 oprName.compare("REAL")==0 00377 || 00378 oprName.compare("DBLE")==0 00379 || 00380 oprName.compare("FLOAT")==0 00381 || 00382 oprName.compare("AIMAG")==0 00383 ) 00384 return true; 00385 } 00386 return false; 00387 } 00388 00389 WN* XlateExpression::xlate_ExprOpUsingIntrinsicTable(const fortTkSupport::IntrinsicXlationTable::XAIFOpr xopr, 00390 const char* xoprNm, 00391 const char* xIntrinKey, 00392 OA::OA_ptr<OA::DGraph::DGraphImplement> g, 00393 OA::OA_ptr<MyDGNode> n, 00394 PUXlationContext& ctxt) { 00395 using namespace OA::DGraph; 00396 fortTkSupport::IntrinsicXlationTable::WHIRLInfo* aWhirlInfo_p = 00397 IntrinsicTable.findWHIRLInfo(xopr, xoprNm, xIntrinKey); 00398 // 1. Gather the operands, sorted by the "position" attribute 00399 unsigned int actualArgCount(n->num_incoming()); 00400 FORTTK_ASSERT_WARN(actualArgCount<= aWhirlInfo_p->numop && actualArgCount>= aWhirlInfo_p->numop-aWhirlInfo_p->numOptional, 00401 "Warning: get " << actualArgCount<< " intrinsic arguments for '" 00402 << xoprNm << "' expect " << aWhirlInfo_p->numop << " (have " << aWhirlInfo_p->numOptional << " optional args?)"); 00403 OA::OA_ptr<MyDGEdge> tmp; tmp = NULL; 00404 vector<OA::OA_ptr<MyDGEdge> > opnd_edge(actualArgCount, tmp); 00405 OA::OA_ptr<EdgesIteratorInterface> itPtr 00406 = n->getIncomingEdgesIterator(); 00407 for (int i = 0; itPtr->isValid(); ++(*itPtr), ++i) { 00408 OA::OA_ptr<OA::DGraph::EdgeInterface> etmp = itPtr->current(); 00409 opnd_edge[i] = etmp.convert<MyDGEdge>(); 00410 } 00411 std::sort(opnd_edge.begin(), opnd_edge.end(),XAIFEdgePositionCompare()); // ascending 00412 // 2. Translate each operand into a WHIRL expression tree 00413 vector<WN*> opnd_wn(actualArgCount, NULL); 00414 for (unsigned i = 0; i < actualArgCount; ++i) { 00415 OA::OA_ptr<NodeInterface> ntmp = opnd_edge[i]->getSource(); 00416 OA::OA_ptr<MyDGNode> opnd = ntmp.convert<MyDGNode>(); 00417 opnd_wn[i] = xlate_Expression(g, opnd, ctxt); 00418 } 00419 if (aWhirlInfo_p->opr==OPR_CALL 00420 && 00421 (aWhirlInfo_p->name && strcmp(aWhirlInfo_p->name,"TRANSFER")==0 00422 || 00423 aWhirlInfo_p->name && strcmp(aWhirlInfo_p->name,"ASSOCIATED")==0 00424 || 00425 aWhirlInfo_p->name && strcmp(aWhirlInfo_p->name,"SIZE")==0)) { 00426 // leave transfer arguments untouched 00427 // std::cout << "XlateExpression::xlate_ExprOpUsingIntrinsicTable: skipping argument conversion for transfer" << std::endl; 00428 } 00429 else { 00430 // Here promote all arguments up to 8 bytes; we assume canonicalized 00431 // argument forms 00432 // FIXME: for now we promote reals to 8; demote ints to 4; we could 00433 // selectively do this... 00434 for (unsigned i = 0; i < opnd_wn.size(); ++i) { 00435 if (WN_operator(opnd_wn[i])==OPR_CALL 00436 && 00437 (strcmp(ST_name(WN_st(opnd_wn[i])),"TRANSFER")==0 00438 || 00439 strcmp(ST_name(WN_st(opnd_wn[i])),"ASSOCIATED")==0 00440 || 00441 strcmp(ST_name(WN_st(opnd_wn[i])),"SIZE")==0)) { 00442 // leave transfer result untouched 00443 // std::cout << "XlateExpression::xlate_ExprOpUsingIntrinsicTable: skipping result conversion for transfer" << std::endl; 00444 } 00445 else { 00446 // FIXME: could use rtype for operator 00447 TY_IDX ty = WN_Tree_Type(opnd_wn[i]); 00448 TYPE_ID rty = TY_mtype(ty); 00449 // Pointers and character strings often look like integers to the 00450 // test below 00451 if (TY_Is_Pointer(ty) || TY_Is_Character_String(ty)) { continue; } 00452 TYPE_ID newrty = MTYPE_UNKNOWN; 00453 if (MTYPE_is_integral(rty)) { 00454 newrty = getMType(MTYPE_CLASS_INTEGER, 4); 00455 } 00456 else if (MTYPE_is_float(rty)) { 00457 newrty = getMType(MTYPE_CLASS_FLOAT, 8); 00458 } 00459 // WN_set_rtype(opnd_wn[i], newrty); 00460 if (newrty != MTYPE_UNKNOWN 00461 && 00462 newrty != rty 00463 && 00464 ! conversionToReal(*aWhirlInfo_p)) { 00465 opnd_wn[i] = WN_Cvt(rty, newrty, opnd_wn[i]); 00466 } 00467 } 00468 } 00469 } 00470 // 3. Translate into either WHIRL OPR_CALL or a WHIRL expression operator 00471 WN* wn = NULL; 00472 switch (aWhirlInfo_p->oprcl) { 00473 case fortTkSupport::IntrinsicXlationTable::WNCall: { 00474 TYPE_ID rtype = MTYPE_F8; // FIXME 00475 wn = CreateCallToIntrin(rtype, aWhirlInfo_p->name, opnd_wn); 00476 break; 00477 } 00478 case fortTkSupport::IntrinsicXlationTable::WNIntrinCall: 00479 case fortTkSupport::IntrinsicXlationTable::WNIntrinOp: { 00480 TYPE_ID rtype = MTYPE_F8; // FIXME 00481 TYPE_ID dtype = MTYPE_V; // FIXME 00482 INTRINSIC intrn = getWNIntrinsic(aWhirlInfo_p->name, opnd_wn, NULL); 00483 wn = CreateIntrinsicCall(aWhirlInfo_p->opr, intrn, rtype, dtype, opnd_wn); 00484 break; 00485 } 00486 case fortTkSupport::IntrinsicXlationTable::WNExpr: { 00487 // Find the opcode for the expression 00488 OPCODE opc = getWNExprOpcode(aWhirlInfo_p->opr, opnd_wn); 00489 // Create a WHIRL expression tree for the operator and operands 00490 switch (actualArgCount) { 00491 case 1: // unary 00492 wn = WN_CreateExp1(opc, opnd_wn[0]); break; 00493 case 2: // binary 00494 wn = WN_CreateExp2(opc, opnd_wn[0], opnd_wn[1]); break; 00495 case 3: // ternary 00496 wn = WN_CreateExp3(opc, opnd_wn[0], opnd_wn[1], opnd_wn[2]); break; 00497 default: 00498 FORTTK_DIE("Incorrect number of operands for WHIRL expr: " << actualArgCount); 00499 } 00500 break; 00501 } 00502 default: 00503 FORTTK_DIE("Invalid WNOprClass class: " << aWhirlInfo_p->oprcl); 00504 } 00505 return wn; 00506 } 00507 00508 // helper operator 00509 struct replaceIfLocal { 00510 public: 00511 ST** mySt; 00512 ST* myStCB; 00513 ST_IDX myOwnPUIdx; 00514 replaceIfLocal(ST** st, 00515 ST* stCB, 00516 ST_IDX myPUIdx): 00517 mySt(st), 00518 myStCB(stCB), 00519 myOwnPUIdx(myPUIdx) { 00520 } 00521 void operator()(UINT32, ST* st) const { 00522 if (ST_sclass(st)==SCLASS_COMMON 00523 && 00524 ST_sclass(ST_base(st))==SCLASS_COMMON 00525 && 00526 myOwnPUIdx==ST_st_idx(ST_base(ST_base(st))) 00527 && 00528 strcmp(ST_name(ST_base(st)),ST_name(myStCB))==0 00529 && 00530 strcmp(ST_name(st),ST_name(*mySt))==0) 00531 *mySt=st; 00532 } 00533 }; 00534 00535 WN* XlateExpression::xlate_SymbolReference(const DOMElement* elem, 00536 PUXlationContext& ctxt) { 00537 typedef std::map<ST_IDX,std::set<ST*> > PuIdxToSTPSetMap; 00538 // this map is supposed to retain a representer common block (associated with another PU) 00539 // for references to common block variables that did not exist in the original PU 00540 static PuIdxToSTPSetMap globPUtoCBMap; 00541 FORTTK_ASSERT(elem, fortTkSupport::Diagnostics::UnexpectedInput); 00542 // ------------------------------------------------------- 00543 // 0. Setup; Possibly redirect processing 00544 // ------------------------------------------------------- 00545 WN* wn = NULL; 00546 fortTkSupport::Symbol* sym = GetSymbol(elem, ctxt); 00547 if (sym->IsActive()) { 00548 ctxt.currentXlationContext().setFlag(XlationContext::ACTIVETYPE); // N.B. inherited up the ctxt stack 00549 } 00550 // redirect handling if access path was collapsed (includes scalarization) 00551 if (sym->IsPathCollapsed()) { 00552 WN* pathVorlage = ctxt.findWN(sym->GetPathVorlage(), true /* mustFind */); 00553 return xlate_SymbolReferenceCollapsedPath(elem, pathVorlage, ctxt); 00554 } 00555 ST* st = sym->GetST(); 00556 // see what kind of symbol this is 00557 if (ST_sclass(st)==SCLASS_COMMON) { 00558 // if it is a common block variable we need to 00559 // avoid picking up duplicate common block definitions 00560 ST* stCB=ST_base(st); 00561 if (ST_sclass(stCB)!=SCLASS_COMMON) 00562 FORTTK_DIE("Expect a common block name here"); 00563 ST* stPU=ST_base(stCB); 00564 ST_IDX otherPUIdx=ST_st_idx(stPU); 00565 ST_IDX myPUIdx=Current_PU_Info->proc_sym; 00566 // std::cout << "doing " << ST_name(stPU) << "::" << ST_name(stCB) << "::" << ST_name(st) << " while in " << ST_name(St_Table[myPUIdx]) << std::endl; 00567 if (myPUIdx!=otherPUIdx) { // not the same PU 00568 // see if there is already a local equivalent to the common block variable 00569 // used in the other PU. 00570 ST* givenST_p=st; 00571 For_all(St_Table,GLOBAL_SYMTAB,replaceIfLocal(&st,stCB,myPUIdx)); 00572 // std::cout << "tried for local CB: " << ST_name(ST_base(ST_base(st))) << "::" << ST_name(ST_base(st)) << "::" << ST_name(st) << " while in " << ST_name(St_Table[myPUIdx]) << std::endl; 00573 // if this is replaces that means we can map it to the common block variant in this PU 00574 if (st==givenST_p) { // not replaced, meaning this common block did not previously exist in this PU 00575 PuIdxToSTPSetMap::iterator it=globPUtoCBMap.find(myPUIdx); 00576 if (it==globPUtoCBMap.end()) { // we haven't seen this common block before 00577 // add it to the map and put the CB ST* into the set 00578 (globPUtoCBMap[myPUIdx]).insert(stCB); 00579 } 00580 else { 00581 std::set<ST*>& theCBset=it->second; 00582 std::set<ST*>::iterator sIt; 00583 for (sIt=theCBset.begin(); 00584 sIt!=theCBset.end(); 00585 ++sIt) { 00586 if (strcmp(ST_name(*sIt),ST_name(stCB))==0) { 00587 // got the CB already in the set 00588 For_all(St_Table,GLOBAL_SYMTAB,replaceIfLocal(&st,*sIt,ST_st_idx(ST_base(*sIt)))); 00589 // std::cout << "tried for other CB: " << ST_name(ST_base(ST_base(st))) << "::" << ST_name(ST_base(st)) << "::" << ST_name(st) << " while in " << ST_name(St_Table[myPUIdx]) << std::endl; 00590 break; 00591 } 00592 } 00593 if (sIt==theCBset.end()) { 00594 // wasn't in the set, add it 00595 (globPUtoCBMap[myPUIdx]).insert(stCB); 00596 } 00597 } 00598 } 00599 } 00600 } 00601 const char* st_name = ST_name(st); 00602 TY_IDX ty = ST_type(st); 00603 TYPE_ID rty, dty; 00604 WN_OFFSET oset = 0; 00605 // ------------------------------------------------------- 00606 // 1. Determine which type of load to use 00607 // ------------------------------------------------------- 00608 bool create_lda = false; 00609 // Note: Order matters in these tests 00610 if (ST_class(st) != CLASS_PREG) { // never create a pointer to a preg 00611 if (ctxt.currentXlationContext().isFlag(XlationContext::ARRAY) 00612 || 00613 TY_Is_Chararray(ty)) { 00614 // Do not load the address of symbol that is already a pointer 00615 if (TY_kind(ty) != KIND_POINTER) { 00616 create_lda = true; 00617 } 00618 } 00619 else if (ctxt.currentXlationContext().isFlag(XlationContext::LVALUE)) { 00620 create_lda = true; 00621 } 00622 } 00623 // ------------------------------------------------------- 00624 // 2. Create the reference 00625 // ------------------------------------------------------- 00626 if (create_lda) { 00627 // OPR_LDA 00628 TY_IDX ty_ptr = Stab_Pointer_To(ty); 00629 rty = TY_mtype(ty_ptr); // Pointer_Mtype 00630 wn = WN_CreateLda(OPR_LDA, rty, MTYPE_V, oset, ty_ptr, st, 0); 00631 } 00632 else { 00633 // OPR_LDID 00634 rty = dty = TY_mtype(ty); 00635 if (TY_kind(ty) == KIND_ARRAY) { // FIXME more special cases? 00636 rty = dty = TY_mtype(TY_etype(ty)); 00637 } 00638 // FIXME: take care of small integer types 00639 if (MTYPE_byte_size(dty) < 4) { 00640 if (MTYPE_is_unsigned(dty)) { rty = Args::ourDefaultMTypeUInt; } 00641 else if (MTYPE_is_signed(dty)) { rty = Args::ourDefaultMTypeInt; } 00642 } 00643 if (ST_class(st) == CLASS_PREG) { 00644 oset = GetPregId(elem); 00645 } 00646 wn = WN_CreateLdid(OPR_LDID, rty, dty, oset, st, ty, 0); 00647 } 00648 return wn; 00649 } 00650 00651 std::pair<ST*, WN_OFFSET> XlateExpression::xlate_SymbolReferenceSimple(const DOMElement* elem, 00652 PUXlationContext& ctxt) { 00653 fortTkSupport::Symbol* sym = GetSymbol(elem, ctxt); 00654 ST* st = sym->GetST(); 00655 WN_OFFSET oset = 0; 00656 if (ST_class(st) == CLASS_PREG) { 00657 oset = GetPregId(elem); 00658 } 00659 return make_pair(st, oset); 00660 } 00661 00662 WN* XlateExpression::xlate_SymbolReferenceCollapsedPath(const DOMElement* elem, 00663 WN* pathVorlageWN, 00664 PUXlationContext& ctxt) { 00665 OPERATOR opr = WN_operator(pathVorlageWN); 00666 bool create_lda = (ctxt.currentXlationContext().isFlag(XlationContext::LVALUE)); // FIXME 00667 WN* wn = NULL; 00668 switch (opr) { 00669 case OPR_STID: 00670 case OPR_STBITS: { 00671 // Create an LDID 00672 TY_IDX ty_idx = WN_GetRefObjType(pathVorlageWN); 00673 TYPE_ID rty = TY_mtype(ty_idx); // OPCODE_rtype(WN_opcode()) 00674 TYPE_ID dty = TY_mtype(ty_idx); // OPCODE_dtype(WN_opcode()) 00675 ST* st = WN_st(pathVorlageWN); 00676 WN_OFFSET ofst = WN_offset(pathVorlageWN); 00677 UINT fid = WN_field_id(pathVorlageWN); 00678 #if 0 // FIXME 00679 if (!TY_Is_Pointer(ty_idx)) { 00680 ty_idx = Stab_Pointer_To(ty_idx); 00681 } 00682 TYPE_ID rty = TY_mtype(ty_idx); 00683 wn = WN_CreateLda(OPR_LDA, rty, MTYPE_V, ofst, ty_idx, st, fid); 00684 #endif 00685 wn = WN_CreateLdid(OPR_LDID, rty, dty, ofst, st, ty_idx, fid); 00686 break; 00687 } 00688 case OPR_ISTORE: 00689 case OPR_ISTBITS: { 00690 // Create an ILOAD (copy ISTORE.kid1 to ILOAD.kid0) 00691 WN* addr = WN_COPY_Tree(WN_kid1(pathVorlageWN)); 00692 TY_IDX refty = WN_GetRefObjType(pathVorlageWN); 00693 TY_IDX ptrty = WN_ty(pathVorlageWN); 00694 TYPE_ID mty = TY_mtype(refty); 00695 WN_OFFSET ofst = WN_offset(pathVorlageWN); 00696 if (OPERATOR_has_offset(WN_operator(addr))) { 00697 ofst += WN_offset(addr); // ISTORE.offset + ISTORE.kid1.offset 00698 } 00699 UINT fid = WN_field_id(pathVorlageWN); 00700 wn = WN_CreateIload(OPR_ILOAD, mty, mty, ofst, refty, ptrty, addr, fid); 00701 break; 00702 } 00703 case OPR_LDA: 00704 case OPR_LDMA: 00705 case OPR_LDID: 00706 case OPR_LDBITS: 00707 case OPR_ILOAD: 00708 case OPR_ILDBITS: 00709 case OPR_STRCTFLD: 00710 wn = WN_COPY_Tree(pathVorlageWN); 00711 break; 00712 default: 00713 break; // fall through 00714 } // switch 00715 FORTTK_ASSERT(wn, fortTkSupport::Diagnostics::Unimplemented << "Unable to recreate collapsed scalarized path."); 00716 //if (!create_lda) { 00717 //} 00718 return wn; 00719 } 00720 00721 WN* XlateExpression::xlate_ArrayElementReference(OA::OA_ptr<OA::DGraph::DGraphImplement> g, 00722 OA::OA_ptr<MyDGNode> n, 00723 PUXlationContext& ctxt) { 00724 FORTTK_ASSERT(!g.ptrEqual(NULL) && !n.ptrEqual(NULL), fortTkSupport::Diagnostics::UnexpectedInput); 00725 DOMElement* elem = n->GetElem(); 00726 WN* arrWN = 0; 00727 // ---------------------------------------------------------------------------------- 00728 // Translate the array symbol reference so we can query the type 00729 OA::OA_ptr<MyDGNode> n1 = GetSuccessor(n, false /* succIsOutEdge */); 00730 const XMLCh* nmX = n1->GetElem()->getNodeName(); 00731 FORTTK_ASSERT(XMLString::equals(nmX, XAIFStrings.elem_SymRef_x()), 00732 "Expected " << XAIFStrings.elem_SymRef() << "; found:\n" 00733 << *(n1->GetElem())); 00734 const XMLCh* symNmX = n1->GetElem()->getAttribute(XAIFStrings.attr_symId_x()); 00735 XercesStrX symNm = XercesStrX(symNmX); 00736 ctxt.createXlationContext(XlationContext::ARRAY); 00737 WN* arraySym = xlate_VarRef(g, n1, ctxt); 00738 ctxt.deleteXlationContext(); 00739 TY_IDX ty; 00740 if (WN_operator(arraySym)==OPR_STRCTFLD) { 00741 ty=WN_GetRefObjType(arraySym); 00742 } 00743 else if (WN_kid0(arraySym) && WN_operator(WN_kid0(arraySym))==OPR_STRCTFLD ) { 00744 ty=WN_GetRefObjType(WN_kid0(arraySym)); 00745 } 00746 else{ 00747 ty = ST_type(WN_st(arraySym)); 00748 } 00749 if (TY_kind(ty) == KIND_POINTER) { 00750 ty = TY_pointed(ty); 00751 } 00752 if (TY_Is_Character_String(ty)) { 00753 // ---------------------------------------------------------------------------------- 00754 // treat character arrays separately because they have a special whirl format 00755 // there is to be one child in xaif expected to be an IndexTriplet 00756 FORTTK_ASSERT(GetChildElementCount(elem)==1,"Internal error: unexpected character array with multiple indices for >" << symNm.c_str() << "<"); 00757 unsigned int childCount = 2; // there are two whirl child nodes 00758 DOMElement* dim = GetFirstChildElement(elem); 00759 FORTTK_ASSERT(XMLString::equals(dim->getNodeName(), XAIFStrings.elem_IndexTriplet_x()), 00760 "Expected " << XAIFStrings.elem_IndexTriplet() << "; found:\n" 00761 << *dim); 00762 DOMElement* tripletElementExpr = GetFirstChildElement(dim); 00763 UINT tripletElementCounter=0; 00764 vector<WN*> triplet(3); 00765 for (; tripletElementExpr; tripletElementExpr = GetNextSiblingElement(tripletElementExpr),++tripletElementCounter) { 00766 DOMElement* firstChild=GetFirstChildElement(tripletElementExpr); 00767 if (firstChild) { 00768 ctxt.createXlationContext(XlationContext::ARRAYIDX); 00769 WN* indexExprWN = translateExpression(firstChild, ctxt); 00770 ctxt.deleteXlationContext(); 00771 const XMLCh* tripletElementnmX = tripletElementExpr->getNodeName(); 00772 if (XMLString::equals(tripletElementnmX, XAIFStrings.elem_Index_x())) 00773 triplet[0]=indexExprWN; 00774 else if (XMLString::equals(tripletElementnmX, XAIFStrings.elem_Bound_x())) 00775 triplet[1]=indexExprWN; 00776 else 00777 FORTTK_DIE("unexpected element :" << *tripletElementExpr); 00778 } 00779 } 00780 FORTTK_ASSERT(tripletElementCounter==2,"Internal error: character array has to have 2 triplet elements for >" << symNm.c_str() << "<"); 00781 // Create Whirl ARRAY node 00782 arrWN = WN_Create(OPR_ARRAY, MTYPE_U8, MTYPE_V, 3); 00783 // kid 0 is the array's base address 00784 WN_kid0(arrWN) = arraySym; 00785 WN_kid(arrWN, 1)=triplet[1]; 00786 WN_kid(arrWN, 2)=triplet[0]; 00787 } 00788 else { // is not a character array 00789 // ---------------------------------------------------------------------------------- 00790 // Translate the index expression for each dimension 00791 unsigned int rank = GetChildElementCount(elem); 00792 vector<WN*> indices(rank,(WN*)0); 00793 DOMElement* dim = GetFirstChildElement(elem); 00794 for (int i = 0; dim; dim = GetNextSiblingElement(dim), ++i) { 00795 const XMLCh* nmX = dim->getNodeName(); 00796 FORTTK_ASSERT(XMLString::equals(nmX, XAIFStrings.elem_IndexTriplet_x()), 00797 "Expected " << XAIFStrings.elem_IndexTriplet() << "; found:\n" 00798 << *dim); 00799 DOMElement* tripletElementExpr = GetFirstChildElement(dim); 00800 UINT tripletElementCounter=0; 00801 vector<WN*> triplet(3,(WN*)0); 00802 for (; tripletElementExpr; tripletElementExpr = GetNextSiblingElement(tripletElementExpr),++tripletElementCounter) { 00803 DOMElement* firstChild=GetFirstChildElement(tripletElementExpr); 00804 if (firstChild) { 00805 ctxt.createXlationContext(XlationContext::ARRAYIDX); 00806 WN* indexExprWN = translateExpression(firstChild, ctxt); 00807 ctxt.deleteXlationContext(); 00808 const XMLCh* tripletElementnmX = tripletElementExpr->getNodeName(); 00809 if (XMLString::equals(tripletElementnmX, XAIFStrings.elem_Index_x())) 00810 triplet[0]=indexExprWN; 00811 else if (XMLString::equals(tripletElementnmX, XAIFStrings.elem_Bound_x())) 00812 triplet[1]=indexExprWN; 00813 else if (XMLString::equals(tripletElementnmX, XAIFStrings.elem_Stride_x())) 00814 triplet[2]=indexExprWN; 00815 else 00816 FORTTK_DIE("unexpected element :" << *tripletElementExpr); 00817 } 00818 } 00819 if (tripletElementCounter==1 && triplet[0]) 00820 indices[i] = WN_Type_Conversion(triplet[0],MTYPE_I4); 00821 else { 00822 WN* theSrcTriplet_p=WN_Create(OPR_SRCTRIPLET, 00823 MTYPE_I8, 00824 MTYPE_V, 00825 3); 00826 for (int j=0; j<3; ++j) { 00827 if (triplet[j]!=0) { 00828 WN_kid(theSrcTriplet_p,j)=WN_Type_Conversion(triplet[j],MTYPE_I4); 00829 } 00830 else { 00831 if (j!=2) 00832 WN_kid(theSrcTriplet_p,j)=WN_Create(OPR_IMPLICIT_BND, 00833 MTYPE_V, 00834 MTYPE_V, 00835 0); 00836 else // the last one (stride) should default to 1 00837 WN_kid(theSrcTriplet_p,j)=WN_CreateIntconst(OPC_I4INTCONST, 1); 00838 } 00839 } 00840 indices[i] = theSrcTriplet_p; 00841 } 00842 } 00843 FORTTK_ASSERT(TY_AR_ndims(ty) == (INT32)rank, 00844 "Internal error: mismatched array dimensions"); 00845 // ------------------------------------------------------- 00846 // Create Whirl ARRAY node (cf. wn_fio.cxx:1.3:7055) 00847 UINT nkids = (rank * 2) + 1; // 2n + 1 where (where n == rank) 00848 arrWN = WN_Create(OPR_ARRAY, MTYPE_U8, MTYPE_V, nkids); 00849 // kid 0 is the array's base address 00850 WN_kid0(arrWN) = arraySym; 00851 // kids 1 to n give size of each dimension. We use a bogus value, 00852 // since we need to support only translation back to source code. 00853 for (unsigned i = 1; i <= rank; ++i) { 00854 WN_kid(arrWN, i) = WN_CreateIntconst(OPC_I4INTCONST, 0); 00855 } 00856 // kids n + 1 to 2n give index expressions for each dimension. 00857 // N.B. Reverse the order of index expressions since we are 00858 // translating Fortran. FIXME: should we change whirl2xaif and this 00859 // to not reverse the indices? 00860 for (unsigned i = 2*rank, j = 0; i >= (rank + 1); --i, ++j) { 00861 WN_kid(arrWN, i) = indices[j]; 00862 } 00863 // ------------------------------------------------------- 00864 // Wrap the ARRAY in an ILOAD 00865 TY_IDX ety = TY_etype(ty); 00866 TYPE_ID emty = TY_mtype(ety); 00867 TY_IDX eptrty = Stab_Pointer_To(ety); 00868 if (emty==0 && TY_Is_Chararray(ty)) { 00869 emty=MTYPE_U4; 00870 } 00871 arrWN=WN_CreateIload(OPR_ILOAD, emty, emty, 0, ety, eptrty, arrWN, 0); 00872 } 00873 return arrWN; 00874 } 00875 00876 OA::OA_ptr<OA::DGraph::DGraphImplement> XlateExpression::createExpressionGraph(const DOMElement* elem, 00877 bool varRef) { 00878 using namespace OA::DGraph; 00879 MyDGNode::resetIds(); 00880 OA::OA_ptr<DGraphImplement> g; g = new DGraphImplement(); 00881 VertexIdToMyDGNodeMap m; 00882 // Setup variables 00883 XMLCh* edgeStr = NULL; 00884 if (varRef) { 00885 edgeStr = XAIFStrings.elem_VarRefEdge_x(); 00886 } else { 00887 edgeStr = XAIFStrings.elem_ExprEdge_x(); 00888 } 00889 // ------------------------------------------------------- 00890 // Create the graph (only examine element nodes) 00891 // ------------------------------------------------------- 00892 DOMElement* e = const_cast<DOMElement*>(elem); 00893 do { 00894 const XMLCh* name = e->getNodeName(); 00895 if (XMLString::equals(name, edgeStr)) { 00896 // Add an edge to the graph. N.B.: we ignore the 'position' 00897 // attribute during creation of the graph. 00898 // Find src and target (sink) nodes. 00899 const XMLCh* srcX = e->getAttribute(XAIFStrings.attr_source_x()); 00900 const XMLCh* targX = e->getAttribute(XAIFStrings.attr_target_x()); 00901 XercesStrX src = XercesStrX(srcX); 00902 XercesStrX targ = XercesStrX(targX); 00903 OA::OA_ptr<MyDGNode> gn1 = m[std::string(src.c_str())]; // source 00904 OA::OA_ptr<MyDGNode> gn2 = m[std::string(targ.c_str())]; // target 00905 FORTTK_ASSERT(!gn1.ptrEqual(NULL) && !gn2.ptrEqual(NULL), "Invalid edge in expression graph:\n" << *e); 00906 OA::OA_ptr<MyDGEdge> ge; ge = new MyDGEdge(gn1, gn2, e); // src, targ 00907 g->addEdge(ge); 00908 } 00909 else { 00910 // Add a vertex to the graph 00911 const XMLCh* vidX = e->getAttribute(XAIFStrings.attr_Vid_x()); 00912 XercesStrX vid = XercesStrX(vidX); 00913 FORTTK_ASSERT(strlen(vid.c_str()) > 0, 00914 "Invalid vertex in expression graph:\n" << *e); 00915 OA::OA_ptr<MyDGNode> gn; gn = new MyDGNode(e); 00916 g->addNode(gn); 00917 m[std::string(vid.c_str())] = gn; 00918 } 00919 } while ( (e = GetNextSiblingElement(e)) ); 00920 return g; 00921 } 00922 00923 WN* XlateExpression::createValueSelector(WN* wn) { 00924 TYPE_ID rty = getRType(wn); 00925 WN* callWN = CreateCallToIntrin(rty, "__value__", 1); 00926 WN_actual(callWN, 0) = CreateParm(wn, WN_PARM_BY_VALUE); 00927 return callWN; 00928 } 00929 00930 WN* XlateExpression::createDerivSelector(WN* wn) { 00931 TYPE_ID rty = getRType(wn); 00932 WN* callWN = CreateCallToIntrin(rty, "__deriv__", 1); 00933 WN_actual(callWN, 0) = CreateParm(wn, WN_PARM_BY_VALUE); 00934 return callWN; 00935 } 00936 00937 TYPE_ID XlateExpression::getRType(WN* wn) { 00938 TY_IDX ty_idx = WN_Tree_Type(wn); 00939 TYPE_ID rty = MTYPE_UNKNOWN; 00940 if (TY_kind(ty_idx) == KIND_POINTER) { 00941 ty_idx=TY_pointed(ty_idx); 00942 } 00943 if (TY_kind(ty_idx) == KIND_ARRAY) { 00944 rty=TY_mtype(TY_etype(ty_idx)); 00945 } 00946 else if (TY_kind(ty_idx) == KIND_STRUCT) { 00947 rty = MTYPE_M; 00948 } else { 00949 rty = TY_mtype(ty_idx); 00950 } 00951 // FIXME: pointer types 00952 FORTTK_ASSERT(rty != MTYPE_UNKNOWN, "Error finding rtype of WN expr"); 00953 return rty; 00954 } 00955 00956 TYPE_ID XlateExpression::getRTypeFromOpands(vector<WN*>& opands) { 00957 int opands_num = opands.size(); 00958 FORTTK_ASSERT(opands_num > 0, fortTkSupport::Diagnostics::UnexpectedInput); 00959 // 1. Gather types for operands 00960 vector<TY_IDX> opands_ty(opands_num); 00961 vector<TYPE_ID> opands_mty(opands_num); 00962 for (int i = 0; i < opands_num; ++i) { 00963 TY_IDX ty = WN_Tree_Type(opands[i]); 00964 opands_ty[i] = ty; 00965 if (TY_kind(ty) == KIND_ARRAY) 00966 opands_mty[i] = TY_mtype(TY_etype(ty)); 00967 else if (TY_kind(ty) == KIND_POINTER) 00968 opands_mty[i] = TY_mtype(TY_pointed(ty)); 00969 else 00970 opands_mty[i] = TY_mtype(ty); 00971 } 00972 // 2. Find an appropriate mtype for operands 00973 TYPE_ID mty = opands_mty[0]; 00974 for (int i = 1; i < opands_num; ++i) { 00975 mty = getRTypeFromOpands(mty, opands_mty[i]); 00976 } 00977 return mty; 00978 } 00979 00980 TYPE_ID XlateExpression::getRTypeFromOpands(TYPE_ID ty1, TYPE_ID ty2) { 00981 // ------------------------------------------------------- 00982 // 1. If both types are same, the answer is easy 00983 // ------------------------------------------------------- 00984 if (ty1 == ty2) { 00985 return ty1; 00986 } 00987 // ------------------------------------------------------- 00988 // 2. We have different types. 00989 // ------------------------------------------------------- 00990 // 2a. If we have different, but compatible classes --> class promotion 00991 unsigned int cl1 = MTYPE_type_class(ty1); 00992 unsigned int cl2 = MTYPE_type_class(ty2); 00993 unsigned int cl = 0; // the new class 00994 if (cl1 == cl2) { 00995 cl = cl1; 00996 } 00997 // (u)int, float --> float 00998 if ( ((cl1 == MTYPE_CLASS_INTEGER || cl1 == MTYPE_CLASS_UNSIGNED_INTEGER) 00999 && (cl2 == MTYPE_CLASS_FLOAT)) 01000 || 01001 ((cl2 == MTYPE_CLASS_INTEGER || cl2 == MTYPE_CLASS_UNSIGNED_INTEGER) 01002 && (cl1 == MTYPE_CLASS_FLOAT)) ) { 01003 cl = MTYPE_CLASS_FLOAT; 01004 } 01005 // int, uint --> [error] 01006 // !complex_float, complex_float --> [error] 01007 // !str, str --> [error] 01008 if (cl == 0) { 01009 return ty1; // FIXME: what to do here? 01010 } 01011 // 2b. If we have different sizes --> size promotion (choose larger) 01012 unsigned int sz1 = MTYPE_byte_size(ty1); 01013 unsigned int sz2 = MTYPE_byte_size(ty2); 01014 unsigned int sz = MAX(sz1, sz2); // the new size 01015 // 2c. Combine class and size information. 01016 TYPE_ID ty = getMType(cl, sz); 01017 return ty; 01018 } 01019 01020 TYPE_ID XlateExpression::getMType(unsigned int cl, unsigned int bytesz) { 01021 TYPE_ID ty = MTYPE_UNKNOWN; 01022 for (TYPE_ID i = MTYPE_FIRST; i <= MTYPE_LAST; ++i) { 01023 if ((MTYPE_type_class(i) == cl) && (MTYPE_byte_size(i) == bytesz)) { 01024 ty = i; 01025 break; 01026 } 01027 } 01028 return ty; 01029 } 01030 01031 OPCODE XlateExpression::getWNExprOpcode(OPERATOR opr, vector<WN*>& opands) { 01032 // 1. Find mtype suggested from operands 01033 TYPE_ID mty = getRTypeFromOpands(opands); 01034 // 2. Find a dtype (operator dependent) FIXME/FIXME 01035 TYPE_ID dty = MTYPE_V; // typical dtype for intrinsics 01036 if (opr == OPR_TRUNC || 01037 opr == OPR_EQ || opr == OPR_NE || opr == OPR_GT || opr == OPR_GE || 01038 opr == OPR_LT || opr == OPR_LE) { 01039 dty = mty; 01040 } 01041 // 3. Find a rtype (operator dependent) 01042 // FIXME: we need a better way; do we need a cvt? FIXME 01043 // Is_Valid_Opcode, Is_Valid_Opcode_Parts 01044 TYPE_ID rty = mty; 01045 if (opr == OPR_SQRT && MTYPE_is_integral(rty)) { 01046 // sqrt: f, z 01047 rty = getMType(MTYPE_CLASS_FLOAT, MTYPE_byte_size(rty)); 01048 } 01049 else if (opr == OPR_TRUNC || opr == OPR_MOD || opr == OPR_REM) { 01050 // trunc, mod, rem: i 01051 rty = getMType(MTYPE_CLASS_INTEGER, MTYPE_byte_size(rty)); 01052 } 01053 else if (opr == OPR_EQ || opr == OPR_NE || opr == OPR_GT || opr == OPR_GE || 01054 opr == OPR_LT || opr == OPR_LE || opr == OPR_LNOT ) { 01055 rty = getMType(MTYPE_CLASS_INTEGER, 4); 01056 } 01057 else if (opr == OPR_COMPLEX ) { 01058 rty = getMType(MTYPE_CLASS_COMPLEX_FLOAT,MTYPE_byte_size(mty)); 01059 } 01060 OPCODE opc = OPCODE_make_op(opr, rty, dty); 01061 return opc; 01062 } 01063 01064 INTRINSIC XlateExpression::getWNIntrinsic(const char* intrnNm, vector<WN*>& opands, TYPE_ID* dtype) { 01065 // 1. Find dtype suggested from operands 01066 TYPE_ID mty = getRTypeFromOpands(opands); 01067 // per Nathan the situation is that there is 01068 // a method to translate the whirl intrinsic enumerations 01069 // into a name but whirl doesn't have a function to 01070 // translate the name back for all of the intrinsic names 01071 // because often the intrinsic name known in 01072 // get_intrinsic_from_name 01073 // includes the machine type 01074 // Because we don't include the machine type 01075 // we hardcode the intrinsic here for the following cases. 01076 INTRINSIC intrn = INTRINSIC_INVALID; 01077 if (strcmp(intrnNm, "EXPEXPR") == 0) { 01078 intrn = INTRN_F8EXPEXPR; 01079 if (dtype) { *dtype = MTYPE_F8; } 01080 } 01081 else if (strcmp(intrnNm, "AMOD") == 0) { 01082 intrn = INTRN_F4MOD; 01083 if (dtype) { *dtype = MTYPE_F4; } 01084 } 01085 else if (strcmp(intrnNm, "DMOD") == 0) { 01086 intrn = INTRN_F4MOD; 01087 if (dtype) { *dtype = MTYPE_F8; } 01088 } 01089 else if (strcmp(intrnNm, "LEN") == 0) { 01090 intrn = INTRN_I4CLEN; 01091 if (dtype) { *dtype = MTYPE_I4; } 01092 } 01093 else { 01094 intrn=get_intrinsic_from_name(intrnNm); 01095 } 01096 FORTTK_ASSERT(intrn != INTRINSIC_INVALID, 01097 "Unknown intrinsic '" << intrnNm << "'"); 01098 return intrn; 01099 } 01100 }
1.7.6.1 
