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