/
expand.c
2985 lines (2720 loc) · 86.5 KB
/
expand.c
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/*
* Copyright (c) 1993-2017, NVIDIA CORPORATION. All rights reserved.
*
* Licensed under the Apache License, Version 2.0 (the "License");
* you may not use this file except in compliance with the License.
* You may obtain a copy of the License at
*
* http://www.apache.org/licenses/LICENSE-2.0
*
* Unless required by applicable law or agreed to in writing, software
* distributed under the License is distributed on an "AS IS" BASIS,
* WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
* See the License for the specific language governing permissions and
* limitations under the License.
*
*/
/** \file
* \brief Common expander routines
*/
#include "gbldefs.h"
#include "error.h"
#include "global.h"
#include "symtab.h"
#include "regutil.h"
#include "machreg.h"
#include "fih.h"
#include "ilmtp.h"
#include "ilm.h"
#include "ili.h"
#define EXPANDER_DECLARE_INTERNAL
#include "expand.h"
#include "machar.h"
#include "scope.h"
#include "outliner.h"
#include "verify.h"
extern void exp_szero(ILM *, int, int, int, int);
extern void ili_lpprg_init(void);
extern void rewindilms(void);
extern void reinline_init(void);
extern void set_allfiles(int);
extern void dmpilms(void);
extern int reinline(int);
extern int ll_rewrite_ilms(int, int, int);
extern void reinline_fini(void);
extern LOGICAL is_scope_label(int);
extern int get_threadprivate_origsize(int);
#ifdef DEBUG
extern void dumpilms(void);
#endif
extern int charlen(int);
extern int charaddr(int);
extern LOGICAL ll_ilm_is_rewriting(void);
extern void delilt(int);
extern int in_extract_inline; /* Bottom-up auto-inlining */
static int efunc(char *);
#define DO_PFO ((XBIT(148, 0x1000) && !XBIT(148, 0x4000)) || XBIT(148, 1))
/***************************************************************/
/*
* Initialize global data structures
*/
void
ds_init(void)
{
int i;
ili_init();
ilt_init();
bih_init();
nme_init();
/*
* allocate the register areas for use by the expander or the optimizer
*/
i = 128;
EXP_ALLOC(rcandb, RCAND, i);
BZERO(&rcandb.stg_base[0], RCAND, i); /* purify umr when cand = 0 */
rcandb.stg_avail = 1;
rcandb.weight = 1;
rcandb.kr = 0;
EXP_ALLOC(ratb, RAT, i);
ratb.stg_avail = 1;
EXP_ALLOC(rgsetb, RGSET, i);
BZERO(&rgsetb.stg_base[0], RGSET, i);
rgsetb.stg_avail = 1;
} /* ds_init */
void
exp_init(void)
{
/*
* Allocate the space necessary to hold the auxiliary information for ILM
* evaluation required by the expander. If necessary the space could
* depend on sem.ilm_size, but this is probably too much. The ilm index
* i is associated with the ith entry in this area (there will items that
* are not used). The following size is probably sufficient but a check
* will be done each time rdilms is called.
*/
EXP_ALLOC(expb.ilmb, ILM_AUX, 610);
expb.flags.wd = 0;
expb.gentmps = 0; /* PGC: counter increments across functions */
expb.str_avail = 0;
if (expb.str_size == 0) {
expb.str_size = 32;
NEW(expb.str_base, STRDESC, expb.str_size);
}
expb.logcjmp = XBIT(125, 0x8) ? IL_ICJMPZ : IL_LCJMPZ;
aux.curr_entry->display = 0;
ds_init();
expb.curilt = 0;
expb.curbih = 0;
expb.isguarded = 0;
expb.flags.bits.noblock = 1;
expb.flags.bits.noheader = 1;
if (CHARLEN_64BIT)
expb.charlen_dtype = DT_INT8;
else
expb.charlen_dtype = DT_INT;
if (flg.xon != 0 || flg.xoff ^ 0xFFFFFFFF)
expb.flags.bits.excstat = 1;
/* For C, only rewind the ilm file once (performed by main()) */
rewindilms();
/* set threshold of # of ilm words, if exceeded, to break ili blocks */
if (flg.x[100])
expb.ilm_thresh = 1 << (flg.x[100] & 0x1f);
else {
#ifdef TM_ILM_THRESH
expb.ilm_thresh = TM_ILM_THRESH;
if (flg.opt >= 3 || flg.vect & 16)
expb.ilm_thresh += TM_ILM_THRESH >> 1; /* allow for 50% more */
#else
expb.ilm_thresh = 1 << 30; /* BIG */
#endif
}
expb.sc = SC_AUTO; /* default storage class for expander-created temps */
exp_smp_init();
expb.clobber_ir = expb.clobber_pr = 0;
}
/*
* clean up allocated space when the program isn't compiled
*/
void
exp_cleanup(void)
{
if (rgsetb.stg_base)
EXP_FREE(rgsetb);
rgsetb.stg_base = NULL;
if (rcandb.stg_base) {
EXP_FREE(rcandb);
}
rcandb.stg_base = NULL;
if (ratb.stg_base)
EXP_FREE(ratb);
ratb.stg_base = NULL;
} /* exp_cleanup */
/*
* Parse an IM_FILE ilm.
*
* - ilmp is an IM_FILE ilm.
* - lineno_out becomes the line number, but only if the IM_FILE has a non-zero
* lineno operand. Otherwise, lineno_out is not touched.
* - findex_out becomes a valid index into the FIH table.
* - ftag_out becomes the ftag.
*/
static void
parse_im_file(const ILM *ilmp, int *lineno_out, int *findex_out, int *ftag_out)
{
/* IM_FILE lineno findex ftag */
int lineno = ILM_OPND(ilmp, 1);
int findex = ILM_OPND(ilmp, 2);
int ftag = ILM_OPND(ilmp, 3);
assert(ILM_OPC(ilmp) == IM_FILE, "parse_im_file: Expected IM_FILE",
ILM_OPC(ilmp), ERR_Fatal);
/* The bottom-up inliner will generate some IM_FILE ilms with findex
* operands that reference the IFIH table. These references are encoded as
* negative numbers. Translate them back to FIH references here. */
if (findex < 0) {
int ifindex = -findex - 1;
assert(ifindex < ifihb.stg_avail,
"parse_im_file: Invalid IFIH reference on IM_FILE", ifindex,
ERR_Warning);
findex = IFIH_FINDEX(ifindex);
}
assert(findex < fihb.stg_avail,
"parse_im_file: Invalid FIH reference on IM_FILE", findex,
ERR_Warning);
if (lineno_out && lineno)
*lineno_out = lineno;
if (findex_out)
*findex_out = findex;
if (ftag_out)
*ftag_out = ftag;
}
/***************************************************************/
/** \brief Expand ILMs to ILIs */
int
expand(void)
{
int ilmx, /* index of the ILM */
len; /* length of the ILM */
ILM *ilmp; /* absolute pointer to the ILM */
ILM_OP opc; /* opcode of the ILM */
int countcalls; /* how many calls in this block of ilms */
int last_label_bih = 0;
int last_ftag = 0;
int nextftag = 0, nextfindex = 0;
int last_cpp_branch = 0;
/*
* NOTE, for an ILM: ilmx is needed to access the ILM_AUX area, ilmp is
* needed to access the ILM area
*/
exp_init();
/* During expand, we want to generate unique proc ili each time a
* proc ILM is processed. The assumption is that the scheduler will
* cse a proc ili if it appears multiple times in a block. E.g.,
* COMPLEX c(10)
* x = f() + f() ! two ili for calling f
* c(ifunc()) = ... ! 1 call to ifunc (although two uses)
* After expand, we share proc ili; the optimizer may create expressions
* which contain calls where the intent is to cse a call if it already
* exists in the block.
*/
share_proc_ili = FALSE;
if (!XBIT(120, 0x4000000)) {
set_allfiles(0);
} else {
gbl.findex = 1;
}
/*
* process all blocks for a function. For Fortran, the terminating
* condition is when the "end" ILM is seen (there may be multiple
* subprograms per compilation -- the ilm file is reused). For C,
* the ilm file contains the blocks for all function. The loop
* terminates when the "end" ILM is seen and a non-zero value is
* returned; if the ilm file is at end-of-file, 0 is returned.
*/
do {
expb.nilms = rdilms();
nextftag = fihb.nextftag;
nextfindex = fihb.nextfindex;
#if DEBUG
if (DBGBIT(4, 0x800))
dumpilms();
#endif
DEBUG_ASSERT(expb.nilms, "expand:ilm end of file");
/*
* the following check could be deleted if the max ilm block size is
* known or if space doesn't have to be conserved during this phase
*/
if (expb.nilms > expb.ilmb.stg_size) {
EXP_MORE(expb.ilmb, ILM_AUX, expb.nilms + 100);
}
/* scan through all the ilms in the current ILM block */
for (ilmx = 0; ilmx < expb.nilms; ilmx += len) {
int saved_curbih = expb.curbih;
int saved_findex = fihb.nextfindex;
LOGICAL followed_by_file = FALSE;
LOGICAL ilmx_is_block_label = FALSE;
int findex, ftag;
/* the first time an ilm is seen, it has no result */
ILM_RESULT(ilmx) = 0;
ILM_EXPANDED_FOR(ilmx) = 0;
ILM_RESTYPE(ilmx) = 0; /* zero out result types */
ILM_NME(ilmx) = 0; /* zero out name entry (?) */
findex = 0;
ftag = 0;
ilmp = (ILM *)(ilmb.ilm_base + ilmx);
opc = ILM_OPC(ilmp);
if (opc == IM_BR) {
last_cpp_branch = ILM_OPND(ilmp, 1);
} else if (opc == IM_LABEL) {
/* Scope labels don't cause block breaks. */
ilmx_is_block_label = !is_scope_label(ILM_OPND(ilmp, 1));
if (!ilmx_is_block_label) {
new_callee_scope = ENCLFUNCG(ILM_OPND(ilmp, 1));
}
}
DEBUG_ASSERT(opc > 0 && opc < N_ILM, "expand: bad ilm");
len = ilms[opc].oprs + 1; /* length is number of words for the
* fixed operands and the opcode */
if (IM_VAR(opc))
len += ILM_OPND(ilmp, 1); /* include the number of
* variable operands */
if (IM_TRM(opc)) {
int cur_label = BIH_LABEL(expb.curbih);
eval_ilm(ilmx);
}
else if (flg.smp && len) {
ll_rewrite_ilms(-1, ilmx, len);
}
if (opc != IM_FILE) {
++nextftag;
fihb.nextftag = nextftag;
} else if ((XBIT(148, 0x1) || XBIT(148, 0x1000)) && !followed_by_file) {
int ftag;
int findex;
parse_im_file((ILM *)&ilmb.ilm_base[ilmx], NULL, &findex, &ftag);
if (ftag) {
nextfindex = findex;
nextftag = ftag;
fihb.nextfindex = nextfindex;
fihb.nextftag = nextftag;
}
}
/* If a new bih is created, detect certain scenarios */
if (expb.curbih > saved_curbih) {
/* Pay special attention to the transition from inlinee to inliner.
* If last bih (in the inlinee) is created by an IM_LABEL followed
* by an IM_FILE, we need to honor the ftag info in the IM_FILE.
*/
if ((saved_curbih != 0) && (saved_curbih == last_label_bih) &&
(saved_findex > fihb.nextfindex))
BIH_FTAG(last_label_bih) = last_ftag;
/* Flag the scenario that the new bih is created by an IM_LABEL that is
* followed by an IM_FILE.
*/
if (ilmx_is_block_label && followed_by_file) {
last_label_bih = expb.curbih;
last_ftag = ftag;
}
}
} /* end of loop through ILM block */
new_callee_scope = 0;
}
while (opc != IM_END && opc != IM_ENDF);
if (DBGBIT(10, 2) && (bihb.stg_avail != 1)) {
int bih;
for (bih = 1; bih != 0; bih = BIH_NEXT(bih)) {
if (BIH_EN(bih))
dump_blocks(gbl.dbgfil, bih, "***** BIHs for Function \"%s\" *****", 1);
}
dmpili();
}
#if DEBUG
verify_function_ili(VERIFY_ILI_DEEP);
if (DBGBIT(10, 16)) {
dmpnme();
{
int i, j;
for (i = nmeb.stg_avail - 1; i >= 2; i--) {
for (j = nmeb.stg_avail - 1; j >= 2; j--) {
if (i != j)
(void)conflict(i, j);
}
}
}
}
if (DBGBIT(8, 64)) {
fprintf(gbl.dbgfil, " ILM(%d)", expb.ilmb.stg_size);
fprintf(gbl.dbgfil, " ILI(%d)", ilib.stg_avail);
fprintf(gbl.dbgfil, " ILT(%d)", iltb.stg_size);
fprintf(gbl.dbgfil, " BIH(%d)", bihb.stg_size);
fprintf(gbl.dbgfil, " NME(%d)\n", nmeb.stg_avail);
}
#endif
ili_lpprg_init();
/* for C, we don't free the ilm area until we reach end-of-file */
FREE(ilmb.ilm_base);
ilmb.ilm_base = NULL;
EXP_FREE(expb.ilmb);
freearea(STR_AREA);
if (flg.opt < 2) {
if (rcandb.stg_base) {
EXP_FREE(rcandb);
rcandb.stg_base = NULL;
}
}
share_proc_ili = TRUE;
exp_smp_fini();
fihb.nextftag = fihb.currftag = 0;
if (!XBIT(120, 0x4000000)) {
/* Restored file indexes to where they were before expand in case
they got changed somewhere.
*/
set_allfiles(1);
} else {
fihb.nextfindex = fihb.currfindex = 1;
}
return expb.nilms;
}
/***************************************************************/
/*
* Check that operand opr of ILM ilmx has been expanded.
* If this will be the first use of this ILM, then set ILM_EXPANDED_FOR
* to ilmx.
*/
static void
eval_ilm_argument1(int opr, ILM* ilmpx, int ilmx)
{
int op1, ilix;
if ((ilix = ILI_OF(op1 = ILM_OPND(ilmpx, opr))) == 0) {
/* hasn't been evaluated yet */
eval_ilm(op1);
/* mark this as expanded for this ILM */
ILM_EXPANDED_FOR(op1) = -ilmx;
} else if (ILM_EXPANDED_FOR(op1) < 0 && !is_cseili_opcode(ILI_OPC(ilix))) {
/* This was originally added for a parent ILM, so it hasn't
* been used as an operand ILI yet. Take ownership of it here.
* When it is reused later for a parent ILM,
* it will get then get turned into a CSE ILI */
ILM_EXPANDED_FOR(op1) = -ilmx;
}
} /* eval_ilm_argument1 */
void
eval_ilm(int ilmx)
{
ILM *ilmpx;
int noprs, /* number of operands in the ILM */
ilix, /* ili index */
tmp, /* temporary */
op1; /* operand 1 */
ILM_OP opcx; /**< ILM opcode of the ILM */
int first_op = 0;
opcx = ILM_OPC(ilmpx = (ILM *)(ilmb.ilm_base + ilmx));
if (flg.smp) {
if (IM_TYPE(opcx) != IMTY_SMP && ll_rewrite_ilms(-1, ilmx, 0)) {
if (ilmx == 0 && opcx == IM_BOS) {
/* Set line no for EPARx */
gbl.lineno = ILM_OPND(ilmpx, 1);
}
return;
}
}
if (EXPDBG(8, 2))
fprintf(gbl.dbgfil, "---------- eval ilm %d\n", ilmx);
if (!ll_ilm_is_rewriting())
{
/*-
* evaluate unevaluated "fixed" arguments:
* For each operand which is a link to another ilm, recurse (evaluate it)
* if not already evaluated
*/
for (tmp = 1, noprs = ilms[opcx].oprs; noprs > first_op; ++tmp, --noprs) {
if (IM_OPRFLAG(opcx, noprs) == OPR_LNK) {
eval_ilm_argument1(noprs, ilmpx, ilmx);
}
}
/* evaluate unevaluated "variable" arguments */
if (IM_VAR(opcx) && IM_OPRFLAG(opcx, ilms[opcx].oprs + 1) == OPR_LNK) {
for (noprs = ILM_OPND(ilmpx, 1); noprs > 0; --noprs, ++tmp) {
eval_ilm_argument1(tmp, ilmpx, ilmx);
}
}
/*-
* check the "fixed" arguments for any duplicated values
*/
for (tmp = 1, noprs = ilms[opcx].oprs; noprs > first_op; ++tmp, --noprs) {
if (IM_OPRFLAG(opcx, noprs) == OPR_LNK) {
/* all arguments will have been evaluated by now */
ilix = ILI_OF(op1 = ILM_OPND(ilmpx, noprs));
if (ILM_EXPANDED_FOR(op1) == -ilmx) {
ILM_EXPANDED_FOR(op1) = ilmx;
} else if (ilix && ILM_EXPANDED_FOR(op1) != ilmx) {
if (ILM_RESTYPE(op1) != ILM_ISCMPLX && ILM_RESTYPE(op1) != ILM_ISDCMPLX
#ifdef LONG_DOUBLE_FLOAT128
&& ILM_RESTYPE(op1) != ILM_ISFLOAT128CMPLX
#endif
)
/* not complex */
ILM_RESULT(op1) = check_ilm(op1, ilix);
else {
/* complex */
ILM_RRESULT(op1) = check_ilm(op1, (int)ILM_RRESULT(op1));
ILM_IRESULT(op1) = check_ilm(op1, (int)ILM_IRESULT(op1));
}
}
}
}
/* check the "variable" arguments for any duplicated values */
if (IM_VAR(opcx) && IM_OPRFLAG(opcx, ilms[opcx].oprs + 1) == OPR_LNK) {
for (noprs = ILM_OPND(ilmpx, 1); noprs > 0; --noprs, ++tmp) {
ilix = ILI_OF(op1 = ILM_OPND(ilmpx, tmp));
if (ILM_EXPANDED_FOR(op1) == -ilmx) {
ILM_EXPANDED_FOR(op1) = ilmx;
} else if (ilix && ILM_EXPANDED_FOR(op1) != ilmx) {
if (ILM_RESTYPE(op1) != ILM_ISCMPLX && ILM_RESTYPE(op1) != ILM_ISDCMPLX
#ifdef LONG_DOUBLE_FLOAT128
&& ILM_RESTYPE(op1) != ILM_ISFLOAT128CMPLX
#endif
){
/* not complex */
ILM_RESULT(op1) = check_ilm(op1, ilix);
} else {
/* complex */
ILM_RRESULT(op1) = check_ilm(op1, (int)ILM_RRESULT(op1));
ILM_IRESULT(op1) = check_ilm(op1, (int)ILM_IRESULT(op1));
}
}
}
}
}
/*
* ready to evaluate the ilm. opcx is opcode of current ilm, ilmpx is
* pointer to current ilm, and ilmx is index to the current ilm.
*/
if (EXPDBG(8, 2))
fprintf(gbl.dbgfil, "ilm %s, index %d, lineno %d\n", ilms[opcx].name, ilmx,
gbl.lineno);
if (!IM_SPEC(opcx))
{
/* expand the macro definition */
tmp = exp_mac(opcx, ilmpx, ilmx);
if (IM_I8(opcx))
ILM_RESTYPE(ilmx) = ILM_ISI8;
return;
}
switch (IM_TYPE(opcx)) { /* special-cased ILM */
case IMTY_REF: /* reference */
exp_ref(opcx, ilmpx, ilmx);
break;
case IMTY_LOAD: /* load */
exp_load(opcx, ilmpx, ilmx);
break;
case IMTY_STORE: /* store */
exp_store(opcx, ilmpx, ilmx);
break;
case IMTY_BRANCH: /* branch */
exp_bran(opcx, ilmpx, ilmx);
break;
case IMTY_PROC: /* procedure */
exp_call(opcx, ilmpx, ilmx);
break;
case IMTY_INTR: /* intrinsic */
case IMTY_ARTH: /* arithmetic */
case IMTY_CONS: /* constant */
exp_ac(opcx, ilmpx, ilmx);
break;
case IMTY_MISC: /* miscellaneous */
exp_misc(opcx, ilmpx, ilmx);
break;
case IMTY_FSTR: /* fortran string */
exp_fstring(opcx, ilmpx, ilmx);
break;
case IMTY_SMP: /* smp ILMs */
exp_smp(opcx, ilmpx, ilmx);
break;
default: /* error */
interr("eval_ilm: bad op type", IM_TYPE(opcx), 3);
break;
} /* end of switch on ILM opc */
if (IM_I8(opcx))
ILM_RESTYPE(ilmx) = ILM_ISI8;
}
/***************************************************************/
/*
* An ESTMT ILM (or an ILI whose value is to be discarded) is processed by
* walking the ILI tree (located by ilix) and creating ILTs for any function
* calls that exist in the tree. This routine is similar to reduce_ilt
* (iltutil.c) except that chk_block is used to add an ILT. This is done so
* that the "end of block" checks are performed.
*/
void
exp_estmt(int ilix)
{
int noprs, i, ilix1;
ILI_OP opc = ILI_OPC(ilix);
if (IL_TYPE(opc) == ILTY_PROC && opc >= IL_JSR) {
iltb.callfg = 1; /* create an ILT for the function */
chk_block(ilix);
} else if (opc == IL_DFRDP && ILI_OPC(ILI_OPND(ilix, 1)) != IL_QJSR) {
iltb.callfg = 1;
chk_block(ad1ili(IL_FREEDP, ilix));
} else if (opc == IL_DFRSP && ILI_OPC(ILI_OPND(ilix, 1)) != IL_QJSR) {
iltb.callfg = 1;
chk_block(ad1ili(IL_FREESP, ilix));
}
else if (opc == IL_DFRCS && ILI_OPC(ILI_OPND(ilix, 1)) != IL_QJSR) {
iltb.callfg = 1;
chk_block(ad1ili(IL_FREECS, ilix));
}
#ifdef LONG_DOUBLE_FLOAT128
else if (opc == IL_FLOAT128RESULT &&
ILI_OPC(ILI_OPND(ilix, 1)) != IL_QJSR) {
iltb.callfg = 1;
chk_block(ad1ili(IL_FLOAT128FREE, ilix));
}
#endif
else if (opc == IL_VA_ARG) {
iltb.callfg = 1;
chk_block(ilix);
}
else if (IL_HAS_FENCE(opc)) {
chk_block(ad_free(ilix));
}
else {
/* otherwise, walk all of the link operands of the ILI */
noprs = ilis[opc].oprs;
for (i = 1; i <= noprs; ++i)
if (IL_ISLINK(opc, i))
exp_estmt((int)ILI_OPND(ilix, i));
}
}
/***************************************************************/
/* Expand a scope label that should be inserted as an in-stream IL_LABEL ilt
* instead of splitting the current block.
*
* These scope labels are generated by enter_lexical_block() and
* exit_lexical_block(). They are verified by scope_verify().
*/
static void
exp_scope_label(int lbl)
{
int ilt, ilix;
/* Each scope label can only appear in one block. The ILIBLK field for the
* label must point to the unique BIH containing the IL_LABEL ilt.
*
* Skip this assertion when generating multiple versions of a function for
* a unified binary --- we will actually be expanding the same label
* multiple times.
*/
assert(ILIBLKG(lbl) == 0 || gbl.multiversion || ISTASKDUPG(GBL_CURRFUNC)
, "Duplicate appearance of scope label", lbl, ERR_Severe);
/* This IM_LABEL may have been created for a lexical scope that turned out
* to not contain any variables. Such a label should simply be ignored. See
* cancel_lexical_block(). */
if (!ENCLFUNCG(lbl))
return;
ilix = ad1ili(IL_LABEL, lbl);
/* Insert the label at the top of the current block instead of appending
* it. Labels are not supposed to affect code generation, but they
* interfere with the trailing branches in a block. We also have code which
* expects the last three ilts in a block to follow a certain pattern for
* indiction variable updates.
*
* Skip any existing labels at the beginning of the block so that multiple
* labels appear in source order.
*
* The first and last ilts in the current block are stored in ILT_NEXT(0)
* and ILT_PREV(0) respectively; BIH_ILTFIRST isn't up-to-date. See
* wrilts().
*/
ilt = ILT_NEXT(0);
while (ilt && ILI_OPC(ILT_ILIP(ilt)) == IL_LABEL)
ilt = ILT_NEXT(ilt);
if (!ilt) {
/* This block is all labels. Append the new label. */
expb.curilt = addilt(expb.curilt, ilix);
} else {
/* Now, ilt is the first non-label ilt in the block.
* Insert new label before ilt.
* This also does the right thing when ILT_PREV(ilt) == 0.
*/
addilt(ILT_PREV(ilt), ilix);
}
ILIBLKP(lbl, expb.curbih);
}
void
exp_label(int lbl)
{
int ilix; /* ili of an ilt */
/* Handle in-stream labels by creating an IL_LABEL ilt. */
if (is_scope_label(lbl)) {
exp_scope_label(lbl);
/* In-stream labels newer cause a new block to be created, so we're
* done. */
return;
}
if (expb.flags.bits.waitlbl) {
/*
* the current ilt points to a conditional branch. saveili locates an
* unconditional branch. If the conditional label is lbl, then the
* conditional is complemented whose label is changed to locate the
* one specified in the unconditional. The unconditional ili is not
* added.
*/
expb.flags.bits.waitlbl = 0;
ilix = ILT_ILIP(expb.curilt); /* conditional branch ili */
if (expb.curilt && (ILI_OPND(ilix, ilis[ILI_OPC(ilix)].oprs)) == lbl) {
ILT_ILIP(expb.curilt) = compl_br(ilix, (int)(ILI_OPND(expb.saveili, 1)));
RFCNTD(lbl);
} else {
if (flg.opt != 1) {
wr_block();
cr_block();
}
expb.curilt = addilt(expb.curilt, expb.saveili);
}
}
/*
* check to see if the current ilt locates an ili which is a branch to
* lbl -- this only happens for opt levels other than 0.
*/
if (flg.opt != 0 && ILT_BR(expb.curilt)) {
ilix = ILT_ILIP(expb.curilt);
if (ILI_OPND(ilix, ilis[ILI_OPC(ilix)].oprs) == lbl &&
ILI_OPC(ilix) != IL_JMPA &&
ILI_OPC(ilix) != IL_JMPMK &&
ILI_OPC(ilix) != IL_JMPM) {
int curilt = expb.curilt;
/*
* delete the branch ilt -- this may create ilts which locate
* functions
*/
if (EXPDBG(8, 32))
fprintf(gbl.dbgfil,
"---exp_label: deleting branch ili %d from block %d\n", ilix,
expb.curbih);
expb.curilt = ILT_PREV(curilt);
ILT_NEXT(expb.curilt) = 0;
ILT_PREV(0) = expb.curilt;
STG_ADD_FREELIST(iltb, curilt);
expb.curilt = reduce_ilt(expb.curilt, ilix);
RFCNTD(lbl);
}
}
/*-
* finish off by checking lbl --
* 1. If opt 0 is requested, the label will always begin a block
* if it is a user label. NOTE that this covers the case when
* just -debug is specified (no -opt); if debug is requested along
* with a higher opt, we do not allow unreferenced labels to
* appear in the blocks since this can drastically affect code.
* WARNING: coffasm needs to be follow these conventions --- see
* the Is_user_label macro in all versions of coffasm.c.
* KLUDGE: for C blocks, labels are created -- their RFCNT's must
* be nonzero (set by semant).
* 2. If the reference count is still non-zero, a new block is
* created labeled by lbl.
*/
if (flg.opt == 0 && CCSYMG(lbl) == 0) {
if (BIH_LABEL(expb.curbih) != 0 ||
(expb.curilt != 0 && !ILT_DBGLINE(expb.curilt))) {
wr_block();
cr_block();
}
BIH_LABEL(expb.curbih) = lbl;
ILIBLKP(lbl, expb.curbih);
fihb.currftag = fihb.nextftag;
fihb.currfindex = fihb.nextfindex;
} else if (RFCNTG(lbl) != 0) {
if (BIH_LABEL(expb.curbih) != 0 ||
(expb.curilt != 0 && !ILT_DBGLINE(expb.curilt))) {
wr_block();
cr_block();
} else if ((XBIT(148, 0x1) || XBIT(148, 0x1000)) && (expb.curilt == 0) &&
(fihb.currfindex != fihb.nextfindex)) {
fihb.currfindex = fihb.nextfindex;
fihb.currftag = fihb.nextftag;
}
BIH_LABEL(expb.curbih) = lbl;
ILIBLKP(lbl, expb.curbih);
fihb.currftag = fihb.nextftag;
fihb.currfindex = fihb.nextfindex;
}
else if (CCSYMG(lbl) == 0 && DBGBIT(8, 4096))
/* defd but not refd */
errlabel(120, 1, gbl.lineno, SYMNAME(lbl), CNULL);
}
/***************************************************************/
/*
* the following macro is used by the load and store code to determine if the
* load or store operation conflicts with the data type of the item being
* fetched or stored. This is done for those names entries which are
* constant array or indirection references.
* Conflicts could occur when:
* 1. if the operation is for a double data item and the data type is not
* double.
* 2. if the operation is for a float data item and the data type is not
* float.
* 3. if the operation is for an integral type and its size is inconsistent
* with the size of the data type.
* A conflict is resolved by creating an array (or indirection) reference
* which has a non-constant offset. The macro argument, "cond", specifies the
* whether or not there is a conflict.
*/
#define CHECK_NME(nme, cond) \
{ \
int i; \
if (NME_SYM(nme) == 0 && ((i = NME_TYPE(nme)) == NT_ARR || i == NT_IND) && \
(cond)) \
nme = add_arrnme(i, -1, (int)NME_NM(nme), (INT)0, (int)NME_SUB(nme), \
(int)NME_INLARR(nme)); \
}
static int
SCALAR_SIZE(int dtype, int n)
{
if (dtype == DT_ASSCHAR || dtype == DT_DEFERCHAR)
/* assume that this a pointer to an adjustable length character */
return n;
if (dtype == DT_ASSNCHAR || dtype == DT_DEFERNCHAR)
return n;
return size_of(dtype);
}
/***************************************************************/
/*
* when inlining a function with an optional argument, where the
* optional argument is missing in the call, the compiler passes
* a placeholder, pghpf_03, which it then can test for in PRESENT() calls.
*/
int
optional_missing(int nme)
{
int sptr, cmblk;
sptr = NME_SYM(nme);
if (CCSYMG(sptr) && SCG(sptr) == SC_CMBLK && ADDRESSG(sptr) == 8) {
cmblk = MIDNUMG(sptr);
if (strcmp(SYMNAME(cmblk), "pghpf_0") == 0) {
return 1;
}
}
return 0;
} /* optional_missing */
/*
* same as above, given an ILM pointer
*/
int
optional_missing_ilm(ILM *ilmpin)
{
int sptr, cmblk;
ILM *ilmp;
ilmp = ilmpin;
while (1) {
switch (ILM_OPC(ilmp)) {
case IM_BASE:
sptr = ILM_OPND(ilmp, 1);
if (CCSYMG(sptr) && SCG(sptr) == SC_CMBLK && ADDRESSG(sptr) == 8) {
cmblk = MIDNUMG(sptr);
if (strcmp(SYMNAME(cmblk), "pghpf_0") == 0) {
return 1;
}
}
return 0;
case IM_PLD:
case IM_MEMBER:
ilmp = (ILM *)(ilmb.ilm_base + ILM_OPND(ilmp, 1));
break;
case IM_ELEMENT:
case IM_INLELEM:
ilmp = (ILM *)(ilmb.ilm_base + ILM_OPND(ilmp, 2));
break;
default:
return 0;
}
}
} /* optional_missing_ilm */
/*
* here, we have a load of the missing optional, replace by a zero
*/
void
replace_by_zero(ILM_OP opc, ILM *ilmp, int curilm)
{
INT num[4];
int zero, newopc, i1;
i1 = ILM_OPND(ilmp, 1);
switch (opc) {
/* handle complex */
case IM_CLD:
num[0] = 0;
num[1] = 0;
zero = getcon(num, DT_CMPLX);
newopc = IM_CDCON;
break;
case IM_CDLD:
num[0] = stb.dbl0;
num[1] = stb.dbl0;
zero = getcon(num, DT_DCMPLX);
newopc = IM_CCON;
break;
case IM_ILD:
case IM_LLD:
case IM_LFUNC: /* LFUNC, for PRESENT calls replaced by zero */
zero = stb.i0;
newopc = IM_ICON;
break;
case IM_KLD:
case IM_KLLD:
zero = stb.k0;
newopc = IM_KCON;
break;
case IM_SLLD:
case IM_SILD:
case IM_CHLD:
zero = stb.i0;
newopc = IM_ICON;
break;
case IM_RLD:
zero = stb.flt0;
newopc = IM_RCON;
break;
case IM_DLD:
zero = stb.dbl0;
newopc = IM_DCON;
break;
case IM_PLD:
zero = stb.i0;
newopc = IM_ICON;
break;
default:
interr("replace_by_zero opc not cased", opc, 3);
break;
}
/* CHANGE the ILM in place */
ILM_OPC(ilmp) = newopc;
ILM_OPND(ilmp, 1) = zero;
/* process as a constant */
eval_ilm(curilm);
ILM_OPC(ilmp) = opc;
ILM_OPND(ilmp, 1) = i1;