|
OpenADFortTk (basic)
|
|
OpenADFortTk (basic)
|
00001 #include "IntrinsicInfo.h" 00002 #include "IFDiagnostics.h" 00003 #include "wn_attr.h" 00004 00005 IntrinsicInfo::IntrinsicMap IntrinsicInfo::ourIntrinsicInfoMap; 00006 bool IntrinsicInfo::ourInitFlag=false; 00007 00008 const IntrinsicInfo::IntrinsicMap& IntrinsicInfo::getMap() { 00009 if (!ourInitFlag) { 00010 // Common mathematical functions 00011 ourIntrinsicInfoMap[Key( OPR_NEG, NULL) ]=Info(false,1,FLOAT_INTR); 00012 ourIntrinsicInfoMap[Key( OPR_ADD, NULL) ]=Info(false,2,FLOAT_INTR); 00013 ourIntrinsicInfoMap[Key( OPR_SUB, NULL) ]=Info(false,2,FLOAT_INTR); 00014 ourIntrinsicInfoMap[Key( OPR_MPY, NULL) ]=Info(false,2,FLOAT_INTR); 00015 ourIntrinsicInfoMap[Key( OPR_DIV, NULL) ]=Info(false,2,FLOAT_INTR); 00016 ourIntrinsicInfoMap[Key( OPR_CALL, "SQRT") ]=Info(false,1,FLOAT_INTR); 00017 ourIntrinsicInfoMap[Key( OPR_CALL, "DSQRT") ]=Info(false,1,FLOAT_INTR); 00018 ourIntrinsicInfoMap[Key( OPR_SQRT, NULL) ]=Info(false,1,FLOAT_INTR); 00019 ourIntrinsicInfoMap[Key( OPR_CALL, "SUM") ]=Info(false,1,ARRAY_INTR); 00020 // modulo/remainder 00021 ourIntrinsicInfoMap[Key( OPR_MOD, NULL) ]=Info(false,2,FLOAT_INTR); 00022 ourIntrinsicInfoMap[Key( OPR_CALL, "MODULO") ]=Info(false,2,FLOAT_INTR); 00023 ourIntrinsicInfoMap[Key( OPR_REM, NULL) ]=Info(false,2,FLOAT_INTR); 00024 ourIntrinsicInfoMap[Key( OPR_INTRINSIC_OP, "AMOD") ]=Info(false,2,FLOAT_INTR); 00025 ourIntrinsicInfoMap[Key( OPR_INTRINSIC_OP, "DMOD") ]=Info(false,2,FLOAT_INTR); 00026 ourIntrinsicInfoMap[Key( OPR_CALL, "MOD") ]=Info(false,2,FLOAT_INTR); 00027 // trigonometric 00028 ourIntrinsicInfoMap[Key( OPR_CALL, "SIN") ]=Info(false,1,FLOAT_INTR); 00029 ourIntrinsicInfoMap[Key( OPR_CALL, "DSIN") ]=Info(false,1,FLOAT_INTR); 00030 ourIntrinsicInfoMap[Key( OPR_CALL, "COS") ]=Info(false,1,FLOAT_INTR); 00031 ourIntrinsicInfoMap[Key( OPR_CALL, "DCOS") ]=Info(false,1,FLOAT_INTR); 00032 ourIntrinsicInfoMap[Key( OPR_CALL, "TAN") ]=Info(false,1,FLOAT_INTR); 00033 ourIntrinsicInfoMap[Key( OPR_CALL, "DTAN") ]=Info(false,1,FLOAT_INTR); 00034 ourIntrinsicInfoMap[Key( OPR_CALL, "ASIN") ]=Info(false,1,FLOAT_INTR); 00035 ourIntrinsicInfoMap[Key( OPR_CALL, "ACOS") ]=Info(false,1,FLOAT_INTR); 00036 ourIntrinsicInfoMap[Key( OPR_CALL, "ATAN") ]=Info(false,1,FLOAT_INTR); 00037 ourIntrinsicInfoMap[Key( OPR_CALL, "SINH") ]=Info(false,1,FLOAT_INTR); 00038 ourIntrinsicInfoMap[Key( OPR_CALL, "DSINH") ]=Info(false,1,FLOAT_INTR); 00039 ourIntrinsicInfoMap[Key( OPR_CALL, "COSH") ]=Info(false,1,FLOAT_INTR); 00040 ourIntrinsicInfoMap[Key( OPR_CALL, "DCOSH") ]=Info(false,1,FLOAT_INTR); 00041 ourIntrinsicInfoMap[Key( OPR_CALL, "TANH") ]=Info(false,1,FLOAT_INTR); 00042 ourIntrinsicInfoMap[Key( OPR_CALL, "DTANH") ]=Info(false,1,FLOAT_INTR); 00043 // exp/log 00044 ourIntrinsicInfoMap[Key( OPR_CALL, "EXP") ]=Info(false,1,FLOAT_INTR); 00045 ourIntrinsicInfoMap[Key( OPR_CALL, "DEXP") ]=Info(false,1,FLOAT_INTR); 00046 ourIntrinsicInfoMap[Key( OPR_CALL, "LOG") ]=Info(false,1,FLOAT_INTR); 00047 ourIntrinsicInfoMap[Key( OPR_CALL, "DLOG") ]=Info(false,1,FLOAT_INTR); 00048 ourIntrinsicInfoMap[Key( OPR_CALL, "ALOG") ]=Info(false,1,FLOAT_INTR); 00049 ourIntrinsicInfoMap[Key( OPR_CALL, "LOG10") ]=Info(false,1,FLOAT_INTR); 00050 ourIntrinsicInfoMap[Key( OPR_INTRINSIC_OP, "EXPEXPR") ]=Info(false,2,FLOAT_INTR); 00051 // string ops 00052 ourIntrinsicInfoMap[Key( OPR_INTRINSIC_OP, "CEQEXPR") ]=Info(false,2,STRING_INTR); 00053 ourIntrinsicInfoMap[Key( OPR_INTRINSIC_OP, "CNEEXPR") ]=Info(false,2,STRING_INTR); 00054 ourIntrinsicInfoMap[Key( OPR_INTRINSIC_OP, "CGEEXPR") ]=Info(false,2,STRING_INTR); 00055 ourIntrinsicInfoMap[Key( OPR_INTRINSIC_OP, "CGTEXPR") ]=Info(false,2,STRING_INTR); 00056 ourIntrinsicInfoMap[Key( OPR_INTRINSIC_OP, "CLEEXPR") ]=Info(false,2,STRING_INTR); 00057 ourIntrinsicInfoMap[Key( OPR_INTRINSIC_OP, "CLTEXPR") ]=Info(false,2,STRING_INTR); 00058 ourIntrinsicInfoMap[Key( OPR_INTRINSIC_OP, "LEN") ]=Info(false,1,STRING_INTR); 00059 ourIntrinsicInfoMap[Key( OPR_CALL, "INDEX") ]=Info(true, 3,STRING_INTR); 00060 ourIntrinsicInfoMap[Key( OPR_CALL, "LEN") ]=Info(false,1,STRING_INTR); 00061 ourIntrinsicInfoMap[Key( OPR_CALL, "LEN_TRIM") ]=Info(false,1,STRING_INTR); 00062 ourIntrinsicInfoMap[Key( OPR_CALL, "TRIM") ]=Info(false,1,STRING_INTR); 00063 ourIntrinsicInfoMap[Key( OPR_CALL, "SCAN") ]=Info(false,2,STRING_INTR); 00064 ourIntrinsicInfoMap[Key( OPR_INTRINSIC_CALL,"CONCATEXPR") ]=Info(true, 2,STRING_INTR); 00065 ourIntrinsicInfoMap[Key( OPR_CALL, "ICHAR") ]=Info(false,1,STRING_INTR); 00066 00067 // string assignment 00068 // String Assigment is Treated as a special case of Intrinsic functions. 00069 // We assume that Intrinsic Functions has no side Effects whereas 00070 // CASSIGNSTMT has side effects. Therefore, we expect its behaviuor to be similar 00071 // to the AssignPair sattement. Therefore, Removed from list of Intrinsics. 00072 //ourIntrinsicInfoMap[Key( OPR_INTRINSIC_CALL,"CASSIGNSTMT")]=Info(false,1,STRING_INTR); 00073 00074 // rounding and conversion 00075 ourIntrinsicInfoMap[Key( OPR_ABS, NULL) ]=Info(false,1,FLOAT_INTR); 00076 ourIntrinsicInfoMap[Key( OPR_CALL, "ABS") ]=Info(false,1,FLOAT_INTR); 00077 ourIntrinsicInfoMap[Key( OPR_CALL, "DABS") ]=Info(false,1,FLOAT_INTR); 00078 ourIntrinsicInfoMap[Key( OPR_CALL, "IABS") ]=Info(false,1,INTEGER_INTR); 00079 ourIntrinsicInfoMap[Key( OPR_CALL, "SIGN") ]=Info(false,2,FLOAT_INTR); 00080 ourIntrinsicInfoMap[Key( OPR_CALL, "DSIGN") ]=Info(false,2,FLOAT_INTR); 00081 ourIntrinsicInfoMap[Key( OPR_RND, NULL) ]=Info(false,1,FLOAT_INTR); 00082 ourIntrinsicInfoMap[Key( OPR_TRUNC, NULL) ]=Info(false,1,FLOAT_INTR); 00083 ourIntrinsicInfoMap[Key( OPR_CALL, "INT") ]=Info(false,1,FLOAT_INTR); 00084 ourIntrinsicInfoMap[Key( OPR_CALL, "NINT") ]=Info(false,1,FLOAT_INTR); 00085 ourIntrinsicInfoMap[Key( OPR_CALL, "TRANSFER") ]=Info(false,2,FLOAT_INTR); 00086 ourIntrinsicInfoMap[Key( OPR_CEIL, NULL) ]=Info(false,1,FLOAT_INTR); 00087 ourIntrinsicInfoMap[Key( OPR_FLOOR, NULL) ]=Info(false,1,FLOAT_INTR); 00088 ourIntrinsicInfoMap[Key( OPR_CALL, "REAL") ]=Info(false,1,FLOAT_INTR); 00089 ourIntrinsicInfoMap[Key( OPR_CALL, "FLOAT") ]=Info(false,1,FLOAT_INTR); 00090 ourIntrinsicInfoMap[Key( OPR_CALL, "DBLE") ]=Info(false,1,FLOAT_INTR); 00091 ourIntrinsicInfoMap[Key( OPR_CALL, "AIMAG") ]=Info(false,1,FLOAT_INTR); 00092 ourIntrinsicInfoMap[Key( OPR_CALL, "TRANSPOSE") ]=Info(false,1,ARRAY_INTR); 00093 ourIntrinsicInfoMap[Key( OPR_CALL, "RESHAPE") ]=Info(false,2,ARRAY_INTR); 00094 ourIntrinsicInfoMap[Key( OPR_COMPLEX, NULL) ]=Info(false,2,FLOAT_INTR); 00095 // logical (and bitwise logical) operations 00096 ourIntrinsicInfoMap[Key( OPR_BNOT, NULL) ]=Info(false,1,BOOL_INTR); 00097 ourIntrinsicInfoMap[Key( OPR_BAND, NULL) ]=Info(false,2,BOOL_INTR); 00098 ourIntrinsicInfoMap[Key( OPR_BIOR, NULL) ]=Info(false,2,BOOL_INTR); 00099 ourIntrinsicInfoMap[Key( OPR_BXOR, NULL) ]=Info(false,2,BOOL_INTR); 00100 ourIntrinsicInfoMap[Key( OPR_LNOT, NULL) ]=Info(false,1,BOOL_INTR); 00101 ourIntrinsicInfoMap[Key( OPR_LAND, NULL) ]=Info(false,2,BOOL_INTR); 00102 ourIntrinsicInfoMap[Key( OPR_LIOR, NULL) ]=Info(false,2,BOOL_INTR); 00103 ourIntrinsicInfoMap[Key( OPR_CAND, NULL) ]=Info(false,2,BOOL_INTR); 00104 ourIntrinsicInfoMap[Key( OPR_CIOR, NULL) ]=Info(false,2,BOOL_INTR); 00105 // comparison operations 00106 ourIntrinsicInfoMap[Key( OPR_EQ, NULL) ]=Info(false,2,FLOAT_INTR); 00107 ourIntrinsicInfoMap[Key( OPR_NE, NULL) ]=Info(false,2,FLOAT_INTR); 00108 ourIntrinsicInfoMap[Key( OPR_GT, NULL) ]=Info(false,2,FLOAT_INTR); 00109 ourIntrinsicInfoMap[Key( OPR_GE, NULL) ]=Info(false,2,FLOAT_INTR); 00110 ourIntrinsicInfoMap[Key( OPR_LT, NULL) ]=Info(false,2,FLOAT_INTR); 00111 ourIntrinsicInfoMap[Key( OPR_LE, NULL) ]=Info(false,2,FLOAT_INTR); 00112 ourIntrinsicInfoMap[Key( OPR_CALL, "ANY") ]=Info(false,1,ARRAY_INTR); 00113 // max/min 00114 ourIntrinsicInfoMap[Key( OPR_MAX, NULL) ]=Info(false,2,FLOAT_INTR); 00115 ourIntrinsicInfoMap[Key( OPR_MIN, NULL) ]=Info(false,2,FLOAT_INTR); 00116 // array operations 00117 ourIntrinsicInfoMap[Key( OPR_CALL, "MAXVAL") ]=Info(false,1,ARRAY_INTR); 00118 ourIntrinsicInfoMap[Key( OPR_CALL, "MAXLOC") ]=Info(false,1,ARRAY_INTR); 00119 ourIntrinsicInfoMap[Key( OPR_CALL, "MINVAL") ]=Info(false,1,ARRAY_INTR); 00120 ourIntrinsicInfoMap[Key( OPR_CALL, "MINLOC") ]=Info(false,1,ARRAY_INTR); 00121 ourIntrinsicInfoMap[Key( OPR_CALL, "LBOUND") ]=Info(false,2,ARRAY_INTR); 00122 ourIntrinsicInfoMap[Key( OPR_CALL, "UBOUND") ]=Info(false,2,ARRAY_INTR); 00123 ourIntrinsicInfoMap[Key( OPR_CALL, "SIZE") ]=Info(false,2,ARRAY_INTR); 00124 ourIntrinsicInfoMap[Key( OPR_CALL, "SHAPE") ]=Info(false,1,ARRAY_INTR); 00125 ourIntrinsicInfoMap[Key( OPR_INTRINSIC_OP, "F90INDEX") ]=Info(false,2,ARRAY_INTR); 00126 ourIntrinsicInfoMap[Key( OPR_CALL, "PRESENT") ]=Info(false,1,COMPILER_INTERNAL_INTR); 00127 ourIntrinsicInfoMap[Key( OPR_CALL, "ASSOCIATED") ]=Info(false,1,COMPILER_INTERNAL_INTR); 00128 ourIntrinsicInfoMap[Key( OPR_CALL, "ALLOCATED") ]=Info(false,1,COMPILER_INTERNAL_INTR); 00129 ourIntrinsicInfoMap[Key( OPR_NULLIFY, NULL) ]=Info(false,1,COMPILER_INTERNAL_INTR); 00130 ourIntrinsicInfoMap[Key( OPR_CALL, "_ALLOCATE") ]=Info(false,1,COMPILER_INTERNAL_INTR); 00131 ourIntrinsicInfoMap[Key( OPR_CALL, "_DEALLOCATE")]=Info(false,1,COMPILER_INTERNAL_INTR); 00132 ourIntrinsicInfoMap[Key( OPR_CALL, "MAXVAL") ]=Info(false,2,ARRAY_INTR); 00133 ourIntrinsicInfoMap[Key( OPR_CALL, "MINVAL") ]=Info(false,2,ARRAY_INTR); 00134 // shifting operations 00135 ourIntrinsicInfoMap[Key( OPR_SHL, NULL) ]=Info(false,2,INTEGER_INTR); 00136 ourIntrinsicInfoMap[Key( OPR_ASHR, NULL) ]=Info(false,2,INTEGER_INTR); 00137 // compiler internal routine for cleanup at the end of PROGRAM 00138 ourIntrinsicInfoMap[Key( OPR_CALL, "_END") ]=Info(false,0,COMPILER_INTERNAL_INTR); 00139 ourInitFlag = true; 00140 } 00141 return ourIntrinsicInfoMap; 00142 } 00143 00144 bool IntrinsicInfo::lookupIntrinsicInfo(const WN* aWN_p, const IntrinsicInfo::Info* anInfo) { 00145 OPERATOR opr = WN_operator(aWN_p); 00146 IntrinsicMap::const_iterator finder; 00147 00166 if (opr==OPR_INTRINSIC_OP) { 00167 // get the name and strip machine type information 00168 const char* inm = intrinsicBaseName(WN_intrinsic(aWN_p)); 00169 finder=getMap().find(Key(opr,inm)); 00170 if (finder==getMap().end()) { 00171 DIE("IntrinsicInfo::isIntrinsic: no entry for OPR_INTRINSIC_OP %s ",inm); 00172 } 00173 } 00174 else if (opr==OPR_CALL) { 00175 // get the name 00176 ST* st = WN_st(aWN_p); 00177 const char* funcNm = ST_name(st); 00178 // if we don't find it in the table we either forgot to add an entry 00179 // or the call is not to an intrinsic 00180 finder=getMap().find(Key(opr,funcNm)); 00181 } 00182 else { 00183 // the rest is for the OPERATORs without discriminating name which we 00184 // hopefully have complete 00185 finder=getMap().find(Key(opr,NULL)); 00186 } 00187 if (finder!=getMap().end()) 00188 anInfo=&((*finder).second); 00189 return finder!=getMap().end(); 00190 } 00191 00192 bool IntrinsicInfo::isIntrinsic(const WN* aWN_p) { 00193 const Info* anInfo_p; 00194 return lookupIntrinsicInfo(aWN_p,anInfo_p); 00195 } 00196 00197 const IntrinsicInfo::Info& IntrinsicInfo::getIntrinsicInfo(WN* aWN_p) { 00198 const Info* anInfo_p; 00199 if(!lookupIntrinsicInfo(aWN_p,anInfo_p)) 00200 DIE("IntrinsicInfo::getIntrinsicInfo: not a known intrinsic"); 00201 return *anInfo_p; 00202 } 00203 00204 bool IntrinsicInfo::KeyLT::operator()(const IntrinsicInfo::Key& k1, const IntrinsicInfo::Key& k2) const { 00205 if (k1.myWNopr<k2.myWNopr) 00206 return true; 00207 else if (k1.myWNopr>k2.myWNopr) 00208 return false; 00209 else if (k1.myWNopr==OPR_CALL) 00210 return strcmp(k1.myName, k2.myName) < 0; 00211 else 00212 return false; 00213 } 00214 00215 const char* IntrinsicInfo::intrinsicBaseName(INTRINSIC intrn) { 00216 // almost none of the Open64 code uses std::string 00217 const char* opc_str = WN_intrinsic_name(intrn); // INTRINSIC_name(intrn); 00218 const char* opc_str_base = opc_str; 00219 const int prefixLength(2); 00220 // Test for two-character prefixes (up to two) 00221 char buf[prefixLength+1]; 00222 for (int i = 0; i < 2; ++i) { 00223 // If a prefix begins 'opc_str_base', shift pointer 00224 strncpy(buf, opc_str_base, prefixLength); 00225 buf[prefixLength] = '\0'; 00226 bool pfix = lookupIntrinsicPrefix(buf); 00227 if (pfix) { 00228 opc_str_base += prefixLength; 00229 } else { 00230 break; // no need to continue 00231 } 00232 } 00233 // Special case: test for one-character prefix 00234 strncpy(buf, opc_str_base, 1); 00235 buf[1] = '\0'; 00236 bool pfix = lookupIntrinsicPrefix(buf); 00237 if (pfix) { 00238 // an exception 00239 if ( !(strcmp(opc_str_base, "VALTMP") == 0) ) { 00240 opc_str_base++; 00241 } 00242 } 00243 return opc_str_base; 00244 } 00245 00246 extern "C" int prefixTableCmp(const char** e1, const char** e2) { 00247 return strcmp(*e1, *e2); 00248 } 00249 00250 extern "C" typedef int (*compare_fn_t)(const void *, const void *); 00251 00252 bool IntrinsicInfo::lookupIntrinsicPrefix(const char* str){ 00253 static const char* prefixTable[] = { 00254 "V", // void 00255 "I1", "I2", "I4", "I8", // integer 00256 "U1", "U2", "U4", "U8", // unsigned integer 00257 "F4", "F8", "FQ", // floating point 00258 "C4", "C8", "CQ" // complex 00259 // "C_" - C intrinsics 00260 // "S_" - UPC intrinsics 00261 }; 00262 static unsigned int prefixTableElemSz = sizeof(const char*); 00263 static unsigned int prefixTableSz = (sizeof(prefixTable) / sizeof(const char*)); 00264 static bool prefixTableSorted = false; 00265 // first sort it 00266 if (!prefixTableSorted) { 00267 qsort(prefixTable, 00268 prefixTableSz, 00269 prefixTableElemSz, 00270 (compare_fn_t)prefixTableCmp); 00271 prefixTableSorted = true; 00272 } 00273 // Search for entry str 00274 void* e = bsearch(&str, 00275 prefixTable, 00276 prefixTableSz, 00277 prefixTableElemSz, 00278 (compare_fn_t)prefixTableCmp); 00279 return (e != NULL); 00280 }
1.7.6.1 
