Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
00001 /* 00002 00003 Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved. 00004 00005 This program is free software; you can redistribute it and/or modify it 00006 under the terms of version 2.1 of the GNU Lesser General Public License 00007 as published by the Free Software Foundation. 00008 00009 This program is distributed in the hope that it would be useful, but 00010 WITHOUT ANY WARRANTY; without even the implied warranty of 00011 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00012 00013 Further, this software is distributed without any warranty that it is 00014 free of the rightful claim of any third person regarding infringement 00015 or the like. Any license provided herein, whether implied or 00016 otherwise, applies only to this software file. Patent licenses, if 00017 any, provided herein do not apply to combinations of this program with 00018 other software, or any other product whatsoever. 00019 00020 You should have received a copy of the GNU Lesser General Public 00021 License along with this program; if not, write the Free Software 00022 Foundation, Inc., 59 Temple Place - Suite 330, Boston MA 02111-1307, 00023 USA. 00024 00025 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00026 Mountain View, CA 94043, or: 00027 00028 http://www.sgi.com 00029 00030 For further information regarding this notice, see: 00031 00032 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00033 00034 */ 00035 00036 00037 #pragma ident "@(#) libcif/cif_lines.c 30.12 08/26/97 07:43:58" 00038 00039 00040 /* 00041 * cif_lines converts a cif into "lines format" as described below : 00042 * 00043 * Summary : 00044 * 00045 * cifhdr 00046 * srcfile 00047 * files 00048 * misc-non-unit-based-records 00049 * unit 00050 * begin_scope 00051 * non-line-numbered-records referenced in this scope block 00052 * line numbered records sorted by line number 00053 * begin_scope 00054 * ... 00055 * end_scope 00056 * ... 00057 * end_scope 00058 * ... 00059 * end_unit 00060 * ... 00061 * summary 00062 * 00063 * 00064 * 1. First record will always be cifhdr. 00065 * it will have the following fields set as indicated 00066 * 00067 * form = 1(binary) bintype = 1(lines) 00068 * 00069 * 2. Second record will be the srcfile record 00070 * 00071 * 3. Next set of records will be the file records in order of fid. 00072 * 00073 * 4. Before the first unit record will be miscellaneous records that 00074 * do not belong to any particular unit; f90_misc_opts, 00075 * include records, machine characteristics, optimization options; 00076 * messages (that do not belong to a unit).... 00077 * 00078 * 5. Following these will be begin-unit { unit records } end-unit groupings 00079 * 00080 * 6. The last cif record will be the summary record. 00081 * 00082 * 7. All records associated with a unit will be contained within the 00083 * begin-unit, end-unit pair. 00084 * 00085 * 8. As applicable (ie for F90), each unit will be split into nested 00086 * begin_scope, end_scope blocks in the same (line) order as 00087 * in the original source. 00088 * 00089 * 9. All records associated with a particular scope will be contained 00090 * within the begin_scope, end_scope pair. 00091 * 00092 * 10. Immediately following a begin_scope will be the f90_entry record 00093 * of the same symid as the begin scope. 00094 * 00095 * [When no scope-blocks are defined (eg CF77), the entry record will 00096 * immediately follow the unit record]. 00097 * 00098 * 11. The grouping within a begin-scope/end-scope block will be as follows : 00099 * 00100 * begin_scope 00101 * f90_entry matching this begin_scope (see 10. for the exception) 00102 * other f90_entries belonging to this scope sorted by symid 00103 * all other records which have no specific line number, sorted 00104 * on record type and then symid. 00105 * records with line numbers sorted on line and column position followed 00106 * by record type. 00107 * end_scope. 00108 * 00109 * 12. All of the above will be true for ascii cif's and binary (cifconv'd) 00110 * cif's alike, except that cifconv'd cif's will have the additional 00111 * filedir and unitdir records which will have non-meaningful positions 00112 * (ie they still provide useful data in terms of obtaining the number 00113 * of units present, but can not be used to position from in the file. 00114 * The filedir will appear before the first unit, and a unitdir will be 00115 * present in each begin-unit, end-unit block. 00116 * 00117 * Problem : cifconv goes to great lengths to coalesce usage records; 00118 * which lines does not break apart. This will break the strictly 00119 * line order natures of the lines output. eg you might see 00120 * 00121 * stmt record at line 10 cpos 7 00122 * usage record for xyz at line 10 cpos 8 00123 * line 15 cpos 10 00124 * line 123 cpos 15 00125 * stmt record at line 11 cpos 7 00126 * usage record for abc at line 11 cpos 9 00127 * etc 00128 * 00129 * where the usages are sorted on the first usage line, but as all are 00130 * grouped into one record, the subsequent usages will be out of order. 00131 * 00132 * ------------------------------------------------------------------------- */ 00133 00134 #ifndef __STDC__ 00135 # define const 00136 #endif 00137 00138 #define CIF_VERSION 3 00139 00140 #ifdef _ABSOFT 00141 #include "cif.h" 00142 #else 00143 #include <cif.h> 00144 #endif 00145 00146 #include <stdio.h> 00147 #include <string.h> 00148 #include <unistd.h> 00149 #include <stdlib.h> 00150 #include <sys/types.h> 00151 #include <sys/stat.h> 00152 00153 #include "cif_int.h" /* CIF field name arrays */ 00154 #include "unitrecord.h" /* table indicating if record in unit or not */ 00155 00156 /* --- external references --- */ 00157 extern int getopt (); 00158 extern int optind; 00159 extern char *optarg; 00160 extern char *getenv (const char *); 00161 00162 extern char *strdup(const char *s); 00163 00164 #define CIF_NOT 0 00165 #define CIF_ASCII 1 00166 #define CIF_BINARY 2 00167 00168 struct unit_list { /* record info array */ 00169 struct Cif_generic *rptr; /* record pointer array */ 00170 int recno; /* number of record */ 00171 long filepos; /* file position */ 00172 }; 00173 00174 struct record { 00175 struct unit_list *ul; 00176 int ulcur; /* next slot in unit_list */ 00177 int ulmax; /* max size of unit_list */ 00178 }; 00179 00180 static struct record ul; 00181 static struct record wl; 00182 static struct record nl; 00183 00184 /* dynmic array to store modid's and there respective direct/indirect 00185 * flag. When f90_entries are being processed, when a module is hit. this 00186 * list is scanned to append the f90_entry with a new bit that says if the 00187 * module was imported directly or indirectly 00188 */ 00189 struct mod_struct { 00190 int modid; 00191 int direct; 00192 }; 00193 00194 static struct mod_struct *modids = (struct mod_struct *) NULL; 00195 static int modid_max = 0; 00196 static int modid_current = 0; 00197 #define MODID_BUMP 10 00198 00199 00200 #undef Cif_Lines /* ensure that we don't try to map this to Cif_Cifconv_Vx */ 00201 00202 /* --- forward reference prototypes --- */ 00203 static void save_record (struct record *, struct Cif_generic *, int, long); 00204 static void print_records (struct record *, struct record *); 00205 static void print_header_records (struct record *); 00206 static int get_id (struct Cif_generic *); 00207 static int get_line (struct Cif_generic *); 00208 static int get_cpos (struct Cif_generic *); 00209 static int get_fid (struct Cif_generic *); 00210 static int get_scope (struct Cif_generic *); 00211 static int get_type (struct Cif_generic *); 00212 static int get_adjusted_scope (struct Cif_generic *); 00213 00214 static int outfd; 00215 static char *outfile = "-"; 00216 00217 static int global_srcfid = 0; 00218 00219 static int global_last_scope = -1; 00220 00221 /* 00222 * This will be set if any begin_scopes exist in the cif which dictates 00223 * how print_records prints the records out in lines format 00224 * ie if scopes, then we want to group records by scope, otherwise, by 00225 * unit-end unit only. 00226 */ 00227 static int global_scope_found = 0; 00228 00229 00230 /* global_cif_status is set according to the flag in the cif_summary 00231 * record. >= 0 indicates that the CIF is valid (global_cif_status is 00232 * set to 0), -1 indicates that 100 errors were found and that the CIF 00233 * may well be incomplete, but should be okay as far as it goes. -2, and 00234 * -3 are different internal compiler errors meaning that this CIF should 00235 * not be trusted. Negative values are propagated into global_cif_status 00236 */ 00237 static int global_cif_status = 0; 00238 00239 /* return the global_cif_status for the last CIF converted with cif_lines */ 00240 00241 int Cif_CifStatus() { 00242 00243 return( global_cif_status ); 00244 00245 } 00246 00247 /* returns True if file_2 is older than file_1 */ 00248 00249 static int later_date 00250 #ifdef __STDC__ 00251 (char *file_1, char *file_2) 00252 #else 00253 (file_1, file_2) 00254 char *file_1, *file_2; 00255 #endif 00256 { 00257 struct stat buf_1, buf_2; 00258 00259 (void) stat(file_1, &buf_1); 00260 (void) stat(file_2, &buf_2); 00261 00262 return(buf_2.st_mtime >= buf_1.st_mtime); 00263 } 00264 00265 00266 00267 /* Function: cif_next_entry */ 00268 00269 static 00270 int cif_next_entry 00271 #ifdef __STDC__ 00272 ( int cifd, long *cifpos, struct Cif_generic **cif_record ) 00273 #else 00274 ( cifd, cifpos, cif_record ) 00275 int cifd; 00276 long *cifpos; 00277 struct Cif_generic **cif_record; 00278 #endif 00279 { 00280 int rtype; 00281 00282 if ((rtype = Cif_Setpos (cifd, *cifpos)) < 0) { 00283 (void) fprintf(stderr, "libcif: set pos returns %d %s for cifd %d %ld\n", 00284 rtype, 00285 Cif_Errstring(rtype), 00286 cifd, 00287 *cifpos); 00288 } 00289 00290 if ((rtype = Cif_Getrecord (cifd, cif_record)) < 0) { 00291 (void) fprintf (stderr, "libcif: Unknown record type at %ld for %d: (%d) %s\n", 00292 *cifpos, 00293 cifd, 00294 rtype, 00295 Cif_Errstring(rtype)); 00296 } 00297 00298 *cifpos = Cif_Getpos(cifd); 00299 return(rtype); 00300 } 00301 00302 00303 /* Cif_Filename returns the filename associated with a given cifd */ 00304 00305 00306 char *Cif_Filename 00307 #ifdef __STDC__ 00308 (int cifd) 00309 #else 00310 (cifd) 00311 int cifd; 00312 #endif 00313 { 00314 if (cifd < 0 || cifd >= CIF_FT_SIZE ||_Cif_filetbl[cifd].form == NOT_A_CIF) 00315 return ((char *) NULL); 00316 else { 00317 00318 return(_Cif_filetbl[cifd].filename); 00319 00320 } 00321 } 00322 00323 00324 00325 00326 /* 00327 * lines_type returns true if this file is in lines format already 00328 * false otherwise. 00329 */ 00330 00331 00332 static int lines_type 00333 #ifdef __STDC__ 00334 (char *cif_name) 00335 #else 00336 (cif_name) 00337 char *cif_name; 00338 #endif 00339 { 00340 int cifd; 00341 long filepos = CIF_FIRST_RECORD; 00342 int return_code; 00343 struct Cif_generic *cif_record; 00344 00345 cifd = Cif_Open(cif_name, "r", NULL, CIF_VERSION); 00346 00347 if (cifd >= 0 && 00348 cif_next_entry(cifd, &filepos, &cif_record) == CIF_CIFHDR) { 00349 00350 global_srcfid = CIFHDR(cif_record)->srcfid; 00351 00352 return_code = (CIFHDR(cif_record)->form == CIF_FORM_SORTED); 00353 return_code &= (CIFHDR(cif_record)->bintype == CIF_FORM_LINES); 00354 00355 Cif_Close (cifd, CIF_MEM_FREE); 00356 return(return_code); 00357 } 00358 else { 00359 return(0); 00360 } 00361 } 00362 00363 00364 static char *cif_concat 00365 #ifdef _STDC__ 00366 ( char *str1, char *str2 ) 00367 #else 00368 ( str1, str2 ) 00369 char *str1, *str2; 00370 #endif 00371 { 00372 char *return_str; 00373 00374 return_str = 00375 (char *) malloc ( (strlen( str1) + strlen(str2) + 1) * sizeof (char)); 00376 00377 if (return_str == (char *) NULL) { 00378 (void) fprintf(stderr, 00379 "libcif, cif_lines error : Couldn't malloc space in cif_concat\n"); 00380 exit(-1); 00381 } 00382 00383 (void) sprintf(return_str, "%s%s",str1, str2); 00384 00385 return( return_str ); 00386 } 00387 00388 00389 00390 /* 00391 * returns the basename of a given filename, ie removing any attached 00392 * directory path 00393 */ 00394 00395 char *cif_basename 00396 #ifdef __STDC__ 00397 ( char *name ) 00398 #else 00399 ( name ) 00400 char *name; 00401 #endif 00402 { 00403 char *return_str = strrchr(name, '/'); 00404 00405 if (return_str == (char *) NULL) 00406 return( name ); 00407 else 00408 return( (char *) (++return_str)); 00409 } 00410 00411 00412 00413 /* 00414 * Returns the directory part of a fully pathed file 00415 */ 00416 00417 static char *cif_dirname 00418 #ifdef __STDC__ 00419 ( char *name ) 00420 #else 00421 ( name ) 00422 char *name; 00423 #endif 00424 { 00425 int i = strlen( name ) - 1; 00426 char *dirname_tmp; 00427 00428 while ( i >= 0 && 00429 name[i]!='/') 00430 i--; 00431 00432 if ( i > 0 ) { 00433 dirname_tmp = (char *) malloc ( (i+1) * sizeof(char)); 00434 if (!dirname_tmp) { 00435 (void) fprintf(stderr, 00436 "libcif, Cif_Lines error : Couldn't malloc space in cif_dirname\n"); 00437 exit(-1); 00438 } 00439 (void) strncpy(dirname_tmp, name, i); 00440 dirname_tmp[i] = '\0'; 00441 } 00442 else 00443 dirname_tmp = strdup("./"); 00444 00445 return(dirname_tmp); 00446 } 00447 00448 00449 int cif_VerifyCanWrite 00450 #ifdef __STDC__ 00451 ( char *file ) 00452 #else 00453 (file) 00454 char *file; 00455 #endif 00456 { 00457 if (!access(file,F_OK)) { 00458 if(access(file,W_OK)) { 00459 /* This file exists but can not be written to */ 00460 return(0); 00461 } 00462 else { 00463 return(1); 00464 } 00465 } 00466 else { 00467 char *dir = cif_dirname(file); 00468 struct stat buf; 00469 int mode; 00470 char *test_file = cif_concat(dir,"/write_test"); 00471 FILE *fd; 00472 00473 if (access(dir,F_OK)) { 00474 /* Directory does not exist */ 00475 (void) free(dir); 00476 (void) free(test_file); 00477 return(0); 00478 } 00479 00480 mode = stat(dir, &buf); 00481 00482 if (mode == -1) { 00483 /* Directory can not be accessed */ 00484 return(0); 00485 } 00486 00487 if (S_ISDIR(buf.st_mode)) { 00488 if (NULL == (fd = fopen(test_file,"w"))) { 00489 /* Directory is not writeable" */ 00490 (void) free(dir); 00491 (void) fclose(fd); 00492 (void) unlink(test_file); 00493 (void) free(test_file); 00494 return(0); 00495 } 00496 else { 00497 (void) free(dir); 00498 (void) fclose(fd); 00499 (void) unlink(test_file); 00500 (void) free(test_file); 00501 return(1); 00502 } 00503 } 00504 else { 00505 /* directory exists, but is not a directory */ 00506 (void) free(test_file); 00507 (void) free(dir); 00508 return(0); 00509 } 00510 } 00511 } 00512 00513 00514 00515 00516 00517 /* --- convert a cif onto a lines mode cif --- */ 00518 static char *Cif_Make_Lines 00519 #ifdef __STDC__ 00520 (char *infile, char *outfile) 00521 #else 00522 (infile, outfile) 00523 char *infile, *outfile; 00524 #endif 00525 { 00526 static int first = 1; 00527 int record_num; 00528 int rtype; 00529 int cifd; 00530 long filepos; 00531 struct Cif_generic *cif_record; 00532 int cif_ending_early = 0; 00533 00534 /* Assume that CIF is valid until the summary record says otherwise */ 00535 global_cif_status = 0; 00536 00537 /* 00538 * Open the input file. If records are to be sorted, 00539 * memory mode must be managed. Set the memory management mode. 00540 */ 00541 00542 if ((cifd = Cif_Open(infile, "r", NULL, CIF_VERSION)) < 0) { 00543 (void) fprintf (stderr ,"libcif: can't open file %s - %s\n", 00544 infile, Cif_Errstring(cifd)); 00545 return((char *) NULL); 00546 } 00547 00548 00549 if ((outfd = Cif_Open(outfile, "w", NULL, CIF_VERSION)) < 0) { 00550 Cif_Close(cifd, CIF_MEM_FREE); 00551 (void) fprintf (stderr, 00552 "libcif: can't open output file %s - %s\n",outfile, 00553 Cif_Errstring(outfd)); 00554 return ((char *) NULL); 00555 } 00556 00557 (void) Cif_Memmode (cifd, CIF_MEM_MANAGED); 00558 00559 /* 00560 * Read each record. If not sorted, display immediately. If sorted 00561 * and a non-unit record, display immediately. If sorted and a 00562 * unit record, save the record pointer in unit_list till the 00563 * CIF_ENDUNIT record has been reached, then sort and print all the 00564 * records. 00565 */ 00566 00567 /* 00568 * Make sure that memory is reset on the first time through 00569 * as soon we will check this value for NULL and allocate 00570 * storage based on it, if unitialised, it could cause problems 00571 */ 00572 if (first == 1) { 00573 ul.ul = (struct unit_list *) NULL; 00574 nl.ul = (struct unit_list *) NULL; 00575 wl.ul = (struct unit_list *) NULL; 00576 first = 0; 00577 } 00578 00579 ul.ulcur = 0; nl.ulcur = 0; wl.ulcur = 0; 00580 00581 ul.ulmax = 0; nl.ulmax = 0; wl.ulmax = 0; 00582 00583 00584 record_num = 1; 00585 filepos = Cif_Getpos(cifd); 00586 while ((rtype = Cif_Getrecord (cifd, &cif_record)) >= 0) { 00587 00588 if (rtype > CIF_MAXRECORD) 00589 (void) fprintf (stderr, "libcif: unknown record type, %d\n", rtype); 00590 else if (rtype == CIF_SUMMARY && 00591 CIFSUM(cif_record)->fldlen < 0) { 00592 global_cif_status = CIFSUM(cif_record)->fldlen; 00593 } 00594 00595 else if (get_scope(cif_record) != 0) 00596 { 00597 /* 00598 * If the cif is ending prematurely, a summary record will 00599 * be issued containing fldlen == -1; this indicates that 00600 * all remaining records should be flushed at the end 00601 * as there will not be an end unit record to do this 00602 * via normal processing 00603 */ 00604 if (rtype == CIF_SUMMARY && 00605 CIFSUM(cif_record)->fldlen < 0) { 00606 global_cif_status = CIFSUM(cif_record)->fldlen; 00607 cif_ending_early = 1; 00608 } 00609 00610 00611 if (rtype == CIF_UNIT) { 00612 00613 global_last_scope = -1; 00614 modid_current = 0; /* no use_mod records 00615 * found in this unit, yet. Used to 00616 * cross reference entries with their 00617 * corresponding use_mods 00618 */ 00619 } 00620 00621 if (! unit_record[rtype] && 00622 rtype != CIF_INCLUDE) { 00623 save_record(&nl, cif_record, record_num, filepos); 00624 } 00625 else { 00626 if (has_line[rtype]) { 00627 save_record (&wl, cif_record, record_num, filepos); 00628 00629 if (rtype == CIF_F90_BEGIN_SCOPE && 00630 global_last_scope == -1) { 00631 global_last_scope = CIFF90BS(cif_record)->scopeid; 00632 00633 } 00634 } 00635 else { 00636 save_record (&ul, cif_record, record_num, filepos); 00637 /* add the use_module so that module entries can be 00638 * looked up to see of they are directly used 00639 */ 00640 if (rtype == CIF_F90_USE_MODULE) { 00641 /* See if more space is needed */ 00642 00643 if (modid_max == modid_current) { 00644 modid_max += MODID_BUMP; 00645 if (modid_max == MODID_BUMP) { 00646 00647 modids = (struct mod_struct *) malloc((sizeof(struct mod_struct) * modid_max)); 00648 } 00649 else { 00650 modids = (struct mod_struct *) realloc(modids, (sizeof(struct mod_struct) * modid_max)); 00651 } 00652 } 00653 modids[modid_current].modid = CIFF90USE(cif_record)->modid; 00654 modids[modid_current].direct = CIFF90USE(cif_record)->direct; 00655 modid_current++; 00656 00657 } 00658 } 00659 00660 if (rtype == CIF_ENDUNIT) { 00661 00662 print_header_records (&nl); 00663 print_records (&wl, &ul); 00664 00665 ul.ulcur = 0; 00666 nl.ulcur = 0; 00667 wl.ulcur = 0; 00668 00669 (void) Cif_Release (cifd, CIF_MEM_KEEP); 00670 } 00671 00672 if (rtype == CIF_USAGE) 00673 record_num += CIFUSAGE(cif_record)->nuses; 00674 else 00675 record_num++; 00676 } 00677 filepos = Cif_Getpos(cifd); 00678 } 00679 } 00680 00681 /* print out any remaining non-unit records, normally the summary */ 00682 00683 /* 00684 * If the cif has terminated early (because of > 100 errors), then 00685 * we need to flush the remaining errors 00686 */ 00687 if (cif_ending_early == 1) { 00688 print_records (&wl, &ul); 00689 } 00690 00691 if (nl.ulcur > 0) 00692 print_header_records (&nl); 00693 00694 /* All done so clean up */ 00695 00696 if (rtype != CIF_EOF) 00697 (void) fprintf (stderr, "CIF error - %s\n", 00698 Cif_Errstring(rtype)); 00699 (void) Cif_Close (cifd, CIF_MEM_FREE); 00700 (void) Cif_Close (outfd, CIF_MEM_KEEP); 00701 return (outfile); 00702 } 00703 00704 00705 static char *cif_convert_to_lines 00706 #ifdef __STDC__ 00707 (char *filename, int keep, int *tmp_cif) 00708 #else 00709 (filename, keep, tmp_cif) 00710 char *filename; 00711 int keep; 00712 int *tmp_cif; 00713 #endif 00714 { 00715 char *value; 00716 char *cifdir = (char *) NULL; 00717 char *cifdir_file = (char *) NULL; 00718 char *outfile = (char *) NULL; 00719 char *create_cif_file = (char *) NULL; 00720 char *tmpdir = (char *) NULL; 00721 00722 /* Assume that a tmp file will not be created, until proved otherwise */ 00723 00724 *tmp_cif = 0; 00725 00726 /* 1. check if the file is already a lines file */ 00727 00728 if (lines_type( filename ) == 1) 00729 return(strdup(filename)); 00730 00731 /* 2. see if CIFDIR is set */ 00732 00733 value = getenv("CIFDIR"); 00734 if (value != (char *) NULL) { 00735 cifdir = value; 00736 00737 cifdir_file = (char *) malloc(sizeof(char) * 00738 (strlen(cifdir) + 00739 strlen(cif_basename(filename)) + 00740 3)); 00741 00742 (void) sprintf(cifdir_file, "%s/%sL", cifdir, cif_basename(filename)); 00743 00744 if (!access(cifdir_file, R_OK)) { 00745 00746 if (later_date(filename, cifdir_file) && 00747 lines_type(cifdir_file) == 1) { 00748 return(cifdir_file); 00749 } 00750 } 00751 } 00752 00753 /* 3. See if the lines cif exists next to the original cif */ 00754 00755 outfile = (char *) malloc(sizeof(char) * 00756 (strlen(filename) + 2)); 00757 (void) sprintf(outfile, "%sL", filename); 00758 00759 if (!access(outfile, R_OK)) { 00760 00761 if (later_date(filename, outfile) && 00762 lines_type(outfile) == 1) { 00763 return(outfile); 00764 } 00765 } 00766 00767 00768 /* Lines for does not exist already, so we have to create it */ 00769 00770 /* Only want to create the cif in non-tmp space if keep == True */ 00771 if (keep == 1) { 00772 00773 /* 4. See if we can write to CIFDIR */ 00774 00775 if (cifdir_file != (char *) NULL && 00776 cif_VerifyCanWrite(cifdir_file)) { 00777 00778 create_cif_file = cifdir_file; 00779 } 00780 else 00781 00782 /* 5. See if we can write next to the original file */ 00783 00784 if (outfile != (char *) NULL && 00785 cif_VerifyCanWrite(outfile)) { 00786 00787 create_cif_file = strdup(outfile); 00788 } 00789 } 00790 00791 if (create_cif_file == (char *) NULL) { 00792 00793 /* 6. put the cif into /tmp, see of TMPDIR is available */ 00794 00795 if (value != (char *) NULL) (void) free(value); 00796 00797 value = getenv("TMPDIR"); 00798 if (value != (char *) NULL) { 00799 tmpdir = value; 00800 } 00801 else { 00802 create_cif_file = (char *) malloc(sizeof(char) * 00803 (strlen("/tmp/") + 00804 strlen(cif_basename(filename)) + 00805 7)); 00806 00807 (void) sprintf(create_cif_file, "/tmp/%sXXXXXX", cif_basename(filename)); 00808 (void) mktemp(create_cif_file); 00809 00810 } 00811 00812 if (create_cif_file == (char *) NULL) { 00813 create_cif_file = (char *) malloc(sizeof(char) * 00814 (strlen(tmpdir) + 00815 strlen(cif_basename(filename)) + 00816 3)); 00817 00818 (void) sprintf(create_cif_file, "%s/%sL", tmpdir, cif_basename(filename)); 00819 } 00820 00821 /* 00822 * indicate that a tmp cif file is about to be created; it will 00823 * be removed on cif_close 00824 */ 00825 00826 *tmp_cif = 1; 00827 00828 } 00829 00830 create_cif_file = Cif_Make_Lines(filename, create_cif_file); 00831 00832 /* free up allocated strings */ 00833 00834 if (cifdir_file != (char *) NULL) (void) free(cifdir_file); 00835 if (outfile != (char *) NULL) (void) free(outfile); 00836 00837 return(create_cif_file); 00838 } 00839 00840 00841 int Cif_Lines 00842 #ifdef __STDC__ 00843 (char *filename, char *optype, int *rtypes, int version, int keep) 00844 #else 00845 (filename, optype, rtypes, version, keep) 00846 char *filename; /* file name */ 00847 char *optype; /* open type */ 00848 int *rtypes; /* ptr to array of selected record types */ 00849 int version; /* CIF version expected by tools */ 00850 int keep; /* keep the file on exit ? */ 00851 #endif 00852 { 00853 00854 char *cif_name; 00855 int tmp_cif; /* 00856 * set by cif_convert_to_lines if a tmp file has been 00857 * created to hold the lines cif; the cif should be deleted 00858 * by cif_close 00859 */ 00860 int ret; 00861 00862 if (_cif_version == 0) 00863 _cif_version = 1; 00864 00865 /* make sure that global values are reset */ 00866 00867 global_scope_found = 0; 00868 global_srcfid = 0; 00869 00870 /* convert filename to cif_lines name */ 00871 00872 cif_name = cif_convert_to_lines(filename, keep, &tmp_cif); 00873 00874 /* an empty filename means that the cif is invalid or not there */ 00875 if (cif_name == (char *) NULL) { 00876 return(CIF_NOTCIF); 00877 } 00878 00879 /* open the file and return */ 00880 00881 if (version == 2) { 00882 ret = Cif_Open_V2(cif_name, optype, rtypes, version); 00883 } 00884 else { 00885 ret = Cif_Open_V3_1(cif_name, optype, rtypes, version, 00886 CIF_SUB_VERSION_3); 00887 } 00888 00889 00890 /* 00891 * cif_convert_to_lines always returns a copy of the filename to 00892 * be opened, but cif_open will be copying this, so we don't need 00893 * the string anymore 00894 */ 00895 00896 (void) free(cif_name); 00897 /* 00898 * If a valid open, set the tmp_cif flag according to indicate if a 00899 * temporary file has been created that should be removed on cif_close 00900 */ 00901 00902 if (ret >= 0) { 00903 _Cif_filetbl[ret].tmp_cif = tmp_cif; 00904 } 00905 00906 /* Return whatever cif_open returned */ 00907 00908 return(ret); 00909 } 00910 00911 00912 /* 00913 * As above + added a check to see of the cif.h in use matches what this 00914 * library was compiled with...looks at CIF_SUB_VERSION_2 which must match 00915 * the sub_version passed. See cif_open macros in cif.h for more details. 00916 */ 00917 00918 int Cif_Lines_V2_1 00919 #ifdef __STDC__ 00920 (char *filename, char *optype, int *rtypes, int version, int keep, int sub_version) 00921 #else 00922 (filename, optype, rtypes, version, keep, sub_version) 00923 char *filename; /* file name */ 00924 char *optype; /* open type */ 00925 int *rtypes; /* ptr to array of selected record types */ 00926 int version; /* CIF version expected by tools */ 00927 int keep; /* keep the file on exit ? */ 00928 int sub_version; /* version number of the cif.h */ 00929 #endif 00930 { 00931 _cif_version = 2; 00932 00933 if (sub_version != CIF_SUB_VERSION_2) 00934 return(CIF_SUBVER); 00935 00936 return(Cif_Lines(filename, optype, rtypes, 00937 version, keep)); 00938 } 00939 00940 /* 00941 * As above for Version 3 00942 */ 00943 00944 int Cif_Lines_V3_1 00945 #ifdef __STDC__ 00946 (char *filename, char *optype, int *rtypes, int version, int keep, int sub_version) 00947 #else 00948 (filename, optype, rtypes, version, keep, sub_version) 00949 char *filename; /* file name */ 00950 char *optype; /* open type */ 00951 int *rtypes; /* ptr to array of selected record types */ 00952 int version; /* CIF version expected by tools */ 00953 int keep; /* keep the file on exit ? */ 00954 int sub_version; /* version number of the cif.h */ 00955 #endif 00956 { 00957 _cif_version = 3; 00958 00959 if (sub_version != CIF_SUB_VERSION_3) 00960 return(CIF_SUBVER); 00961 00962 return(Cif_Lines(filename, optype, rtypes, 00963 version, keep)); 00964 } 00965 00966 /* -------------------------------------------------------------------------- 00967 * Add a record pointer to unit_list. Create unit_list if not created yet. 00968 * Expand unit_unit if full. 00969 * -------------------------------------------------------------------------- */ 00970 static void save_record 00971 (struct record *l, 00972 struct Cif_generic *cif_record, 00973 int recno, 00974 long filepos) 00975 { 00976 if (l->ul == (struct unit_list *) NULL) { 00977 l->ulmax = 10000; 00978 l->ul= 00979 (struct unit_list *) 00980 calloc (l->ulmax, sizeof(struct unit_list)); 00981 } 00982 else 00983 if (l->ulcur >= l->ulmax) { 00984 l->ulmax += 1000; 00985 l->ul = (struct unit_list *) 00986 realloc (l->ul, sizeof(struct unit_list) * l->ulmax); 00987 00988 (void) memset((char *) (&(l->ul[l->ulmax - 1000])), '\0', 00989 (1000 * sizeof(struct unit_list))); 00990 00991 } 00992 00993 l->ul[l->ulcur].rptr = cif_record; 00994 l->ul[l->ulcur].recno = recno; 00995 l->ul[l->ulcur++].filepos = filepos; 00996 } 00997 00998 00999 /* -------------------------------------------------------------------------- 01000 * qsort comparsion routine for comparing symbol ids 01001 * -------------------------------------------------------------------------- */ 01002 static comp_id ( 01003 struct Cif_generic **r1, 01004 struct Cif_generic **r2) 01005 { 01006 int ret; 01007 01008 if (((ret = (get_fid(*r1) - get_fid(*r2)))) != 0) 01009 return (ret); 01010 else 01011 if (((ret = (get_line(*r1) - get_line(*r2)))) != 0) 01012 return (ret); 01013 else 01014 if (((ret = ( get_cpos(*r1) - get_cpos(*r2)))) != 0) 01015 return(ret); 01016 else { 01017 if (((ret = ((*r1)->rectype - (*r2)->rectype ))) != 0) 01018 return (ret); 01019 else 01020 if ((*r1)->rectype == CIF_F90_END_SCOPE) 01021 01022 /* 01023 * note that we want to compare scopes the other way 01024 * around, ie if it's the same position/record, we are 01025 * looking at two end scopes and as scope x will have 01026 * started before x + 1, we want x+1 end to come before x. 01027 */ 01028 01029 return ( get_scope(*r2) - get_scope(*r1) ); 01030 else 01031 return ( get_scope(*r1) - get_scope(*r2) ); 01032 } 01033 } 01034 01035 01036 /* -------------------------------------------------------------------------- 01037 * qsort comparsion routine for comparing symbol scopes 01038 * --------------------------------------------------------------------------*/ 01039 static int comp_scope ( 01040 struct Cif_generic **r1, 01041 struct Cif_generic **r2) 01042 { 01043 int ret; 01044 if ((ret = (get_adjusted_scope(*r1) - get_adjusted_scope(*r2))) != 0) 01045 return(ret); 01046 else 01047 if ((ret = (get_type(*r1) - get_type(*r2))) != 0) 01048 return(ret); 01049 else 01050 return ( get_id(*r1) - get_id(*r2) ); 01051 } 01052 01053 /* -------------------------------------------------------------------------- 01054 * qsort comparsion routine for comparing record types 01055 * --------------------------------------------------------------------------*/ 01056 static int comp_rtype ( 01057 struct Cif_generic **r1, 01058 struct Cif_generic **r2) 01059 { 01060 int rtype_1, rtype_2; 01061 01062 rtype_1 = (*r1)->rectype; 01063 rtype_2 = (*r2)->rectype; 01064 if (rtype_1 == rtype_2 && 01065 rtype_2 == CIF_FILE) 01066 return(CIFFILE(*r1)->fid - CIFFILE(*r2)->fid); 01067 else 01068 if (rtype_1 == CIF_SRCFILE) 01069 rtype_1 = CIF_FILE - 1; /* want srcfiles before files */ 01070 else 01071 if (rtype_2 == CIF_SRCFILE) 01072 rtype_2 = CIF_FILE - 1; 01073 01074 return ( rtype_1 - rtype_2 ); 01075 } 01076 01077 01078 /* 01079 * If an include record is found, all records belonging to this include 01080 * file should be listed after it, even though this will seemingly 01081 * break the natural line number order. eg line 10 of fred.f and line 01082 * 11 of inc1.h should not be compared, so that an ordered line list 01083 * is provided for all things in incl1.h immediately after the include 01084 * line record. Note, this is recrsive to account for the fact that 01085 * include files may be nested. 01086 */ 01087 01088 /* When multiple units are within the same include file, we need 01089 * to re-enter this routine with the second and subsequent units, 01090 * as such, we need to remember what include file we were processing 01091 * at the time. last_inc stores this. When current comes in as -1, 01092 * it means that we are processing another unit within the include, 01093 * so use the previous include fid value 01094 */ 01095 01096 static int last_inc = 0; 01097 01098 static void print_include_records(struct record *w, struct record *n, int start, int current, int *pscope_index) 01099 { 01100 int inner_index; 01101 int inc_fid; 01102 int scope_index = *pscope_index; 01103 int save_scope_index; 01104 int ret; 01105 01106 /* if current == -1 then we are starting a new unit within the same 01107 * include file. As such, use the inc_fid from before 01108 */ 01109 if (current == -1) inc_fid = last_inc; 01110 else /* pick up the include file id from the include record */ 01111 inc_fid = CIFINC(w->ul[current].rptr)->incid; 01112 01113 /* note the include file id, just in case we return with another 01114 * unit within the same include file 01115 */ 01116 last_inc = inc_fid; 01117 01118 /* Search for matching fid to this include */ 01119 for (inner_index = start + 1; 01120 w->ul[inner_index].rptr != NULL && 01121 get_fid(w->ul[inner_index].rptr) != inc_fid; 01122 inner_index++) { 01123 } 01124 01125 for (; 01126 w->ul[inner_index].rptr != NULL && 01127 get_fid(w->ul[inner_index].rptr) == inc_fid; 01128 inner_index++) { 01129 01130 if ((ret = 01131 Cif_Putrecord(outfd, 01132 w->ul[inner_index].rptr)) < 0) { 01133 (void) fprintf (stderr, 01134 "cif_lines: error writing output file %s - %s\n", 01135 outfile, Cif_Errstring(ret)); 01136 exit (ret); 01137 } 01138 01139 if (CIFGEN(w->ul[inner_index].rptr)->rectype == CIF_INCLUDE) { 01140 print_include_records(w, n, start, inner_index, &scope_index); 01141 } 01142 else { 01143 if (CIFGEN(w->ul[inner_index].rptr)->rectype ==CIF_F90_BEGIN_SCOPE || 01144 global_scope_found == 0 ) { 01145 01146 /* Look for the entry matching this scope and make 01147 * sure that it comes out first 01148 */ 01149 save_scope_index = scope_index; 01150 for (; scope_index < n->ulcur; scope_index++) { 01151 01152 if (CIFGEN(n->ul[scope_index].rptr)->rectype != 01153 CIF_F90_ENTRY) 01154 break; 01155 01156 if (CIFF90ENTRY(n->ul[scope_index].rptr)->symid == 01157 CIFF90BS(w->ul[inner_index].rptr)->symid) { 01158 01159 if ((ret = 01160 Cif_Putrecord(outfd, 01161 n->ul[scope_index].rptr)) < 0) { 01162 (void) fprintf (stderr, 01163 "cif_lines: error writing output file %s - %s\n", 01164 outfile, Cif_Errstring(ret)); 01165 exit (ret); 01166 } 01167 CIFGEN(n->ul[scope_index].rptr)->rectype = 0; 01168 break; 01169 } 01170 } 01171 scope_index = save_scope_index; 01172 01173 for (; scope_index < n->ulcur; scope_index++) { 01174 01175 if (CIFGEN(n->ul[scope_index].rptr)->rectype == 0) 01176 continue; 01177 01178 if (get_scope(n->ul[scope_index].rptr) == 01179 CIFF90BS(w->ul[inner_index].rptr)->scopeid || 01180 global_scope_found == 0) { 01181 01182 if (get_scope(n->ul[scope_index].rptr) == 0) 01183 continue; 01184 01185 /* 01186 * For module entries, look to see if they are 01187 * used directly, or indirectly 01188 */ 01189 if (CIFGEN(n->ul[scope_index].rptr)->rectype == CIF_F90_ENTRY && 01190 CIFF90ENTRY(n->ul[scope_index].rptr)->etype == CIF_F90_ET_MODULE) { 01191 int mod; 01192 01193 for (mod = 0; mod < modid_current; mod++) { 01194 01195 if (modids[mod].modid == 01196 CIFF90ENTRY(n->ul[scope_index].rptr)->symid) { 01197 CIFF90ENTRY(n->ul[scope_index].rptr)->direct = modids[mod].direct; 01198 break; 01199 } 01200 } 01201 } 01202 01203 if ((ret = 01204 Cif_Putrecord(outfd, 01205 n->ul[scope_index].rptr)) < 0) { 01206 (void) fprintf (stderr, 01207 "cif_lines: error writing output file %s - %s\n", 01208 outfile, Cif_Errstring(ret)); 01209 exit (ret); 01210 } 01211 } 01212 else 01213 break; 01214 } 01215 } 01216 } 01217 01218 CIFGEN(w->ul[inner_index].rptr)->rectype = 0; 01219 01220 } 01221 01222 *pscope_index = scope_index; 01223 01224 } 01225 01226 01227 /* -------------------------------------------------------------------------- 01228 * Sort the records as selected and print 'em out. 01229 * -------------------------------------------------------------------------- */ 01230 static void print_records (struct record *w, struct record *n) 01231 { 01232 int i, ret, scope_index; 01233 int scope_count = 0; 01234 int save_scope_index = 0; 01235 01236 (void) qsort ((char *)w->ul, w->ulcur, sizeof(struct unit_list), (int(*)()) comp_id); 01237 (void) qsort ((char *)n->ul, n->ulcur, sizeof(struct unit_list), (int(*)()) comp_scope); 01238 01239 /* Find the unit record first */ 01240 for (i=0, scope_index = 0; i < w->ulcur; i++) { 01241 if ((w->ul[i].rptr)->rectype == CIF_UNIT) { 01242 01243 if (get_fid(w->ul[i].rptr) > global_srcfid) { 01244 01245 /* put out the unit record */ 01246 if ((ret = Cif_Putrecord(outfd, w->ul[i].rptr)) < 0) { 01247 (void) fprintf (stderr, 01248 "cif_lines: error writing output file %s - %s\n", 01249 outfile, Cif_Errstring(ret)); 01250 exit (ret); 01251 } 01252 01253 (w->ul[i].rptr)->rectype = 0; 01254 01255 /* print the records that exist within the include file 01256 * within this unit */ 01257 print_include_records(w, n, i, -1, &scope_index); 01258 } 01259 break; 01260 } 01261 } 01262 01263 for (i=0, scope_index = 0; i < w->ulcur; i++) { 01264 01265 /* 01266 * Any non-local (ie in a different file) objects will 01267 * have been printed out after their matching cif_include line 01268 */ 01269 #ifdef notdef 01270 if (get_fid(w->ul[i].rptr) > global_srcfid) { 01271 if ((w->ul[i].rptr)->rectype == CIF_UNIT) { 01272 01273 /* put out the unit record */ 01274 if ((ret = Cif_Putrecord(outfd, w->ul[i].rptr)) < 0) { 01275 (void) fprintf (stderr, 01276 "cif_lines: error writing output file %s - %s\n", 01277 outfile, Cif_Errstring(ret)); 01278 exit (ret); 01279 } 01280 /* print the records that exist within the include file 01281 * within this unit */ 01282 print_include_records(w, n, i, -1, &scope_index); 01283 } 01284 break; 01285 } 01286 #endif 01287 /* 01288 * Not sure why there would ever be a zero, but just in case, 01289 * as cif_putrecord would exit if it found a zero rectype 01290 */ 01291 if ((w->ul[i].rptr)->rectype == 0) 01292 continue; 01293 01294 /* 01295 * Check for two usages at the same point for the same symid; 01296 * remove the first, it is a duplicate of the second. This is 01297 * a workaround to a compiler problem 01298 */ 01299 if (CIFGEN(w->ul[i].rptr)->rectype == CIF_USAGE && 01300 i < w->ulcur - 1 && 01301 CIFGEN(w->ul[i+1].rptr)->rectype == CIF_USAGE) { 01302 01303 if (CIFUSAGE(w->ul[i].rptr)->use->line == CIFUSAGE(w->ul[i+1].rptr)->use->line && 01304 CIFUSAGE(w->ul[i].rptr)->use->cpos == CIFUSAGE(w->ul[i+1].rptr)->use->cpos && 01305 CIFUSAGE(w->ul[i].rptr)->symid == CIFUSAGE(w->ul[i+1].rptr)->symid) { 01306 01307 if (CIFUSAGE(w->ul[i].rptr)->use->utype == CIF_F90_OB_MODIFIED && 01308 CIFUSAGE(w->ul[i+1].rptr)->use->utype == CIF_F90_OB_OPER_ARG 01309 01310 ) 01311 CIFUSAGE(w->ul[i+1].rptr)->use->utype = CIF_F90_OB_MODIFIED_ASN; 01312 continue; 01313 } 01314 } 01315 01316 if ((ret = Cif_Putrecord(outfd, w->ul[i].rptr)) < 0) { 01317 (void) fprintf (stderr, 01318 "cif_lines: error writing output file %s - %s\n", 01319 outfile, Cif_Errstring(ret)); 01320 exit (ret); 01321 } 01322 else 01323 01324 if (CIFGEN(w->ul[i].rptr)->rectype == CIF_INCLUDE) { 01325 print_include_records(w, n, i, i, &scope_index); 01326 } 01327 else { 01328 if (CIFGEN(w->ul[i].rptr)->rectype ==CIF_F90_BEGIN_SCOPE || 01329 global_scope_found == 0 ) { 01330 01331 /* Look for the entry matching this scope and 01332 * make sure that it comes out first 01333 */ 01334 01335 save_scope_index = scope_index; 01336 for (; scope_index < n->ulcur; scope_index++) { 01337 if (get_scope(n->ul[scope_index].rptr) != 01338 CIFF90BS(w->ul[i].rptr)->scopeid || 01339 global_scope_found == 0) { 01340 continue; 01341 } 01342 01343 if (CIFGEN(n->ul[scope_index].rptr)->rectype != 01344 CIF_F90_ENTRY) 01345 break; 01346 01347 if (CIFF90ENTRY(n->ul[scope_index].rptr)->symid == 01348 CIFF90BS(w->ul[i].rptr)->symid) { 01349 01350 01351 if ((ret = 01352 Cif_Putrecord(outfd, 01353 n->ul[scope_index].rptr)) < 0) { 01354 (void) fprintf (stderr, 01355 "cif_lines: error writing output file %s - %s\n", 01356 outfile, Cif_Errstring(ret)); 01357 exit (ret); 01358 } 01359 CIFGEN(n->ul[scope_index].rptr)->rectype = 0; 01360 break; 01361 } 01362 } 01363 scope_index = save_scope_index; 01364 01365 for (; scope_index < n->ulcur; scope_index++) { 01366 01367 if (CIFGEN(n->ul[scope_index].rptr)->rectype == 0) 01368 continue; 01369 01370 if (get_scope(n->ul[scope_index].rptr) < CIFF90BS(w->ul[i].rptr)->scopeid) 01371 continue; 01372 01373 if (get_scope(n->ul[scope_index].rptr) == 01374 CIFF90BS(w->ul[i].rptr)->scopeid || 01375 global_scope_found == 0) { 01376 01377 if (get_scope(n->ul[scope_index].rptr) == 0) 01378 continue; 01379 01380 /* 01381 * For module entries, look to see if they are 01382 * used directly, or indirectly 01383 */ 01384 if (CIFGEN(n->ul[scope_index].rptr)->rectype == CIF_F90_ENTRY && 01385 CIFF90ENTRY(n->ul[scope_index].rptr)->etype == CIF_F90_ET_MODULE) { 01386 int mod; 01387 01388 01389 for (mod = 0; mod < modid_current; mod++) { 01390 01391 if (modids[mod].modid == 01392 CIFF90ENTRY(n->ul[scope_index].rptr)->symid) { 01393 CIFF90ENTRY(n->ul[scope_index].rptr)->direct = modids[mod].direct; 01394 break; 01395 } 01396 } 01397 } 01398 01399 if ((ret = 01400 Cif_Putrecord(outfd, 01401 n->ul[scope_index].rptr)) < 0) { 01402 (void) fprintf (stderr, 01403 "cif_lines: error writing output file %s - %s\n", 01404 outfile, Cif_Errstring(ret)); 01405 exit (ret); 01406 } 01407 } 01408 else { 01409 break; 01410 } 01411 } 01412 } 01413 } 01414 } 01415 } 01416 01417 01418 /* -------------------------------------------------------------------------- 01419 * Sort the header records and write them out 01420 * -------------------------------------------------------------------------- */ 01421 static void print_header_records (struct record *l) 01422 { 01423 int i, ret; 01424 01425 (void) qsort ((char *)l->ul, l->ulcur, sizeof(struct unit_list), (int(*)()) comp_rtype); 01426 for (i=0; i < l->ulcur; i++) { 01427 01428 /* 01429 * We are writing a lines mode binary file, so set the bintype 01430 * to show that lines wrote this cif file 01431 */ 01432 01433 if (l->ul[i].rptr->rectype == CIF_CIFHDR) { 01434 CIFHDR(l->ul[i].rptr)->bintype = CIF_FORM_LINES; 01435 } 01436 01437 if ((ret = Cif_Putrecord(outfd, l->ul[i].rptr)) < 0) { 01438 (void) fprintf (stderr, 01439 "cif_lines: error writing output file %s - %s\n", 01440 outfile, Cif_Errstring(ret)); 01441 exit (ret); 01442 } 01443 } 01444 } 01445 01446 /* -------------------------------------------------------------------------- 01447 * Extract the symbol id from a record. Return 0 if the record doesn't 01448 * contain a symbol id. 01449 * -------------------------------------------------------------------------- */ 01450 static int get_id ( 01451 struct Cif_generic *rptr) 01452 { 01453 01454 int id; 01455 01456 switch (rptr->rectype) { 01457 case CIF_CALLSITE: 01458 id = CIFCS(rptr)->entryid; 01459 break; 01460 case CIF_COMBLK: 01461 id = CIFCB(rptr)->symid; 01462 break; 01463 case CIF_CONST: 01464 id = CIFCON(rptr)->symid; 01465 break; 01466 case CIF_ENTRY: 01467 id = CIFENTRY(rptr)->symid; 01468 break; 01469 case CIF_LABEL: 01470 id = CIFLABEL(rptr)->symid; 01471 break; 01472 case CIF_NAMELIST: 01473 id = CIFNL(rptr)->symid; 01474 break; 01475 case CIF_OBJECT: 01476 id = CIFOBJ(rptr)->symid; 01477 break; 01478 case CIF_USAGE: 01479 id = CIFUSAGE(rptr)->symid; 01480 break; 01481 01482 #if CIF_VERSION != 1 01483 case CIF_F90_CALLSITE: 01484 id = CIFF90CS(rptr)->entryid; 01485 break; 01486 case CIF_F90_COMBLK: 01487 id = CIFF90CB(rptr)->symid; 01488 break; 01489 case CIF_F90_CONST: 01490 id = CIFF90CON(rptr)->symid; 01491 break; 01492 case CIF_F90_ENTRY: 01493 id = CIFF90ENTRY(rptr)->symid; 01494 break; 01495 case CIF_F90_LABEL: 01496 id = CIFF90LABEL(rptr)->symid; 01497 break; 01498 case CIF_F90_NAMELIST: 01499 id = CIFF90NL(rptr)->symid; 01500 break; 01501 case CIF_F90_OBJECT: 01502 id = CIFF90OBJ(rptr)->symid; 01503 break; 01504 case CIF_F90_DERIVED_TYPE: 01505 id = CIFF90DTYPE(rptr)->symid; 01506 break; 01507 case CIF_F90_BEGIN_SCOPE: 01508 id = CIFF90BS(rptr)->symid; 01509 global_scope_found = 1; 01510 break; 01511 case CIF_F90_USE_MODULE: 01512 id = CIFF90USE(rptr)->modid; 01513 break; 01514 case CIF_F90_RENAME: 01515 id = CIFF90RN(rptr)->modid; 01516 break; 01517 case CIF_F90_INT_BLOCK: 01518 id = CIFF90IB(rptr)->intid; 01519 break; 01520 01521 case CIF_GEOMETRY: 01522 id = CIFGEOM(rptr)->geomid; 01523 break; 01524 01525 01526 case CIF_C_LINT_DIRECTIVE: 01527 id = CIFCLDIR(rptr)->objid; 01528 break; 01529 case CIF_C_MACRO_DEF: 01530 id = CIFCMDEF(rptr)->symid; 01531 break; 01532 case CIF_C_MACRO_UNDEF: 01533 id = CIFCMUDEF(rptr)->symid; 01534 break; 01535 case CIF_C_MACRO_USAGE: 01536 id = CIFCMUSE(rptr)->symid; 01537 break; 01538 case CIF_C_ENTRY_END: 01539 id = CIFCEEND(rptr)->symid; 01540 break; 01541 01542 #endif /* CIF_VERSION != 1 */ 01543 01544 01545 #if CIF_VERSION == 3 01546 01547 case CIF_SRC_POS: 01548 id = CIFSPOS(rptr)->symid; 01549 break; 01550 01551 #endif 01552 01553 case CIF_C_TAG: 01554 id = CIFCTAG(rptr)->tagid; 01555 break; 01556 case CIF_C_CONST: 01557 id = CIFCCON(rptr)->symid; 01558 break; 01559 case CIF_C_ENTRY: 01560 id = CIFCENTRY(rptr)->symid; 01561 break; 01562 case CIF_C_OBJECT: 01563 id = CIFCOBJ(rptr)->symid; 01564 break; 01565 default: 01566 id = 0; 01567 } 01568 return (id); 01569 01570 } 01571 01572 01573 /* -------------------------------------------------------------------------- 01574 * Extract the line number from a record. Return -? if the record doesn't 01575 * contain a line number. 01576 * ------------------------------------------------------------------------- */ 01577 static int get_line ( 01578 struct Cif_generic *rptr) 01579 { 01580 int id; 01581 01582 switch (rptr->rectype) { 01583 case CIF_UNIT: 01584 id = CIFUNIT(rptr)->line; 01585 break; 01586 case CIF_ENDUNIT: 01587 id = CIFENDU(rptr)->line; 01588 break; 01589 case CIF_CALLSITE: 01590 id = CIFCS(rptr)->line; 01591 break; 01592 case CIF_LOOP: 01593 id = CIFLOOP(rptr)->strline; 01594 break; 01595 case CIF_COMBLK: 01596 id = -1; 01597 break; 01598 case CIF_CONST: 01599 id = -2; 01600 break; 01601 case CIF_ENTRY: 01602 id = -3; 01603 break; 01604 case CIF_LABEL: 01605 id = -4; 01606 break; 01607 case CIF_MESSAGE: 01608 id = CIFMSG(rptr)->fline;; 01609 break; 01610 case CIF_ND_MSG: 01611 id = CIFNMSG(rptr)->fline;; 01612 break; 01613 case CIF_NAMELIST: 01614 id = -5; 01615 break; 01616 case CIF_OBJECT: 01617 id = -6; 01618 break; 01619 case CIF_USAGE: 01620 id = CIFUSAGE(rptr)->use->line; 01621 break; 01622 case CIF_STMT_TYPE: 01623 id = CIFSTMT(rptr)->line; 01624 break; 01625 case CIF_INCLUDE: 01626 id = CIFINC(rptr)->line; 01627 break; 01628 01629 #if CIF_VERSION != 1 01630 case CIF_CDIR: 01631 id = CIFCDIR(rptr)->line; 01632 break; 01633 case CIF_CDIR_DOSHARED: 01634 id = CIFCDIRDO(rptr)->line; 01635 break; 01636 case CIF_CONTINUATION: 01637 id = CIFCONT(rptr)->line; 01638 break; 01639 01640 01641 case CIF_F90_CALLSITE: 01642 id = CIFF90CS(rptr)->line; 01643 break; 01644 case CIF_F90_COMBLK: 01645 id = -7; 01646 break; 01647 case CIF_F90_LOOP: 01648 id = CIFF90LOOP(rptr)->strline; 01649 break; 01650 case CIF_F90_ENTRY: 01651 id = -8; 01652 break; 01653 case CIF_F90_CONST: 01654 id = CIFF90CON(rptr)->strline; 01655 break; 01656 case CIF_F90_LABEL: 01657 id = -10; 01658 break; 01659 case CIF_F90_NAMELIST: 01660 id = -11; 01661 break; 01662 case CIF_F90_OBJECT: 01663 id = -12; 01664 break; 01665 case CIF_F90_DERIVED_TYPE: 01666 id = -13; 01667 break; 01668 case CIF_F90_BEGIN_SCOPE: 01669 id = CIFF90BS(rptr)->line; 01670 global_scope_found = 1; 01671 break; 01672 case CIF_F90_END_SCOPE: 01673 id = CIFF90ES(rptr)->line; 01674 break; 01675 case CIF_F90_SCOPE_INFO: 01676 id = -14; 01677 break; 01678 case CIF_F90_USE_MODULE: 01679 id = -15; 01680 break; 01681 case CIF_F90_RENAME: 01682 id = -16; 01683 break; 01684 case CIF_F90_INT_BLOCK: 01685 id = -17; 01686 break; 01687 01688 case CIF_GEOMETRY: 01689 id = -18; 01690 break; 01691 01692 01693 case CIF_C_LINT_DIRECTIVE: 01694 id = CIFCLDIR(rptr)->strline; 01695 break; 01696 case CIF_C_MACRO_DEF: 01697 id = CIFCMDEF(rptr)->strline; 01698 break; 01699 case CIF_C_MACRO_UNDEF: 01700 id = CIFCMUDEF(rptr)->line; 01701 break; 01702 case CIF_C_MACRO_USAGE: 01703 id = CIFCMUSE(rptr)->strline; 01704 break; 01705 case CIF_C_ENTRY_END: 01706 id = CIFCEEND(rptr)->strline; 01707 break; 01708 01709 case CIF_BE_NODE: 01710 id = -19; 01711 break; 01712 01713 case CIF_BE_FID: 01714 id = -19; 01715 break; 01716 01717 #endif /* CIF_VERSION != 1 */ 01718 01719 #if CIF_VERSION >= 3 01720 01721 case CIF_CC_TYPE: 01722 id = -24; 01723 break; 01724 01725 case CIF_CC_ENTRY: 01726 id = CIFCCENT(rptr)->sline; 01727 break; 01728 01729 case CIF_CC_OBJ: 01730 id = -24; 01731 break; 01732 01733 case CIF_CC_SUBTYPE: 01734 id = -24; 01735 break; 01736 01737 case CIF_CC_ENUM: 01738 id = -24; 01739 break; 01740 01741 case CIF_CC_EXPR: 01742 id = CIFCCEXPR(rptr)->line; 01743 break; 01744 01745 case CIF_SRC_POS: 01746 id = CIFSPOS(rptr)->sline; 01747 break; 01748 01749 #endif 01750 01751 case CIF_C_TAG: 01752 id = -20; 01753 break; 01754 case CIF_C_CONST: 01755 id = -21; 01756 break; 01757 case CIF_C_MESSAGE: 01758 id = CIFCMSG(rptr)->fline; 01759 break; 01760 case CIF_C_ENTRY: 01761 id = -22; 01762 break; 01763 case CIF_C_OBJECT: 01764 id = -23; 01765 break; 01766 default: 01767 id = 0; 01768 } 01769 return (id); 01770 } 01771 01772 01773 /* -------------------------------------------------------------------------- 01774 * Extract the fid from a record. Return -? if the record doesn't 01775 * contain a fid. 01776 * ------------------------------------------------------------------------- */ 01777 static int get_fid ( 01778 struct Cif_generic *rptr) 01779 { 01780 int id; 01781 01782 switch (rptr->rectype) { 01783 case CIF_UNIT: 01784 id = CIFUNIT(rptr)->fid; 01785 break; 01786 case CIF_ENDUNIT: 01787 id = CIFENDU(rptr)->fid; 01788 break; 01789 case CIF_CALLSITE: 01790 id = CIFCS(rptr)->fid; 01791 break; 01792 case CIF_COMBLK: 01793 id = -1; 01794 break; 01795 case CIF_CONST: 01796 id = -2; 01797 break; 01798 case CIF_ENTRY: 01799 id = -3; 01800 break; 01801 case CIF_LOOP: 01802 id = CIFLOOP(rptr)->sfid; 01803 break; 01804 case CIF_LABEL: 01805 id = -4; 01806 break; 01807 case CIF_MESSAGE: 01808 id = CIFMSG(rptr)->fid; 01809 break; 01810 case CIF_ND_MSG: 01811 id = CIFNMSG(rptr)->fid; 01812 break; 01813 case CIF_NAMELIST: 01814 id = -5; 01815 break; 01816 case CIF_OBJECT: 01817 id = -6; 01818 break; 01819 case CIF_USAGE: 01820 id = CIFUSAGE(rptr)->use->fid; 01821 break; 01822 case CIF_STMT_TYPE: 01823 id = CIFSTMT(rptr)->fid; 01824 break; 01825 case CIF_INCLUDE: 01826 id = CIFINC(rptr)->srcid; 01827 break; 01828 01829 #if CIF_VERSION != 1 01830 case CIF_CDIR: 01831 id = CIFCDIR(rptr)->fid; 01832 break; 01833 case CIF_CDIR_DOSHARED: 01834 id = CIFCDIRDO(rptr)->fid; 01835 break; 01836 case CIF_CONTINUATION: 01837 id = CIFCONT(rptr)->fid; 01838 break; 01839 01840 01841 case CIF_F90_CALLSITE: 01842 id = CIFF90CS(rptr)->fid; 01843 break; 01844 case CIF_F90_COMBLK: 01845 id = -7; 01846 break; 01847 case CIF_F90_LOOP: 01848 id = CIFF90LOOP(rptr)->sfid; 01849 break; 01850 case CIF_F90_ENTRY: 01851 id = -8; 01852 break; 01853 case CIF_F90_CONST: 01854 id = CIFF90CON(rptr)->fid; 01855 break; 01856 case CIF_F90_LABEL: 01857 id = -10; 01858 break; 01859 case CIF_F90_NAMELIST: 01860 id = -11; 01861 break; 01862 case CIF_F90_OBJECT: 01863 id = -12; 01864 break; 01865 case CIF_F90_DERIVED_TYPE: 01866 id = -13; 01867 break; 01868 case CIF_F90_BEGIN_SCOPE: 01869 id = CIFF90BS(rptr)->fid; 01870 global_scope_found = 1; 01871 break; 01872 case CIF_F90_END_SCOPE: 01873 id = CIFF90ES(rptr)->fid; 01874 break; 01875 case CIF_F90_SCOPE_INFO: 01876 id = -14; 01877 break; 01878 case CIF_F90_USE_MODULE: 01879 id = -15; 01880 break; 01881 case CIF_F90_RENAME: 01882 id = -16; 01883 break; 01884 case CIF_F90_INT_BLOCK: 01885 id = -17; 01886 break; 01887 01888 case CIF_GEOMETRY: 01889 id = -18; 01890 break; 01891 01892 01893 case CIF_C_LINT_DIRECTIVE: 01894 id = CIFCLDIR(rptr)->fid; 01895 break; 01896 case CIF_C_MACRO_DEF: 01897 id = CIFCMDEF(rptr)->fid; 01898 break; 01899 case CIF_C_MACRO_UNDEF: 01900 id = CIFCMUDEF(rptr)->fid; 01901 break; 01902 case CIF_C_MACRO_USAGE: 01903 id = CIFCMUSE(rptr)->fid; 01904 break; 01905 case CIF_C_ENTRY_END: 01906 id = CIFCEEND(rptr)->fid; 01907 break; 01908 01909 case CIF_BE_NODE: 01910 id = -19; 01911 break; 01912 01913 case CIF_BE_FID: 01914 id = -19; 01915 break; 01916 01917 #endif 01918 01919 #if CIF_VERSION == 3 01920 01921 case CIF_CC_TYPE: 01922 id = -24; 01923 break; 01924 01925 case CIF_CC_ENTRY: 01926 id = CIFCCENT(rptr)->sfid; 01927 break; 01928 01929 case CIF_CC_OBJ: 01930 id = -24; 01931 break; 01932 01933 case CIF_CC_SUBTYPE: 01934 id = -24; 01935 break; 01936 01937 case CIF_CC_ENUM: 01938 id = -24; 01939 break; 01940 01941 case CIF_CC_EXPR: 01942 id = CIFCCEXPR(rptr)->fid; 01943 break; 01944 01945 case CIF_SRC_POS: 01946 id = CIFSPOS(rptr)->fid; 01947 break; 01948 01949 #endif 01950 01951 case CIF_C_TAG: 01952 id = -20; 01953 break; 01954 case CIF_C_CONST: 01955 id = -21; 01956 break; 01957 case CIF_C_MESSAGE: 01958 id = CIFCMSG(rptr)->fid; 01959 break; 01960 case CIF_C_ENTRY: 01961 id = -22; 01962 break; 01963 case CIF_C_OBJECT: 01964 id = -23; 01965 break; 01966 default: 01967 id = 0; 01968 } 01969 return (id); 01970 } 01971 01972 01973 01974 01975 01976 /* -------------------------------------------------------------------------- 01977 * Extract the scope from a record. Return 0 if the record doesn't 01978 * contain a scope 01979 * ------------------------------------------------------------------------- */ 01980 static int get_scope ( 01981 struct Cif_generic *rptr) 01982 { 01983 int id; 01984 01985 switch (rptr->rectype) { 01986 01987 #if CIF_VERSION != 1 01988 01989 case CIF_F90_COMBLK: 01990 id = CIFF90CB(rptr)->scopeid; 01991 break; 01992 case CIF_F90_LOOP: 01993 id = CIFF90LOOP(rptr)->scopeid; 01994 break; 01995 case CIF_F90_ENTRY: 01996 id = CIFF90ENTRY(rptr)->scopeid; 01997 break; 01998 case CIF_F90_LABEL: 01999 id = CIFF90LABEL(rptr)->scopeid; 02000 break; 02001 case CIF_F90_NAMELIST: 02002 id = CIFF90NL(rptr)->scopeid; 02003 break; 02004 case CIF_F90_OBJECT: 02005 id = CIFF90OBJ(rptr)->scopeid; 02006 break; 02007 case CIF_F90_DERIVED_TYPE: 02008 id = CIFF90DTYPE(rptr)->scopeid; 02009 break; 02010 case CIF_F90_BEGIN_SCOPE: 02011 id = CIFF90BS(rptr)->scopeid; 02012 global_scope_found = 1; 02013 break; 02014 case CIF_F90_END_SCOPE: 02015 id = CIFF90ES(rptr)->scopeid; 02016 break; 02017 case CIF_F90_SCOPE_INFO: 02018 id = CIFF90SI(rptr)->scopeid; 02019 break; 02020 case CIF_F90_INT_BLOCK: 02021 id = CIFF90IB(rptr)->scopeid; 02022 break; 02023 case CIF_F90_RENAME: 02024 id = CIFF90RN(rptr)->scopeid; 02025 break; 02026 case CIF_F90_CONST: 02027 id = CIFF90CON(rptr)->scopeid; 02028 break; 02029 case CIF_F90_USE_MODULE: 02030 id = global_last_scope; /* use_modules belong to the last 02031 scope block seen; this really 02032 should be a field in the use_module 02033 record, but it isn't so this 02034 will have to do for now */ 02035 break; 02036 02037 #endif 02038 02039 case CIF_C_ENTRY: 02040 id = CIFCENTRY(rptr)->scope; 02041 break; 02042 default: 02043 id = -1; 02044 } 02045 return (id); 02046 } 02047 02048 02049 /* -------------------------------------------------------------------------- 02050 * Extract the type from a record. Moves some records higher than 02051 * they should be to bump them sooner in the output 02052 * ------------------------------------------------------------------------- */ 02053 static int get_type ( 02054 struct Cif_generic *rptr) 02055 { 02056 int id; 02057 02058 switch (rptr->rectype) { 02059 02060 #if CIF_VERSION != 1 02061 case CIF_F90_ENTRY: 02062 id = -10; 02063 break; 02064 #endif 02065 02066 case CIF_ENTRY: 02067 id = -10; 02068 break; 02069 02070 default: 02071 id = rptr->rectype; 02072 break; 02073 } 02074 02075 return(id); 02076 } 02077 02078 02079 /* -------------------------------------------------------------------------- 02080 * Extract the scope from a record. Return 99999 if the record doesn't 02081 * contain a scope such that they come after any records with a scope 02082 * ------------------------------------------------------------------------- */ 02083 static int get_adjusted_scope ( 02084 struct Cif_generic *rptr) 02085 { 02086 int id; 02087 02088 switch (rptr->rectype) { 02089 02090 #if CIF_VERSION != 1 02091 02092 case CIF_F90_COMBLK: 02093 id = CIFF90CB(rptr)->scopeid; 02094 break; 02095 case CIF_F90_LOOP: 02096 id = CIFF90LOOP(rptr)->scopeid; 02097 break; 02098 case CIF_F90_ENTRY: 02099 id = CIFF90ENTRY(rptr)->scopeid; 02100 break; 02101 case CIF_F90_LABEL: 02102 id = CIFF90LABEL(rptr)->scopeid; 02103 break; 02104 case CIF_F90_NAMELIST: 02105 id = CIFF90NL(rptr)->scopeid; 02106 break; 02107 case CIF_F90_OBJECT: 02108 id = CIFF90OBJ(rptr)->scopeid; 02109 break; 02110 case CIF_F90_DERIVED_TYPE: 02111 id = CIFF90DTYPE(rptr)->scopeid; 02112 break; 02113 case CIF_F90_BEGIN_SCOPE: 02114 id = CIFF90BS(rptr)->scopeid; 02115 global_scope_found = 1; 02116 break; 02117 case CIF_F90_END_SCOPE: 02118 id = CIFF90ES(rptr)->scopeid; 02119 break; 02120 case CIF_F90_SCOPE_INFO: 02121 id = CIFF90SI(rptr)->scopeid; 02122 break; 02123 case CIF_F90_INT_BLOCK: 02124 id = CIFF90IB(rptr)->scopeid; 02125 break; 02126 case CIF_F90_RENAME: 02127 id = CIFF90RN(rptr)->scopeid; 02128 break; 02129 case CIF_F90_CONST: 02130 id = CIFF90CON(rptr)->scopeid; 02131 break; 02132 case CIF_F90_USE_MODULE: 02133 id = global_last_scope; /* use_modules belong to the last 02134 scope block seen; this really 02135 should be a field in the use_module 02136 record, but it isn't so this 02137 will have to do for now */ 02138 break; 02139 02140 #endif 02141 02142 case CIF_C_ENTRY: 02143 id = CIFCENTRY(rptr)->scope; 02144 break; 02145 default: 02146 id = 99999; 02147 } 02148 return (id); 02149 } 02150 02151 02152 02153 /* -------------------------------------------------------------------------- 02154 * Extract the cpos number from a record. Return 0 if the record doesn't 02155 * contain a cpos. 02156 * ------------------------------------------------------------------------- */ 02157 static int get_cpos ( 02158 struct Cif_generic *rptr) 02159 { 02160 int id; 02161 02162 switch (rptr->rectype) { 02163 case CIF_UNIT: 02164 id = CIFUNIT(rptr)->cpos - 2; /* must come first, before 02165 stmt's and scopes at same 02166 line and cpos */ 02167 break; 02168 case CIF_ENDUNIT: 02169 id = CIFENDU(rptr)->cpos + 2; /* must come last, after stmt's 02170 and end scopes at same line 02171 and cpos */ 02172 break; 02173 case CIF_CALLSITE: 02174 id = CIFCS(rptr)->cpos; 02175 break; 02176 case CIF_MESSAGE: 02177 id = CIFMSG(rptr)->cpos;; 02178 break; 02179 case CIF_ND_MSG: 02180 id = CIFNMSG(rptr)->cpos;; 02181 break; 02182 case CIF_USAGE: 02183 id = CIFUSAGE(rptr)->use->cpos; 02184 break; 02185 case CIF_STMT_TYPE: 02186 id = CIFSTMT(rptr)->cpos; 02187 break; 02188 case CIF_INCLUDE: 02189 id = CIFINC(rptr)->cpos; 02190 break; 02191 02192 #if CIF_VERSION != 1 02193 case CIF_CDIR: 02194 id = CIFCDIR(rptr)->cpos; 02195 break; 02196 case CIF_CDIR_DOSHARED: 02197 id = CIFCDIRDO(rptr)->cpos; 02198 break; 02199 case CIF_CONTINUATION: 02200 id = CIFCONT(rptr)->cpos; 02201 break; 02202 02203 02204 case CIF_F90_CALLSITE: 02205 id = CIFF90CS(rptr)->cpos; 02206 break; 02207 case CIF_F90_BEGIN_SCOPE: 02208 id = CIFF90BS(rptr)->cpos - 1; /* ensure that this 02209 occurs before all other 02210 stmts at this line/cpos */ 02211 global_scope_found = 1; 02212 break; 02213 case CIF_F90_END_SCOPE: 02214 id = CIFF90ES(rptr)->cpos + 1; /* as above, only after */ 02215 break; 02216 02217 case CIF_C_LINT_DIRECTIVE: 02218 id = CIFCLDIR(rptr)->strpos; 02219 break; 02220 case CIF_C_MACRO_DEF: 02221 id = CIFCMDEF(rptr)->strpos; 02222 break; 02223 case CIF_C_MACRO_UNDEF: 02224 id = CIFCMUDEF(rptr)->cpos; 02225 break; 02226 case CIF_C_MACRO_USAGE: 02227 id = CIFCMUSE(rptr)->strpos; 02228 break; 02229 02230 #endif 02231 02232 02233 #if CIF_VERSION == 3 02234 02235 case CIF_SRC_POS: 02236 id = CIFSPOS(rptr)->scol; 02237 break; 02238 02239 #endif 02240 02241 default: 02242 id = 0; 02243 } 02244 return (id); 02245 02246 } 02247