1 /*
2 * Copyright (c) 1993-2019, NVIDIA CORPORATION. All rights reserved.
3 *
4 * Licensed under the Apache License, Version 2.0 (the "License");
5 * you may not use this file except in compliance with the License.
6 * You may obtain a copy of the License at
7 *
8 * http://www.apache.org/licenses/LICENSE-2.0
9 *
10 * Unless required by applicable law or agreed to in writing, software
11 * distributed under the License is distributed on an "AS IS" BASIS,
12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13 * See the License for the specific language governing permissions and
14 * limitations under the License.
15 *
16 */
17
18 /* \file
19 * ilmutil.c - SCC/SCFTN ILM utilities used by Semantic Analyzer. */
20
21 /* Contents:
22 *
23 * addlabel(sptr) - add label ilm
24 * ad1ilm(opc) - append 1 ILM word to ILM buffer.
25 * ad2ilm(opc,op1) - append 2 ILM words.
26 * ad3ilm(opc,op1,op2) - append 3 ILM words.
27 * ad4ilm(opc,op1,op2,op3) - append 4 ILM words.
28 * ad5ilm(opc,op1,op2,op3,
29 * op4) - append 5 ILM words.
30 * wrilms(linenum) - write block of ILM's to ILM file.
31 * save_ilms(area) - copy ilms into working storage area and
32 * return pointer to copy.
33 * add_ilms(p) - copy ILM's into ILM buffer.
34 * mkbranch(ilmptr,truelb) - convert logical expr into branches.
35 * dmpilms() - dump block of ILM's to debug listing file.
36 * int rdilms() - read in an ILM block
37 */
38
39 #include "ilmutil.h"
40 #include "error.h"
41 #include "ilmtp.h"
42 #include "ilm.h"
43 #include "fih.h"
44 #include "semant.h"
45 #include "pragma.h"
46 #include "outliner.h"
47 #include "symfun.h"
48 #include "mp.h"
49
50 ILMB ilmb;
51
52 GILMB gilmb = {0, 0, 0, 0, 0, 0, 0, 0};
53 GILMB next_gilmb = {0, 0, 0, 0, 0, 0, 0, 0};
54
55 /* reserve a few words before each ILM block in gilmb
56 * to store global information */
57 #define GILMSAVE 2
58 /* are we in global mode? */
59 int ilmpos = 0;
60 extern ILM_T *ilm_base; /* base ptr for ILMs read in (from inliner.c) */
61 static int gilmb_mode = 0;
62
63 #define TY(n) ((int)(n & 0x03))
64
65 /*******************************************************************/
66
67 void
addlabel(int sptr)68 addlabel(int sptr)
69 /* add label ILM */ {
70 (void)ad2ilm(IM_LABEL, sptr);
71 }
72
73 /*******************************************************************/
74
75 #if DEBUG
76 #define ILMNAME(opc) ((opc) > 0 && (opc) < N_ILM ? ilms[opc].name : "???")
77 #endif
78
79 /*
80 * Add 1 ILM word to current ILM buffer.
81 */
82 int
ad1ilm(int opc)83 ad1ilm(int opc)
84 {
85 #if DEBUG
86 if (DBGBIT(4, 0x4))
87 fprintf(gbl.dbgfil, "%5d %s\n", ilmb.ilmavl, ILMNAME(opc));
88 #endif
89 NEED(ilmb.ilmavl + 1, ilmb.ilm_base, ILM_T, ilmb.ilm_size,
90 ilmb.ilmavl + 1000);
91 ilmb.ilm_base[ilmb.ilmavl] = opc;
92 return ilmb.ilmavl++;
93 }
94
95 /******************************************************************/
96
97 /*
98 * Add 2 ILM words to current ILM buffer.
99 */
100 int
ad2ilm(int opc,int opr1)101 ad2ilm(int opc, int opr1)
102 {
103 ILM_T *p;
104
105 #if DEBUG
106 if (DBGBIT(4, 0x4))
107 fprintf(gbl.dbgfil, "%5d %s %d\n", ilmb.ilmavl, ILMNAME(opc), opr1);
108 #endif
109 NEED(ilmb.ilmavl + 2, ilmb.ilm_base, ILM_T, ilmb.ilm_size,
110 ilmb.ilmavl + 1000);
111 p = ilmb.ilm_base + ilmb.ilmavl;
112 ilmb.ilmavl += 2;
113 *p++ = opc;
114 *p = opr1;
115 return ilmb.ilmavl - 2;
116 }
117
118 /******************************************************************/
119
120 /*
121 * Add 3 ILM words to current ILM buffer.
122 */
123 int
ad3ilm(int opc,int opr1,int opr2)124 ad3ilm(int opc, int opr1, int opr2)
125 {
126 ILM_T *p;
127
128 #if DEBUG
129 if (DBGBIT(4, 0x4))
130 fprintf(gbl.dbgfil, "%5d %s %d,%d\n", ilmb.ilmavl, ILMNAME(opc), opr1,
131 opr2);
132 #endif
133 NEED(ilmb.ilmavl + 3, ilmb.ilm_base, ILM_T, ilmb.ilm_size,
134 ilmb.ilmavl + 1000);
135 p = ilmb.ilm_base + ilmb.ilmavl;
136 ilmb.ilmavl += 3;
137 *p++ = opc;
138 *p++ = opr1;
139 *p = opr2;
140 return ilmb.ilmavl - 3;
141 }
142
143 /******************************************************************/
144
145 /*
146 * add 4 ILM words to current ILM buffer.
147 */
148 int
ad4ilm(int opc,int opr1,int opr2,int opr3)149 ad4ilm(int opc, int opr1, int opr2, int opr3)
150 {
151 ILM_T *p;
152
153 #if DEBUG
154 if (DBGBIT(4, 0x4))
155 fprintf(gbl.dbgfil, "%5d %s %d,%d,%d\n", ilmb.ilmavl, ILMNAME(opc), opr1,
156 opr2, opr3);
157 #endif
158 NEED(ilmb.ilmavl + 4, ilmb.ilm_base, ILM_T, ilmb.ilm_size,
159 ilmb.ilmavl + 1000);
160 p = ilmb.ilm_base + ilmb.ilmavl;
161 ilmb.ilmavl += 4;
162 *p++ = opc;
163 *p++ = opr1;
164 *p++ = opr2;
165 *p = opr3;
166 return ilmb.ilmavl - 4;
167 }
168
169 /******************************************************************/
170
171 /*
172 * add 5 ILM words to current ILM buffer.
173 */
174 int
ad5ilm(int opc,int opr1,int opr2,int opr3,int opr4)175 ad5ilm(int opc, int opr1, int opr2, int opr3, int opr4)
176 {
177 ILM_T *p;
178
179 #if DEBUG
180 if (DBGBIT(4, 0x4))
181 fprintf(gbl.dbgfil, "%5d %s %d,%d,%d,%d\n", ilmb.ilmavl, ILMNAME(opc), opr1,
182 opr2, opr3, opr4);
183 #endif
184 NEED(ilmb.ilmavl + 5, ilmb.ilm_base, ILM_T, ilmb.ilm_size,
185 ilmb.ilmavl + 1000);
186 p = ilmb.ilm_base + ilmb.ilmavl;
187 ilmb.ilmavl += 5;
188 *p++ = opc;
189 *p++ = opr1;
190 *p++ = opr2;
191 *p++ = opr3;
192 *p = opr4;
193 return ilmb.ilmavl - 5;
194 }
195
196 /******************************************************************/
197
198 /**
199 * Add 'n' ILM words to current ILM buffer, including the opc.
200 */
201 int
adNilm(int n,int opc,...)202 adNilm(int n, int opc, ...)
203 {
204 ILM_T *p;
205 int i, opr;
206 va_list vargs;
207
208 assert(n > 5, "adNilm should only be used for ILMs with >5 arguments", opc,
209 ERR_Fatal);
210
211 #if DEBUG
212 if (DBGBIT(4, 0x4))
213 fprintf(gbl.dbgfil, "%5d %s %d operands\n", ilmb.ilmavl, ILMNAME(opc), n);
214 #endif
215 NEED(ilmb.ilmavl + n, ilmb.ilm_base, ILM_T, ilmb.ilm_size,
216 ilmb.ilmavl + 1000);
217 p = ilmb.ilm_base + ilmb.ilmavl;
218 ilmb.ilmavl += n;
219
220 va_start(vargs, opc);
221
222 *p++ = opc;
223 for (i = 1; i < n; ++i, ++p) {
224 opr = va_arg(vargs, int);
225 *p = opr;
226 }
227 --p;
228 va_end(vargs);
229 return ilmb.ilmavl - n;
230 }
231
232 int
ilm_callee_index(ILM_OP opc)233 ilm_callee_index(ILM_OP opc)
234 {
235 assert(IM_TYPE(opc) == IMTY_PROC, "ilm_callee_index: opc must have proc type",
236 opc, ERR_Fatal);
237 switch (opc) {
238 case IM_FAPPLY:
239 case IM_VAPPLY:
240 return 3;
241 case IM_FINVOKE:
242 case IM_VINVOKE:
243 return 4;
244 default:
245 return 2;
246 }
247 }
248
249 SYMTYPE
ilm_symtype_of_return_slot(DTYPE ret_type)250 ilm_symtype_of_return_slot(DTYPE ret_type)
251 {
252 if (DTY(ret_type) == TY_STRUCT || DTY(ret_type) == TY_UNION) {
253 /* function returns struct or union */
254 return DTY(ret_type) == TY_STRUCT ? ST_STRUCT : ST_UNION;
255 }
256 if (DT_ISCMPLX(ret_type)) {
257 /* function returns complex */
258 return ST_VAR;
259 }
260 return ST_UNKNOWN;
261 }
262
263 int
ilm_return_slot_index(ILM_T * ilmp)264 ilm_return_slot_index(ILM_T *ilmp)
265 {
266 DEBUG_ASSERT(0 < ilmp[0] && ilmp[0] < N_ILM,
267 "ilm_return_slot_index: bad ILM");
268
269 /* Each case either returns the return slot index, or sets callee_index
270 so that logic after the switch can find the return type and return slot. */
271 switch (ilmp[0]) {
272 case IM_VAPPLY:
273 case IM_FAPPLY:
274 case IM_VINVOKE:
275 case IM_FINVOKE:
276 break;
277 case IM_SFUNC:
278 case IM_CFUNC:
279 case IM_CDFUNC:
280 #ifdef LONG_DOUBLE_FLOAT128
281 case IM_CFLOAT128FUNC:
282 #endif
283 return 3;
284 default:
285 return 0;
286 }
287 interr("ilm_return_slot_index: ILM not implemented yet", ilmp[0], ERR_Severe);
288 return 0;
289 }
290
291 /******************************************************************/
292 static char *nullname = "";
293
294 /*
295 * allocate the ILMs, free the ILMs
296 */
297 void
init_ilm(int ilmsize)298 init_ilm(int ilmsize)
299 {
300 ilmb.ilmavl = BOS_SIZE;
301 ilmb.ilm_size = ilmsize;
302 NEW(ilmb.ilm_base, ILM_T, ilmb.ilm_size);
303 fihb.stg_size = 10;
304 NEW(fihb.stg_base, FIH, fihb.stg_size);
305 fihb.stg_avail = 1;
306 BZERO(fihb.stg_base + 0, FIH, 2);
307 FIH_DIRNAME(0) = NULL;
308 FIH_FILENAME(0) = nullname;
309 FIH_FULLNAME(0) = nullname;
310 FIH_DIRNAME(1) = NULL;
311 FIH_FILENAME(1) = nullname;
312 FIH_FULLNAME(1) = nullname;
313 } /* init_ilm */
314
315 void
init_global_ilm_mode()316 init_global_ilm_mode()
317 {
318 gilmb.ilmavl = 0;
319 gilmb.ilmpos = 0;
320 gilmb.globalilmtotal = 0;
321 gilmb.globalilmfirst = 0;
322 gilmb.ilm_size = ilmb.ilm_size * 5;
323 if (gilmb.ilm_size == 0)
324 gilmb.ilm_size = 1000;
325 NEW(gilmb.ilm_base, ILM_T, gilmb.ilm_size);
326 } /* init_global_ilm_mode */
327
328 void
reset_global_ilm_position()329 reset_global_ilm_position()
330 {
331 gilmb.ilmpos = GILMSAVE;
332 ilmb.globalilmstart = gilmb.globalilmstart;
333 ilmb.globalilmcount = gilmb.globalilmcount;
334 } /* reset_global_ilm_position */
335
336 void
init_global_ilm_position()337 init_global_ilm_position()
338 {
339 gilmb.globalilmstart = ilmb.globalilmstart;
340 gilmb.globalilmcount = ilmb.globalilmcount;
341 } /* init_global_ilm_position */
342
343 /*
344 * while inlining, we read from gilm, write to next_gilmb,
345 * one block at a time
346 */
347 void
init_next_gilm()348 init_next_gilm()
349 {
350 next_gilmb.ilmavl = GILMSAVE;
351 next_gilmb.ilmpos = GILMSAVE;
352 next_gilmb.ilm_size = gilmb.ilm_size;
353 NEW(next_gilmb.ilm_base, ILM_T, next_gilmb.ilm_size);
354 gilmb.globalilmcount = ilmb.globalilmcount;
355 gilmb.globalilmstart = ilmb.globalilmstart;
356 next_gilmb.globalilmcount = ilmb.globalilmcount;
357 next_gilmb.globalilmstart = ilmb.globalilmstart;
358 } /* init_next_gilm */
359
360 /*
361 * after inlining one level, swap the next_gilmb space with the gilmb space
362 * prepare for the next level of inlining
363 */
364 void
swap_next_gilm()365 swap_next_gilm()
366 {
367 GILMB temp;
368 next_gilmb.globalilmfirst = gilmb.globalilmfirst; /* preserve */
369 next_gilmb.globalilmtotal = gilmb.globalilmtotal; /* preserve */
370 memcpy(&temp, &gilmb, sizeof(gilmb));
371 memcpy(&gilmb, &next_gilmb, sizeof(gilmb));
372 memcpy(&next_gilmb, &temp, sizeof(gilmb));
373 next_gilmb.ilmavl = GILMSAVE;
374 next_gilmb.ilmpos = GILMSAVE;
375 ilmb.globalilmcount = gilmb.globalilmcount;
376 ilmb.globalilmstart = gilmb.globalilmstart;
377 } /* swap_next_gilm */
378
379 /*
380 * write the current ILM block to next_gilmb
381 */
382 void
gwrilms(int nilms)383 gwrilms(int nilms)
384 {
385 ilmb.ilm_base[3] = nilms;
386 NEED(next_gilmb.ilmavl + nilms + GILMSAVE * 2, next_gilmb.ilm_base, ILM_T,
387 next_gilmb.ilm_size, next_gilmb.ilmavl + nilms + 1000);
388 BCOPY(next_gilmb.ilm_base + next_gilmb.ilmavl, ilmb.ilm_base, ILM_T, nilms);
389 next_gilmb.ilm_base[next_gilmb.ilmavl - 1] =
390 ilmb.globalilmcount - ilmb.globalilmstart;
391 next_gilmb.ilmavl += nilms + GILMSAVE;
392 /* reinitialize with empty ILM block */
393 ilmb.ilmavl = BOS_SIZE;
394 ilmb.ilm_base[0] = IM_BOS;
395 ilmb.ilm_base[1] = 0;
396 ilmb.ilm_base[2] = 1;
397 ilmb.ilm_base[3] = BOS_SIZE;
398 } /* gwrilms */
399
400 /*
401 * done with inlining
402 */
403 void
fini_next_gilm()404 fini_next_gilm()
405 {
406 FREE(next_gilmb.ilm_base);
407 next_gilmb.ilm_base = NULL;
408 next_gilmb.ilm_size = 0;
409 next_gilmb.ilmavl = 0;
410 next_gilmb.ilmpos = 0;
411 } /* fini_next_gilm */
412
413 /*
414 * free ILMs when we're done
415 */
416 void
fini_ilm()417 fini_ilm()
418 {
419 FREE(ilmb.ilm_base);
420 ilmb.ilm_base = NULL;
421 if (gilmb_mode && gilmb.ilm_base) {
422 FREE(gilmb.ilm_base);
423 gilmb.ilm_base = NULL;
424 gilmb.ilm_size = 0;
425 gilmb.ilmavl = 0;
426 gilmb.ilmpos = 0;
427 gilmb.globalilmtotal = 0;
428 gilmb.globalilmfirst = 0;
429 }
430 } /* fini_ilm */
431 /******************************************************************/
432
433 /*
434 * write one block of ILM's to ILM file.
435 */
436 void
wrilms(int linenum)437 wrilms(int linenum)
438 {
439 void dmpilms();
440 ILM_T *p;
441 int nw;
442
443 /* if nocode, then just return */
444 if (ilmb.ilmavl == BOS_SIZE)
445 return;
446
447 p = ilmb.ilm_base;
448 *p++ = IM_BOS;
449 if (linenum == -1 || linenum == 0)
450 *p++ = gbl.lineno;
451 else
452 *p++ = linenum;
453
454 *p++ = gbl.findex;
455
456 *p = ilmb.ilmavl;
457
458 if (sem.wrilms) {
459 nw = fwrite((char *)ilmb.ilm_base, sizeof(ILM_T), ilmb.ilmavl, gbl.ilmfil);
460 if (nw != ilmb.ilmavl)
461 error(F_0010_File_write_error_occurred_OP1, ERR_Fatal, 0, "(IL file)", CNULL);
462 }
463
464 if (DBGBIT(4, 1))
465 dmpilms();
466
467 ilmb.ilmavl = BOS_SIZE;
468 gilmb_mode = 0; /* next rdilms comes from file */
469 }
470
471 /*****************************************************************/
472
473 /*
474 * if the ILM area is not empty, allocate a block in the indicated working
475 * storage area and copy the current ILM's into it. The first word of the
476 * block will contain the number of ILM words. The ILM area is reset to the
477 * empty state.
478 */
479 ILM_T *
save_ilms(int area)480 save_ilms(int area)
481 {
482 ILM_T *p;
483 int count;
484 ILM_T *q;
485
486 if (ilmb.ilmavl == BOS_SIZE)
487 return NULL;
488 count = ilmb.ilmavl - BOS_SIZE;
489 q = p = (ILM_T *)getitem(area, sizeof(ILM_T) * (count + 1));
490 *p++ = count;
491 BCOPY(p, ilmb.ilm_base + BOS_SIZE, ILM_T, count);
492 #if DEBUG
493 if (DBGBIT(4, 8)) {
494 ILMA(0) = IM_BOS;
495 ILMA(1) = gbl.lineno;
496 ILMA(2) = gbl.findex;
497 ILMA(BOS_SIZE - 1) = ilmb.ilmavl;
498 dmpilms();
499 }
500 #endif
501 ilmb.ilmavl = BOS_SIZE;
502 return q;
503 }
504
505 /*
506 * Similar to above, except save into an already-allocated area.
507 */
508 ILM_T *
save_ilms0(void * area)509 save_ilms0(void *area)
510 {
511 ILM_T *p;
512 int count;
513 ILM_T *q;
514
515 if (ilmb.ilmavl == BOS_SIZE)
516 return NULL;
517 count = ilmb.ilmavl - BOS_SIZE;
518 q = p = (ILM_T*)area;
519 *p++ = count;
520 BCOPY(p, ilmb.ilm_base + BOS_SIZE, ILM_T, count);
521 #if DEBUG
522 if (DBGBIT(4, 8)) {
523 ILMA(0) = IM_BOS;
524 ILMA(1) = gbl.lineno;
525 ILMA(2) = gbl.findex;
526 ILMA(BOS_SIZE - 1) = ilmb.ilmavl;
527 dmpilms();
528 }
529 #endif
530 ilmb.ilmavl = BOS_SIZE;
531 return q;
532 }
533
534 /************************************************************************/
535
536 /*
537 * Copy block of ILM's, previously saved by save_ilms, directly into the ILM
538 * buffer:
539 */
540 void
add_ilms(ILM_T * p)541 add_ilms(ILM_T *p)
542 {
543 int count;
544 int need;
545
546 if (p == NULL)
547 return;
548 count = *p++;
549 /* lfm bug fix 12/16/91 */
550 assert(count > 0, "add_ilms: non-positive count", 0, ERR_Fatal);
551 need = count;
552 if (need < 1000)
553 need = 1000;
554 NEED(ilmb.ilmavl + count, ilmb.ilm_base, ILM_T, ilmb.ilm_size,
555 ilmb.ilmavl + need);
556 BCOPY(ilmb.ilm_base + ilmb.ilmavl, p, ILM_T, count);
557 ilmb.ilmavl += count;
558 }
559
560 /************************************************************************/
561
562 /*
563 * Copy block of ILM's, previously saved by save_ilms, directly into the ILM
564 * buffer and relocate links.
565 */
566 void
reloc_ilms(ILM_T * p)567 reloc_ilms(ILM_T *p)
568 {
569 int count;
570 int need;
571 int ilmptr;
572 int rlc;
573
574 if (p == NULL)
575 return;
576 ilmptr = ilmb.ilmavl;
577 rlc = ilmb.ilmavl - BOS_SIZE;
578 count = *p++;
579 assert(count > 0, "reloc_ilms: non-positive count", 0, ERR_Fatal);
580 need = count;
581 if (need < 1000)
582 need = 1000;
583 NEED(ilmb.ilmavl + count, ilmb.ilm_base, ILM_T, ilmb.ilm_size,
584 ilmb.ilmavl + need);
585 BCOPY(ilmb.ilm_base + ilmb.ilmavl, p, ILM_T, count);
586 ilmb.ilmavl += count;
587
588 /* scan current ILM buffer, and relocate links */
589 do { /* loop once for each opcode */
590 int opc, len, noprs, varpart, opnd;
591
592 opc = ILMA(ilmptr);
593 len = noprs = ilms[opc].oprs; /* number of "fixed" operands */
594 if (IM_VAR(opc)) {
595 varpart = ILMA(ilmptr + 1);
596 len += varpart;
597 /*
598 * for an ILM with a variable number operands, we only want to
599 * examine the operands only if they are links. In any case,
600 * we want to begin at the second operand.
601 */
602 if (IM_OPRFLAG(opc, noprs + 1) != OPR_LNK)
603 varpart = 0;
604 noprs--;
605 opnd = 2;
606 } else {
607 /*
608 * the ILM does not have any variable ILM links -- the
609 * analysis begins with the first operand.
610 */
611 varpart = 0;
612 opnd = 1;
613 }
614 for (;; opnd++) {
615 if (noprs == 0) {
616 if ((varpart--) == 0)
617 break;
618 } else {
619 noprs--;
620 if (IM_OPRFLAG(opc, opnd) != OPR_LNK)
621 continue;
622 }
623 #if DEBUG
624 assert(ILMA(ilmptr + opnd) >= BOS_SIZE && ILMA(ilmptr + opnd) < ilmptr,
625 "reloc_ilms: bad lnk", ilmptr, ERR_Severe);
626 #endif
627 ILMA(ilmptr + opnd) += rlc;
628 }
629 ilmptr += (len + 1);
630 } while (ilmptr < ilmb.ilmavl);
631 }
632
633 /************************************************************************/
634
635 /*
636 * Convert ILM 'tree' pointed to by ilmptr into a series of one or more
637 * conditional branches which have the net effect of branching to truelb
638 * if the condition has the truth value of flag:
639 */
640 void
mkbranch(int ilmptr,int truelb,int flag)641 mkbranch(int ilmptr, int truelb, int flag)
642 {
643 int opc, falselb;
644
645 opc = ILMA(ilmptr);
646 if (opc == IM_LAND) {
647 if (!flag) {
648 /* if (!ilm1 || !ilm2) goto truelb */
649 mkbranch(ILMA(ilmptr + 1), truelb, false);
650 mkbranch(ILMA(ilmptr + 2), truelb, false);
651 /* erase the AND ilm: */
652 if (ilmptr + 3 == ilmb.ilmavl)
653 ilmb.ilmavl = ilmptr;
654 else {
655 ILMA(ilmptr++) = IM_NOP;
656 ILMA(ilmptr++) = IM_NOP;
657 ILMA(ilmptr) = IM_NOP;
658 }
659 } else {
660 /* if (ilm1 && ilm2) goto truelb -->
661 *
662 * if (!ilm1) goto falselb
663 * if (ilm2) goto truelb
664 * falselb:
665 */
666 falselb = getlab();
667 mkbranch(ILMA(ilmptr + 1), falselb, false);
668 mkbranch(ILMA(ilmptr + 2), truelb, true);
669 ILMA(ilmptr++) = IM_LABEL;
670 ILMA(ilmptr++) = falselb;
671 ILMA(ilmptr) = IM_NOP;
672 }
673 } else if (opc == IM_LAND8) {
674 /*
675 * tpr3035, the relational expressions are always logical*4. In the
676 * presence of a logical*8 expression, the relational is converted
677 * with a IM_ITOI8. Unfortunately, this means that the ILM order of
678 * the operands to LAND8 to LOR8 may change, and the assumptions to
679 * effect short-circuiting are no longer valid; e.g.,
680 * (1) a
681 * (2) b
682 * (3) LOR (1) (2) [operand 1 precedes operand 2]
683 * becomes
684 * (1) a
685 * (2) b
686 * (3) ITOI8 a
687 * (4) LOR8 (3) (2) [operand 1 no longer precedes operand 2]
688 *
689 * Need to detect this situation and to correct the order.
690 */
691 if (ILMA(ilmptr + 1) > ILMA(ilmptr + 2)) {
692 int i1, i2;
693 i1 = ILMA(ilmptr + 1);
694 i2 = ILMA(ilmptr + 2);
695 ILMA(ilmptr + 1) = i2;
696 ILMA(ilmptr + 2) = i1;
697 mkbranch(ilmptr, truelb, flag);
698 return;
699 }
700 if (!flag) {
701 /* if (!ilm1 || !ilm2) goto truelb */
702 mkbranch(ILMA(ilmptr + 1), truelb, false);
703 mkbranch(ILMA(ilmptr + 2), truelb, false);
704 /* erase the AND ilm: */
705 if (ilmptr + 3 == ilmb.ilmavl)
706 ilmb.ilmavl = ilmptr;
707 else {
708 ILMA(ilmptr++) = IM_NOP;
709 ILMA(ilmptr++) = IM_NOP;
710 ILMA(ilmptr) = IM_NOP;
711 }
712 } else {
713 /* if (ilm1 && ilm2) goto truelb -->
714 *
715 * if (!ilm1) goto falselb
716 * if (ilm2) goto truelb
717 * falselb:
718 */
719 falselb = getlab();
720 mkbranch(ILMA(ilmptr + 1), falselb, false);
721 mkbranch(ILMA(ilmptr + 2), truelb, true);
722 ILMA(ilmptr++) = IM_LABEL;
723 ILMA(ilmptr++) = falselb;
724 ILMA(ilmptr) = IM_NOP;
725 }
726 } else if (opc == IM_LOR) {
727 if (flag) {
728 /* if (ilm1 || ilm2) goto truelb */
729 mkbranch(ILMA(ilmptr + 1), truelb, true);
730 mkbranch(ILMA(ilmptr + 2), truelb, true);
731
732 /* erase the OR ilm: */
733 if (ilmptr + 3 == ilmb.ilmavl)
734 ilmb.ilmavl = ilmptr;
735 else {
736 ILMA(ilmptr++) = IM_NOP;
737 ILMA(ilmptr++) = IM_NOP;
738 ILMA(ilmptr) = IM_NOP;
739 }
740 } else {
741 /* if (!ilm1 && !ilm2) goto truelb -->
742 *
743 * if (ilm1) goto falselb
744 * if (!ilm2) goto truelb
745 * falselb:
746 */
747 falselb = getlab();
748 mkbranch(ILMA(ilmptr + 1), falselb, true);
749 mkbranch(ILMA(ilmptr + 2), truelb, false);
750 ILMA(ilmptr++) = IM_LABEL;
751 ILMA(ilmptr++) = falselb;
752 ILMA(ilmptr) = IM_NOP;
753 }
754 } else if (opc == IM_LOR8) {
755 /*
756 * tpr3035, the relational expressions are always logical*4. In the
757 * presence of a logical*8 expression, the relational is converted
758 * with a IM_ITOI8. Unfortunately, this means that the ILM order of
759 * the operands to LAND8 to LOR8 may change, and the assumptions to
760 * effect short-circuiting are no longer valid; e.g.,
761 * (1) a
762 * (2) b
763 * (3) LOR (1) (2) [operand 1 precedes operand 2]
764 * becomes
765 * (1) a
766 * (2) b
767 * (3) ITOI8 a
768 * (4) LOR8 (3) (2) [operand 1 no longer precedes operand 2]
769 *
770 * Need to detect this situation and to correct the order.
771 */
772 if (ILMA(ilmptr + 1) > ILMA(ilmptr + 2)) {
773 int i1, i2;
774 i1 = ILMA(ilmptr + 1);
775 i2 = ILMA(ilmptr + 2);
776 ILMA(ilmptr + 1) = i2;
777 ILMA(ilmptr + 2) = i1;
778 mkbranch(ilmptr, truelb, flag);
779 return;
780 }
781 if (flag) {
782 /* if (ilm1 || ilm2) goto truelb */
783 mkbranch(ILMA(ilmptr + 1), truelb, true);
784 mkbranch(ILMA(ilmptr + 2), truelb, true);
785
786 /* erase the OR ilm: */
787 if (ilmptr + 3 == ilmb.ilmavl)
788 ilmb.ilmavl = ilmptr;
789 else {
790 ILMA(ilmptr++) = IM_NOP;
791 ILMA(ilmptr++) = IM_NOP;
792 ILMA(ilmptr) = IM_NOP;
793 }
794 } else {
795 /* if (!ilm1 && !ilm2) goto truelb -->
796 *
797 * if (ilm1) goto falselb
798 * if (!ilm2) goto truelb
799 * falselb:
800 */
801 falselb = getlab();
802 mkbranch(ILMA(ilmptr + 1), falselb, true);
803 mkbranch(ILMA(ilmptr + 2), truelb, false);
804 ILMA(ilmptr++) = IM_LABEL;
805 ILMA(ilmptr++) = falselb;
806 ILMA(ilmptr) = IM_NOP;
807 }
808 } else {
809 if (IS_COMPARE(opc)) {
810 /* follow opcode with BRT or BRF*/
811 ILMA(ilmptr + 2) = flag ? IM_BRT : IM_BRF;
812 ILMA(ilmptr + 3) = ilmptr;
813 ILMA(ilmptr + 4) = truelb;
814 } else if (opc == IM_LNOP || opc == IM_LNOP8) {
815 ILMA(ilmptr) = flag ? IM_BRT : IM_BRF;
816 ILMA(ilmptr + 2) = truelb;
817 } else if (opc == IM_LNOT || opc == IM_LNOT8) {
818 ILMA(ilmptr) = flag ? IM_BRF : IM_BRT;
819 ILMA(ilmptr + 2) = truelb;
820 } else
821 (void)ad3ilm(flag ? IM_BRT : IM_BRF, ilmptr, truelb);
822
823 RFCNTI(truelb); /* increment label reference count */
824 }
825 }
826
827 /*****************************************************************/
828 static int globfile = 0, globindex = 0;
829
830 /*
831 * dump one ilm
832 */
833 int
_dumponeilm(ILM_T * ilm_base,int i,int check)834 _dumponeilm(ILM_T *ilm_base, int i, int check)
835 {
836 int opc, opcp, varpart, val, ty, bsize, sym, pr;
837 int j, k;
838 INT oprflg; /* bit map defining operand types */
839 opc = ilm_base[i];
840 opcp = i;
841 bsize = ilm_base[BOS_SIZE - 1]; /* number of words in this ILM block */
842 #define SPECIALOPC 65000
843 /* mark opcode, make sure links point to one of these */
844 if (check)
845 ilm_base[i] = SPECIALOPC;
846 if (opc <= 0 || opc >= N_ILM) {
847 fprintf(gbl.dbgfil, "%4d ? %6d ?", i, opc);
848 k = 0;
849 varpart = 0;
850 } else {
851 k = ilms[opc].oprs;
852 oprflg = ilms[opc].oprflag;
853 varpart = ((TY(oprflg) == OPR_N) ? ilm_base[i + 1] : 0);
854 if (i + k + varpart >= bsize) {
855 fprintf(gbl.dbgfil, " (BAD ARG COUNT=%d)", k + varpart);
856 varpart = 0;
857 }
858 j = i + 1 + k + varpart;
859 if (j < bsize && ilm_base[j] == IM_FILE) {
860 globfile = ilm_base[j + 2];
861 globindex = ilm_base[j + 3];
862 }
863 if (DBGBIT(4, 0x8000)) {
864 if (opc == IM_FILE) {
865 fprintf(gbl.dbgfil, "%4s %5s ", " ", " ");
866 } else {
867 fprintf(gbl.dbgfil, "%4d/%5d ", globfile, globindex);
868 }
869 }
870 if (opc == IM_FILE) {
871 /* do nothing */
872 } else {
873 globindex += k + varpart + 1;
874 }
875 fprintf(gbl.dbgfil, "%4d %-10.20s", i, ilms[opc].name);
876 }
877
878 j = 0;
879 sym = 0;
880 pr = 0;
881 do {
882 i++;
883 j++;
884 if (j <= k) {
885 ty = TY(oprflg);
886 oprflg >>= 2;
887 } else if (j <= k + varpart) {
888 if (j == k + 1)
889 ty = TY(oprflg);
890 } else
891 break;
892
893 val = (int)ilm_base[i];
894 switch (ty) {
895 case OPR_LNK:
896 fprintf(gbl.dbgfil, " %4d^", val);
897 if (val >= opcp || val < BOS_SIZE ||
898 (check && ilm_base[val] != SPECIALOPC)) {
899 fprintf(gbl.dbgfil, "<-BAD LINK");
900 }
901 break;
902
903 case OPR_SYM:
904 if (sym == 0)
905 sym = val;
906 fprintf(gbl.dbgfil, " %5d", val);
907 break;
908
909 case OPR_STC:
910 if (pr == 0)
911 pr = val;
912 fprintf(gbl.dbgfil, " %5d", val);
913 break;
914
915 case OPR_N:
916 fprintf(gbl.dbgfil, " %5d", val);
917 if (j != 1 || val < 0) {
918 fprintf(gbl.dbgfil, "<-BAD ARG COUNT");
919 }
920 }
921 } while (true);
922 if (pr) {
923 char *s;
924 switch (opc) {
925 case IM_MP_MAP:
926 case IM_PRAGMA:
927 case IM_PRAGMASYM:
928 case IM_PRAGMASLIST:
929 case IM_PRAGMAEXPR:
930 case IM_PRAGMASYMEXPR:
931 case IM_PRAGMASELIST:
932 case IM_PRAGMADPSELIST:
933 case IM_PRAGMAGEN:
934 switch (pr) {
935 case PR_NONE:
936 s = "NONE";
937 break;
938 case PR_INLININGON:
939 s = "INLININGON";
940 break;
941 case PR_INLININGOFF:
942 s = "INLININGOFF";
943 break;
944 case PR_ALWAYSINLINE:
945 s = "ALWAYSINLINE";
946 break;
947 case PR_MAYINLINE:
948 s = "MAYINLINE";
949 break;
950 case PR_NEVERINLINE:
951 s = "NEVERINLINE";
952 break;
953 case PR_ACCEL:
954 s = "ACCEL";
955 break;
956 case PR_ENDACCEL:
957 s = "ENDACCEL";
958 break;
959 case PR_INLINEONLY:
960 s = "INLINEONLY";
961 break;
962 case PR_INLINETYPE:
963 s = "INLINETYPE";
964 break;
965 case PR_INLINEAS:
966 s = "INLINEAS";
967 break;
968 case PR_INLINEALIGN:
969 s = "INLINEALIGN";
970 break;
971 case PR_ACCCOPYIN:
972 s = "ACCCOPYIN";
973 break;
974 case PR_ACCCOPYOUT:
975 s = "ACCCOPYOUT";
976 break;
977 case PR_ACCLOCAL:
978 s = "ACCLOCAL";
979 break;
980 case PR_ACCDELETE:
981 s = "ACCDELETE";
982 break;
983 case PR_ACCELLP:
984 s = "ACCELLP";
985 break;
986 case PR_ACCVECTOR:
987 s = "ACCVECTOR";
988 break;
989 case PR_ACCPARALLEL:
990 s = "ACCPARALLEL";
991 break;
992 case PR_ACCSEQ:
993 s = "ACCSEQ";
994 break;
995 case PR_ACCHOST:
996 s = "ACCHOST";
997 break;
998 case PR_ACCPRIVATE:
999 s = "ACCPRIVATE";
1000 break;
1001 case PR_ACCCACHE:
1002 s = "ACCCACHE";
1003 break;
1004 case PR_ACCSHORTLOOP:
1005 s = "ACCSHORTLOOP";
1006 break;
1007 case PR_ACCBEGINDIR:
1008 s = "ACCBEGINDIR";
1009 break;
1010 case PR_ACCIF:
1011 s = "ACCIF";
1012 break;
1013 case PR_ACCUNROLL:
1014 s = "ACCUNROLL";
1015 break;
1016 case PR_ACCKERNEL:
1017 s = "ACCKERNEL";
1018 break;
1019 case PR_ACCCOPY:
1020 s = "ACCCOPY";
1021 break;
1022 case PR_ACCDATAREG:
1023 s = "ACCDATAREG";
1024 break;
1025 case PR_ACCENTERDATA:
1026 s = "ACCENTERDATA";
1027 break;
1028 case PR_ACCEXITDATA:
1029 s = "ACCEXITDATA";
1030 break;
1031 case PR_ACCENDDATAREG:
1032 s = "ACCENDDATAREG";
1033 break;
1034 case PR_ACCUPDATEHOST:
1035 s = "ACCUPDATEHOST";
1036 break;
1037 case PR_ACCUPDATESELF:
1038 s = "ACCUPDATESELF";
1039 break;
1040 case PR_ACCUPDATEDEVICE:
1041 s = "ACCUPDATEDEVICE";
1042 break;
1043 case PR_ACCUPDATE:
1044 s = "ACCUPDATE";
1045 break;
1046 case PR_ACCINDEPENDENT:
1047 s = "ACCINDEPENDENT";
1048 break;
1049 case PR_ACCWAIT:
1050 s = "ACCWAIT";
1051 break;
1052 case PR_ACCNOWAIT:
1053 s = "ACCNOWAIT";
1054 break;
1055 case PR_ACCIMPDATAREG:
1056 s = "ACCIMPDATAREG";
1057 break;
1058 case PR_ACCENDIMPDATAREG:
1059 s = "ACCENDIMPDATAREG";
1060 break;
1061 case PR_ACCMIRROR:
1062 s = "ACCMIRROR";
1063 break;
1064 case PR_ACCREFLECT:
1065 s = "ACCREFLECT";
1066 break;
1067 case PR_KERNELBEGIN:
1068 s = "KERNELBEGIN";
1069 break;
1070 case PR_KERNEL:
1071 s = "KERNEL";
1072 break;
1073 case PR_ENDKERNEL:
1074 s = "ENDKERNEL";
1075 break;
1076 case PR_KERNELTILE:
1077 s = "KERNELTILE";
1078 break;
1079 case PR_ACCDEVSYM:
1080 s = "ACCDEVSYM";
1081 break;
1082 case PR_ACCIMPDATAREGX:
1083 s = "ACCIMPDATAREGX";
1084 break;
1085 case PR_KERNEL_NEST:
1086 s = "KERNEL_NEST";
1087 break;
1088 case PR_KERNEL_GRID:
1089 s = "KERNEL_GRID";
1090 break;
1091 case PR_KERNEL_BLOCK:
1092 s = "KERNEL_BLOCK";
1093 break;
1094 case PR_ACCDEVICEPTR:
1095 s = "ACCDEVICEPTR";
1096 break;
1097 case PR_ACCPARUNROLL:
1098 s = "ACCPARUNROLL";
1099 break;
1100 case PR_ACCVECUNROLL:
1101 s = "ACCVECUNROLL";
1102 break;
1103 case PR_ACCSEQUNROLL:
1104 s = "ACCSEQUNROLL";
1105 break;
1106 case PR_ACCCUDACALL:
1107 s = "ACCCUDACALL";
1108 break;
1109 case PR_ACCSCALARREG:
1110 s = "ACCSCALARREG";
1111 break;
1112 case PR_ACCENDSCALARREG:
1113 s = "ACCENDSCALARREG";
1114 break;
1115 case PR_ACCSERIAL:
1116 s = "ACCSERIAL";
1117 break;
1118 case PR_ACCENDSERIAL:
1119 s = "ACCENDSERIAL";
1120 break;
1121 case PR_ACCPARCONSTRUCT:
1122 s = "ACCPARCONSTRUCT";
1123 break;
1124 case PR_ACCENDPARCONSTRUCT:
1125 s = "ACCENDPARCONSTRUCT";
1126 break;
1127 case PR_ACCKERNELS:
1128 s = "ACCKERNELS";
1129 break;
1130 case PR_ACCENDKERNELS:
1131 s = "ACCENDKERNELS";
1132 break;
1133 case PR_ACCCREATE:
1134 s = "ACCCREATE";
1135 break;
1136 case PR_ACCPRESENT:
1137 s = "ACCPRESENT";
1138 break;
1139 case PR_ACCPCOPY:
1140 s = "ACCPCOPY";
1141 break;
1142 case PR_ACCPCOPYIN:
1143 s = "ACCPCOPYIN";
1144 break;
1145 case PR_ACCPCOPYOUT:
1146 s = "ACCPCOPYOUT";
1147 break;
1148 case PR_ACCPCREATE:
1149 s = "ACCPCREATE";
1150 break;
1151 case PR_ACCPNOT:
1152 s = "ACCPNOT";
1153 break;
1154 case PR_ACCNO_CREATE:
1155 s = "ACCNO_CREATE";
1156 break;
1157 case PR_ACCPDELETE:
1158 s = "ACCPDELETE";
1159 break;
1160 case PR_ACCASYNC:
1161 s = "ACCASYNC";
1162 break;
1163 case PR_KERNEL_STREAM:
1164 s = "KERNEL_STREAM";
1165 break;
1166 case PR_KERNEL_DEVICE:
1167 s = "KERNEL_DEVICE";
1168 break;
1169 case PR_ACCWAITDIR:
1170 s = "ACCWAITDIR";
1171 break;
1172 case PR_ACCSLOOP:
1173 s = "ACCSLOOP";
1174 break;
1175 case PR_ACCTSLOOP:
1176 s = "ACCTSLOOP";
1177 break;
1178 case PR_ACCKLOOP:
1179 s = "ACCKLOOP";
1180 break;
1181 case PR_ACCTKLOOP:
1182 s = "ACCTKLOOP";
1183 break;
1184 case PR_ACCPLOOP:
1185 s = "ACCPLOOP";
1186 break;
1187 case PR_ACCTPLOOP:
1188 s = "ACCTPLOOP";
1189 break;
1190 case PR_ACCGANG:
1191 s = "ACCGANG";
1192 break;
1193 case PR_ACCWORKER:
1194 s = "ACCWORKER";
1195 break;
1196 case PR_ACCFIRSTPRIVATE:
1197 s = "ACCFIRSTPRIVATE";
1198 break;
1199 case PR_ACCNUMGANGS:
1200 s = "ACCNUMGANGS";
1201 break;
1202 case PR_ACCNUMGANGS2:
1203 s = "ACCNUMGANGS2";
1204 break;
1205 case PR_ACCNUMGANGS3:
1206 s = "ACCNUMGANGS3";
1207 break;
1208 case PR_ACCGANGDIM:
1209 s = "ACCGANGDIM";
1210 break;
1211 case PR_ACCNUMWORKERS:
1212 s = "ACCNUMWORKERS";
1213 break;
1214 case PR_ACCVLENGTH:
1215 s = "ACCVLENGTH";
1216 break;
1217 case PR_ACCWAITARG:
1218 s = "ACCWAITARG";
1219 break;
1220 case PR_ACCREDUCTION:
1221 s = "ACCREDUCTION";
1222 break;
1223 case PR_ACCREDUCTOP:
1224 s = "ACCREDUCTOP";
1225 break;
1226 case PR_ACCCACHEDIR:
1227 s = "ACCCACHEDIR";
1228 break;
1229 case PR_ACCCACHEARG:
1230 s = "ACCCACHEARG";
1231 break;
1232 case PR_ACCHOSTDATA:
1233 s = "ACCHOSTDATA";
1234 break;
1235 case PR_ACCENDHOSTDATA:
1236 s = "ACCENDHOSTDATA";
1237 break;
1238 case PR_ACCUSEDEVICE:
1239 s = "ACCUSEDEVICE";
1240 break;
1241 case PR_ACCUSEDEVICEIFP:
1242 s = "ACCUSEDEVICEIFP";
1243 break;
1244 case PR_ACCCOLLAPSE:
1245 s = "ACCCOLLAPSE";
1246 break;
1247 case PR_ACCFORCECOLLAPSE:
1248 s = "ACCFORCECOLLAPSE";
1249 break;
1250 case PR_ACCDEVICERES:
1251 s = "ACCDEVICERES";
1252 break;
1253 case PR_ACCLINK:
1254 s = "ACCLINK";
1255 break;
1256 case PR_ACCDEVICEID:
1257 s = "ACCDEVICEID";
1258 break;
1259 case PR_ACCLOOPPRIVATE:
1260 s = "ACCLOOPPRIVATE";
1261 break;
1262 case PR_CUFLOOPPRIVATE:
1263 s = "CUFLOOPPRIVATE";
1264 break;
1265 case PR_ACCTILE:
1266 s = "ACCTILE";
1267 break;
1268 case PR_ACCAUTO:
1269 s = "ACCAUTO";
1270 break;
1271 case PR_ACCGANGCHUNK:
1272 s = "ACCGANGCHUNK";
1273 break;
1274 case PR_ACCDEFNONE:
1275 s = "ACCDEFAULTNONE";
1276 break;
1277 case PR_ACCDEFPRESENT:
1278 s = "ACCDEFAULTPRESENT";
1279 break;
1280 case PR_ACCCACHEREADONLY:
1281 s = "ACCCACHEREADONLY";
1282 break;
1283 case PR_ACCFINALEXITDATA:
1284 s = "ACCFINALEXITDATA";
1285 break;
1286 case PR_ACCUPDATEHOSTIFP:
1287 s = "ACCUPDATEHOSTIFP";
1288 break;
1289 case PR_ACCUPDATEDEVICEIFP:
1290 s = "ACCUPDATEDEVICEIFP";
1291 break;
1292 case PR_ACCUPDATESELFIFP:
1293 s = "ACCUPDATESELFIFP";
1294 break;
1295 case PR_ACCATTACH:
1296 s = "ACCATTACH";
1297 break;
1298 case PR_ACCDETACH:
1299 s = "ACCDETACH";
1300 break;
1301 case PR_ACCCOMPARE:
1302 s = "ACCCOMPARE";
1303 break;
1304 case PR_PGICOMPARE:
1305 s = "PGICOMPARE";
1306 break;
1307 case PR_PCASTCOMPARE:
1308 s = "PCASTCOMPARE";
1309 break;
1310 case PR_MAPALLOC:
1311 s = "MAPALLOC";
1312 break;
1313 case PR_MAPDELETE:
1314 s = "MAPDELETE";
1315 break;
1316 case PR_MAPFROM:
1317 s = "MAPFROM";
1318 break;
1319 case PR_MAPRELEASE:
1320 s = "MAPRELEASE";
1321 break;
1322 case PR_MAPTO:
1323 s = "MAPTO";
1324 break;
1325 case PR_MAPTOFROM:
1326 s = "MAPTOFROM";
1327 break;
1328 default:
1329 s = "?";
1330 break;
1331 }
1332 fprintf(gbl.dbgfil, " ;%s", s);
1333 break;
1334 #ifdef IM_BTARGET
1335 case IM_BTARGET:
1336 fprintf(gbl.dbgfil, " ;");
1337 if (pr & MP_TGT_NOWAIT)
1338 fprintf(gbl.dbgfil, " NOWAIT");
1339 if (pr & MP_TGT_IFTARGET)
1340 fprintf(gbl.dbgfil, " IFTARGET");
1341 if (pr & MP_TGT_IFPAR)
1342 fprintf(gbl.dbgfil, " IFPAR");
1343 if (pr & MP_TGT_DEPEND_IN)
1344 fprintf(gbl.dbgfil, " DEPEND_IN");
1345 if (pr & MP_TGT_DEPEND_OUT)
1346 fprintf(gbl.dbgfil, " DEPEND_OUT");
1347 if (pr & MP_TGT_DEPEND_IN)
1348 fprintf(gbl.dbgfil, " DEPEND_INOUT");
1349 if (pr & MP_CMB_TEAMS)
1350 fprintf(gbl.dbgfil, " TEAMS");
1351 if (pr & MP_CMB_DISTRIBUTE)
1352 fprintf(gbl.dbgfil, " DISTRIBUTE");
1353 if (pr & MP_CMB_PARALLEL)
1354 fprintf(gbl.dbgfil, " PARALLEL");
1355 if (pr & MP_CMB_FOR)
1356 fprintf(gbl.dbgfil, " FOR");
1357 if (pr & MP_CMB_SIMD)
1358 fprintf(gbl.dbgfil, " SIMD");
1359 break;
1360 #endif /* BTARGET */
1361 }
1362 }
1363 if (sym) {
1364 switch (opc) {
1365 case IM_EHREG_ST:
1366 case IM_EHRESUME:
1367 fprintf(gbl.dbgfil, "\t;__catch_clause_number,__caught_object_address");
1368 break;
1369 default:
1370 fprintf(gbl.dbgfil, " ;%s", getprint(sym));
1371 break;
1372 }
1373 }
1374 return i;
1375 } /* _dumponeilm */
1376
1377
1378 /*
1379 * dump block of ILM's to debug listing file.
1380 */
1381 void
_dumpilms(ILM_T * ilm_base,int check)1382 _dumpilms(ILM_T *ilm_base, int check)
1383 {
1384 int i, bsize;
1385 globfile = 0;
1386 globindex = 0;
1387
1388 if (gbl.dbgfil == NULL)
1389 gbl.dbgfil = stderr;
1390
1391 if (ilm_base[0] != IM_BOS) {
1392 fprintf(gbl.dbgfil, "dmpilms: no IM_BOS (ilm_base[0]==%d)\n", ilm_base[0]);
1393 }
1394
1395 fprintf(gbl.dbgfil, "\n----- lineno: %d"
1396 #if DEBUG
1397 " ----- global ILM index %d:%d"
1398 #endif
1399 "\n",
1400 ilm_base[1]
1401 #if DEBUG
1402 ,
1403 ilmb.globalilmstart, ilmb.globalilmcount
1404 #endif
1405 );
1406 bsize = ilm_base[BOS_SIZE - 1]; /* number of words in this ILM block */
1407
1408 i = 0;
1409 globfile = 1;
1410 globindex = ilmb.globalilmstart;
1411 do { /* loop once for each ILM opcode: */
1412 i = _dumponeilm(ilm_base, i, check);
1413 fprintf(gbl.dbgfil, "\n");
1414 if (i > bsize) {
1415 fprintf(gbl.dbgfil, "BAD BLOCK LENGTH: %d\n", bsize);
1416 }
1417 } while (i < bsize);
1418 globfile = 0;
1419 globindex = 0;
1420 }
1421
1422 void
dumpilms()1423 dumpilms()
1424 {
1425 ILMA(BOS_SIZE - 1) = ilmb.ilmavl;
1426 if (gbl.dbgfil == NULL)
1427 gbl.dbgfil = stderr;
1428 _dumpilms(ilmb.ilm_base, 0);
1429 } /* dumpilms */
1430
1431 void
dmpilms()1432 dmpilms()
1433 {
1434 _dumpilms(ilmb.ilm_base, 1);
1435 } /* dmpilms */
1436
1437 #if DEBUG
1438 static int xsize, xavl;
1439 static int *x;
1440 static FILE *xfile;
1441
1442 static void
putsym(int sptr)1443 putsym(int sptr)
1444 {
1445 /* we want to print the name; if the name is ..inline, we use
1446 * an index into the list of inlined names */
1447 if (strncmp(SYMNAME(sptr), "..inline", 8) != 0) {
1448 fprintf(xfile, " %s", SYMNAME(sptr));
1449 } else {
1450 int xx;
1451 for (xx = 0; xx < xavl; ++xx) {
1452 if (x[xx] == sptr)
1453 break;
1454 }
1455 if (xx >= xavl) {
1456 xx = xavl;
1457 ++xavl;
1458 NEED(xavl, x, int, xsize, xsize + 100);
1459 x[xx] = sptr;
1460 }
1461 fprintf(xfile, " ..inline.%d", xx);
1462 }
1463 } /* putsym */
1464
1465 /** \brief Write a DTYPE to xfile.
1466 This routine is spelled with an underscore to
1467 distinguish it from routine putdtype in mwd.c */
1468 static void
put_dtype(DTYPE dtype)1469 put_dtype(DTYPE dtype)
1470 {
1471 int dty;
1472 ADSC *ad;
1473 int numdim;
1474 dty = DTY(dtype);
1475 switch (dty) {
1476 case TY_CMPLX:
1477 case TY_DBLE:
1478 case TY_DCMPLX:
1479 case TY_FLOAT:
1480 case TY_INT:
1481 case TY_INT8:
1482 case TY_LOG:
1483 case TY_LOG8:
1484 case TY_NONE:
1485 case TY_QUAD:
1486 case TY_SINT:
1487 case TY_UINT:
1488 case TY_UINT8:
1489 case TY_USINT:
1490 case TY_WORD:
1491 fprintf(xfile, "%s", stb.tynames[dty]);
1492 break;
1493 case TY_CHAR:
1494 fprintf(xfile, "%s*%" ISZ_PF "d", stb.tynames[dty], DTyCharLength(dtype));
1495 break;
1496 case TY_ARRAY:
1497 fprintf(xfile, "%s", stb.tynames[dty]);
1498 ad = AD_DPTR(dtype);
1499 numdim = AD_NUMDIM(ad);
1500 fprintf(xfile, "(");
1501 if (numdim >= 1 && numdim <= 7) {
1502 int i;
1503 for (i = 0; i < numdim; ++i) {
1504 if (i)
1505 fprintf(xfile, ",");
1506 putsym(AD_LWBD(ad, i));
1507 fprintf(xfile, ":");
1508 putsym(AD_UPBD(ad, i));
1509 }
1510 }
1511 fprintf(xfile, ")");
1512 break;
1513 case TY_PTR:
1514 fprintf(xfile, "*(");
1515 put_dtype(DTySeqTyElement(dtype));
1516 fprintf(xfile, ")");
1517 break;
1518
1519 case TY_PARAM:
1520 break;
1521 case TY_STRUCT:
1522 case TY_UNION:
1523 if (dty == TY_STRUCT)
1524 fprintf(xfile, "struct");
1525 if (dty == TY_UNION)
1526 fprintf(xfile, "union");
1527 DTySet(dtype, -dty);
1528 if (DTyAlgTyTag(dtype)) {
1529 fprintf(xfile, " ");
1530 putsym(DTyAlgTyTag(dtype));
1531 }
1532 fprintf(xfile, "{");
1533 if (DTyAlgTyMember(dtype)) {
1534 int member;
1535 for (member = DTyAlgTyMember(dtype); member > NOSYM && member < stb.stg_avail;) {
1536 put_dtype(DTYPEG(member));
1537 fprintf(xfile, " ");
1538 putsym(member);
1539 member = SYMLKG(member);
1540 fprintf(xfile, ";");
1541 }
1542 }
1543 fprintf(xfile, "}");
1544 DTySet(dtype, dty);
1545 break;
1546 case -TY_STRUCT:
1547 case -TY_UNION:
1548 if (dty == -TY_STRUCT)
1549 fprintf(xfile, "struct");
1550 if (dty == -TY_UNION)
1551 fprintf(xfile, "union");
1552 if (DTyAlgTyTagNeg(dtype)) {
1553 fprintf(xfile, " ");
1554 putsym(DTyAlgTyTagNeg(dtype));
1555 } else {
1556 fprintf(xfile, " %d", dtype);
1557 }
1558 break;
1559 default:
1560 break;
1561 }
1562
1563 } /* put_dtype */
1564
1565 void
dumpsingleilm(ILM_T * ilm_base,int i)1566 dumpsingleilm(ILM_T *ilm_base, int i)
1567 {
1568 int opc, args, varargs, oprflg, j, sym;
1569 opc = ilm_base[0];
1570 args = ilms[opc].oprs;
1571 oprflg = ilms[opc].oprflag;
1572 varargs = ((TY(oprflg) == OPR_N) ? ilm_base[1] : 0);
1573 sym = 0;
1574 if (ilm_base[0] == IM_BOS) {
1575 fprintf(gbl.dbgfil, "\n----- lineno: %d"
1576 " ----- global ILM index %d:%d"
1577 "\n",
1578 ilm_base[1] , ilm_base[2], ilm_base[3]
1579 );
1580 }
1581 fprintf(gbl.dbgfil, "%4d %s",i, ilms[opc].name);
1582 for (j = 1; j <= args + varargs; ++j) {
1583 int ty, val;
1584 ty = TY(oprflg);
1585 if (j <= args) {
1586 oprflg >>= 2;
1587 }
1588 val = ilm_base[j];
1589 switch (ty) {
1590 case OPR_LNK:
1591 fprintf(gbl.dbgfil, " op%d", j);
1592 break;
1593
1594 case OPR_STC:
1595 fprintf(gbl.dbgfil, " %5d", val);
1596 break;
1597 break;
1598
1599 case OPR_N:
1600 fprintf(gbl.dbgfil, " n%d", val);
1601 break;
1602
1603 case OPR_SYM:
1604 if (sym == 0)
1605 sym = val;
1606 fprintf(gbl.dbgfil, " %5d", val);
1607 break;
1608 }
1609 }
1610 if (sym) {
1611 switch (opc) {
1612 default:
1613 fprintf(gbl.dbgfil, " ;%s", getprint(sym));
1614 break;
1615 }
1616 }
1617 fprintf(gbl.dbgfil, "\n");
1618 } /* dumpsingleilm */
1619
1620 /* dump a single ILM tree */
1621 static void
_dumpilmtree(int i,int indent)1622 _dumpilmtree(int i, int indent)
1623 {
1624 int opc, args, varargs, oprflg, j, sym;
1625 opc = ILMA(i);
1626 args = ilms[opc].oprs;
1627 oprflg = ilms[opc].oprflag;
1628 varargs = ((TY(oprflg) == OPR_N) ? ILMA(i + 1) : 0);
1629 for (j = 0; j < indent; ++j)
1630 fprintf(xfile, " ");
1631 fprintf(xfile, "%s", ilms[opc].name);
1632 sym = 0;
1633 for (j = 1; j <= args + varargs; ++j) {
1634 int ty;
1635 int val;
1636 ty = TY(oprflg);
1637 if (j <= args) {
1638 oprflg >>= 2;
1639 }
1640 val = ILMA(i + j);
1641 switch (ty) {
1642 case OPR_LNK:
1643 fprintf(xfile, " op%d", j);
1644 break;
1645
1646 case OPR_STC:
1647 if (opc != IM_FARG && opc != IM_ELEMENT) {
1648 fprintf(xfile, " %d", val);
1649 } else {
1650 /* this is a datatype */
1651 fprintf(xfile, " ");
1652 put_dtype((DTYPE)val); // ???
1653 }
1654 break;
1655
1656 case OPR_N:
1657 fprintf(xfile, " n%d", val);
1658 break;
1659
1660 case OPR_SYM:
1661 if (sym == 0)
1662 sym = val;
1663 fprintf(xfile, " %5d", val);
1664 break;
1665 }
1666 }
1667 if (sym) {
1668 switch (opc) {
1669 default:
1670 fprintf(xfile, " ;%s", getprint(sym));
1671 break;
1672 }
1673 }
1674 fprintf(xfile, "\n");
1675 /* now print the subtrees */
1676 oprflg = ilms[opc].oprflag;
1677 for (j = 1; j <= args + varargs; ++j) {
1678 int ty, val;
1679 ty = TY(oprflg);
1680 if (j <= args) {
1681 oprflg >>= 2;
1682 }
1683 val = ILMA(i + j);
1684 switch (ty) {
1685 case OPR_LNK:
1686 _dumpilmtree(val, indent + 1);
1687 break;
1688 }
1689 }
1690 } /* _dumpilmtree */
1691
1692 /* dump ILM trees, for comparisons between two different compiles */
1693 void
dumpilmtree(int ilmptr)1694 dumpilmtree(int ilmptr)
1695 {
1696 int xx;
1697 xfile = gbl.dbgfil ? gbl.dbgfil : stderr;
1698 xsize = 100;
1699 xavl = 0;
1700 NEW(x, int, xsize);
1701 fprintf(xfile, "\n----- lineno: %d\n", ILMA(1));
1702 _dumpilmtree(ilmptr, 0);
1703 for (xx = 0; xx < xavl; ++xx) {
1704 fprintf(xfile, "..inline.%d = sptr:%d\n", xx, x[xx]);
1705 }
1706 FREE(x);
1707 xsize = 0;
1708 xavl = 0;
1709 } /* dumpilmtree */
1710
1711 /* dump ILM trees, for comparisons between two different compiles */
1712 void
dumpilmtrees()1713 dumpilmtrees()
1714 {
1715 int i, args, xx;
1716 xfile = gbl.dbgfil ? gbl.dbgfil : stderr;
1717 xsize = 100;
1718 xavl = 0;
1719 NEW(x, int, xsize);
1720 fprintf(xfile, "\n----- lineno: %d\n", ILMA(1));
1721 for (i = 0; i < ilmb.ilmavl; i += args + 1) {
1722 int opc, oprflg;
1723 opc = ILMA(i);
1724 if (opc <= 0 || opc >= N_ILM) {
1725 fprintf(xfile, " OPC=%6d\n", opc);
1726 args = 0;
1727 } else if (IM_TRM(opc)) {
1728 _dumpilmtree(i, 0);
1729 }
1730 args = ilms[opc].oprs;
1731 oprflg = ilms[opc].oprflag;
1732 args += ((TY(oprflg) == OPR_N) ? ILMA(i + 1) : 0);
1733 }
1734 for (xx = 0; xx < xavl; ++xx) {
1735 fprintf(xfile, "..inline.%d = sptr:%d\n", xx, x[xx]);
1736 }
1737 FREE(x);
1738 xsize = 0;
1739 xavl = 0;
1740 } /* dumpilmtrees */
1741 #endif
1742
1743 /****************************************************************/
1744 extern void rewindilms();
1745 //#if defined(PGC)
1746 /*
1747 * ILM file position before starting the current function
1748 */
1749 static long gilmpos = 0;
1750
1751 long
get_ilmpos()1752 get_ilmpos()
1753 {
1754 return gilmpos;
1755 } /* get_ilmpos */
1756
1757 long
get_ilmstart()1758 get_ilmstart()
1759 {
1760 ilmb.globalilmstart = gilmb.globalilmtotal;
1761 ilmb.globalilmcount = gilmb.globalilmtotal;
1762 return gilmb.globalilmfirst;
1763 } /* get_ilmstart */
1764
1765 void
set_ilmpos(long pos)1766 set_ilmpos(long pos)
1767 {
1768 int r;
1769 r = fseek(gbl.ilmfil, pos, SEEK_SET);
1770 if (r != 0) {
1771 interr("seek on ILM file failed", 0, ERR_Fatal);
1772 }
1773 } /* set_ilmpos */
1774
1775 void
set_ilmstart(int start)1776 set_ilmstart(int start)
1777 {
1778 ilmb.globalilmstart = start;
1779 ilmb.globalilmcount = start;
1780 } /* set_ilmstart */
1781
1782 int
get_entry()1783 get_entry()
1784 {
1785 if (gilmb.ilm_base[GILMSAVE + BOS_SIZE] == IM_ENTRY) {
1786 return gilmb.ilm_base[GILMSAVE + BOS_SIZE + 1];
1787 }
1788 return 0;
1789 } /* get_entry */
1790 //#endif
1791
1792 /*
1793 * read in a function's worth of ILMs into gilmb.ilm_base
1794 * gilmb_mode = 1: Read in from gbl.ilmfil into gilmb.ilm_base
1795 * gilmb_mode = 2: Read in from ilm_base into gilmb.ilm_base
1796 */
1797 int
rdgilms(int mode)1798 rdgilms(int mode)
1799 {
1800 int i, nilms, nw, pos, sumilms = 0;
1801 int ilmx, opc, len;
1802 gilmb.ilmavl = GILMSAVE;
1803 gilmb.ilmpos = GILMSAVE;
1804 gilmb.ilm_base[0] = 0;
1805 gilmb.ilm_base[1] = 0;
1806 gilmb.ilm_base[2] = 1;
1807 if (flg.smp && llvm_ilms_rewrite_mode()) {
1808 gilmb_mode = 0;
1809 } else
1810 {
1811 gilmb_mode = 0;
1812 rewindilms();
1813 }
1814
1815 gilmb_mode = mode;
1816 gilmb.globalilmfirst = gilmb.globalilmtotal;
1817 if (mode != 2) {
1818 gilmpos = ftell(gbl.ilmfil);
1819 }
1820 #if DEBUG
1821 if (DBGBIT(4, 0x80)) {
1822 fprintf(gbl.dbgfil, "------rdgilms-----\n");
1823 }
1824 #endif
1825 do {
1826 /* we've already determine that we have enough space
1827 * to read in the BOS block */
1828 if (gilmb_mode == 1) {
1829 #if DEBUG
1830 if (DBGBIT(4, 0x80)) {
1831 fprintf(gbl.dbgfil, "Reading at %ld\n", ftell(gbl.ilmfil));
1832 }
1833 #endif
1834 i = fread((void *)(gilmb.ilm_base + gilmb.ilmavl), sizeof(ILM_T),
1835 BOS_SIZE, gbl.ilmfil);
1836 if (i == 0) {
1837 if (gilmb.ilmavl == GILMSAVE)
1838 return 0;
1839 return gilmb.ilmavl;
1840 }
1841 assert(i == BOS_SIZE, "rdgilms: BOS error", i, ERR_Severe);
1842 }
1843
1844 /*
1845 * determine the number of words remaining in the ILM block
1846 */
1847 nilms = gilmb.ilm_base[gilmb.ilmavl + 3];
1848 gilmb.globalilmtotal += nilms;
1849 nw = nilms - BOS_SIZE;
1850 /* read in the remaining part of the ILM block */
1851 /* make sure we have enough for this ILM block and the
1852 * BOS of the next ILM block */
1853 NEED(gilmb.ilmavl + nilms + 2 * BOS_SIZE + GILMSAVE, gilmb.ilm_base, ILM_T,
1854 gilmb.ilm_size, gilmb.ilm_size + nilms + 1000);
1855
1856 if (gilmb_mode == 1) {
1857 i = fread((void *)(gilmb.ilm_base + gilmb.ilmavl + BOS_SIZE),
1858 sizeof(ILM_T), nw, gbl.ilmfil);
1859 assert(i == nw, "grdilms: BLOCK error", nilms, ERR_Severe);
1860 }
1861
1862 sumilms += nilms;
1863 pos = gilmb.ilmavl;
1864 gilmb.ilm_base[pos - 1] = nilms;
1865 gilmb.ilmavl += nilms + GILMSAVE;
1866 /* find the last IM, look for IM_END */
1867 for (ilmx = BOS_SIZE; ilmx < nilms; ilmx += len) {
1868 opc = gilmb.ilm_base[pos + ilmx];
1869 #if DEBUG
1870 if (DBGBIT(4, 0x80)) {
1871 if (opc < 0 || opc >= N_ILM) {
1872 fprintf(gbl.dbgfil, "opc:%d\n", opc);
1873 } else {
1874 fprintf(gbl.dbgfil, "opc:%s\n", ilms[opc].name);
1875 }
1876 }
1877 #endif
1878 len = ilms[opc].oprs + 1; /* length is number of words */
1879 if (IM_VAR(opc)) {
1880 len += gilmb.ilm_base[pos + ilmx + 1]; /* include the variable opnds */
1881 }
1882 }
1883 gilmb.ilm_base[pos + nilms] = 0;
1884 gilmb.ilm_base[pos + nilms + 1] = 1;
1885 }
1886 while (opc != IM_END && opc != IM_ENDF);
1887
1888 return gilmb.ilmavl;
1889 } /* rdgilms */
1890
1891 /*
1892 * for Unified binary, save (and below, restore) the gilmb structure
1893 */
1894 void
SaveGilms(FILE * fil)1895 SaveGilms(FILE *fil)
1896 {
1897 int nw;
1898 /* output the size of the gilmb structure */
1899 nw = fwrite((void *)&gilmb.ilmavl, sizeof(gilmb.ilmavl), 1, fil);
1900 if (nw != 1) {
1901 error(S_0155_OP1_OP2, ERR_Fatal, 0, "Error writing temp file:", "gilmavl");
1902 exit(1);
1903 }
1904 nw = fwrite((void *)gilmb.ilm_base, sizeof(ILM_T), gilmb.ilmavl, fil);
1905 if (nw != gilmb.ilmavl) {
1906 error(S_0155_OP1_OP2, ERR_Fatal, 0, "Error writing temp file:", "gilms");
1907 exit(1);
1908 }
1909 } /* SaveGilms */
1910
1911 void
RestoreGilms(FILE * fil)1912 RestoreGilms(FILE *fil)
1913 {
1914 int nw;
1915 /* output the size of the gilmb structure */
1916 nw = fread((void *)&gilmb.ilmavl, sizeof(gilmb.ilmavl), 1, fil);
1917 if (nw != 1) {
1918 error(S_0155_OP1_OP2, ERR_Fatal, 0, "Error reading temp file:", "gilmavl");
1919 exit(1);
1920 }
1921 NEED(gilmb.ilmavl + BOS_SIZE + GILMSAVE, gilmb.ilm_base, ILM_T,
1922 gilmb.ilm_size, gilmb.ilmavl + 1000);
1923 nw = fread((void *)gilmb.ilm_base, sizeof(ILM_T), gilmb.ilmavl, fil);
1924 if (nw != gilmb.ilmavl) {
1925 error(S_0155_OP1_OP2, ERR_Fatal, 0, "Error reading temp file:", "gilms");
1926 exit(1);
1927 }
1928 gilmb.ilmpos = GILMSAVE;
1929 gilmb_mode = 1;
1930 } /* RestoreGilms */
1931
1932 /****************************************************************/
1933
1934 /* Set the value of gilmb_mode */
1935 void
set_gilmb_mode(int mode)1936 set_gilmb_mode(int mode)
1937 {
1938 gilmb_mode = mode;
1939 }
1940
1941 /*
1942 * read in a block of ILMs
1943 */
1944 int
rdilms()1945 rdilms()
1946 {
1947 int i, nw, nilms;
1948
1949 /* read in the BOS ILM */
1950
1951 ilmb.globalilmstart = ilmb.globalilmcount;
1952
1953 /* gilmb_mode = 0 : Read ILMs from gbl.ilmfil to ilmb.ilm_base
1954 * gilmb_mode !=0 : Read ILMs from gilmb.ilm_base to ilmb.ilm_base
1955 */
1956 if (!gilmb_mode) {
1957 i = fread((char *)ilmb.ilm_base, sizeof(ILM_T), BOS_SIZE, gbl.ilmfil);
1958 if (i == 0)
1959 return 0;
1960 assert(i == BOS_SIZE, "rdilms: BOS error", i, ERR_Severe);
1961 fihb.nextfindex = ilmb.ilm_base[2];
1962 nilms = ilmb.ilm_base[3];
1963 ilmb.globalilmcount += nilms;
1964 } else {
1965 if (gilmb.ilmpos >= gilmb.ilmavl)
1966 return 0;
1967 BCOPY(ilmb.ilm_base, gilmb.ilm_base + gilmb.ilmpos, ILM_T, BOS_SIZE);
1968 fihb.nextfindex = ilmb.ilm_base[2];
1969 nilms = ilmb.ilm_base[3];
1970 ilmb.globalilmcount += gilmb.ilm_base[gilmb.ilmpos - 1];
1971 gilmb.ilmpos += BOS_SIZE;
1972 }
1973
1974 /*
1975 * determine the number of words remaining in the ILM block
1976 */
1977 nw = nilms - BOS_SIZE;
1978 ilmb.ilmavl = nilms;
1979
1980 if (!gilmb_mode) {
1981 /* read in the remaining part of the ILM block */
1982 i = fread((char *)(ilmb.ilm_base + BOS_SIZE), sizeof(ILM_T), nw,
1983 gbl.ilmfil);
1984 assert(i == nw, "rdilms: BLOCK error", nilms, ERR_Severe);
1985 } else {
1986 assert(gilmb.ilmpos + nw <= gilmb.ilmavl, "rdilms: BLOCK error", nilms, ERR_Severe);
1987 NEED(nilms, ilmb.ilm_base, ILM_T, ilmb.ilm_size,
1988 ilmb.ilm_size + nilms + 1000);
1989 BCOPY(ilmb.ilm_base + BOS_SIZE, gilmb.ilm_base + gilmb.ilmpos, ILM_T, nw);
1990 gilmb.ilmpos += nw + GILMSAVE;
1991 }
1992
1993 #if DEBUG
1994 if (DBGBIT(4, 0x20)) {
1995 dumpilms();
1996 }
1997 #endif
1998
1999 return nilms;
2000 }
2001
2002 static int saveilmstart = 0, saveilmcount = 0;
2003
2004 /*
2005 * rewind ilm file, reset counters
2006 */
2007 void
rewindilms()2008 rewindilms()
2009 {
2010 int i;
2011 if (gilmb_mode) {
2012 reset_global_ilm_position();
2013 } else {
2014 i = fseek(gbl.ilmfil, 0L, 0);
2015 assert(i == 0, "ilmfil seek error", i, ERR_Severe);
2016 }
2017 if (fihb.stg_base == NULL) {
2018 fihb.stg_size = 10;
2019 NEW(fihb.stg_base, FIH, fihb.stg_size);
2020 fihb.stg_avail = 1;
2021 BZERO(fihb.stg_base + 0, FIH, 1);
2022 FIH_DIRNAME(0) = NULL;
2023 FIH_FILENAME(0) = nullname;
2024 FIH_FULLNAME(0) = nullname;
2025 }
2026 fihb.nextfindex = 1;
2027 fihb.nextftag = 0;
2028 fihb.currfindex = 1;
2029 fihb.currftag = 0;
2030 ilmb.globalilmstart = saveilmstart;
2031 ilmb.globalilmcount = saveilmcount;
2032 } /* rewindilms */
2033
2034 /*
2035 * rewind ilm file in preparation for starting a new Fortran subprogram
2036 */
2037 void
restartilms(void)2038 restartilms(void)
2039 {
2040 int i;
2041 i = fseek(gbl.ilmfil, 0L, 0);
2042 assert(i == 0, "ilmfil seek error", i, ERR_Severe);
2043 /* save ilmstart/ilmcount values so when we rewind to start the next
2044 * subprogram, we're starting at the same point */
2045 saveilmstart = ilmb.globalilmstart;
2046 saveilmcount = ilmb.globalilmcount;
2047 } /* restartilms */
2048
2049 /*
2050 * Count the number of ILMs only contribute to the code generation
2051 */
2052 int
count_ilms()2053 count_ilms()
2054 {
2055 int ilmx, len, newnumilms, nilms, begin_ilm;
2056 ILM_OP opc;
2057
2058 nilms = ilmb.ilm_base[BOS_SIZE - 1];
2059 newnumilms = nilms;
2060 begin_ilm = BOS_SIZE;
2061
2062 for (ilmx = begin_ilm; ilmx < nilms; ilmx += len) {
2063 opc = (ILM_OP)ilmb.ilm_base[ilmx]; // ???
2064 #if DEBUG
2065 assert(opc > IM_null && opc < N_ILM, "count_ilms: bad ilm", opc, ERR_Severe);
2066 #endif
2067 len = ilms[opc].oprs + 1;
2068 if (IM_VAR(opc))
2069 len += *(ilmb.ilm_base + ilmx + 1);
2070 #if DEBUG
2071 assert(len > 0, "count_ilms: bad len", opc, ERR_Severe);
2072 #endif
2073 if (IM_NOINLC(opc)) {
2074 newnumilms -= len;
2075 }
2076 }
2077 #if DEBUG
2078 assert(nilms >= newnumilms, "count_ilms: bad newnumilms", opc, ERR_Severe);
2079 #endif
2080 return newnumilms;
2081 }
2082
2083