|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
00001 /* 00002 00003 Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved. 00004 00005 This program is free software; you can redistribute it and/or modify it 00006 under the terms of version 2 of the GNU General Public License as 00007 published by the Free Software Foundation. 00008 00009 This program is distributed in the hope that it would be useful, but 00010 WITHOUT ANY WARRANTY; without even the implied warranty of 00011 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00012 00013 Further, this software is distributed without any warranty that it is 00014 free of the rightful claim of any third person regarding infringement 00015 or the like. Any license provided herein, whether implied or 00016 otherwise, applies only to this software file. Patent licenses, if 00017 any, provided herein do not apply to combinations of this program with 00018 other software, or any other product whatsoever. 00019 00020 You should have received a copy of the GNU General Public License along 00021 with this program; if not, write the Free Software Foundation, Inc., 59 00022 Temple Place - Suite 330, Boston MA 02111-1307, USA. 00023 00024 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00025 Mountain View, CA 94043, or: 00026 00027 http://www.sgi.com 00028 00029 For further information regarding this notice, see: 00030 00031 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00032 00033 */ 00034 00035 00036 /* USMID: "\n@(#)5.0_pl/macros/lex.m 5.3 07/28/99 12:17:30\n" */ 00037 00038 00039 /*****************\ 00040 |* MISCELLANEOUS *| 00041 \*****************/ 00042 00043 /********************\ 00044 |* SIZES AND LIMITS *| 00045 \********************/ 00046 00047 # define MAX_BIN_CONST_LEN 256 /* max binary const len */ 00048 # define MAX_HEX_CONST_LEN 64 /* max hex const len */ 00049 # define MAX_OCT_CONST_LEN 86 /* max octal const len */ 00050 00051 # define MAX_CHAR_CONST_LEN 1320 /* max character const len */ 00052 # define MAX_KWD_LEN 31 /* max keyword len */ 00053 00054 /******************************\ 00055 |* OBJECT REPLACEMENT STRINGS *| 00056 \******************************/ 00057 00058 00059 /***********************************\ 00060 |* CONDITIONAL REPLACEMENT STRINGS *| 00061 \***********************************/ 00062 00063 # define IS_BIN_DIGIT(CH) ((((CH) - '0') >> 1) == 0) 00064 # define IS_OCT_DIGIT(CH) ((((CH) - '0') >> 3) == 0) 00065 00066 # define VALID_LA_CH ((LA_CH_CLASS == Ch_Class_Letter || \ 00067 LA_CH_CLASS == Ch_Class_Digit || \ 00068 LA_CH_VALUE == USCORE || \ 00069 LA_CH_VALUE == DOLLAR || \ 00070 LA_CH_VALUE == AT_SIGN) && \ 00071 !sig_blank) 00072 00073 00074 00075 /***********************************************\ 00076 |* STATEMENT/FUNCTION-LIKE REPLACEMENT STRINGS *| 00077 \***********************************************/ 00078 00079 # define CHECK_FOR_FREE_BLANK \ 00080 if (source_form == Free_Form && \ 00081 VALID_LA_CH) { \ 00082 PRINTMSG(LA_CH_LINE, 415, Error, LA_CH_COLUMN); \ 00083 } 00084 00085 # define ADD_TO_TOKEN_KIND_STR(CH,LEN) \ 00086 if ((LEN) < MAX_ID_LEN) { \ 00087 TOKEN_KIND_STR(token)[(LEN)] = (CH); \ 00088 } \ 00089 (LEN)++ 00090 00091 # define ADD_TO_TOKEN_STR(CH,LEN) \ 00092 if ((LEN) < MAX_ID_LEN) { \ 00093 TOKEN_STR(token)[(LEN)] = (CH); \ 00094 } \ 00095 (LEN)++ 00096 00097 # define ADD_TO_CONST_BUF(CH,LEN) \ 00098 if ((LEN) < MAX_CHAR_CONST_LEN) { \ 00099 const_buf[(LEN)] = (CH); \ 00100 } \ 00101 (LEN)++ 00102 00103 # ifdef _WARNING_FOR_NUMERIC_INPUT_ERROR 00104 # define OVERFLOW_MESSAGE(RESULT) \ 00105 PRINTMSG(TOKEN_LINE(token),1413,Warning,TOKEN_COLUMN(token)); 00106 # else 00107 # define OVERFLOW_MESSAGE(RESULT) \ 00108 PRINTMSG(TOKEN_LINE(token),374,Error,TOKEN_COLUMN(token));\ 00109 RESULT = FALSE; 00110 # endif 00111 00112 /************************************************/ 00113 00114 # ifdef _USE_FOLD_DOT_f 00115 00116 # define CONVERT_INT_CONST(TYPE, LEN, RESULT) \ 00117 {const_buf[(LEN)] = '\0'; \ 00118 kludge_input_conversion(const_buf, TYPE); } 00119 00120 # define CONVERT_REAL_CONST(TYPE, LEN, RESULT) \ 00121 {const_buf[(LEN)] = '\0'; \ 00122 kludge_input_conversion(const_buf, TYPE); } 00123 00124 # define CONVERT_DBL_CONST(TYPE, LEN, RESULT) \ 00125 {const_buf[(LEN)] = '\0'; \ 00126 kludge_input_conversion(const_buf, TYPE); } 00127 00128 # else 00129 00130 # ifdef _ARITH_INPUT_CONV 00131 00132 # ifdef _TARGET64 00133 # define CONVERT_INT_CONST(TYPE, LEN, RESULT) \ 00134 { aligned_value_type a_const, tmp_const; \ 00135 int _stat, _bits, _base, _cvrt_lin_type; \ 00136 const_buf[(LEN)] = '\0'; \ 00137 _base = 10; \ 00138 _stat = AR_convert_str_to_int((AR_DATA *)tmp_const.v, \ 00139 (const AR_TYPE *)&input_arith_type[TYP_LINEAR(TYPE)],\ 00140 &_bits, \ 00141 (const char *)const_buf, \ 00142 (const int *)&_base); \ 00143 if (((_stat & AR_STAT_OVERFLOW) != 0) || \ 00144 ((_stat & AR_STAT_UNDERFLOW) != 0) || \ 00145 ((_stat & AR_STAT_SEMIVALID) != 0) || \ 00146 ((_stat & AR_STAT_UNDEFINED) != 0)) { \ 00147 OVERFLOW_MESSAGE(RESULT); \ 00148 } \ 00149 else if ((_stat & AR_STAT_INVALID_TYPE) != 0) { \ 00150 PRINTMSG(TOKEN_LINE(token),1016,Internal, \ 00151 TOKEN_COLUMN(token), \ 00152 arith_type_string[TYP_LINEAR(TYPE)]); \ 00153 } \ 00154 if (RESULT == TRUE) { \ 00155 _cvrt_lin_type = TYP_LINEAR(TYPE); \ 00156 _stat = AR_convert((AR_DATA *)a_const.v, \ 00157 (const AR_TYPE *)&linear_to_arith[_cvrt_lin_type], \ 00158 (const AR_DATA *)tmp_const.v, \ 00159 (const AR_TYPE *)&input_arith_type[TYP_LINEAR(TYPE)]); \ 00160 SHIFT_ARITH_RESULT(a_const.v, TYP_LINEAR(TYPE)); \ 00161 if (((_stat & AR_STAT_OVERFLOW) != 0) || \ 00162 ((_stat & AR_STAT_UNDERFLOW) != 0) || \ 00163 ((_stat & AR_STAT_SEMIVALID) != 0) || \ 00164 ((_stat & AR_STAT_UNDEFINED) != 0)) { \ 00165 OVERFLOW_MESSAGE(RESULT); \ 00166 } \ 00167 else if ((_stat & AR_STAT_INVALID_TYPE) != 0) { \ 00168 PRINTMSG(TOKEN_LINE(token),1016,Internal, \ 00169 TOKEN_COLUMN(token), \ 00170 arith_type_string[TYP_LINEAR(TYPE)]); \ 00171 } \ 00172 if (RESULT == TRUE) { \ 00173 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE, \ 00174 FALSE, a_const.v);\ 00175 } \ 00176 } \ 00177 } 00178 00179 # else 00180 00181 # define CONVERT_INT_CONST(TYPE, LEN, RESULT) \ 00182 { aligned_value_type a_const,tmp_const; \ 00183 int _stat, _bits, _base, _cvrt_lin_type; \ 00184 const_buf[(LEN)] = '\0'; \ 00185 _base = 10; \ 00186 _stat = AR_convert_str_to_int((AR_DATA *)tmp_const.v, \ 00187 (const AR_TYPE *)&input_arith_type[TYP_LINEAR(TYPE)],\ 00188 &_bits, \ 00189 (const char *)const_buf, \ 00190 (const int *)&_base); \ 00191 if (((_stat & AR_STAT_OVERFLOW) != 0) || \ 00192 ((_stat & AR_STAT_UNDERFLOW) != 0) || \ 00193 ((_stat & AR_STAT_SEMIVALID) != 0) || \ 00194 ((_stat & AR_STAT_UNDEFINED) != 0)) { \ 00195 OVERFLOW_MESSAGE(RESULT); \ 00196 } \ 00197 else if ((_stat & AR_STAT_INVALID_TYPE) != 0) { \ 00198 PRINTMSG(TOKEN_LINE(token),1016,Internal, \ 00199 TOKEN_COLUMN(token), \ 00200 arith_type_string[TYP_LINEAR(TYPE)]); \ 00201 } \ 00202 if (RESULT == TRUE) { \ 00203 _cvrt_lin_type = TYP_LINEAR(TYPE); \ 00204 _stat = AR_convert((AR_DATA *)a_const.v, \ 00205 (const AR_TYPE *)&linear_to_arith[_cvrt_lin_type], \ 00206 (const AR_DATA *)tmp_const.v, \ 00207 (const AR_TYPE *)&input_arith_type[TYP_LINEAR(TYPE)]); \ 00208 SHIFT_ARITH_RESULT(a_const.v, TYP_LINEAR(TYPE)); \ 00209 if (((_stat & AR_STAT_OVERFLOW) != 0) || \ 00210 ((_stat & AR_STAT_UNDERFLOW) != 0) || \ 00211 ((_stat & AR_STAT_SEMIVALID) != 0) || \ 00212 ((_stat & AR_STAT_UNDEFINED) != 0)) { \ 00213 OVERFLOW_MESSAGE(RESULT); \ 00214 } \ 00215 else if ((_stat & AR_STAT_INVALID_TYPE) != 0) { \ 00216 PRINTMSG(TOKEN_LINE(token),1016,Internal, \ 00217 TOKEN_COLUMN(token), \ 00218 arith_type_string[TYP_LINEAR(TYPE)]); \ 00219 } \ 00220 if (RESULT == TRUE) { \ 00221 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE, \ 00222 FALSE, a_const.v);\ 00223 } \ 00224 } \ 00225 } 00226 # endif 00227 00228 # define CONVERT_REAL_CONST(TYPE, LEN, RESULT) \ 00229 { aligned_value_type a_const; \ 00230 int _stat; \ 00231 const_buf[(LEN)] = '\0'; \ 00232 _stat = AR_convert_str_to_float((AR_DATA *)a_const.v, \ 00233 (const AR_TYPE *)&input_arith_type[TYP_LINEAR(TYPE)],\ 00234 (const char *)const_buf); \ 00235 SHIFT_ARITH_RESULT(a_const.v, TYP_LINEAR(TYPE)); \ 00236 if (((_stat & AR_STAT_OVERFLOW) != 0) || \ 00237 ((_stat & AR_STAT_UNDERFLOW) != 0) || \ 00238 ((_stat & AR_STAT_SEMIVALID) != 0) || \ 00239 ((_stat & AR_STAT_UNDEFINED) != 0)) { \ 00240 if (target_ieee) { \ 00241 PRINTMSG(TOKEN_LINE(token),1189,Warning, \ 00242 TOKEN_COLUMN(token)); \ 00243 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE, \ 00244 FALSE, a_const.v);\ 00245 } else { \ 00246 OVERFLOW_MESSAGE(RESULT); \ 00247 } \ 00248 } \ 00249 else if ((_stat & AR_STAT_INVALID_TYPE) != 0) { \ 00250 PRINTMSG(TOKEN_LINE(token),1016,Internal, \ 00251 TOKEN_COLUMN(token), \ 00252 arith_type_string[TYP_LINEAR(TYPE)]); \ 00253 } \ 00254 if (RESULT == TRUE) { \ 00255 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE, \ 00256 FALSE, a_const.v);\ 00257 } \ 00258 } 00259 00260 # define CONVERT_DBL_CONST(TYPE, LEN, RESULT) \ 00261 { aligned_value_type a_const; \ 00262 int _stat; \ 00263 const_buf[(LEN)] = '\0'; \ 00264 _stat = AR_convert_str_to_float((AR_DATA *)a_const.v, \ 00265 (const AR_TYPE *)&input_arith_type[TYP_LINEAR(TYPE)],\ 00266 (const char *)const_buf); \ 00267 SHIFT_ARITH_RESULT(a_const.v, TYP_LINEAR(TYPE)); \ 00268 if (((_stat & AR_STAT_OVERFLOW) != 0) || \ 00269 ((_stat & AR_STAT_UNDERFLOW) != 0) || \ 00270 ((_stat & AR_STAT_SEMIVALID) != 0) || \ 00271 ((_stat & AR_STAT_UNDEFINED) != 0)) { \ 00272 if (target_ieee) { \ 00273 PRINTMSG(TOKEN_LINE(token),1189,Warning, \ 00274 TOKEN_COLUMN(token)); \ 00275 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE, \ 00276 FALSE, a_const.v);\ 00277 } else { \ 00278 OVERFLOW_MESSAGE(RESULT); \ 00279 } \ 00280 } \ 00281 else if ((_stat & AR_STAT_INVALID_TYPE) != 0) { \ 00282 PRINTMSG(TOKEN_LINE(token),1016,Internal, \ 00283 TOKEN_COLUMN(token), \ 00284 arith_type_string[TYP_LINEAR(TYPE)]); \ 00285 } \ 00286 if (RESULT == TRUE) { \ 00287 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE, \ 00288 FALSE, a_const.v);\ 00289 } \ 00290 } 00291 00292 # else 00293 00294 # if defined(_HOST_OS_SOLARIS) 00295 00296 # define CONVERT_INT_CONST(TYPE, LEN, RESULT) \ 00297 { long_type a_const; \ 00298 const_buf[(LEN)] = '\0'; \ 00299 errno = 0; \ 00300 a_const = strtol(const_buf, (char **) NULL, 10); \ 00301 if (errno == 0) { \ 00302 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE, \ 00303 FALSE, &a_const); \ 00304 } else { \ 00305 OVERFLOW_MESSAGE(RESULT); \ 00306 } \ 00307 } 00308 00309 # define CONVERT_REAL_CONST(TYPE, LEN, RESULT) \ 00310 { long_type a_const[MAX_WORDS_FOR_NUMERIC]; \ 00311 double tmp_const; \ 00312 int _stat; \ 00313 const_buf[(LEN)] = '\0'; \ 00314 errno = 0; \ 00315 tmp_const = strtod(const_buf, (char **)NULL); \ 00316 if (errno != 0) { \ 00317 OVERFLOW_MESSAGE(RESULT); \ 00318 } \ 00319 else { \ 00320 _stat = AR_convert((AR_DATA *)a_const, \ 00321 (const AR_TYPE *)&linear_to_arith[TYP_LINEAR(TYPE)],\ 00322 (const AR_DATA *)&tmp_const, \ 00323 (const AR_TYPE *)&linear_to_arith[Real_8]); \ 00324 SHIFT_ARITH_RESULT(a_const, TYP_LINEAR(TYPE)); \ 00325 if (((_stat & AR_STAT_OVERFLOW) != 0) || \ 00326 /* ((_stat & AR_STAT_UNDERFLOW) != 0) || */ \ 00327 ((_stat & AR_STAT_SEMIVALID) != 0) || \ 00328 ((_stat & AR_STAT_UNDEFINED) != 0)) { \ 00329 OVERFLOW_MESSAGE(RESULT); \ 00330 } \ 00331 else if ((_stat & AR_STAT_INVALID_TYPE) != 0) { \ 00332 PRINTMSG(TOKEN_LINE(token),1016,Internal, \ 00333 TOKEN_COLUMN(token), \ 00334 arith_type_string[TYP_LINEAR(TYPE)]); \ 00335 } \ 00336 else { \ 00337 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE, \ 00338 FALSE, a_const);\ 00339 } \ 00340 } \ 00341 } 00342 00343 # define CONVERT_DBL_CONST(TYPE, LEN, RESULT) \ 00344 { double a_const; \ 00345 const_buf[(LEN)] = '\0'; \ 00346 errno = 0; \ 00347 a_const = strtod(const_buf, (char **)NULL); \ 00348 if (errno == 0) { \ 00349 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE, \ 00350 FALSE, (long_type *)&a_const);\ 00351 } else { \ 00352 OVERFLOW_MESSAGE(RESULT); \ 00353 } \ 00354 } 00355 # elif defined(_HOST32) && defined(_TARGET64) 00356 00357 # define CONVERT_INT_CONST(TYPE, LEN, RESULT) \ 00358 { long_type a_const; \ 00359 const_buf[(LEN)] = '\0'; \ 00360 errno = 0; \ 00361 a_const = strtoll(const_buf, (char **) NULL, 10); \ 00362 if (errno == 0) { \ 00363 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE, \ 00364 FALSE, &a_const); \ 00365 } else { \ 00366 OVERFLOW_MESSAGE(RESULT); \ 00367 } \ 00368 } 00369 00370 # define CONVERT_REAL_CONST(TYPE_IDX, LEN, RESULT) \ 00371 { float_type a_const; \ 00372 const_buf[(LEN)] = '\0'; \ 00373 errno = 0; \ 00374 a_const = (float_type)atof(const_buf); \ 00375 if (errno == 0) { \ 00376 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE_IDX, \ 00377 FALSE, (long_type *)&a_const);\ 00378 } else { \ 00379 OVERFLOW_MESSAGE(RESULT); \ 00380 } \ 00381 } 00382 00383 # define CONVERT_DBL_CONST(TYPE_IDX, LEN, RESULT) \ 00384 { ldouble a_const; \ 00385 const_buf[(LEN)] = '\0'; \ 00386 errno = 0; \ 00387 a_const = (ldouble)atof(const_buf); \ 00388 if (errno == 0) { \ 00389 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE_IDX, \ 00390 FALSE, (long_type *)&a_const);\ 00391 } else { \ 00392 OVERFLOW_MESSAGE(RESULT); \ 00393 } \ 00394 } 00395 00396 # else 00397 00398 # define CONVERT_INT_CONST(TYPE, LEN, RESULT) \ 00399 { long_type a_const; \ 00400 const_buf[(LEN)] = '\0'; \ 00401 errno = 0; \ 00402 a_const = LEX_STRTOL(const_buf, (char **) NULL, 10); \ 00403 if (errno == 0) { \ 00404 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE, \ 00405 FALSE, &a_const); \ 00406 } else { \ 00407 OVERFLOW_MESSAGE(RESULT); \ 00408 } \ 00409 } 00410 00411 # define CONVERT_REAL_CONST(TYPE, LEN, RESULT) \ 00412 { float a_const; \ 00413 const_buf[(LEN)] = '\0'; \ 00414 errno = 0; \ 00415 a_const = (float)atof(const_buf); \ 00416 if (errno == 0) { \ 00417 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE, \ 00418 FALSE, (long_type *)&a_const);\ 00419 } else { \ 00420 OVERFLOW_MESSAGE(RESULT); \ 00421 } \ 00422 } 00423 00424 # define CONVERT_DBL_CONST(TYPE, LEN, RESULT) \ 00425 { double a_const; \ 00426 const_buf[(LEN)] = '\0'; \ 00427 errno = 0; \ 00428 a_const = atof(const_buf); \ 00429 if (errno == 0) { \ 00430 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(TYPE, \ 00431 FALSE, (long_type *)&a_const);\ 00432 } else { \ 00433 OVERFLOW_MESSAGE(RESULT); \ 00434 } \ 00435 } 00436 # endif 00437 # endif 00438 # endif
1.7.6.1 
