1 /*
2 * Copyright (c) 1994-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 main.c
19 \brief main program and initialization routines for fortran front-end
20 */
21 #include "gbldefs.h"
22 #include <stdbool.h>
23 #include "flang/ArgParser/arg_parser.h"
24 #include "error.h"
25 #if !defined(TARGET_WIN)
26 #include <unistd.h>
27 #endif
28 #include <time.h>
29 #include "global.h"
30 #include "symtab.h"
31 #include "dtypeutl.h"
32 #include "version.h"
33 #include "inliner.h"
34 #include "interf.h"
35 #include "semant.h"
36 #include "dinit.h"
37
38 #include "ast.h"
39 #include "lower.h"
40 #include "dbg_out.h"
41 #include "ccffinfo.h"
42 #include "x86.h"
43 #include "direct.h"
44 #include "optimize.h"
45 #include "transfrm.h"
46 #include "extern.h"
47 #include "commopt.h"
48 #include "scan.h"
49 #include "hlvect.h"
50
51 #define IPA_ENABLED 0
52 #define IPA_NO_ASM 0
53 #define IPA_COLLECTION_ENABLED 0
54 #define IPA_INHERIT_ENABLED 0
55 #define IPA_FUTURE_INHERIT_DISABLED 0
56 #define IPA_REPORT_ENABLED 0
57
58 /* static prototypes */
59
60 static void reptime(void);
61 static void add_debuglist(char *phasearg, char *dumparg);
62 static void do_debug(char *phase);
63 static void cleanup(void);
64 static void init(int argc, char *argv[]);
65 static void datastructure_reinit(void);
66 static void set_ipa_export_file(char *name);
67 static void set_ipa_import_mode(void);
68 static void set_ipa_import_offset(char *offset);
69 static void set_debug(LOGICAL value);
70 static void set_debug_symbol(LOGICAL value);
71 static void set_debug_line(LOGICAL value);
72 static void do_set_tp(char *tp);
73 static void fini(void);
74 static void mkDwfInfoFilename(void);
75
76 /* ******************************************************************** */
77
78 /* Below are definitions/static variables required by main function */
79 static int saveoptflag;
80 static int savevectflag;
81 static int savex8flag;
82 static int saverecursive;
83 static LOGICAL has_accel_code = FALSE;
84 static action_map_t *phase_dump_map;
85 #if DEBUG
86 static int debugfunconly = -1;
87 #endif
88 static LOGICAL ipa_import_mode = FALSE;
89 static char *ipa_export_file = NULL;
90 static BIGUINT ipa_import_offset = 0;
91 static char *who[] = {"init", "parser", "bblock", "vectorize", "optimize",
92 "schedule", "assemble", "xref", "unroll"};
93 #define _N_WHO (sizeof(who) / sizeof(char *))
94 static INT xtimes[_N_WHO];
95 static LOGICAL postprocessing = TRUE;
96
97 /* Feature names for Fortran front-end */
98 #if defined(TARGET_LINUX_X8664)
99 static char *feature = "flang";
100 static char *os = "lin";
101 static char *accel = NULL;
102 #elif defined(TARGET_WIN_X8664)
103 static char *feature2 = "pgi-f95-win64";
104 static char *feature = "pgfortran";
105 static char *os = "win";
106 static char *accel = NULL;
107 #elif defined(TARGET_OSX_X8664)
108 static char *feature2 = "pgi-f95-osx64";
109 static char *feature = "pgfortran";
110 static char *os = "osx";
111 static char *accel = NULL;
112 #elif defined(OSF86)
113 static char *feature = "pgi-f95-osf32";
114 static char *os = NULL;
115 static char *accel = NULL;
116 #elif defined(TARGET_LLVM_POWER)
117 static char *feature2 = "pgi-f95-power";
118 static char *feature = "pgfortran";
119 static char *os = "lin";
120 static char *accel = NULL;
121 #else
122 static char *feature2 = "pgi-f95";
123 static char *feature = "pgfortran";
124 static char *os = "lin";
125 static char *accel = NULL;
126 #endif
127
128 /** Product name in debug output
129 */
130 #define DNAME "F90"
131
132 #if DEBUG
133 static int dodebug = 0;
134 #define TR(str) \
135 if (dodebug) { \
136 fprintf(gbl.dbgfil, str); \
137 fflush(gbl.dbgfil); \
138 }
139 #define TR1(str) \
140 if (DBGBIT(0, 512)) \
141 dump_stg_stat(str)
142 #define DUMP(a) do_debug(a)
143 #else
144 #define TR(str)
145 #define TR1(str)
146 #define DUMP(a)
147 #endif /* DEBUG */
148
149 #define NO_FLEXLM
150
151 /** \brief Fortran front-end main entry
152 \param argc number of command-line arguments
153 \pram argv array of command-line argument strings
154 */
155 int
main(int argc,char * argv[])156 main(int argc, char *argv[])
157 {
158 int savescope, savecurrmod = 0;
159 get_rutime();
160 init(argc, argv); /* initialize */
161 if (gbl.fn == NULL)
162 gbl.fn = gbl.src_file;
163
164 #if DEBUG
165 if (debugfunconly > 0)
166 dodebug = 0;
167 #endif
168
169 saveoptflag = flg.opt;
170 savevectflag = flg.vect;
171 savex8flag = flg.x[8];
172 saverecursive = flg.recursive;
173
174 if (IPA_INHERIT_ENABLED && (flg.opt >= 2 || IPA_COLLECTION_ENABLED)) {
175 ipa_init();
176 }
177
178 gbl.findex = addfile(gbl.fn, NULL, 0, 0, 0, 1, 0);
179
180 if (ipa_export_file && ipa_import_mode) {
181 ipa_import_open(ipa_export_file, ipa_import_offset);
182 }
183 if (IPA_ENABLED && ipa_export_file && !ipa_import_mode) {
184 /* export the program unit for IPA recompilation */
185 ipa_export_open(ipa_export_file);
186 }
187
188 if (gbl.srcfil == NULL) {
189 if (!ipa_import_mode) {
190 finish();
191 }
192 }
193 do { /* loop once for each user program unit */
194 #if DEBUG
195 if (debugfunconly > 0) {
196 if (debugfunconly == gbl.func_count + 1)
197 dodebug = 1;
198 else
199 dodebug = 0;
200 }
201 #endif
202 reinit();
203 errini();
204 if (ipa_export_file && ipa_import_mode && gbl.func_count == 0) {
205 ipa_import_highpoint();
206 }
207 if (IPA_ENABLED && ipa_export_file && !ipa_import_mode &&
208 gbl.func_count == 0) {
209 ipa_export_highpoint();
210 }
211 xtimes[0] += get_rutime();
212 if (ipa_export_file && ipa_import_mode) {
213 ipa_import();
214 if (gbl.eof_flag & 2)
215 break;
216 } else {
217 TR(DNAME " PARSER begins\n")
218 parser(); /* parse and do semantic analysis */
219 set_tag();
220 }
221 gbl.func_count++;
222 ccff_open_unit_f90();
223 if (gbl.internal <= 1) {
224 gbl.outersub = 0;
225 gbl.outerentries = 0;
226 }
227 savescope = stb.curr_scope;
228 if (gbl.currsub) {
229 if (SCOPEG(gbl.currsub)) {
230 stb.curr_scope = SCOPEG(gbl.currsub);
231 if (STYPEG(stb.curr_scope) != ST_ALIAS ||
232 SYMLKG(stb.curr_scope) != gbl.currsub) {
233 stb.curr_scope = gbl.currsub;
234 }
235 } else {
236 stb.curr_scope = gbl.currsub;
237 }
238 }
239 TR1("- after semant");
240 xtimes[1] += get_rutime();
241 DUMP("parser");
242 if (gbl.rutype == RU_BDATA) {
243 /* a module? */
244 if (has_cuda_data())
245 has_accel_code = TRUE;
246 }
247 if (gbl.currsub == 0) {
248 if (IPA_ENABLED && ipa_export_file && !ipa_import_mode) {
249 /* export the program unit for IPA recompilation */
250 ipa_export_endmodule();
251 }
252 continue; /* end of a module */
253 }
254 if (CUDAG(gbl.currsub) & (CUDA_GLOBAL | CUDA_DEVICE)) {
255 /* remember that this routine needs a constructor */
256 has_accel_code = TRUE;
257 }
258 savecurrmod = gbl.currmod;
259 #if DEBUG
260 if (DBGBIT(5, 1))
261 symdmp(gbl.dbgfil, DBGBIT(5, 8));
262 if (DBGBIT(5, 2))
263 dump_std();
264 if (DBGBIT(5, 16))
265 dmp_dtype();
266 #endif
267 if (IPA_ENABLED && ipa_export_file && !ipa_import_mode) {
268 /* export the program unit for IPA recompilation */
269 ipa_export();
270 }
271
272 #if DEBUG
273 if (DBGBIT(4, 256))
274 dump_ast();
275 #endif
276 if (IPA_INHERIT_ENABLED && gbl.rutype != RU_BDATA) {
277 int func;
278 ipa_startfunc(gbl.currsub);
279 ipa_header1(gbl.currsub);
280 ipa_header2(gbl.currsub);
281 }
282 postprocessing = FALSE;
283 if (gbl.maxsev < 3 && !DBGBIT(2, 4)) {
284 postprocessing = TRUE;
285
286 flg.ipa |= 0x20;
287 if (XBIT(57, 0x2000) && !flg.inliner) {
288 /* try to eliminate unused common blocks here */
289 eliminate_unused_variables(1);
290 DUMP("staticunused");
291 }
292 /* by default, generate data initialization inline. */
293 if (gbl.rutype != RU_BDATA) {
294 direct_rou_load(gbl.currsub);
295 if (flg.opt > 1 && !XBIT(47, 0x40000000)) {
296 if (sem.stats.allocs > 800 && sem.stats.nodes > 1000) {
297 direct_rou_setopt(gbl.currsub, 1);
298 /*
299 * Also, inhibit sectfloat() which is enabled with
300 * -fast or -O2 or greater.
301 */
302 flg.x[70] &= (~0x400);
303 }
304 }
305 ili_lpprg_init();
306
307 TR(DNAME " BBLOCK begins\n");
308 has_accel_code |= bblock();
309 TR1("- after bblock");
310 DUMP("bblock");
311 if (flg.inliner) {
312 TR(DNAME " INLINER begins\n");
313 #if DEBUG
314 if (flg.x[29] == 0 || flg.x[29] == gbl.func_count)
315 #endif
316 inliner();
317 DUMP("inliner");
318 TR1("- after inliner");
319 }
320
321 if (flg.opt >= 2 && XBIT(50, 0x40)) {
322 unconditional_branches();
323 DUMP("unconditional");
324 }
325 if (flg.opt >= 2 && !XBIT(47, 0x20)) {
326 TR(DNAME " OPTIMIZE_ALLOC begins\n");
327 optimize_alloc();
328 DUMP("optalloc");
329 TR1("- after optimize_alloc");
330 }
331
332 if (IPA_ENABLED) {
333 ipasave();
334 if (IPA_NO_ASM) {
335 ipasave_endfunc();
336 direct_rou_end();
337 continue;
338 }
339 }
340 if (IPA_INHERIT_ENABLED && !IPA_FUTURE_INHERIT_DISABLED) {
341 if (!IPA_ENABLED) {
342 fill_ipasym();
343 }
344 ipa();
345 DUMP("ipa");
346 if (IPA_Vestigial) {
347 ipasave_endfunc();
348 if (gbl.internal == 1) {
349 ipa_set_vestigial_host(); /* interf.c */
350 save_host_state(0x2 + (ipa_import_mode ? 0x20 : 0));
351 gbl.outersub = gbl.currsub;
352 gbl.outerentries = gbl.entries;
353 }
354 (void)summary(FALSE, FALSE);
355 continue;
356 }
357 }
358
359 /* infer array alignments */
360 TR(DNAME " PROCESS_ALIGN begins\n");
361 trans_process_align();
362 TR1("- after process_align");
363 DUMP("process-align");
364
365 if (flg.opt >= 2) {
366 if (XBIT(53, 2)) {
367 points_to_anal();
368 DUMP("pointsto");
369 }
370 pstride_analysis();
371 DUMP("pstride");
372 }
373
374 if (!XBIT(49, 1)) {
375 TR(DNAME " TRANSFORMER begins\n");
376 transform();
377 DUMP("transform");
378 TR1("- after transform");
379
380 forall_init();
381
382 if (!XBIT(49, 0x20)) {
383 if (flg.opt >= 2 && !XBIT(47, 0x02)) {
384 TR(DNAME " COMMUNICATIONS pre-OPTIMIZER begins\n");
385 comm_optimize_pre();
386 DUMP("comm-analyze-pre");
387 TR1("- after comm pre-optimizer");
388 }
389 TR(DNAME " COMMUNICATIONS ANALYZER begins\n");
390 comm_analyze();
391 DUMP("comm-analyze");
392 TR1("- after comm_analyze");
393
394 TR(DNAME " CALL ANALYZER begins\n");
395 call_analyze();
396 DUMP("call-analyze");
397 TR1("- after call_analyze");
398 if (flg.opt >= 2 && !XBIT(47, 0x01)) {
399 TR(DNAME " COMMUNICATIONS post-OPTIMIZER begins\n");
400 comm_optimize_post();
401 DUMP("comm-optimize-post");
402 TR1("- after comm post-optimizer");
403 }
404 if (flg.opt >= 2 && !XBIT(47, 0x08)) {
405 TR(DNAME " COMMUNICATIONS hoisting begins\n");
406 comm_invar();
407 DUMP("comm-invar");
408 TR1("- after comm_invar");
409 }
410 TR(DNAME " COMMUNICATIONS GENERATOR begins\n");
411 comm_generator();
412 DUMP("comm-generator");
413 TR1("- after comm_generator");
414 }
415 TR(DNAME " CONVERT_FORALL begins\n");
416 convert_forall();
417 DUMP("convert-forall");
418 TR1("- after convert_forall");
419
420 TR(DNAME " CONVERT_OUTPUT begins\n");
421 convert_output();
422 TR1("- after convert_output");
423 DUMP("convert-output");
424 }
425 if (XBIT(70, 0x400) || XBIT(47, 0x400000)
426 ) {
427 optimize(1);
428 DUMP("optimize0");
429 TR1("- after optimize0");
430 }
431 if (XBIT(70, 0x400)) {
432 sectfloat();
433 DUMP("sectfloat");
434 }
435 if (XBIT(47, 0x400000) || flg.opt >= 2 || XBIT(163, 1)
436 ) {
437 sectinline();
438 DUMP("sectinline");
439 }
440 if (XBIT(70, 0x18)) {
441 linearize_arrays();
442 DUMP("linearize");
443 }
444 if (!XBIT(70, 0x40)) {
445 DUMP("bredundss");
446 redundss();
447 DUMP("redundss");
448 }
449 if (flg.opt >= 2 && !XBIT(47, 0x1000)) {
450 TR(DNAME " OPTIMIZER begins\n");
451 optimize(0);
452 DUMP("optimize");
453 TR1("- after optimize");
454 }
455 if (IPA_ENABLED) {
456 ipasave_endfunc();
457 }
458 if (IPA_REPORT_ENABLED) {
459 ipa_report();
460 }
461
462 direct_rou_end();
463 if (flg.opt >= 2 && XBIT(53, 2)) {
464 fini_points_to_all();
465 }
466 } else { /* gbl.rutype == RU_BDATA */
467 direct_rou_load(gbl.currsub);
468 if (IPA_ENABLED) {
469 ipasave();
470 }
471 merge_commons();
472 if (XBIT(55, 2)) {
473 cleanup();
474 goto skip_compile;
475 }
476 /* block data must be transformed so that common blocks
477 * get handled -- lfm
478 */
479 /* infer array alignments */
480 TR("Blkdata -- " DNAME " PROCESS_ALIGN begins\n");
481 trans_process_align();
482 DUMP("process-align");
483 TR1("- after process_align");
484 if (!XBIT(49, 1)) {
485 TR("Blkdata -- " DNAME " TRANSFORMER begins\n");
486 transform();
487 DUMP("transform");
488 TR1("- after transform");
489 }
490 }
491 #if DEBUG
492 if (XBIT(57, 0x100)) {
493 renumber_lines();
494 }
495 #endif
496 if (XBIT(57, 0x2000)) {
497 DUMP("bunused");
498 eliminate_unused_variables(2);
499 DUMP("unused");
500 }
501 DUMP("before-output");
502 lower(0);
503 if (gbl.internal == 1) {
504 save_host_state(0x2 + (ipa_import_mode ? 0x20 : 0));
505 }
506 DUMP("output");
507 if (gbl.rutype != RU_BDATA && flg.opt >= 2 && XBIT(53, 2)) {
508 fini_pstride_analysis();
509 }
510 #if DEBUG
511 if (DBGBIT(5, 4))
512 symdmp(gbl.dbgfil, DBGBIT(5, 8));
513 if (DBGBIT(5, 16))
514 dmp_dtype();
515 #endif
516 } else { /* if( gbl.maxsev < 3 && !DBGBIT(2, 4) ) */
517 if (gbl.internal == 1) {
518 save_host_state(0x2);
519 }
520 } /* if( gbl.maxsev < 3 && !DBGBIT(2, 4) ) */
521
522 if (flg.xref) {
523 xref(); /* write cross reference map */
524 xtimes[7] += get_rutime();
525 }
526 skip_compile:
527 (void)summary(FALSE, FALSE);
528 errini();
529
530 if (gbl.internal == 1) {
531 gbl.outersub = gbl.currsub;
532 gbl.outerentries = gbl.entries;
533 }
534 stb.curr_scope = savescope;
535 ccff_close_unit_f90();
536 } while (!gbl.eof_flag);
537 finish(); /* finish does not return */
538 return 0; /* never reached */
539 }
540
541 /* ************************************************************** */
542
543 /*
544 * static structures/variables used in command line processing/init() function:
545 */
546
547 #define __ATOI(s, p, l, r) _atoi(s, p, l)
548 static char *objectfile;
549 static char *outfile_name;
550 LOGICAL fpp_ = FALSE;
551 static LOGICAL no_specified;
552 static int preproc = -1; /* not specified */
553
554 /* ***************************************************************** */
555
556 /*
557 * Various types of AST dumpers, wrapper functions
558 */
559
560 static void
dump_stds(void)561 dump_stds(void)
562 {
563 dstds(0, 0);
564 }
565
566 static void
dump_sstds(void)567 dump_sstds(void)
568 {
569 dsstds(0, 0);
570 }
571
572 static void
dump_stdps(void)573 dump_stdps(void)
574 {
575 dstdps(0, 0);
576 }
577
578 /** \brief Dump symbols
579 */
580 static void
dump_symbols(void)581 dump_symbols(void)
582 {
583 dsyms(0, 0);
584 }
585
586 /** \brief Dump all symbols
587 */
588 static void
dump_all_symbols(void)589 dump_all_symbols(void)
590 {
591 dsyms(1, 0);
592 }
593
594 /** \brief Dump symbols from current source file
595 */
596 static void
dump_current_symbols(void)597 dump_current_symbols(void)
598 {
599 dsyms(stb.firstosym, 0);
600 }
601
602 /** \brief Yet another symbol table dumper
603 */
604 static void
dump_old_symbols(void)605 dump_old_symbols(void)
606 {
607 symdmp(gbl.dbgfil, 0);
608 }
609
610 /** \brief Dump memory area
611 */
612 static void
report_area(void)613 report_area(void)
614 {
615 reportarea(0);
616 }
617
618 static char *current_phase;
619
620 /** \brief Dump stg statistics
621 */
622 static void
dump_stg_stats(void)623 dump_stg_stats(void)
624 {
625 dump_stg_stat(current_phase);
626 }
627
628 /**
629 * \brief Initialize Fortran frontend at the beginning of compilation.
630 */
631 static void
init(int argc,char * argv[])632 init(int argc, char *argv[])
633 {
634 int argindex;
635 char *argstring;
636 int indice, next;
637 char *sourcefile;
638 char *stboutfile;
639 int nosuffixcheck = 0;
640 char *listfile;
641 char *cppfile;
642 char *tempfile;
643 char *asmfile;
644 int i;
645 int def_count = 0; /* number of -def switches */
646 int idir_count = 0; /* number of -idir switches */
647 INT qval1;
648 INT qval2;
649 int val_follows;
650 LOGICAL dbgflg;
651 char *dbgfile = NULL;
652 LOGICAL errflg;
653 FILE *fd;
654 int exlib_flag = 0;
655 char *file_suffix;
656 int copy_curr_file = 1;
657 static struct {
658 char *nm; /* name, 0 = end of list */
659 int form; /* 0 = fixed, 1 = form */
660 int fpp; /* 0 = don't preprocess, 1 = preprocess */
661 } suffixes[] = {
662 {".hpf", 0, 0}, {".f", 0, 0}, {".F", 0, 1}, {".f90", 1, 0},
663 {".F90", 1, 1}, {".f95", 1, 0}, {".F95", 1, 1}, {".for", 0, 0},
664 {".fpp", 0, 1}, {0, 0, 0},
665 };
666 char *followval;
667 int followindex;
668 time_t now;
669
670 flg.freeform = -1;
671 file_suffix = ".f90"; /* default suffix for source files */
672 /*
673 * initialize error and symbol table modules in case error messages are
674 * issued:
675 */
676 errini();
677 gbl.curr_file = NULL;
678 gbl.fn = NULL;
679 sym_init();
680 interf_init();
681 BZERO(&sem, SEM, 1);
682
683 /* fill in date and time */
684 time(&now);
685 strftime(gbl.datetime, sizeof gbl.datetime, "%m/%d/%Y %H:%M:%S",
686 localtime(&now));
687
688 dbgflg = FALSE;
689 errflg = FALSE;
690
691 sourcefile = NULL;
692 listfile = NULL;
693 cppfile = NULL;
694 objectfile = NULL;
695 asmfile = NULL;
696 outfile_name = NULL;
697 gbl.ipaname = NULL;
698 argindex = 0;
699 stboutfile = NULL;
700
701 flg.x[79] = 16; /* Hardwire XBIT(79,16): CSE DP loads for a distance of 16 */
702
703 flg.x[27] = -1; /* overlap not set */
704
705 if (argc < 2)
706 goto empty_cl;
707
708 char *tp; /* Target architecture */
709 char *omptp = NULL; /* OpenMP Target architecture */
710 int vect_val; /* Vectorizer settings */
711 char *modexport_val; /* Modexport file name */
712 char *modindex_val; /* Modindex file name */
713 char **module_dirs; /* Null-terminated list of module directories */
714 bool arg_preproc; /* Argument to turn preprocessor on and off */
715 bool arg_freeform; /* Argument to force free-form source */
716 bool arg_extend; /* Argument to force line extension */
717 bool arg_reentrant; /* Argument to enable generating reentrant code */
718
719 /* Create a datastructure of various dump actions and their names */
720 action_map_t *dump_map; /* Deallocated after arguments are parsed */
721 create_action_map(&dump_map);
722 add_action(dump_map, "ast", dump_ast);
723 add_action(dump_map, "dtype", dumpdts);
724 add_action(dump_map, "std", dump_stds);
725 add_action(dump_map, "sstd", dump_sstds);
726 add_action(dump_map, "stdp", dump_stdps);
727 add_action(dump_map, "sym", dump_symbols);
728 add_action(dump_map, "syms", dump_symbols);
729 add_action(dump_map, "symtab", dump_symbols);
730 add_action(dump_map, "allsym", dump_all_symbols);
731 add_action(dump_map, "stats", dump_stg_stats);
732 add_action(dump_map, "area", report_area);
733 add_action(dump_map, "olddtype", dmp_dtype);
734 add_action(dump_map, "odtype", dmp_dtype);
735 add_action(dump_map, "oldsym", dump_old_symbols);
736 add_action(dump_map, "osym", dump_current_symbols);
737 add_action(dump_map, "hsym", dump_current_symbols);
738 add_action(dump_map, "hsyms", dump_current_symbols);
739 add_action(dump_map, "common", dcommons);
740 add_action(dump_map, "commons", dcommons);
741 add_action(dump_map, "nast", dumpasts);
742 add_action(dump_map, "stdtree", dumpstdtrees);
743 add_action(dump_map, "stdtrees", dumpstdtrees);
744 add_action(dump_map, "shape", dumpshapes);
745 add_action(dump_map, "aux", dumplists);
746 /* Initialize the map that will be used by dump handler later */
747 create_action_map(&phase_dump_map);
748
749 arg_parser_t *arg_parser;
750
751 create_arg_parser(&arg_parser, true);
752
753 /* Register two ways for supplying source file argument */
754 register_filename_arg(arg_parser, &sourcefile);
755 register_string_arg(arg_parser, "src", &sourcefile, NULL);
756 /* Output file (.ilm) */
757 register_combined_bool_string_arg(arg_parser, "output", (bool *)&(flg.output),
758 &outfile_name);
759 /* Other files to input or output */
760 register_string_arg(arg_parser, "stbfile", &stboutfile, NULL);
761 register_string_arg(arg_parser, "modexport", &modexport_val, NULL);
762 register_string_arg(arg_parser, "modindex", &modindex_val, NULL);
763 register_string_arg(arg_parser, "qfile", &dbgfile, NULL);
764
765 /* Optimization level */
766 register_integer_arg(arg_parser, "opt", &(flg.opt), 1);
767
768 /* Debug */
769 register_boolean_arg(arg_parser, "debug", &(flg.debug), 0);
770 register_integer_arg(arg_parser, "ieee", &(flg.ieee), 0);
771
772 /* Allocate space for command line macro definitions */
773 flg.def = (char **)getitem(8, argc * sizeof(char *));
774 flg.undef = (char **)getitem(8, argc * sizeof(char *));
775 flg.idir = (char **)getitem(8, argc * sizeof(char *));
776 module_dirs = (char **)getitem(8, argc * sizeof(char *));
777 /* Command line macro definitions */
778 register_string_list_arg(arg_parser, "def", flg.def);
779 register_string_list_arg(arg_parser, "undef", flg.undef);
780 register_string_list_arg(arg_parser, "idir", flg.idir);
781 register_string_list_arg(arg_parser, "moddir", module_dirs);
782
783 /* x flags */
784 register_xflag_arg(arg_parser, "x", flg.x,
785 (sizeof(flg.x) / sizeof(flg.x[0])));
786 register_yflag_arg(arg_parser, "y", flg.x);
787 /* Debug flags */
788 register_qflag_arg(arg_parser, "q", flg.dbg,
789 (sizeof(flg.dbg) / sizeof(flg.dbg[0])));
790 register_action_map_arg(arg_parser, "qq", phase_dump_map, dump_map);
791
792 /* Other flags */
793 register_boolean_arg(arg_parser, "mp", (bool *)&(flg.smp), false);
794 register_string_arg(arg_parser, "fopenmp-targets", &omptp, NULL);
795 register_boolean_arg(arg_parser, "preprocess", &arg_preproc, true);
796 register_boolean_arg(arg_parser, "reentrant", &arg_reentrant, false);
797 register_integer_arg(arg_parser, "terse", &(flg.terse), 1);
798 register_inform_level_arg(arg_parser, "inform",
799 (inform_level_t *)&(flg.inform), LV_Inform);
800 register_boolean_arg(arg_parser, "hpf", (bool *)&(flg.hpf), true);
801 register_boolean_arg(arg_parser, "static", (bool *)&(flg.doprelink), true);
802 register_boolean_arg(arg_parser, "quad", (bool *)&(flg.quad), true);
803 register_boolean_arg(arg_parser, "freeform", &arg_freeform, false);
804 register_string_arg(arg_parser, "tp", &tp, NULL);
805 register_string_arg(arg_parser, "stdinc", &(flg.stdinc), (char *)1);
806 register_integer_arg(arg_parser, "vect", &(vect_val), 0);
807 register_boolean_arg(arg_parser, "standard", (bool *)&(flg.standard), false);
808 register_boolean_arg(arg_parser, "save", (bool *)&(flg.save), false);
809 register_boolean_arg(arg_parser, "extend", &arg_extend, false);
810 register_boolean_arg(arg_parser, "recursive", (bool *)&(flg.recursive),
811 false);
812 register_string_arg(arg_parser, "cmdline", &(flg.cmdline), NULL);
813 register_boolean_arg(arg_parser, "es", (bool *)&(flg.es), false);
814 register_boolean_arg(arg_parser, "pp", (bool *)&(flg.p), false);
815
816 /* Set values form command line arguments */
817 parse_arguments(arg_parser, argc, argv);
818
819 /* Direct debug output */
820 if (was_value_set(arg_parser, &(flg.dbg)) ||
821 was_value_set(arg_parser, phase_dump_map)) {
822 #if DEBUG
823 dodebug = 1;
824 #endif
825 if (dbgfile) {
826 gbl.dbgfil = fopen(dbgfile, "w");
827 if (gbl.dbgfil == NULL)
828 errfatal(5);
829 } else if ((flg.dbg[0] & 1) || sourcefile == NULL) {
830 gbl.dbgfil = stderr;
831 } else {
832 if (ipa_import_mode) {
833 tempfile = mkfname(sourcefile, file_suffix, ".qdbh");
834 } else {
835 tempfile = mkfname(sourcefile, file_suffix, ".qdbf");
836 if ((gbl.dbgfil = fopen(tempfile, "w")) == NULL)
837 errfatal(5);
838 }
839 }
840 }
841
842 /* Set preporocessor and Fortran source form
843 * ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
844 * FIXME this logic needs to be moved to where those values are consumed
845 */
846 if (was_value_set(arg_parser, &arg_preproc)) {
847 /* If the argument was present on command line set the value, otherwise
848 * keep "undefined" -1 */
849 preproc = arg_preproc;
850 }
851 if (was_value_set(arg_parser, &arg_freeform)) {
852 /* If the argument was present on command line set the value, otherwise
853 * keep "undefined" -1 */
854 flg.freeform = arg_freeform;
855 }
856
857 /* Enable reentrant code */
858 if (was_value_set(arg_parser, &arg_reentrant)) {
859 if (arg_reentrant) {
860 flg.x[7] |= 0x2; /* inhibit terminal func optz. */
861 flg.recursive = TRUE; /* no static locals */
862 } else {
863 flg.x[7] &= ~(0x2);
864 flg.recursive = FALSE;
865 }
866 }
867
868 /* Free memory */
869 destroy_arg_parser(&arg_parser);
870 destroy_action_map(&dump_map);
871
872 /* Now do some postprocessing
873 * ^^^^^^^^^^^^^^^^^^^^^^^^^^
874 */
875
876 /* Check optimization level */
877 if (flg.opt > 4) {
878 fprintf(stderr, "%s-W-Opt levels greater than 4 are not supported\n", version.lang);
879 }
880 /* -nostatic postprocessing */
881 if (!flg.doprelink)
882 flg.ipa |= 0x50; /* don't defer initialization, issue errors */
883
884 /* Postprocess target architecture */
885 do_set_tp(tp);
886 #ifdef OMP_OFFLOAD_LLVM
887 if(omptp != NULL)
888 flg.omptarget = TRUE;
889 #endif
890 /* Vectorizer settings */
891 flg.vect |= vect_val;
892 if (flg.vect & 0x10)
893 flg.x[19] &= ~0x10;
894 if (flg.vect & 0x20)
895 flg.x[19] &= ~8;
896 set_yflag(34, 0x30);
897
898 /* modexport file name */
899 mod_combined_name(modexport_val);
900 /* modindex file name */
901 mod_combined_index(modindex_val);
902
903 /* Extend source file lines */
904 if (arg_extend)
905 flg.extend_source = 132;
906
907 /* Set module directory linked list
908 * ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
909 * FIXME this is bad, have different implementations for different string
910 * lists, that needs to stop.
911 */
912 char **module_dir = module_dirs;
913 while (module_dir && *module_dir) {
914 moddir_list *mdl;
915 NEW(mdl, moddir_list, 1);
916 mdl->module_directory = *module_dir;
917 mdl->next = NULL;
918 if (module_directory_list == NULL) {
919 module_directory_list = mdl;
920 } else {
921 moddir_list *link;
922 for (link = module_directory_list; link->next; link = link->next)
923 ;
924 link->next = mdl;
925 }
926 ++module_dir;
927 }
928
929 flg.genilm = TRUE;
930 /* set -x 49 0x400000, F90-style output */
931 set_xflag(49, 0x400000);
932 /* set -x 58 0x10000, handle all pointers */
933 set_xflag(58, 0x10000);
934 gbl.is_f90 = TRUE;
935 /* set -x 58 0x40, and reset hpf flag, no static-init */
936 set_xflag(58, 0x40);
937 flg.defaulthpf = flg.hpf = FALSE;
938 flg.defaultsequence = flg.sequence = TRUE;
939 /* set -x 58 0x20000, allocate temps only as big as needed */
940 set_xflag(58, 0x20000);
941
942 if (XBIT(25, 0xf0)) {
943 fprintf(stderr, "%s-I-Beta Release Optimizations Activated\n", version.lang);
944 }
945
946 if (flg.x[27] == -1)
947 flg.x[27] = 4; /* default/max overlap of 4 */
948
949 if (flg.es && !flg.p)
950 flg.x[123] |= 0x100;
951
952 empty_cl:
953 if (sourcefile == NULL) {
954 if (flg.ipa & 0x0a) {
955 /* for IPA propagation or when generating static$init, no sourcefile */
956 sourcefile = "pghpf.prelink.f";
957 gbl.src_file = (char *)malloc(strlen(sourcefile) + 1);
958 strcpy(gbl.src_file, sourcefile);
959 gbl.srcfil = NULL;
960 copy_curr_file = 0;
961 } else {
962 gbl.src_file = sourcefile = "STDIN.f";
963 gbl.srcfil = stdin;
964 }
965 goto do_curr_file;
966 }
967
968 if (errflg)
969 finish();
970
971 if (ipa_import_mode) {
972 char *s;
973 if (!sourcefile) {
974 gbl.src_file = (char *)malloc(strlen(sourcefile) + 1);
975 strcpy(gbl.src_file, sourcefile);
976 basenam(gbl.src_file, "", sourcefile);
977 } else {
978 sourcefile = "STDIN.f";
979 gbl.src_file = (char *)malloc(strlen(sourcefile) + 1);
980 strcpy(gbl.src_file, sourcefile);
981 }
982 file_suffix = "";
983 for (s = gbl.src_file; *s; ++s) {
984 if (*s == '.')
985 file_suffix = s;
986 }
987
988 } else {
989 if (!nosuffixcheck) {
990 /* open sourcefile */
991 for (i = 0; suffixes[i].nm; ++i) {
992 int lsuf, lsrc;
993 lsuf = strlen(suffixes[i].nm);
994 lsrc = strlen(sourcefile);
995 if (lsuf >= lsrc)
996 continue;
997 if (strcmp(sourcefile + (lsrc - lsuf), suffixes[i].nm))
998 continue;
999 gbl.src_file = mkfname(sourcefile, suffixes[i].nm, suffixes[i].nm);
1000 if ((gbl.srcfil = fopen(gbl.src_file, "r")) != NULL) {
1001 /* fill in flg.freeform, file_suffix, fpp_, gbl.src_file */
1002 if (flg.freeform == -1)
1003 flg.freeform = suffixes[i].form;
1004 file_suffix = suffixes[i].nm;
1005 if (suffixes[i].fpp) {
1006 if (preproc == -1 || preproc == 1)
1007 fpp_ = TRUE;
1008 /* -nopreproc overrides use of .F extension */
1009 }
1010 /* strip pathname, if any */
1011 /* use mkfname to allocate space */
1012 sourcefile = mkfname(gbl.src_file, file_suffix, file_suffix);
1013 /* base name strips the pathname */
1014 basenam(gbl.src_file, "", sourcefile);
1015 goto is_open;
1016 }
1017 /* ** else will be reported_as_an error(2...) below ** */
1018 }
1019 }
1020 if ((gbl.srcfil = fopen(sourcefile, "r")) != NULL) {
1021 /* fill in gbl.src_file, file_suffix */
1022 char *s;
1023 gbl.src_file = (char *)malloc(strlen(sourcefile) + 1);
1024 strcpy(gbl.src_file, sourcefile);
1025 basenam(gbl.src_file, "", sourcefile);
1026 file_suffix = "";
1027 for (s = gbl.src_file; *s; ++s) {
1028 if (*s == '.')
1029 file_suffix = s;
1030 }
1031 goto is_open;
1032 }
1033 /* not found */
1034 error(2, 4, 0, sourcefile, CNULL);
1035 is_open:
1036 if (preproc == 1)
1037 fpp_ = TRUE; /* -preproc forces preprocessing */
1038 }
1039
1040 do_curr_file:
1041
1042 if (gbl.file_name == NULL)
1043 gbl.file_name = gbl.src_file;
1044 if (sourcefile != NULL)
1045 gbl.module = mkfname(sourcefile, file_suffix, "");
1046 if (copy_curr_file)
1047 gbl.curr_file = gbl.src_file;
1048
1049 /* process object file: */
1050
1051 gbl.objfil = NULL;
1052
1053 if (sourcefile == NULL) {
1054 if (!flg.output || outfile_name == NULL) {
1055 gbl.outfil = stdout;
1056 } else {
1057 if ((gbl.outfil = fopen(outfile_name, "w")) == NULL)
1058 error(4, 0, 0, "Unable to open output file", outfile_name);
1059 }
1060 if (OUTPUT_DWARF && (dbg_file == NULL) && outfile_name != NULL) {
1061 /* make dwarf debug info file from the source file */
1062 mkDwfInfoFilename();
1063 if ((dbg_file = fopen(dbg_file_name, "wb")) == NULL)
1064 errfatal(9);
1065 dwarf_set_fn();
1066 } else {
1067 flg.debug = 0;
1068 }
1069 if (stboutfile != NULL) {
1070 char *tname;
1071 if ((gbl.stbfil = fopen(stboutfile, "w")) == NULL)
1072 errfatal(9);
1073 } else {
1074 gbl.stbfil = 0;
1075 }
1076 } else {
1077 char *tname;
1078 /* process listing file */
1079 if (flg.code || flg.list || flg.xref) {
1080 if (listfile == NULL) {
1081 /* make listing filename from sourcefile name */
1082 listfile = mkfname(sourcefile, file_suffix, LISTFILE);
1083 }
1084 if ((fd = fopen(listfile, "w")) == NULL)
1085 errfatal(3);
1086 list_init(fd);
1087 }
1088 if (OUTPUT_DWARF && (dbg_file == NULL)) {
1089 /* make dwarf debug info file from the source file */
1090 if (outfile_name != NULL) {
1091 mkDwfInfoFilename();
1092 } else {
1093 dbg_file_name = mkfname(sourcefile, file_suffix, ".dbg");
1094 }
1095 if ((dbg_file = fopen(dbg_file_name, "wb")) == NULL)
1096 errfatal(9);
1097 }
1098 if (stboutfile) {
1099 if ((gbl.stbfil = fopen(stboutfile, "w")) == NULL)
1100 errfatal(9);
1101 } else {
1102 gbl.stbfil = NULL;
1103 }
1104
1105 /* process assembly output file */
1106 if (flg.asmcode) {
1107 if (asmfile == NULL) {
1108 /* make assembly filename from sourcefile name */
1109 asmfile = mkfname(sourcefile, file_suffix, ASMFILE);
1110 }
1111 if ((gbl.asmfil = fopen(asmfile, "w")) == NULL)
1112 errfatal(9);
1113 } else /* do this for compilers which write asm code to stdout */
1114 gbl.asmfil = stdout;
1115 /* process source output file */
1116 if (flg.output && !flg.es) {
1117 /* make output filename from sourcefile name */
1118 if (outfile_name == NULL) {
1119 outfile_name = mkfname(sourcefile, file_suffix, ".ilm");
1120 }
1121 if ((gbl.outfil = fopen(outfile_name, "w")) == NULL)
1122 error(4, 0, 0, "Unable to open output file", outfile_name);
1123 } else
1124 gbl.outfil = stdout;
1125
1126
1127 if (flg.doprelink && (flg.ipa & 0x03) == 0 && gbl.ipaname == NULL) {
1128 gbl.ipaname = mkfname(sourcefile, file_suffix, ".d");
1129 gbl.gblfil = NULL;
1130 unlink(gbl.ipaname);
1131 }
1132
1133 /* create temporary file for preprocessor output & preprocess */
1134 if (!ipa_import_mode) {
1135 if (fpp_) {
1136 if (flg.es) {
1137 if (cppfile == NULL)
1138 gbl.cppfil = stdout;
1139 else if ((gbl.cppfil = fopen(cppfile, "w")) == NULL)
1140 errfatal(5);
1141 } else {
1142 if ((gbl.cppfil = tmpf("a")) == NULL)
1143 errfatal(5);
1144 }
1145 fpp();
1146 if (flg.es || gbl.maxsev >= 3)
1147 finish();
1148 if (flg.list)
1149 list_page();
1150 scan_init(gbl.cppfil);
1151 } else
1152 scan_init(gbl.srcfil);
1153 }
1154 #if DEBUG
1155 assert(flg.es == 0, "init:flg.esA", 0, 0);
1156 #endif
1157 assemble_init();
1158 if (OUTPUT_DWARF && dbg_file != NULL) {
1159 dwarf_set_fn();
1160 }
1161 }
1162 gbl.func_count = 0;
1163
1164 if (XBIT(125, 0x8))
1165 gbl.ftn_true = 1;
1166 else
1167 gbl.ftn_true = -1;
1168
1169 /*
1170 * direct_init() must be called at a point where we are sure that
1171 * the values of flg members, especially xflags, can be propagated
1172 * to the global, routine, etc. directive data structures. For example,
1173 * direct_init() can only be called after the code above which can
1174 * disable the cuda/accel features in the code by clearing their
1175 * respective xflags.
1176 */
1177 direct_init();
1178
1179 /* set mach, currently need for -mp=align optimization on sandybridge */
1180 set_mach(&mach, flg.tpvalue[0]);
1181
1182 return;
1183 }
1184
1185 /* *************************************************************** */
1186
1187 static char *uses_name;
1188
1189 moddir_list *module_directory_list = NULL;
1190
1191 #if DEBUG
1192
1193 static void
do_debug(char * phase)1194 do_debug(char *phase)
1195 {
1196 if (debugfunconly > 0 && gbl.func_count != debugfunconly) {
1197 /* only for some functions */
1198 return;
1199 }
1200 if (dodebug)
1201 fprintf(gbl.dbgfil, "{%s after %s\n", feature, phase);
1202
1203 current_phase = phase;
1204 execute_actions_for_keyword(phase_dump_map, phase);
1205 } /* do_debug */
1206
1207 #endif /* if DEBUG */
1208
1209 /* call this routine to clean up data structures if not compiling all the
1210 * way to the end */
1211 static void
cleanup(void)1212 cleanup(void)
1213 {
1214 direct_rou_end();
1215 dinit_end();
1216 df_dinit_end();
1217 freearea(15);
1218 postprocessing = FALSE;
1219 } /* cleanup */
1220
1221 static void
reptime(void)1222 reptime(void)
1223 {
1224 char buf[80];
1225 int i;
1226 INT total;
1227 int prct;
1228 int tmp;
1229
1230 total = 0;
1231 for (i = 0; i < _N_WHO; i++)
1232 total += xtimes[i];
1233
1234 if (!DBGBIT(0, 8) || DBGBIT(14, 3))
1235 goto xbitcheck;
1236
1237 if (flg.code || flg.list || flg.xref) {
1238 list_line("");
1239 list_line(" Timing stats:");
1240 } else if (gbl.dbgfil)
1241 fprintf(gbl.dbgfil, " Timing stats:\n");
1242 for (i = 0; i < _N_WHO; i++) {
1243 if (xtimes[i]) {
1244 tmp = 100 * xtimes[i];
1245 prct = tmp / total;
1246 sprintf(buf, " %-10.10s %15d millisecs %5d%%", who[i], xtimes[i],
1247 prct);
1248 if (flg.code || flg.list || flg.xref)
1249 list_line(buf);
1250 else if (gbl.dbgfil)
1251 fprintf(gbl.dbgfil, "%s\n", buf);
1252 }
1253 }
1254
1255 sprintf(buf, " Total time %15d millisecs", total);
1256 if (flg.code || flg.list || flg.xref) {
1257 list_line(buf);
1258 } else if (gbl.dbgfil)
1259 fprintf(gbl.dbgfil, "%s\n", buf);
1260
1261 xbitcheck:
1262 if (!XBIT(0, 1))
1263 return;
1264 fprintf(stderr, " Timing stats:\n");
1265
1266 for (i = 0; i < _N_WHO; i++) {
1267 if (xtimes[i]) {
1268 tmp = 100 * xtimes[i];
1269 prct = tmp / total;
1270 sprintf(buf, " %-10.10s %15d millisecs %5d%%", who[i], xtimes[i],
1271 prct);
1272 fprintf(stderr, "%s\n", buf);
1273 }
1274 }
1275 sprintf(buf, " Total time %15d millisecs", total);
1276 fprintf(stderr, "%s\n", buf);
1277 }
1278
1279 static void
datastructure_reinit(void)1280 datastructure_reinit(void)
1281 {
1282 /* initialize global variables: */
1283 gbl.currsub = 0;
1284 gbl.arets = FALSE;
1285 gbl.rutype = RU_PROG;
1286 gbl.cmblks = NOSYM;
1287 gbl.externs = NOSYM;
1288 gbl.consts = NOSYM;
1289 gbl.locals = NOSYM;
1290 gbl.statics = NOSYM;
1291 gbl.ent_select = 0;
1292 gbl.stfuncs = NOSYM;
1293 gbl.locaddr = 0;
1294 gbl.saddr = 0;
1295 set_bss_addr(0);
1296 gbl.autobj = NOSYM;
1297 gbl.asgnlbls = 0;
1298 gbl.exitstd = 0;
1299 gbl.tp_adjarr = NOSYM;
1300 gbl.p_adjarr = NOSYM;
1301 gbl.p_adjstr = NOSYM;
1302 gbl.denorm = FALSE;
1303 gbl.inomptarget = false;
1304 /* restore opt flag to its original value */
1305 flg.opt = saveoptflag;
1306 flg.vect = savevectflag;
1307 flg.x[8] = savex8flag;
1308 flg.recursive = saverecursive;
1309
1310 sym_init(); /* initialize symbol table module */
1311 dinit_init(); /* initialize data init file module */
1312 /* close data initialization files */
1313 dinit_end();
1314 if (astb.df != NULL)
1315 fclose(astb.df);
1316 astb.df = NULL;
1317
1318 astout_init();
1319 } /* datastructure_reinit */
1320
1321 /** \brief perform initializations for new user subprogram unit.
1322 */
1323 void
reinit(void)1324 reinit(void)
1325 {
1326 scan_opt_restore(); /* if OPTIONS statement was seen in prev */
1327
1328 datastructure_reinit();
1329
1330 semant_init(ipa_export_file != 0 && ipa_import_mode);
1331 /* initialize semantic analyzer.
1332 * WARNING: when compiling module subprograms,
1333 * it's assumed that the certain data structures
1334 * (asts, dtypes, etc.) of entities in the
1335 * module specification part will have the same
1336 * indices when imported into a CONTAINS'd
1337 * subprogram. All inits, on which importing
1338 * module information depends, must be peformed
1339 * before semant_init().
1340 */
1341 if (flg.xref)
1342 xrefinit(); /* initialize cross reference module */
1343 dpm_out_init(); /* initialize dp output module -- should
1344 * be replaced with call to transform_init().
1345 */
1346
1347 queue_tbp(0, 0, 0, 0, TBP_CLEAR_STALE_RECORDS);
1348 }
1349
1350 /* *************************************************************** */
1351
1352 static int exitcode;
1353
1354 /** \brief set exit code for compiler (see finish() function)
1355 \param ec - the exit code to set
1356 */
1357 void
set_exitcode(int ec)1358 set_exitcode(int ec)
1359 {
1360 exitcode = ec;
1361 }
1362
1363 /** \brief Write summary line to terminal, and exit compiler.
1364 */
1365 void
finish(void)1366 finish(void)
1367 {
1368 int maxfilsev;
1369 static int called = 0;
1370
1371 if (!ipa_import_mode)
1372 scan_fini();
1373 if (IPA_INHERIT_ENABLED && (flg.opt >= 2 || IPA_COLLECTION_ENABLED)) {
1374 ipa_fini();
1375 }
1376 ipasave_fini();
1377 DUMP("fini");
1378 symtab_fini();
1379 fih_fini();
1380 ast_fini();
1381 direct_fini();
1382 sem_fini();
1383 mod_fini();
1384 if (XBIT(123, 0x30000)) {
1385 import_module_print();
1386 }
1387
1388 called++;
1389 if (gbl.maxsev < 3 && called == 1 && (XBIT(123, 2) || XBIT(123, 8))) {
1390 FILE *fp;
1391 char *dependfile;
1392
1393 if (XBIT(123, 8)) {
1394 /* -MD option: Print list of include files to file <program>.d */
1395 dependfile = mkfname(gbl.module, "", ".d");
1396 if ((fp = fopen(dependfile, "w")) == NULL)
1397 errfatal(5);
1398 } else {
1399 /* -M option: Print list of include files to stdout */
1400 fp = stdout;
1401 }
1402 if (gbl.moddependfil) {
1403 rewind(gbl.moddependfil);
1404 while (1) {
1405 int c;
1406 c = fgetc(gbl.moddependfil);
1407 if (c == EOF)
1408 break;
1409 fputc(c, fp);
1410 }
1411 }
1412 if (!XBIT(123, 0x40000)) {
1413 fprintf(fp, "%s%s : ", gbl.module, OBJFILE);
1414 fprintf(fp, "%s ", gbl.src_file);
1415 } else {
1416 fprintf(fp, "\"%s%s\" : ", gbl.module, OBJFILE);
1417 fprintf(fp, "\"%s\" ", gbl.src_file);
1418 }
1419 if (gbl.dependfil) {
1420 rewind(gbl.dependfil);
1421 while (1) {
1422 int c;
1423 c = fgetc(gbl.dependfil);
1424 if (c == EOF)
1425 break;
1426 fputc(c, fp);
1427 }
1428 }
1429 fputc('\n', fp);
1430 if (XBIT(123, 8))
1431 fclose(fp);
1432 }
1433
1434 if (!flg.es) {
1435 reptime();
1436 maxfilsev = summary(TRUE, FALSE);
1437 } else
1438 maxfilsev = gbl.maxsev;
1439
1440 if (maxfilsev >= 3) {
1441 /* remove objectfile if there were severe errors */
1442 if (flg.object && gbl.objfil)
1443 if (!DBGBIT(0, 16))
1444 unlink(objectfile);
1445 } else {
1446 if (gbl.objfil != NULL)
1447 fclose(gbl.objfil);
1448 if (IPA_ENABLED || IPA_INHERIT_ENABLED)
1449 ipasave_closefile();
1450 if (IPA_INHERIT_ENABLED)
1451 ipa_closefile();
1452 if (!flg.es) {
1453 fini();
1454 }
1455 }
1456 if (gbl.asmfil != NULL && gbl.asmfil != stdout)
1457 fclose(gbl.asmfil);
1458 if (gbl.outfil != NULL && gbl.outfil != stdout)
1459 fclose(gbl.outfil);
1460 if (IPA_ENABLED && ipa_export_file && !ipa_import_mode) {
1461 /* export the program unit for IPA recompilation */
1462 ipa_export_close();
1463 }
1464
1465 freearea(8); /* temporary filenames and pathnames space */
1466 free_getitem_p(); /* getitem_p tbl contains area 8 pointers */
1467 destroy_action_map(&phase_dump_map);
1468 /*free( gbl.src_file );*/
1469 gbl.src_file = NULL;
1470 if (maxfilsev >= 3) {
1471 if (!XBIT(123, 0x40000) || exitcode == 0)
1472 exit(1);
1473 else
1474 exit(exitcode);
1475 } else
1476 exit(0);
1477 }
1478
1479 /* ******************************************************************* */
1480
1481 /* dummies for dwarf */
1482 FILE *dbg_file = NULL;
1483 char *dbg_file_name = NULL;
dwarf_set_fn(void)1484 void dwarf_set_fn(void) {}
setrefsymbol(int symbol)1485 void setrefsymbol(int symbol) {}
scan_for_dwarf_module(void)1486 void scan_for_dwarf_module(void) {}
1487
1488 static void
do_set_tp(char * tp)1489 do_set_tp(char *tp)
1490 {
1491 if (tp) {
1492 if (strcmp(tp, "x64") == 0) {
1493 set_tp("k8-64");
1494 set_tp("p7-64");
1495 } else {
1496 set_tp(tp);
1497 }
1498 }
1499 }
1500
1501 /** \brief This function creates a dwarf debug info filename from source file.
1502 */
1503 static void
mkDwfInfoFilename(void)1504 mkDwfInfoFilename(void)
1505 {
1506 int i;
1507 /* first, find the file suffix of the output file (created by the driver) */
1508 for (i = strlen(outfile_name) - 1; i > 0; i--)
1509 if (outfile_name[i] == '.')
1510 break;
1511 if (i == 0)
1512 i = strlen(outfile_name) - 1; /* punt if no suffix */
1513 dbg_file_name = mkfname(outfile_name, &outfile_name[i], ".dbg");
1514 }
1515
1516 /** \brief called at end of processing contains subprograms */
1517 void
end_contained(void)1518 end_contained(void)
1519 {
1520 lower_end_contains();
1521 if (ipa_export_file && !ipa_import_mode) {
1522 ipa_export_endcontained();
1523 }
1524 }
1525
1526 static void
fini()1527 fini()
1528 {
1529 assemble_end();
1530 }
1531
1532 /* dummies required to link when we don't have IPA */
1533
1534 int IPA_Vestigial = 0;
1535
ipa_closefile()1536 void ipa_closefile() {}
ipa_export()1537 void ipa_export() {}
ipa_export_close()1538 void ipa_export_close() {}
ipa_export_endcontained()1539 void ipa_export_endcontained() {}
ipa_export_endmodule()1540 void ipa_export_endmodule() {}
ipa_export_highpoint()1541 void ipa_export_highpoint() {}
ipa_export_open(char * export_filename)1542 void ipa_export_open(char *export_filename) {}
ipa_header1(int currfunc)1543 void ipa_header1(int currfunc) {}
ipa_header2(int currfunc)1544 void ipa_header2(int currfunc) {}
ipa_import_highpoint(void)1545 void ipa_import_highpoint(void) {}
ipa_import_open(char * import_file,BIGUINT offset)1546 void ipa_import_open(char *import_file, BIGUINT offset) {}
ipa_import(void)1547 void ipa_import(void) {}
ipa_init()1548 void ipa_init() {}
ipa_report()1549 void ipa_report() {}
ipasave_closefile()1550 void ipasave_closefile() {}
ipasave_compname(char * name,int argc,char * argv[])1551 void ipasave_compname(char *name, int argc, char *argv[]) {}
ipasave_endfunc()1552 void ipasave_endfunc() {}
ipasave_fini(void)1553 void ipasave_fini(void) {}
ipasave(void)1554 void ipasave(void) {}
ipa_startfunc(int currfunc)1555 void ipa_startfunc(int currfunc) {}
ipa_fini()1556 void ipa_fini() {}
fill_ipasym()1557 void fill_ipasym() {}
ipa()1558 void ipa() {}
ipa_set_vestigial_host()1559 void ipa_set_vestigial_host() {}
IPA_isnoconflict(int sptr)1560 int IPA_isnoconflict(int sptr) { return 0; }
1561
set_ipa_export_file(char * name)1562 static void set_ipa_export_file(char *name) {}
set_ipa_import_mode()1563 static void set_ipa_import_mode() {}
set_ipa_import_offset(char * offset)1564 static void set_ipa_import_offset(char *offset) {}
set_debug(LOGICAL value)1565 static void set_debug(LOGICAL value) {}
set_debug_symbol(LOGICAL value)1566 static void set_debug_symbol(LOGICAL value) {}
set_debug_line(LOGICAL value)1567 static void set_debug_line(LOGICAL value) {}
1568
1569