00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045 static char USMID[] = "\n@(#)5.0_pl/sources/fold_drive.c 5.19 10/14/99 14:09:57\n";
00046
00047 # include <stdarg.h>
00048 #ifdef KEY
00049 # include "stdlib.h"
00050 # include "errno.h"
00051 #endif
00052 # include "defines.h"
00053 # include "host.m"
00054 # include "host.h"
00055 # include "target.m"
00056 # include "target.h"
00057 # include "globals.m"
00058 # include "tokens.m"
00059 # include "sytb.m"
00060 # include "s_globals.m"
00061 # include "debug.m"
00062 # include "fold_drive.m"
00063 # include "globals.h"
00064 # include "tokens.h"
00065 # include "sytb.h"
00066 # include "s_globals.h"
00067 # include "fmath.h"
00068 # include "arith.h"
00069 # include "fold_drive.h"
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091 boolean compare_cn_and_value(int cn_idx,
00092 #if defined(_HOST32) && defined(_TARGET64)
00093 long long value,
00094 #else
00095 long value,
00096 #endif
00097 int opr)
00098
00099 {
00100 long_type result[MAX_WORDS_FOR_NUMERIC];
00101 long_type right_value[MAX_WORDS_FOR_NUMERIC];
00102 boolean is_true = FALSE;
00103 int type_idx;
00104
00105
00106 TRACE (Func_Entry,"compare_cn_and_value" , NULL);
00107
00108 C_TO_F_INT(right_value, value, CG_INTEGER_DEFAULT_TYPE);
00109
00110 type_idx = CG_LOGICAL_DEFAULT_TYPE;
00111
00112 if (folder_driver((char *)&CN_CONST(cn_idx),
00113 CN_TYPE_IDX(cn_idx),
00114 (char *)&right_value,
00115 # ifdef _WHIRL_HOST64_TARGET64
00116 Integer_8,
00117 # else
00118 CG_INTEGER_DEFAULT_TYPE,
00119 # endif
00120 result,
00121 &type_idx,
00122 stmt_start_line,
00123 stmt_start_col,
00124 2,
00125 opr)) {
00126
00127 if (THIS_IS_TRUE(result, type_idx)) {
00128 is_true = TRUE;
00129 }
00130 }
00131
00132 TRACE (Func_Exit, "compare_cn_and_value", NULL);
00133
00134 return(is_true);
00135
00136 }
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155 static void f90_character_compare(char *ch_ptr1,
00156 long64 len1,
00157 char *ch_ptr2,
00158 long64 len2,
00159 int opr,
00160 long_type *result,
00161 int type_idx)
00162
00163 {
00164 char char1;
00165 char char2;
00166 int comp_result = 0;
00167 long64 i;
00168
00169
00170 TRACE (Func_Entry, "f90_character_compare", NULL);
00171
00172 set_up_logical_constant(result, type_idx, FALSE_VALUE, FALSE);
00173
00174 for (i = 0; i < (len1 > len2 ? len1 : len2); i++) {
00175
00176 if (i < len1) {
00177 char1 = ch_ptr1[i];
00178 }
00179 else {
00180 char1 = ' ';
00181 }
00182
00183 if (i < len2) {
00184 char2 = ch_ptr2[i];
00185 }
00186 else {
00187 char2 = ' ';
00188 }
00189
00190 if (char1 == char2) {
00191
00192 }
00193 else if (char1 < char2) {
00194 comp_result = -1;
00195 break;
00196 }
00197 else if (char1 > char2) {
00198 comp_result = 1;
00199 break;
00200 }
00201 }
00202
00203
00204 switch (opr) {
00205 case Eq_Opr :
00206
00207 if (comp_result == 0) {
00208 set_up_logical_constant(result, type_idx, TRUE_VALUE, FALSE);
00209 }
00210 break;
00211
00212 case Ne_Opr :
00213
00214 if (comp_result != 0) {
00215 set_up_logical_constant(result, type_idx, TRUE_VALUE, FALSE);
00216 }
00217 break;
00218
00219 case Lt_Opr :
00220
00221 if (comp_result < 0) {
00222 set_up_logical_constant(result, type_idx, TRUE_VALUE, FALSE);
00223 }
00224 break;
00225
00226 case Le_Opr :
00227
00228 if (comp_result <= 0) {
00229 set_up_logical_constant(result, type_idx, TRUE_VALUE, FALSE);
00230 }
00231 break;
00232
00233 case Gt_Opr :
00234
00235 if (comp_result > 0) {
00236 set_up_logical_constant(result, type_idx, TRUE_VALUE, FALSE);
00237 }
00238 break;
00239
00240 case Ge_Opr :
00241
00242 if (comp_result >= 0) {
00243 set_up_logical_constant(result, type_idx, TRUE_VALUE, FALSE);
00244 }
00245 break;
00246
00247 }
00248
00249 TRACE (Func_Exit, "f90_character_compare", NULL);
00250
00251 return;
00252
00253 }
00254
00255
00256 #ifdef KEY
00257
00258
00259
00260
00261
00262
00263
00264 #define CORRECT_THE_POINTER(l_value_offset) \
00265 (((char *)const_pool) + l_value_offset)
00266 #endif
00267
00268 #ifdef KEY
00269
00270
00271
00272
00273
00274
00275
00276
00277
00278
00279
00280
00281
00282
00283
00284
00285
00286
00287 void
00288 copy_and_pad_boz(long_type *dst, Uint dst_words, long_type *src, Uint src_words) {
00289 for (int i = 0; i < dst_words; i++) {
00290 dst[i] = 0;
00291 }
00292
00293
00294 src_words = (0 == src_words) ? 1 : src_words;
00295 dst_words = (0 == dst_words) ? 1 : dst_words;
00296 int start = (src_words > dst_words) ? (src_words - dst_words) : 0;
00297 # if defined(_HOST_LITTLE_ENDIAN) && defined(_TARGET_LITTLE_ENDIAN)
00298 int reverse = src_words - 1;
00299 for (int i = start; i < src_words; i++) {
00300 dst[reverse - i] = src[i];
00301 }
00302 # else
00303 int pad = dst_words - src_words;
00304 for (int i = start; i < src_words; i++) {
00305 dst[i + pad] = src[i];
00306 }
00307 # endif
00308 }
00309 #endif
00310
00311
00312
00313
00314
00315
00316
00317
00318
00319
00320
00321
00322
00323
00324
00325 #define FOLD_OP fold_operation__
00326
00327 extern void FOLD_OP(int *,
00328 void *,
00329 linear_type_type *,
00330 void *,
00331 linear_type_type *,
00332 void *,
00333 linear_type_type *,
00334 void *,
00335 linear_type_type *);
00336
00337 boolean folder_driver(char *l_value_ptr,
00338 int l_type_idx,
00339 char *r_value_ptr,
00340 int r_type_idx,
00341 long_type *result,
00342 int *res_type_idx,
00343 int line,
00344 int col,
00345 int num_args,
00346 int opr,
00347 ...)
00348
00349 {
00350 struct value_entry { long_type v[MAX_WORDS_FOR_NUMERIC]; };
00351
00352 typedef struct value_entry value_type;
00353
00354 struct big_value_entry { long_type v[2000]; };
00355
00356 typedef struct big_value_entry big_value_type;
00357
00358 boolean ok = TRUE;
00359 long64 count;
00360 big_value_type l_value;
00361 value_type r_value;
00362 value_type a3_value;
00363 value_type a4_value;
00364 value_type str_len1;
00365 value_type str_len2;
00366 big_value_type loc_result;
00367 long64 i;
00368 int j;
00369 int k;
00370 int cn_idx;
00371 long64 length;
00372 long64 length_o;
00373 long64 length_d;
00374 linear_type_type l_linear_type;
00375 linear_type_type r_linear_type;
00376 linear_type_type a3_linear_type;
00377 #ifdef KEY
00378 linear_type_type a4_linear_type = Err_Res;
00379 #else
00380 linear_type_type a4_linear_type;
00381 #endif
00382 linear_type_type res_linear_type;
00383 linear_type_type str1_linear_type;
00384 linear_type_type str2_linear_type;
00385 long_type mask;
00386 #ifdef KEY
00387 char *a3_value_ptr = 0;
00388 int a3_type_idx = 0;
00389 char *a4_value_ptr = 0;
00390 int a4_type_idx = 0;
00391 #else
00392 char *a3_value_ptr;
00393 int a3_type_idx;
00394 char *a4_value_ptr;
00395 int a4_type_idx;
00396 #endif
00397 va_list arg_ptr;
00398 char char_buf[8000];
00399 int type_idx;
00400 int char_idx;
00401 int tmp_opr;
00402 char *char_ptr;
00403 long arith_type;
00404 long arith_type_l;
00405 AR_COMPARE_TYPE comp_res;
00406 long64 char_len;
00407
00408
00409 TRACE (Func_Entry, "folder_driver", NULL);
00410
00411 if (l_type_idx != NULL_IDX) {
00412 l_linear_type = TYP_LINEAR(l_type_idx);
00413 }
00414
00415 res_linear_type = TYP_LINEAR(*res_type_idx);
00416
00417 if (num_args > 1 && r_type_idx != NULL_IDX) {
00418 r_linear_type = TYP_LINEAR(r_type_idx);
00419 }
00420
00421 if (num_args > 2) {
00422 va_start (arg_ptr, opr);
00423 a3_value_ptr = va_arg(arg_ptr, char *);
00424 a3_type_idx = va_arg(arg_ptr, long);
00425 a4_value_ptr = va_arg(arg_ptr, char *);
00426 a4_type_idx = va_arg(arg_ptr, long);
00427 va_end(arg_ptr);
00428
00429 if (a3_type_idx != NULL_IDX) {
00430 a3_linear_type = TYP_LINEAR(a3_type_idx);
00431 }
00432
00433 if (num_args == 4 &&
00434 a4_type_idx != NULL_IDX) {
00435
00436 a4_linear_type = TYP_LINEAR(a4_type_idx);
00437 }
00438 }
00439
00440 if ((opr == SRK_Opr) ||
00441 (opr == Transfer_Opr) ||
00442 (opr == Reshape_Opr)) {
00443 goto CONTINUE;
00444 }
00445
00446
00447
00448
00449 if (TYP_TYPE(l_type_idx) == Typeless) {
00450 for (i = 0;
00451 i < ((TYP_BIT_LEN(l_type_idx) + TARGET_BITS_PER_WORD - 1)/
00452 TARGET_BITS_PER_WORD);
00453 i++) {
00454 l_value.v[i] = ((long_type *)l_value_ptr)[i];
00455 }
00456 }
00457 else if (TYP_TYPE(l_type_idx) != Character) {
00458 for (i = 0; i < num_host_wds[TYP_LINEAR(l_type_idx)]; i++) {
00459 l_value.v[i] = ((long_type *)l_value_ptr)[i];
00460 }
00461
00462 # ifdef _TARGET_OS_MAX
00463 if (l_linear_type == Complex_4) {
00464
00465 l_value.v[0] = l_value.v[0] << 32;
00466 l_value.v[0] = l_value.v[0] | (l_value.v[1] & 0xFFFFFFFF);
00467 }
00468 # endif
00469 }
00470 else {
00471 char_ptr = (char *)l_value.v;
00472 l_value.v[0] = 0;
00473
00474 for (i = 0; i < CN_INT_TO_C(TYP_IDX(l_type_idx)); i++) {
00475 char_ptr[i] = l_value_ptr[i];
00476 }
00477
00478 for ( ; i < TARGET_BYTES_PER_WORD; i++) {
00479 char_ptr[i] = ' ';
00480 }
00481 }
00482
00483 if (num_args > 1) {
00484
00485 if (TYP_TYPE(r_type_idx) == Typeless) {
00486
00487 for (i = 0;
00488 i < ((TYP_BIT_LEN(r_type_idx) + TARGET_BITS_PER_WORD - 1)/
00489 TARGET_BITS_PER_WORD);
00490 i++) {
00491
00492 r_value.v[i] = ((long_type *)r_value_ptr)[i];
00493 }
00494 }
00495 else if (TYP_TYPE(r_type_idx) != Character) {
00496
00497 for (i = 0; i < num_host_wds[TYP_LINEAR(r_type_idx)]; i++) {
00498 r_value.v[i] = ((long_type *)r_value_ptr)[i];
00499 }
00500
00501 # ifdef _TARGET_OS_MAX
00502 if (r_linear_type == Complex_4) {
00503
00504 r_value.v[0] = r_value.v[0] << 32;
00505 r_value.v[0] = r_value.v[0] | (r_value.v[1] & 0xFFFFFFFF);
00506 }
00507 # endif
00508 }
00509 else {
00510 char_ptr = (char *)r_value.v;
00511 r_value.v[0] = 0;
00512
00513 for (i = 0; i < CN_INT_TO_C(TYP_IDX(r_type_idx)) &&
00514 i < TARGET_BYTES_PER_WORD;
00515 i++) {
00516 char_ptr[i] = r_value_ptr[i];
00517 }
00518
00519 for ( ; i < TARGET_BYTES_PER_WORD; i++) {
00520 char_ptr[i] = ' ';
00521 }
00522 }
00523 }
00524
00525 if (num_args > 2) {
00526
00527 if (TYP_TYPE(a3_type_idx) == Typeless) {
00528
00529 for (i = 0;
00530 i < ((TYP_BIT_LEN(a3_type_idx) + TARGET_BITS_PER_WORD - 1)/
00531 TARGET_BITS_PER_WORD);
00532 i++) {
00533
00534 a3_value.v[i] = ((long_type *)a3_value_ptr)[i];
00535 }
00536 }
00537 else if (TYP_TYPE(a3_type_idx) != Character) {
00538
00539 for (i = 0; i < num_host_wds[a3_linear_type]; i++) {
00540 a3_value.v[i] = ((long_type *)a3_value_ptr)[i];
00541 }
00542
00543 # ifdef _TARGET_OS_MAX
00544 if (a3_linear_type == Complex_4) {
00545
00546 a3_value.v[0] = a3_value.v[0] << 32;
00547 a3_value.v[0] = a3_value.v[0] | (a3_value.v[1] & 0xFFFFFFFF);
00548 }
00549 # endif
00550 }
00551 else {
00552 char_ptr = (char *)a3_value.v;
00553 a3_value.v[0] = 0;
00554
00555 for (i = 0; i < CN_INT_TO_C(TYP_IDX(a3_type_idx)) &&
00556 i < TARGET_BYTES_PER_WORD;
00557 i++) {
00558 char_ptr[i] = a3_value_ptr[i];
00559 }
00560
00561 for ( ; i < TARGET_BYTES_PER_WORD; i++) {
00562 char_ptr[i] = ' ';
00563 }
00564 }
00565 }
00566
00567 if (num_args > 3) {
00568
00569 if (TYP_TYPE(a4_type_idx) == Typeless) {
00570
00571 for (i = 0;
00572 i < ((TYP_BIT_LEN(a4_type_idx) + TARGET_BITS_PER_WORD - 1)/
00573 TARGET_BITS_PER_WORD);
00574 i++) {
00575
00576 a4_value.v[i] = ((long_type *)a4_value_ptr)[i];
00577 }
00578 }
00579 else if (TYP_TYPE(a4_type_idx) != Character) {
00580
00581 for (i = 0; i < num_host_wds[a4_linear_type]; i++) {
00582 a4_value.v[i] = ((long_type *)a4_value_ptr)[i];
00583 }
00584
00585 # ifdef _TARGET_OS_MAX
00586 if (a4_linear_type == Complex_4) {
00587
00588 a4_value.v[0] = a4_value.v[0] << 32;
00589 a4_value.v[0] = a4_value.v[0] | (a4_value.v[1] & 0xFFFFFFFF);
00590 }
00591 # endif
00592 }
00593 else {
00594 char_ptr = (char *)a4_value.v;
00595 a4_value.v[0] = 0;
00596
00597 for (i = 0; i < CN_INT_TO_C(TYP_IDX(a4_type_idx)) &&
00598 i < TARGET_BYTES_PER_WORD;
00599 i++) {
00600 char_ptr[i] = a4_value_ptr[i];
00601 }
00602
00603 for ( ; i < TARGET_BYTES_PER_WORD; i++) {
00604 char_ptr[i] = ' ';
00605 }
00606 }
00607 }
00608
00609
00610 CONTINUE:
00611
00612 #ifdef KEY
00613
00614
00615
00616
00617
00618
00619
00620
00621
00622
00623 {
00624 size_t l_value_offset = l_value_ptr - (char *) const_pool;
00625 size_t r_value_offset = r_value_ptr - (char *) const_pool;
00626 #endif
00627 switch (opr) {
00628 case Reshape_Opr :
00629 mask = AR_reshape((void *)result,
00630 (const void *)l_value_ptr,
00631 (const void *)r_value_ptr,
00632 (const void *)a3_value_ptr,
00633 (const void *)a4_value_ptr);
00634
00635 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
00636
00637 goto EXIT;
00638
00639
00640 case Transfer_Opr :
00641 if (a3_value_ptr != NULL) {
00642 for (i = 0; i < num_host_wds[a3_linear_type]; i++) {
00643 a3_value.v[i] = ((long_type *)a3_value_ptr)[i];
00644 }
00645 SHIFT_ARITH_ARG(a3_value.v, a3_linear_type);
00646
00647 mask = AR_transfer((void *)result,
00648 (const void *)l_value_ptr,
00649 (const void *)r_value_ptr,
00650 (const AR_DATA *)a3_value.v,
00651 (const AR_TYPE *)&linear_to_arith[a3_linear_type]);
00652 }
00653 else {
00654 mask = AR_transfer((void *)result,
00655 (const void *)l_value_ptr,
00656 (const void *)r_value_ptr,
00657 (const AR_DATA *)a3_value_ptr,
00658 (const AR_TYPE *)&linear_to_arith[INTEGER_DEFAULT_TYPE]);
00659 }
00660
00661 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
00662
00663 goto EXIT;
00664
00665
00666 case Trim_Opr :
00667
00668
00669
00670 i = CN_INT_TO_C(TYP_IDX(l_type_idx));
00671 while (i > 0 && l_value_ptr[i-1] == ' ') {
00672 i--;
00673 }
00674
00675 char_len = i;
00676
00677 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
00678 TYP_TYPE(TYP_WORK_IDX) = Character;
00679 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE;
00680 TYP_CHAR_CLASS(TYP_WORK_IDX) = Const_Len_Char;
00681 TYP_FLD(TYP_WORK_IDX) = CN_Tbl_Idx;
00682 TYP_IDX(TYP_WORK_IDX) = C_INT_TO_CN(NULL_IDX, char_len);
00683 *res_type_idx = ntr_type_tbl();
00684
00685 result[0] = ntr_const_tbl((*res_type_idx), TRUE, NULL);
00686 #ifdef KEY
00687 l_value_ptr = CORRECT_THE_POINTER(l_value_offset);
00688 r_value_ptr = CORRECT_THE_POINTER(r_value_offset);
00689 #endif
00690 char_ptr = (char *) &CN_CONST(result[0]);
00691
00692 for (i = 0; i < char_len; i++) {
00693 char_ptr[i] = l_value_ptr[i];
00694 }
00695
00696 break;
00697
00698
00699 case Repeat_Opr :
00700
00701
00702
00703
00704
00705 length = CP_CONSTANT(CN_POOL_IDX(TYP_IDX(l_type_idx)) +
00706 num_host_wds[TYP_LINEAR(CN_TYPE_IDX(TYP_IDX(l_type_idx)))] - 1);
00707
00708 # if defined(_HOST_LITTLE_ENDIAN) && defined(_TARGET_LITTLE_ENDIAN)
00709 if (r_linear_type == Integer_8)
00710 count = *(long long *)(&r_value.v[0]);
00711 else
00712 #endif
00713 count = r_value.v[num_host_wds[r_linear_type] - 1];
00714
00715 length = length * count;
00716
00717 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
00718 TYP_TYPE(TYP_WORK_IDX) = Character;
00719 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE;
00720 TYP_CHAR_CLASS(TYP_WORK_IDX) = Const_Len_Char;
00721 TYP_FLD(TYP_WORK_IDX) = CN_Tbl_Idx;
00722 TYP_IDX(TYP_WORK_IDX) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, length),
00723 *res_type_idx = ntr_type_tbl();
00724
00725 result[0] = ntr_const_tbl((*res_type_idx), TRUE, NULL);
00726 #ifdef KEY
00727 l_value_ptr = CORRECT_THE_POINTER(l_value_offset);
00728 r_value_ptr = CORRECT_THE_POINTER(r_value_offset);
00729 #endif
00730 char_ptr = (char *) &CN_CONST(result[0]);
00731
00732 length = CP_CONSTANT(CN_POOL_IDX(TYP_IDX(l_type_idx)) +
00733 num_host_wds[TYP_LINEAR(CN_TYPE_IDX(TYP_IDX(l_type_idx)))] - 1);
00734
00735 char_idx = 0;
00736 for (k = 0; k < count; k++) {
00737 for (i = 0; i < length; i++) {
00738 char_ptr[char_idx] = l_value_ptr[i];
00739 char_idx++;
00740 }
00741 }
00742 break;
00743
00744
00745 case SRK_Opr :
00746 if (r_value_ptr == NULL) {
00747
00748 for (i = 0; i < num_host_wds[l_linear_type]; i++) {
00749 l_value.v[i] = ((long_type *)l_value_ptr)[i];
00750 }
00751
00752 if (l_linear_type != res_linear_type) {
00753 SHIFT_ARITH_ARG(l_value.v, l_linear_type);
00754
00755 # if defined(_USE_FOLD_DOT_f)
00756 tmp_opr = Cvrt_Opr;
00757 FOLD_OP(
00758 &tmp_opr,
00759 &loc_result.v,
00760 &res_linear_type,
00761 &l_value.v,
00762 &l_linear_type,
00763 &r_value.v,
00764 &r_linear_type,
00765 &a3_value.v,
00766 &a3_linear_type);
00767 # else
00768 mask = AR_convert((AR_DATA *)loc_result.v,
00769 (const AR_TYPE *)&linear_to_arith[res_linear_type],
00770 (const AR_DATA *)l_value.v,
00771 (const AR_TYPE *)&linear_to_arith[l_linear_type]);
00772 # endif
00773
00774 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
00775 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
00776
00777 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
00778 l_value.v[i] = loc_result.v[i];
00779 }
00780 }
00781
00782 r_linear_type = Err_Res;
00783
00784 SHIFT_ARITH_ARG(l_value.v, res_linear_type);
00785
00786 # if defined(_USE_FOLD_DOT_f)
00787 FOLD_OP(
00788 &opr,
00789 &loc_result.v,
00790 &res_linear_type,
00791 &l_value.v,
00792 &l_linear_type,
00793 &r_value.v,
00794 &r_linear_type,
00795 &a3_value.v,
00796 &a3_linear_type);
00797 # else
00798 mask = AR_selected_real_kind((AR_DATA *)loc_result.v,
00799 (const AR_TYPE *)&linear_to_arith[res_linear_type],
00800 (const AR_DATA *)l_value.v,
00801 (const AR_TYPE *)&linear_to_arith[res_linear_type],
00802 (const AR_DATA *)NULL,
00803 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
00804 # endif
00805
00806 }
00807 else if (l_value_ptr == NULL) {
00808 for (i = 0; i < num_host_wds[r_linear_type]; i++) {
00809 r_value.v[i] = ((long_type *)r_value_ptr)[i];
00810 }
00811
00812 if (r_linear_type != res_linear_type) {
00813 SHIFT_ARITH_ARG(r_value.v, r_linear_type);
00814
00815 # if defined(_USE_FOLD_DOT_f)
00816 tmp_opr = Cvrt_Opr;
00817 FOLD_OP(
00818 &tmp_opr,
00819 &loc_result.v,
00820 &res_linear_type,
00821 &r_value.v,
00822 &r_linear_type,
00823 &r_value.v,
00824 &r_linear_type,
00825 &a3_value.v,
00826 &a3_linear_type);
00827 # else
00828 mask = AR_convert((AR_DATA *)loc_result.v,
00829 (const AR_TYPE *)&linear_to_arith[res_linear_type],
00830 (const AR_DATA *)r_value.v,
00831 (const AR_TYPE *)&linear_to_arith[r_linear_type]);
00832 # endif
00833
00834 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
00835 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
00836
00837 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
00838 r_value.v[i] = loc_result.v[i];
00839 }
00840 }
00841
00842 l_linear_type = Err_Res;
00843
00844 SHIFT_ARITH_ARG(r_value.v, res_linear_type);
00845
00846 # if defined(_USE_FOLD_DOT_f)
00847 FOLD_OP(
00848 &opr,
00849 &loc_result.v,
00850 &res_linear_type,
00851 &l_value.v,
00852 &l_linear_type,
00853 &r_value.v,
00854 &r_linear_type,
00855 &a3_value.v,
00856 &a3_linear_type);
00857 # else
00858 mask = AR_selected_real_kind((AR_DATA *)loc_result.v,
00859 (const AR_TYPE *)&linear_to_arith[res_linear_type],
00860 (const AR_DATA *)NULL,
00861 (const AR_TYPE *)&linear_to_arith[res_linear_type],
00862 (const AR_DATA *)r_value.v,
00863 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
00864 # endif
00865 }
00866 else {
00867
00868 for (i = 0; i < num_host_wds[l_linear_type]; i++) {
00869 l_value.v[i] = ((long_type *)l_value_ptr)[i];
00870 }
00871
00872 if (l_linear_type != res_linear_type) {
00873 SHIFT_ARITH_ARG(l_value.v, l_linear_type);
00874
00875 # if defined(_USE_FOLD_DOT_f)
00876 tmp_opr = Cvrt_Opr;
00877 FOLD_OP(
00878 &tmp_opr,
00879 &loc_result.v,
00880 &res_linear_type,
00881 &l_value.v,
00882 &l_linear_type,
00883 &r_value.v,
00884 &r_linear_type,
00885 &a3_value.v,
00886 &a3_linear_type);
00887 # else
00888 mask = AR_convert((AR_DATA *)loc_result.v,
00889 (const AR_TYPE *)&linear_to_arith[res_linear_type],
00890 (const AR_DATA *)l_value.v,
00891 (const AR_TYPE *)&linear_to_arith[l_linear_type]);
00892 # endif
00893
00894 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
00895 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
00896
00897 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
00898 l_value.v[i] = loc_result.v[i];
00899 }
00900 }
00901
00902 SHIFT_ARITH_ARG(l_value.v, res_linear_type);
00903
00904 for (i = 0; i < num_host_wds[r_linear_type]; i++) {
00905 r_value.v[i] = ((long_type *)r_value_ptr)[i];
00906 }
00907
00908 if (r_linear_type != res_linear_type) {
00909 SHIFT_ARITH_ARG(r_value.v, r_linear_type);
00910
00911 # if defined(_USE_FOLD_DOT_f)
00912 tmp_opr = Cvrt_Opr;
00913 FOLD_OP(
00914 &tmp_opr,
00915 &loc_result.v,
00916 &res_linear_type,
00917 &r_value.v,
00918 &r_linear_type,
00919 &r_value.v,
00920 &r_linear_type,
00921 &a3_value.v,
00922 &a3_linear_type);
00923 # else
00924 mask = AR_convert((AR_DATA *)loc_result.v,
00925 (const AR_TYPE *)&linear_to_arith[res_linear_type],
00926 (const AR_DATA *)r_value.v,
00927 (const AR_TYPE *)&linear_to_arith[r_linear_type]);
00928 # endif
00929
00930 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
00931 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
00932
00933 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
00934 r_value.v[i] = loc_result.v[i];
00935 }
00936 }
00937
00938 SHIFT_ARITH_ARG(r_value.v, res_linear_type);
00939
00940 # if defined(_USE_FOLD_DOT_f)
00941 FOLD_OP(
00942 &opr,
00943 &loc_result.v,
00944 &res_linear_type,
00945 &l_value.v,
00946 &l_linear_type,
00947 &r_value.v,
00948 &r_linear_type,
00949 &a3_value.v,
00950 &a3_linear_type);
00951 # else
00952 mask = AR_selected_real_kind((AR_DATA *)loc_result.v,
00953 (const AR_TYPE *)&linear_to_arith[res_linear_type],
00954 (const AR_DATA *)l_value.v,
00955 (const AR_TYPE *)&linear_to_arith[res_linear_type],
00956 (const AR_DATA *)r_value.v,
00957 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
00958 # endif
00959 }
00960
00961 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
00962 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
00963
00964 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
00965 result[i] = loc_result.v[i];
00966 }
00967
00968 break;
00969
00970
00971 case SIK_Opr :
00972 cn_idx = ntr_const_tbl(l_type_idx, FALSE, &l_value.v[0]);
00973 #ifdef KEY
00974 l_value_ptr = CORRECT_THE_POINTER(l_value_offset);
00975 r_value_ptr = CORRECT_THE_POINTER(r_value_offset);
00976 #endif
00977
00978 if (compare_cn_and_value(cn_idx, RANGE_INT1_F90, Le_Opr)) {
00979 i = 1;
00980 }
00981 else if (compare_cn_and_value(cn_idx, RANGE_INT2_F90, Le_Opr)) {
00982 i = 2;
00983 }
00984 else if (compare_cn_and_value(cn_idx, RANGE_INT4_F90, Le_Opr)) {
00985 i = 4;
00986 }
00987 else if (compare_cn_and_value(cn_idx, RANGE_INT8_F90, Le_Opr)) {
00988 i = 8;
00989 }
00990 else {
00991 i = -1;
00992 }
00993
00994 C_TO_F_INT(result, i, res_linear_type);
00995
00996 break;
00997
00998
00999 case Uminus_Opr :
01000 if (l_linear_type != res_linear_type &&
01001 TYP_TYPE(l_type_idx) != Typeless) {
01002
01003 SHIFT_ARITH_ARG(l_value.v, l_linear_type);
01004
01005 # if defined(_USE_FOLD_DOT_f)
01006 tmp_opr = Cvrt_Opr;
01007 FOLD_OP(
01008 &tmp_opr,
01009 &loc_result.v,
01010 &res_linear_type,
01011 &l_value.v,
01012 &l_linear_type,
01013 &r_value.v,
01014 &r_linear_type,
01015 &a3_value.v,
01016 &a3_linear_type);
01017 # else
01018 mask = AR_convert((AR_DATA *)loc_result.v,
01019 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01020 (const AR_DATA *)l_value.v,
01021 (const AR_TYPE *)&linear_to_arith[l_linear_type]);
01022 # endif
01023
01024 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01025 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01026
01027 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01028 l_value.v[i] = loc_result.v[i];
01029 }
01030 }
01031
01032 SHIFT_ARITH_ARG(l_value.v, res_linear_type);
01033
01034 # if defined(_USE_FOLD_DOT_f)
01035 FOLD_OP(
01036 &opr,
01037 &loc_result.v,
01038 &res_linear_type,
01039 &l_value.v,
01040 &res_linear_type,
01041 &r_value.v,
01042 &res_linear_type,
01043 &a3_value.v,
01044 &a3_linear_type);
01045 # else
01046 mask = AR_negate((AR_DATA *)loc_result.v,
01047 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01048 (const AR_DATA *)l_value.v,
01049 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
01050 # endif
01051
01052 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01053 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01054
01055 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01056 result[i] = loc_result.v[i];
01057 }
01058 break;
01059
01060
01061 case Cvrt_Opr :
01062 case Int_Opr :
01063 if (TYP_TYPE(l_type_idx) == Character) {
01064 length_o = CN_INT_TO_C(TYP_IDX(l_type_idx));
01065
01066 if (TYP_TYPE((*res_type_idx)) == Character) {
01067 length_d = CN_INT_TO_C(TYP_IDX((*res_type_idx)));
01068 }
01069 else {
01070 length_d = num_host_wds[TYP_LINEAR((*res_type_idx))] *
01071 TARGET_CHARS_PER_WORD;
01072 }
01073
01074 char_ptr = (char *) result;
01075 l_value_ptr = (char *) &l_value.v;
01076
01077 for (i = 0; i < length_o; i++) {
01078 char_ptr[i] = l_value_ptr[i];
01079 }
01080
01081 for (j = i; j < length_d; j++) {
01082 char_ptr[j] = ' ';
01083 }
01084
01085 break;
01086 }
01087
01088 if (TYP_TYPE(l_type_idx) == Logical &&
01089 TYP_TYPE((*res_type_idx)) == Logical) {
01090
01091 # if defined(_TARGET_OS_SOLARIS) || (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
01092 if (l_linear_type == Logical_8 &&
01093 (res_linear_type == Logical_1 ||
01094 res_linear_type == Logical_2 ||
01095 res_linear_type == Logical_4)) {
01096
01097 # if defined(_HOST_LITTLE_ENDIAN) && defined(_TARGET_LITTLE_ENDIAN)
01098 *(long *)result = *(long long *)(l_value.v);
01099 # else
01100 result[0] = l_value.v[1];
01101 # endif
01102 }
01103 else if (res_linear_type == Logical_8 &&
01104 (l_linear_type == Logical_1 ||
01105 l_linear_type == Logical_2 ||
01106 l_linear_type == Logical_4)) {
01107
01108 # if defined(_HOST_LITTLE_ENDIAN) && defined(_TARGET_LITTLE_ENDIAN)
01109 *(long long *)result = *(long *)(l_value.v);
01110 # else
01111 result[0] = 0;
01112 result[1] = l_value.v[0];
01113 # endif
01114 }
01115 else {
01116 result[0] = l_value.v[0];
01117 result[1] = l_value.v[1];
01118 }
01119 # else
01120 result[0] = l_value.v[0];
01121 # endif
01122 break;
01123 }
01124
01125 if (TYP_TYPE(l_type_idx) == Typeless) {
01126 for (i = 0;i < (TYP_BIT_LEN(l_type_idx)/TARGET_BITS_PER_WORD);i++) {
01127 result[i] = l_value.v[i];
01128 }
01129 break;
01130 }
01131
01132 if (l_linear_type == res_linear_type) {
01133 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01134 result[i] = l_value.v[i];
01135 }
01136 break;
01137 }
01138
01139 # if defined(_USE_FOLD_DOT_f)
01140 tmp_opr = Cvrt_Opr;
01141 FOLD_OP(
01142 &tmp_opr,
01143 &loc_result.v,
01144 &res_linear_type,
01145 &l_value.v,
01146 &l_linear_type,
01147 &r_value.v,
01148 &r_linear_type,
01149 &a3_value.v,
01150 &a3_linear_type);
01151 # else
01152 arith_type = linear_to_arith[l_linear_type];
01153
01154 if ((TYP_TYPE(l_type_idx) == Real ||
01155 TYP_TYPE(l_type_idx) == Complex) &&
01156 TYP_TYPE((*res_type_idx)) == Integer) {
01157
01158
01159
01160 switch(linear_to_arith[l_linear_type]) {
01161 case AR_Float_IEEE_NR_32 :
01162 arith_type = AR_Float_IEEE_ZE_32;
01163 break;
01164
01165 case AR_Float_IEEE_NR_64 :
01166 arith_type = AR_Float_IEEE_ZE_64;
01167 break;
01168
01169 case AR_Float_IEEE_NR_128 :
01170 arith_type = AR_Float_IEEE_ZE_128;
01171 break;
01172
01173 case AR_Complex_IEEE_NR_32 :
01174 arith_type = AR_Complex_IEEE_ZE_32;
01175 break;
01176
01177 case AR_Complex_IEEE_NR_64 :
01178 arith_type = AR_Complex_IEEE_ZE_64;
01179 break;
01180
01181 case AR_Complex_IEEE_NR_128 :
01182 arith_type = AR_Complex_IEEE_ZE_128;
01183 break;
01184
01185 }
01186 }
01187
01188 SHIFT_ARITH_ARG(l_value.v, l_linear_type);
01189
01190 mask = AR_convert((AR_DATA *)loc_result.v,
01191 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01192 (const AR_DATA *)l_value.v,
01193 (const AR_TYPE *)&arith_type);
01194 # endif
01195
01196 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01197 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01198
01199 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01200 result[i] = loc_result.v[i];
01201 }
01202 break;
01203
01204
01205 case Cvrt_Unsigned_Opr :
01206 SHIFT_ARITH_ARG(l_value.v, l_linear_type);
01207
01208 arith_type = linear_to_arith[res_linear_type];
01209 arith_type_l = linear_to_arith[l_linear_type];
01210
01211 # if defined(_TARGET_OS_MAX) || defined(_TARGET_OS_SOLARIS) || \
01212 (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
01213
01214 if (TYP_TYPE((*res_type_idx)) == Integer) {
01215 arith_type = input_arith_type[res_linear_type];
01216 }
01217
01218 if (arith_type_l == AR_Int_32_S) {
01219 arith_type_l = AR_Int_32_U;
01220 }
01221 else if (arith_type_l == AR_Int_64_S) {
01222 arith_type_l = AR_Int_64_U;
01223 }
01224 # endif
01225
01226 # if defined(_USE_FOLD_DOT_f)
01227 tmp_opr = Cvrt_Opr;
01228 FOLD_OP(
01229 &tmp_opr,
01230 &loc_result.v,
01231 &res_linear_type,
01232 &l_value.v,
01233 &l_linear_type,
01234 &r_value.v,
01235 &r_linear_type,
01236 &a3_value.v,
01237 &a3_linear_type);
01238 # else
01239 mask = AR_convert((AR_DATA *)loc_result.v,
01240 (const AR_TYPE *)&arith_type,
01241 (const AR_DATA *)l_value.v,
01242 (const AR_TYPE *)&arith_type_l);
01243 # endif
01244
01245 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01246 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01247
01248 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01249 result[i] = loc_result.v[i];
01250 }
01251 break;
01252
01253
01254 case Power_Opr :
01255 if (l_linear_type != res_linear_type &&
01256 TYP_TYPE(l_type_idx) != Typeless) {
01257
01258 SHIFT_ARITH_ARG(l_value.v, l_linear_type);
01259
01260 # if defined(_USE_FOLD_DOT_f)
01261 tmp_opr = Cvrt_Opr;
01262 FOLD_OP(
01263 &tmp_opr,
01264 &loc_result.v,
01265 &res_linear_type,
01266 &l_value.v,
01267 &l_linear_type,
01268 &r_value.v,
01269 &r_linear_type,
01270 &a3_value.v,
01271 &a3_linear_type);
01272 # else
01273 mask = AR_convert((AR_DATA *)loc_result.v,
01274 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01275 (const AR_DATA *)l_value.v,
01276 (const AR_TYPE *)&linear_to_arith[l_linear_type]);
01277 # endif
01278 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01279 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01280
01281 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01282 l_value.v[i] = loc_result.v[i];
01283 }
01284 }
01285
01286 if (r_linear_type != res_linear_type &&
01287 TYP_TYPE(r_type_idx) == Integer &&
01288 TYP_TYPE((*res_type_idx)) == Integer) {
01289
01290 SHIFT_ARITH_ARG(r_value.v, r_linear_type);
01291
01292 # if defined(_USE_FOLD_DOT_f)
01293 tmp_opr = Cvrt_Opr;
01294 FOLD_OP(
01295 &tmp_opr,
01296 &loc_result.v,
01297 &res_linear_type,
01298 &r_value.v,
01299 &r_linear_type,
01300 &r_value.v,
01301 &r_linear_type,
01302 &a3_value.v,
01303 &a3_linear_type);
01304 # else
01305 mask = AR_convert((AR_DATA *)loc_result.v,
01306 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01307 (const AR_DATA *)r_value.v,
01308 (const AR_TYPE *)&linear_to_arith[r_linear_type]);
01309 # endif
01310
01311 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01312 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01313
01314 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01315 r_value.v[i] = loc_result.v[i];
01316 }
01317
01318 r_linear_type = res_linear_type;
01319 }
01320 else if (r_linear_type != res_linear_type &&
01321 TYP_TYPE(r_type_idx) != Integer &&
01322 TYP_TYPE(r_type_idx) != Typeless) {
01323
01324 SHIFT_ARITH_ARG(r_value.v, r_linear_type);
01325
01326 # if defined(_USE_FOLD_DOT_f)
01327 tmp_opr = Cvrt_Opr;
01328 FOLD_OP(
01329 &tmp_opr,
01330 &loc_result.v,
01331 &res_linear_type,
01332 &r_value.v,
01333 &r_linear_type,
01334 &r_value.v,
01335 &r_linear_type,
01336 &a3_value.v,
01337 &a3_linear_type);
01338 # else
01339 mask = AR_convert((AR_DATA *)loc_result.v,
01340 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01341 (const AR_DATA *)r_value.v,
01342 (const AR_TYPE *)&linear_to_arith[r_linear_type]);
01343 # endif
01344
01345 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01346 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01347
01348 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01349 r_value.v[i] = loc_result.v[i];
01350 }
01351
01352 r_linear_type = res_linear_type;
01353 }
01354
01355 SHIFT_ARITH_ARG(l_value.v, res_linear_type);
01356 SHIFT_ARITH_ARG(r_value.v, r_linear_type);
01357
01358 # if defined(_USE_FOLD_DOT_f)
01359 FOLD_OP(
01360 &opr,
01361 &loc_result.v,
01362 &res_linear_type,
01363 &l_value.v,
01364 &res_linear_type,
01365 &r_value.v,
01366 &r_linear_type,
01367 &a3_value.v,
01368 &a3_linear_type);
01369 # else
01370 mask = AR_power((AR_DATA *)loc_result.v,
01371 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01372 (const AR_DATA *)l_value.v,
01373 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01374 (const AR_DATA *)r_value.v,
01375 (const AR_TYPE *)&linear_to_arith[r_linear_type]);
01376 # endif
01377
01378 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01379 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01380
01381 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01382 result[i] = loc_result.v[i];
01383 }
01384 break;
01385
01386
01387 case Mult_Opr :
01388 case Div_Opr :
01389 case Real_Div_To_Int_Opr:
01390 case Minus_Opr :
01391 case Plus_Opr :
01392 case Mod_Opr :
01393 case Modulo_Opr :
01394 if (l_linear_type != res_linear_type &&
01395 TYP_TYPE(l_type_idx) != Typeless) {
01396
01397 SHIFT_ARITH_ARG(l_value.v, l_linear_type);
01398
01399 # if defined(_USE_FOLD_DOT_f)
01400 tmp_opr = Cvrt_Opr;
01401 FOLD_OP(
01402 &tmp_opr,
01403 &loc_result.v,
01404 &res_linear_type,
01405 &l_value.v,
01406 &l_linear_type,
01407 &r_value.v,
01408 &r_linear_type,
01409 &a3_value.v,
01410 &a3_linear_type);
01411 # else
01412 mask = AR_convert((AR_DATA *)loc_result.v,
01413 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01414 (const AR_DATA *)l_value.v,
01415 (const AR_TYPE *)&linear_to_arith[l_linear_type]);
01416 # endif
01417
01418 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01419 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01420
01421 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01422 l_value.v[i] = loc_result.v[i];
01423 }
01424 }
01425
01426 if (r_linear_type != res_linear_type &&
01427 TYP_TYPE(r_type_idx) != Typeless) {
01428
01429 SHIFT_ARITH_ARG(r_value.v, r_linear_type);
01430
01431 # if defined(_USE_FOLD_DOT_f)
01432 tmp_opr = Cvrt_Opr;
01433 FOLD_OP(
01434 &tmp_opr,
01435 &loc_result.v,
01436 &res_linear_type,
01437 &r_value.v,
01438 &r_linear_type,
01439 &r_value.v,
01440 &r_linear_type,
01441 &a3_value.v,
01442 &a3_linear_type);
01443 # else
01444 mask = AR_convert((AR_DATA *)loc_result.v,
01445 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01446 (const AR_DATA *)r_value.v,
01447 (const AR_TYPE *)&linear_to_arith[r_linear_type]);
01448 # endif
01449
01450 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01451 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01452
01453 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01454 r_value.v[i] = loc_result.v[i];
01455 }
01456 }
01457
01458 SHIFT_ARITH_ARG(l_value.v, res_linear_type);
01459 SHIFT_ARITH_ARG(r_value.v, res_linear_type);
01460
01461 # if defined(_USE_FOLD_DOT_f)
01462 FOLD_OP(
01463 &opr,
01464 &loc_result.v,
01465 &res_linear_type,
01466 &l_value.v,
01467 &res_linear_type,
01468 &r_value.v,
01469 &res_linear_type,
01470 &a3_value.v,
01471 &a3_linear_type);
01472 # else
01473 switch (opr) {
01474 case Mult_Opr:
01475 mask = AR_multiply((AR_DATA *)loc_result.v,
01476 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01477 (const AR_DATA *)l_value.v,
01478 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01479 (const AR_DATA *)r_value.v,
01480 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
01481 break;
01482
01483 case Div_Opr :
01484 mask = AR_divide((AR_DATA *)loc_result.v,
01485 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01486 (const AR_DATA *)l_value.v,
01487 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01488 (const AR_DATA *)r_value.v,
01489 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
01490 break;
01491
01492 case Real_Div_To_Int_Opr :
01493 mask = AR_divide((AR_DATA *)loc_result.v,
01494 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01495 (const AR_DATA *)l_value.v,
01496 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01497 (const AR_DATA *)r_value.v,
01498 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
01499
01500 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01501
01502 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01503 r_value.v[i] = loc_result.v[i];
01504 }
01505
01506 mask = AR_round_int_div((AR_DATA *)loc_result.v,
01507 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01508 (const AR_DATA *)r_value.v,
01509 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
01510 break;
01511
01512 case Minus_Opr :
01513 mask = AR_subtract((AR_DATA *)loc_result.v,
01514 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01515 (const AR_DATA *)l_value.v,
01516 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01517 (const AR_DATA *)r_value.v,
01518 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
01519 break;
01520
01521 case Plus_Opr :
01522 mask = AR_add((AR_DATA *)loc_result.v,
01523 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01524 (const AR_DATA *)l_value.v,
01525 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01526 (const AR_DATA *)r_value.v,
01527 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
01528 break;
01529
01530 case Modulo_Opr :
01531 mask = AR_Modulo((AR_DATA *)loc_result.v,
01532 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01533 (const AR_DATA *)l_value.v,
01534 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01535 (const AR_DATA *)r_value.v,
01536 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
01537 break;
01538
01539 case Mod_Opr :
01540 mask = AR_mod((AR_DATA *)loc_result.v,
01541 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01542 (const AR_DATA *)l_value.v,
01543 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01544 (const AR_DATA *)r_value.v,
01545 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
01546 break;
01547
01548 }
01549 # endif
01550
01551 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01552 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01553
01554 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01555 result[i] = loc_result.v[i];
01556 }
01557 break;
01558
01559
01560 case Eq_Opr :
01561 case Ne_Opr :
01562 case Lt_Opr :
01563 case Le_Opr :
01564 case Gt_Opr :
01565 case Ge_Opr :
01566 if (TYP_TYPE(l_type_idx) == Character &&
01567 TYP_TYPE(r_type_idx) == Character) {
01568 f90_character_compare(l_value_ptr,
01569 CN_INT_TO_C(TYP_IDX(l_type_idx)),
01570 r_value_ptr,
01571 CN_INT_TO_C(TYP_IDX(r_type_idx)),
01572 opr,
01573 result,
01574 (*res_type_idx));
01575 }
01576 else {
01577 res_linear_type = (linear_type_type)
01578 bin_add_tbl[l_linear_type][r_linear_type].type;
01579
01580 if (l_linear_type != res_linear_type &&
01581 TYP_TYPE(l_type_idx) != Typeless) {
01582
01583 SHIFT_ARITH_ARG(l_value.v, l_linear_type);
01584
01585 # if defined(_USE_FOLD_DOT_f)
01586 tmp_opr = Cvrt_Opr;
01587 FOLD_OP(
01588 &tmp_opr,
01589 &loc_result.v,
01590 &res_linear_type,
01591 &l_value.v,
01592 &l_linear_type,
01593 &r_value.v,
01594 &r_linear_type,
01595 &a3_value.v,
01596 &a3_linear_type);
01597 # else
01598 mask = AR_convert((AR_DATA *)loc_result.v,
01599 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01600 (const AR_DATA *)l_value.v,
01601 (const AR_TYPE *)&linear_to_arith[l_linear_type]);
01602 # endif
01603
01604 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01605 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01606
01607 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01608 l_value.v[i] = loc_result.v[i];
01609 }
01610 }
01611
01612 if (r_linear_type != res_linear_type &&
01613 TYP_TYPE(r_type_idx) != Typeless) {
01614
01615 SHIFT_ARITH_ARG(r_value.v, r_linear_type);
01616
01617 # if defined(_USE_FOLD_DOT_f)
01618 tmp_opr = Cvrt_Opr;
01619 FOLD_OP(
01620 &tmp_opr,
01621 &loc_result.v,
01622 &res_linear_type,
01623 &r_value.v,
01624 &r_linear_type,
01625 &r_value.v,
01626 &r_linear_type,
01627 &a3_value.v,
01628 &a3_linear_type);
01629 # else
01630 mask = AR_convert((AR_DATA *)loc_result.v,
01631 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01632 (const AR_DATA *)r_value.v,
01633 (const AR_TYPE *)&linear_to_arith[r_linear_type]);
01634 # endif
01635
01636 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01637 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01638
01639 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01640 r_value.v[i] = loc_result.v[i];
01641 }
01642 }
01643
01644 # if defined(_USE_FOLD_DOT_f)
01645 FOLD_OP(
01646 &opr,
01647 &loc_result.v,
01648 &res_linear_type,
01649 &l_value.v,
01650 &res_linear_type,
01651 &r_value.v,
01652 &res_linear_type,
01653 &a3_value.v,
01654 &a3_linear_type);
01655
01656 if (loc_result.v[0] == 0) {
01657 set_up_logical_constant(result,
01658 (*res_type_idx),
01659 FALSE_VALUE,
01660 FALSE);
01661 }
01662 else {
01663 set_up_logical_constant(result,
01664 (*res_type_idx),
01665 TRUE_VALUE,
01666 FALSE);
01667 }
01668 # else
01669 SHIFT_ARITH_ARG(l_value.v, res_linear_type);
01670 SHIFT_ARITH_ARG(r_value.v, res_linear_type);
01671
01672 comp_res = AR_compare((const AR_DATA *)l_value.v,
01673 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01674 (const AR_DATA *)r_value.v,
01675 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
01676
01677 switch (opr) {
01678 case Eq_Opr :
01679 if (comp_res == AR_Compare_EQ) {
01680 set_up_logical_constant(result, (*res_type_idx), TRUE_VALUE,
01681 FALSE);
01682 }
01683 else {
01684 set_up_logical_constant(result, (*res_type_idx), FALSE_VALUE,
01685 FALSE);
01686 }
01687 break;
01688
01689 case Ne_Opr :
01690 if (comp_res != AR_Compare_EQ) {
01691 set_up_logical_constant(result, (*res_type_idx), TRUE_VALUE,
01692 FALSE);
01693 }
01694 else {
01695 set_up_logical_constant(result, (*res_type_idx), FALSE_VALUE,
01696 FALSE);
01697 }
01698 break;
01699
01700 case Lt_Opr :
01701 if (comp_res == AR_Compare_LT) {
01702 set_up_logical_constant(result, (*res_type_idx), TRUE_VALUE,
01703 FALSE);
01704 }
01705 else {
01706 set_up_logical_constant(result, (*res_type_idx), FALSE_VALUE,
01707 FALSE);
01708 }
01709 break;
01710
01711 case Le_Opr :
01712 if (comp_res != AR_Compare_GT) {
01713 set_up_logical_constant(result, (*res_type_idx), TRUE_VALUE,
01714 FALSE);
01715 }
01716 else {
01717 set_up_logical_constant(result, (*res_type_idx), FALSE_VALUE,
01718 FALSE);
01719 }
01720 break;
01721
01722 case Gt_Opr :
01723 if (comp_res == AR_Compare_GT) {
01724 set_up_logical_constant(result, (*res_type_idx), TRUE_VALUE,
01725 FALSE);
01726 }
01727 else {
01728 set_up_logical_constant(result, (*res_type_idx), FALSE_VALUE,
01729 FALSE);
01730 }
01731 break;
01732
01733 case Ge_Opr :
01734 if (comp_res != AR_Compare_LT) {
01735 set_up_logical_constant(result, (*res_type_idx), TRUE_VALUE,
01736 FALSE);
01737 }
01738 else {
01739 set_up_logical_constant(result, (*res_type_idx), FALSE_VALUE,
01740 FALSE);
01741 }
01742 break;
01743 }
01744 # endif
01745
01746 res_linear_type = TYP_LINEAR(*res_type_idx);
01747 }
01748 break;
01749
01750
01751 case Not_Opr :
01752 if (THIS_IS_TRUE(l_value.v, l_type_idx)) {
01753 set_up_logical_constant(result, (*res_type_idx), FALSE_VALUE,FALSE);
01754 }
01755 else {
01756 set_up_logical_constant(result, (*res_type_idx), TRUE_VALUE, FALSE);
01757 }
01758 break;
01759
01760
01761 case And_Opr :
01762 if (THIS_IS_TRUE(l_value.v, l_type_idx) &&
01763 THIS_IS_TRUE(r_value.v, r_type_idx)) {
01764 set_up_logical_constant(result, (*res_type_idx), TRUE_VALUE, FALSE);
01765 }
01766 else {
01767 set_up_logical_constant(result, (*res_type_idx), FALSE_VALUE,FALSE);
01768 }
01769 break;
01770
01771
01772 case Or_Opr :
01773 if (THIS_IS_TRUE(l_value.v, l_type_idx) ||
01774 THIS_IS_TRUE(r_value.v, r_type_idx)) {
01775 set_up_logical_constant(result, (*res_type_idx), TRUE_VALUE, FALSE);
01776 }
01777 else {
01778 set_up_logical_constant(result, (*res_type_idx), FALSE_VALUE,FALSE);
01779 }
01780 break;
01781
01782
01783 case Eqv_Opr :
01784 if ((THIS_IS_TRUE(l_value.v, l_type_idx)) ==
01785 (THIS_IS_TRUE(r_value.v, r_type_idx))) {
01786 set_up_logical_constant(result, (*res_type_idx), TRUE_VALUE, FALSE);
01787 }
01788 else {
01789 set_up_logical_constant(result, (*res_type_idx), FALSE_VALUE,FALSE);
01790 }
01791 break;
01792
01793
01794 case Neqv_Opr :
01795 if ((THIS_IS_TRUE(l_value.v, l_type_idx)) !=
01796 (THIS_IS_TRUE(r_value.v, r_type_idx))) {
01797 set_up_logical_constant(result, (*res_type_idx), TRUE_VALUE, FALSE);
01798 }
01799 else {
01800 set_up_logical_constant(result, (*res_type_idx), FALSE_VALUE,FALSE);
01801 }
01802 break;
01803
01804
01805 case Bnot_Opr :
01806 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01807 result[i] = ~l_value.v[i];
01808 }
01809 break;
01810
01811
01812 case Band_Opr :
01813 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01814 result[i] = l_value.v[i] & r_value.v[i];
01815 }
01816 break;
01817
01818
01819 case Bor_Opr :
01820 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01821 result[i] = l_value.v[i] | r_value.v[i];
01822 }
01823 break;
01824
01825
01826 case Bneqv_Opr :
01827 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01828 result[i] = l_value.v[i] ^ r_value.v[i];
01829 }
01830 break;
01831
01832
01833 case Beqv_Opr :
01834 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01835 result[i] = ~(l_value.v[i] ^ r_value.v[i]);
01836 }
01837 break;
01838
01839
01840 # if defined(_USE_FOLD_DOT_f)
01841 case Sqrt_Opr :
01842 SHIFT_ARITH_ARG(l_value.v, res_linear_type);
01843
01844 FOLD_OP(
01845 &opr,
01846 &loc_result.v,
01847 &res_linear_type,
01848 &l_value.v,
01849 &res_linear_type,
01850 &r_value.v,
01851 &res_linear_type,
01852 &a3_value.v,
01853 &a3_linear_type);
01854
01855 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01856 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01857
01858 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01859 result[i] = loc_result.v[i];
01860 }
01861 break;
01862 # endif
01863
01864
01865 case Abs_Opr :
01866 SHIFT_ARITH_ARG(l_value.v, res_linear_type);
01867
01868 # if defined(_USE_FOLD_DOT_f)
01869 FOLD_OP(
01870 &opr,
01871 &loc_result.v,
01872 &res_linear_type,
01873 &l_value.v,
01874 &res_linear_type,
01875 &r_value.v,
01876 &res_linear_type,
01877 &a3_value.v,
01878 &a3_linear_type);
01879 # else
01880 mask = AR_abs((AR_DATA *)loc_result.v,
01881 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01882 (const AR_DATA *)l_value.v,
01883 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
01884 # endif
01885
01886 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01887 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
01888
01889 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01890 result[i] = loc_result.v[i];
01891 }
01892 break;
01893
01894
01895 case Nint_Opr :
01896 # if defined(_USE_FOLD_DOT_f)
01897 FOLD_OP(
01898 &opr,
01899 &loc_result.v,
01900 &res_linear_type,
01901 &l_value.v,
01902 &l_linear_type,
01903 &r_value.v,
01904 &r_linear_type,
01905 &a3_value.v,
01906 &a3_linear_type);
01907
01908 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
01909 result[i] = loc_result.v[i];
01910 }
01911 # else
01912 strcpy(char_buf, "0.5");
01913 mask = AR_convert_str_to_float((AR_DATA *)a3_value.v,
01914 (const AR_TYPE *)&input_arith_type[l_linear_type],
01915 (const char *)char_buf);
01916 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01917 SHIFT_ARITH_RESULT(a3_value.v, l_linear_type);
01918
01919 type_idx = CG_LOGICAL_DEFAULT_TYPE;
01920
01921 ok &= folder_driver((char *)l_value.v,
01922 l_type_idx,
01923 (char *)&CN_CONST(CN_INTEGER_ZERO_IDX),
01924 CG_INTEGER_DEFAULT_TYPE,
01925 a4_value.v,
01926 &type_idx,
01927 line,
01928 col,
01929 2,
01930 Le_Opr);
01931
01932 if (THIS_IS_TRUE(a4_value.v,type_idx)) {
01933 type_idx = l_type_idx;
01934 ok &= folder_driver((char *)l_value.v,
01935 l_type_idx,
01936 (char *)a3_value.v,
01937 l_type_idx,
01938 a4_value.v,
01939 &type_idx,
01940 line,
01941 col,
01942 2,
01943 Minus_Opr);
01944 }
01945 else {
01946 type_idx = l_type_idx;
01947 ok &= folder_driver((char *)l_value.v,
01948 l_type_idx,
01949 (char *)a3_value.v,
01950 l_type_idx,
01951 a4_value.v,
01952 &type_idx,
01953 line,
01954 col,
01955 2,
01956 Plus_Opr);
01957 }
01958
01959 ok &= folder_driver((char *)a4_value.v,
01960 l_type_idx,
01961 NULL,
01962 NULL_IDX,
01963 result,
01964 res_type_idx,
01965 line,
01966 col,
01967 1,
01968 Int_Opr);
01969 # endif
01970 break;
01971
01972
01973 case Sign_Opr :
01974 SHIFT_ARITH_ARG(l_value.v, res_linear_type);
01975
01976 # if defined(_USE_FOLD_DOT_f)
01977 tmp_opr = Abs_Opr;
01978 FOLD_OP(
01979 &tmp_opr,
01980 &a3_value.v,
01981 &res_linear_type,
01982 &l_value.v,
01983 &res_linear_type,
01984 &r_value.v,
01985 &r_linear_type,
01986 &a3_value.v,
01987 &a3_linear_type);
01988 # else
01989 mask = AR_abs((AR_DATA *)a3_value.v,
01990 (const AR_TYPE *)&linear_to_arith[res_linear_type],
01991 (const AR_DATA *)l_value.v,
01992 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
01993 # endif
01994
01995 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
01996 SHIFT_ARITH_RESULT(a3_value.v, res_linear_type);
01997
01998 type_idx = CG_LOGICAL_DEFAULT_TYPE;
01999
02000 ok &= folder_driver((char *)r_value.v,
02001 r_type_idx,
02002 (char *)&CN_CONST(CN_INTEGER_ZERO_IDX),
02003 CG_INTEGER_DEFAULT_TYPE,
02004 a4_value.v,
02005 &type_idx,
02006 line,
02007 col,
02008 2,
02009 Lt_Opr);
02010
02011 if (THIS_IS_TRUE(a4_value.v, type_idx)) {
02012
02013 SHIFT_ARITH_ARG(a3_value.v, res_linear_type);
02014
02015 # if defined(_USE_FOLD_DOT_f)
02016 tmp_opr = Uminus_Opr;
02017 FOLD_OP(
02018 &tmp_opr,
02019 &loc_result.v,
02020 &res_linear_type,
02021 &a3_value.v,
02022 &res_linear_type,
02023 &r_value.v,
02024 &r_linear_type,
02025 &a3_value.v,
02026 &a3_linear_type);
02027 # else
02028 mask = AR_negate((AR_DATA *)loc_result.v,
02029 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02030 (const AR_DATA *)a3_value.v,
02031 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
02032 # endif
02033
02034 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02035 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
02036
02037 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02038 result[i] = loc_result.v[i];
02039 }
02040 }
02041 else {
02042 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02043 result[i] = a3_value.v[i];
02044 }
02045 }
02046 break;
02047
02048
02049
02050
02051 case Shift_Opr :
02052
02053
02054
02055 # if defined(_USE_FOLD_DOT_f)
02056 FOLD_OP(
02057 &opr,
02058 &loc_result.v,
02059 &res_linear_type,
02060 &l_value.v,
02061 &l_linear_type,
02062 &r_value.v,
02063 &r_linear_type,
02064 &a3_value.v,
02065 &a3_linear_type);
02066
02067 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02068 result[i] = loc_result.v[i];
02069 }
02070
02071 break;
02072 # endif
02073
02074
02075
02076 a4_value.v[0] = TARGET_BITS_PER_WORD;
02077 # ifdef _TARGET32
02078 if (num_host_wds[res_linear_type] != 1) {
02079 a4_value.v[1] = 2 * TARGET_BITS_PER_WORD;
02080 a4_value.v[0] = 0;
02081 }
02082 # endif
02083
02084
02085 SHIFT_ARITH_ARG(r_value.v, res_linear_type);
02086 SHIFT_ARITH_ARG(a4_value.v, res_linear_type);
02087
02088 mask = AR_mod((AR_DATA *)a3_value.v,
02089 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02090 (const AR_DATA *)r_value.v,
02091 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02092 (const AR_DATA *)a4_value.v,
02093 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
02094
02095 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02096
02097 a4_value.v[0] = 0;
02098 a4_value.v[1] = 0;
02099 a4_value.v[2] = 0;
02100 a4_value.v[3] = 0;
02101
02102 SHIFT_ARITH_ARG(l_value.v, res_linear_type);
02103
02104 if ((mask & AR_STAT_NEGATIVE) != 0) {
02105
02106 mask = AR_negate((AR_DATA *)loc_result.v,
02107 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02108 (const AR_DATA *)a3_value.v,
02109 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
02110
02111 for (i = 0; i < 4; i++) {
02112 a3_value.v[i] = loc_result.v[i];
02113 }
02114
02115 mask = AR_dshiftr((AR_DATA *)r_value.v,
02116 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02117 (const AR_DATA *)l_value.v,
02118 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02119 (const AR_DATA *)a4_value.v,
02120 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02121 (const AR_DATA *)a3_value.v,
02122 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
02123
02124 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02125
02126 mask = AR_shiftr((AR_DATA *)loc_result.v,
02127 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02128 (const AR_DATA *)l_value.v,
02129 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02130 (const AR_DATA *)a3_value.v,
02131 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
02132
02133 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02134 }
02135 else {
02136 mask = AR_dshiftl((AR_DATA *)r_value.v,
02137 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02138 (const AR_DATA *)a4_value.v,
02139 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02140 (const AR_DATA *)l_value.v,
02141 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02142 (const AR_DATA *)a3_value.v,
02143 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
02144
02145 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02146
02147 mask = AR_shiftl((AR_DATA *)loc_result.v,
02148 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02149 (const AR_DATA *)l_value.v,
02150 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02151 (const AR_DATA *)a3_value.v,
02152 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
02153
02154 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02155 }
02156
02157 SHIFT_ARITH_RESULT(r_value.v, res_linear_type);
02158 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
02159 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02160 loc_result.v[i] |= r_value.v[i];
02161 }
02162
02163 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02164 result[i] = loc_result.v[i];
02165 }
02166 break;
02167
02168
02169
02170 case Ishftc_Opr :
02171 case Ibits_Opr :
02172 if (l_linear_type != res_linear_type &&
02173 TYP_TYPE(l_type_idx) != Typeless) {
02174
02175 SHIFT_ARITH_ARG(l_value.v, l_linear_type);
02176
02177 # if defined(_USE_FOLD_DOT_f)
02178 tmp_opr = Cvrt_Opr;
02179 FOLD_OP(
02180 &tmp_opr,
02181 &loc_result.v,
02182 &res_linear_type,
02183 &l_value.v,
02184 &l_linear_type,
02185 &r_value.v,
02186 &r_linear_type,
02187 &a3_value.v,
02188 &a3_linear_type);
02189 # else
02190 mask = AR_convert((AR_DATA *)loc_result.v,
02191 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02192 (const AR_DATA *)l_value.v,
02193 (const AR_TYPE *)&linear_to_arith[l_linear_type]);
02194 # endif
02195
02196 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02197 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
02198
02199 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02200 l_value.v[i] = loc_result.v[i];
02201 }
02202 }
02203
02204 if (r_linear_type != res_linear_type &&
02205 TYP_TYPE(r_type_idx) != Typeless) {
02206
02207 SHIFT_ARITH_ARG(r_value.v, r_linear_type);
02208
02209 # if defined(_USE_FOLD_DOT_f)
02210 tmp_opr = Cvrt_Opr;
02211 FOLD_OP(
02212 &tmp_opr,
02213 &loc_result.v,
02214 &res_linear_type,
02215 &r_value.v,
02216 &r_linear_type,
02217 &r_value.v,
02218 &r_linear_type,
02219 &a3_value.v,
02220 &a3_linear_type);
02221 # else
02222 mask = AR_convert((AR_DATA *)loc_result.v,
02223 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02224 (const AR_DATA *)r_value.v,
02225 (const AR_TYPE *)&linear_to_arith[r_linear_type]);
02226 # endif
02227
02228 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02229 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
02230
02231 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02232 r_value.v[i] = loc_result.v[i];
02233 }
02234 }
02235
02236 if (a3_linear_type != res_linear_type &&
02237 TYP_TYPE(a3_type_idx) != Typeless) {
02238
02239 SHIFT_ARITH_ARG(a3_value.v, a3_linear_type);
02240
02241 # if defined(_USE_FOLD_DOT_f)
02242 tmp_opr = Cvrt_Opr;
02243 FOLD_OP(
02244 &tmp_opr,
02245 &loc_result.v,
02246 &res_linear_type,
02247 &a3_value.v,
02248 &a3_linear_type,
02249 &r_value.v,
02250 &r_linear_type,
02251 &a3_value.v,
02252 &a3_linear_type);
02253 # else
02254 mask = AR_convert((AR_DATA *)loc_result.v,
02255 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02256 (const AR_DATA *)a3_value.v,
02257 (const AR_TYPE *)&linear_to_arith[a3_linear_type]);
02258 # endif
02259
02260 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02261 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
02262
02263 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02264 a3_value.v[i] = loc_result.v[i];
02265 }
02266 }
02267
02268 SHIFT_ARITH_ARG(l_value.v, res_linear_type);
02269 SHIFT_ARITH_ARG(r_value.v, res_linear_type);
02270 SHIFT_ARITH_ARG(a3_value.v, res_linear_type);
02271
02272 # if defined(_USE_FOLD_DOT_f)
02273 FOLD_OP(
02274 &opr,
02275 &loc_result.v,
02276 &res_linear_type,
02277 &l_value.v,
02278 &res_linear_type,
02279 &r_value.v,
02280 &res_linear_type,
02281 &a3_value.v,
02282 &res_linear_type);
02283 # else
02284 if (opr == Ibits_Opr) {
02285 mask = AR_ibits((AR_DATA *)loc_result.v,
02286 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02287 (const AR_DATA *)l_value.v,
02288 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02289 (const AR_DATA *)r_value.v,
02290 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02291 (const AR_DATA *)a3_value.v,
02292 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
02293 }
02294 else {
02295 mask = AR_ishftc((AR_DATA *)loc_result.v,
02296 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02297 (const AR_DATA *)l_value.v,
02298 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02299 (const AR_DATA *)r_value.v,
02300 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02301 (const AR_DATA *)a3_value.v,
02302 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
02303 }
02304
02305
02306
02307 if ((mask & AR_STAT_INVALID_TYPE) != 0) {
02308 PRINTMSG(line, 1079, Internal, col);
02309 }
02310 # endif
02311
02312 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
02313
02314 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02315 result[i] = loc_result.v[i];
02316 }
02317 break;
02318
02319
02320 case Shiftl_Opr :
02321 case Shiftr_Opr :
02322 case Shifta_Opr :
02323 if (l_linear_type != res_linear_type &&
02324 TYP_TYPE(l_type_idx) != Typeless) {
02325
02326 SHIFT_ARITH_ARG(l_value.v, l_linear_type);
02327
02328 # if defined(_USE_FOLD_DOT_f)
02329 tmp_opr = Cvrt_Opr;
02330 FOLD_OP(
02331 &tmp_opr,
02332 &loc_result.v,
02333 &res_linear_type,
02334 &l_value.v,
02335 &l_linear_type,
02336 &r_value.v,
02337 &r_linear_type,
02338 &a3_value.v,
02339 &a3_linear_type);
02340 # else
02341 mask = AR_convert((AR_DATA *)loc_result.v,
02342 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02343 (const AR_DATA *)l_value.v,
02344 (const AR_TYPE *)&linear_to_arith[l_linear_type]);
02345 # endif
02346
02347 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02348 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
02349
02350 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02351 l_value.v[i] = loc_result.v[i];
02352 }
02353 }
02354
02355 if (r_linear_type != res_linear_type &&
02356 TYP_TYPE(r_type_idx) != Typeless) {
02357
02358 SHIFT_ARITH_ARG(r_value.v, r_linear_type);
02359
02360 # if defined(_USE_FOLD_DOT_f)
02361 tmp_opr = Cvrt_Opr;
02362 FOLD_OP(
02363 &tmp_opr,
02364 &loc_result.v,
02365 &res_linear_type,
02366 &r_value.v,
02367 &r_linear_type,
02368 &r_value.v,
02369 &r_linear_type,
02370 &a3_value.v,
02371 &a3_linear_type);
02372 # else
02373 mask = AR_convert((AR_DATA *)loc_result.v,
02374 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02375 (const AR_DATA *)r_value.v,
02376 (const AR_TYPE *)&linear_to_arith[r_linear_type]);
02377 # endif
02378
02379 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02380 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
02381
02382 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02383 r_value.v[i] = loc_result.v[i];
02384 }
02385 }
02386
02387 SHIFT_ARITH_ARG(l_value.v, res_linear_type);
02388 SHIFT_ARITH_ARG(r_value.v, res_linear_type);
02389
02390 arith_type = linear_to_arith[res_linear_type];
02391
02392 if (opr != Shifta_Opr) {
02393 if (arith_type == AR_Int_32_S) {
02394 arith_type = AR_Int_32_U;
02395 }
02396 else if (arith_type == AR_Int_64_S) {
02397 arith_type = AR_Int_64_U;
02398 }
02399 }
02400
02401 # if defined(_USE_FOLD_DOT_f)
02402 FOLD_OP(
02403 &opr,
02404 &loc_result.v,
02405 &res_linear_type,
02406 &l_value.v,
02407 &res_linear_type,
02408 &r_value.v,
02409 &res_linear_type,
02410 &a3_value.v,
02411 &a3_linear_type);
02412 # else
02413 switch (opr) {
02414 case Shiftl_Opr :
02415 mask = AR_shiftl((AR_DATA *)loc_result.v,
02416 (const AR_TYPE *)&arith_type,
02417 (const AR_DATA *)l_value.v,
02418 (const AR_TYPE *)&arith_type,
02419 (const AR_DATA *)r_value.v,
02420 (const AR_TYPE *)&arith_type);
02421 break;
02422
02423 case Shiftr_Opr :
02424 case Shifta_Opr :
02425 mask = AR_shiftr((AR_DATA *)loc_result.v,
02426 (const AR_TYPE *)&arith_type,
02427 (const AR_DATA *)l_value.v,
02428 (const AR_TYPE *)&arith_type,
02429 (const AR_DATA *)r_value.v,
02430 (const AR_TYPE *)&arith_type);
02431 break;
02432 }
02433
02434
02435
02436 if ((mask & AR_STAT_INVALID_TYPE) != 0) {
02437 PRINTMSG(line, 1079, Internal, col);
02438 }
02439 # endif
02440
02441 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
02442
02443 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02444 result[i] = loc_result.v[i];
02445 }
02446 break;
02447
02448
02449 case Dim_Opr :
02450 type_idx = CG_LOGICAL_DEFAULT_TYPE;
02451
02452 ok = folder_driver((char *)l_value.v,
02453 l_type_idx,
02454 (char *)r_value.v,
02455 r_type_idx,
02456 a3_value.v,
02457 &type_idx,
02458 line,
02459 col,
02460 2,
02461 Le_Opr);
02462
02463 if (THIS_IS_TRUE(a3_value.v, type_idx)) {
02464 ok &= folder_driver((char *)&CN_CONST(CN_INTEGER_ZERO_IDX),
02465 CG_INTEGER_DEFAULT_TYPE,
02466 NULL,
02467 NULL_IDX,
02468 result,
02469 res_type_idx,
02470 line,
02471 col,
02472 1,
02473 Cvrt_Opr);
02474 }
02475 else {
02476 ok = folder_driver((char *)l_value.v,
02477 l_type_idx,
02478 (char *)r_value.v,
02479 r_type_idx,
02480 a3_value.v,
02481 res_type_idx,
02482 line,
02483 col,
02484 2,
02485 Minus_Opr);
02486
02487 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02488 result[i] = a3_value.v[i];
02489 }
02490 }
02491 break;
02492
02493
02494
02495 case Ichar_Opr :
02496 result[0] = l_value_ptr[0];
02497
02498 # ifdef _TARGET32
02499 if (res_linear_type == Integer_8) {
02500 # if defined(_TARGET_LITTLE_ENDIAN)
02501
02502 result[1] = 0;
02503 # else
02504 result[1] = result[0];
02505 result[0] = 0;
02506 #endif
02507 }
02508 # endif
02509 break;
02510
02511
02512 case Char_Opr :
02513 # if defined(_TARGET_LITTLE_ENDIAN)
02514
02515
02516
02517
02518 result[0] = l_value.v[0];
02519 # else
02520
02521 # ifdef _TARGET32
02522 if (l_linear_type == Integer_8) {
02523 l_value.v[0] = l_value.v[1];
02524 }
02525 # endif
02526
02527 result[0] = l_value.v[0] << (TARGET_BITS_PER_WORD - CHAR_BIT);
02528 # endif
02529 break;
02530
02531
02532 case Index_Opr :
02533 SHIFT_ARITH_ARG(a3_value.v, a3_linear_type);
02534
02535 str1_linear_type = TYP_LINEAR(CN_TYPE_IDX(TYP_IDX(l_type_idx)));
02536 str2_linear_type = TYP_LINEAR(CN_TYPE_IDX(TYP_IDX(r_type_idx)));
02537
02538 for (i = 0;
02539 i < num_host_wds[str1_linear_type];
02540 i++) {
02541
02542 str_len1.v[i] = CP_CONSTANT(CN_POOL_IDX(TYP_IDX(l_type_idx)) + i);
02543 }
02544
02545 for (i = 0;
02546 i < num_host_wds[str2_linear_type];
02547 i++) {
02548
02549 str_len2.v[i] = CP_CONSTANT(CN_POOL_IDX(TYP_IDX(r_type_idx)) + i);
02550 }
02551
02552 # ifdef _TARGET32
02553 if (num_host_wds[str1_linear_type] != num_host_wds[res_linear_type]) {
02554 if (res_linear_type == Integer_8) {
02555 #ifndef _TARGET_LITTLE_ENDIAN
02556 str_len1.v[1] = str_len1.v[0];
02557 str_len1.v[0] = 0;
02558 #endif
02559 }
02560 else {
02561 str_len1.v[0] = str_len1.v[1];
02562 }
02563 }
02564
02565 if (num_host_wds[str2_linear_type] != num_host_wds[res_linear_type]) {
02566 if (res_linear_type == Integer_8) {
02567 #ifndef _TARGET_LITTLE_ENDIAN
02568 str_len2.v[1] = str_len2.v[0];
02569 str_len2.v[0] = 0;
02570 #endif
02571 }
02572 else {
02573 str_len2.v[0] = str_len2.v[1];
02574 }
02575 }
02576 # endif
02577
02578
02579 SHIFT_ARITH_ARG(str_len1.v, res_linear_type);
02580 SHIFT_ARITH_ARG(str_len2.v, res_linear_type);
02581
02582 mask = AR_index((AR_DATA *)loc_result.v,
02583 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02584 (const char *)l_value_ptr,
02585 (const AR_DATA *)str_len1.v,
02586 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02587 (const char *)r_value_ptr,
02588 (const AR_DATA *)str_len2.v,
02589 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02590 (const AR_DATA *)a3_value.v,
02591 (const AR_TYPE *)&linear_to_arith[a3_linear_type]);
02592
02593 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
02594
02595 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02596 result[i] = loc_result.v[i];
02597 }
02598
02599 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02600 break;
02601
02602
02603 case Scan_Opr :
02604 SHIFT_ARITH_ARG(a3_value.v, a3_linear_type);
02605
02606 str1_linear_type = TYP_LINEAR(CN_TYPE_IDX(TYP_IDX(l_type_idx)));
02607 str2_linear_type = TYP_LINEAR(CN_TYPE_IDX(TYP_IDX(r_type_idx)));
02608
02609 for (i = 0;
02610 i < num_host_wds[str1_linear_type];
02611 i++) {
02612
02613 str_len1.v[i] = CP_CONSTANT(CN_POOL_IDX(TYP_IDX(l_type_idx)) + i);
02614 }
02615
02616 for (i = 0;
02617 i < num_host_wds[str2_linear_type];
02618 i++) {
02619
02620 str_len2.v[i] = CP_CONSTANT(CN_POOL_IDX(TYP_IDX(r_type_idx)) + i);
02621 }
02622
02623 # ifdef _TARGET32
02624 if (num_host_wds[str1_linear_type] != num_host_wds[res_linear_type]) {
02625 if (res_linear_type == Integer_8) {
02626 #ifndef _TARGET_LITTLE_ENDIAN
02627 str_len1.v[1] = str_len1.v[0];
02628 str_len1.v[0] = 0;
02629 #endif
02630 }
02631 else {
02632 str_len1.v[0] = str_len1.v[1];
02633 }
02634 }
02635
02636 if (num_host_wds[str2_linear_type] != num_host_wds[res_linear_type]) {
02637 if (res_linear_type == Integer_8) {
02638 #ifndef _TARGET_LITTLE_ENDIAN
02639 str_len2.v[1] = str_len2.v[0];
02640 str_len2.v[0] = 0;
02641 #endif
02642 }
02643 else {
02644 str_len2.v[0] = str_len2.v[1];
02645 }
02646 }
02647 # endif
02648
02649
02650 SHIFT_ARITH_ARG(str_len1.v, res_linear_type);
02651 SHIFT_ARITH_ARG(str_len2.v, res_linear_type);
02652
02653 mask = AR_scan((AR_DATA *)loc_result.v,
02654 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02655 (const char *)l_value_ptr,
02656 (const AR_DATA *)str_len1.v,
02657 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02658 (const char *)r_value_ptr,
02659 (const AR_DATA *)str_len2.v,
02660 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02661 (const AR_DATA *)a3_value.v,
02662 (const AR_TYPE *)&linear_to_arith[a3_linear_type]);
02663
02664 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
02665
02666 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02667 result[i] = loc_result.v[i];
02668 }
02669
02670 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02671 break;
02672
02673
02674 case Verify_Opr :
02675 SHIFT_ARITH_ARG(a3_value.v, a3_linear_type);
02676
02677 str1_linear_type = TYP_LINEAR(CN_TYPE_IDX(TYP_IDX(l_type_idx)));
02678 str2_linear_type = TYP_LINEAR(CN_TYPE_IDX(TYP_IDX(r_type_idx)));
02679
02680 for (i = 0;
02681 i < num_host_wds[str1_linear_type];
02682 i++) {
02683
02684 str_len1.v[i] = CP_CONSTANT(CN_POOL_IDX(TYP_IDX(l_type_idx)) + i);
02685 }
02686
02687 for (i = 0;
02688 i < num_host_wds[str2_linear_type];
02689 i++) {
02690
02691 str_len2.v[i] = CP_CONSTANT(CN_POOL_IDX(TYP_IDX(r_type_idx)) + i);
02692 }
02693
02694 # ifdef _TARGET32
02695 if (num_host_wds[str1_linear_type] != num_host_wds[res_linear_type]) {
02696 if (res_linear_type == Integer_8) {
02697 #ifndef _TARGET_LITTLE_ENDIAN
02698 str_len1.v[1] = str_len1.v[0];
02699 str_len1.v[0] = 0;
02700 #endif
02701 }
02702 else {
02703 str_len1.v[0] = str_len1.v[1];
02704 }
02705 }
02706
02707 if (num_host_wds[str2_linear_type] != num_host_wds[res_linear_type]) {
02708 if (res_linear_type == Integer_8) {
02709 #ifndef _TARGET_LITTLE_ENDIAN
02710 str_len2.v[1] = str_len2.v[0];
02711 str_len2.v[0] = 0;
02712 #endif
02713 }
02714 else {
02715 str_len2.v[0] = str_len2.v[1];
02716 }
02717 }
02718 # endif
02719
02720
02721 SHIFT_ARITH_ARG(str_len1.v, res_linear_type);
02722 SHIFT_ARITH_ARG(str_len2.v, res_linear_type);
02723
02724
02725 mask = AR_verify((AR_DATA *)loc_result.v,
02726 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02727 (const char *)l_value_ptr,
02728 (const AR_DATA *)str_len1.v,
02729 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02730 (const char *)r_value_ptr,
02731 (const AR_DATA *)str_len2.v,
02732 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02733 (const AR_DATA *)a3_value.v,
02734 (const AR_TYPE *)&linear_to_arith[a3_linear_type]);
02735
02736 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
02737
02738 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02739 result[i] = loc_result.v[i];
02740 }
02741
02742 ARITH_ERROR_RESULT_TEST(mask, (*res_type_idx), ok, line, col);
02743 break;
02744
02745
02746 case Adjustl_Opr :
02747
02748
02749
02750 result[0] = ntr_const_tbl(l_type_idx, TRUE, NULL);
02751 #ifdef KEY
02752 l_value_ptr = CORRECT_THE_POINTER(l_value_offset);
02753 r_value_ptr = CORRECT_THE_POINTER(r_value_offset);
02754 #endif
02755
02756 *res_type_idx = l_type_idx;
02757
02758 char_len = CN_INT_TO_C(TYP_IDX(l_type_idx));
02759
02760 i = 0;
02761 while (i < char_len &&
02762 l_value_ptr[i] == ' ') {
02763 i++;
02764 }
02765
02766 char_ptr = (char *)&(CN_CONST(result[0]));
02767
02768 for (k = 0; k < (char_len - i); k++) {
02769 char_ptr[k] = l_value_ptr[i + k];
02770 }
02771
02772 for (; k < char_len; k++) {
02773 char_ptr[k] = ' ';
02774 }
02775 break;
02776
02777
02778 case Adjustr_Opr :
02779
02780
02781
02782 result[0] = ntr_const_tbl(l_type_idx,
02783 TRUE,
02784 (long_type *) char_buf);
02785 #ifdef KEY
02786 l_value_ptr = CORRECT_THE_POINTER(l_value_offset);
02787 r_value_ptr = CORRECT_THE_POINTER(r_value_offset);
02788 #endif
02789
02790 *res_type_idx = l_type_idx;
02791
02792 char_len = CN_INT_TO_C(TYP_IDX(l_type_idx));
02793
02794 i = 0;
02795 while (i < char_len &&
02796 l_value_ptr[(char_len - i) - 1] == ' ') {
02797 i++;
02798 }
02799
02800
02801
02802 char_ptr = (char *)&(CN_CONST(result[0]));
02803
02804 for (k = char_len; k > i; k--) {
02805 char_ptr[k - 1] = l_value_ptr[(k - i) - 1];
02806 }
02807
02808 for (; k > 0; k--) {
02809 char_ptr[k - 1] = ' ';
02810 }
02811 break;
02812
02813
02814 case Len_Trim_Opr :
02815 char_len = CN_INT_TO_C(TYP_IDX(l_type_idx));
02816 while (char_len > 0 && l_value_ptr[char_len-1] == ' ') {
02817 char_len--;
02818 }
02819
02820
02821
02822 C_TO_F_INT(result, char_len, TYP_LINEAR(*res_type_idx));
02823 break;
02824
02825
02826 case Mask_Opr :
02827 SHIFT_ARITH_ARG(l_value.v, l_linear_type);
02828
02829 mask = AR_mask((AR_DATA *)loc_result.v,
02830 (const AR_TYPE *)&linear_to_arith[res_linear_type],
02831 (const AR_DATA *)l_value.v,
02832 (const AR_TYPE *)&linear_to_arith[res_linear_type]);
02833
02834
02835
02836 if ((mask & AR_STAT_INVALID_TYPE) != 0) {
02837 PRINTMSG(line, 1079, Internal, col);
02838 }
02839 SHIFT_ARITH_RESULT(loc_result.v, res_linear_type);
02840
02841 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02842 result[i] = loc_result.v[i];
02843 }
02844 break;
02845
02846
02847
02848 case Csmg_Opr :
02849
02850
02851
02852 type_idx = *res_type_idx;
02853
02854
02855 ok = folder_driver((char *)l_value.v,
02856 l_type_idx,
02857 (char *)a3_value.v,
02858 a3_type_idx,
02859 a4_value.v,
02860 &type_idx,
02861 line,
02862 col,
02863 2,
02864 Band_Opr) && ok;
02865
02866 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02867 l_value.v[i] = a4_value.v[i];
02868 }
02869
02870
02871
02872
02873 ok = folder_driver((char *)a3_value.v,
02874 a3_type_idx,
02875 NULL,
02876 NULL_IDX,
02877 a4_value.v,
02878 &type_idx,
02879 line,
02880 col,
02881 1,
02882 Bnot_Opr) && ok;
02883
02884 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02885 a3_value.v[i] = a4_value.v[i];
02886 }
02887
02888
02889
02890 ok = folder_driver((char *)r_value.v,
02891 r_type_idx,
02892 (char *)a3_value.v,
02893 type_idx,
02894 a4_value.v,
02895 &type_idx,
02896 line,
02897 col,
02898 2,
02899 Band_Opr) && ok;
02900
02901 for (i = 0; i < num_host_wds[res_linear_type]; i++) {
02902 r_value.v[i] = a4_value.v[i];
02903 }
02904
02905
02906
02907
02908
02909 ok = folder_driver((char *)l_value.v,
02910 type_idx,
02911 (char *)r_value.v,
02912 type_idx,
02913 result,
02914 res_type_idx,
02915 line,
02916 col,
02917 2,
02918 Bor_Opr) && ok;
02919
02920 break;
02921
02922 default:
02923 PRINTMSG(line, 828, Internal, col);
02924 break;
02925 }
02926 #ifdef KEY
02927 }
02928 #endif
02929
02930 # ifdef _TARGET_OS_MAX
02931 if (res_linear_type == Complex_4) {
02932
02933 result[1] = result[0] & 0xFFFFFFFF;
02934 result[0] = result[0] >> 32;
02935 }
02936 # endif
02937
02938 EXIT:
02939
02940 TRACE (Func_Exit, "folder_driver", NULL);
02941
02942 return(ok);
02943
02944 }
02945
02946
02947
02948
02949
02950
02951
02952
02953
02954
02955
02956
02957
02958
02959
02960
02961
02962
02963
02964
02965
02966 boolean size_offset_binary_calc(size_offset_type *op1,
02967 size_offset_type *op2,
02968 operator_type opr,
02969 size_offset_type *result)
02970
02971 {
02972 long_type *constant1;
02973 long_type *constant2;
02974 int i;
02975 int ir_idx;
02976 boolean ok;
02977 opnd_type opnd1;
02978 opnd_type opnd2;
02979 boolean symbolic_constant = FALSE;
02980 int type_idx;
02981 int type1_idx;
02982 int type2_idx;
02983 long_type result_long[MAX_WORDS_FOR_INTEGER];
02984
02985
02986 TRACE (Func_Entry, "size_offset_binary_calc", NULL);
02987
02988 switch ((*op1).fld) {
02989 case NO_Tbl_Idx:
02990 constant1 = &((*op1).constant[0]);
02991 type1_idx = (*op1).type_idx;
02992 break;
02993
02994 case CN_Tbl_Idx:
02995 constant1 = &(CN_CONST((*op1).idx));
02996 type1_idx = CN_TYPE_IDX((*op1).idx);
02997 break;
02998
02999 case AT_Tbl_Idx:
03000 constant1 = NULL;
03001 type1_idx = ATD_TYPE_IDX((*op1).idx);
03002 symbolic_constant = (AT_OBJ_CLASS((*op1).idx) == Data_Obj) &&
03003 ATD_SYMBOLIC_CONSTANT((*op1).idx);
03004 break;
03005
03006 case IR_Tbl_Idx:
03007 constant1 = NULL;
03008 type1_idx = IR_TYPE_IDX((*op1).idx);
03009 break;
03010
03011 default:
03012
03013 constant1 = NULL;
03014 type1_idx = SA_INTEGER_DEFAULT_TYPE;
03015 break;
03016
03017 }
03018
03019
03020 switch ((*op2).fld) {
03021 case NO_Tbl_Idx:
03022 constant2 = &((*op2).constant[0]);
03023 type2_idx = (*op2).type_idx;
03024 break;
03025
03026 case CN_Tbl_Idx:
03027 constant2 = &(CN_CONST((*op2).idx));
03028 type2_idx = CN_TYPE_IDX((*op2).idx);
03029 break;
03030
03031 case AT_Tbl_Idx:
03032 constant2 = NULL;
03033 type2_idx = ATD_TYPE_IDX((*op2).idx);
03034 symbolic_constant |= (AT_OBJ_CLASS((*op2).idx) == Data_Obj) &&
03035 ATD_SYMBOLIC_CONSTANT((*op2).idx);
03036 break;
03037
03038 case IR_Tbl_Idx:
03039 constant2 = NULL;
03040 type2_idx = IR_TYPE_IDX((*op2).idx);
03041 break;
03042
03043 default:
03044
03045 constant2 = NULL;
03046 type2_idx = SA_INTEGER_DEFAULT_TYPE;
03047 break;
03048
03049 }
03050
03051
03052 if (constant1 != NULL && constant2 != NULL) {
03053 type_idx = (TYP_LINEAR(type2_idx) > TYP_LINEAR(type1_idx)) ? type2_idx :
03054 type1_idx;
03055
03056 issue_overflow_msg_719 = FALSE;
03057
03058 ok = folder_driver((char *) constant1,
03059 type1_idx,
03060 (char *) constant2,
03061 type2_idx,
03062 result_long,
03063 &type_idx,
03064 stmt_start_line,
03065 stmt_start_col,
03066 2,
03067 opr);
03068
03069 if (need_to_issue_719) {
03070
03071 if (TYP_LINEAR(type_idx) < LARGEST_INTEGER_TYPE) {
03072 need_to_issue_719 = FALSE;
03073 type_idx = LARGEST_INTEGER_TYPE;
03074 ok |= folder_driver((char *) constant1,
03075 type1_idx,
03076 (char *) constant2,
03077 type2_idx,
03078 result_long,
03079 &type_idx,
03080 stmt_start_line,
03081 stmt_start_col,
03082 2,
03083 opr);
03084 }
03085
03086 if (need_to_issue_719) {
03087 PRINTMSG(stmt_start_line, 1175, Error, stmt_start_col);
03088 need_to_issue_719 = FALSE;
03089 }
03090 }
03091
03092 for (i = 0; i < MAX_WORDS_FOR_INTEGER; i++) {
03093 (*result).constant[i] = result_long[i];
03094 }
03095
03096 (*result).type_idx = type_idx;
03097 (*result).fld = NO_Tbl_Idx;
03098 issue_overflow_msg_719 = TRUE;
03099 }
03100 else {
03101
03102
03103
03104
03105 if ((*op1).fld == NO_Tbl_Idx) {
03106 (*op1).idx = ntr_const_tbl((*op1).type_idx, FALSE, (*op1).constant);
03107 (*op1).fld = CN_Tbl_Idx;
03108 }
03109 else if ((*op2).fld == NO_Tbl_Idx) {
03110 (*op2).idx = ntr_const_tbl((*op2).type_idx, FALSE, (*op2).constant);
03111 (*op2).fld = CN_Tbl_Idx;
03112 }
03113
03114 OPND_FLD(opnd1) = (*op1).fld;
03115 OPND_IDX(opnd1) = (*op1).idx;
03116 OPND_LINE_NUM(opnd1) = stmt_start_line;
03117 OPND_COL_NUM(opnd1) = stmt_start_col;
03118
03119 OPND_FLD(opnd2) = (*op2).fld;
03120 OPND_IDX(opnd2) = (*op2).idx;
03121 OPND_LINE_NUM(opnd2) = stmt_start_line;
03122 OPND_COL_NUM(opnd2) = stmt_start_col;
03123
03124 if (!symbolic_constant) {
03125 type1_idx = check_type_for_size_address(&opnd1);
03126 type2_idx = check_type_for_size_address(&opnd2);
03127 }
03128
03129 type_idx = (TYP_LINEAR(type2_idx) > TYP_LINEAR(type1_idx)) ? type2_idx :
03130 type1_idx;
03131
03132 NTR_IR_TBL(ir_idx);
03133 IR_TYPE_IDX(ir_idx) = type_idx;
03134 IR_LINE_NUM_L(ir_idx) = stmt_start_line;
03135 IR_LINE_NUM_R(ir_idx) = stmt_start_line;
03136 IR_LINE_NUM(ir_idx) = stmt_start_line;
03137 IR_COL_NUM_L(ir_idx) = stmt_start_col;
03138 IR_COL_NUM_R(ir_idx) = stmt_start_col;
03139 IR_COL_NUM(ir_idx) = stmt_start_col;
03140 IR_FLD_L(ir_idx) = OPND_FLD(opnd1);
03141 IR_IDX_L(ir_idx) = OPND_IDX(opnd1);
03142 IR_FLD_R(ir_idx) = OPND_FLD(opnd2);
03143 IR_IDX_R(ir_idx) = OPND_IDX(opnd2);
03144
03145 if (symbolic_constant) {
03146
03147 switch(opr) {
03148 case Plus_Opr:
03149 opr = Symbolic_Plus_Opr;
03150 break;
03151
03152 case Div_Opr:
03153 opr = Symbolic_Div_Opr;
03154 break;
03155
03156 case Mult_Opr:
03157 opr = Symbolic_Mult_Opr;
03158 break;
03159
03160 case Minus_Opr:
03161 opr = Symbolic_Minus_Opr;
03162 break;
03163
03164 case Mod_Opr:
03165 opr = Symbolic_Mod_Opr;
03166 break;
03167
03168 case Shiftl_Opr:
03169 opr = Symbolic_Shiftl_Opr;
03170 break;
03171
03172 case Shiftr_Opr:
03173 opr = Symbolic_Shiftr_Opr;
03174 break;
03175 }
03176
03177 (*result).fld = AT_Tbl_Idx;
03178 (*result).idx = gen_compiler_tmp(stmt_start_line, stmt_start_col,
03179 Priv, TRUE);
03180
03181 ATD_TYPE_IDX((*result).idx) = INTEGER_DEFAULT_TYPE;
03182 ATD_FLD((*result).idx) = IR_Tbl_Idx;
03183 ATD_TMP_IDX((*result).idx) = ir_idx;
03184 ATD_SYMBOLIC_CONSTANT((*result).idx) = TRUE;
03185 }
03186 else {
03187 (*result).idx = ir_idx;
03188 (*result).fld = IR_Tbl_Idx;
03189 }
03190
03191 IR_OPR(ir_idx) = opr;
03192 ok = TRUE;
03193 }
03194
03195 TRACE (Func_Exit, "size_offset_binary_calc", NULL);
03196
03197 return(ok);
03198
03199 }
03200
03201
03202
03203
03204
03205
03206
03207
03208
03209
03210
03211
03212
03213
03214
03215
03216
03217
03218
03219
03220
03221 boolean size_offset_logical_calc(size_offset_type *op1,
03222 size_offset_type *op2,
03223 operator_type opr,
03224 size_offset_type *result)
03225
03226 {
03227 long_type *constant1;
03228 long_type *constant2;
03229 int ir_idx;
03230 boolean ok;
03231 int type_idx;
03232 int type1_idx;
03233 int type2_idx;
03234
03235
03236 TRACE (Func_Entry, "size_offset_logical_calc", NULL);
03237
03238 switch ((*op1).fld) {
03239 case NO_Tbl_Idx:
03240 constant1 = &((*op1).constant[0]);
03241 type1_idx = (*op1).type_idx;
03242 # ifdef KEY
03243 if (type1_idx == Integer_4 && *constant1 < 0){
03244 type1_idx = Integer_8;
03245 }
03246 # endif
03247 break;
03248
03249 case CN_Tbl_Idx:
03250 constant1 = &(CN_CONST((*op1).idx));
03251 type1_idx = CN_TYPE_IDX((*op1).idx);
03252 # ifdef KEY
03253 if (TYP_LINEAR(CN_TYPE_IDX((*op1).idx)) == Integer_4 && *constant1 < 0){
03254 type1_idx = Integer_8;
03255 }
03256 # endif
03257
03258 break;
03259
03260 case AT_Tbl_Idx:
03261 constant1 = NULL;
03262 type1_idx = ATD_TYPE_IDX((*op1).idx);
03263 break;
03264
03265 case IR_Tbl_Idx:
03266 constant1 = NULL;
03267 type1_idx = IR_TYPE_IDX((*op1).idx);
03268 break;
03269
03270 default:
03271
03272 constant1 = NULL;
03273 type1_idx = CG_INTEGER_DEFAULT_TYPE;
03274 break;
03275
03276 }
03277
03278
03279 switch ((*op2).fld) {
03280 case NO_Tbl_Idx:
03281 constant2 = &((*op2).constant[0]);
03282 type2_idx = (*op2).type_idx;
03283 # ifdef KEY
03284 if (type2_idx == Integer_4 && *constant2 < 0){
03285 type2_idx = Integer_8;
03286 }
03287 # endif
03288 break;
03289
03290 case CN_Tbl_Idx:
03291 constant2 = &(CN_CONST((*op2).idx));
03292 type2_idx = CN_TYPE_IDX((*op2).idx);
03293 # ifdef KEY
03294 if (TYP_LINEAR(CN_TYPE_IDX((*op2).idx)) == Integer_4 && *constant2 < 0){
03295 type2_idx = Integer_8;
03296 }
03297 # endif
03298 break;
03299
03300 case AT_Tbl_Idx:
03301 constant2 = NULL;
03302 type2_idx = ATD_TYPE_IDX((*op2).idx);
03303 break;
03304
03305 case IR_Tbl_Idx:
03306 constant2 = NULL;
03307 type2_idx = IR_TYPE_IDX((*op2).idx);
03308 break;
03309
03310 default:
03311
03312 constant2 = NULL;
03313 type2_idx = CG_INTEGER_DEFAULT_TYPE;
03314 break;
03315
03316 }
03317
03318 type_idx = CG_LOGICAL_DEFAULT_TYPE;
03319
03320 if (constant1 != NULL && constant2 != NULL) {
03321
03322 ok = folder_driver((char *) constant1,
03323 type1_idx,
03324 (char *) constant2,
03325 type2_idx,
03326 (*result).constant,
03327 &type_idx,
03328 stmt_start_line,
03329 stmt_start_col,
03330 2,
03331 opr);
03332
03333 (*result).type_idx = type_idx;
03334 (*result).fld = NO_Tbl_Idx;
03335 }
03336 else {
03337
03338
03339
03340
03341 if ((*op1).fld == NO_Tbl_Idx) {
03342 (*op1).idx = ntr_const_tbl((*op1).type_idx, FALSE, (*op1).constant);
03343 (*op1).fld = CN_Tbl_Idx;
03344 }
03345 else if ((*op2).fld == NO_Tbl_Idx) {
03346 (*op2).idx = ntr_const_tbl((*op2).type_idx, FALSE, (*op2).constant);
03347 (*op2).fld = CN_Tbl_Idx;
03348 }
03349
03350 NTR_IR_TBL(ir_idx);
03351
03352 IR_TYPE_IDX(ir_idx) = type_idx;
03353 IR_LINE_NUM_L(ir_idx) = stmt_start_line;
03354 IR_LINE_NUM_R(ir_idx) = stmt_start_line;
03355 IR_LINE_NUM(ir_idx) = stmt_start_line;
03356 IR_COL_NUM_L(ir_idx) = stmt_start_col;
03357 IR_COL_NUM_R(ir_idx) = stmt_start_col;
03358 IR_COL_NUM(ir_idx) = stmt_start_col;
03359 IR_OPR(ir_idx) = opr;
03360 IR_IDX_L(ir_idx) = (*op1).idx;
03361 IR_FLD_L(ir_idx) = (*op1).fld;
03362 IR_IDX_R(ir_idx) = (*op2).idx;
03363 IR_FLD_R(ir_idx) = (*op2).fld;
03364
03365 (*result).idx = ir_idx;
03366 (*result).fld = IR_Tbl_Idx;
03367 ok = TRUE;
03368 }
03369
03370 TRACE (Func_Exit, "size_offset_logical_calc", NULL);
03371
03372 return(ok);
03373
03374 }
03375
03376
03377
03378
03379
03380
03381
03382
03383
03384
03385
03386
03387
03388
03389
03390
03391
03392
03393
03394 boolean size_offset_min_max_calc(size_offset_type *op1,
03395 size_offset_type *op2,
03396 operator_type operator,
03397 size_offset_type *result)
03398
03399 {
03400 long_type *constant1;
03401 long_type *constant2;
03402 int il_idx;
03403 int il_idx2;
03404 int ir_idx;
03405 boolean ok;
03406 opnd_type opnd1;
03407 opnd_type opnd2;
03408 #ifdef KEY
03409 boolean symbolic_constant = FALSE;
03410 #else
03411 boolean symbolic_constant;
03412 #endif
03413 int type_idx;
03414 int type1_idx;
03415 int type2_idx;
03416
03417
03418 TRACE (Func_Entry, "size_offset_min_calc", NULL);
03419
03420 switch ((*op1).fld) {
03421 case NO_Tbl_Idx:
03422 constant1 = &((*op1).constant[0]);
03423 type1_idx = (*op1).type_idx;
03424 break;
03425
03426 case CN_Tbl_Idx:
03427 constant1 = &(CN_CONST((*op1).idx));
03428 type1_idx = CN_TYPE_IDX((*op1).idx);
03429 break;
03430
03431 case AT_Tbl_Idx:
03432 constant1 = NULL;
03433 type1_idx = ATD_TYPE_IDX((*op1).idx);
03434 symbolic_constant = (AT_OBJ_CLASS((*op1).idx) == Data_Obj) &&
03435 ATD_SYMBOLIC_CONSTANT((*op1).idx);
03436 break;
03437
03438 case IR_Tbl_Idx:
03439 constant1 = NULL;
03440 type1_idx = IR_TYPE_IDX((*op1).idx);
03441 break;
03442
03443 default:
03444
03445 constant1 = NULL;
03446 type1_idx = CG_INTEGER_DEFAULT_TYPE;
03447 break;
03448
03449 }
03450
03451
03452 switch ((*op2).fld) {
03453 case NO_Tbl_Idx:
03454 constant2 = &((*op2).constant[0]);
03455 type2_idx = (*op2).type_idx;
03456 break;
03457
03458 case CN_Tbl_Idx:
03459 constant2 = &(CN_CONST((*op2).idx));
03460 type2_idx = CN_TYPE_IDX((*op2).idx);
03461 break;
03462
03463 case AT_Tbl_Idx:
03464 constant2 = NULL;
03465 type2_idx = ATD_TYPE_IDX((*op2).idx);
03466 symbolic_constant |= (AT_OBJ_CLASS((*op2).idx) == Data_Obj) &&
03467 ATD_SYMBOLIC_CONSTANT((*op2).idx);
03468 break;
03469
03470 case IR_Tbl_Idx:
03471 constant2 = NULL;
03472 type2_idx = IR_TYPE_IDX((*op2).idx);
03473 break;
03474
03475 default:
03476 constant2 = NULL;
03477 type2_idx = CG_INTEGER_DEFAULT_TYPE;
03478 break;
03479
03480 }
03481
03482 if (constant1 != NULL && constant2 != NULL) {
03483 type_idx = CG_LOGICAL_DEFAULT_TYPE;
03484
03485 ok = folder_driver((char *) constant1,
03486 type1_idx,
03487 (char *) constant2,
03488 type2_idx,
03489 (*result).constant,
03490 &type_idx,
03491 stmt_start_line,
03492 stmt_start_col,
03493 2,
03494 Lt_Opr);
03495
03496 if (THIS_IS_TRUE((*result).constant, (*result).type_idx)) {
03497 (*result) = (operator == Min_Opr) ? (*op1) : (*op2);
03498 }
03499 else {
03500 (*result) = (operator == Min_Opr) ? (*op2) : (*op1);
03501 }
03502 }
03503 else {
03504
03505
03506
03507
03508 if ((*op1).fld == NO_Tbl_Idx) {
03509 (*op1).idx = ntr_const_tbl((*op1).type_idx, FALSE, (*op1).constant);
03510 (*op1).fld = CN_Tbl_Idx;
03511 }
03512 else if ((*op2).fld == NO_Tbl_Idx) {
03513 (*op2).idx = ntr_const_tbl((*op2).type_idx, FALSE, (*op2).constant);
03514 (*op2).fld = CN_Tbl_Idx;
03515 }
03516
03517 OPND_FLD(opnd1) = (*op1).fld;
03518 OPND_IDX(opnd1) = (*op1).idx;
03519 OPND_LINE_NUM(opnd1) = stmt_start_line;
03520 OPND_COL_NUM(opnd1) = stmt_start_col;
03521
03522 OPND_FLD(opnd2) = (*op2).fld;
03523 OPND_IDX(opnd2) = (*op2).idx;
03524 OPND_LINE_NUM(opnd2) = stmt_start_line;
03525 OPND_COL_NUM(opnd2) = stmt_start_col;
03526
03527 if (!symbolic_constant) {
03528 type1_idx = check_type_for_size_address(&opnd1);
03529 type2_idx = check_type_for_size_address(&opnd2);
03530 }
03531
03532 type_idx = (TYP_LINEAR(type2_idx) > TYP_LINEAR(type1_idx)) ? type2_idx :
03533 type1_idx;
03534
03535 NTR_IR_TBL(ir_idx);
03536
03537 IR_TYPE_IDX(ir_idx) = type_idx;
03538 IR_LINE_NUM(ir_idx) = stmt_start_line;
03539 IR_COL_NUM(ir_idx) = stmt_start_col;
03540
03541 if (operator == Min_Opr) {
03542 IR_OPR(ir_idx) = (symbolic_constant) ? Symbolic_Min_Opr :
03543 Min_Opr;
03544 }
03545 else {
03546 IR_OPR(ir_idx) = (symbolic_constant) ? Symbolic_Max_Opr :
03547 Max_Opr;
03548 }
03549 IR_FLD_L(ir_idx) = IL_Tbl_Idx;
03550 IR_LIST_CNT_L(ir_idx) = 2;
03551
03552 NTR_IR_LIST_TBL(il_idx);
03553 IL_LINE_NUM(il_idx) = stmt_start_line;
03554 IL_COL_NUM(il_idx) = stmt_start_col;
03555 IL_FLD(il_idx) = OPND_FLD(opnd1);
03556 IL_IDX(il_idx) = OPND_IDX(opnd1);
03557
03558 IR_IDX_L(ir_idx) = il_idx;
03559
03560 NTR_IR_LIST_TBL(il_idx2);
03561 IL_LINE_NUM(il_idx2) = stmt_start_line;
03562 IL_COL_NUM(il_idx2) = stmt_start_col;
03563 IL_FLD(il_idx2) = OPND_FLD(opnd2);
03564 IL_IDX(il_idx2) = OPND_IDX(opnd2);
03565 IL_PREV_LIST_IDX(il_idx2) = il_idx;
03566
03567 IL_NEXT_LIST_IDX(il_idx) = il_idx2;
03568
03569 (*result).idx = ir_idx;
03570 (*result).fld = IR_Tbl_Idx;
03571 ok = TRUE;
03572 }
03573
03574 TRACE (Func_Exit, "size_offset_min_calc", NULL);
03575
03576 return(ok);
03577
03578 }
03579
03580
03581
03582
03583
03584
03585
03586
03587
03588
03589
03590
03591
03592
03593
03594
03595
03596
03597 long64 f_int_to_cval(long_type *the_constant,
03598 int lin_type)
03599
03600 {
03601 int i;
03602 long_type input[MAX_WORDS_FOR_INTEGER];
03603 long64 result;
03604
03605
03606 TRACE (Func_Entry, "f_int_to_cval", NULL);
03607
03608 for (i = 0; i < num_host_wds[TYP_LINEAR(lin_type)]; i++) {
03609 input[i] = the_constant[i];
03610 }
03611
03612 SHIFT_ARITH_ARG(input, lin_type);
03613
03614 i = AR_convert_int_to_host_sint64((AR_HOST_SINT64 *) &result,
03615 (const AR_DATA *) &input,
03616 (const AR_TYPE *) &linear_to_arith[lin_type]);
03617
03618 TRACE (Func_Exit, "f_int_to_cval", NULL);
03619
03620 return(result);
03621
03622 }
03623
03624
03625
03626
03627
03628
03629
03630
03631
03632
03633
03634
03635
03636
03637
03638
03639
03640
03641
03642
03643
03644
03645 int cval_to_f_int(long_type *result,
03646 long64 *the_constant,
03647 int type_idx)
03648
03649 {
03650 int lin_type;
03651 int ret;
03652
03653
03654 TRACE (Func_Entry, "cval_to_f_int", NULL);
03655
03656 lin_type = (type_idx == NULL_IDX) ? CG_INTEGER_DEFAULT_TYPE :
03657 TYP_LINEAR(type_idx);
03658
03659 ret = AR_convert_host_sint64_to_int((AR_DATA *) result,
03660 (const AR_TYPE *) &linear_to_arith[lin_type],
03661 (AR_HOST_SINT64) *the_constant);
03662
03663
03664 if (ret == AR_STAT_OVERFLOW) {
03665
03666 if (type_idx == NULL_IDX &&
03667 CG_INTEGER_DEFAULT_TYPE < LARGEST_INTEGER_TYPE) {
03668 lin_type = LARGEST_INTEGER_TYPE;
03669 ret = AR_convert_host_sint64_to_int(
03670 (AR_DATA *) result,
03671 (const AR_TYPE *) &linear_to_arith[LARGEST_INTEGER_TYPE],
03672 (AR_HOST_SINT64) *the_constant);
03673 }
03674
03675 if (ret == AR_STAT_OVERFLOW) {
03676 PRINTMSG(stmt_start_line, 719, Error, stmt_start_col);
03677 lin_type = Err_Res;
03678 }
03679 else {
03680 SHIFT_ARITH_RESULT(result, lin_type);
03681 }
03682 }
03683 else {
03684 SHIFT_ARITH_RESULT(result, lin_type);
03685 }
03686
03687 TRACE (Func_Exit, "cval_to_f_int", NULL);
03688
03689 return(lin_type);
03690
03691 }
03692
03693
03694
03695
03696
03697
03698
03699
03700
03701
03702
03703
03704
03705
03706
03707
03708
03709 int ntr_int_const_tbl(int type_idx,
03710 long64 constant)
03711
03712 {
03713 int cn_idx;
03714 long_type the_constant[MAX_WORDS_FOR_INTEGER];
03715
03716 # if !defined(_HOST64) || !defined(_TARGET64)
03717 int new_type;
03718
03719 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
03720 long *cn_ptr;
03721 # endif
03722 # endif
03723
03724
03725 TRACE (Func_Entry, "ntr_int_const_tbl", NULL);
03726
03727 # if defined(_HOST64) && defined(_TARGET64)
03728
03729 if (type_idx == NULL_IDX) {
03730 type_idx = CG_INTEGER_DEFAULT_TYPE;
03731 }
03732
03733 the_constant[0] = constant;
03734
03735 # elif defined(_USE_FOLD_DOT_f)
03736 if (type_idx == NULL_IDX) {
03737 type_idx = CG_INTEGER_DEFAULT_TYPE;
03738 }
03739
03740 if (TYP_LINEAR(type_idx) == Integer_8 ||
03741 TYP_LINEAR(type_idx) == Typeless_8) {
03742 cn_ptr = (long *) &constant;
03743 the_constant[0] = *cn_ptr;
03744 if (MAX_WORDS_FOR_INTEGER > 1 )
03745 the_constant[1] = *(++cn_ptr);
03746 }
03747 else {
03748 the_constant[0] = constant;
03749 if (MAX_WORDS_FOR_INTEGER > 1 )
03750 the_constant[1] = 0;
03751 }
03752
03753 # elif (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
03754
03755 if (type_idx == NULL_IDX) {
03756 new_type = cval_to_f_int(the_constant,
03757 &constant,
03758 NULL_IDX);
03759
03760 if (new_type == NULL_IDX) {
03761 type_idx = CG_INTEGER_DEFAULT_TYPE;
03762 }
03763 else {
03764 type_idx = TYP_LINEAR(new_type);
03765 }
03766 }
03767 else {
03768
03769 if (TYP_LINEAR(type_idx) == Integer_8 ||
03770 TYP_LINEAR(type_idx) == Typeless_8) {
03771 cn_ptr = (long *) &constant;
03772 the_constant[0] = *cn_ptr;
03773 if (MAX_WORDS_FOR_INTEGER > 1 )
03774 the_constant[1] = *(++cn_ptr);
03775 }
03776 else {
03777 the_constant[0] = (long) constant;
03778 if (MAX_WORDS_FOR_INTEGER > 1 )
03779 the_constant[1] = 0;
03780 }
03781 }
03782
03783 # else
03784
03785
03786
03787
03788 new_type = cval_to_f_int(the_constant,
03789 &constant,
03790 type_idx);
03791
03792 if (new_type == NULL_IDX) {
03793 type_idx = CG_INTEGER_DEFAULT_TYPE;
03794 }
03795 else {
03796 type_idx = TYP_LINEAR(new_type);
03797 }
03798
03799 # endif
03800
03801 cn_idx = ntr_const_tbl(type_idx,
03802 FALSE,
03803 the_constant);
03804
03805 TRACE (Func_Exit, "ntr_int_const_tbl", NULL);
03806
03807 return(cn_idx);
03808
03809 }
03810
03811
03812
03813
03814
03815
03816
03817
03818
03819
03820
03821
03822
03823
03824
03825
03826
03827 long_type mpp_cn_int_to_c(int cn_idx)
03828
03829 {
03830 long_type the_constant;
03831 int type_idx;
03832
03833 TRACE (Func_Entry, "mpp_cn_int_to_c", NULL);
03834
03835 if (TYP_LINEAR(CN_TYPE_IDX(cn_idx)) == Integer_1 ||
03836 TYP_LINEAR(CN_TYPE_IDX(cn_idx)) == Integer_2 ||
03837 TYP_LINEAR(CN_TYPE_IDX(cn_idx)) == Integer_4) {
03838
03839 type_idx = CG_INTEGER_DEFAULT_TYPE;
03840
03841 if (folder_driver((char *)&CN_CONST(cn_idx),
03842 CN_TYPE_IDX(cn_idx),
03843 NULL,
03844 NULL_IDX,
03845 &the_constant,
03846 &type_idx,
03847 stmt_start_line,
03848 stmt_start_col,
03849 1,
03850 Cvrt_Opr)) {
03851
03852 }
03853 }
03854 else {
03855 the_constant = CN_CONST(cn_idx);
03856 }
03857
03858 TRACE (Func_Exit, "mpp_cn_int_to_c", NULL);
03859
03860 return(the_constant);
03861
03862 }
03863
03864
03865
03866
03867
03868
03869
03870
03871
03872
03873
03874
03875
03876
03877
03878 boolean compare_target_consts(long_type *const1,
03879 int type1,
03880 long_type *const2,
03881 int type2,
03882 int opr)
03883
03884 {
03885 boolean is_true;
03886 long_type result[MAX_WORDS_FOR_INTEGER];
03887 int type_idx;
03888
03889
03890 TRACE (Func_Entry, "compare_target_consts", NULL);
03891
03892 type_idx = LOGICAL_DEFAULT_TYPE;
03893
03894 if (folder_driver((char *)const1,
03895 type1,
03896 (char *)const2,
03897 type2,
03898 result,
03899 &type_idx,
03900 stmt_start_line,
03901 stmt_start_col,
03902 2,
03903 opr)) {
03904
03905 is_true = THIS_IS_TRUE(result, type_idx);
03906 }
03907 else {
03908 is_true = FALSE;
03909 }
03910
03911 TRACE (Func_Exit, "compare_target_consts", NULL);
03912
03913 return(is_true);
03914
03915 }
03916
03917
03918 # ifdef _USE_FOLD_DOT_f
03919
03920 #ifdef KEY
03921
03922
03923
03924
03925
03926
03927
03928
03929
03930
03931
03932
03933
03934
03935
03936
03937
03938
03939
03940
03941
03942 boolean kludge_input_conversion(char *str, int type_idx, boolean promote)
03943 {
03944 long_type number[MAX_WORDS_FOR_NUMERIC];
03945
03946 for (int i = 0; i < MAX_WORDS_FOR_NUMERIC; i++) {
03947 number[i] = 0;
03948 }
03949
03950 linear_type_type new_linear_type = Err_Res;
03951 int new_nbytes = 0;
03952 boolean range_ok = TRUE;
03953 errno = 0;
03954 switch (TYP_LINEAR(type_idx)) {
03955 case Integer_1:
03956 *(long *)number = strtol(str, (char **) 0, 10);
03957 if ((*(long *)number >= -128 && *(long*)number <= 127) || !promote) {
03958 break;
03959 }
03960 range_ok = FALSE;
03961 new_linear_type = Integer_2;
03962 new_nbytes = 2;
03963
03964
03965 case Integer_2:
03966 *(long *)number = strtol(str, (char **) 0, 10);
03967 if ((*(long *)number >= -32768 && *(long*)number <= 32767) || !promote) {
03968 break;
03969 }
03970 range_ok = FALSE;
03971 new_linear_type = Integer_4;
03972 new_nbytes = 4;
03973
03974
03975 case Integer_4:
03976 *(long *)number = strtol(str, (char **) 0, 10);
03977 if (ERANGE != errno || !promote) {
03978 break;
03979 }
03980 range_ok = FALSE;
03981 new_linear_type = Integer_8;
03982 new_nbytes = 8;
03983
03984
03985 case Integer_8:
03986 *(long long *)number = strtoll(str, (char **) 0, 10);
03987 #ifdef KEY
03988
03989
03990
03991
03992
03993
03994
03995 if (ERANGE == errno) {
03996 unsigned long long tryagain = strtoull(str, (char **) 0, 10);
03997 if (tryagain == ((unsigned long long)1) << 63) {
03998 *(unsigned long long *)number = tryagain;
03999 }
04000 errno = ERANGE;
04001 }
04002 #endif
04003 range_ok = range_ok && (ERANGE != errno);
04004 break;
04005
04006 case Real_4:
04007 *(float *)number = strtof(str, (char **) 0);
04008 range_ok = (ERANGE != errno);
04009 break;
04010
04011 case Real_8:
04012 *(double *)number = strtod(str, (char **) 0);
04013 range_ok = (ERANGE != errno);
04014 break;
04015
04016 case Real_16:
04017 *(long double *)number = strtold(str, (char **) 0);
04018 range_ok = (ERANGE != errno);
04019 break;
04020
04021 default:
04022 errno = EINVAL;
04023 break;
04024 }
04025 if (!range_ok) {
04026 errno = 0;
04027 PRINTMSG(TOKEN_LINE(token), 1413, Warning, TOKEN_COLUMN(token));
04028 }
04029 if (Err_Res != new_linear_type) {
04030 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
04031 TYP_TYPE(TYP_WORK_IDX) = TYP_TYPE(type_idx);
04032 TYP_LINEAR(TYP_WORK_IDX) = new_linear_type;
04033 TYP_DCL_VALUE(TYP_WORK_IDX) = new_nbytes;
04034 TYP_DESC(TYP_WORK_IDX) = Kind_Typed;
04035 type_idx = ntr_type_tbl();
04036 }
04037 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(type_idx, FALSE, number);
04038 if (errno) {
04039 PRINTMSG(stmt_start_line, 626, Internal, stmt_start_col,
04040 "Integer or Real type", "kludge_input_conversion");
04041 return FALSE;
04042 }
04043 return TRUE;
04044 }
04045 #else
04046
04047
04048
04049
04050
04051
04052
04053
04054
04055
04056
04057
04058
04059
04060
04061
04062
04063
04064
04065 void kludge_input_conversion (char *str,
04066 int type_idx)
04067 {
04068 int i;
04069 long_type number[MAX_WORDS_FOR_NUMERIC];
04070
04071 for (i = 0; i < MAX_WORDS_FOR_NUMERIC; i++) {
04072 number[i] = 0;
04073 }
04074
04075 switch (TYP_LINEAR(type_idx)) {
04076 case Integer_1:
04077 case Integer_2:
04078 case Integer_4:
04079 sscanf(str, "%lu", (long *)number);
04080 break;
04081
04082 case Integer_8:
04083 sscanf(str, "%lld", (long long *)number);
04084 break;
04085
04086 case Real_4:
04087 sscanf(str, "%f", (float *)number);
04088 break;
04089
04090 case Real_8:
04091 sscanf(str, "%lf", (double *)number);
04092 break;
04093
04094 case Real_16:
04095 sscanf(str, "%Lf", (long double *)number);
04096 break;
04097
04098 default:
04099 PRINTMSG(stmt_start_line, 626, Internal, stmt_start_col,
04100 "Integer or Real type", "kludge_input_conversion");
04101 break;
04102 }
04103
04104 TOKEN_CONST_TBL_IDX(token) = ntr_const_tbl(type_idx,
04105 FALSE,
04106 number);
04107 }
04108 #endif
04109
04110
04111
04112
04113
04114
04115
04116
04117
04118
04119
04120
04121
04122
04123
04124
04125
04126
04127
04128
04129 void kludge_output_conversion (long_type *the_constant,
04130 int type_idx,
04131 char *str)
04132 {
04133
04134 switch (TYP_LINEAR(type_idx)) {
04135 case Integer_1:
04136 case Integer_2:
04137 case Integer_4:
04138 sprintf(str, "%ld", *(long *)the_constant);
04139 break;
04140
04141 case Integer_8:
04142 sprintf(str, "%lld", *(long long *)the_constant);
04143 break;
04144
04145 case Real_4:
04146 sprintf(str, "%f", *(float *)the_constant);
04147 break;
04148
04149 case Real_8:
04150 sprintf(str, "%f", *(double *)the_constant);
04151 break;
04152
04153 case Real_16:
04154 sprintf(str, "%Lf", *(long double *)the_constant);
04155 break;
04156
04157 default:
04158 PRINTMSG(stmt_start_line, 626, Internal, stmt_start_col,
04159 "Integer or Real type", "kludge_output_conversion");
04160 break;
04161 }
04162 }
04163
04164 # endif
