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 static char USMID[] = "\n@(#)3.0_pl/sources/mifcvrt.c 3.8 01/17/97 12:00:48\n";
00037
00038
00039
00040 # include "defines.h"
00041
00042 # include "host.m"
00043 # include "host.h"
00044 # include "target.m"
00045 # include "target.h"
00046
00047 # include "globals.m"
00048 # include "tokens.m"
00049 # include "sytb.m"
00050 # include "debug.m"
00051 # include "s_globals.m"
00052
00053 # include "globals.h"
00054 # include "tokens.h"
00055 # include "sytb.h"
00056 # include "p_globals.h"
00057
00058 # if defined(_STANDALONE_FRONT_END)
00059
00060 # include "asm.h"
00061
00062 # include <sys/types.h>
00063 # include <sys/stat.h>
00064
00065 # if defined(_HOST_OS_UNICOS) || defined(_HOST_OS_MAX)
00066 # include <sys/target.h>
00067 # endif
00068
00069 # include <mif_dialect.h>
00070 # include <mif.h>
00071 # include <mif_util.h>
00072 # include <mif_io.h>
00073
00074
00075
00076
00077
00078
00079 enum evcontext { value, address };
00080 enum proc_call_class { Definition, Parent, Imported };
00081
00082 static void create_option_tbl(void);
00083 static void cvrt_proc_to_mif(FILE *, char *);
00084 static void cvrt_sytb_to_mif(int);
00085 static void cvrt_exp_to_mif(mopd_t *, mblk_t*, int, fld_type,
00086 mopnflag_t, enum evcontext);
00087 static void cvrt_ir_to_mif(int);
00088 static int get_basic_type(int);
00089 static int get_ptr_type(fld_type, int);
00090 static int get_type_idx(int);
00091 static void cvrt_dummy_procedure(int);
00092 static int cvrt_darg_list(int);
00093 static void cvrt_proc(int, int, enum proc_call_class);
00094 static int cvrt_derived_type(int);
00095 static int cvrt_label(int, mopnflag_t, mpos_t);
00096 static int cvrt_attr_ntry(int);
00097 static void cvrt_const (char *, int, int, mopd_t *);
00098 static int fold_exp(int, fld_type, int *, int *, int *);
00099 static void cvrt_data_impl_do(int, fld_type);
00100 static void write_mod_tbl_file_name(FILE *);
00101 static void init_subprog_info(int);
00102 mopd_t mif_opn_add(mblk_t *, mop_t, int, mpos_t, unsigned long,
00103 mopd_t, mopd_t, mopd_t);
00104
00105
00106
00107
00108
00109
00110 extern char frontend_version[];
00111 extern char *getenv (const char *);
00112
00113
00114
00115
00116
00117
00118 static msubprog_t msp;
00119 static char hostname[MACHINENAMELEN];
00120 static int srcix;
00121 static int optionix;
00122 static char *src_path = 0;
00123 static int local_scope;
00124 static int host_scope;
00125 static int F90_prod_mif_idx;
00126 static mopd_t *mif_attr_map;
00127 static int *mif_attr_type_map;
00128 static int mif_attr_map_size;
00129 static mopd_t *mif_const_map;
00130 static int mif_const_map_size;
00131 static int *mif_stor_blk_map;
00132 static int mif_stor_blk_map_size;
00133 static FILE *MIF_fp = 0;
00134 static boolean unsigned_type = FALSE;
00135 static int data_value_idx;
00136 static int data_values_consumed = 0;
00137 static long_type do_control_var[16];
00138 static long_type implied_do_idx[16];
00139 static int do_control_idx = NONE;
00140 static int *task_region_stk = 0;
00141 static int task_region_top = -1;
00142 static int task_region_alloc = 0;
00143 static int loop_end_label_idx;
00144 static int parallel_loop_end_label_idx;
00145 static int loop_tregend_blk_idx;
00146 static int loop_tregend_opn_idx;
00147 static int loop_region_idx;
00148 static int processing_aloc = FALSE;
00149
00150
00151
00152
00153
00154
00155
00156
00157
00158
00159
00160
00161
00162
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172 void
00173 out_of_memory (char *srcfilename, int lineno, int bytes) {
00174 PRINTMSG(1, 1044, Internal, 0, "mifcvrt.c: out of memory");
00175 }
00176
00177
00178
00179
00180
00181
00182
00183
00184
00185
00186
00187
00188
00189
00190
00191
00192
00193
00194
00195
00196
00197
00198 static
00199 void
00200 insert_init (int initix, mtag_t objtag, int objix) {
00201
00202 msym_t *obj_entry = objtag==mtag_gsym ? &msp.gsym[objix] :
00203 &msp.lsym[objix];
00204 int newoffset = msp.init[initix].offset;
00205
00206 TRACE (Func_Entry, "insert_init", NULL);
00207
00208 if (INVALID(obj_entry->init)) {
00209 obj_entry->init = initix;
00210 }
00211 else {
00212 int curr = obj_entry->init;
00213 int prev;
00214
00215
00216 while (VALID(curr)) {
00217 prev = curr;
00218 curr = msp.init[curr].next;
00219 }
00220
00221 msp.init[prev].next = initix;
00222 msp.init[initix].next = NONE;
00223 }
00224
00225 TRACE (Func_Exit, "insert_init", NULL);
00226
00227 }
00228
00229
00230
00231
00232
00233
00234
00235
00236
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246 static int source_position(int global_line)
00247 {
00248 int act_file_line;
00249 int i;
00250 int j;
00251 int glb_idx;
00252
00253 TRACE (Func_Entry, "source_position", NULL);
00254
00255 # ifdef _DEBUG
00256 if (global_line <= 0) {
00257 PRINTMSG(1, 1044, Internal, 0, "source_position: bad global line");
00258 }
00259 # endif
00260
00261 GLOBAL_LINE_TO_FILE_LINE(global_line, glb_idx, act_file_line);
00262
00263
00264 if (global_line_tbl_idx == 1) {
00265 i = 1;
00266 }
00267 else {
00268 i = 1;
00269 while (GL_GLOBAL_LINE(i) <= global_line) {
00270 i = i + 1;
00271 if (i > global_line_tbl_idx) {
00272 break;
00273 }
00274 }
00275 i = i - 1;
00276 }
00277
00278 srcix = GL_MIF_FILE_ID(i);
00279
00280 # ifdef _DEBUG
00281 if (srcix < 0) {
00282 PRINTMSG(1, 1044, Internal, 0, "source_position: bad srcix");
00283 }
00284 # endif
00285
00286 return(act_file_line);
00287
00288 TRACE (Func_Exit, "source_position", NULL);
00289
00290 }
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301
00302
00303
00304
00305
00306
00307
00308
00309
00310
00311
00312
00313
00314
00315 void cvrt_to_mif (char *compiler_gen_date)
00316
00317 {
00318 int child_idx;
00319 char msgbuf[512];
00320
00321
00322 TRACE (Func_Entry, "cvrt_to_mif", NULL);
00323
00324 if (!MIF_fp) {
00325 MIF_fp = mif_open_output(MIF_file, msgbuf);
00326
00327 if (!MIF_fp) {
00328 PRINTMSG(1, 1043, Error, 0, MIF_file);
00329 return;
00330 }
00331 }
00332
00333
00334
00335
00336
00337
00338
00339
00340
00341
00342
00343
00344 if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) == Module) {
00345 child_idx = SCP_FIRST_CHILD_IDX(curr_scp_idx);
00346 SCP_FIRST_CHILD_IDX(curr_scp_idx) = NULL_IDX;
00347
00348 cvrt_proc_to_mif(MIF_fp, compiler_gen_date);
00349
00350 if (child_idx != NULL_IDX) {
00351 curr_scp_idx = child_idx;
00352 cvrt_proc_to_mif(MIF_fp, compiler_gen_date);
00353 }
00354
00355 curr_scp_idx = MAIN_SCP_IDX;
00356
00357
00358
00359 # if defined(_TARGET_OS_UNICOS)
00360 write_mod_tbl_file_name(MIF_fp);
00361 # endif
00362
00363 }
00364 else {
00365 cvrt_proc_to_mif(MIF_fp, compiler_gen_date);
00366 }
00367
00368 return;
00369
00370 TRACE (Func_Exit, "cvrt_to_mif", NULL);
00371
00372 }
00373
00374
00375
00376
00377
00378
00379
00380
00381
00382
00383
00384
00385
00386
00387
00388
00389
00390
00391
00392
00393 static void cvrt_proc_to_mif (FILE *out_fp,
00394 char *compiler_gen_date)
00395
00396 {
00397 int i, j, k, l;
00398 int pgm_attr_idx;
00399 int pgm_code;
00400 int attr;
00401 int pgm_data;
00402 int save_curr_scp_idx;
00403 char *p;
00404 char *name_ptr;
00405 boolean check_scp = TRUE;
00406 mpos_t pos;
00407
00408
00409 TRACE (Func_Entry, "cvrt_proc_to_mif", NULL);
00410
00411 PROCESS_SIBLING:
00412
00413
00414
00415
00416 if (SCP_FIRST_CHILD_IDX(curr_scp_idx) != NULL_IDX) {
00417 save_curr_scp_idx = curr_scp_idx;
00418 curr_scp_idx = SCP_FIRST_CHILD_IDX(curr_scp_idx);
00419 cvrt_proc_to_mif(out_fp, compiler_gen_date);
00420 curr_scp_idx = save_curr_scp_idx;
00421 }
00422
00423 mif_attr_map_size = attr_tbl_idx + 1;
00424 MEM_ALLOC (mif_attr_map, mopd_t, mif_attr_map_size);
00425 MEM_ALLOC (mif_attr_type_map, int, mif_attr_map_size);
00426 for (i = 0; i < mif_attr_map_size; i++) {
00427 mif_attr_map[i] = mopd_null;
00428 mif_attr_type_map[i] = NONE;
00429 }
00430
00431 mif_const_map_size = const_tbl_idx + 1;
00432 MEM_ALLOC (mif_const_map, mopd_t, mif_const_map_size);
00433 for (i = 0; i < mif_const_map_size; i++) {
00434 mif_const_map[i] = mopd_null;
00435 }
00436
00437 mif_stor_blk_map_size = stor_blk_tbl_idx + 1;
00438 MEM_ALLOC (mif_stor_blk_map, int, mif_stor_blk_map_size);
00439 for (i = 0; i < mif_stor_blk_map_size; i++) {
00440 mif_stor_blk_map[i] = NONE;
00441 }
00442
00443 pgm_attr_idx = SCP_ATTR_IDX(curr_scp_idx);
00444 ATP_SCP_ALIVE(pgm_attr_idx) = TRUE;
00445
00446
00447 init_subprog_info (pgm_attr_idx);
00448 name_ptr = &name_pool[ATP_EXT_NAME_IDX(pgm_attr_idx)].name_char;
00449 msp.name = mnpool(&msp, name_ptr);
00450
00451
00452 local_scope = mifalloc[mtag_scope](&msp);
00453
00454 host_scope = NONE;
00455 if (SCP_PARENT_IDX(curr_scp_idx) != NULL_IDX) {
00456 host_scope = mifalloc[mtag_scope](&msp);
00457 }
00458 else {
00459 if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) != Module) {
00460 host_scope = mifalloc[mtag_scope](&msp);
00461 }
00462 }
00463
00464
00465 msp.immtype = get_basic_type(INTEGER_DEFAULT_TYPE);
00466
00467 # ifdef _HOST32
00468 msp.immtype = get_basic_type(Integer_4);
00469 # endif
00470
00471
00472 cvrt_sytb_to_mif(curr_scp_idx);
00473
00474
00475
00476
00477
00478
00479
00480 attr = SCP_ATTR_IDX(curr_scp_idx);
00481 msp.scope[local_scope].func = mif_attr_map[attr].val;
00482
00483 source_position(SH_GLB_LINE(SCP_FIRST_SH_IDX(curr_scp_idx)));
00484 pos = mpos_null;
00485 pos.line = source_position(SH_GLB_LINE(SCP_FIRST_SH_IDX(curr_scp_idx)));
00486 pos.src = srcix;
00487 msp.scope[local_scope].start = pos;
00488
00489 # if defined(_DEBUG)
00490
00491 if (SCP_SB_HOSTED_STACK_IDX(curr_scp_idx) != NULL_IDX &&
00492 SB_LEN_FLD(SCP_SB_HOSTED_STACK_IDX(curr_scp_idx)) != CN_Tbl_Idx) {
00493 PRINTMSG(SB_DEF_LINE(SCP_SB_HOSTED_STACK_IDX(curr_scp_idx)), 1201,
00494 Internal,
00495 SB_DEF_COLUMN(SCP_SB_HOSTED_STACK_IDX(curr_scp_idx)),
00496 SB_NAME_PTR(SCP_SB_HOSTED_STACK_IDX(curr_scp_idx)));
00497 }
00498
00499 # endif
00500
00501 if (SCP_PARENT_IDX(curr_scp_idx) != NULL_IDX) {
00502 attr = SCP_ATTR_IDX(SCP_PARENT_IDX(curr_scp_idx));
00503
00504 if (ATP_PGM_UNIT(attr) == Module) {
00505 attr = SCP_ATTR_IDX(curr_scp_idx);
00506 msp.scope[host_scope].func = mif_attr_map[attr].val;
00507 msp.scope[host_scope].start = pos;
00508 msp.scope[host_scope].flags |= mscopeflag_host;
00509
00510
00511
00512 if (SCP_SB_HOSTED_STACK_IDX(curr_scp_idx) != NULL_IDX) {
00513 msp.scope[host_scope].size =
00514 CN_INT_TO_C(SB_LEN_IDX(SCP_SB_HOSTED_STACK_IDX(curr_scp_idx)));
00515 }
00516 else {
00517 msp.scope[host_scope].size = 0;
00518 }
00519 }
00520 else {
00521 pos = mpos_null;
00522 pos.line = source_position
00523 (SH_GLB_LINE(SCP_FIRST_SH_IDX(SCP_PARENT_IDX(curr_scp_idx))));
00524 pos.src = srcix;
00525 msp.scope[host_scope].func = mif_attr_map[attr].val;
00526 msp.scope[host_scope].start = pos;
00527 msp.scope[host_scope].flags |= mscopeflag_host;
00528
00529
00530
00531 if (SCP_SB_HOSTED_STACK_IDX(SCP_PARENT_IDX(curr_scp_idx)) != NULL_IDX){
00532 msp.scope[host_scope].size =
00533 CN_INT_TO_C(SB_LEN_IDX(SCP_SB_HOSTED_STACK_IDX(
00534 SCP_PARENT_IDX(curr_scp_idx))));
00535 }
00536 else {
00537 msp.scope[host_scope].size = 0;
00538 }
00539 }
00540 }
00541 else {
00542 attr = SCP_ATTR_IDX(curr_scp_idx);
00543
00544 if (ATP_PGM_UNIT(attr) != Module) {
00545 msp.scope[host_scope].func = mif_attr_map[attr].val;
00546 msp.scope[host_scope].start = pos;
00547 msp.scope[host_scope].flags |= mscopeflag_host;
00548
00549
00550
00551 if (SCP_SB_HOSTED_STACK_IDX(curr_scp_idx) != NULL_IDX) {
00552 msp.scope[host_scope].size =
00553 CN_INT_TO_C(SB_LEN_IDX(SCP_SB_HOSTED_STACK_IDX(curr_scp_idx)));
00554 }
00555 else {
00556 msp.scope[host_scope].size = 0;
00557 }
00558 }
00559 }
00560
00561 init_directive(3);
00562
00563
00564 cvrt_ir_to_mif(curr_scp_idx);
00565
00566 ATP_SCP_ALIVE(pgm_attr_idx) = FALSE;
00567
00568
00569
00570 if (curr_scp_idx == MAIN_SCP_IDX) {
00571
00572 if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) != Module) {
00573 check_scp = FALSE;
00574 }
00575
00576 # if !defined(_TARGET_OS_MAX) && !defined(_TARGET_OS_UNICOS)
00577 else {
00578
00579
00580
00581 write_mod_tbl_file_name(out_fp);
00582 }
00583 # endif
00584 }
00585
00586
00587
00588
00589 mifwrite(out_fp, &msp, cmd_line_flags.output_format, "/bin/cat");
00590
00591 miffree (&msp);
00592
00593 MEM_FREE (mif_attr_map);
00594 MEM_FREE (mif_attr_type_map);
00595 MEM_FREE (mif_const_map);
00596 MEM_FREE (mif_stor_blk_map);
00597
00598 if (check_scp && SCP_SIBLING_IDX(curr_scp_idx) != NULL_IDX) {
00599 curr_scp_idx = SCP_SIBLING_IDX(curr_scp_idx);
00600 goto PROCESS_SIBLING;
00601 }
00602
00603 TRACE (Func_Exit, "cvrt_proc_to_mif", NULL);
00604
00605 }
00606
00607
00608
00609
00610
00611
00612
00613
00614
00615
00616
00617
00618
00619
00620
00621
00622
00623
00624
00625 static void cvrt_sytb_to_mif(int scp_idx)
00626 {
00627 int al_idx;
00628 int attr_idx;
00629 int prev_idx;
00630 int tmp_scp_idx;
00631 int name_idx;
00632 int pgm_idx;
00633
00634 TRACE (Func_Entry, "cvrt_sytb_to_mif", NULL);
00635
00636
00637 pgm_idx = SCP_ATTR_IDX(scp_idx);
00638 mif_attr_map[pgm_idx].tag = mtag_func;
00639 mif_attr_map[pgm_idx].val = mifalloc[mtag_func](&msp);
00640 msp.deffunc = mif_attr_map[pgm_idx].val;
00641
00642
00643
00644
00645
00646
00647 prev_idx = msp.deffunc;
00648 tmp_scp_idx = SCP_PARENT_IDX(scp_idx);
00649 while (tmp_scp_idx != NULL_IDX) {
00650 pgm_idx = SCP_ATTR_IDX(tmp_scp_idx);
00651 mif_attr_map[pgm_idx].tag = mtag_func;
00652 mif_attr_map[pgm_idx].val = mifalloc[mtag_func](&msp);
00653
00654
00655 msp.func[prev_idx].within = mif_attr_map[pgm_idx].val;
00656 prev_idx = mif_attr_map[pgm_idx].val;
00657 tmp_scp_idx = SCP_PARENT_IDX(tmp_scp_idx);
00658 }
00659
00660
00661
00662
00663 cvrt_proc(SCP_ATTR_IDX(scp_idx), SCP_ENTRY_IDX(scp_idx), Definition);
00664
00665 for (name_idx = SCP_LN_FW_IDX(scp_idx) + 1;
00666 name_idx < SCP_LN_LW_IDX(scp_idx);
00667 name_idx++) {
00668 attr_idx = LN_ATTR_IDX(name_idx);
00669 cvrt_attr_ntry(attr_idx);
00670 }
00671
00672 al_idx = SCP_ATTR_LIST(curr_scp_idx);
00673 while (al_idx != NULL_IDX) {
00674 if (AT_OBJ_CLASS(AL_ATTR_IDX(al_idx)) == Data_Obj &&
00675 ATD_CLASS(AL_ATTR_IDX(al_idx)) == Compiler_Tmp &&
00676 AT_REFERENCED(AL_ATTR_IDX(al_idx)) == Not_Referenced) {
00677
00678
00679 }
00680 else if (mif_attr_map [AL_ATTR_IDX(al_idx)].tag == mtag_none) {
00681 cvrt_attr_ntry(AL_ATTR_IDX(al_idx));
00682 }
00683
00684 al_idx = AL_NEXT_IDX(al_idx);
00685 }
00686
00687
00688 tmp_scp_idx = SCP_PARENT_IDX(scp_idx);
00689 while (tmp_scp_idx != NULL_IDX) {
00690 cvrt_proc(SCP_ATTR_IDX(tmp_scp_idx),
00691 SCP_ENTRY_IDX(tmp_scp_idx),
00692 Parent);
00693 tmp_scp_idx = SCP_PARENT_IDX(tmp_scp_idx);
00694 }
00695
00696 TRACE (Func_Exit, "cvrt_sytb_to_mif", NULL);
00697
00698 }
00699
00700
00701
00702
00703
00704
00705
00706
00707
00708
00709
00710
00711
00712
00713
00714
00715
00716
00717
00718
00719
00720 static void add_tasking_symbols(mtaskreg_t *t,
00721 int list_idx,
00722 mtaskusage_t default_usage,
00723 boolean dope_is_value)
00724 {
00725 int sublist_idx;
00726 int symix;
00727 mtasksym_t *s;
00728 mtasksym_t *l;
00729
00730 TRACE (Func_Entry, "add_tasking_symbols", NULL);
00731
00732
00733 if (IL_FLD(list_idx) == IL_Tbl_Idx) {
00734 sublist_idx = IL_IDX(list_idx);
00735 while (sublist_idx) {
00736 symix = mifalloc[mtag_tasksym](&msp);
00737 s = msp.tasksym + symix;
00738
00739
00740 l = msp.tasksym + t->tasksym;
00741 if (VALID(t->tasksym)) {
00742 while (VALID(l->next)) {
00743 l = msp.tasksym + l->next;
00744 }
00745 l->next = symix;
00746 }
00747 else {
00748 t->tasksym = symix;
00749 }
00750
00751 if (dope_is_value &&
00752 AT_OBJ_CLASS(IL_IDX(sublist_idx)) == Data_Obj &&
00753 (ATD_IM_A_DOPE(IL_IDX(sublist_idx)) ||
00754 (TYP_TYPE(ATD_TYPE_IDX(IL_IDX(sublist_idx))) == Structure &&
00755 ATT_POINTER_CPNT(TYP_IDX(ATD_TYPE_IDX(
00756 IL_IDX(sublist_idx))))))) {
00757
00758 s->taskusage = mtaskusage_value;
00759 }
00760 else {
00761 s->taskusage = default_usage;
00762 }
00763 s->sym = mif_attr_map[IL_IDX(sublist_idx)];
00764
00765 sublist_idx = IL_NEXT_LIST_IDX(sublist_idx);
00766 }
00767 }
00768
00769 TRACE (Func_Exit, "cvrt_sytb_to_mif", NULL);
00770
00771 }
00772
00773
00774
00775
00776
00777
00778
00779
00780
00781
00782
00783
00784
00785
00786
00787
00788
00789
00790 static mworkdist_t map_work_distribution(int val)
00791 {
00792 switch (val) {
00793 case CMIC_WORK_DIST_SINGLE:
00794 return mworkdist_single;
00795
00796 case CMIC_WORK_DIST_VECTOR:
00797 return mworkdist_vector;
00798
00799 case CMIC_WORK_DIST_GUIDED:
00800 return mworkdist_guided;
00801
00802 case CMIC_WORK_DIST_NUMCHUNKS:
00803 return mworkdist_numchunks;
00804
00805 case CMIC_WORK_DIST_CHUNKSIZE:
00806 return mworkdist_chunksize;
00807
00808 case CMIC_WORK_DIST_NCPUS_CHUNKS:
00809 return mworkdist_ncpus_chunks;
00810
00811 default:
00812 PRINTMSG(1, 1044, Internal, 0,
00813 "map_work_distribution: unexpected work distribution");
00814 }
00815
00816 }
00817
00818
00819
00820
00821
00822
00823
00824
00825
00826
00827
00828
00829
00830
00831
00832
00833
00834
00835 static int start_task_region(mblk_t *blk,
00836 int ir_idx,
00837 mopnflag_t flags,
00838 mpos_t pos)
00839 {
00840 int tskix = mifalloc[mtag_taskreg](&msp);
00841 mtaskreg_t *t = msp.taskreg + tskix;
00842 int list_idx;
00843 int symix;
00844 mtasksym_t *s;
00845 mopd_t opd0;
00846 mtype_t typ;
00847 mtasksym_t *l;
00848
00849 TRACE (Func_Entry, "start_task_region", NULL);
00850
00851 if (IR_OPR(ir_idx)==Case_Cmic_Opr &&
00852 msp.taskreg[task_region_stk[task_region_top]].regionclass==
00853 mregionclass_case) {
00854
00855 opd0.tag = mtag_taskreg;
00856 opd0.val = task_region_stk[task_region_top];
00857 mif_opn_add(blk,
00858 mop_tregend,
00859 get_basic_type(NONE),
00860 pos,
00861 flags,
00862 opd0,
00863 mopd_null,
00864 mopd_null);
00865 }
00866 else {
00867
00868 if (++task_region_top >= task_region_alloc) {
00869 task_region_alloc += 5;
00870 MEM_REALLOC(task_region_stk, int, task_region_alloc);
00871 }
00872 }
00873
00874
00875 task_region_stk[task_region_top] = tskix;
00876
00877
00878 switch (IR_OPR(ir_idx)) {
00879 case Case_Cmic_Opr:
00880 t->regionclass = mregionclass_case;
00881 t->within = task_region_stk[task_region_top-1];
00882 break;
00883
00884 case Guard_Cmic_Opr:
00885 t->regionclass = mregionclass_guard;
00886
00887
00888 if (IR_FLD_L(ir_idx) != NO_Tbl_Idx) {
00889 t->guardtemp = cvrt_attr_ntry(IR_IDX_L(ir_idx));
00890 }
00891 break;
00892
00893 case Doall_Cmic_Opr:
00894 t->regionclass = mregionclass_doall;
00895
00896
00897 list_idx = IR_IDX_L(ir_idx);
00898 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
00899 t->iftemp = cvrt_attr_ntry(IL_IDX(list_idx));
00900 }
00901
00902
00903 list_idx = IL_NEXT_LIST_IDX(list_idx);
00904 add_tasking_symbols(t, list_idx, mtaskusage_shared, FALSE);
00905
00906
00907 list_idx = IL_NEXT_LIST_IDX(list_idx);
00908 add_tasking_symbols(t, list_idx, mtaskusage_private, TRUE);
00909
00910
00911 list_idx = IL_NEXT_LIST_IDX(list_idx);
00912 if (IL_FLD(list_idx) == CN_Tbl_Idx) {
00913 t->flags |= mtaskregflag_defaultusage;
00914 }
00915
00916
00917 list_idx = IL_NEXT_LIST_IDX(list_idx);
00918
00919
00920
00921 add_tasking_symbols(t, list_idx, mtaskusage_iterate, FALSE);
00922
00923
00924 list_idx = IL_NEXT_LIST_IDX(list_idx);
00925 if (IL_FLD(list_idx) == CN_Tbl_Idx) {
00926 t->flags |= mtaskregflag_savelast;
00927 }
00928
00929
00930 list_idx = IL_NEXT_LIST_IDX(list_idx);
00931 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
00932 t->maxcpustemp = cvrt_attr_ntry(IL_IDX(list_idx));
00933 }
00934
00935
00936 list_idx = IL_NEXT_LIST_IDX(list_idx);
00937 t->workdist = map_work_distribution(CN_INT_TO_C(IL_IDX(list_idx)));
00938
00939
00940 list_idx = IL_NEXT_LIST_IDX(list_idx);
00941 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
00942 t->disttemp = cvrt_attr_ntry(IL_IDX(list_idx));
00943 }
00944
00945
00946 symix = mifalloc[mtag_tasksym](&msp);
00947 s = msp.tasksym + symix;
00948
00949
00950 l = msp.tasksym + t->tasksym;
00951 if (VALID(t->tasksym)) {
00952 while (VALID(l->next)) {
00953 l = msp.tasksym + l->next;
00954 }
00955 l->next = symix;
00956 }
00957 else {
00958 t->tasksym = symix;
00959 }
00960
00961 s->taskusage = mtaskusage_induction;
00962 s->sym = mif_attr_map[IR_IDX_R(ir_idx)];
00963
00964
00965
00966
00967
00968
00969 parallel_loop_end_label_idx = loop_end_label_idx;
00970 break;
00971
00972 case Doparallel_Cmic_Opr:
00973 t->regionclass = mregionclass_loop;
00974 t->within = task_region_stk[task_region_top-1];
00975
00976
00977 list_idx = IR_IDX_L(ir_idx);
00978 t->workdist = map_work_distribution(CN_INT_TO_C(IL_IDX(list_idx)));
00979
00980
00981 list_idx = IL_NEXT_LIST_IDX(list_idx);
00982 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
00983 t->disttemp = cvrt_attr_ntry(IL_IDX(list_idx));
00984 }
00985
00986
00987 symix = mifalloc[mtag_tasksym](&msp);
00988 s = msp.tasksym + symix;
00989 t->tasksym = symix;
00990 s->taskusage = mtaskusage_induction;
00991 s->sym = mif_attr_map[IR_IDX_R(ir_idx)];
00992
00993
00994
00995
00996
00997
00998 parallel_loop_end_label_idx = loop_end_label_idx;
00999 break;
01000
01001 case Parallel_Cmic_Opr:
01002 t->regionclass = mregionclass_parallel;
01003
01004
01005 list_idx = IR_IDX_L(ir_idx);
01006 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
01007 t->iftemp = cvrt_attr_ntry(IL_IDX(list_idx));
01008 }
01009
01010
01011 list_idx = IL_NEXT_LIST_IDX(list_idx);
01012 add_tasking_symbols(t, list_idx, mtaskusage_shared, FALSE);
01013
01014
01015 list_idx = IL_NEXT_LIST_IDX(list_idx);
01016 add_tasking_symbols(t, list_idx, mtaskusage_private, TRUE);
01017
01018
01019 list_idx = IL_NEXT_LIST_IDX(list_idx);
01020 if (IL_FLD(list_idx) == CN_Tbl_Idx) {
01021 t->flags |= mtaskregflag_defaultusage;
01022 }
01023
01024
01025 list_idx = IL_NEXT_LIST_IDX(list_idx);
01026
01027
01028
01029 add_tasking_symbols(t, list_idx, mtaskusage_iterate, FALSE);
01030
01031
01032 list_idx = IL_NEXT_LIST_IDX(list_idx);
01033 if (IL_FLD(list_idx) != NO_Tbl_Idx) {
01034 t->maxcpustemp = cvrt_attr_ntry(IL_IDX(list_idx));
01035 }
01036 break;
01037
01038 default:
01039 PRINTMSG(1, 1044, Internal, 0,
01040 "start_task_region: unexpected OPR");
01041 break;
01042 }
01043
01044 TRACE (Func_Exit, "start_task_region", NULL);
01045
01046 return tskix;
01047
01048 }
01049
01050
01051
01052
01053
01054
01055
01056
01057
01058
01059
01060
01061
01062
01063
01064
01065
01066
01067 static void cvrt_exp_to_mif(mopd_t *result,
01068 mblk_t *blk,
01069 int ir_idx,
01070 fld_type field,
01071 mopnflag_t flags,
01072 enum evcontext context)
01073 {
01074
01075 int attr_idx;
01076 int base_attr;
01077 boolean bound_chk;
01078 int next_idx;
01079 int temp_ir_idx;
01080 long_type i,j;
01081 int unused1;
01082 int unused2;
01083 int basic;
01084 int opnix;
01085 int tskix;
01086 mopd_t opd, opd0, opd1, opd2;
01087 int typeix;
01088 mop_t op;
01089 mtype_t type;
01090 mpos_t pos = mpos_null;
01091 mopn_t *o;
01092 mopnflag_t save_flags;
01093
01094
01095 TRACE (Func_Entry, "cvrt_exp_to_mif", NULL);
01096
01097 *result = mopd_null;
01098
01099
01100 switch (field) {
01101
01102 case NO_Tbl_Idx :
01103 break;
01104
01105
01106 case CN_Tbl_Idx :
01107
01108 if (ir_idx >= mif_const_map_size ||
01109 (mif_const_map[ir_idx].tag == mtag_none)) {
01110
01111
01112 cvrt_const((char *)&CN_CONST(ir_idx),
01113 CN_TYPE_IDX(ir_idx),
01114 CN_TYPE_IDX(ir_idx),
01115 result);
01116
01117 if (ir_idx < mif_const_map_size) {
01118 mif_const_map[ir_idx] = *result;
01119 }
01120 }
01121 else {
01122
01123 *result = mif_const_map[ir_idx];
01124 }
01125
01126 break;
01127
01128
01129 case IL_Tbl_Idx :
01130
01131
01132 for (; ir_idx != NULL_IDX; ir_idx = IL_NEXT_LIST_IDX(ir_idx)) {
01133 if (IL_IDX(ir_idx) != NULL_IDX) {
01134 cvrt_exp_to_mif(&opd0,
01135 blk,
01136 IL_IDX(ir_idx),
01137 IL_FLD(ir_idx),
01138 flags,
01139 context);
01140 }
01141 else {
01142 opd0 = mopd_null;
01143 }
01144
01145 *result = mif_opn_add(blk,
01146 mop_list,
01147 mopdtype(&msp, opd0, blk->opn),
01148 mpos_null,
01149 0,
01150 opd0,
01151 *result,
01152 mopd_null);
01153 }
01154 break;
01155
01156
01157 case AT_Tbl_Idx :
01158
01159 if (AT_OBJ_CLASS(ir_idx) == Data_Obj) {
01160 if (ATD_CLASS(ir_idx) == Compiler_Tmp &&
01161 ATD_TMP_INIT_NOT_DONE(ir_idx)) {
01162 insert_init_stmt_for_tmp(ir_idx);
01163 }
01164
01165 if (context == address) {
01166 *result = mif_opn_add(blk,
01167 mop_loc,
01168 get_ptr_type(AT_Tbl_Idx, ir_idx),
01169 mpos_null,
01170 0,
01171 mif_attr_map[ir_idx],
01172 mopd_null,
01173 mopd_null);
01174 }
01175 else {
01176 *result = mif_attr_map[ir_idx];
01177 }
01178 }
01179 else if (AT_OBJ_CLASS(ir_idx) == Pgm_Unit) {
01180 if ((ATP_PROC(ir_idx) == Extern_Proc) &&
01181 (AT_ACTUAL_ARG(ir_idx)) &&
01182 (ATP_DCL_EXTERNAL(ir_idx))) {
01183 *result = mif_opn_add(blk,
01184 mop_loc,
01185 get_ptr_type(AT_Tbl_Idx, ir_idx),
01186 pos,
01187 0,
01188 mif_attr_map[ir_idx],
01189 mopd_null,
01190 mopd_null);
01191 }
01192 else {
01193 *result = mif_attr_map[ir_idx];
01194 }
01195 }
01196 break;
01197
01198
01199 case IR_Tbl_Idx :
01200
01201
01202 # ifdef _DEBUG
01203 if (IR_TYPE_IDX(ir_idx) == NULL_IDX) {
01204 PRINTMSG(IR_LINE_NUM(ir_idx),
01205 993,
01206 Internal,
01207 IR_COL_NUM(ir_idx));
01208 }
01209 # endif
01210
01211 basic = get_basic_type(IR_TYPE_IDX(ir_idx));
01212
01213
01214 if (IR_RANK(ir_idx)) {
01215 flags |= mopnflag_array;
01216 }
01217 else {
01218 flags &= ~mopnflag_array;
01219 }
01220
01221
01222 pos = mpos_null;
01223 pos.line = source_position(IR_LINE_NUM(ir_idx));
01224 pos.src = srcix;
01225 pos.col = IR_COL_NUM(ir_idx);
01226
01227 switch (IR_OPR(ir_idx)) {
01228
01229
01230 case Ranf_Opr :
01231 *result = mif_opn_add(blk, mop_ranf, basic, pos,
01232 flags | mopnflag_precious |
01233 mopnflag_immobile |
01234 mopnflag_runtime |
01235 mopnflag_variant |
01236 mopnflag_distinct,
01237 mopd_null, mopd_null, mopd_null);
01238 break;
01239
01240 case Rtc_Opr :
01241 *result = mif_opn_add(blk, mop_clock, basic, pos,
01242 flags | mopnflag_immobile |
01243 mopnflag_runtime |
01244 mopnflag_variant |
01245 mopnflag_distinct,
01246 mopd_null, mopd_null, mopd_null);
01247 break;
01248
01249 case Numarg_Opr :
01250 *result = mif_opn_add(blk, mop_numargs, basic, pos,
01251 flags, mopd_null, mopd_null, mopd_null);
01252 break;
01253
01254 case My_Pe_Opr :
01255 break;
01256
01257 case Argchck_Present_Opr :
01258 *result = mif_opn_add(blk, mop_argchk, basic, pos,
01259 flags, mopd_null, mopd_null, mopd_null);
01260 break;
01261
01262 case Argchck_Loc_Opr :
01263 *result = mif_opn_add(blk, mop_argckloc, basic, pos,
01264 flags, mopd_null, mopd_null, mopd_null);
01265 break;
01266
01267 case Readsm_Opr :
01268 opd0 = mopd_0;
01269 opd0.val = _semget_op;
01270 *result = mif_opn_add(blk, mop_asm, basic, pos,
01271 flags, opd0, mopd_null, mopd_null);
01272 break;
01273
01274 case Remote_Write_Barrier_Opr :
01275 opd0 = mopd_0;
01276 opd0.val = _remote_write_barrier_op;
01277 *result = mif_opn_add(blk, mop_asm, basic, pos,
01278 flags, opd0, mopd_null, mopd_null);
01279 break;
01280
01281 case Memory_Barrier_Opr :
01282 opd0 = mopd_0;
01283 opd0.val = _memory_barrier_op;
01284 *result = mif_opn_add(blk, mop_asm, basic, pos,
01285 flags, opd0, mopd_null, mopd_null);
01286 break;
01287
01288 case Write_Memory_Barrier_Opr :
01289 opd0 = mopd_0;
01290 opd0.val = _write_memory_barrier_op;
01291 *result = mif_opn_add(blk, mop_asm, basic, pos,
01292 flags, opd0, mopd_null, mopd_null);
01293 break;
01294
01295 case Mul_Opr :
01296 *result = mif_opn_add(blk, mop_bmul, basic, pos,
01297 flags, mopd_null, mopd_null, mopd_null);
01298 break;
01299
01300 case Mcbl_Opr :
01301 *result = mif_opn_add(blk, mop_bmclr, basic, pos,
01302 flags, mopd_null, mopd_null, mopd_null);
01303 break;
01304
01305 case Get_Ieee_Exceptions_Opr :
01306 *result = mif_opn_add(blk, mop_get_all_estat, basic, pos,
01307 flags, mopd_null, mopd_null, mopd_null);
01308 break;
01309
01310 case Get_Ieee_Interrupts_Opr :
01311 *result = mif_opn_add(blk, mop_get_interupt, basic, pos,
01312 flags, mopd_null, mopd_null, mopd_null);
01313 break;
01314
01315 case Get_Ieee_Rounding_Mode_Opr :
01316 *result = mif_opn_add(blk, mop_getround, basic, pos,
01317 flags, mopd_null, mopd_null, mopd_null);
01318 break;
01319
01320 case Endcase_Cmic_Opr:
01321 case Endguard_Cmic_Opr:
01322 case Enddo_Cmic_Opr:
01323 case Endparallel_Cmic_Opr:
01324
01325 switch (IR_OPR(ir_idx)) {
01326 case Enddo_Cmic_Opr:
01327
01328
01329
01330
01331
01332
01333
01334 msp.blk[loop_tregend_blk_idx].opn[loop_tregend_opn_idx] = mopn_null;
01335 task_region_top++;
01336 task_region_stk[task_region_top] = loop_region_idx;
01337
01338 msp.taskreg[task_region_stk[task_region_top]].flags |=
01339 mtaskregflag_extendloop;
01340 break;
01341
01342 case Endcase_Cmic_Opr:
01343 msp.taskreg[task_region_stk[task_region_top]].flags |=
01344 mtaskregflag_lastcase;
01345 break;
01346 }
01347
01348 opd0.tag = mtag_taskreg;
01349 opd0.val = task_region_stk[task_region_top--];
01350 *result = mif_opn_add(blk,
01351 mop_tregend,
01352 get_basic_type(NONE),
01353 pos,
01354 flags,
01355 opd0,
01356 mopd_null,
01357 mopd_null);
01358 break;
01359
01360
01361
01362 case Int_Mult_Upper_Opr :
01363 case Get_Ieee_Status_Opr :
01364 case Numcpus_Cmic_Opr :
01365 case Mmx_Opr :
01366 case Mld_Opr :
01367 case Uplus_Opr :
01368 case Uminus_Opr :
01369 case Paren_Opr :
01370 case Present_Opr :
01371 case Abs_Opr :
01372 case Cos_Opr :
01373 case Sin_Opr :
01374 case Tan_Opr :
01375 case Acos_Opr :
01376 case Asin_Opr :
01377 case Atan_Opr :
01378 case Cot_Opr :
01379 case Exp_Opr :
01380 case Sqrt_Opr :
01381 case Cosh_Opr :
01382 case Sinh_Opr :
01383 case Tanh_Opr :
01384 case Log_10_Opr :
01385 case Log_E_Opr :
01386 case Conjg_Opr :
01387 case Dble_Opr :
01388 case Int_Opr :
01389 case Logical_Opr :
01390 case Real_Opr :
01391 case Ichar_Opr :
01392 case Char_Opr :
01393 case Cvrt_Opr :
01394 case Cvrt_Unsigned_Opr :
01395 case Leadz_Opr :
01396 case Poppar_Opr :
01397 case Popcnt_Opr :
01398 case Not_Opr :
01399 case Bnot_Opr :
01400 case Nint_Opr :
01401 case Anint_Opr :
01402 case Aint_Opr :
01403 case Aimag_Opr :
01404 case Clen_Opr :
01405 case Len_Trim_Opr :
01406 case Adjustl_Opr :
01407 case Adjustr_Opr :
01408 case Ceiling_Opr :
01409 case Floor_Opr :
01410 case Exponent_Opr :
01411 case Fraction_Opr :
01412 case Unit_Opr :
01413 case Getpos_Opr :
01414 case Length_Opr :
01415 case Transpose_Opr:
01416 case Mask_Opr :
01417 case Ranget_Opr :
01418 case Ranset_Opr :
01419 case Set_Ieee_Status_Opr :
01420 case Set_Ieee_Exceptions_Opr :
01421 case Set_Ieee_Interrupts_Opr :
01422 case Set_Ieee_Rounding_Mode_Opr :
01423 case Test_Ieee_Interrupt_Opr :
01424 case Test_Ieee_Exception_Opr :
01425 case Enable_Ieee_Interrupt_Opr :
01426 case Disable_Ieee_Interrupt_Opr :
01427 case Ieee_Finite_Opr :
01428 case Ieee_Is_Nan_Opr :
01429 case Ieee_Class_Opr :
01430
01431 opd0 = mopd_null;
01432 opd1 = mopd_null;
01433 opd2 = mopd_null;
01434
01435 cvrt_exp_to_mif(&opd0,
01436 blk,
01437 IR_IDX_L(ir_idx),
01438 IR_FLD_L(ir_idx),
01439 flags,
01440 value);
01441
01442 switch (IR_OPR(ir_idx)) {
01443 case Int_Mult_Upper_Opr:
01444 opd1 = opd0;
01445 opd0 = mopd_0;
01446 opd0.val = _int_mult_upper_op;
01447 op = mop_asm;
01448 break;
01449 case Numcpus_Cmic_Opr :
01450 op = mop_set_numcpus;
01451 break;
01452 case Mmx_Opr :
01453 op = mop_bmmx;
01454 break;
01455 case Mld_Opr :
01456 op = mop_bmld;
01457 break;
01458 case Uplus_Opr :
01459 op = mop_xmit;
01460 break;
01461 case Paren_Opr :
01462 op = mop_paren;
01463 break;
01464 case Present_Opr :
01465 op = mop_present;
01466 break;
01467 case Uminus_Opr :
01468 op = mop_neg;
01469 break;
01470 case Abs_Opr :
01471 if (msp.type[mopdtype(&msp, opd0, blk->opn)].u.class ==
01472 mtypeclass_complex) {
01473 op = mop_cabs;
01474 }
01475 else {
01476 op = mop_abs;
01477 }
01478 break;
01479 case Cos_Opr :
01480 op = mop_cos;
01481 break;
01482 case Sin_Opr :
01483 op = mop_sin;
01484 break;
01485 case Tan_Opr :
01486 op = mop_tan;
01487 break;
01488 case Acos_Opr :
01489 op = mop_acos;
01490 break;
01491 case Asin_Opr :
01492 op = mop_asin;
01493 break;
01494 case Atan_Opr :
01495 op = mop_atan;
01496 break;
01497 case Cot_Opr :
01498 op = mop_cot;
01499 break;
01500 case Exp_Opr :
01501 op = mop_exp;
01502 break;
01503 case Sqrt_Opr :
01504 op = mop_sqrt;
01505 break;
01506 case Cosh_Opr :
01507 op = mop_cosh;
01508 break;
01509 case Sinh_Opr :
01510 op = mop_sinh;
01511 break;
01512 case Tanh_Opr :
01513 op = mop_tanh;
01514 break;
01515 case Log_10_Opr :
01516 op = mop_log10;
01517 break;
01518 case Log_E_Opr :
01519 op = mop_log;
01520 break;
01521 case Conjg_Opr :
01522 op = mop_conjg;
01523 break;
01524 case Dble_Opr :
01525 case Int_Opr :
01526 case Logical_Opr :
01527 case Real_Opr :
01528 case Ichar_Opr :
01529 case Char_Opr :
01530 case Cvrt_Opr :
01531 op = mop_cast;
01532 break;
01533 case Cvrt_Unsigned_Opr :
01534 unsigned_type = TRUE;
01535 basic = get_basic_type(IR_TYPE_IDX(ir_idx));
01536 unsigned_type = FALSE;
01537 op = mop_cast;
01538 break;
01539 case Leadz_Opr :
01540 op = mop_lead0;
01541 break;
01542 case Poppar_Opr :
01543 op = mop_parity;
01544 break;
01545 case Popcnt_Opr :
01546 op = mop_pop;
01547 break;
01548 case Not_Opr :
01549 op = mop_not;
01550 break;
01551 case Bnot_Opr :
01552 op = mop_not;
01553 break;
01554 case Nint_Opr :
01555 case Anint_Opr :
01556 op = mop_round;
01557 break;
01558 case Aint_Opr :
01559 op = mop_trunc;
01560 break;
01561 case Aimag_Opr :
01562 op = mop_cast;
01563 opd2 = mopd_1;
01564 break;
01565 case Clen_Opr :
01566 op = mop_chlen;
01567 break;
01568 case Len_Trim_Opr :
01569 op = mop_chlentr;
01570 break;
01571 case Adjustl_Opr :
01572 op = mop_chadjl;
01573 break;
01574 case Adjustr_Opr :
01575 op = mop_chadjr;
01576 break;
01577 case Unit_Opr :
01578 op = mop_unit;
01579 break;
01580 case Getpos_Opr :
01581 op = mop_getpos;
01582 break;
01583 case Length_Opr :
01584 op = mop_length;
01585 break;
01586 case Ceiling_Opr :
01587 op = mop_ceiling;
01588 break;
01589 case Floor_Opr :
01590 op = mop_floor;
01591 break;
01592 case Exponent_Opr :
01593 op = mop_getexpo;
01594 break;
01595 case Fraction_Opr :
01596 op = mop_fract;
01597 break;
01598 case Transpose_Opr:
01599 op = mop_transp;
01600 break;
01601 case Mask_Opr :
01602 op = mop_mask;
01603 break;
01604 case Ranget_Opr :
01605 op = mop_ranget;
01606 break;
01607 case Ranset_Opr :
01608 op = mop_ranset;
01609 break;
01610 case Set_Ieee_Status_Opr :
01611 op = mop_set_stat;
01612 break;
01613 case Get_Ieee_Status_Opr :
01614 opd1 = opd0;
01615 opd0 = mopd_0;
01616 opd0.val = _readSR_op;
01617 op = mop_asm;
01618 break;
01619
01620 case Set_Ieee_Exceptions_Opr :
01621 op = mop_set_all_estat;
01622 break;
01623 case Set_Ieee_Interrupts_Opr :
01624 op = mop_set_interupt;
01625 break;
01626 case Set_Ieee_Rounding_Mode_Opr :
01627 op = mop_setround;
01628 break;
01629 case Test_Ieee_Interrupt_Opr :
01630 op = mop_tst_interupt;
01631 break;
01632 case Test_Ieee_Exception_Opr :
01633 op = mop_tst_estat;
01634 break;
01635 case Enable_Ieee_Interrupt_Opr :
01636 op = mop_enbl_interupt;
01637 break;
01638 case Disable_Ieee_Interrupt_Opr :
01639 op = mop_dsbl_interupt;
01640 break;
01641 case Ieee_Finite_Opr :
01642 op = mop_isfinite;
01643 break;
01644 case Ieee_Is_Nan_Opr :
01645 op = mop_isnan;
01646 break;
01647 case Ieee_Class_Opr :
01648 op = mop_fpclass;
01649 break;
01650 }
01651
01652 *result = mif_opn_add(blk,
01653 op,
01654 basic,
01655 pos,
01656 flags,
01657 opd0,
01658 opd1,
01659 opd2);
01660 break;
01661
01662
01663
01664 case Set_Ieee_Exception_Opr :
01665 case Clear_Ieee_Exception_Opr :
01666 case Spacing_Opr :
01667 case Rrspacing_Opr :
01668 case I24mult_Opr :
01669 case Mldmx_Opr :
01670 case All_Opr:
01671 case Any_Opr:
01672 case Count_Opr:
01673 case Atan2_Opr :
01674 case Cmplx_Opr :
01675 case Dim_Opr :
01676 case Mod_Opr :
01677 case Modulo_Opr :
01678 case Sign_Opr :
01679 case Scale_Opr :
01680 case Set_Exponent_Opr :
01681 case Dprod_Opr :
01682 case Fcd_Opr :
01683 case Shiftl_Opr :
01684 case Shiftr_Opr :
01685 case Shifta_Opr :
01686 case Shift_Opr :
01687 case Dot_Product_Opr :
01688 case Matmul_Opr :
01689 case Minloc_Opr :
01690 case Maxloc_Opr :
01691 case Ieee_Next_After_Opr :
01692 case Ieee_Unordered_Opr :
01693 case Ieee_Remainder_Opr :
01694 case Ieee_Int_Opr :
01695 case Ieee_Real_Opr :
01696 case Ieee_Copy_Sign_Opr :
01697 case Ieee_Binary_Scale_Opr :
01698 case Ieee_Exponent_Opr :
01699
01700 opd0 = mopd_null;
01701 opd1 = mopd_null;
01702 opd2 = mopd_null;
01703
01704 i = IR_IDX_L(ir_idx);
01705 cvrt_exp_to_mif(&opd0, blk, IL_IDX(i), IL_FLD(i), flags, value);
01706 i = IL_NEXT_LIST_IDX(i);
01707 cvrt_exp_to_mif(&opd1, blk, IL_IDX(i), IL_FLD(i), flags, value);
01708
01709 switch (IR_OPR(ir_idx)) {
01710 case Spacing_Opr :
01711 op = mop_spacing;
01712 break;
01713 case Rrspacing_Opr :
01714 op = mop_rrspcng;
01715 break;
01716 case I24mult_Opr :
01717 op = mop_i24mult;
01718 break;
01719 case Mldmx_Opr :
01720 op = mop_bmldmx;
01721 break;
01722 case All_Opr :
01723 op = mop_all;
01724 opd2 = opd0;
01725 opd0 = mopd_null;
01726 break;
01727 case Any_Opr :
01728 op = mop_any;
01729 opd2 = opd0;
01730 opd0 = mopd_null;
01731 break;
01732 case Count_Opr :
01733 op = mop_count;
01734 opd2 = opd0;
01735 opd0 = mopd_null;
01736 break;
01737 case Atan2_Opr :
01738 op = mop_atan2;
01739 break;
01740 case Cmplx_Opr :
01741 op = mop_cast;
01742 break;
01743 case Dim_Opr :
01744 op = mop_dim;
01745 break;
01746 case Mod_Opr :
01747 op = mop_rem;
01748 break;
01749 case Modulo_Opr :
01750 op = mop_mod;
01751 break;
01752 case Sign_Opr :
01753 op = mop_sign;
01754 break;
01755 case Scale_Opr :
01756 op = mop_scale;
01757 break;
01758 case Set_Exponent_Opr :
01759 op = mop_setexpo;
01760 break;
01761 case Dprod_Opr :
01762 op = mop_mul;
01763 break;
01764 case Fcd_Opr :
01765 op = mop_cast;
01766 break;
01767 case Shiftl_Opr :
01768 op = mop_lsh;
01769 opd2 = opd1;
01770 opd1 = mopd_null;
01771 break;
01772 case Shiftr_Opr :
01773 op = mop_rsh;
01774 opd2 = opd1;
01775 opd1 = opd0;
01776 opd0 = mopd_null;
01777 break;
01778 case Shifta_Opr :
01779 op = mop_mrsh;
01780 opd2 = opd1;
01781 opd1 = opd0;
01782 opd0 = mopd_null;
01783 break;
01784 case Shift_Opr :
01785 opd2 = opd1;
01786 opd1 = opd0;
01787 op = mop_lsh;
01788 break;
01789 case Dot_Product_Opr :
01790 op = mop_dotprod;
01791 break;
01792 case Matmul_Opr :
01793 op = mop_matmul;
01794 break;
01795 case Minloc_Opr :
01796 op = mop_minloc;
01797 opd2 = opd1;
01798 opd1 = mopd_null;
01799 break;
01800 case Maxloc_Opr :
01801 op = mop_maxloc;
01802 opd2 = opd1;
01803 opd1 = mopd_null;
01804 break;
01805 case Ieee_Next_After_Opr :
01806 op = mop_nextafter;
01807 break;
01808 case Ieee_Unordered_Opr :
01809 op = mop_isunordered;
01810 break;
01811 case Ieee_Remainder_Opr :
01812 op = mop_remainder;
01813 break;
01814 case Ieee_Int_Opr :
01815 op = mop_ieee_trunc;
01816 break;
01817 case Ieee_Real_Opr :
01818 op = mop_ieee_round;
01819 break;
01820 case Ieee_Copy_Sign_Opr :
01821 op = mop_sign_xfer;
01822 break;
01823 case Ieee_Binary_Scale_Opr :
01824 op = mop_scalb;
01825 break;
01826 case Ieee_Exponent_Opr :
01827 op = mop_logb;
01828 break;
01829 case Set_Ieee_Exception_Opr :
01830 op = mop_set_estat;
01831 break;
01832 case Clear_Ieee_Exception_Opr :
01833 op = mop_clr_estat;
01834 break;
01835
01836 }
01837
01838 *result = mif_opn_add(blk, op, basic, pos, flags, opd0, opd1, opd2);
01839 break;
01840
01841
01842
01843 case Nearest_Opr :
01844 case Dshiftl_Opr :
01845 case Dshiftr_Opr :
01846 case Cvmgp_Opr :
01847 case Cvmgm_Opr :
01848 case Cvmgz_Opr :
01849 case Cvmgn_Opr :
01850 case Cvmgt_Opr :
01851 case Csmg_Opr :
01852 case Index_Opr :
01853 case Scan_Opr :
01854 case Verify_Opr :
01855 case Cshift_Opr :
01856 case Product_Opr :
01857 case Sum_Opr :
01858 case Minval_Opr :
01859 case Maxval_Opr :
01860 case Spread_Opr :
01861 case Eoshift_Opr :
01862
01863 i = IR_IDX_L(ir_idx);
01864 cvrt_exp_to_mif(&opd0, blk, IL_IDX(i), IL_FLD(i), flags, value);
01865 i = IL_NEXT_LIST_IDX(i);
01866 cvrt_exp_to_mif(&opd1, blk, IL_IDX(i), IL_FLD(i), flags, value);
01867 i = IL_NEXT_LIST_IDX(i);
01868 cvrt_exp_to_mif(&opd2, blk, IL_IDX(i), IL_FLD(i), flags, value);
01869
01870 switch (IR_OPR(ir_idx)) {
01871 case Nearest_Opr :
01872 op = mop_nearest;
01873 break;
01874 case Dshiftl_Opr :
01875 op = mop_lsh;
01876 break;
01877 case Dshiftr_Opr :
01878 op = mop_rsh;
01879 break;
01880 case Cvmgp_Opr :
01881 case Cvmgm_Opr :
01882 case Cvmgz_Opr :
01883 case Cvmgn_Opr :
01884 case Cvmgt_Opr :
01885 op = mop_pick;
01886 break;
01887 case Csmg_Opr :
01888 op = mop_mrg;
01889 break;
01890 case Index_Opr :
01891 op = mop_chindex;
01892 break;
01893 case Scan_Opr :
01894 op = mop_chscan;
01895 break;
01896 case Verify_Opr :
01897 op = mop_chver;
01898 break;
01899 case Cshift_Opr :
01900 op = mop_cshift;
01901 break;
01902 case Product_Opr :
01903 op = mop_product;
01904 break;
01905 case Sum_Opr :
01906 op = mop_sum;
01907 break;
01908 case Minval_Opr :
01909 op = mop_minval;
01910 break;
01911 case Maxval_Opr :
01912 op = mop_maxval;
01913 break;
01914 case Spread_Opr :
01915 op = mop_spread;
01916 break;
01917 case Eoshift_Opr :
01918 cvrt_exp_to_mif(&opd2, blk, i, IL_Tbl_Idx, flags, value);
01919 op = mop_eoshift;
01920 break;
01921 }
01922
01923 *result = mif_opn_add(blk, op, basic, pos, flags, opd0, opd1, opd2);
01924 break;
01925
01926
01927 case Loc_Opr :
01928 cvrt_exp_to_mif(&opd0,
01929 blk,
01930 IR_IDX_L(ir_idx),
01931 IR_FLD_L(ir_idx),
01932 flags,
01933 value);
01934
01935 *result = mif_opn_add(blk,
01936 mop_loc,
01937 get_basic_type(IR_TYPE_IDX(ir_idx)),
01938 mpos_null,
01939 0,
01940 opd0,
01941 mopd_null,
01942 mopd_null);
01943 break;
01944
01945
01946 case Const_Tmp_Loc_Opr :
01947 cvrt_exp_to_mif(&opd0,
01948 blk,
01949 IR_IDX_L(ir_idx),
01950 IR_FLD_L(ir_idx),
01951 flags,
01952 value);
01953
01954 *result = mif_opn_add(blk,
01955 mop_loc,
01956 get_ptr_type(IR_Tbl_Idx, ir_idx),
01957 pos,
01958 flags,
01959 opd0,
01960 mopd_null,
01961 mopd_null);
01962 break;
01963
01964
01965 case Aloc_Opr :
01966 processing_aloc = TRUE;
01967 cvrt_exp_to_mif(result, blk,
01968 IR_IDX_L(ir_idx), IR_FLD_L(ir_idx),
01969 flags, address);
01970 processing_aloc = FALSE;
01971 opd2 = mopd_0;
01972 opd2.val = maliasclass_restrict;
01973 type = msp.type[mopdtype(&msp, *result, blk->opn)];
01974 type.maddr.aliasing = maliasclass_restrict;
01975 *result = mif_opn_add(blk, mop_alias,
01976 mtype_lookup(&msp, &type), pos, flags,
01977 *result, mopd_null, opd2);
01978 break;
01979
01980
01981 case Plus_Opr :
01982 case Minus_Opr :
01983 case Mult_Opr :
01984 case Div_Opr :
01985 case Real_Div_To_Int_Opr :
01986 case Power_Opr :
01987 case And_Opr :
01988 case Band_Opr :
01989 case Or_Opr :
01990 case Bor_Opr :
01991 case Neqv_Opr :
01992 case Bneqv_Opr :
01993 case Eqv_Opr:
01994 case Beqv_Opr :
01995 case Case_Range_Opr :
01996 case Lg_Opr :
01997
01998 cvrt_exp_to_mif(&opd0, blk,
01999 IR_IDX_L(ir_idx), IR_FLD_L(ir_idx),
02000 flags, value);
02001 cvrt_exp_to_mif(&opd1, blk,
02002 IR_IDX_R(ir_idx), IR_FLD_R(ir_idx),
02003 flags, value);
02004
02005 switch (IR_OPR(ir_idx)) {
02006 case Plus_Opr :
02007 op = mop_add;
02008 break;
02009 case Minus_Opr :
02010 op = mop_sub;
02011 break;
02012 case Mult_Opr :
02013 op = mop_mul;
02014 break;
02015 case Div_Opr :
02016 op = mop_div;
02017 break;
02018 case Real_Div_To_Int_Opr :
02019 op = mop_rdiv;
02020 break;
02021 case Power_Opr :
02022 op = mop_pow;
02023 break;
02024 case And_Opr :
02025 case Band_Opr :
02026 op = mop_and;
02027 break;
02028 case Or_Opr :
02029 case Bor_Opr :
02030 op = mop_or;
02031 break;
02032 case Neqv_Opr :
02033 case Bneqv_Opr :
02034 op = mop_xor;
02035 break;
02036 case Eqv_Opr :
02037 case Beqv_Opr :
02038 op = mop_eqv;
02039 break;
02040 case Case_Range_Opr :
02041 op = mop_range;
02042 break;
02043 case Lg_Opr :
02044 op = mop_islg;
02045 break;
02046 }
02047
02048 *result = mif_opn_add(blk, op, basic, pos,
02049 flags, opd0, opd1, mopd_null);
02050 break;
02051
02052
02053
02054 case Eq_Opr :
02055 case Ne_Opr :
02056 case Lt_Opr :
02057 case Le_Opr :
02058 case Gt_Opr :
02059 case Ge_Opr :
02060 case Llt_Opr :
02061 case Lle_Opr :
02062 case Lgt_Opr :
02063 case Lge_Opr :
02064
02065 if (IR_FLD_L(ir_idx) == IL_Tbl_Idx) {
02066 i = IR_IDX_L(ir_idx);
02067 cvrt_exp_to_mif(&opd0, blk, IL_IDX(i), IL_FLD(i), flags, value);
02068 i = IL_NEXT_LIST_IDX(i);
02069 cvrt_exp_to_mif(&opd1, blk, IL_IDX(i), IL_FLD(i), flags, value);
02070 }
02071 else {
02072 cvrt_exp_to_mif(&opd0, blk,
02073 IR_IDX_L(ir_idx), IR_FLD_L(ir_idx),
02074 flags, value);
02075 cvrt_exp_to_mif(&opd1, blk,
02076 IR_IDX_R(ir_idx), IR_FLD_R(ir_idx),
02077 flags, value);
02078 }
02079
02080 opd2 = mopd_0;
02081 switch(IR_OPR(ir_idx)) {
02082 case Eq_Opr:
02083 opd2.val = mrelation_EQ;
02084 break;
02085 case Ne_Opr:
02086 opd2.val = mrelation_LT | mrelation_GT;
02087 break;
02088 case Lt_Opr :
02089 case Llt_Opr :
02090 opd2.val = mrelation_LT;
02091 break;
02092 case Le_Opr :
02093 case Lle_Opr :
02094 opd2.val = mrelation_LT | mrelation_EQ;
02095 break;
02096 case Gt_Opr :
02097 case Lgt_Opr :
02098 opd2.val = mrelation_GT;
02099 break;
02100 case Ge_Opr :
02101 case Lge_Opr :
02102 opd2.val = mrelation_GT | mrelation_EQ;
02103 break;
02104 }
02105
02106 *result = mif_opn_add(blk, mop_cmp, basic,
02107 pos, flags, opd0, opd1, opd2);
02108 break;
02109
02110
02111
02112 case Case_Cmic_Opr:
02113 case Guard_Cmic_Opr:
02114 case Doall_Cmic_Opr:
02115 case Doparallel_Cmic_Opr:
02116 case Parallel_Cmic_Opr:
02117
02118 opd0.tag = mtag_taskreg;
02119 opd0.val = start_task_region(blk, ir_idx, flags, pos);
02120 *result = mif_opn_add(blk,
02121 mop_tregbegin,
02122 get_basic_type(NONE),
02123 pos,
02124 flags,
02125 opd0,
02126 mopd_null,
02127 mopd_null);
02128 break;
02129
02130
02131 case Max_Opr :
02132 case Min_Opr :
02133 case Concat_Opr :
02134
02135 switch (IR_OPR(ir_idx)) {
02136 case Max_Opr :
02137 op = mop_max;
02138 break;
02139
02140 case Min_Opr :
02141 op = mop_min;
02142 break;
02143
02144 case Concat_Opr :
02145 op = mop_cat;
02146 break;
02147
02148 }
02149
02150
02151 i = 0;
02152
02153 for (temp_ir_idx = IR_IDX_L(ir_idx);
02154 temp_ir_idx != NULL_IDX;
02155 temp_ir_idx = IL_NEXT_LIST_IDX(temp_ir_idx)) {
02156
02157 if (IL_IDX(temp_ir_idx) != NULL_IDX) {
02158
02159 if (!i++) {
02160
02161 cvrt_exp_to_mif(result, blk,
02162 IL_IDX(temp_ir_idx), IL_FLD(temp_ir_idx),
02163 flags, value);
02164 }
02165 else {
02166
02167 cvrt_exp_to_mif(&opd1, blk,
02168 IL_IDX(temp_ir_idx), IL_FLD(temp_ir_idx),
02169 flags, value);
02170
02171 if (opd1.tag == mtag_sx &&
02172 blk->opn[opd1.val].flags & mopnflag_array) {
02173 flags |= mopnflag_array;
02174 }
02175
02176 *result = mif_opn_add(blk, op, basic, pos, flags,
02177 *result, opd1, mopd_null);
02178 }
02179 }
02180 }
02181
02182 break;
02183
02184
02185
02186 case Asg_Opr :
02187 case Ptr_Asg_Opr:
02188 case Alt_Return_Opr :
02189 case Dv_Whole_Copy_Opr :
02190
02191 if ((IR_FLD_L(ir_idx) == AT_Tbl_Idx) &&
02192 (AT_OBJ_CLASS(IR_IDX_L(ir_idx)) == Label)) {
02193
02194 attr_idx = IR_IDX_L(ir_idx);
02195 mif_attr_map[attr_idx].val = cvrt_label(attr_idx, flags, pos);
02196
02197
02198 type = *mtype_null[mtypeclass_blkaddr];
02199 type.mblkaddr.size = mint(&msp,
02200 msp.immtype,
02201 (unsigned long)TARGET_BITS_PER_WORD);
02202
02203 opd1 = mif_opn_add(blk,
02204 mop_loc,
02205 mtype_lookup(&msp, &type),
02206 pos,
02207 flags,
02208 mif_attr_map[attr_idx],
02209 mopd_null,
02210 mopd_null);
02211
02212
02213 op = mop_asg;
02214 opd0 = mif_attr_map[IR_IDX_R(ir_idx)];
02215 }
02216 else {
02217
02218
02219 cvrt_exp_to_mif(&opd1,
02220 blk,
02221 IR_IDX_R(ir_idx),
02222 IR_FLD_R(ir_idx),
02223 flags,
02224 value);
02225
02226 if (IR_FLD_L(ir_idx) == AT_Tbl_Idx &&
02227 AT_OBJ_CLASS(IR_IDX_L(ir_idx)) == Data_Obj &&
02228 ATD_CLASS(IR_IDX_L(ir_idx)) != Dummy_Argument) {
02229
02230 opd0 = mif_attr_map[IR_IDX_L(ir_idx)];
02231 op = mop_asg;
02232 }
02233 else {
02234 cvrt_exp_to_mif(&opd0,
02235 blk,
02236 IR_IDX_L(ir_idx),
02237 IR_FLD_L(ir_idx),
02238 flags,
02239 address);
02240 op = mop_st;
02241 }
02242
02243 }
02244
02245 mif_opn_add(blk,
02246 op,
02247 get_basic_type(NONE),
02248 pos,
02249 flags,
02250 opd0,
02251 opd1,
02252 mopd_null);
02253 break;
02254
02255
02256
02257
02258 case Flat_Array_Asg_Opr :
02259
02260 cvrt_exp_to_mif(&opd1,
02261 blk,
02262 IR_IDX_R(ir_idx),
02263 IR_FLD_R(ir_idx),
02264 flags,
02265 value);
02266
02267 cvrt_exp_to_mif(&opd0,
02268 blk,
02269 IR_IDX_L(ir_idx),
02270 IR_FLD_L(ir_idx),
02271 flags,
02272 address);
02273 op = mop_constr;
02274
02275 mif_opn_add(blk,
02276 op,
02277 get_basic_type(NONE),
02278 pos,
02279 flags,
02280 opd0,
02281 opd1,
02282 mopd_null);
02283 break;
02284
02285
02286
02287
02288
02289
02290 case Dv_Def_Asg_Opr :
02291 cvrt_exp_to_mif(&opd0,
02292 blk,
02293 IR_IDX_L(ir_idx),
02294 IR_FLD_L(ir_idx),
02295 flags,
02296 address);
02297
02298 cvrt_exp_to_mif(&opd1,
02299 blk,
02300 IR_IDX_L(IR_IDX_R(ir_idx)),
02301 IR_FLD_L(IR_IDX_R(ir_idx)),
02302 flags,
02303 value);
02304
02305 mif_opn_add(blk,
02306 mop_dvdef,
02307 get_basic_type(NONE),
02308 pos,
02309 flags,
02310 opd0,
02311 opd1,
02312 mopd_null);
02313 break;
02314
02315
02316
02317
02318
02319
02320
02321
02322
02323
02324
02325
02326
02327
02328
02329
02330
02331
02332
02333
02334
02335
02336
02337
02338
02339
02340
02341
02342
02343
02344 mif_opn_add(blk,
02345 mop_st,
02346 get_basic_type(NONE),
02347 pos,
02348 flags,
02349 opd0,
02350 opd1,
02351 mopd_null);
02352 break;
02353 */
02354
02355
02356 case Where_Opr :
02357
02358
02359 i = IR_IDX_L(ir_idx);
02360 cvrt_exp_to_mif(&opd0,
02361 blk,
02362 IL_IDX(i),
02363 IL_FLD(i),
02364 flags,
02365 address);
02366
02367
02368 i = IL_NEXT_LIST_IDX(i);
02369 cvrt_exp_to_mif(&opd2,
02370 blk,
02371 IL_IDX(i),
02372 IL_FLD(i),
02373 flags,
02374 value);
02375
02376 opd0 = mif_opn_add(blk, mop_where, mopdtype(&msp, opd0,
02377 blk->opn), pos,
02378 flags | mopnflag_distinct,
02379 opd0, opd2, mopd_null);
02380
02381
02382 i = IL_NEXT_LIST_IDX(i);
02383 cvrt_exp_to_mif(&opd1, blk,
02384 IL_IDX(i), IL_FLD(i),
02385 flags, value);
02386
02387
02388 if (VALID (basic) &&
02389 mopdtype(&msp, opd1, blk->opn) != basic &&
02390 msp.type[basic].u.class != mtypeclass_fchar) {
02391 opd1 = mif_opn_add(blk, mop_cast, basic, pos, flags,
02392 opd1, mopd_null, mopd_null);
02393 }
02394
02395 mif_opn_add(blk,
02396 mop_st,
02397 get_basic_type(NONE),
02398 pos,
02399 flags,
02400 opd0,
02401 opd1,
02402 mopd_null);
02403 break;
02404
02405
02406
02407 case Read_Formatted_Opr :
02408 case Write_Formatted_Opr :
02409 case Read_Unformatted_Opr :
02410 case Write_Unformatted_Opr :
02411 case Read_Namelist_Opr :
02412 case Write_Namelist_Opr :
02413
02414
02415 cvrt_exp_to_mif(&opd0,
02416 blk,
02417 IR_IDX_L(ir_idx),
02418 IR_FLD_L(ir_idx),
02419 flags,
02420 value);
02421
02422
02423 cvrt_exp_to_mif(&opd1,
02424 blk,
02425 IR_IDX_R(ir_idx),
02426 IR_FLD_R(ir_idx),
02427 flags,
02428 value);
02429
02430 opd2 = mopd_0;
02431
02432 switch(IR_OPR(ir_idx)) {
02433 case Read_Formatted_Opr :
02434 case Read_Unformatted_Opr :
02435 case Read_Namelist_Opr :
02436 opd2.val |= mIOflag_read;
02437 break;
02438 case Write_Formatted_Opr :
02439 case Write_Unformatted_Opr :
02440 case Write_Namelist_Opr :
02441 opd2.val |= mIOflag_write;
02442 break;
02443 }
02444 switch(IR_OPR(ir_idx)) {
02445 case Read_Formatted_Opr :
02446 case Write_Formatted_Opr :
02447 opd2.val |= mIOflag_formatted;
02448 break;
02449 case Read_Unformatted_Opr :
02450 case Write_Unformatted_Opr :
02451 opd2.val |= mIOflag_unformatted;
02452 break;
02453 case Read_Namelist_Opr :
02454 case Write_Namelist_Opr :
02455 opd2.val |= mIOflag_namelist;
02456 break;
02457 }
02458
02459 *result = mif_opn_add(blk,
02460 mop_IO,
02461 msp.immtype,
02462 pos,
02463 flags,
02464 opd0,
02465 opd1,
02466 opd2);
02467 break;
02468
02469
02470 case Inquire_Iolength_Opr:
02471
02472 cvrt_exp_to_mif(&opd0,
02473 blk,
02474 IR_IDX_L(ir_idx),
02475 IR_FLD_L(ir_idx),
02476 flags,
02477 value);
02478
02479
02480 cvrt_exp_to_mif(&opd1,
02481 blk,
02482 IR_IDX_R(ir_idx),
02483 IR_FLD_R(ir_idx),
02484 flags,
02485 value);
02486
02487 *result = mif_opn_add(blk,
02488 mop_IOlength, basic,
02489 pos,
02490 flags,
02491 opd0,
02492 opd1,
02493 mopd_null);
02494 break;
02495
02496 case Implied_Do_Opr :
02497
02498
02499
02500
02501 j = IL_NEXT_LIST_IDX(IR_IDX_R(ir_idx));
02502 cvrt_exp_to_mif(&opd0, blk, IL_IDX(j), IL_FLD(j), flags, value);
02503 j = IL_NEXT_LIST_IDX(j);
02504 cvrt_exp_to_mif(&opd1, blk, IL_IDX(j), IL_FLD(j), flags, value);
02505 j = IL_NEXT_LIST_IDX(j);
02506 cvrt_exp_to_mif(&opd2, blk, IL_IDX(j), IL_FLD(j), flags, value);
02507
02508
02509 opd2 = mif_opn_add(blk, mop_triplet, msp.immtype, pos,
02510 flags | mopnflag_array,
02511 opd0, opd1, opd2);
02512
02513
02514 cvrt_exp_to_mif(&opd0,
02515 blk,
02516 IR_IDX_L(ir_idx),
02517 IR_FLD_L(ir_idx),
02518 flags,
02519 value);
02520
02521
02522 cvrt_exp_to_mif(&opd1,
02523 blk,
02524 IL_IDX(IR_IDX_R(ir_idx)),
02525 IL_FLD(IR_IDX_R(ir_idx)),
02526 flags,
02527 value);
02528
02529 *result = mif_opn_add(blk, mop_implDO, msp.immtype, pos,
02530 flags | mopnflag_array,
02531 opd0, opd1, opd2);
02532 break;
02533
02534
02535 case Call_Opr :
02536
02537 if (ATP_PROC(IR_IDX_L(ir_idx)) == Dummy_Proc) {
02538 if (TYP_TYPE(IR_TYPE_IDX(ir_idx)) == Typeless) {
02539 basic = get_basic_type(NONE);
02540 }
02541 }
02542 else if (ATP_HAS_ALT_RETURN(IR_IDX_L(ir_idx))) {
02543 basic = msp.immtype;
02544 }
02545 else if (ATP_PGM_UNIT(IR_IDX_L(ir_idx)) == Subroutine ||
02546 ATP_EXTRA_DARG(IR_IDX_L(ir_idx)) ||
02547 INVALID (basic)) {
02548 basic = get_basic_type(NONE);
02549 }
02550
02551
02552 cvrt_exp_to_mif(&opd0,
02553 blk,
02554 IR_IDX_L(ir_idx),
02555 IR_FLD_L(ir_idx),
02556 flags,
02557 value);
02558
02559
02560 if (IR_IDX_R(ir_idx) != NULL_IDX) {
02561 cvrt_exp_to_mif(&opd1, blk,
02562 IR_IDX_R(ir_idx),
02563 IR_FLD_R(ir_idx),
02564 flags,
02565 value);
02566 }
02567 else {
02568 opd1 = mopd_null;
02569 }
02570
02571 if (cdir_switches.do_inline) {
02572
02573
02574
02575
02576
02577 if (!ATP_INLINE_NEVER(IR_IDX_L(ir_idx))) {
02578 flags |= mopnflag_inline;
02579 }
02580 }
02581 else if (opt_flags.inline_lvl > 0 &&
02582 ATP_INLINE_ALWAYS(IR_IDX_L(ir_idx))) {
02583 flags |= mopnflag_inline;
02584 }
02585 else if (cdir_switches.noinline || opt_flags.inline_lvl == 0) {
02586 flags |= mopnflag_noinline;
02587 }
02588
02589 *result = mif_opn_add(blk,
02590 mop_call,
02591 basic, pos, flags,
02592 opd0, opd1, mopd_null);
02593 break;
02594
02595
02596 case Whole_Subscript_Opr :
02597 case Section_Subscript_Opr :
02598 case Subscript_Opr :
02599
02600 base_attr = find_left_attr(&(IR_OPND_L(ir_idx)));
02601
02602 bound_chk = (cdir_switches.bounds ||
02603 ATD_BOUNDS_CHECK(base_attr)) &&
02604 ! ATD_NOBOUNDS_CHECK(base_attr);
02605
02606
02607 cvrt_exp_to_mif(&opd0, blk,
02608 IR_IDX_L(ir_idx),
02609 IR_FLD_L(ir_idx),
02610 flags, address);
02611
02612 opd1 = mopd_null;
02613
02614
02615
02616
02617
02618
02619 for (next_idx = IR_IDX_R(ir_idx);
02620 next_idx != NULL_IDX;
02621 next_idx = IL_NEXT_LIST_IDX(next_idx)) {
02622
02623 cvrt_exp_to_mif(&opd, blk,
02624 IL_IDX(next_idx),
02625 IL_FLD(next_idx),
02626 flags, value);
02627
02628 opd1 = mif_opn_add(blk,
02629 mop_list,
02630 mopdtype(&msp, opd, blk->opn),
02631 pos,
02632 flags,
02633 opd,
02634 opd1,
02635 mopd_null);
02636 }
02637
02638 save_flags = flags;
02639
02640 if (bound_chk) {
02641 flags |= mopnflag_validate;
02642 }
02643
02644 *result = mif_opn_add(blk,
02645 mop_index,
02646 get_ptr_type(IR_Tbl_Idx, ir_idx),
02647 pos,
02648 flags,
02649 opd0,
02650 opd1,
02651 mopd_null);
02652
02653
02654 if (context == value) {
02655
02656 flags = save_flags;
02657
02658 *result = mif_opn_add(blk,
02659 mop_ld,
02660 basic,
02661 pos,
02662 flags,
02663 *result,
02664 mopd_null,
02665 mopd_null);
02666 }
02667
02668 break;
02669
02670
02671 case Triplet_Opr :
02672
02673 i = IR_IDX_L(ir_idx);
02674 cvrt_exp_to_mif(&opd0, blk, IL_IDX(i), IL_FLD(i), flags, value);
02675 i = IL_NEXT_LIST_IDX(i);
02676 cvrt_exp_to_mif(&opd1, blk, IL_IDX(i), IL_FLD(i), flags, value);
02677 i = IL_NEXT_LIST_IDX(i);
02678 cvrt_exp_to_mif(&opd2, blk, IL_IDX(i), IL_FLD(i), flags, value);
02679
02680
02681 *result = mif_opn_add(blk,
02682 mop_triplet,
02683 basic,
02684 pos,
02685 flags | mopnflag_array,
02686 opd0,
02687 opd1,
02688 opd2);
02689 break;
02690
02691
02692 case Whole_Substring_Opr :
02693 case Substring_Opr :
02694
02695 base_attr = find_left_attr(&(IR_OPND_L(ir_idx)));
02696
02697 bound_chk = cmd_line_flags.runtime_substring;
02698
02699
02700 cvrt_exp_to_mif(&opd0, blk,
02701 IR_IDX_L(ir_idx),
02702 IR_FLD_L(ir_idx),
02703 flags, address);
02704
02705
02706 i = IR_IDX_R(ir_idx);
02707 cvrt_exp_to_mif(&opd1, blk, IL_IDX(i), IL_FLD(i), flags, value);
02708
02709
02710 i = IL_NEXT_LIST_IDX(IL_NEXT_LIST_IDX(i));
02711 cvrt_exp_to_mif(&opd2, blk, IL_IDX(i), IL_FLD(i), flags, value);
02712
02713 save_flags = flags;
02714
02715 if (bound_chk) {
02716 flags |= mopnflag_validate;
02717 }
02718
02719 *result = mif_opn_add(blk, mop_substr, get_ptr_type(IR_Tbl_Idx, ir_idx),
02720 pos, flags & ~mopnflag_array,
02721 opd0, opd1, opd2);
02722
02723
02724 if (context == value) {
02725
02726 flags = save_flags;
02727
02728 *result = mif_opn_add(blk,
02729 mop_ld,
02730 basic,
02731 pos,
02732 flags,
02733 *result,
02734 mopd_null,
02735 mopd_null);
02736 }
02737
02738 break;
02739
02740
02741 case Struct_Opr :
02742
02743
02744 cvrt_exp_to_mif(&opd0, blk,
02745 IR_IDX_L(ir_idx), IR_FLD_L(ir_idx),
02746 flags, address);
02747
02748
02749 if (IR_FLD_R(ir_idx) == AT_Tbl_Idx &&
02750 AT_OBJ_CLASS(IR_IDX_R(ir_idx)) == Data_Obj) {
02751 opd1 = mif_attr_map[IR_IDX_R(ir_idx)];
02752 typeix = get_ptr_type(AT_Tbl_Idx, IR_IDX_R(ir_idx));
02753 }
02754 else {
02755 cvrt_exp_to_mif(&opd1, blk,
02756 IR_IDX_R(ir_idx),
02757 IR_FLD_R(ir_idx),
02758 flags,
02759 value);
02760
02761 typeix = get_ptr_type(IR_Tbl_Idx, ir_idx);
02762 }
02763
02764 *result = mif_opn_add(blk,
02765 mop_field,
02766 typeix, pos, flags,
02767 opd0,
02768 opd1,
02769 mopd_null);
02770
02771
02772 if (context==value) {
02773
02774 *result = mif_opn_add(blk, mop_ld,
02775 msp.type[typeix].u.base, pos, flags,
02776 *result, mopd_null, mopd_null);
02777 }
02778 break;
02779
02780
02781
02782
02783 case Dv_Deref_Opr :
02784 cvrt_exp_to_mif(result,
02785 blk,
02786 IR_IDX_L(ir_idx),
02787 IR_FLD_L(ir_idx),
02788 flags,
02789 value);
02790
02791
02792
02793
02794 if (context == value) {
02795 *result = mif_opn_add(blk,
02796 mop_ld,
02797 basic,
02798 pos,
02799 flags,
02800 *result,
02801 mopd_null,
02802 mopd_null);
02803 }
02804 break;
02805
02806
02807 case Dv_Access_Base_Addr :
02808 case Dv_Set_Base_Addr :
02809 case Dv_Access_El_Len :
02810 case Dv_Set_El_Len :
02811 case Dv_Access_N_Dim :
02812 case Dv_Set_N_Dim :
02813 case Dv_Access_Assoc :
02814 case Dv_Set_Assoc :
02815 case Dv_Access_Ptr_Alloc :
02816 case Dv_Set_Ptr_Alloc :
02817 case Dv_Access_P_Or_A :
02818 case Dv_Set_P_Or_A :
02819 case Dv_Access_A_Contig :
02820 case Dv_Set_A_Contig :
02821 case Dv_Access_Typ_Code :
02822 case Dv_Set_Typ_Code :
02823 case Dv_Access_Orig_Base :
02824 case Dv_Set_Orig_Base :
02825 case Dv_Access_Orig_Size :
02826 case Dv_Set_Orig_Size :
02827 case Dv_Access_Low_Bound :
02828 case Dv_Set_Low_Bound :
02829 case Dv_Access_Extent :
02830 case Dv_Set_Extent :
02831 case Dv_Access_Stride_Mult :
02832 case Dv_Set_Stride_Mult :
02833
02834 cvrt_exp_to_mif(&opd0,
02835 blk,
02836 IR_IDX_L(ir_idx),
02837 IR_FLD_L(ir_idx),
02838 flags,
02839 value);
02840
02841
02842 opd1 = mopd_0;
02843 switch (IR_OPR(ir_idx)) {
02844
02845 case Dv_Set_Base_Addr :
02846
02847
02848 case Dv_Access_Base_Addr : opd1.val = 1; break;
02849 case Dv_Set_El_Len :
02850 case Dv_Access_El_Len : opd1.val = 2; break;
02851 case Dv_Set_Assoc :
02852 case Dv_Access_Assoc : opd1.val = 3; break;
02853 case Dv_Set_Ptr_Alloc :
02854 case Dv_Access_Ptr_Alloc : opd1.val = 4; break;
02855 case Dv_Set_P_Or_A :
02856 case Dv_Access_P_Or_A : opd1.val = 5; break;
02857 case Dv_Set_A_Contig :
02858 case Dv_Access_A_Contig : opd1.val = 6; break;
02859 case Dv_Set_N_Dim :
02860 case Dv_Access_N_Dim : opd1.val = 7; break;
02861 case Dv_Set_Typ_Code :
02862 case Dv_Access_Typ_Code : opd1.val = 8; break;
02863 case Dv_Set_Orig_Base :
02864 case Dv_Access_Orig_Base : opd1.val = 9; break;
02865 case Dv_Set_Orig_Size :
02866 case Dv_Access_Orig_Size : opd1.val = 10; break;
02867
02868
02869 case Dv_Set_Low_Bound :
02870 case Dv_Access_Low_Bound : opd1.val = 0; break;
02871 case Dv_Set_Extent :
02872 case Dv_Access_Extent : opd1.val = 1; break;
02873 case Dv_Set_Stride_Mult :
02874 case Dv_Access_Stride_Mult : opd1.val = 2; break;
02875 }
02876
02877
02878 opd2 = mopd_null;
02879 switch (IR_OPR(ir_idx)) {
02880 case Dv_Set_Low_Bound :
02881 case Dv_Access_Low_Bound :
02882 case Dv_Set_Extent :
02883 case Dv_Access_Extent :
02884 case Dv_Set_Stride_Mult :
02885 case Dv_Access_Stride_Mult :
02886 opd2 = mopd_0;
02887 opd2.val = IR_DV_DIM(ir_idx);
02888 }
02889
02890 opd0 = mif_opn_add(blk,
02891 mop_dvfield,
02892 get_ptr_type(IR_Tbl_Idx, ir_idx),
02893 pos,
02894 flags,
02895 opd0,
02896 opd1,
02897 opd2);
02898
02899
02900 opd1 = mopd_null;
02901 switch (IR_OPR(ir_idx)) {
02902 case Dv_Set_Base_Addr :
02903 case Dv_Set_El_Len :
02904 case Dv_Set_Assoc :
02905 case Dv_Set_Ptr_Alloc :
02906 case Dv_Set_P_Or_A :
02907 case Dv_Set_A_Contig :
02908 case Dv_Set_N_Dim :
02909 case Dv_Set_Typ_Code :
02910 case Dv_Set_Orig_Base :
02911 case Dv_Set_Orig_Size :
02912 case Dv_Set_Low_Bound :
02913 case Dv_Set_Extent :
02914 case Dv_Set_Stride_Mult :
02915 cvrt_exp_to_mif(&opd1,
02916 blk,
02917 IR_IDX_R(ir_idx),
02918 IR_FLD_R(ir_idx),
02919 flags,
02920 value);
02921
02922 op = mop_st;
02923 basic = get_basic_type(NONE);
02924 break;
02925
02926 default :
02927
02928 op = mop_ld;
02929 }
02930
02931 *result = mif_opn_add(blk, op, basic, pos,
02932 flags, opd0, opd1, mopd_null);
02933 break;
02934
02935
02936 #if ! defined _ALLOCATE_IS_CALL
02937 case Allocate_Opr:
02938 case Deallocate_Opr:
02939 cvrt_exp_to_mif(&opd0, blk, IR_IDX_R(ir_idx), IR_FLD_R(ir_idx),
02940 flags,
02941 value);
02942
02943 cvrt_exp_to_mif(&opd1, blk, IR_IDX_L(ir_idx), IR_FLD_L(ir_idx),
02944 flags,
02945 value);
02946
02947 *result = mif_opn_add(blk,
02948 mop_allocate,
02949 get_basic_type(NONE),
02950 pos,
02951 flags,
02952 opd0,
02953 opd1,
02954 mopd_null);
02955 break;
02956 #endif
02957
02958 case SSD_Alloc_Opr :
02959 case Alloc_Opr :
02960
02961 cvrt_exp_to_mif(&opd0, blk,
02962 IR_IDX_L(ir_idx),
02963 IR_FLD_L(ir_idx),
02964 flags,
02965 value);
02966
02967
02968 opd1 = mopd_0;
02969 # ifdef _HEAP_REQUEST_IN_WORDS
02970 opd1.val = 8;
02971 # else
02972 opd1.val = 1;
02973 # endif
02974 opd0 = mif_opn_add(blk,
02975 mop_mul,
02976 msp.immtype,
02977 pos,
02978 flags,
02979 opd0,
02980 opd1,
02981 mopd_null);
02982
02983
02984 op = IR_OPR(ir_idx) == SSD_Alloc_Opr ? mop_SSD : mop_alloc;
02985
02986
02987
02988 *result = mif_opn_add(blk,
02989 op,
02990 get_ptr_type(IR_Tbl_Idx, ir_idx),
02991 pos, flags,
02992 opd0,
02993 mopd_null,
02994 mopd_null);
02995 break;
02996
02997
02998 case Dealloc_Opr :
02999 case SSD_Dealloc_Opr :
03000 cvrt_exp_to_mif(&opd0,
03001 blk,
03002 IR_IDX_L(ir_idx),
03003 IR_FLD_L(ir_idx),
03004 flags,
03005 value);
03006
03007
03008 opd0 = mif_opn_add(blk,
03009 mop_cast,
03010 get_ptr_type(IR_Tbl_Idx, ir_idx),
03011 pos,
03012 flags,
03013 opd0,
03014 mopd_null,
03015 mopd_null);
03016
03017 op = IR_OPR(ir_idx) == SSD_Dealloc_Opr ? mop_SSDfree : mop_free;
03018
03019 *result = mif_opn_add(blk,
03020 op,
03021 get_basic_type(NONE),
03022 pos,
03023 flags,
03024 opd0,
03025 mopd_null,
03026 mopd_null);
03027 break;
03028
03029 default:
03030 PRINTMSG(IR_LINE_NUM(ir_idx),
03031 1044,
03032 Internal,
03033 IR_COL_NUM(ir_idx),
03034 "cvrt_exp_to_mif: unexpected operator");
03035 break;
03036
03037 }
03038 break;
03039
03040 }
03041
03042 TRACE (Func_Exit, "cvrt_exp_to_mif", NULL);
03043 }
03044
03045
03046
03047
03048
03049
03050
03051
03052
03053
03054
03055
03056
03057
03058
03059
03060
03061
03062
03063 static void cvrt_ir_to_mif(int scp_idx)
03064 {
03065 int attr_idx;
03066 int baseattr;
03067 int basic;
03068 int blkix = NONE;
03069 int case_ct;
03070 size_offset_type char_bit;
03071 int cn_idx;
03072 int curr_sh;
03073 mopnflag_t flags;
03074 int fldattr;
03075 int i, j;
03076 int idx;
03077 int initix;
03078 int ir_idx;
03079 int l_idx;
03080 int lastblkix;
03081 int lcv;
03082 int length;
03083 int list_idx1;
03084 int list_idx2;
03085 int loc_offset_idx;
03086 int lt0, eq0, gt0;
03087 int nested_case_ct;
03088 mopn_t *o;
03089 long offset;
03090 size_offset_type offset1;
03091 mop_t op;
03092 mopd_t opd, opd0, opd1, opd2;
03093 opnd_type opnd;
03094 int opnix;
03095 mpos_t pos;
03096 size_offset_type result;
03097 long t;
03098 int tmp_sh;
03099 mtype_t typ;
03100 int typeix;
03101 boolean unused;
03102
03103
03104 TRACE (Func_Entry, "cvrt_ir_to_mif", NULL);
03105
03106
03107 for (curr_sh = SCP_FIRST_SH_IDX(scp_idx);
03108 curr_sh != NULL_IDX;
03109 curr_sh = SH_NEXT_IDX(curr_sh)) {
03110
03111
03112 pos = mpos_null;
03113 pos.line = source_position(SH_GLB_LINE(curr_sh));
03114 pos.src = srcix;
03115 pos.col = SH_COL_NUM(curr_sh);
03116
03117 msp.scope[local_scope].end.line = pos.line;
03118 msp.scope[local_scope].end.src = pos.src;
03119
03120 if (VALID(host_scope)) {
03121 msp.scope[host_scope].end.line = pos.line;
03122 msp.scope[host_scope].end.src = pos.src;
03123 }
03124
03125 flags = 0;
03126 if (SH_COMPILER_GEN(curr_sh)) {
03127 flags |= mopnflag_syn;
03128 }
03129
03130 ir_idx = SH_IR_IDX(curr_sh);
03131 if (ir_idx != NULL_IDX) {
03132
03133 switch(IR_OPR(ir_idx)) {
03134
03135
03136 case Vector_Cdir_Opr :
03137 case Novector_Cdir_Opr :
03138 case Ivdep_Cdir_Opr :
03139 case Unroll_Cdir_Opr :
03140 case Nounroll_Cdir_Opr :
03141 case Vsearch_Cdir_Opr :
03142 case Novsearch_Cdir_Opr :
03143 case Recurrence_Cdir_Opr :
03144 case Norecurrence_Cdir_Opr :
03145 case Cachealign_Cdir_Opr :
03146 case Align_Cdir_Opr :
03147 case Nextscalar_Cdir_Opr :
03148 case Shortloop128_Cdir_Opr :
03149 case Shortloop_Cdir_Opr:
03150 case Task_Cdir_Opr:
03151 case Notask_Cdir_Opr:
03152 case Prefervector_Cdir_Opr:
03153 case Prefertask_Cdir_Opr:
03154 case Bl_Cdir_Opr:
03155 case Nobl_Cdir_Opr:
03156 case Permutation_Cmic_Opr:
03157 case Cncall_Cmic_Opr:
03158 case Maxcpus_Cmic_Opr:
03159 break;
03160
03161
03162 case Inline_Cdir_Opr :
03163 cdir_switches.do_inline = TRUE;
03164 cdir_switches.noinline = FALSE;
03165 break;
03166
03167 case Noinline_Cdir_Opr :
03168 cdir_switches.do_inline = FALSE;
03169 cdir_switches.noinline = TRUE;
03170 break;
03171
03172 case Bounds_Cdir_Opr :
03173 if (IR_FLD_L(ir_idx) == IL_Tbl_Idx) {
03174 list_idx1 = IR_IDX_L(ir_idx);
03175
03176 while (list_idx1) {
03177 attr_idx = IL_IDX(list_idx1);
03178
03179
03180
03181
03182 if (ATD_NOBOUNDS_CHECK(attr_idx)) {
03183 ATD_NOBOUNDS_CHECK(attr_idx) = FALSE;
03184 list_idx2 = cdir_switches.nobounds_il_list;
03185
03186 while (list_idx2 != NULL_IDX) {
03187 if (IL_IDX(list_idx2) == attr_idx) {
03188
03189
03190 if (list_idx2 == cdir_switches.nobounds_il_list) {
03191 cdir_switches.nobounds_il_list =
03192 IL_NEXT_LIST_IDX(list_idx2);
03193 if (cdir_switches.nobounds_il_list) {
03194 IL_PREV_LIST_IDX(
03195 cdir_switches.nobounds_il_list) =
03196 NULL_IDX;
03197 }
03198 }
03199 else {
03200 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list_idx2)) =
03201 IL_NEXT_LIST_IDX(list_idx2);
03202 if (IL_NEXT_LIST_IDX(list_idx2)) {
03203 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx2)) =
03204 IL_PREV_LIST_IDX(list_idx2);
03205 }
03206 }
03207 FREE_IR_LIST_NODE(list_idx2);
03208
03209 break;
03210 }
03211 list_idx2 = IL_NEXT_LIST_IDX(list_idx2);
03212 }
03213 }
03214
03215
03216
03217 if (ATD_BOUNDS_CHECK(attr_idx) == FALSE) {
03218 ATD_BOUNDS_CHECK(attr_idx) = TRUE;
03219
03220 NTR_IR_LIST_TBL(list_idx2);
03221 IL_FLD(list_idx2) = AT_Tbl_Idx;
03222 IL_IDX(list_idx2) = attr_idx;
03223
03224 IL_NEXT_LIST_IDX(list_idx2) = cdir_switches.bounds_il_list;
03225 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx2)) = list_idx2;
03226 cdir_switches.bounds_il_list = list_idx2;
03227 }
03228
03229 list_idx1 = IL_NEXT_LIST_IDX(list_idx1);
03230 }
03231 }
03232 else {
03233 cdir_switches.bounds = TRUE;
03234
03235
03236
03237 list_idx1 = cdir_switches.nobounds_il_list;
03238 cdir_switches.nobounds_il_list = NULL_IDX;
03239
03240 while (list_idx1) {
03241 attr_idx = IL_IDX(list_idx1);
03242 ATD_NOBOUNDS_CHECK(attr_idx) = FALSE;
03243
03244 list_idx2 = list_idx1;
03245 list_idx1 = IL_NEXT_LIST_IDX(list_idx1);
03246 FREE_IR_LIST_NODE(list_idx2);
03247 }
03248 }
03249 break;
03250
03251 case Nobounds_Cdir_Opr :
03252
03253 if (IR_FLD_L(ir_idx) == IL_Tbl_Idx) {
03254 list_idx1 = IR_IDX_L(ir_idx);
03255
03256 while (list_idx1) {
03257 attr_idx = IL_IDX(list_idx1);
03258
03259
03260
03261
03262 if (ATD_BOUNDS_CHECK(attr_idx)) {
03263 ATD_BOUNDS_CHECK(attr_idx) = FALSE;
03264 list_idx2 = cdir_switches.bounds_il_list;
03265
03266 while (list_idx2 != NULL_IDX) {
03267 if (IL_IDX(list_idx2) == attr_idx) {
03268
03269
03270 if (list_idx2 == cdir_switches.bounds_il_list) {
03271 cdir_switches.bounds_il_list =
03272 IL_NEXT_LIST_IDX(list_idx2);
03273 if (cdir_switches.bounds_il_list) {
03274 IL_PREV_LIST_IDX(
03275 cdir_switches.bounds_il_list) =
03276 NULL_IDX;
03277 }
03278 }
03279 else {
03280 IL_NEXT_LIST_IDX(IL_PREV_LIST_IDX(list_idx2)) =
03281 IL_NEXT_LIST_IDX(list_idx2);
03282 if (IL_NEXT_LIST_IDX(list_idx2)) {
03283 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx2)) =
03284 IL_PREV_LIST_IDX(list_idx2);
03285 }
03286 }
03287 FREE_IR_LIST_NODE(list_idx2);
03288
03289 break;
03290 }
03291 list_idx2 = IL_NEXT_LIST_IDX(list_idx2);
03292 }
03293 }
03294
03295
03296
03297 if (ATD_NOBOUNDS_CHECK(attr_idx) == FALSE) {
03298 ATD_NOBOUNDS_CHECK(attr_idx) = TRUE;
03299
03300 NTR_IR_LIST_TBL(list_idx2);
03301 IL_FLD(list_idx2) = AT_Tbl_Idx;
03302 IL_IDX(list_idx2) = attr_idx;
03303
03304 IL_NEXT_LIST_IDX(list_idx2) =
03305 cdir_switches.nobounds_il_list;
03306 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx2)) = list_idx2;
03307 cdir_switches.nobounds_il_list = list_idx2;
03308 }
03309
03310 list_idx1 = IL_NEXT_LIST_IDX(list_idx1);
03311 }
03312 }
03313 else {
03314 cdir_switches.bounds = FALSE;
03315
03316
03317
03318 list_idx1 = cdir_switches.bounds_il_list;
03319 cdir_switches.bounds_il_list = NULL_IDX;
03320
03321 while (list_idx1) {
03322 attr_idx = IL_IDX(list_idx1);
03323 ATD_BOUNDS_CHECK(attr_idx) = FALSE;
03324
03325 list_idx2 = list_idx1;
03326 list_idx1 = IL_NEXT_LIST_IDX(list_idx1);
03327 FREE_IR_LIST_NODE(list_idx2);
03328 }
03329 }
03330 break;
03331
03332
03333 case Entry_Opr :
03334 lastblkix = blkix;
03335 blkix = mifalloc[mtag_blk](&msp);
03336 msp.blk[blkix].pos = pos;
03337 msp.blk[blkix].scope = local_scope;
03338 if (VALID(lastblkix)) {
03339 mflow_local(&msp, lastblkix, blkix);
03340 }
03341
03342 mif_opn_add(&msp.blk[blkix],
03343 mop_entry,
03344 get_basic_type(NONE),
03345 pos,
03346 flags,
03347 mif_attr_map[IR_IDX_L(ir_idx)],
03348 mopd_null,
03349 mopd_null);
03350 break;
03351
03352
03353
03354 case Return_Opr :
03355 if (INVALID(blkix)) {
03356 blkix = mifalloc[mtag_blk](&msp);
03357 msp.blk[blkix].pos = pos;
03358 msp.blk[blkix].scope = local_scope;
03359 }
03360
03361 cvrt_exp_to_mif(&opd1, &msp.blk[blkix],
03362 IR_IDX_L(ir_idx), IR_FLD_L(ir_idx),
03363 flags, value);
03364
03365 cvrt_exp_to_mif(&opd0, &msp.blk[blkix],
03366 IR_IDX_R(ir_idx), IR_FLD_R(ir_idx),
03367 flags, value);
03368
03369 mif_opn_add(&msp.blk[blkix],
03370 mop_return,
03371 get_basic_type(NONE),
03372 pos,
03373 flags,
03374 opd0,
03375 opd1,
03376 mopd_null);
03377
03378 blkix = NONE;
03379 break;
03380
03381
03382
03383 case Label_Opr :
03384 attr_idx = IR_IDX_L(ir_idx);
03385 if (ATL_CLASS(attr_idx) == Lbl_Format ||
03386 ATL_CLASS(attr_idx) <= Lbl_User &&
03387 !ATL_EXECUTABLE(attr_idx)) {
03388 break;
03389 }
03390
03391 mif_attr_map[attr_idx].val = cvrt_label(attr_idx, flags, pos);
03392 lastblkix = blkix;
03393 blkix = mif_attr_map[attr_idx].val;
03394 msp.blk[blkix].pos = pos;
03395 if (VALID(lastblkix)) {
03396 mflow_local(&msp, lastblkix, blkix);
03397 }
03398 break;
03399
03400
03401 case Suppress_Opr :
03402 attr_idx = IR_IDX_R(ir_idx);
03403 mif_attr_map[attr_idx].val = cvrt_label(attr_idx, flags, pos);
03404 lastblkix = blkix;
03405 blkix = mif_attr_map[attr_idx].val;
03406 msp.blk[blkix].pos = pos;
03407 if (VALID(lastblkix)) {
03408 mflow_local(&msp, lastblkix, blkix);
03409 }
03410
03411
03412 cvrt_exp_to_mif(&opd0,
03413 &msp.blk[blkix],
03414 IR_IDX_L(ir_idx),
03415 IR_FLD_L(ir_idx),
03416 flags,
03417 value);
03418
03419 mif_opn_add(&msp.blk[blkix],
03420 mop_supp,
03421 get_basic_type(NONE),
03422 pos,
03423 flags |
03424 mopnflag_precious |
03425 mopnflag_immobile |
03426 mopnflag_variant |
03427 mopnflag_distinct,
03428 opd0, mopd_null, mopd_null);
03429 break;
03430
03431
03432 case Br_Uncond_Opr :
03433 attr_idx = IR_IDX_R(ir_idx);
03434 mif_attr_map[attr_idx].val = cvrt_label(attr_idx, flags, mpos_null);
03435 if (INVALID(blkix)) {
03436 blkix = mifalloc[mtag_blk](&msp);
03437 msp.blk[blkix].pos = pos;
03438 msp.blk[blkix].scope = local_scope;
03439 }
03440 mflow_local(&msp, blkix, mif_attr_map[attr_idx].val);
03441 blkix = NONE;
03442 break;
03443
03444
03445 case Br_True_Opr :
03446
03447 attr_idx = IR_IDX_R(ir_idx);
03448 mif_attr_map[attr_idx].val = cvrt_label(attr_idx, flags, mpos_null);
03449 if (INVALID(blkix)) {
03450 blkix = mifalloc[mtag_blk](&msp);
03451 msp.blk[blkix].pos = pos;
03452 msp.blk[blkix].scope = local_scope;
03453 }
03454
03455
03456 cvrt_exp_to_mif(&opd0, &msp.blk[blkix],
03457 IR_IDX_L(ir_idx), IR_FLD_L(ir_idx),
03458 flags, value);
03459
03460 mif_opn_add(&msp.blk[blkix],
03461 mop_if,
03462 get_basic_type(NONE),
03463 pos,
03464 flags,
03465 opd0,
03466 mopd_null,
03467 mopd_null);
03468
03469 lastblkix = blkix;
03470 blkix = mifalloc[mtag_blk](&msp);
03471 msp.blk[blkix].pos = pos;
03472 msp.blk[blkix].scope = local_scope;
03473
03474 mflow_local(&msp, lastblkix, blkix);
03475
03476 mflow_local(&msp, lastblkix, mif_attr_map[attr_idx].val);
03477 msp.blk[lastblkix].next = blkix;
03478
03479 break;
03480
03481
03482 case Br_Aif_Opr :
03483
03484
03485 i= IR_IDX_R(ir_idx);
03486 attr_idx = IL_IDX(i);
03487 mif_attr_map[attr_idx].val = cvrt_label(attr_idx, flags, mpos_null);
03488 eq0 = mif_attr_map[attr_idx].val;
03489
03490
03491 i = IL_NEXT_LIST_IDX(i);
03492 attr_idx = IL_IDX(i);
03493 mif_attr_map[attr_idx].val = cvrt_label(attr_idx, flags, mpos_null);
03494 gt0 = mif_attr_map[attr_idx].val;
03495
03496
03497 i = IL_NEXT_LIST_IDX(i);
03498 attr_idx = IL_IDX(i);
03499 mif_attr_map[attr_idx].val = cvrt_label(attr_idx, flags, mpos_null);
03500 lt0 = mif_attr_map[attr_idx].val;
03501
03502 if (INVALID(blkix)) {
03503 blkix = mifalloc[mtag_blk](&msp);
03504 msp.blk[blkix].pos = pos;
03505 msp.blk[blkix].scope = local_scope;
03506 }
03507
03508 cvrt_exp_to_mif(&opd0,
03509 &msp.blk[blkix],
03510 IR_IDX_L(ir_idx),
03511 IR_FLD_L(ir_idx),
03512 flags,
03513 value);
03514
03515
03516 if (lt0 == eq0 && eq0 == gt0) {
03517 mif_opn_add(&msp.blk[blkix],
03518 mop_paren,
03519 mopdtype(&msp, opd0, msp.blk[blkix].opn),
03520 pos,
03521 flags,
03522 opd0,
03523 mopd_null,
03524 mopd_null);
03525 mflow_local(&msp, blkix, lt0);
03526 blkix = NONE;
03527 break;
03528 }
03529
03530
03531 if (lt0 == eq0 || lt0 == gt0 || eq0 == gt0) {
03532
03533
03534 typeix = mopdtype(&msp, opd0, msp.blk[blkix].opn);
03535 opd = mopd_0;
03536 if (typeix != msp.immtype) {
03537 opd = mif_opn_add(&msp.blk[blkix], mop_cast,
03538 typeix, pos, flags,
03539 opd, mopd_null, mopd_null);
03540 }
03541
03542
03543 opd1 = mopd_0;
03544 if (lt0 == eq0) {
03545 opd1.val = mrelation_GT;
03546 }
03547 else if (lt0 == gt0) {
03548 opd1.val = mrelation_EQ;
03549 }
03550 else {
03551 opd1.val = mrelation_EQ | mrelation_GT;
03552 }
03553
03554 typ = *mtype_null[mtypeclass_bool];
03555 typ.mbool.kind = storage_bit_kind_tbl[LOGICAL_DEFAULT_TYPE];
03556 typ.mbool.size = mint(&msp,
03557 msp.immtype,
03558 (unsigned long) storage_bit_size_tbl[LOGICAL_DEFAULT_TYPE]);
03559 typ.mbool.prec = storage_bit_prec_tbl[LOGICAL_DEFAULT_TYPE];
03560
03561 opd0 = mif_opn_add(&msp.blk[blkix], mop_cmp,
03562 mtype_lookup(&msp, &typ),
03563 pos,
03564 flags,
03565 opd0,
03566 opd,
03567 opd1);
03568
03569 mflow_local(&msp, blkix, lt0);
03570 if (lt0 == eq0) {
03571 mflow_local(&msp, blkix, gt0);
03572 }
03573 else {
03574 mflow_local(&msp, blkix, eq0);
03575 }
03576
03577 op = mop_if;
03578 typeix = get_basic_type(NONE);
03579 }
03580 else {
03581
03582
03583 op = mop_aif;
03584
03585 typeix = get_basic_type(NONE);
03586 mflow_local(&msp, blkix, lt0);
03587 mflow_local(&msp, blkix, eq0);
03588 mflow_local(&msp, blkix, gt0);
03589
03590 }
03591
03592 mif_opn_add(&msp.blk[blkix],
03593 op,
03594 typeix,
03595 pos,
03596 flags,
03597 opd0,
03598 mopd_null,
03599 mopd_null);
03600
03601 blkix = NONE;
03602 break;
03603
03604
03605 case Br_Asg_Opr :
03606
03607 if (INVALID(blkix)) {
03608 blkix = mifalloc[mtag_blk](&msp);
03609 msp.blk[blkix].pos = pos;
03610 msp.blk[blkix].scope = local_scope;
03611 }
03612
03613 cvrt_exp_to_mif(&opd0, &msp.blk[blkix],
03614 IR_IDX_L(ir_idx), IR_FLD_L(ir_idx),
03615 flags, value);
03616
03617 (void) mif_opn_add(&msp.blk[blkix],
03618 mop_ijmp,
03619 get_basic_type(NONE),
03620 pos,
03621 flags,
03622 opd0,
03623 mopd_null,
03624 mopd_null);
03625
03626
03627 for (attr_idx = SCP_ASSIGN_LBL_CHAIN(curr_scp_idx);
03628 attr_idx != NULL_IDX;
03629 attr_idx = ATL_NEXT_ASG_LBL_IDX(attr_idx)) {
03630 mif_attr_map[attr_idx].val =
03631 cvrt_label(attr_idx, flags, mpos_null);
03632 mflow_local(&msp, blkix, mif_attr_map[attr_idx].val);
03633 }
03634
03635 blkix = NONE;
03636 break;
03637
03638
03639 case Br_Index_Opr :
03640
03641 if (INVALID(blkix)) {
03642 blkix = mifalloc[mtag_blk](&msp);
03643 msp.blk[blkix].pos = pos;
03644 msp.blk[blkix].scope = local_scope;
03645 }
03646
03647
03648 lastblkix = blkix;
03649 blkix = mifalloc[mtag_blk](&msp);
03650 msp.blk[blkix].pos = pos;
03651 msp.blk[blkix].scope = local_scope;
03652 msp.blk[lastblkix].next = blkix;
03653
03654
03655
03656 opd0 = mopd_0;
03657 opd1 = mopd_null;
03658 opd2 = mopd_0;
03659 for (i = 0, j = IR_IDX_R(ir_idx);
03660 i < IR_LIST_CNT_R(ir_idx);
03661 i++, j = IL_NEXT_LIST_IDX(j)) {
03662
03663 attr_idx = IL_IDX(j);
03664
03665 mif_attr_map[attr_idx].val =
03666 cvrt_label(attr_idx, flags, mpos_null);
03667
03668 opd0.val = i + 1;
03669 opd2.val = mflow_local(&msp, lastblkix,
03670 mif_attr_map[attr_idx].val);
03671
03672 opd1 = mif_opn_add(&msp.blk[lastblkix], mop_list,
03673 mopdtype(&msp, opd0, msp.blk[lastblkix].opn), pos,
03674 flags, opd0, opd1, opd2);
03675 }
03676
03677 cvrt_exp_to_mif(&opd0, &msp.blk[lastblkix],
03678 IR_IDX_L(ir_idx), IR_FLD_L(ir_idx),
03679 flags, value);
03680 opd2.val = mflow_local(&msp, lastblkix, blkix);
03681
03682 mif_opn_add(&msp.blk[lastblkix],
03683 mop_switch,
03684 get_basic_type(NONE),
03685 pos,
03686 flags,
03687 opd0,
03688 opd1,
03689 opd2);
03690 break;
03691
03692
03693 case Select_Opr :
03694
03695
03696 if (INVALID(blkix)) {
03697 blkix = mifalloc[mtag_blk](&msp);
03698 msp.blk[blkix].pos = pos;
03699 msp.blk[blkix].scope = local_scope;
03700 }
03701
03702
03703
03704
03705 opd = mopd_null;
03706 opd1 = mopd_null;
03707 opd2 = mopd_0;
03708
03709 case_ct = CN_INT_TO_C(IL_IDX(IR_IDX_R(ir_idx)));
03710 nested_case_ct = 0;
03711 for (tmp_sh = SH_NEXT_IDX(curr_sh);
03712 case_ct && tmp_sh != NULL_IDX;
03713 tmp_sh = SH_NEXT_IDX(tmp_sh)) {
03714
03715 if (SH_IR_IDX(tmp_sh) == NULL_IDX) {
03716 continue;
03717 }
03718
03719 if (IR_OPR(SH_IR_IDX(tmp_sh)) == Select_Opr) {
03720
03721 nested_case_ct +=
03722 CN_INT_TO_C(IL_IDX(IR_IDX_R(SH_IR_IDX(tmp_sh))));
03723 }
03724
03725 else if (IR_OPR(SH_IR_IDX(tmp_sh)) == Case_Opr) {
03726
03727 if (IR_IDX_L(SH_IR_IDX(tmp_sh)) == NULL_IDX) {
03728
03729 continue;
03730 }
03731
03732 if (nested_case_ct) {
03733 nested_case_ct--;
03734 }
03735
03736 else {
03737
03738 case_ct--;
03739
03740
03741 i = mifalloc[mtag_blk](&msp);
03742 msp.blk[i].pos = pos;
03743 msp.blk[i].scope = local_scope;
03744
03745
03746
03747 IR_LINE_NUM_R(SH_IR_IDX(tmp_sh)) = i;
03748
03749 cvrt_exp_to_mif(&opd0, &msp.blk[blkix],
03750 IR_IDX_L(SH_IR_IDX(tmp_sh)),
03751 IR_FLD_L(SH_IR_IDX(tmp_sh)),
03752 flags, value);
03753 opd2.val = mflow_local(&msp, blkix, i);
03754 opd1 = mif_opn_add(&msp.blk[blkix], mop_list,
03755 mopdtype(&msp, opd0, msp.blk[blkix].opn),
03756 pos, flags, opd0, opd1, opd2);
03757 }
03758 }
03759 }
03760
03761
03762 cvrt_exp_to_mif(&opd0,
03763 &msp.blk[blkix],
03764 IR_IDX_L(ir_idx),
03765 IR_FLD_L(ir_idx),
03766 flags, value);
03767
03768
03769 i = IL_NEXT_LIST_IDX(IR_IDX_R(ir_idx));
03770 if (IR_LIST_CNT_R(ir_idx) > 2) {
03771 i = IL_NEXT_LIST_IDX(i);
03772 }
03773 attr_idx = IL_IDX(i);
03774 mif_attr_map[attr_idx].val = cvrt_label(attr_idx, flags, mpos_null);
03775
03776
03777 opd = mopd_0;
03778 opd.val = mflow_local(&msp, blkix, mif_attr_map[attr_idx].val);
03779
03780 mif_opn_add(&msp.blk[blkix],
03781 mop_switch,
03782 get_basic_type(NONE),
03783 pos,
03784 flags,
03785 opd0,
03786 opd1,
03787 opd);
03788
03789 blkix = NONE;
03790
03791 break;
03792
03793
03794 case Case_Opr :
03795 if (IR_IDX_L(ir_idx) == NULL_IDX) {
03796
03797 break;
03798 }
03799
03800
03801 lastblkix = blkix;
03802 blkix = IR_LINE_NUM_R(ir_idx);
03803 msp.blk[blkix].pos = pos;
03804 if (VALID(lastblkix)) {
03805 mflow_local(&msp, lastblkix, blkix);
03806 }
03807 break;
03808
03809
03810 case Loop_Info_Opr :
03811
03812
03813
03814
03815
03816
03817
03818 idx = IR_IDX_R(ir_idx);
03819 idx = IL_NEXT_LIST_IDX(idx);
03820 idx = IL_IDX(idx);
03821 idx = IL_NEXT_LIST_IDX(idx);
03822 loop_end_label_idx = IL_IDX(idx);
03823 break;
03824
03825
03826 case Loop_End_Opr :
03827 break;
03828
03829
03830 case Init_Opr :
03831
03832 if (IR_FLD_L(ir_idx) == IR_Tbl_Idx &&
03833 IR_OPR(IR_IDX_L(ir_idx)) == Implied_Do_Opr) {
03834
03835
03836 data_value_idx = IR_IDX_R(ir_idx);
03837 data_values_consumed = 0;
03838
03839 cvrt_data_impl_do(IR_IDX_L(ir_idx), IR_FLD_L(ir_idx));
03840 }
03841 else {
03842
03843
03844
03845 initix = mifalloc[mtag_init](&msp);
03846 msp.init[initix].offset = fold_exp(IR_IDX_L(ir_idx),
03847 IR_FLD_L(ir_idx),
03848 &baseattr,
03849 &fldattr,
03850 &typeix);
03851
03852 i = IR_IDX_R(ir_idx);
03853
03854 cn_idx = IL_IDX(i);
03855
03856 switch (TYP_TYPE(CN_TYPE_IDX(cn_idx))) {
03857
03858 case Character :
03859 if ((IR_FLD_L(ir_idx) == IR_Tbl_Idx) &&
03860 ((IR_OPR(IR_IDX_L(ir_idx)) == Substring_Opr) ||
03861 (IR_OPR(IR_IDX_L(ir_idx)) == Whole_Substring_Opr))) {
03862 l_idx = IR_IDX_R(IR_IDX_L(ir_idx));
03863 l_idx = IL_NEXT_LIST_IDX(l_idx);
03864 l_idx = IL_NEXT_LIST_IDX(l_idx);
03865 msp.init[initix].size = CN_INT_TO_C(IL_IDX(l_idx)) *
03866 CHAR_BIT;
03867 }
03868 else {
03869 msp.init[initix].size =
03870 CN_INT_TO_C(TYP_IDX(CN_TYPE_IDX(cn_idx))) * CHAR_BIT;
03871 }
03872 break;
03873
03874 case Typeless :
03875 msp.init[initix].size = TYP_BIT_LEN(CN_TYPE_IDX(cn_idx));
03876 break;
03877
03878 default :
03879 if (msp.type[typeix].u.size.tag != mtag_imm) {
03880 t = mif_con_to_host_long(&msp,
03881 msp.type[typeix].u.size.val);
03882 }
03883 else {
03884 t = msp.type[typeix].u.size.val;
03885 }
03886
03887 msp.init[initix].size = t;
03888 break;
03889 }
03890
03891 cvrt_const((char *)&CN_CONST(cn_idx),
03892 CN_TYPE_IDX(cn_idx),
03893 ATD_TYPE_IDX(fldattr),
03894 &msp.init[initix].val);
03895
03896 i = IL_NEXT_LIST_IDX(i);
03897 msp.init[initix].count = CN_INT_TO_C(IL_IDX(i));
03898
03899 i = IL_NEXT_LIST_IDX(i);
03900 msp.init[initix].stride = CN_INT_TO_C(IL_IDX(i));
03901 if (!msp.init[initix].stride) {
03902 msp.init[initix].stride = msp.init[initix].size;
03903 }
03904
03905 insert_init(initix,
03906 mif_attr_map[baseattr].tag,
03907 mif_attr_map[baseattr].val);
03908 }
03909 break;
03910
03911
03912 case Init_Reloc_Opr :
03913 initix = mifalloc[mtag_init](&msp);
03914
03915 if (msp.ldexpr == 0) {
03916 mifalloc[mtag_ldexpr](&msp);
03917 }
03918
03919 offset = fold_exp(IR_IDX_L(ir_idx),
03920 IR_FLD_L(ir_idx),
03921 &baseattr, &fldattr, &typeix);
03922
03923 # if defined(_TARGET_OS_SOLARIS) || (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX))
03924 loc_offset_idx = IL_IDX(IL_NEXT_LIST_IDX(IR_IDX_R(ir_idx)));
03925
03926
03927 COPY_OPND(opnd, IL_OPND(IR_IDX_R(ir_idx)));
03928 attr_idx = find_left_attr(&opnd);
03929
03930 # ifdef _DEBUG
03931 if (SB_FIRST_ATTR_IDX(ATD_STOR_BLK_IDX(attr_idx)) == NULL_IDX) {
03932 PRINTMSG(IR_LINE_NUM(ir_idx), 1049, Internal,
03933 IR_COL_NUM(ir_idx));
03934 }
03935 # endif
03936
03937 offset1.idx = ATD_OFFSET_IDX(attr_idx);
03938 offset1.fld = ATD_OFFSET_FLD(attr_idx);
03939 result.idx = ATD_OFFSET_IDX(SB_FIRST_ATTR_IDX(
03940 ATD_STOR_BLK_IDX(attr_idx)));
03941 result.fld = ATD_OFFSET_FLD(SB_FIRST_ATTR_IDX(
03942 ATD_STOR_BLK_IDX(attr_idx)));
03943
03944 size_offset_binary_calc(&offset1, &result, Minus_Opr, &result);
03945
03946 offset1.idx = loc_offset_idx;
03947 offset1.fld = CN_Tbl_Idx;
03948
03949 size_offset_binary_calc(&offset1, &result, Plus_Opr, &result);
03950
03951 attr_idx = SB_FIRST_ATTR_IDX(ATD_STOR_BLK_IDX(attr_idx));
03952
03953 OPND_FLD(opnd) = AT_Tbl_Idx;
03954 OPND_IDX(opnd) = attr_idx;
03955 OPND_LINE_NUM(opnd) = IR_LINE_NUM(ir_idx);
03956 OPND_COL_NUM(opnd) = IR_COL_NUM(ir_idx);
03957
03958
03959 COPY_OPND(IR_OPND_L(IL_IDX(IR_IDX_R(ir_idx))), opnd);
03960 IR_OPR(IL_IDX(IR_IDX_R(ir_idx))) = Aloc_Opr;
03961 IR_TYPE_IDX(IL_IDX(IR_IDX_R(ir_idx))) = CRI_Ptr_8;
03962
03963 cvrt_exp_to_mif(&opd1,
03964 msp.ldexpr,
03965 IL_IDX(IR_IDX_R(ir_idx)),
03966 IL_FLD(IR_IDX_R(ir_idx)),
03967 flags,
03968 value);
03969
03970 char_bit.fld = CN_Tbl_Idx;
03971 char_bit.idx = CN_INTEGER_CHAR_BIT_IDX;
03972
03973 size_offset_binary_calc(&result, &char_bit, Div_Opr, &result);
03974
03975 # ifdef _TARGET32
03976 if (TYP_LINEAR(result.type_idx) == Integer_8) {
03977 result.constant[0] = result.constant[1];
03978 result.type_idx = CG_INTEGER_DEFAULT_TYPE;
03979 result.fld = NO_Tbl_Idx;
03980 }
03981 # endif
03982
03983 if (result.fld == NO_Tbl_Idx) {
03984 cn_idx = ntr_const_tbl(result.type_idx, FALSE, result.constant);
03985 }
03986 else if (result.fld == CN_Tbl_Idx) {
03987 cn_idx = result.idx;
03988 }
03989 else {
03990 PRINTMSG(IR_LINE_NUM(ir_idx), 1201, Internal,
03991 IR_COL_NUM(ir_idx), " ");
03992 }
03993
03994 cvrt_exp_to_mif(&opd2,
03995 msp.ldexpr,
03996 cn_idx,
03997 CN_Tbl_Idx,
03998 flags,
03999 value);
04000
04001 opd0 = mif_opn_add(msp.ldexpr,
04002 mop_pinc,
04003 mopdtype(&msp, opd1, msp.ldexpr->opn),
04004 mpos_null,
04005 0,
04006 opd1,
04007 opd2,
04008 mopd_null);
04009 # else
04010 cvrt_exp_to_mif(&opd0,
04011 msp.ldexpr,
04012 IL_IDX(IR_IDX_R(ir_idx)),
04013 IL_FLD(IR_IDX_R(ir_idx)),
04014 flags,
04015 value);
04016 # endif
04017
04018 msp.init[initix].val = opd0;
04019 msp.init[initix].offset = offset;
04020 msp.init[initix].count = 1;
04021 msp.init[initix].size = TARGET_BITS_PER_WORD;
04022 msp.init[initix].stride = msp.init[initix].size;
04023
04024 insert_init(initix,
04025 mif_attr_map[baseattr].tag,
04026 mif_attr_map[baseattr].val);
04027 break;
04028
04029
04030
04031 case Use_Opr:
04032
04033 # if defined(_MODULE_TO_DOT_o)
04034
04035 if (ATP_MOD_PATH_IDX(IR_IDX_L(ir_idx)) != NULL_IDX) {
04036
04037 if (INVALID(blkix)) {
04038 blkix = mifalloc[mtag_blk](&msp);
04039 msp.blk[blkix].pos = pos;
04040 msp.blk[blkix].scope = local_scope;
04041 }
04042
04043 length = ATP_MOD_PATH_LEN(IR_IDX_L(ir_idx));
04044
04045 typ = *mtype_null[mtypeclass_raw];
04046 typ.mraw.size = mint(&msp,
04047 msp.immtype,
04048 (unsigned long)(length * CHAR_BIT));
04049
04050 opd0.tag = mtag_con;
04051 opd0.val = mcon_lookup(&msp,
04052 mtype_lookup(&msp, &typ),
04053 (char *)ATP_MOD_PATH_NAME_PTR(IR_IDX_L(ir_idx)),
04054 NONE);
04055
04056 length = ATP_EXT_NAME_LEN(IR_IDX_L(ir_idx));
04057
04058 typ = *mtype_null[mtypeclass_raw];
04059 typ.mraw.size = mint(&msp,
04060 msp.immtype,
04061 (unsigned long)(length * CHAR_BIT));
04062
04063 opd1.tag = mtag_con;
04064 opd1.val = mcon_lookup(&msp,
04065 mtype_lookup(&msp, &typ),
04066 (char *)ATP_EXT_NAME_PTR(IR_IDX_L(ir_idx)),
04067 NONE);
04068
04069 mif_opn_add(&msp.blk[blkix],
04070 mop_usepath,
04071 get_basic_type(NONE),
04072 pos,
04073 flags,
04074 opd0,
04075 opd1,
04076 mopd_null);
04077 }
04078 # endif
04079
04080 break;
04081
04082 default:
04083 if (INVALID(blkix)) {
04084 blkix = mifalloc[mtag_blk](&msp);
04085 msp.blk[blkix].pos = pos;
04086 msp.blk[blkix].scope = local_scope;
04087 }
04088
04089 cvrt_exp_to_mif(&opd,
04090 &msp.blk[blkix],
04091 ir_idx,
04092 IR_Tbl_Idx,
04093 flags,
04094 address);
04095 break;
04096 }
04097 }
04098 }
04099
04100 TRACE (Func_Exit, "cvrt_ir_to_mif", NULL);
04101
04102 }
04103
04104
04105
04106
04107
04108
04109
04110
04111
04112
04113
04114
04115
04116
04117
04118
04119
04120
04121
04122
04123 static int get_basic_type(int type_idx)
04124
04125 {
04126 int idx;
04127 mtype_t typ;
04128 int btype;
04129
04130 TRACE (Func_Entry, "get_basic_type", NULL);
04131
04132 if (type_idx == NONE) {
04133 typ = *mtype_null[mtypeclass_void];
04134 typ.mvoid.size = mint(&msp, msp.immtype, (unsigned long) 0);
04135 idx = mtype_lookup(&msp, &typ);
04136 }
04137 else {
04138
04139 switch (TYP_TYPE(type_idx)) {
04140
04141 case Typeless :
04142 typ = *mtype_null[mtypeclass_raw];
04143 typ.mraw.size = mint(&msp, msp.immtype,
04144 (unsigned long) TYP_BIT_LEN(type_idx));
04145 idx = mtype_lookup(&msp, &typ);
04146 break;
04147
04148
04149 case Integer :
04150 typ = *mtype_null[mtypeclass_int];
04151
04152 switch (TYP_LINEAR(type_idx)) {
04153 case Integer_1:
04154 case Integer_2:
04155 case Integer_4:
04156 # ifdef _TARGET64
04157 if (unsigned_type) {
04158 typ.mint.flags |= mtypeflag_unsigned;
04159 }
04160 # endif
04161 break;
04162 }
04163
04164 typ.mint.kind = storage_bit_kind_tbl[TYP_LINEAR(type_idx)];
04165 typ.mint.size = mint(&msp, msp.immtype,
04166 (unsigned long) storage_bit_size_tbl[TYP_LINEAR(type_idx)]);
04167 typ.mint.prec = storage_bit_prec_tbl[TYP_LINEAR(type_idx)];
04168 idx = mtype_lookup(&msp, &typ);
04169 break;
04170
04171
04172 case Logical :
04173 typ = *mtype_null [mtypeclass_bool];
04174 typ.mint.kind = storage_bit_kind_tbl[TYP_LINEAR(type_idx)];
04175 typ.mint.size = mint(&msp, msp.immtype,
04176 (unsigned long) storage_bit_size_tbl[TYP_LINEAR(type_idx)]);
04177 typ.mint.prec = storage_bit_prec_tbl[TYP_LINEAR(type_idx)];
04178 idx = mtype_lookup(&msp, &typ);
04179 break;
04180
04181
04182 case Real :
04183 typ = *mtype_null[mtypeclass_float];
04184 typ.mint.kind = storage_bit_kind_tbl[TYP_LINEAR(type_idx)];
04185 typ.mint.size = mint(&msp, msp.immtype,
04186 (unsigned long) storage_bit_size_tbl[TYP_LINEAR(type_idx)]);
04187 typ.mint.prec = storage_bit_prec_tbl[TYP_LINEAR(type_idx)];
04188 idx = mtype_lookup(&msp, &typ);
04189 break;
04190
04191
04192 case Complex :
04193 typ = *mtype_null [mtypeclass_complex];
04194 typ.mint.kind = storage_bit_kind_tbl[TYP_LINEAR(type_idx)];
04195 typ.mint.size = mint(&msp, msp.immtype,
04196 (unsigned long) storage_bit_size_tbl[TYP_LINEAR(type_idx)]);
04197 typ.mint.prec = storage_bit_prec_tbl[TYP_LINEAR(type_idx)];
04198 idx = mtype_lookup(&msp, &typ);
04199 break;
04200
04201
04202 case Character :
04203 typ = *mtype_null[mtypeclass_fchar];
04204 typ.mfchar.prec = storage_bit_prec_tbl[TYP_LINEAR(type_idx)];
04205
04206 switch (TYP_CHAR_CLASS(type_idx)) {
04207 case Assumed_Size_Char :
04208 case Var_Len_Char :
04209 typ.mfchar.temp.val = cvrt_attr_ntry(TYP_IDX(type_idx));
04210 typ.mfchar.temp.tag = mif_attr_map[TYP_IDX(type_idx)].tag;
04211 break;
04212
04213 case Const_Len_Char :
04214 typ.mfchar.size = mint(&msp, msp.immtype,
04215 (unsigned long) (CHAR_BIT * CN_INT_TO_C(TYP_IDX(type_idx))));
04216 break;
04217 }
04218
04219 idx = mtype_lookup(&msp, &typ);
04220 break;
04221
04222
04223 case Structure :
04224 idx = cvrt_derived_type(TYP_IDX(type_idx));
04225 break;
04226
04227
04228 case CRI_Ptr :
04229
04230
04231
04232
04233 typ = *mtype_null[mtypeclass_addr];
04234 typ.maddr.size = mint(&msp, msp.immtype,
04235 (unsigned long) storage_bit_size_tbl[CRI_Ptr_8]);
04236 typ.maddr.prec = TYP_PTR_INCREMENT(type_idx);
04237 typ.maddr.aliasing = maliasclass_restrict;
04238 idx = mtype_lookup(&msp, &typ);
04239 break;
04240
04241
04242 case CRI_Ch_Ptr :
04243
04244
04245 typ = *mtype_null[mtypeclass_fchar];
04246 typ.mfchar.prec = CHAR_BIT;
04247 btype = mtype_lookup(&msp, &typ);
04248
04249 typ = *mtype_null[mtypeclass_addr];
04250 typ.maddr.size = mint(&msp, msp.immtype,
04251 (unsigned long) storage_bit_size_tbl[CRI_Ch_Ptr_8]);
04252 typ.maddr.prec = storage_bit_prec_tbl[CRI_Ch_Ptr_8];
04253 typ.maddr.base = btype;
04254 typ.maddr.aliasing = maliasclass_restrict;
04255
04256 idx = mtype_lookup(&msp, &typ);
04257 break;
04258
04259
04260 case CRI_Parcel_Ptr :
04261 typ = *mtype_null[mtypeclass_blkaddr];
04262 typ.mblkaddr.size = mint(&msp, msp.immtype,
04263 (unsigned long) storage_bit_size_tbl[CRI_Parcel_Ptr_8]);
04264 idx = mtype_lookup(&msp, &typ);
04265 break;
04266
04267
04268 default :
04269 PRINTMSG(1, 1044, Internal, 0, "unexpected TYP_TYPE value");
04270
04271 }
04272
04273 }
04274
04275 TRACE (Func_Exit, "get_basic_type", NULL);
04276
04277 return(idx);
04278
04279 }
04280
04281
04282
04283
04284
04285
04286
04287
04288
04289
04290
04291
04292
04293
04294
04295
04296
04297
04298 static int get_ptr_type(fld_type field,
04299 int idx)
04300 {
04301 int typ_idx;
04302 mtype_t type;
04303
04304
04305 TRACE (Func_Exit, "get_ptr_type", NULL);
04306
04307 type = *mtype_null[mtypeclass_addr];
04308
04309 if (field == AT_Tbl_Idx) {
04310 type.maddr.base = get_type_idx(idx);
04311
04312 if (AT_OBJ_CLASS(idx) == Data_Obj &&
04313 (ATD_CLASS(idx) == Dummy_Argument ||
04314 ATD_CLASS(idx) == Function_Result ||
04315 ATD_CLASS(idx) == CRI__Pointee)) {
04316 type.maddr.aliasing = maliasclass_restrict;
04317 }
04318 else {
04319 type.maddr.aliasing = maliasclass_anytype;
04320 }
04321 }
04322 else if (field == IR_Tbl_Idx) {
04323 type.maddr.base = get_basic_type(IR_TYPE_IDX(idx));
04324
04325 if (IR_OPR(idx) == Const_Tmp_Loc_Opr) {
04326 type.maddr.aliasing = maliasclass_restrict;
04327 }
04328 else {
04329 type.maddr.aliasing = maliasclass_anytype;
04330 }
04331 }
04332
04333 typ_idx = type.maddr.base;
04334 while (VALID(msp.type[typ_idx].u.base)) {
04335 typ_idx = msp.type[typ_idx].u.base;
04336 }
04337
04338 if (msp.type[typ_idx].u.class == mtypeclass_fchar) {
04339 type.maddr.size = mint(&msp, msp.immtype,
04340 (unsigned long) storage_bit_size_tbl[CRI_Ch_Ptr_8]);
04341 type.maddr.prec = storage_bit_prec_tbl[CRI_Ch_Ptr_8];
04342 }
04343 else {
04344 type.maddr.size = mint(&msp, msp.immtype,
04345 (unsigned long) storage_bit_size_tbl[CRI_Ptr_8]);
04346 type.maddr.prec = storage_bit_prec_tbl[CRI_Ptr_8];
04347 }
04348
04349 TRACE (Func_Exit, "get_ptr_type", NULL);
04350
04351 return(mtype_lookup(&msp, &type));
04352 }
04353
04354
04355
04356
04357
04358
04359
04360
04361
04362
04363
04364
04365
04366
04367
04368
04369
04370
04371 static int get_type_idx(int input_idx)
04372 {
04373 int array_idx;
04374 int attr_idx;
04375 int i;
04376 int j;
04377 int mtype;
04378 size_offset_type size;
04379 long temp;
04380 int tmp_idx;
04381 mtype_t typ;
04382 int type_idx;
04383 long val;
04384
04385
04386 TRACE (Func_Entry, "get_type_idx", NULL);
04387
04388 if (VALID(mif_attr_type_map[input_idx])) {
04389
04390 return(mif_attr_type_map[input_idx]);
04391 }
04392
04393 mtype = 0;
04394
04395 switch (AT_OBJ_CLASS(input_idx)) {
04396
04397 case Data_Obj:
04398 attr_idx = input_idx;
04399
04400 if (ATD_CLASS(attr_idx) == CRI__Pointee &&
04401 TYP_TYPE(ATD_TYPE_IDX(ATD_PTR_IDX(attr_idx))) == CRI_Ch_Ptr) {
04402
04403 typ = *mtype_null[mtypeclass_fchar];
04404 typ.mfchar.prec = storage_bit_prec_tbl[CRI_Ch_Ptr_8];
04405 typ.mfchar.temp.val = cvrt_attr_ntry(ATD_PTR_IDX(attr_idx));
04406 typ.mfchar.temp.tag = mif_attr_map[ATD_PTR_IDX(attr_idx)].tag;
04407
04408 type_idx = mtype_lookup(&msp, &typ);
04409 }
04410 else {
04411 type_idx = get_basic_type(ATD_TYPE_IDX(attr_idx));
04412 }
04413 break;
04414
04415 case Pgm_Unit:
04416 if (ATP_PGM_UNIT(input_idx) == Function) {
04417 attr_idx = ATP_RSLT_IDX(input_idx);
04418
04419
04420
04421
04422 if (ATP_EXPL_ITRFC(input_idx) && !ATP_SCP_ALIVE(input_idx)) {
04423 if (TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == Character &&
04424 TYP_CHAR_CLASS(ATD_TYPE_IDX(attr_idx)) != Const_Len_Char) {
04425 cvrt_attr_ntry(TYP_IDX(ATD_TYPE_IDX(attr_idx)));
04426 }
04427 }
04428
04429 type_idx = get_basic_type(ATD_TYPE_IDX(attr_idx));
04430 }
04431 else {
04432 type_idx = get_basic_type(NONE);
04433 goto EXIT;
04434 }
04435 break;
04436
04437 default:
04438 PRINTMSG(AT_DEF_LINE(input_idx), 450, Internal, 0, "get_type_idx");
04439 break;
04440
04441 }
04442
04443
04444
04445 if (ATD_IM_A_DOPE(attr_idx)) {
04446
04447 typ = *mtype_null [mtypeclass_dope];
04448 typ.mdope.base = type_idx;
04449 typ.mdope.rank = (ATD_ARRAY_IDX(attr_idx) == NULL_IDX)
04450 ? 0
04451 : BD_RANK(ATD_ARRAY_IDX(attr_idx));
04452 typ.mdope.size = mint(&msp, msp.immtype,
04453 (unsigned long) (TARGET_BITS_PER_WORD * (6 + 3 * typ.mdope.rank)));
04454 type_idx = mtype_lookup(&msp, &typ);
04455 }
04456
04457 else if (ATD_ARRAY_IDX(attr_idx) != NULL_IDX) {
04458
04459 array_idx = ATD_ARRAY_IDX(attr_idx);
04460
04461 typ = *mtype_null[mtypeclass_array];
04462 typ.marray.base = get_basic_type(ATD_TYPE_IDX(attr_idx));
04463 typ.marray.rank = BD_RANK(array_idx);
04464
04465 if (typ.marray.rank) {
04466
04467
04468
04469 MEM_ALLOC(typ.marray.low, mopd_t, typ.marray.rank);
04470 MEM_ALLOC(typ.marray.stride, mopd_t, typ.marray.rank);
04471 MEM_ALLOC(typ.marray.extent, mopd_t, typ.marray.rank);
04472 }
04473
04474 if (BD_ARRAY_CLASS(array_idx) <= Assumed_Size) {
04475 size = stor_bit_size_of(attr_idx, FALSE, FALSE);
04476
04477
04478
04479 if (size.fld == CN_Tbl_Idx) {
04480 typ.marray.size = mint(&msp, msp.immtype,
04481 (unsigned long) CN_INT_TO_C(size.idx));
04482 }
04483 else {
04484 typ.marray.size = mint(&msp, msp.immtype,
04485 (unsigned long) CN_BIG_INT_TO_LONG(size));
04486 }
04487 }
04488
04489 for (i = 1; i <= BD_RANK(array_idx); i++) {
04490
04491
04492 if (BD_LB_FLD(array_idx, i) == CN_Tbl_Idx) {
04493 cvrt_exp_to_mif(&typ.marray.low[i-1], 0,
04494 BD_LB_IDX(array_idx,i), CN_Tbl_Idx,
04495 mopnflag_syn, value);
04496 }
04497 else {
04498 j = BD_LB_IDX(array_idx, i);
04499 typ.marray.low[i-1].tag = mtag_lsym;
04500 typ.marray.low[i-1].val = cvrt_attr_ntry(j);
04501 }
04502
04503
04504 if (BD_SM_FLD(array_idx, i) == CN_Tbl_Idx) {
04505 cvrt_exp_to_mif(&typ.marray.stride[i-1], 0,
04506 BD_SM_IDX(array_idx,i), CN_Tbl_Idx,
04507 mopnflag_syn, value);
04508 }
04509 else {
04510 j = BD_SM_IDX(array_idx, i);
04511 typ.marray.stride[i-1].tag = mtag_lsym;
04512 typ.marray.stride[i-1].val = cvrt_attr_ntry(j);
04513 }
04514
04515
04516 if (BD_XT_FLD(array_idx, i) == CN_Tbl_Idx) {
04517 cvrt_exp_to_mif(&typ.marray.extent[i-1],
04518 0,
04519 BD_XT_IDX(array_idx,i),
04520 CN_Tbl_Idx,
04521 mopnflag_syn,
04522 value);
04523
04524 if (typ.marray.size.tag != mtag_imm) {
04525 temp = mif_con_to_host_long(&msp, typ.marray.size.val);
04526 }
04527 else {
04528 temp = typ.marray.size.val;
04529 }
04530
04531 typ.marray.size = mint(&msp, msp.immtype,
04532 (unsigned long) (temp * CN_INT_TO_C(BD_XT_IDX(array_idx, i))));
04533 }
04534 else {
04535 j = BD_XT_IDX(array_idx, i);
04536 typ.marray.extent[i-1].tag = mtag_lsym;
04537 typ.marray.extent[i-1].val = cvrt_attr_ntry(j);
04538 typ.marray.size = mint(&msp, msp.immtype, (unsigned long) 0);
04539 }
04540 }
04541
04542 type_idx = mtype_lookup(&msp, &typ);
04543 }
04544
04545 EXIT:
04546 mif_attr_type_map[input_idx] = type_idx;
04547 return(type_idx);
04548
04549 TRACE (Func_Exit, "get_type_idx", NULL);
04550 }
04551
04552
04553
04554
04555
04556
04557
04558
04559
04560
04561
04562
04563
04564
04565
04566
04567
04568
04569
04570 static void cvrt_dummy_procedure(int attr_idx)
04571
04572 {
04573 mtype_t ftype, ptype;
04574 int symix;
04575
04576 TRACE (Func_Entry, "cvrt_dummy_procedure", NULL);
04577
04578
04579 ftype = *mtype_null [mtypeclass_func];
04580 ftype.mfunc.base = get_type_idx(attr_idx);
04581 ftype.mfunc.flags = mtypeflag_arg_mystery;
04582 ptype = *mtype_null[mtypeclass_addr];
04583 ptype.maddr.size = mint(&msp, msp.immtype, (unsigned long)
04584 storage_bit_size_tbl[CRI_Ptr_8]);
04585 ptype.maddr.prec = storage_bit_prec_tbl[CRI_Ptr_8];
04586 ptype.maddr.aliasing = maliasclass_restrict;
04587 ptype.maddr.base = mtype_lookup(&msp, &ftype);
04588
04589 symix = mifalloc[mtag_lsym](&msp);
04590 mif_attr_map[attr_idx].tag = mtag_lsym;
04591 mif_attr_map[attr_idx].val = symix;
04592 msp.lsym[symix].name = mnpool(&msp, AT_OBJ_NAME_PTR(attr_idx));
04593 msp.lsym[symix].scope = local_scope;
04594
04595
04596 if (AT_REF_IN_CHILD(attr_idx)) {
04597 msp.lsym[symix].flags |= msymflag_child_ref;
04598 }
04599 if (AT_DEF_IN_CHILD(attr_idx)) {
04600 msp.lsym[symix].flags |= msymflag_child_def;
04601 }
04602 if (AT_DEFINED(attr_idx)) {
04603 msp.lsym[symix].flags |= msymflag_modified;
04604 }
04605 msp.lsym[symix].storage = mstorage_formal;
04606 msp.lsym[symix].type = mtype_lookup(&msp, &ptype);
04607
04608 TRACE (Func_Exit, "cvrt_dummy_procedure", NULL);
04609
04610 }
04611
04612
04613
04614
04615
04616
04617
04618
04619
04620
04621
04622
04623
04624
04625
04626
04627
04628
04629
04630
04631 static int cvrt_darg_list(int pgm_attr_idx)
04632
04633 {
04634 int i;
04635 int attr_idx;
04636 int size;
04637 int sn_idx;
04638 mtype_t ftype, ptype;
04639 msym_t *s;
04640 int symix = NONE;
04641 int sym2ix;
04642 int first_sym2_idx = NONE;
04643 int last_sym2_idx = NONE;
04644
04645
04646 TRACE (Func_Entry, "cvrt_darg_list", NULL);
04647
04648 for (i = 0; i < ATP_NUM_DARGS(pgm_attr_idx); i++) {
04649
04650 sn_idx = ATP_FIRST_IDX(pgm_attr_idx) + i;
04651 attr_idx = SN_ATTR_IDX(sn_idx);
04652
04653 if (!ATP_IN_INTERFACE_BLK(pgm_attr_idx)) {
04654
04655 if (mif_attr_map[attr_idx].tag == mtag_none) {
04656
04657
04658 if (AT_OBJ_CLASS(attr_idx) == Data_Obj) {
04659 cvrt_attr_ntry(attr_idx);
04660 }
04661 else {
04662 cvrt_dummy_procedure(attr_idx);
04663 }
04664 }
04665
04666 symix = mif_attr_map[attr_idx].val;
04667 }
04668
04669
04670 sym2ix = mifalloc[mtag_sym2](&msp);
04671
04672 if ((symix != NONE) && (msp.lsym[symix].flags & msymflag_implicit)) {
04673 msp.sym2[sym2ix].flags |= msym2flag_implicit;
04674 }
04675
04676 if (AT_OPTIONAL(attr_idx)) {
04677 msp.sym2[sym2ix].flags |= msym2flag_optional;
04678 }
04679
04680 msp.sym2[sym2ix].lang = mlang_F90;
04681 msp.sym2[sym2ix].name = mnpool(&msp, AT_OBJ_NAME_PTR(attr_idx));
04682
04683 if (symix != NONE) {
04684 s = &msp.lsym[symix];
04685 s->argsym2_ct += 1;
04686
04687 if (s->argsym2_ct == 1) {
04688 MEM_ALLOC(s->argsym2, int, s->argsym2_ct);
04689 }
04690 else {
04691 MEM_REALLOC(s->argsym2, int, s->argsym2_ct);
04692 }
04693
04694 s->argsym2[s->argsym2_ct-1] = sym2ix;
04695
04696 if (AT_OBJ_CLASS (attr_idx) == Data_Obj) {
04697 symix = msp.lsym[symix].base.val;
04698 }
04699
04700 msp.sym2[sym2ix].type = msp.lsym[symix].type;
04701 }
04702 else {
04703
04704 msp.sym2[sym2ix].type = get_ptr_type(AT_Tbl_Idx, attr_idx);
04705 }
04706
04707
04708
04709 if (AT_OBJ_CLASS(attr_idx) == Data_Obj) {
04710 switch (ATD_INTENT(attr_idx)) {
04711 case Intent_In :
04712 msp.sym2[sym2ix].intent = mintent_in;
04713 break;
04714 case Intent_Out :
04715 msp.sym2[sym2ix].intent = mintent_out;
04716 break;
04717 default :
04718 if (ATD_CLASS(attr_idx) == Function_Result) {
04719 msp.sym2[sym2ix].intent = mintent_out;
04720 }
04721 else {
04722 msp.sym2[sym2ix].intent = mintent_in_out;
04723 }
04724 break;
04725 }
04726 }
04727 else
04728 msp.sym2[sym2ix].intent = mintent_in_out;
04729
04730 if (VALID(last_sym2_idx)) {
04731 msp.sym2[last_sym2_idx].next = sym2ix;
04732 }
04733 else {
04734 first_sym2_idx = sym2ix;
04735 }
04736 last_sym2_idx = sym2ix;
04737 }
04738
04739 TRACE (Func_Exit, "cvrt_darg_list", NULL);
04740
04741 return(first_sym2_idx);
04742
04743 }
04744
04745
04746
04747
04748
04749
04750
04751
04752
04753
04754
04755
04756
04757
04758
04759
04760
04761
04762
04763
04764
04765
04766
04767 static void cvrt_proc(int attr_idx,
04768 int alt_entry_idx,
04769 enum proc_call_class call_type)
04770
04771 {
04772
04773 int i;
04774 int pgm_unit;
04775 int funcix;
04776 mtype_t type;
04777 mtype_t typ;
04778 int proc;
04779 int main_entry_idx;
04780 char *p;
04781 int rslt_idx;
04782 int parent_attr;
04783 mpos_t pos;
04784
04785
04786 TRACE (Func_Entry, "cvrt_proc", NULL);
04787
04788 if (call_type == Imported) {
04789
04790
04791 if (ATP_PROC(attr_idx) == Dummy_Proc) {
04792 if (mif_attr_map[attr_idx].tag == mtag_none) {
04793
04794 cvrt_dummy_procedure(attr_idx);
04795 }
04796 goto EXIT;
04797 }
04798
04799 if (ATP_PGM_UNIT(attr_idx) == Module && ATP_IN_CURRENT_COMPILE(attr_idx)){
04800
04801
04802 goto EXIT;
04803 }
04804 else if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) == Module) {
04805
04806 goto EXIT;
04807 }
04808 else if (AT_REFERENCED(attr_idx) == Not_Referenced &&
04809 !ATP_DCL_EXTERNAL(attr_idx)) {
04810
04811
04812
04813
04814 goto EXIT;
04815 }
04816 }
04817
04818 pgm_unit = ATP_PGM_UNIT(attr_idx);
04819
04820
04821 if (mif_attr_map[attr_idx].tag != mtag_func) {
04822 mif_attr_map[attr_idx].tag = mtag_func;
04823 mif_attr_map[attr_idx].val = mifalloc[mtag_func](&msp);
04824 }
04825
04826 pos = mpos_null;
04827 pos.line = source_position(AT_DEF_LINE(attr_idx));
04828 pos.src = srcix;
04829 pos.col = AT_DEF_COLUMN(attr_idx);
04830
04831 funcix = mif_attr_map[attr_idx].val;
04832 msp.func[funcix].lang = mlang_F90;
04833 msp.func[funcix].pos = pos;
04834
04835
04836 if (attr_idx == glb_tbl_idx[