1 /*
2 * Copyright (c) 2007-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 * \brief common compiler feedback format module
20 */
21
22 #include "gbldefs.h"
23 #include "global.h"
24 #include "error.h"
25 #include <stdio.h>
26
27 #include <string.h>
28 #include <time.h>
29 #if !defined(HOST_WIN)
30 #include <unistd.h>
31 #endif
32 #include "symtab.h"
33 #ifndef FE90
34 #include "ilm.h"
35 #endif
36 #include "fih.h"
37 #include "version.h"
38 #include "ccffinfo.h"
39
40 extern int auto_reinlinedepth; /* For bottom-up auto-inlining */
41 #ifndef FE90
42 #include "lz.h"
43 #include "cgraph.h"
44 static int fihlevel = 0;
45 static int curr_ifihx = 0;
46 extern bool in_auto_reinline;
47 #endif
48
49 int bu_auto_inline(void);
50
51 static int anyunits = 0;
52 static int prevnest = -1;
53 static int prevchildnest = -1;
54 static int prevlineno = 0;
55 static bool anymessages;
56
57 #define BUILD_VENDOR "flang-compiler"
58
59 FIHB fihb = {(FIH *)0, 0, 0, 0, 0, 0, 0};
60 FIHB ifihb = {(FIH *)0, 0, 0, 0, 0, 0, 0}; /* bottom-up auto-inliner */
61
62 #define CCFFAREA 24
63 #define ICCFFAREA 27
64 #define COPYSTRING(string) \
65 strcpy(GETITEMS(CCFFAREA, char, strlen(string) + 1), string)
66 #define ICOPYSTRING(string) \
67 strcpy(GETITEMS(ICCFFAREA, char, strlen(string) + 1), string)
68 #define COPYNSTRING(string, len) \
69 strncpy(GETITEMS(CCFFAREA, char, (len) + 1), string, len)
70 #define ICOPYNSTRING(string, len) \
71 strncpy(GETITEMS(ICCFFAREA, char, (len) + 1), string, len)
72
73 static char *formatbuffer = NULL;
74 static int formatbuffersize = 0;
75
76 static int unitstatus = -1; /* not opened */
77
78 static MESSAGE *prevmessage = NULL;
79 static int globalorder = 0;
80
81 #ifndef FE90
82 static FILE *ccff_file = NULL;
83
84 static bool
need_cdata(const char * string)85 need_cdata(const char *string)
86 {
87 const char *p;
88 for (p = string; *p; ++p) {
89 if (*p == '&' || *p == '<') {
90 return true;
91 }
92 }
93 return false;
94 }
95
96 /*
97 * clean up the XML output
98 * if there's a < or > or & in the string, enclose in a CDATA
99 */
100 static void
xmlout(const char * string)101 xmlout(const char *string)
102 {
103 if (!ccff_file)
104 return;
105 if (need_cdata(string)) {
106 fprintf(ccff_file, "<![CDATA[%s]]>", string);
107 } else {
108 fprintf(ccff_file, "%s", string);
109 }
110 } /* xmlout */
111
112 /*
113 * clean up the XML output
114 * if there's a < or > or & in either string, enclose in a CDATA
115 */
116 static void
xmlout2(const char * string1,const char * string2)117 xmlout2(const char *string1, const char *string2)
118 {
119 if (!ccff_file)
120 return;
121 if (need_cdata(string1) || need_cdata(string2)) {
122 fprintf(ccff_file, "<![CDATA[%s %s]]>", string1, string2);
123 } else {
124 fprintf(ccff_file, "%s %s", string1, string2);
125 }
126 } /* xmlout2 */
127
128 /*
129 * output value
130 */
131 static void
xmlintout(int value)132 xmlintout(int value)
133 {
134 if (!ccff_file)
135 return;
136 fprintf(ccff_file, "%d", value);
137 } /* xmlintout */
138
139 /*
140 * output value
141 */
142 static void
xmlintout2(int value1,int value2)143 xmlintout2(int value1, int value2)
144 {
145 if (!ccff_file)
146 return;
147 fprintf(ccff_file, "%d-%d", value1, value2);
148 } /* xmlintout2 */
149
150 /*
151 * output <entity>
152 */
153 static void
xmlopen(char * entity,char * shortentity)154 xmlopen(char *entity, char *shortentity)
155 {
156 if (!ccff_file)
157 return;
158 if (XBIT(161, 0x100000))
159 fprintf(ccff_file, "<%s>", shortentity);
160 else
161 fprintf(ccff_file, "<%s>\n", entity);
162 } /* xmlopen */
163
164 /*
165 * output <entity> without newline
166 */
167 static void
xmlopenn(char * entity,char * shortentity)168 xmlopenn(char *entity, char *shortentity)
169 {
170 if (!ccff_file)
171 return;
172 if (XBIT(161, 0x100000))
173 fprintf(ccff_file, "<%s>", shortentity);
174 else
175 fprintf(ccff_file, "<%s>", entity);
176 } /* xmlopenn */
177
178 /*
179 * output <entity attr="attrval">
180 */
181 static void
xmlopenattri(char * entity,char * shortentity,char * attr,int attrval)182 xmlopenattri(char *entity, char *shortentity, char *attr, int attrval)
183 {
184 if (!ccff_file)
185 return;
186 if (XBIT(161, 0x100000))
187 fprintf(ccff_file, "<%s %s=\"%d\">", shortentity, attr, attrval);
188 else
189 fprintf(ccff_file, "<%s %s=\"%d\">\n", entity, attr, attrval);
190 } /* xmlopenattri */
191
192 /*
193 * output <entity attr="attrval">
194 */
195 static void
xmlopenattrs(char * entity,char * shortentity,char * attr,char * attrval)196 xmlopenattrs(char *entity, char *shortentity, char *attr, char *attrval)
197 {
198 if (!ccff_file)
199 return;
200 if (XBIT(161, 0x100000))
201 fprintf(ccff_file, "<%s %s=\"%s\">", shortentity, attr, attrval);
202 else
203 fprintf(ccff_file, "<%s %s=\"%s\">\n", entity, attr, attrval);
204 } /* xmlopenattrs */
205
206 /*
207 * output <entity attr1="attr1val" attr2="attr2val">
208 */
209 static void
xmlopenattrs2(char * entity,char * shortentity,char * attr1,char * attr1val,char * attr2,char * attr2val)210 xmlopenattrs2(char *entity, char *shortentity, char *attr1, char *attr1val,
211 char *attr2, char *attr2val)
212 {
213 if (!ccff_file)
214 return;
215 if (XBIT(161, 0x100000))
216 fprintf(ccff_file, "<%s %s=\"%s\" %s=\"%s\">", shortentity, attr1, attr1val,
217 attr2, attr2val);
218 else
219 fprintf(ccff_file, "<%s %s=\"%s\" %s=\"%s\">\n", entity, attr1, attr1val,
220 attr2, attr2val);
221 } /* xmlopenattrs2 */
222
223 /*
224 * output </entity>
225 */
226 static void
xmlclose(char * entity,char * shortentity)227 xmlclose(char *entity, char *shortentity)
228 {
229 if (!ccff_file)
230 return;
231 if (XBIT(161, 0x100000))
232 fprintf(ccff_file, "</%s>", shortentity);
233 else
234 fprintf(ccff_file, "</%s>\n", entity);
235 } /* xmlclose */
236
237 /*
238 * output <entity>string</entity>
239 */
240 static void
xmlentity(char * entity,char * shortentity,const char * string)241 xmlentity(char *entity, char *shortentity, const char *string)
242 {
243 if (!ccff_file)
244 return;
245 if (XBIT(161, 0x100000))
246 fprintf(ccff_file, "<%s>", shortentity);
247 else
248 fprintf(ccff_file, "<%s>", entity);
249 xmlout(string);
250 if (XBIT(161, 0x100000))
251 fprintf(ccff_file, "</%s>", shortentity);
252 else
253 fprintf(ccff_file, "</%s>\n", entity);
254 } /* xmlentity */
255
256 /*
257 * output <entity>string1 string2</entity>
258 */
259 static void
xmlentity2(char * entity,char * shortentity,const char * string1,const char * string2)260 xmlentity2(char *entity, char *shortentity, const char *string1,
261 const char *string2)
262 {
263 if (!ccff_file)
264 return;
265 if (XBIT(161, 0x100000))
266 fprintf(ccff_file, "<%s>", shortentity);
267 else
268 fprintf(ccff_file, "<%s>", entity);
269 xmlout2(string1, string2);
270 if (XBIT(161, 0x100000))
271 fprintf(ccff_file, "</%s>", shortentity);
272 else
273 fprintf(ccff_file, "</%s>\n", entity);
274 } /* xmlentity2 */
275
276 /*
277 * output <entity>value</entity>
278 */
279 static void
xmlintentity(char * entity,char * shortentity,int value)280 xmlintentity(char *entity, char *shortentity, int value)
281 {
282 if (!ccff_file)
283 return;
284 if (XBIT(161, 0x100000))
285 fprintf(ccff_file, "<%s>", shortentity);
286 else
287 fprintf(ccff_file, "<%s>", entity);
288 xmlintout(value);
289 if (XBIT(161, 0x100000))
290 fprintf(ccff_file, "</%s>", shortentity);
291 else
292 fprintf(ccff_file, "</%s>\n", entity);
293 } /* xmlintentity */
294
295 /*
296 * output <entity>value1 value2</entity>
297 */
298 static void
xmlintentity2(char * entity,char * shortentity,int value1,int value2)299 xmlintentity2(char *entity, char *shortentity, int value1, int value2)
300 {
301 if (!ccff_file)
302 return;
303 if (XBIT(161, 0x100000))
304 fprintf(ccff_file, "<%s>", shortentity);
305 else
306 fprintf(ccff_file, "<%s>", entity);
307 xmlintout2(value1, value2);
308 if (XBIT(161, 0x100000))
309 fprintf(ccff_file, "</%s>", shortentity);
310 else
311 fprintf(ccff_file, "</%s>\n", entity);
312 } /* xmlintentity2 */
313
314 /** \brief Open ccff_file, write initial tags
315 *
316 * called from main()
317 */
318 void
ccff_open(char * ccff_filename,char * srcfile)319 ccff_open(char *ccff_filename, char *srcfile)
320 {
321 char *cwd, ch;
322 int cwdlen;
323 int i, slash;
324 ccff_file = fopen(ccff_filename, "wb");
325 if (ccff_file == NULL) {
326 return; /* give error message? */
327 }
328 xmlopenattrs2("ccff", "ccff", "version", CCFFVERSION, "xmlns",
329 "http://www.pgroup.com/ccff");
330 /* get the file name path */
331 slash = -1;
332 for (i = 0; srcfile[i] != '\0'; ++i) {
333 if (srcfile[i] == '/')
334 slash = i;
335 #ifdef HOST_WIN
336 else if (srcfile[i] == '\\')
337 slash = i;
338 #endif
339 }
340 xmlopen("source", "s");
341 if (slash >= 0) {
342 xmlentity("sourcename", "sn", srcfile + slash + 1);
343 ch = srcfile[slash];
344 srcfile[slash] = '\0';
345 xmlentity("sourcepath", "sp", srcfile);
346 srcfile[slash] = ch;
347 } else {
348 xmlentity("sourcename", "sn", srcfile);
349 xmlentity("sourcepath", "sp", ".");
350 }
351 cwdlen = 100;
352 cwd = (char *)malloc(cwdlen);
353 while ((void *)getcwd(cwd, cwdlen - 1) == NULL) {
354 cwdlen *= 2;
355 cwd = (char *)realloc(cwd, cwdlen);
356 }
357 xmlentity("sourcedir", "sd", cwd);
358 xmlclose("source", "s");
359 free(cwd);
360 unitstatus = 0; /* file open */
361 } /* ccff_open */
362
363 /** \brief Close the ccff tag, close ccff_file
364 */
365 void
ccff_close()366 ccff_close()
367 {
368 unitstatus = -1; /* file not open */
369 if (!ccff_file)
370 return;
371 if (anyunits) {
372 xmlclose("units", "us");
373 }
374 xmlclose("ccff", "ccff");
375 fclose(ccff_file);
376 ccff_file = NULL;
377 } /* ccff_close */
378
379 /** \brief Write build information, including command line options
380 */
381 void
ccff_build(char * options,char * language)382 ccff_build(char *options, char *language)
383 {
384 char sdate[50], stime[50];
385 time_t now;
386 struct tm *tm;
387 if (!ccff_file)
388 return;
389 xmlopen("build", "b");
390 xmlentity("buildcompiler", "bc", version.lang);
391 xmlentity("buildvendor", "bn", BUILD_VENDOR);
392 if (options)
393 xmlentity("buildoptions", "bo", options);
394 xmlentity2("buildversion", "bv", version.vsn, version.bld);
395 xmlentity("buildhost", "bh", version.host);
396 xmlentity("buildtarget", "bt", version.target);
397 xmlentity("buildlanguage", "bl", language);
398 time(&now);
399 tm = localtime(&now);
400 strftime(sdate, sizeof(sdate), "%m/%d/%Y", tm);
401 strftime(stime, sizeof(sdate), "%H:%M:%S", tm);
402 xmlentity2("builddate", "bd", sdate, stime);
403 xmlentity("buildrepository", "bp", "pgexplain.xml");
404 xmlclose("build", "b");
405 } /* ccff_build */
406
407 extern char *getexnamestring(char *, int, int, int, int);
408
409 /** \brief Write initial unit information
410 */
411 void
ccff_open_unit()412 ccff_open_unit()
413 {
414 char *abiname;
415 formatbuffer = NULL;
416 formatbuffersize = 0;
417 if ((!ccff_file && flg.x[161] == 0 && flg.x[162] == 0))
418 return;
419 if (unitstatus == gbl.func_count)
420 return; /* already opened for this function */
421 unitstatus = gbl.func_count; /* set for this function */
422 if (anyunits == 0) {
423 anyunits = 1;
424 xmlopen("units", "us");
425 }
426 xmlopen("unit", "u");
427 xmlopen("unitinfo", "ui");
428 xmlentity("unitname", "un", SYMNAME(GBL_CURRFUNC));
429 abiname = getexnamestring(SYMNAME(GBL_CURRFUNC), GBL_CURRFUNC,
430 STYPEG(GBL_CURRFUNC), SCG(GBL_CURRFUNC), 0);
431 xmlentity("unitabiname", "uabi", abiname);
432 /* eventually we'd like to get the ENDLINE here as well */
433 #ifdef ENDLINEG
434 xmlintentity2("unitlines", "ul", FUNCLINEG(GBL_CURRFUNC),
435 ENDLINEG(GBL_CURRFUNC));
436 #else
437 xmlintentity("unitlines", "ul", FUNCLINEG(GBL_CURRFUNC));
438 #endif
439 switch (gbl.rutype) {
440 case RU_SUBR:
441 xmlentity("unittype", "ut", "subroutine");
442 break;
443 case RU_FUNC:
444 xmlentity("unittype", "ut", "function");
445 break;
446 case RU_PROG:
447 xmlentity("unittype", "ut", "program");
448 break;
449 case RU_BDATA:
450 xmlentity("unittype", "ut", "block data");
451 break;
452 #ifdef RU_MODULE
453 case RU_MODULE:
454 xmlentity("unittype", "ut", "module");
455 break;
456 #endif
457 }
458 xmlclose("unitinfo", "ui");
459 } /* ccff_open_unit */
460
461 /*
462 * * For bottom-up auto-inlining, save inlining information
463 * */
464 void
ccff_open_unit_deferred(void)465 ccff_open_unit_deferred(void)
466 {
467 char *abiname;
468 formatbuffer = NULL;
469 formatbuffersize = 0;
470 if ((!ccff_file && flg.x[161] == 0 && flg.x[162] == 0))
471 return;
472 if (unitstatus == 1)
473 return; /* already opened for this function */
474 unitstatus = 1; /* set for this function */
475 }
476
477 #else
478 /*
479 * Initialize for F90/HPF front end
480 */
481 void
ccff_init_f90()482 ccff_init_f90()
483 {
484 unitstatus = 0; /* we're not dealing with files here
485 * but we've initialized */
486 } /* ccff_init_f90 */
487
488 /*
489 * Close up for F90/HPF front end
490 */
491 void
ccff_finish_f90()492 ccff_finish_f90()
493 {
494 unitstatus = -1; /* we've finalized */
495 } /* ccff_finish_f90 */
496
497 /*
498 * set up for next program unit
499 */
500 void
ccff_open_unit_f90()501 ccff_open_unit_f90()
502 {
503 if (unitstatus >= 0) {
504 unitstatus = gbl.func_count;
505 }
506 } /* ccff_open_unit_f90 */
507
508 /*
509 * clean up from this program unit
510 */
511 static void ccff_cleanup_children();
512 void
ccff_close_unit_f90()513 ccff_close_unit_f90()
514 {
515 if (unitstatus > 0) {
516 unitstatus = 0;
517 }
518 ccff_cleanup_children();
519 } /* ccff_close_unit_f90 */
520 #endif
521
522 static int *childlist;
523 static int childlistsize;
524 static MESSAGE **messagelist;
525 static int messagelistsize;
526
527 static int strngsize = 0;
528 static char *strng = NULL;
529
530 /*
531 * dump a message
532 */
533 static void
dumpmessage(MESSAGE * m)534 dumpmessage(MESSAGE *m)
535 {
536 FILE *dfile = gbl.dbgfil ? gbl.dbgfil : stderr;
537 ARGUMENT *a;
538 fprintf(dfile, "ccff:%p type:%d lineno:%d order:%d id:%s", m, m->msgtype,
539 m->lineno, m->order, m->msgid);
540 if (m->varname)
541 fprintf(dfile, " varname:%s", m->varname);
542 if (m->funcname)
543 fprintf(dfile, " funcname:%s", m->funcname);
544 fprintf(dfile, "\n ");
545 fprintf(dfile, " message:%s", m->message);
546 for (a = m->args; a; a = a->next) {
547 fprintf(dfile, " %s=%s", a->argstring, a->argvalue);
548 }
549 fprintf(dfile, "\n");
550 } /* dumpmessage */
551
552 /*
553 * dump list of messages
554 */
555 static void
dumpmsglist(MESSAGE * m)556 dumpmsglist(MESSAGE *m)
557 {
558 for (; m; m = m->next)
559 dumpmessage(m);
560 } /* dumpmsglist */
561
562 void
dumpmessagelist(int nmessages)563 dumpmessagelist(int nmessages)
564 {
565 int n;
566 for (n = 0; n < nmessages; ++n)
567 dumpmessage(messagelist[n]);
568 } /* dumpmessagelist */
569
570 /*
571 * heap sort by line number
572 */
573 static void
_childsort(int l,int h)574 _childsort(int l, int h)
575 {
576 int m1, m2;
577 int c, c1, c2;
578 c = childlist[l];
579 while (1) {
580 m1 = l * 2 + 1;
581 if (m1 > h)
582 break; /* done */
583 c1 = childlist[m1];
584 m2 = l * 2 + 2;
585 if (m2 <= h) {
586 c2 = childlist[m2];
587 if (FIH_LINENO(c2) > FIH_LINENO(c1) ||
588 (FIH_LINENO(c2) == FIH_LINENO(c1) && c2 > c1)) {
589 m1 = m2;
590 c1 = c2;
591 }
592 }
593 if (FIH_LINENO(c1) > FIH_LINENO(c) ||
594 (FIH_LINENO(c1) == FIH_LINENO(c) && c1 > c)) {
595 childlist[l] = c1;
596 childlist[m1] = c;
597 l = m1;
598 } else {
599 break;
600 }
601 }
602 } /* _childsort */
603
604 /*
605 * * heap sort by line number
606 * */
607 static void
_ichildsort(int l,int h)608 _ichildsort(int l, int h)
609 {
610 int m1, m2;
611 int c, c1, c2;
612 c = childlist[l];
613 while (1) {
614 m1 = l * 2 + 1;
615 if (m1 > h)
616 break; /* done */
617 c1 = childlist[m1];
618 m2 = l * 2 + 2;
619 if (m2 <= h) {
620 c2 = childlist[m2];
621 if (IFIH_LINENO(c2) > IFIH_LINENO(c1) ||
622 (IFIH_LINENO(c2) == IFIH_LINENO(c1) && c2 > c1)) {
623 m1 = m2;
624 c1 = c2;
625 }
626 }
627 if (IFIH_LINENO(c1) > IFIH_LINENO(c) ||
628 (IFIH_LINENO(c1) == IFIH_LINENO(c) && c1 > c)) {
629 childlist[l] = c1;
630 childlist[m1] = c;
631 l = m1;
632 } else {
633 break;
634 }
635 }
636 } /* _ichildsort */
637
638 /*
639 * all children of fihx appear in FIH_CHILD/FIH_NEXT linked list.
640 * sort them by line number
641 */
642 static void
fih_sort_children(int fihx)643 fih_sort_children(int fihx)
644 {
645 int child, nchildren, n;
646 if (FIH_CHILD(fihx) == 0)
647 return;
648 nchildren = 0;
649 for (child = FIH_CHILD(fihx); child; child = FIH_NEXT(child)) {
650 ++nchildren;
651 }
652 if (nchildren > childlistsize) {
653 childlistsize = nchildren + 100;
654 childlist = GETITEMS(CCFFAREA, int, childlistsize);
655 }
656 nchildren = 0;
657 for (child = FIH_CHILD(fihx); child; child = FIH_NEXT(child)) {
658 childlist[nchildren] = child;
659 ++nchildren;
660 }
661 /* heap sort */
662 for (n = nchildren / 2; n > 0; --n) {
663 _childsort(n - 1, nchildren - 1);
664 }
665 for (n = nchildren - 1; n > 0; --n) {
666 int c;
667 c = childlist[n];
668 childlist[n] = childlist[0];
669 childlist[0] = c;
670 _childsort(0, n - 1);
671 }
672 FIH_CHILD(fihx) = childlist[0];
673 for (n = 0; n < nchildren - 1; ++n) {
674 FIH_NEXT(childlist[n]) = childlist[n + 1];
675 }
676 FIH_NEXT(childlist[nchildren - 1]) = 0;
677 } /* fih_sort_children */
678
679 /* all children of ifihx appear in IFIH_CHILD/IFIH_NEXT linked list.
680 * sort them by line number */
681 static void
ifih_sort_children(int ifihx)682 ifih_sort_children(int ifihx)
683 {
684 int child, nchildren, n;
685 if (IFIH_CHILD(ifihx) == 0)
686 return;
687 nchildren = 0;
688 for (child = IFIH_CHILD(ifihx); child; child = IFIH_NEXT(child)) {
689 ++nchildren;
690 }
691 if (nchildren > childlistsize) {
692 childlistsize = nchildren + 100;
693 childlist = GETITEMS(ICCFFAREA, int, childlistsize);
694 }
695 nchildren = 0;
696 for (child = IFIH_CHILD(ifihx); child; child = IFIH_NEXT(child)) {
697 childlist[nchildren] = child;
698 ++nchildren;
699 }
700 /* heap sort */
701 for (n = nchildren / 2; n > 0; --n) {
702 _ichildsort(n - 1, nchildren - 1);
703 }
704 for (n = nchildren - 1; n > 0; --n) {
705 int c;
706 c = childlist[n];
707 childlist[n] = childlist[0];
708 childlist[0] = c;
709 _ichildsort(0, n - 1);
710 }
711 IFIH_CHILD(ifihx) = childlist[0];
712 for (n = 0; n < nchildren - 1; ++n) {
713 IFIH_NEXT(childlist[n]) = childlist[n + 1];
714 }
715 IFIH_NEXT(childlist[nchildren - 1]) = 0;
716 } /* ifih_sort_children */
717
718 /*
719 * return TRUE if the string is numeric
720 */
721 static bool
_numeric(char * s,int * v)722 _numeric(char *s, int *v)
723 {
724 int r = 0;
725 while (*s) {
726 if (*s >= '0' && *s <= '9') {
727 r = r * 10 + (*s - '0');
728 ++s;
729 } else {
730 return false;
731 }
732 }
733 *v = r;
734 return true;
735 } /* _numeric */
736
737 /*
738 * compare two MESSAGEs.
739 * keys:
740 * line number
741 * if sortorder==0 or sortorder==1
742 * if the same message type:
743 * message id
744 * varname, if any
745 * funcname, if any
746 * arguments
747 * if sortorder==1 || sortorder == 2
748 * insertion order
749 * if sortorder == 2
750 * suborder
751 */
752 static int
_messagecmp(MESSAGE * m1,MESSAGE * m2,int sortorder)753 _messagecmp(MESSAGE *m1, MESSAGE *m2, int sortorder)
754 {
755 int r;
756 ARGUMENT *a1, *a2;
757 if (m1->lineno > m2->lineno)
758 return +1;
759 if (m1->lineno < m2->lineno)
760 return -1;
761 if (m1->msgtype == m2->msgtype && sortorder != 2) {
762 r = strcmp(m1->msgid, m2->msgid);
763 if (r)
764 return r;
765 if (m1->varname && m2->varname) {
766 r = strcmp(m1->varname, m2->varname);
767 if (r)
768 return r;
769 } else if (m1->varname) {
770 return +1;
771 } else if (m2->varname) {
772 return -1;
773 }
774 if (m1->funcname && m2->funcname) {
775 r = strcmp(m1->funcname, m2->funcname);
776 if (r)
777 return r;
778 } else if (m1->funcname) {
779 return +1;
780 } else if (m2->funcname) {
781 return -1;
782 }
783 for (a1 = m1->args, a2 = m2->args; a1 && a2; a1 = a1->next, a2 = a2->next) {
784 if (a1->argstring && a2->argstring) {
785 r = strcmp(a1->argstring, a2->argstring);
786 if (r)
787 return r;
788 } else if (a1->argstring) {
789 return +1;
790 } else if (a2->argstring) {
791 return -1;
792 }
793 if (a1->argvalue && a2->argvalue) {
794 int v1, v2;
795 if (_numeric(a1->argvalue, &v1) && _numeric(a2->argvalue, &v2)) {
796 if (v1 > v2)
797 return +1;
798 if (v1 < v2)
799 return -1;
800 } else {
801 r = strcmp(a1->argvalue, a2->argvalue);
802 if (r)
803 return r;
804 }
805 } else if (a1->argvalue) {
806 return +1;
807 } else if (a2->argvalue) {
808 return -1;
809 }
810 }
811 } else if (!sortorder) {
812 /* when sortorder != 0, we are only comparing for equality,
813 * so just return a nonzero value to mean not equal */
814 return 1;
815 }
816 if (sortorder > 0) {
817 if (m1->order > m2->order)
818 return +1;
819 if (m1->order < m2->order)
820 return -1;
821 }
822 if (sortorder == 2) {
823 if (m1->suborder > m2->suborder)
824 return +1;
825 if (m1->suborder < m2->suborder)
826 return -1;
827 }
828 return 0;
829 } /* _messagecmp */
830
831 /*
832 * heap sort by line number
833 */
834 static void
_messagesort(int l,int h,int sortorder)835 _messagesort(int l, int h, int sortorder)
836 {
837 int m1, m2, r;
838 MESSAGE *c, *c1, *c2;
839 c = messagelist[l];
840 while (1) {
841 m1 = l * 2 + 1;
842 if (m1 > h)
843 break; /* done */
844 c1 = messagelist[m1];
845 m2 = l * 2 + 2;
846 if (m2 <= h) {
847 c2 = messagelist[m2];
848 r = _messagecmp(c1, c2, sortorder);
849 if (r < 0) {
850 /* compare to c2 */
851 m1 = m2;
852 c1 = c2;
853 } else {
854 /* compare to c1 */
855 }
856 }
857 r = _messagecmp(c, c1, sortorder);
858 if (r < 0) {
859 messagelist[l] = c1;
860 messagelist[m1] = c;
861 l = m1;
862 } else {
863 break;
864 }
865 }
866 } /* _messagesort */
867
868 /*
869 * sort messages by line number
870 */
871 static MESSAGE *
sort_message_list(MESSAGE * msglist)872 sort_message_list(MESSAGE *msglist)
873 {
874 int nmessages, n, prevn;
875 MESSAGE *mptr;
876 MESSAGE *newmsglist;
877 nmessages = 0;
878 for (mptr = msglist; mptr; mptr = mptr->next)
879 ++nmessages;
880 if (nmessages == 0)
881 return msglist;
882 if (nmessages > messagelistsize) {
883 messagelistsize = nmessages + 100;
884 messagelist = GETITEMS(CCFFAREA, MESSAGE *, messagelistsize);
885 }
886 nmessages = 0;
887 for (mptr = msglist; mptr; mptr = mptr->next)
888 messagelist[nmessages++] = mptr;
889 /* heap sort */
890 for (n = nmessages / 2; n > 0; --n)
891 _messagesort(n - 1, nmessages - 1, 1);
892 for (n = nmessages - 1; n > 0; --n) {
893 mptr = messagelist[n];
894 messagelist[n] = messagelist[0];
895 messagelist[0] = mptr;
896 _messagesort(0, n - 1, 1);
897 }
898 newmsglist = messagelist[0];
899 prevn = 0;
900 for (n = 1; n < nmessages; ++n) {
901 /* look for duplicate messages, with the same arguments, on the same line */
902 MESSAGE *mmptr;
903 int nn;
904
905 mptr = messagelist[n];
906 mmptr = messagelist[n - 1];
907 if (_messagecmp(mptr, mmptr, 0) != 0) {
908 /* not a duplicate, include this message */
909 messagelist[prevn]->next = messagelist[n];
910 prevn = n;
911 /* if this message has the same message id, reset order to match */
912 if (strcmp(mptr->msgid, mmptr->msgid) == 0) {
913 mmptr->order = mptr->order;
914 mmptr->suborder = mptr->suborder + 1;
915 } else {
916 mmptr->suborder = 1;
917 }
918 }
919 }
920 if (prevn >= 0)
921 messagelist[prevn]->next = NULL;
922
923 /* resort by line number, sort order, suborder,
924 * after the duplicate messages are all removed */
925 nmessages = 0;
926 for (mptr = newmsglist; mptr; mptr = mptr->next) {
927 messagelist[nmessages] = mptr;
928 ++nmessages;
929 }
930 /* heap sort */
931 for (n = nmessages / 2; n > 0; --n) {
932 _messagesort(n - 1, nmessages - 1, 2);
933 }
934 for (n = nmessages - 1; n > 0; --n) {
935 mptr = messagelist[n];
936 messagelist[n] = messagelist[0];
937 messagelist[0] = mptr;
938 _messagesort(0, n - 1, 2);
939 }
940 mptr = messagelist[0];
941 for (n = 1; n < nmessages; ++n) {
942 mptr->next = messagelist[n];
943 mptr = messagelist[n];
944 }
945 mptr->next = NULL;
946 newmsglist = messagelist[0];
947 return newmsglist;
948 } /* sort_message_list */
949
950 static void
fih_sort_messages(int fihx)951 fih_sort_messages(int fihx)
952 {
953 MESSAGE *mptr;
954 FIH_CCFFINFO(fihx) = (char *)sort_message_list((MESSAGE *)FIH_CCFFINFO(fihx));
955 /* sort any child messages */
956 for (mptr = (MESSAGE *)FIH_CCFFINFO(fihx); mptr; mptr = mptr->next) {
957 if (mptr->msgchild) {
958 mptr->msgchild = sort_message_list(mptr->msgchild);
959 }
960 }
961 } /* fih_sort_messages */
962
963 static void
ifih_sort_messages(int ifihx)964 ifih_sort_messages(int ifihx)
965 {
966 MESSAGE *mptr;
967 IFIH_CCFFINFO(ifihx) =
968 (char *)sort_message_list((MESSAGE *)IFIH_CCFFINFO(ifihx));
969 /* sort any child messages */
970 for (mptr = (MESSAGE *)IFIH_CCFFINFO(ifihx); mptr; mptr = mptr->next) {
971 if (mptr->msgchild) {
972 mptr->msgchild = sort_message_list(mptr->msgchild);
973 }
974 }
975 } /* ifih_sort_messages */
976
977 /*
978 * Does the next message have the same message ID and the same
979 * arguments as this one, except for arguments named '*list='
980 */
981 static bool
combine_message(MESSAGE * mptr1,MESSAGE * mptr2)982 combine_message(MESSAGE *mptr1, MESSAGE *mptr2)
983 {
984 ARGUMENT *arg1, *arg2;
985 if (XBIT(198, 4))
986 return false;
987 if (mptr1->lineno != mptr2->lineno)
988 return false;
989 if (mptr1->fihx != mptr2->fihx)
990 return false;
991 if (mptr1->msgtype != mptr2->msgtype)
992 return false;
993 if (strcmp(mptr1->msgid, mptr2->msgid))
994 return false;
995 for (arg1 = mptr1->args, arg2 = mptr2->args; arg1 && arg2;
996 arg1 = arg1->next, arg2 = arg2->next) {
997 char *s1, *s2;
998 int listarg = 0;
999 s1 = arg1->argstring;
1000 s2 = arg2->argstring;
1001 if (strcmp(s1, s2))
1002 return false;
1003 /* look for %...list */
1004 for (; *s1 && *s1 != '='; ++s1) {
1005 if (*s1 == 'l') {
1006 if (strcmp(s1, "list") == 0) {
1007 listarg = 1; /* list arguments may differ */
1008 break;
1009 }
1010 }
1011 }
1012 if (!listarg) {
1013 /* not a list argument, must match exactly */
1014 if (strcmp(arg1->argvalue, arg2->argvalue))
1015 return false;
1016 }
1017 }
1018 if (arg1 || arg2) /* one message had more arguments */
1019 return false;
1020 mptr2->combine = 1;
1021 return true;
1022 } /* combine_message */
1023
1024 /*
1025 * print one message to the output file
1026 * with symbolic substitution
1027 */
1028 static void
__fih_message(FILE * ofile,MESSAGE * mptr,bool dolist)1029 __fih_message(FILE *ofile, MESSAGE *mptr, bool dolist)
1030 {
1031 char *message;
1032 char *chp;
1033 int strnglen, n;
1034 ARGUMENT *aptr, *aptr3;
1035 MESSAGE *mptr2, *mptr3;
1036 message = mptr->message;
1037 for (chp = message; *chp; ++chp) {
1038 if (*chp != '%') {
1039 fprintf(ofile, "%c", *chp);
1040 } else {
1041 ++chp;
1042 if (*chp == '%') {
1043 fprintf(ofile, "%c", *chp);
1044 } else {
1045 strnglen = 0;
1046 while ((*chp >= 'a' && *chp <= 'z') || (*chp >= 'A' && *chp <= 'Z') ||
1047 (*chp >= '0' && *chp <= '9') || *chp == '_') {
1048 if (strnglen >= strngsize - 1) {
1049 char *nstrng;
1050 strng[strnglen] = '\0';
1051 strngsize *= 2;
1052 nstrng = (char *)getitem(CCFFAREA, strngsize);
1053 strcpy(nstrng, strng);
1054 strng = nstrng;
1055 }
1056 strng[strnglen++] = *chp++;
1057 }
1058 --chp;
1059 if (strnglen) {
1060 int first = 1;
1061 bool islist = false;
1062 strng[strnglen] = '\0';
1063 if (!XBIT(198, 4) && strnglen > 4 &&
1064 strcmp(strng + strnglen - 4, "list") == 0)
1065 islist = true;
1066 for (mptr2 = mptr; mptr2; mptr2 = mptr2->next) {
1067 bool duplicate = false;
1068 if (mptr2 != mptr && !mptr2->combine)
1069 break;
1070 for (aptr = mptr2->args; aptr; aptr = aptr->next) {
1071 if (strcmp(aptr->argstring, strng) == 0)
1072 break;
1073 }
1074 if (aptr) {
1075 /* see if argument aptr has already been printed for this list */
1076 for (mptr3 = mptr; mptr3 != mptr2; mptr3 = mptr3->next) {
1077 for (aptr3 = mptr3->args; aptr3; aptr3 = aptr3->next) {
1078 if (strcmp(aptr3->argstring, strng) == 0)
1079 break;
1080 }
1081 if (aptr3 && strcmp(aptr3->argvalue, aptr->argvalue) == 0) {
1082 duplicate = true;
1083 break;
1084 }
1085 }
1086 if (!duplicate) {
1087 if (first) {
1088 fprintf(ofile, "%s", aptr->argvalue);
1089 } else {
1090 fprintf(ofile, ",%s", aptr->argvalue);
1091 }
1092 first = 0;
1093 }
1094 }
1095 if (!dolist || !islist)
1096 break;
1097 }
1098 }
1099 }
1100 }
1101 }
1102 } /* __fih_message */
1103
1104 static void
_fih_message(FILE * ofile,MESSAGE * mptr,bool do_cdata)1105 _fih_message(FILE *ofile, MESSAGE *mptr, bool do_cdata)
1106 {
1107 #ifndef FE90
1108 if (do_cdata) {
1109 /* look for any '&' or '<' in the message or arguments */
1110 do_cdata = false;
1111 if (need_cdata(mptr->message)) {
1112 do_cdata = true;
1113 } else {
1114 ARGUMENT *aptr;
1115 for (aptr = mptr->args; aptr; aptr = aptr->next) {
1116 if (need_cdata(aptr->argvalue)) {
1117 do_cdata = true;
1118 break;
1119 }
1120 }
1121 }
1122 }
1123 if (do_cdata) {
1124 fprintf(ccff_file, "<![CDATA[");
1125 }
1126 #endif
1127 __fih_message(ofile, mptr, true);
1128 #ifndef FE90
1129 if (do_cdata) {
1130 fprintf(ccff_file, "]]>");
1131 }
1132 #endif
1133 } /* _fih_message */
1134
1135 #ifndef FE90
1136 static void
fih_message(MESSAGE * mptr)1137 fih_message(MESSAGE *mptr)
1138 {
1139 if (mptr->seq <= 0) {
1140 xmlopen("message", "m");
1141 } else {
1142 xmlopenattri("message", "m", "seq", mptr->seq);
1143 }
1144 if (mptr->lineno > 0 || (mptr->varname == NULL && mptr->funcname == NULL)) {
1145 xmlintentity("messageline", "ml", mptr->lineno);
1146 }
1147 if (mptr->varname != NULL) {
1148 xmlentity("messagevar", "mv", mptr->varname);
1149 }
1150 if (mptr->funcname != NULL) {
1151 xmlentity("messagefunc", "mf", mptr->funcname);
1152 }
1153 xmlentity("messageid", "mi", mptr->msgid);
1154 if (mptr->args) {
1155 ARGUMENT *aptr;
1156 xmlopenn("messageargs", "ma");
1157 for (aptr = mptr->args; aptr; aptr = aptr->next) {
1158 fprintf(ccff_file, "%%%s=", aptr->argstring);
1159 xmlout(aptr->argvalue);
1160 }
1161 xmlclose("messageargs", "ma");
1162 }
1163 xmlopenn("messagetext", "mt");
1164 _fih_message(ccff_file, mptr, true);
1165 xmlclose("messagetext", "mt");
1166 if (mptr->msgchild) {
1167 MESSAGE *child, *nextchild;
1168 xmlopen("messagechild", "md");
1169 for (child = mptr->msgchild; child; child = nextchild) {
1170 for (nextchild = child->next;
1171 nextchild && combine_message(child, nextchild);
1172 nextchild = nextchild->next)
1173 ;
1174 fih_message(child);
1175 }
1176 xmlclose("messagechild", "md");
1177 }
1178 xmlclose("message", "m");
1179 } /* fih_message */
1180 #endif
1181
1182 #define INDENT 5
1183 #define CINDENT 2
1184
1185 static void
print_func(FILE * ofile)1186 print_func(FILE *ofile)
1187 {
1188 char *funcname;
1189 if (!anymessages) {
1190 anymessages = true;
1191 funcname = FIH_FUNCNAME(1);
1192 fprintf(ofile, "%s:\n", funcname);
1193 }
1194 } /* print_func */
1195
1196 /*
1197 * Format and print message to log file
1198 */
1199 static void
fih_message_ofile(FILE * ofile,int nest,int lineno,int childnest,MESSAGE * mptr)1200 fih_message_ofile(FILE *ofile, int nest, int lineno, int childnest,
1201 MESSAGE *mptr)
1202 {
1203 MESSAGE *child, *nextchild;
1204 if (flg.x[161] != 0 || flg.x[162] != 0) {
1205 switch (mptr->msgtype) {
1206 case MSGINLINER:
1207 if (!XBIT(161, 1))
1208 return;
1209 break;
1210 case MSGNEGINLINER:
1211 if (!XBIT(162, 1))
1212 return;
1213 break;
1214 case MSGLOOP:
1215 if (!XBIT(161, 2))
1216 return;
1217 break;
1218 case MSGNEGLOOP:
1219 if (!XBIT(162, 2))
1220 return;
1221 break;
1222 case MSGLRE:
1223 if (!XBIT(161, 4))
1224 return;
1225 break;
1226 case MSGNEGLRE:
1227 if (!XBIT(162, 4))
1228 return;
1229 break;
1230 case MSGINTENSITY:
1231 if (!XBIT(161, 8))
1232 return;
1233 break;
1234 case MSGIPA:
1235 if (!XBIT(161, 0x10))
1236 return;
1237 break;
1238 case MSGNEGIPA:
1239 if (!XBIT(162, 0x10))
1240 return;
1241 break;
1242 case MSGFUSE:
1243 if (!XBIT(161, 0x20))
1244 return;
1245 break;
1246 case MSGNEGFUSE:
1247 if (!XBIT(162, 0x20))
1248 return;
1249 break;
1250 case MSGVECT:
1251 case MSGCVECT:
1252 if (!XBIT(161, 0x40))
1253 return;
1254 break;
1255 case MSGNEGVECT:
1256 case MSGNEGCVECT:
1257 if (!XBIT(162, 0x40))
1258 return;
1259 break;
1260 case MSGOPENMP:
1261 if (!XBIT(161, 0x80))
1262 return;
1263 break;
1264 case MSGOPT:
1265 if (!XBIT(161, 0x100))
1266 return;
1267 break;
1268 case MSGNEGOPT:
1269 if (!XBIT(162, 0x100))
1270 return;
1271 break;
1272 case MSGPREFETCH:
1273 if (!XBIT(161, 0x200))
1274 return;
1275 break;
1276 case MSGFTN:
1277 if (!XBIT(161, 0x400))
1278 return;
1279 break;
1280 case MSGPAR:
1281 if (!XBIT(161, 0x800))
1282 return;
1283 break;
1284 case MSGNEGPAR:
1285 if (!XBIT(162, 0x800))
1286 return;
1287 break;
1288 case MSGHPF:
1289 if (!XBIT(161, 0x1000))
1290 return;
1291 break;
1292 case MSGPFO:
1293 case MSGNEGPFO:
1294 if (!XBIT(161, 0x2000))
1295 return;
1296 break;
1297 case MSGACCEL:
1298 if (!XBIT(161, 0x4000))
1299 return;
1300 break;
1301 case MSGNEGACCEL:
1302 if (!XBIT(162, 0x4000))
1303 return;
1304 break;
1305 case MSGUNIFIED:
1306 if (!XBIT(161, 0x8000))
1307 return;
1308 break;
1309 case MSGPCAST:
1310 if (!XBIT(161, 0x20000))
1311 return;
1312 break;
1313 }
1314 }
1315 print_func(ofile);
1316 fprintf(ofile, "%*s ", nest * INDENT, "");
1317 if (childnest > 0)
1318 fprintf(ofile, "%*s ", childnest * CINDENT, "");
1319 if (nest != prevnest || childnest != prevchildnest || lineno != prevlineno ||
1320 XBIT(198, 0x10000000)) {
1321 fprintf(ofile, "%5d, ", lineno);
1322 } else {
1323 fprintf(ofile, "%5s ", " ");
1324 }
1325 prevnest = nest;
1326 prevchildnest = childnest;
1327 prevlineno = lineno;
1328 _fih_message(ofile, mptr, false);
1329 fprintf(ofile, "\n");
1330 if (mptr->msgchild) {
1331 for (child = mptr->msgchild; child; child = nextchild) {
1332 for (nextchild = child->next;
1333 nextchild && combine_message(child, nextchild);
1334 nextchild = nextchild->next)
1335 ;
1336 fih_message_ofile(ofile, nest, child->lineno, childnest + 1, child);
1337 }
1338 }
1339 } /* fih_message_ofile */
1340
1341 /*
1342 * Format and print message to log file
1343 */
1344 static void
ifih_message_ofile(FILE * ofile,int nest,int lineno,int childnest,MESSAGE * mptr)1345 ifih_message_ofile(FILE *ofile, int nest, int lineno, int childnest,
1346 MESSAGE *mptr)
1347 {
1348 MESSAGE *child;
1349 char *funcname;
1350 if (flg.x[161] != 0 || flg.x[162] != 0) {
1351 switch (mptr->msgtype) {
1352 case MSGINLINER:
1353 if (!XBIT(161, 1))
1354 return;
1355 break;
1356 case MSGNEGINLINER:
1357 if (!XBIT(162, 1))
1358 return;
1359 break;
1360 case MSGLOOP:
1361 if (!XBIT(161, 2))
1362 return;
1363 break;
1364 case MSGNEGLOOP:
1365 if (!XBIT(162, 2))
1366 return;
1367 break;
1368 case MSGLRE:
1369 if (!XBIT(161, 4))
1370 return;
1371 break;
1372 case MSGNEGLRE:
1373 if (!XBIT(162, 4))
1374 return;
1375 break;
1376 case MSGINTENSITY:
1377 if (!XBIT(161, 8))
1378 return;
1379 break;
1380 case MSGIPA:
1381 if (!XBIT(161, 0x10))
1382 return;
1383 break;
1384 case MSGNEGIPA:
1385 if (!XBIT(162, 0x10))
1386 return;
1387 break;
1388 case MSGFUSE:
1389 if (!XBIT(161, 0x20))
1390 return;
1391 break;
1392 case MSGNEGFUSE:
1393 if (!XBIT(162, 0x20))
1394 return;
1395 break;
1396 case MSGVECT:
1397 case MSGCVECT:
1398 if (!XBIT(161, 0x40))
1399 return;
1400 break;
1401 case MSGNEGVECT:
1402 case MSGNEGCVECT:
1403 if (!XBIT(162, 0x40))
1404 return;
1405 break;
1406 case MSGOPENMP:
1407 if (!XBIT(161, 0x80))
1408 return;
1409 break;
1410 case MSGOPT:
1411 if (!XBIT(161, 0x100))
1412 return;
1413 break;
1414 case MSGNEGOPT:
1415 if (!XBIT(162, 0x100))
1416 return;
1417 break;
1418 case MSGPREFETCH:
1419 if (!XBIT(161, 0x200))
1420 return;
1421 break;
1422 case MSGFTN:
1423 if (!XBIT(161, 0x400))
1424 return;
1425 break;
1426 case MSGPAR:
1427 if (!XBIT(161, 0x800))
1428 return;
1429 break;
1430 case MSGNEGPAR:
1431 if (!XBIT(162, 0x800))
1432 return;
1433 break;
1434 case MSGHPF:
1435 if (!XBIT(161, 0x1000))
1436 return;
1437 break;
1438 case MSGPFO:
1439 case MSGNEGPFO:
1440 if (!XBIT(161, 0x2000))
1441 return;
1442 break;
1443 case MSGACCEL:
1444 if (!XBIT(161, 0x4000))
1445 return;
1446 break;
1447 case MSGNEGACCEL:
1448 if (!XBIT(162, 0x4000))
1449 return;
1450 break;
1451 case MSGUNIFIED:
1452 if (!XBIT(161, 0x8000))
1453 return;
1454 break;
1455 }
1456 }
1457 if (!anymessages) {
1458 anymessages = true;
1459 funcname = IFIH_FUNCNAME(1);
1460 fprintf(ofile, "%s:\n", funcname);
1461 }
1462 fprintf(ofile, "%*s ", nest * INDENT, "");
1463 if (childnest > 0) {
1464 fprintf(ofile, "%*s ", childnest * CINDENT, "");
1465 }
1466 if (nest != prevnest || childnest > prevchildnest || lineno != prevlineno) {
1467 fprintf(ofile, "%5d, ", lineno);
1468 } else {
1469 fprintf(ofile, "%5s ", " ");
1470 }
1471 prevnest = nest;
1472 prevchildnest = childnest;
1473 prevlineno = lineno;
1474 _fih_message(ofile, mptr, false);
1475 fprintf(ofile, "\n");
1476 if (mptr->msgchild) {
1477 for (child = mptr->msgchild; child; child = child->next) {
1478 ifih_message_ofile(ofile, nest, child->lineno, childnest + 1, child);
1479 }
1480 }
1481 } /* ifih_message_ofile */
1482
1483 /*
1484 * output messages for this FIH tag
1485 */
1486 static void
fih_messages(int fihx,FILE * ofile,int nest)1487 fih_messages(int fihx, FILE *ofile, int nest)
1488 {
1489 #ifndef FE90
1490 int child, c;
1491 MESSAGE *mptr, *firstmptr, *nextmptr;
1492 char *funcname;
1493
1494 if (ccff_file && fihx > 1) {
1495
1496 if (FIH_CHECKFLAG(fihx, FIH_INCLUDED)) {
1497 xmlopenattri("included", "c", "seq", fihx);
1498 xmlopen("includeinfo", "ci");
1499 xmlintentity("includelevel", "cl", FIH_LEVEL(fihx));
1500 if (FIH_FULLNAME(fihx)) {
1501 xmlentity("includefile", "cf", FIH_FULLNAME(fihx));
1502 }
1503 xmlclose("includeinfo", "ci");
1504 }
1505
1506 if (FIH_CHECKFLAG(fihx, FIH_INLINED)) {
1507 xmlopenattri("inlined", "l", "seq", fihx);
1508 xmlopen("inlineinfo", "li");
1509 xmlintentity("inlinelevel", "lv", FIH_LEVEL(fihx));
1510 xmlintentity("inlineline", "ll", FIH_LINENO(fihx));
1511 if (FIH_SRCLINE(fihx) > 0)
1512 xmlintentity("inlinesrcline", "lsl", FIH_SRCLINE(fihx));
1513 funcname = FIH_FUNCNAME(fihx);
1514 xmlentity("inlinename", "ln", funcname);
1515 if (funcname != FIH_FUNCNAME(fihx) &&
1516 strcmp(funcname, FIH_FUNCNAME(fihx)) != 0) {
1517 xmlentity("inlinemangledname", "lmn", FIH_FUNCNAME(fihx));
1518 }
1519 if (FIH_FULLNAME(fihx)) {
1520 xmlentity("inlinefile", "lf", FIH_FULLNAME(fihx));
1521 }
1522 xmlclose("inlineinfo", "li");
1523 }
1524 }
1525
1526 if (ofile && FIH_CHECKFLAG(fihx, FIH_DO_CCFF) &&
1527 FIH_CHECKFLAG(fihx, FIH_INCLUDED)) {
1528 int lineno;
1529 print_func(ofile);
1530 lineno = FIH_LINENO(fihx);
1531 fprintf(ofile, "%*s ", (nest - 1) * INDENT, "");
1532 if ((nest - 1) != prevnest || prevchildnest != 0 || lineno != prevlineno) {
1533 fprintf(ofile, "%5d, ", lineno);
1534 } else {
1535 fprintf(ofile, "%5s ", " ");
1536 }
1537 prevnest = (nest - 1);
1538 prevchildnest = 0;
1539 prevlineno = lineno;
1540 fprintf(ofile, "include \'%s\'\n", FIH_FILENAME(fihx));
1541 }
1542
1543 prevnest = -1;
1544 /* clear 'done' flags for children */
1545 for (child = FIH_CHILD(fihx); child; child = FIH_NEXT(child)) {
1546 FIH_CLEARDONE(child);
1547 FIH_CLEARINCDONE(fihx);
1548 }
1549 child = FIH_CHILD(fihx);
1550 firstmptr = (MESSAGE *)FIH_CCFFINFO(fihx);
1551 if (child || firstmptr) {
1552 if (ccff_file)
1553 xmlopen("messages", "ms");
1554 for (mptr = firstmptr; mptr; mptr = nextmptr) {
1555 for (nextmptr = mptr->next; nextmptr && combine_message(mptr, nextmptr);
1556 nextmptr = nextmptr->next)
1557 ;
1558 while (child && FIH_LINENO(child) < mptr->lineno) {
1559 if (!FIH_DONE(child)) {
1560 FIH_SETDONE(child);
1561 fih_messages(child, ofile, nest + 1);
1562 }
1563 child = FIH_NEXT(child);
1564 }
1565 if (ccff_file) {
1566 fih_message(mptr);
1567 }
1568 if (ofile) {
1569 fih_message_ofile(ofile, nest, mptr->lineno, 0, mptr);
1570 }
1571 if (ccff_file || ofile) {
1572 if (mptr->seq > 0) {
1573 if (!FIH_DONE(mptr->seq)) {
1574 FIH_SETDONE(mptr->seq);
1575 fih_messages(mptr->seq, ofile, nest + 1);
1576 }
1577 }
1578 }
1579 }
1580 for (; child; child = FIH_NEXT(child)) {
1581 if (!FIH_DONE(child)) {
1582 fih_messages(child, ofile, nest + 1);
1583 FIH_SETDONE(child);
1584 }
1585 }
1586 if (ccff_file)
1587 xmlclose("messages", "ms");
1588 }
1589 if (FIH_CHECKFLAG(fihx, FIH_INLINED)) {
1590 if (ccff_file && fihx > 1)
1591 xmlclose("inlined", "l");
1592 }
1593 if (FIH_CHECKFLAG(fihx, FIH_INCLUDED)) {
1594 if (ccff_file && fihx > 1)
1595 xmlclose("included", "c");
1596 }
1597 #endif
1598 } /* fih_messages */
1599
1600 /*
1601 * output messages for this FIH tag
1602 */
1603 static void
ifih_messages(int ifihx,FILE * ofile,int nest)1604 ifih_messages(int ifihx, FILE *ofile, int nest)
1605 {
1606 #ifndef FE90
1607 int child, c;
1608 MESSAGE *mptr, *firstmptr;
1609 char *funcname;
1610
1611 if (ccff_file && ifihx > 0) {
1612
1613 if ((IFIH_FLAGS(ifihx) & FIH_INCLUDED)) {
1614 xmlopenattri("included", "c", "seq", ifihx);
1615 xmlopen("includeinfo", "ci");
1616 xmlintentity("includelevel", "cl", IFIH_LEVEL(ifihx));
1617 if (IFIH_FULLNAME(ifihx)) {
1618 xmlentity("includefile", "cf", IFIH_FULLNAME(ifihx));
1619 }
1620 xmlclose("includeinfo", "ci");
1621 }
1622
1623 if (IFIH_FLAGS(ifihx) & FIH_INLINED) {
1624 xmlopenattri("inlined", "l", "seq", ifihx);
1625 xmlopen("inlineinfo", "li");
1626 xmlintentity("inlinelevel", "lv", IFIH_LEVEL(ifihx));
1627 xmlintentity("inlineline", "ll", IFIH_LINENO(ifihx));
1628 if (IFIH_SRCLINE(ifihx) > 0)
1629 xmlintentity("inlinesrcline", "lsl", IFIH_SRCLINE(ifihx));
1630 funcname = IFIH_FUNCNAME(ifihx);
1631 xmlentity("inlinename", "ln", funcname);
1632 if (funcname != IFIH_FUNCNAME(ifihx) &&
1633 strcmp(funcname, IFIH_FUNCNAME(ifihx)) != 0) {
1634 xmlentity("inlinemangledname", "lmn", IFIH_FUNCNAME(ifihx));
1635 }
1636 if (IFIH_FULLNAME(ifihx)) {
1637 xmlentity("inlinefile", "lf", IFIH_FULLNAME(ifihx));
1638 }
1639 xmlclose("inlineinfo", "li");
1640 }
1641 }
1642 if ((IFIH_FLAGS(ifihx) & FIH_CCFF) == 0) {
1643 if (((IFIH_FLAGS(ifihx) & FIH_INLINED))) {
1644 if (ccff_file && ifihx > 1)
1645 xmlclose("inlined", "l");
1646 }
1647 }
1648
1649 if ((IFIH_FLAGS(ifihx) & FIH_CCFF) == 0) {
1650 if ((IFIH_FLAGS(ifihx) & FIH_INCLUDED) == FIH_INCLUDED) {
1651 if (ccff_file && ifihx > 1)
1652 xmlclose("included", "c");
1653 }
1654 }
1655
1656 prevnest = -1;
1657 /* clear 'done' flag for children */
1658 for (child = IFIH_CHILD(ifihx); child; child = IFIH_NEXT(child)) {
1659 IFIH_CLEARDONE(child);
1660 }
1661 child = IFIH_CHILD(ifihx);
1662 firstmptr = (MESSAGE *)IFIH_CCFFINFO(ifihx);
1663 if (child || firstmptr) {
1664 if (ccff_file)
1665 xmlopen("messages", "ms");
1666 for (mptr = firstmptr; mptr; mptr = mptr->next) {
1667 while (child && IFIH_LINENO(child) < mptr->lineno) {
1668 if (!IFIH_DONE(child)) {
1669 IFIH_SETDONE(child);
1670 ifih_messages(child, ofile, nest + 1);
1671 }
1672 child = IFIH_NEXT(child);
1673 }
1674 if (ccff_file) {
1675 fih_message(mptr);
1676 }
1677 if (ofile) {
1678 ifih_message_ofile(ofile, nest, mptr->lineno, 0, mptr);
1679 }
1680 if (ccff_file || ofile) {
1681 if (mptr->seq > 0) {
1682 if (!IFIH_DONE(mptr->seq)) {
1683 IFIH_SETDONE(mptr->seq);
1684 ifih_messages(mptr->seq, ofile, nest + 1);
1685 }
1686 }
1687 }
1688 }
1689 for (; child; child = IFIH_NEXT(child)) {
1690 if (!IFIH_DONE(child)) {
1691 ifih_messages(child, ofile, nest + 1);
1692 IFIH_SETDONE(child);
1693 }
1694 }
1695 if (ccff_file)
1696 xmlclose("messages", "ms");
1697 }
1698 if (((IFIH_FLAGS(ifihx) & FIH_INLINED))) {
1699 if (ccff_file && ifihx > 1)
1700 xmlclose("inlined", "l");
1701 }
1702 if ((IFIH_FLAGS(ifihx) & FIH_INCLUDED) == FIH_INCLUDED) {
1703 if (ccff_file && ifihx > 1)
1704 xmlclose("included", "c");
1705 }
1706 #endif
1707 } /* ifih_messages */
1708
1709 /*
1710 * Remove child include files if there is no message.
1711 */
1712
1713 static void
fih_rminc_children(int fihx)1714 fih_rminc_children(int fihx)
1715 {
1716 int child;
1717 int prev_fihx = 0;
1718
1719 for (; fihx; fihx = FIH_NEXT(fihx)) {
1720
1721 /* Do the deepest level child first */
1722 child = FIH_CHILD(fihx);
1723 if (child) {
1724 fih_rminc_children(child);
1725 }
1726
1727 if (FIH_CHECKFLAG(fihx, FIH_INCLUDED)) {
1728 if (!FIH_CCFFINFO(fihx)) {
1729 if (prev_fihx && !FIH_CHILD(fihx))
1730 FIH_NEXT(prev_fihx) = FIH_NEXT(fihx);
1731 else if (!FIH_CHILD(fihx)) {
1732 FIH_CHILD(FIH_PARENT(fihx)) = FIH_NEXT(fihx);
1733 continue;
1734 }
1735 }
1736 }
1737 prev_fihx = fihx;
1738 }
1739 }
1740
1741 /* Remove child include files if there is no message. */
1742
1743 static void
ifih_rminc_children(int ifihx)1744 ifih_rminc_children(int ifihx)
1745 {
1746 int child;
1747 int prev_ifihx = 0;
1748
1749 for (; ifihx; ifihx = IFIH_NEXT(ifihx)) {
1750
1751 /* Do the deepest level child first */
1752 child = IFIH_CHILD(ifihx);
1753 if (child) {
1754 ifih_rminc_children(child);
1755 }
1756
1757 if (IFIH_FLAGS(ifihx) & FIH_INCLUDED) {
1758 if (!IFIH_CCFFINFO(ifihx)) {
1759 if (prev_ifihx && !IFIH_CHILD(ifihx))
1760 IFIH_NEXT(prev_ifihx) = IFIH_NEXT(ifihx);
1761 else if (!IFIH_CHILD(ifihx)) {
1762 IFIH_CHILD(IFIH_PARENT(ifihx)) = IFIH_NEXT(ifihx);
1763 continue;
1764 }
1765 }
1766 }
1767 prev_ifihx = ifihx;
1768 }
1769 }
1770
1771 static bool
save_any_messages(int fihx)1772 save_any_messages(int fihx)
1773 {
1774 MESSAGE *mptr;
1775 mptr = (MESSAGE *)FIH_CCFFINFO(fihx);
1776 for (; mptr; mptr = mptr->next) {
1777 switch (mptr->msgtype) {
1778 case MSGINLINER:
1779 if (XBIT(161, 1))
1780 return true;
1781 break;
1782 case MSGNEGINLINER:
1783 if (XBIT(162, 1))
1784 return true;
1785 break;
1786 case MSGLOOP:
1787 if (XBIT(161, 2))
1788 return true;
1789 break;
1790 case MSGNEGLOOP:
1791 if (XBIT(162, 2))
1792 return true;
1793 break;
1794 case MSGLRE:
1795 if (XBIT(161, 4))
1796 return true;
1797 break;
1798 case MSGNEGLRE:
1799 if (XBIT(162, 4))
1800 return true;
1801 break;
1802 case MSGINTENSITY:
1803 if (XBIT(161, 8))
1804 return true;
1805 break;
1806 case MSGIPA:
1807 if (XBIT(161, 0x10))
1808 return true;
1809 break;
1810 case MSGNEGIPA:
1811 if (XBIT(162, 0x10))
1812 return true;
1813 break;
1814 case MSGFUSE:
1815 if (XBIT(161, 0x20))
1816 return true;
1817 break;
1818 case MSGNEGFUSE:
1819 if (XBIT(162, 0x20))
1820 return true;
1821 break;
1822 case MSGVECT:
1823 case MSGCVECT:
1824 if (XBIT(161, 0x40))
1825 return true;
1826 break;
1827 case MSGNEGVECT:
1828 case MSGNEGCVECT:
1829 if (XBIT(162, 0x40))
1830 return true;
1831 break;
1832 case MSGOPENMP:
1833 if (XBIT(161, 0x80))
1834 return true;
1835 break;
1836 case MSGOPT:
1837 if (XBIT(161, 0x100))
1838 return true;
1839 break;
1840 case MSGNEGOPT:
1841 if (XBIT(162, 0x100))
1842 return true;
1843 break;
1844 case MSGPREFETCH:
1845 if (XBIT(161, 0x200))
1846 return true;
1847 break;
1848 case MSGFTN:
1849 if (XBIT(161, 0x400))
1850 return true;
1851 break;
1852 case MSGPAR:
1853 if (XBIT(161, 0x800))
1854 return true;
1855 break;
1856 case MSGNEGPAR:
1857 if (XBIT(162, 0x800))
1858 return true;
1859 break;
1860 case MSGHPF:
1861 if (XBIT(161, 0x1000))
1862 return true;
1863 break;
1864 case MSGPFO:
1865 case MSGNEGPFO:
1866 if (XBIT(161, 0x2000))
1867 return true;
1868 break;
1869 case MSGACCEL:
1870 if (XBIT(161, 0x4000))
1871 return true;
1872 break;
1873 case MSGNEGACCEL:
1874 if (XBIT(162, 0x4000))
1875 return true;
1876 break;
1877 case MSGUNIFIED:
1878 if (XBIT(161, 0x8000))
1879 return true;
1880 break;
1881 }
1882 }
1883 return false;
1884 } /* save_any_messages */
1885
1886 /*
1887 * set up childlist, messagelist, set FIH_CHILD, FIH_PARENT
1888 */
1889 static void
ccff_set_children()1890 ccff_set_children()
1891 {
1892 int fihx, parentx;
1893
1894 childlistsize = 100;
1895 childlist = GETITEMS(CCFFAREA, int, childlistsize);
1896 messagelistsize = 100;
1897 messagelist = GETITEMS(CCFFAREA, MESSAGE *, messagelistsize);
1898 for (fihx = 1; fihx < fihb.stg_avail; ++fihx) {
1899 FIH_CHILD(fihx) = 0;
1900 FIH_NEXT(fihx) = 0;
1901 }
1902 for (fihx = fihb.stg_avail - 1; fihx > 0; --fihx) {
1903 if (save_any_messages(fihx))
1904 FIH_SETFLAG(fihx, FIH_DO_CCFF);
1905 parentx = FIH_PARENT(fihx);
1906 if (parentx) {
1907 if (FIH_CHILD(parentx)) {
1908 FIH_NEXT(fihx) = FIH_CHILD(parentx);
1909 }
1910 FIH_CHILD(parentx) = fihx;
1911 if (FIH_CHECKFLAG(fihx, FIH_CCFF))
1912 FIH_SETFLAG(parentx, FIH_CCFF);
1913 if (FIH_CHECKFLAG(fihx, FIH_DO_CCFF))
1914 FIH_SETFLAG(parentx, FIH_DO_CCFF);
1915 }
1916 }
1917
1918 if (fihb.stg_avail > 1 && FIH_CHILD(1))
1919 fih_rminc_children(FIH_CHILD(1));
1920
1921 for (fihx = 1; fihx < fihb.stg_avail; ++fihx) {
1922 fih_sort_children(fihx);
1923 fih_sort_messages(fihx);
1924 }
1925 strngsize = 100;
1926 strng = (char *)getitem(CCFFAREA, strngsize);
1927 } /* ccff_set_children */
1928
1929 /* set up childlist, messagelist, set IFIH_CHILD, IFIH_PARENT */
1930 static void
ccff_set_children_deferred()1931 ccff_set_children_deferred()
1932 {
1933 int ifihx, parentx;
1934
1935 childlistsize = 100;
1936 childlist = GETITEMS(ICCFFAREA, int, childlistsize);
1937 messagelistsize = 100;
1938 messagelist = GETITEMS(ICCFFAREA, MESSAGE *, messagelistsize);
1939 for (ifihx = 1; ifihx < ifihb.stg_avail; ++ifihx) {
1940 IFIH_CHILD(ifihx) = 0;
1941 IFIH_NEXT(ifihx) = 0;
1942 }
1943 for (ifihx = ifihb.stg_avail - 1; ifihx > 0; --ifihx) {
1944 parentx = IFIH_PARENT(ifihx);
1945 if (parentx) {
1946 if (IFIH_CHILD(parentx)) {
1947 IFIH_NEXT(ifihx) = IFIH_CHILD(parentx);
1948 }
1949 IFIH_CHILD(parentx) = ifihx;
1950 if (IFIH_FLAGS(ifihx) & FIH_CCFF) {
1951 IFIH_FLAGS(parentx) |= FIH_CCFF;
1952 }
1953 }
1954 }
1955
1956 if (ifihb.stg_avail > 1 && IFIH_CHILD(1))
1957 ifih_rminc_children(IFIH_CHILD(1));
1958
1959 for (ifihx = 1; ifihx < ifihb.stg_avail; ++ifihx) {
1960 ifih_sort_children(ifihx);
1961 ifih_sort_messages(ifihx);
1962 }
1963 strngsize = 100;
1964 strng = (char *)getitem(ICCFFAREA, strngsize);
1965 } /* ccff_set_children_deferred */
1966
1967 /*
1968 * free up allocated space
1969 */
1970 static void
ccff_cleanup_children()1971 ccff_cleanup_children()
1972 {
1973 int fihx;
1974 freearea(CCFFAREA);
1975 formatbuffer = NULL;
1976 formatbuffersize = 0;
1977 strngsize = 0;
1978 strng = NULL;
1979 childlistsize = 0;
1980 childlist = NULL;
1981 messagelistsize = 0;
1982 messagelist = NULL;
1983 for (fihx = 1; fihx < fihb.stg_avail; ++fihx) {
1984 FIH_CCFFINFO(fihx) = NULL;
1985 FIH_CLEARFLAG(fihx, FIH_CCFF);
1986 }
1987 } /* ccff_cleanup_children */
1988
1989 /* free up allocated space */
1990 void
ccff_cleanup_children_deferred()1991 ccff_cleanup_children_deferred()
1992 {
1993 int ifihx;
1994 freearea(ICCFFAREA);
1995 formatbuffer = NULL;
1996 formatbuffersize = 0;
1997 strngsize = 0;
1998 strng = NULL;
1999 childlistsize = 0;
2000 childlist = NULL;
2001 messagelistsize = 0;
2002 messagelist = NULL;
2003 for (ifihx = 1; ifihx < ifihb.stg_avail; ++ifihx) {
2004 IFIH_CCFFINFO(ifihx) = NULL;
2005 IFIH_FLAGS(ifihx) &= ~(FIH_CCFF);
2006 }
2007 } /* ccff_cleanup_children_deferred */
2008
2009 #ifndef FE90
2010 /*
2011 * write messages to ccff_file
2012 * close xml tag
2013 */
2014 void
ccff_close_unit()2015 ccff_close_unit()
2016 {
2017 FILE *ofile = NULL;
2018 if (unitstatus <= 0) /* no file, or not set up for this unit */
2019 return;
2020 #ifndef FE90
2021 if (XBIT(0, 0x2000000))
2022 ofile = stderr;
2023 #endif
2024 ccff_set_children();
2025 anymessages = false;
2026 prevmessage = NULL;
2027 fih_messages(1, ofile, 0);
2028 if (ccff_file)
2029 xmlclose("unit", "u");
2030 unitstatus = 0; /* not set up for this unit */
2031 ccff_cleanup_children();
2032 } /* ccff_close_unit */
2033
2034 /*
2035 * For bottom-up inlining, save inlining information
2036 */
2037 void
ccff_close_unit_deferred()2038 ccff_close_unit_deferred()
2039 {
2040 FILE *ofile = NULL;
2041 if (unitstatus <= 0) /* no file, or not set up for this unit */
2042 return;
2043 #ifndef FE90
2044 if (XBIT(0, 0x2000000))
2045 ofile = stderr;
2046 #endif
2047 ccff_set_children_deferred();
2048 anymessages = false;
2049 prevmessage = NULL;
2050 unitstatus = 0; /* not set up for this unit */
2051 globalorder = 0;
2052 } /* ccff_close_unit_deferred */
2053 #endif
2054
2055 /*
2056 * the routines below allocate new space in CCFFAREA
2057 * for the output of the sprintf. They use the safer snprintf.
2058 * I had hoped to use a varargs routine so as to only need one
2059 * newprintf routine, but I required two calls to snprintf
2060 * (the first to get the buffer size, the second after allocating the
2061 * buffer) and you can't easily restart a varargs
2062 */
2063
2064 /*
2065 * fill the 'formatbuffer' to pass to snprintf
2066 */
2067 static void
fillformat(const char * format,int len)2068 fillformat(const char *format, int len)
2069 {
2070 if (len > formatbuffersize) {
2071 if (formatbuffersize == 0) {
2072 formatbuffersize = 100;
2073 } else {
2074 formatbuffersize = len * 2;
2075 }
2076 formatbuffer = GETITEMS(CCFFAREA, char, formatbuffersize + 1);
2077 }
2078 strncpy(formatbuffer, format, len);
2079 formatbuffer[len] = '\0';
2080 } /* fillformat */
2081
2082 /*
2083 * allocate a new buffer to hold the snprintf output
2084 */
2085 static char *
newbuff(char * oldstring,int len,int * pl)2086 newbuff(char *oldstring, int len, int *pl)
2087 {
2088 int l;
2089 char *buff;
2090 l = 0;
2091 if (oldstring)
2092 l = strlen(oldstring);
2093 buff = GETITEMS(CCFFAREA, char, l + len + 1);
2094 if (oldstring)
2095 strcpy(buff, oldstring);
2096 *pl = l;
2097 return buff;
2098 } /* newbuff */
2099
2100 static char *
newprintfl(char * oldstring,const char * format,int len,long data)2101 newprintfl(char *oldstring, const char *format, int len, long data)
2102 {
2103 char dummybuffer[50];
2104 char *buff;
2105 int n, l;
2106 fillformat(format, len);
2107 n = snprintf(dummybuffer, sizeof(dummybuffer), formatbuffer, data);
2108 if (n <= 0)
2109 return NULL;
2110 buff = newbuff(oldstring, n, &l);
2111 n = snprintf(buff + l, n + 1, formatbuffer, data);
2112 return buff;
2113 } /* newprintfl */
2114
2115 static char *
newprintfi(char * oldstring,const char * format,int len,int data)2116 newprintfi(char *oldstring, const char *format, int len, int data)
2117 {
2118 char dummybuffer[50];
2119 char *buff;
2120 int n, l;
2121 fillformat(format, len);
2122 n = snprintf(dummybuffer, sizeof(dummybuffer), formatbuffer, data);
2123 if (n <= 0)
2124 return NULL;
2125 buff = newbuff(oldstring, n, &l);
2126 n = snprintf(buff + l, n + 1, formatbuffer, data);
2127 return buff;
2128 } /* newprintfi */
2129
2130 static char *
newprintfd(char * oldstring,const char * format,int len,double data)2131 newprintfd(char *oldstring, const char *format, int len, double data)
2132 {
2133 char dummybuffer[50];
2134 char *buff;
2135 int n, l;
2136 fillformat(format, len);
2137 n = snprintf(dummybuffer, sizeof(dummybuffer), formatbuffer, data);
2138 if (n <= 0)
2139 return NULL;
2140 buff = newbuff(oldstring, n, &l);
2141 n = snprintf(buff + l, n + 1, formatbuffer, data);
2142 return buff;
2143 } /* newprintfd */
2144
2145 static char *
newprintfs(char * oldstring,const char * format,int len,char * data)2146 newprintfs(char *oldstring, const char *format, int len, char *data)
2147 {
2148 char *buff;
2149 int n, l;
2150 #ifdef HOST_WIN
2151
2152 /* On windows, snprintf does a copy and return -1 if number of bytes
2153 * copied is smaller than strlen(data) */
2154
2155 char *dummybuffer = (char *)malloc((size_t)(strlen(data) + strlen(format)));
2156 #else
2157 char dummybuffer[1];
2158 #endif
2159 fillformat(format, len);
2160 #ifdef HOST_WIN
2161 n = snprintf(dummybuffer, strlen(data), formatbuffer, data);
2162 #else
2163 n = snprintf(dummybuffer, 1, formatbuffer, data);
2164 #endif
2165 if (n <= 0)
2166 return NULL;
2167 buff = newbuff(oldstring, n, &l);
2168 n = snprintf(buff + l, n + 1, formatbuffer, data);
2169 #ifdef HOST_WIN
2170 free(dummybuffer);
2171 #endif
2172 return buff;
2173 } /* newprintfs */
2174
2175 static char *
newprintfx(char * oldstring,const char * format,int len)2176 newprintfx(char *oldstring, const char *format, int len)
2177 {
2178 char dummybuffer[50];
2179 char *buff;
2180 int n, l;
2181 fillformat(format, len);
2182 n = snprintf(dummybuffer, sizeof(dummybuffer), "%s", formatbuffer);
2183 if (n <= 0)
2184 return NULL;
2185 buff = newbuff(oldstring, n, &l);
2186 n = snprintf(buff + l, n + 1, "%s", formatbuffer);
2187 return buff;
2188 } /* newprintfx */
2189
2190 /*
2191 * save one message
2192 * _ccff_info( MSGTYPE, MSGID, BIH_FINDEX(bihx), BIH_LINENO(bihx),
2193 * "varname", "funcname",
2194 * "function %func inlined, size %size",
2195 * "func=%s", SYMNAME(foo), "size=%d", funcsize, NULL );
2196 */
2197 void *
_ccff_info(int msgtype,const char * msgid,int fihx,int lineno,const char * varname,const char * funcname,const void * xparent,const char * message,va_list argptr)2198 _ccff_info(int msgtype, const char *msgid, int fihx, int lineno, const char *varname,
2199 const char *funcname, const void *xparent, const char *message,
2200 va_list argptr)
2201 {
2202 MESSAGE *mptr;
2203 ARGUMENT *aptr, *alast;
2204 char *argformat, *argend, *format, *f;
2205 int seenpercent, seenlong, ll;
2206
2207 #ifndef FE90
2208 #if DEBUG
2209 if (DBGBIT(73, 2)) {
2210 fprintf(gbl.dbgfil,
2211 "CCFF(msgtype=%d, msgid=%s, fihx=%d, lineno=%d, message=\"%s\"",
2212 msgtype, msgid, fihx, lineno, message);
2213 if (varname)
2214 fprintf(gbl.dbgfil, ", varname=%s", varname);
2215 if (funcname)
2216 fprintf(gbl.dbgfil, ", funcname=%s", funcname);
2217
2218 if (xparent)
2219 fprintf(gbl.dbgfil, ", xparent=0x%p", xparent);
2220 fprintf(gbl.dbgfil, "\n");
2221 }
2222 #endif
2223
2224 if (unitstatus <= 0) /* file not open */
2225 return NULL;
2226 #else
2227 if (unitstatus <= 0) /* not initialized */
2228 return NULL;
2229 #endif
2230
2231 /* keep list of messages at this FIH index */
2232 ++globalorder;
2233 mptr = GETITEM(CCFFAREA, MESSAGE);
2234 BZERO(mptr, MESSAGE, 1);
2235 mptr->msgtype = msgtype;
2236 mptr->msgid = msgid;
2237 mptr->fihx = fihx;
2238 mptr->lineno = lineno;
2239 mptr->varname = NULL;
2240 mptr->funcname = NULL;
2241 mptr->seq = 0;
2242 mptr->combine = 0;
2243 if (varname && varname[0] != '\0')
2244 mptr->varname = COPYSTRING(varname);
2245 if (funcname && funcname[0] != '\0')
2246 mptr->funcname = COPYSTRING(funcname);
2247 mptr->message = COPYSTRING(message);
2248 mptr->args = NULL;
2249 mptr->order = globalorder;
2250 prevmessage = mptr;
2251 alast = NULL;
2252 while (1) {
2253 /* argument must be name=%X where X is
2254 * d - integer
2255 * ld - long
2256 * s - string
2257 * f - double
2258 * x - integer in hex
2259 * lx - long in hex
2260 */
2261 argformat = va_arg(argptr, char *);
2262 if (argformat == NULL)
2263 break;
2264 /* 1st character must be alpha */
2265 if ((argformat[0] < 'a' || argformat[0] > 'z') &&
2266 (argformat[0] < 'A' || argformat[0] > 'Z')) {
2267 interr("ccff_info: bad argument format", 0, ERR_Severe);
2268 return NULL;
2269 }
2270 #ifndef FE90
2271 #if DEBUG
2272 if (DBGBIT(73, 2))
2273 fprintf(gbl.dbgfil, ", \"%s\"", argformat);
2274 #endif
2275 #endif
2276 aptr = GETITEM(CCFFAREA, ARGUMENT);
2277 BZERO(aptr, ARGUMENT, 1);
2278 aptr->next = NULL;
2279 /* find the "=" */
2280 for (argend = argformat + 1; *argend && *argend != '='; ++argend)
2281 ;
2282 if (argend[0] != '=') {
2283 interr("ccff_info: bad argument format", 0, ERR_Severe);
2284 return NULL;
2285 }
2286 ll = argend - argformat;
2287 aptr->argstring = COPYNSTRING(argformat, ll);
2288 aptr->argstring[ll] = '\0';
2289 aptr->argvalue = NULL;
2290 format = argend + 1;
2291 seenpercent = 0;
2292 seenlong = 0;
2293 for (f = format; *f; ++f) {
2294 switch (*f) {
2295 case '%':
2296 seenpercent = 1;
2297 seenlong = 0;
2298 break;
2299 case 'l':
2300 seenlong = 1;
2301 break;
2302 case 'd':
2303 case 'o':
2304 case 'x':
2305 case 'X':
2306 case 'u':
2307 if (seenpercent) {
2308 /* int */
2309 if (seenlong) {
2310 long l;
2311 l = va_arg(argptr, long);
2312 #ifndef FE90
2313 #if DEBUG
2314 if (DBGBIT(73, 2))
2315 fprintf(gbl.dbgfil, ", %ld", l);
2316 #endif
2317 #endif
2318 aptr->argvalue =
2319 newprintfl(aptr->argvalue, format, f + 1 - format, l);
2320 } else {
2321 int i;
2322 i = va_arg(argptr, int);
2323 #ifndef FE90
2324 #if DEBUG
2325 if (DBGBIT(73, 2))
2326 fprintf(gbl.dbgfil, ", %d", i);
2327 #endif
2328 #endif
2329 aptr->argvalue =
2330 newprintfi(aptr->argvalue, format, f + 1 - format, i);
2331 }
2332 format = f + 1;
2333 seenpercent = 0;
2334 }
2335 break;
2336 case 'e':
2337 case 'E':
2338 case 'g':
2339 case 'G':
2340 case 'f':
2341 if (seenpercent) {
2342 double d;
2343 d = va_arg(argptr, double);
2344 #ifndef FE90
2345 #if DEBUG
2346 if (DBGBIT(73, 2))
2347 fprintf(gbl.dbgfil, ", %f", d);
2348 #endif
2349 #endif
2350 aptr->argvalue =
2351 newprintfd(aptr->argvalue, format, f + 1 - format, d);
2352 format = f + 1;
2353 seenpercent = 0;
2354 }
2355 break;
2356 case 's':
2357 /* string */
2358 if (seenpercent) {
2359 char *s;
2360 s = va_arg(argptr, char *);
2361 #ifndef FE90
2362 #if DEBUG
2363 if (DBGBIT(73, 2))
2364 fprintf(gbl.dbgfil, ", \"%s\"", s);
2365 #endif
2366 #endif
2367 aptr->argvalue =
2368 newprintfs(aptr->argvalue, format, f + 1 - format, s);
2369 format = f + 1;
2370 seenpercent = 0;
2371 }
2372 break;
2373 }
2374 }
2375 if (*format != '\0') {
2376 aptr->argvalue = newprintfx(aptr->argvalue, format, f + 1 - format);
2377 }
2378 if (aptr->argvalue != NULL) {
2379 if (alast) {
2380 alast->next = aptr;
2381 } else {
2382 mptr->args = aptr;
2383 }
2384 alast = aptr;
2385 }
2386 }
2387 if (xparent == NULL) {
2388 /* just prepend onto the list */
2389 mptr->next = (MESSAGE *)FIH_CCFFINFO(fihx);
2390 FIH_CCFFINFO(fihx) = (void *)mptr;
2391 FIH_SETFLAG(fihx, FIH_CCFF);
2392 } else {
2393 /* append to child list of the parent */
2394 MESSAGE *parent, *child;
2395 parent = (MESSAGE *)xparent;
2396 if (parent->msgchild == NULL) {
2397 parent->msgchild = mptr;
2398 } else {
2399 for (child = parent->msgchild; child->next; child = child->next)
2400 ;
2401 child->next = mptr;
2402 }
2403 }
2404 #ifndef FE90
2405 #if DEBUG
2406 if (DBGBIT(73, 2)) {
2407 fprintf(gbl.dbgfil, ") returns %p\n", mptr);
2408 }
2409 if (DBGBIT(73, 0x10)) {
2410 fprintf(gbl.dbgfil, "Message: fih:%d line:%d %s", mptr->fihx, mptr->lineno,
2411 mptr->message);
2412 for (aptr = mptr->args; aptr; aptr = aptr->next) {
2413 fprintf(gbl.dbgfil, " %s=%s", aptr->argstring, aptr->argvalue);
2414 }
2415 fprintf(gbl.dbgfil, "\n");
2416 }
2417 #endif
2418 #endif
2419 return mptr;
2420 } /* _ccff_info */
2421
2422 /*
2423 * Save a message
2424 */
2425 void *
ccff_info(int msgtype,const char * msgid,int fihx,int lineno,const char * message,...)2426 ccff_info(int msgtype, const char *msgid, int fihx, int lineno, const char *message,
2427 ...)
2428 {
2429 va_list argptr;
2430 va_start(argptr, message);
2431 return _ccff_info(msgtype, msgid, fihx, lineno, NULL, NULL, NULL, message,
2432 argptr);
2433 } /* ccff_info */
2434
2435 /*
2436 * Save a message that is more detail for a previous message
2437 */
2438 void *
subccff_info(void * xparent,int msgtype,const char * msgid,int fihx,int lineno,const char * message,...)2439 subccff_info(void *xparent, int msgtype, const char *msgid, int fihx, int lineno,
2440 const char *message, ...)
2441 {
2442 va_list argptr;
2443 va_start(argptr, message);
2444 return _ccff_info(msgtype, msgid, fihx, lineno, NULL, NULL, xparent, message,
2445 argptr);
2446 } /* subccff_info */
2447
2448 /*
2449 * Save information for a variable symbol
2450 */
2451 void *
ccff_var_info(int msgtype,const char * msgid,char * varname,const char * message,...)2452 ccff_var_info(int msgtype, const char *msgid, char *varname, const char *message, ...)
2453 {
2454 va_list argptr;
2455 va_start(argptr, message);
2456 return _ccff_info(msgtype, msgid, 1, 0, varname, NULL, NULL, message, argptr);
2457 } /* ccff_var_info */
2458
2459 /*
2460 * Save information for a function symbol
2461 */
2462 void *
ccff_func_info(int msgtype,const char * msgid,char * funcname,const char * message,...)2463 ccff_func_info(int msgtype, const char *msgid, char *funcname, const char *message,
2464 ...)
2465 {
2466 va_list argptr;
2467 va_start(argptr, message);
2468 return _ccff_info(msgtype, msgid, 1, 0, NULL, funcname, NULL, message,
2469 argptr);
2470 } /* ccff_func_info */
2471
2472 /*
2473 * set seq field for most recent message
2474 */
2475 void
ccff_seq(int seq)2476 ccff_seq(int seq)
2477 {
2478 if (prevmessage && seq) {
2479 prevmessage->seq = seq;
2480 }
2481 } /* ccff_seq */
2482
2483 static char *nullname = "";
2484
2485 int
addfile(char * filename,char * funcname,int tag,int flags,int lineno,int srcline,int level)2486 addfile(char *filename, char *funcname, int tag, int flags, int lineno,
2487 int srcline, int level)
2488 {
2489 int f, len;
2490 char *pfilename, *slash, *cp, *pfuncname;
2491 if (fihb.stg_base == NULL) {
2492 fihb.stg_size = 500;
2493 NEW(fihb.stg_base, FIH, fihb.stg_size);
2494 fihb.stg_avail = 1;
2495 BZERO(fihb.stg_base + 0, FIH, 1);
2496 FIH_DIRNAME(0) = NULL;
2497 FIH_FILENAME(0) = nullname;
2498 FIH_FULLNAME(0) = nullname;
2499 fihb.nextfindex = 1;
2500 fihb.nextftag = 0;
2501 fihb.currfindex = 1;
2502 fihb.currftag = 0;
2503 }
2504
2505 f = fihb.stg_avail++;
2506 if (f == 1)
2507 fihb.currfindex = 1;
2508
2509 NEED(fihb.stg_avail, fihb.stg_base, FIH, fihb.stg_size, fihb.stg_size + 500);
2510 BZERO(fihb.stg_base + f, FIH, 1);
2511 /* allocate in permanent area 8 */
2512 len = strlen(filename);
2513 pfilename = getitem(8, len + 1);
2514 strcpy(pfilename, filename);
2515 FIH_FULLNAME(f) = pfilename;
2516 /* get directory/file component */
2517 slash = NULL;
2518 for (cp = pfilename; *cp; ++cp) {
2519 if (*cp == '/'
2520 #ifdef HOST_WIN
2521 || *cp == '\\'
2522 #endif
2523 ) {
2524 slash = cp;
2525 }
2526 }
2527 if (!slash) {
2528 FIH_DIRNAME(f) = NULL;
2529 FIH_FILENAME(f) = FIH_FULLNAME(f);
2530 } else {
2531 /* filename = "/usr/include/stdio.h"
2532 * len = 20
2533 * slash = last / */
2534 int l;
2535 l = slash - pfilename;
2536 /* l = 12 */
2537 if (l == 0)
2538 l = 1; /* allow for /file */
2539 FIH_DIRNAME(f) = getitem(8, l + 1);
2540 strncpy(FIH_DIRNAME(f), pfilename, l);
2541 FIH_DIRNAME(f)[l] = '\0'; /* strncpy does not terminate string */
2542 l = slash - pfilename; /* recompute, in case we incremented l */
2543 l = len - l;
2544 /* len-l = 8, but we'll split off the slash,
2545 * leaving room for the string terminator */
2546 FIH_FILENAME(f) = getitem(8, l);
2547 strncpy(FIH_FILENAME(f), slash + 1, l - 1);
2548 FIH_FILENAME(f)[l - 1] = '\0';
2549 }
2550 if (funcname == NULL) {
2551 FIH_FUNCNAME(f) = nullname;
2552 } else {
2553 pfuncname = getitem(8, strlen(funcname) + 1);
2554 strcpy(pfuncname, funcname);
2555 FIH_FUNCNAME(f) = pfuncname;
2556 }
2557 FIH_FUNCTAG(f) = tag;
2558 FIH_FLAGS(f) = flags;
2559 FIH_PARENT(f) = 0;
2560 FIH_LINENO(f) = lineno;
2561 FIH_SRCLINE(f) = srcline;
2562 FIH_LEVEL(f) = 0;
2563 if (FIH_INC(f))
2564 FIH_LEVEL(f) = level;
2565 if (f != fihb.currfindex && fihb.currfindex > 0) {
2566 FIH_PARENT(f) = fihb.currfindex;
2567 if (!FIH_INC(f))
2568 FIH_LEVEL(f) = FIH_LEVEL(fihb.currfindex) + 1;
2569 }
2570 #ifndef FE90
2571 #if DEBUG
2572 if (DBGBIT(73, 4)) {
2573 fprintf(gbl.dbgfil, "addfile(%d) filename=%s funcname=%s tag=%d "
2574 "flags=0x%x lineno=%d srcline=%d level=%d\n",
2575 f, filename, FIH_FUNCNAME(f), tag, flags, lineno, srcline, level);
2576 }
2577 #endif
2578 #endif
2579 return f;
2580 } /* addfile */
2581
2582 /* This function is used in global_inline when importing bottom-up
2583 auto-inlining information */
2584 int
addinlfile(char * filename,char * funcname,int tag,int flags,int lineno,int srcline,int level,int parent)2585 addinlfile(char *filename, char *funcname, int tag, int flags, int lineno,
2586 int srcline, int level, int parent)
2587 {
2588 int f, len;
2589 char *pfilename, *slash, *cp, *pfuncname;
2590 if (fihb.stg_base == NULL) {
2591 fihb.stg_size = 500;
2592 NEW(fihb.stg_base, FIH, fihb.stg_size);
2593 fihb.stg_avail = 1;
2594 BZERO(fihb.stg_base + 0, FIH, 1);
2595 FIH_DIRNAME(0) = NULL;
2596 FIH_FILENAME(0) = nullname;
2597 FIH_FULLNAME(0) = nullname;
2598 fihb.nextfindex = 1;
2599 fihb.nextftag = 0;
2600 fihb.currfindex = 1;
2601 fihb.currftag = 0;
2602 }
2603
2604 f = fihb.stg_avail++;
2605
2606 NEED(fihb.stg_avail, fihb.stg_base, FIH, fihb.stg_size, fihb.stg_size + 500);
2607 BZERO(fihb.stg_base + f, FIH, 1);
2608 /* allocate in permanent area 8 */
2609 len = strlen(filename);
2610 pfilename = getitem(8, len + 1);
2611 strcpy(pfilename, filename);
2612 FIH_FULLNAME(f) = pfilename;
2613 /* get directory/file component */
2614 slash = NULL;
2615 for (cp = pfilename; *cp; ++cp) {
2616 if (*cp == '/'
2617 #ifdef HOST_WIN
2618 || *cp == '\\'
2619 #endif
2620 ) {
2621 slash = cp;
2622 }
2623 }
2624 if (!slash) {
2625 FIH_DIRNAME(f) = NULL;
2626 FIH_FILENAME(f) = FIH_FULLNAME(f);
2627 } else {
2628 /* filename = "/usr/include/stdio.h"
2629 * len = 20
2630 * slash = last / */
2631 int l;
2632 l = slash - pfilename;
2633 /* l = 12 */
2634 if (l == 0)
2635 l = 1; /* allow for /file */
2636 FIH_DIRNAME(f) = getitem(8, l + 1);
2637 strncpy(FIH_DIRNAME(f), pfilename, l);
2638 FIH_DIRNAME(f)[l] = '\0'; /* strncpy does not terminate string */
2639 l = slash - pfilename; /* recompute, in case we incremented l */
2640 l = len - l;
2641 /* len-l = 8, but we'll split off the slash,
2642 * leaving room for the string terminator */
2643 FIH_FILENAME(f) = getitem(8, l);
2644 strncpy(FIH_FILENAME(f), slash + 1, l - 1);
2645 FIH_FILENAME(f)[l - 1] = '\0';
2646 }
2647 if (funcname == NULL) {
2648 FIH_FUNCNAME(f) = nullname;
2649 } else {
2650 pfuncname = getitem(8, strlen(funcname) + 1);
2651 strcpy(pfuncname, funcname);
2652 FIH_FUNCNAME(f) = pfuncname;
2653 }
2654 FIH_FUNCTAG(f) = tag;
2655 FIH_FLAGS(f) = flags;
2656 FIH_LINENO(f) = lineno;
2657 FIH_SRCLINE(f) = srcline;
2658 FIH_LEVEL(f) = level;
2659 FIH_PARENT(f) = parent;
2660 FIH_CCFFINFO(f) = NULL;
2661 #ifndef FE90
2662 #if DEBUG
2663 if (DBGBIT(73, 4)) {
2664 fprintf(gbl.dbgfil, "addinlfile(%d) filename=%s funcname=%s tag=%d "
2665 "flags=0x%x lineno=%d srcline=%d level=%d\n",
2666 f, filename, FIH_FUNCNAME(f), tag, flags, lineno, srcline,
2667 FIH_LEVEL(f));
2668 }
2669 #endif
2670 #endif
2671 return f;
2672 } /* addinlfile */
2673
2674 int
subfih(int fihindex,int tag,int flags,int lineno)2675 subfih(int fihindex, int tag, int flags, int lineno)
2676 {
2677 int f;
2678 if (fihb.stg_base == NULL) {
2679 return 0;
2680 }
2681
2682 f = fihb.stg_avail++;
2683
2684 NEED(fihb.stg_avail, fihb.stg_base, FIH, fihb.stg_size, fihb.stg_size + 500);
2685 BZERO(fihb.stg_base + f, FIH, 1);
2686 /* allocate in permanent area 8 */
2687 FIH_FULLNAME(f) = FIH_FULLNAME(fihindex);
2688 FIH_FILENAME(f) = FIH_FILENAME(fihindex);
2689 FIH_DIRNAME(f) = FIH_DIRNAME(fihindex);
2690 FIH_FUNCNAME(f) = FIH_FUNCNAME(fihindex);
2691 FIH_FUNCTAG(f) = tag;
2692 FIH_FLAGS(f) = flags;
2693 FIH_PARENT(f) = fihindex;
2694 FIH_LINENO(f) = lineno;
2695 FIH_LEVEL(f) = FIH_LEVEL(fihindex) + 1;
2696 return f;
2697 } /* subfih */
2698
2699 void
setfile(int f,char * funcname,int tag)2700 setfile(int f, char *funcname, int tag)
2701 {
2702 char *pfuncname;
2703 bool firsttime = true;
2704 if (funcname == NULL) {
2705 FIH_FUNCNAME(f) = nullname;
2706 } else if (f == 1 && FIH_FUNCNAME(f) &&
2707 strcmp(funcname, FIH_FUNCNAME(f)) == 0) {
2708 firsttime = false;
2709 } else {
2710 pfuncname = getitem(8, strlen(funcname) + 1);
2711 strcpy(pfuncname, funcname);
2712 FIH_FUNCNAME(f) = pfuncname;
2713 /* if( f == 1 ){
2714 fihb.stg_avail = 2;
2715 } */
2716 }
2717 if (firsttime) {
2718 FIH_FLAGS(f) = 0;
2719 FIH_CCFFINFO(f) = NULL;
2720 }
2721 FIH_LINENO(f) = gbl.lineno;
2722 if (tag >= 0) {
2723 FIH_FUNCTAG(f) = tag;
2724 } else {
2725 #ifndef FE90
2726 FIH_FUNCTAG(f) = ilmb.globalilmstart;
2727 #else
2728 FIH_FUNCTAG(f) = 0;
2729 #endif
2730 }
2731 #ifndef FE90
2732 if (f == 1 && firsttime && GBL_CURRFUNC)
2733 ccff_open_unit();
2734 #endif
2735 } /* setfile */
2736
2737 /*
2738 * save the high water mark of the fihb structure
2739 * we do this in C/C++ after parsing, when we have all the included
2740 * files, but before the expander, before we do any inlining
2741 * Then, before each routine, we restore fihb.stg_avail to the
2742 * high water mark, essentially eliminating the inlining information
2743 * from the previous program unit
2744 */
2745 void
save_ccff_mark()2746 save_ccff_mark()
2747 {
2748 fihb.saved_avail = fihb.stg_avail;
2749 } /* save_ccff_mark */
2750
2751 void
restore_ccff_mark()2752 restore_ccff_mark()
2753 {
2754 /* per flyspray 15759, we must not shrink fihb.stg_avail because
2755 * dwarf2.c may use file information from the previous compile unit
2756 * and therefore we must keep the file information around. We output
2757 * dwarf file information include header/directory header at the end
2758 * of compilation each file, not per routine. If we shrink it, file
2759 * information could be incorrect because we may refer to file index
2760 * that got shrunk in dwarf2.c and may be replaced with other file.
2761 * ccff_cleanup_children() should cleanup FIH_CCFFINFO
2762 * Remove: fihb.stg_avail = fihb.saved_avail;
2763 */
2764 int fihx;
2765 for (fihx = fihb.saved_avail; fihx < fihb.stg_avail; ++fihx) {
2766 FIH_PARENT(fihx) = 0;
2767 }
2768
2769 } /* restore_ccff_mark */
2770
2771 /* save and restore files */
2772
2773 /* If passing argument; 0 is save, 1 is to retrive file indexes. */
2774 void
set_allfiles(int save)2775 set_allfiles(int save)
2776 {
2777 static int save_curr = 1;
2778 static int save_next = 1;
2779 static int save_findex = 1;
2780 if (save == 0) {
2781 save_curr = fihb.currfindex;
2782 save_next = fihb.nextfindex;
2783 save_findex = gbl.findex;
2784 } else {
2785 fihb.currfindex = save_curr;
2786 fihb.nextfindex = save_next;
2787 gbl.findex = save_findex;
2788 }
2789 }
2790
2791 #ifdef FE90
2792 /*
2793 * for Fortran front end, process and save messages for back end to emit
2794 */
2795
2796 /*
2797 * output messages for this FIH tag
2798 */
2799 static void
lower_fih_messages(int fihx,FILE * lfile,int nest)2800 lower_fih_messages(int fihx, FILE *lfile, int nest)
2801 {
2802 int child;
2803 MESSAGE *mptr, *firstmptr;
2804 /* until we productize high-level inlining, this isn't so important */
2805 if (fihx > 1) {
2806 if (FIH_CHECKFLAG(fihx, FIH_INLINED)) {
2807 fprintf(lfile, "CCFFinl seq:%d level:%d line:%d srcline:%d %d:%s %d:%s\n",
2808 fihx, FIH_LEVEL(fihx), FIH_LINENO(fihx), FIH_SRCLINE(fihx),
2809 (int)strlen(FIH_FUNCNAME(fihx)), FIH_FUNCNAME(fihx),
2810 (int)strlen(FIH_FULLNAME(fihx)), FIH_FULLNAME(fihx));
2811 }
2812 }
2813
2814 if (!FIH_CHECKFLAG(fihx, FIH_CCFF)) {
2815 if (FIH_CHECKFLAG(fihx, FIH_INLINED)) {
2816 if (fihx > 1)
2817 fprintf(lfile, "CCFFlni\n");
2818 }
2819 }
2820
2821 prevnest = -1;
2822 prevchildnest = -1;
2823 child = FIH_CHILD(fihx);
2824 firstmptr = (MESSAGE *)FIH_CCFFINFO(fihx);
2825 if (child || firstmptr) {
2826 for (mptr = firstmptr; mptr; mptr = mptr->next) {
2827 while (child && FIH_LINENO(child) < mptr->lineno) {
2828 fih_messages(child, lfile, nest + 1);
2829 child = FIH_NEXT(child);
2830 }
2831 fprintf(lfile, "CCFFmsg seq:%d lineno:%d type:%d %d:%s %d:%s %d:%s\n",
2832 mptr->seq, mptr->lineno, mptr->msgtype,
2833 mptr->varname ? (int)strlen(mptr->varname) : 0,
2834 mptr->varname ? mptr->varname : "",
2835 mptr->funcname ? (int)strlen(mptr->funcname) : 0,
2836 mptr->funcname ? mptr->funcname : "", (int)strlen(mptr->msgid),
2837 mptr->msgid);
2838 if (mptr->args) {
2839 ARGUMENT *aptr;
2840 for (aptr = mptr->args; aptr; aptr = aptr->next) {
2841 fprintf(lfile, "CCFFarg %d:%s %d:%s\n", (int)strlen(aptr->argstring),
2842 aptr->argstring, (int)strlen(aptr->argvalue), aptr->argvalue);
2843 }
2844 }
2845 fprintf(lfile, "CCFFtxt %s\n", mptr->message);
2846 if (XBIT(0, 0x8000000)) {
2847 fprintf(stderr, "%7d, ", mptr->lineno);
2848 _fih_message(stderr, mptr, false);
2849 fprintf(stderr, "\n");
2850 }
2851 }
2852 for (; child; child = FIH_NEXT(child)) {
2853 fih_messages(child, lfile, nest + 1);
2854 }
2855 }
2856
2857 if (fihx > 1)
2858 if (FIH_CHECKFLAG(fihx, FIH_INLINED)) {
2859 fprintf(lfile, "CCFFlni\n");
2860 }
2861
2862 } /* lower_fih_messages */
2863
2864 void
ccff_lower(FILE * lfile)2865 ccff_lower(FILE *lfile)
2866 {
2867 if (unitstatus < 0 || (fihb.stg_avail == 2 && !FIH_CHECKFLAG(1, FIH_CCFF))) {
2868 /* ccff not being saved, or no inlining and no messages */
2869 return;
2870 }
2871 ccff_set_children();
2872 fprintf(lfile, "CCFF\n");
2873 lower_fih_messages(1, lfile, 0);
2874 fprintf(lfile, "CCFFend\n");
2875 } /* ccff_lower */
2876 #endif
2877
2878 #if defined(PGF90) && !defined(FE90)
2879 static ARGUMENT *prevargument = NULL;
2880 /*
2881 * for F90/HPF, save message exported from front end
2882 */
2883 void
save_ccff_msg(int msgtype,const char * msgid,int fihx,int lineno,const char * varname,const char * funcname)2884 save_ccff_msg(int msgtype, const char *msgid, int fihx, int lineno,
2885 const char *varname, const char *funcname)
2886 {
2887 MESSAGE *mptr;
2888
2889 /* keep list of messages at this FIH index */
2890 ++globalorder;
2891 mptr = GETITEM(CCFFAREA, MESSAGE);
2892 BZERO(mptr, MESSAGE, 1);
2893 mptr->msgtype = msgtype;
2894 mptr->msgid = COPYSTRING(msgid);
2895 mptr->fihx = fihx;
2896 mptr->lineno = lineno;
2897 mptr->varname = NULL;
2898 mptr->funcname = NULL;
2899 mptr->seq = 0;
2900 mptr->combine = 0;
2901 if (varname && varname[0] != '\0')
2902 mptr->varname = COPYSTRING(varname);
2903 if (funcname && funcname[0] != '\0')
2904 mptr->funcname = COPYSTRING(funcname);
2905 mptr->message = NULL;
2906 mptr->args = NULL;
2907 mptr->order = globalorder;
2908 prevmessage = mptr;
2909 prevargument = NULL;
2910 /* just prepend onto the list */
2911 mptr->next = (MESSAGE *)FIH_CCFFINFO(fihx);
2912 FIH_CCFFINFO(fihx) = (void *)mptr;
2913 FIH_SETFLAG(fihx, FIH_CCFF);
2914 } /* save_ccff_msg */
2915
2916 /*
2917 * save CCFF argument and value
2918 */
2919 void
save_ccff_arg(char * argname,char * argvalue)2920 save_ccff_arg(char *argname, char *argvalue)
2921 {
2922 ARGUMENT *aptr;
2923 aptr = GETITEM(CCFFAREA, ARGUMENT);
2924 BZERO(aptr, ARGUMENT, 1);
2925 aptr->next = NULL;
2926 aptr->argstring = COPYSTRING(argname);
2927 aptr->argvalue = COPYSTRING(argvalue);
2928 if (prevargument) {
2929 prevargument->next = aptr;
2930 } else if (prevmessage && prevmessage->args == NULL) {
2931 prevmessage->args = aptr;
2932 }
2933 prevargument = aptr;
2934 } /* save_ccff_arg */
2935
2936 /*
2937 * save CCFF message text
2938 */
2939 void
save_ccff_text(char * message)2940 save_ccff_text(char *message)
2941 {
2942 if (prevmessage && prevmessage->message == NULL)
2943 prevmessage->message = COPYSTRING(message);
2944 } /* save_ccff_text */
2945 #endif
2946
2947 void
fih_fini()2948 fih_fini()
2949 {
2950 if (fihb.stg_base)
2951 FREE(fihb.stg_base);
2952 fihb.stg_base = NULL;
2953 fihb.stg_avail = 0;
2954 fihb.stg_size = 0;
2955 } /* fih_fini */
2956
2957 /* debugging helper functions */
2958 void
print_fih()2959 print_fih()
2960 {
2961 int i;
2962 MESSAGE *temp;
2963 printf("************************************************\n");
2964 for (i = 0; i < fihb.stg_avail; i++) {
2965 printf("-FIH:%d file:%s name:%s flag:%d level:%d parent:%d child:%d "
2966 "next:%d ccffinfo:%p\n",
2967 i, FIH_FILENAME(i), FIH_FUNCNAME(i), FIH_FLAGS(i), FIH_LEVEL(i),
2968 FIH_PARENT(i), FIH_CHILD(i), FIH_NEXT(i), FIH_CCFFINFO(i));
2969 temp = (MESSAGE *)FIH_CCFFINFO(i);
2970 if (temp)
2971 printf("\n--File message:%s\n", temp->message);
2972 }
2973 printf("************************************************\n");
2974 }
2975
2976 void
print_ifih()2977 print_ifih()
2978 {
2979 int i;
2980 MESSAGE *temp;
2981 printf("************************************************\n");
2982 for (i = 0; i < ifihb.stg_avail; i++) {
2983 printf("-IFIH:%d file:%s name:%s flag:%d level:%d parent:%d child:%d "
2984 "next:%d lineno:%d ccffinfo:%p\n",
2985 i, IFIH_FILENAME(i), IFIH_FUNCNAME(i), IFIH_FLAGS(i), IFIH_LEVEL(i),
2986 IFIH_PARENT(i), IFIH_CHILD(i), IFIH_NEXT(i), IFIH_LINENO(i),
2987 IFIH_CCFFINFO(i));
2988 temp = (MESSAGE *)IFIH_CCFFINFO(i);
2989 if (temp)
2990 printf("\n--File message:%s\n", temp->message);
2991 }
2992 printf("************************************************\n");
2993 }
2994