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 static char USMID[] = "@(#) libcif/cifgetrec.c 30.18 06/27/97 14:34:02"; 00038 00039 00040 /* ------------------------------------------------------------------------- 00041 * CIF record retrieval and conversion routines 00042 * Tabs are set up to be read with tab spacing = 3 00043 * -------------------------------------------------------------------------- 00044 */ 00045 00046 #define CIF_VERSION 3 00047 00048 #ifdef _ABSOFT 00049 #include "cif.h" 00050 #else 00051 #include <cif.h> 00052 #endif 00053 00054 #include <stdlib.h> 00055 #include <memory.h> 00056 #include <stdio.h> 00057 #include <string.h> 00058 00059 #include "cif_int.h" 00060 00061 /* --- function pointer array - ASCII format conversion routines --- */ 00062 00063 static int ascii_callsite __((struct Cif_callsite *)); 00064 static int ascii_cifhdr __((struct Cif_cifhdr *)); 00065 static int ascii_comblk __((struct Cif_comblk *)); 00066 static int ascii_const __((struct Cif_const *)); 00067 static int ascii_entry __((struct Cif_entry *)); 00068 static int ascii_file __((struct Cif_file *)); 00069 static int ascii_loop __((struct Cif_loop *)); 00070 static int ascii_include __((struct Cif_include *)); 00071 static int ascii_label __((struct Cif_label *)); 00072 static int ascii_message __((struct Cif_message *)); 00073 static int ascii_namelist __((struct Cif_namelist *)); 00074 static int ascii_object __((struct Cif_object *)); 00075 static int ascii_srcfile __((struct Cif_srcfile *)); 00076 static int ascii_summary __((struct Cif_summary *)); 00077 static int ascii_unit __((struct Cif_unit *)); 00078 static int ascii_endunit __((struct Cif_endunit *)); 00079 static int ascii_usage __((struct Cif_usage *)); 00080 static int ascii_f90_usage __((struct Cif_usage *)); 00081 static int ascii_nd_msg __((struct Cif_nd_msg *)); 00082 static int ascii_edopts __((struct Cif_edopts *)); 00083 static int ascii_mach_char __((struct Cif_mach_char *)); 00084 static int ascii_misc_opts __((struct Cif_misc_opts *)); 00085 static int ascii_opt_opts __((struct Cif_opt_opts *)); 00086 static int ascii_stmt_type __((struct Cif_stmt_type *)); 00087 static int ascii_transform __((struct Cif_transform *)); 00088 00089 static int ascii_cdir __((struct Cif_cdir *)); 00090 static int ascii_cdir_doshared __((struct Cif_cdir_doshared *)); 00091 static int ascii_geometry __((struct Cif_geometry *)); 00092 static int ascii_continuation __((struct Cif_continuation *)); 00093 00094 static int ascii_c_tag __((struct Cif_c_tag *)); 00095 static int ascii_c_opts __((struct Cif_c_opts *)); 00096 static int ascii_c_message __((struct Cif_c_message *)); 00097 static int ascii_c_const __((struct Cif_c_const *)); 00098 static int ascii_c_entry __((struct Cif_c_entry *)); 00099 static int ascii_c_object __((struct Cif_c_object *)); 00100 static int ascii_c_entry_end __((struct Cif_c_entry_end *)); 00101 static int ascii_c_lint_directive __((struct Cif_c_lint_directive *)); 00102 static int ascii_c_macro_def __((struct Cif_c_macro_def *)); 00103 static int ascii_c_macro_undef __((struct Cif_c_macro_undef *)); 00104 static int ascii_c_macro_usage __((struct Cif_c_macro_usage *)); 00105 00106 #ifndef CRAY2 00107 static int ascii_f90_callsite __((struct Cif_f90_callsite *)); 00108 static int ascii_f90_comblk __((struct Cif_f90_comblk *)); 00109 static int ascii_f90_const __((struct Cif_f90_const *)); 00110 static int ascii_f90_entry __((struct Cif_f90_entry *)); 00111 static int ascii_f90_loop __((struct Cif_f90_loop *)); 00112 static int ascii_f90_derived_type __((struct Cif_f90_derived_type *)); 00113 static int ascii_f90_label __((struct Cif_f90_label *)); 00114 static int ascii_f90_namelist __((struct Cif_f90_namelist *)); 00115 static int ascii_f90_object __((struct Cif_f90_object *)); 00116 static int ascii_f90_misc_opts __((struct Cif_f90_misc_opts *)); 00117 static int ascii_f90_opt_opts __((struct Cif_f90_opt_opts *)); 00118 static int ascii_f90_begin_scope __((struct Cif_f90_begin_scope *)); 00119 static int ascii_f90_end_scope __((struct Cif_f90_end_scope *)); 00120 static int ascii_f90_scope_info __((struct Cif_f90_scope_info *)); 00121 static int ascii_f90_use_module __((struct Cif_f90_use_module *)); 00122 static int ascii_f90_rename __((struct Cif_f90_rename *)); 00123 static int ascii_f90_int_block __((struct Cif_f90_int_block *)); 00124 static int ascii_f90_vectorization __((struct Cif_f90_vectorization *)); 00125 00126 static int ascii_BE_node __((struct Cif_BE_node *)); 00127 static int ascii_BE_fid __((struct Cif_BE_fid *)); 00128 static int ascii_cc_type __((struct Cif_cc_type *)); 00129 static int ascii_cc_entry __((struct Cif_cc_entry *)); 00130 static int ascii_cc_obj __((struct Cif_cc_obj *)); 00131 static int ascii_cc_subtype __((struct Cif_cc_subtype *)); 00132 static int ascii_cc_enum __((struct Cif_cc_enum *)); 00133 static int ascii_cc_expr __((struct Cif_cc_expr *)); 00134 static int ascii_src_pos __((struct Cif_src_pos *)); 00135 static int ascii_orig_cmd __((struct Cif_orig_cmd *)); 00136 #endif 00137 00138 static int (*ascii_record[CIF_MAXRECORD]) () = { 00139 0, /* 00= */ 00140 ascii_callsite, /* 01= CIF_CALLSITE */ 00141 ascii_cifhdr, /* 02= CIF_CIFHDR */ 00142 ascii_comblk, /* 03= CIF_COMBLK */ 00143 ascii_const, /* 04= CIF_CONST */ 00144 ascii_cdir, /* 05= CIF_CDIR */ 00145 ascii_entry, /* 06= CIF_ENTRY */ 00146 ascii_file, /* 07= CIF_FILE */ 00147 ascii_loop, /* 08= CIF_LOOP */ 00148 ascii_include, /* 09= CIF_INCLUDE */ 00149 ascii_label, /* 10= CIF_LABEL */ 00150 ascii_message, /* 11= CIF_MESSAGE */ 00151 ascii_namelist, /* 12= CIF_NAMELIST */ 00152 ascii_object, /* 13= CIF_OBJECT */ 00153 ascii_srcfile, /* 14= CIF_SRCFILE */ 00154 ascii_summary, /* 15= CIF_SUMMARY */ 00155 ascii_cdir_doshared, /* 16= CIF_CDIR_DOSHARED*/ 00156 ascii_unit, /* 17= CIF_UNIT */ 00157 ascii_endunit, /* 18= CIF_ENDUNIT */ 00158 ascii_usage, /* 19= CIF_USAGE */ 00159 ascii_nd_msg, /* 20= CIF_ND_MSG */ 00160 ascii_edopts, /* 21= CIF_EDOPTS */ 00161 ascii_mach_char, /* 22= CIF_MACH_CHAR */ 00162 ascii_misc_opts, /* 23= CIF_MISC_OPTS */ 00163 ascii_opt_opts, /* 24= CIF_OPT_OPTS */ 00164 ascii_stmt_type, /* 25= CIF_STMT_TYPE */ 00165 ascii_geometry, /* 26= CIF_GEOMETRY */ 00166 ascii_continuation, /* 27= CIF_CONTINUATION */ 00167 #ifndef CRAY2 00168 ascii_f90_callsite, /* 28= CIF_F90_CALLSITE */ 00169 ascii_f90_comblk, /* 29= CIF_F90_COMBLK */ 00170 ascii_f90_const, /* 30= CIF_F90_CONST */ 00171 ascii_f90_entry, /* 31= CIF_F90_ENTRY */ 00172 ascii_f90_loop, /* 32= CIF_F90_LOOP */ 00173 ascii_f90_derived_type, /* 33= CIF_F90_DERIVED_TYPE */ 00174 ascii_f90_label, /* 34= CIF_F90_LABEL */ 00175 ascii_f90_namelist, /* 35= CIF_F90_NAMELIST */ 00176 ascii_f90_object, /* 36= CIF_F90_OBJECT */ 00177 ascii_f90_misc_opts, /* 37= CIF_F90_MISC_OPTS */ 00178 ascii_f90_opt_opts, /* 38= CIF_F90_OPT_OPTS */ 00179 ascii_f90_begin_scope, /* 39= CIF_F90_BEGIN_SCOPE */ 00180 ascii_f90_end_scope, /* 40= CIF_F90_END_SCOPE */ 00181 ascii_f90_scope_info, /* 41= CIF_F90_SCOPE_INFO */ 00182 ascii_f90_use_module, /* 42= CIF_F90_USE_MODULE */ 00183 ascii_f90_rename, /* 43= CIF_F90_RENAME */ 00184 ascii_f90_int_block, /* 44= CIF_F90_INT_BLOCK */ 00185 ascii_f90_vectorization, /* 45= CIF_F90_VECTORIZATION */ 00186 ascii_BE_node, /* 46= CIF_BE_NODE */ 00187 #else 00188 NULL, NULL, NULL, NULL, 00189 NULL, NULL, NULL, NULL, 00190 NULL, NULL, NULL, NULL, 00191 NULL, NULL, NULL, NULL, 00192 NULL, NULL, NULL, 00193 #endif /* ndef CRAY2 */ 00194 ascii_transform, /* 47= CIF_TRANSFORM */ 00195 0,0, /* 48-49 */ 00196 ascii_BE_fid, /* 50= CIF_BE_FID */ 00197 ascii_c_tag, /* 51= CIF_C_TAG */ 00198 ascii_c_opts, /* 52= CIF_C_OPTS */ 00199 ascii_c_message, /* 53= CIF_C_MESSAGE */ 00200 ascii_c_const, /* 54= CIF_C_CONST */ 00201 ascii_c_entry, /* 55= CIF_C_ENTRY */ 00202 ascii_c_object, /* 56= CIF_C_OBJECT */ 00203 ascii_c_lint_directive, /* 57= CIF_C_LINT_DIRECTIVE */ 00204 ascii_c_macro_def, /* 58= CIF_C_MACRO_DEF */ 00205 ascii_c_macro_undef, /* 59= CIF_C_MACRO_UNDEF */ 00206 ascii_c_macro_usage, /* 60= CIF_C_MACRO_USAGE */ 00207 ascii_c_entry_end, /* 61= CIF_C_ENTRY_END */ 00208 0,0,0,0,0,0,0,0, /* 62-69 */ 00209 ascii_orig_cmd, /* 70= CIF_ORIG_CMD */ 00210 0,0,0,0,0,0,0,0,0, /* 71-79 */ 00211 ascii_cc_type, /* 80 = CIF_CC_TYPE */ 00212 ascii_cc_entry, /* 81 = CIF_CC_ENTRY */ 00213 ascii_cc_obj, /* 82 = CIF_CC_OBJ */ 00214 ascii_cc_subtype, /* 83 = CIF_CC_SUBTYPE */ 00215 ascii_cc_enum, /* 84 = CIF_CC_ENUM */ 00216 ascii_cc_expr, /* 85 = CIF_CC_EXPR */ 00217 ascii_src_pos /* 86 = CIF_SRC_POS */ 00218 00219 00220 }; 00221 00222 00223 00224 /* --- valid binary record indicators --- */ 00225 static short valid_record[CIF_MAXRECORD] = { 00226 NO, /* 00= */ 00227 YES, /* 01= CIF_CALLSITE */ 00228 YES, /* 02= CIF_CIFHDR */ 00229 YES, /* 03= CIF_COMBLK */ 00230 YES, /* 04= CIF_CONST */ 00231 YES, /* 05= CIF_CDIR */ 00232 YES, /* 06= CIF_ENTRY */ 00233 YES, /* 07= CIF_FILE */ 00234 YES, /* 08= CIF_LOOP */ 00235 YES, /* 09= CIF_INCLUDE */ 00236 YES, /* 10= CIF_LABEL */ 00237 YES, /* 11= CIF_MESSAGE */ 00238 YES, /* 12= CIF_NAMELIST */ 00239 YES, /* 13= CIF_OBJECT */ 00240 YES, /* 14= CIF_SRCFILE */ 00241 YES, /* 15= CIF_SUMMARY */ 00242 YES, /* 16= CIF_CDIR_DOSHARED */ 00243 YES, /* 17= CIF_UNIT */ 00244 YES, /* 18= CIF_ENDUNIT */ 00245 YES, /* 19= CIF_USAGE */ 00246 YES, /* 20= CIF_ND_MSG */ 00247 YES, /* 21= CIF_EDOPTS */ 00248 YES, /* 22= CIF_MACH_CHAR */ 00249 YES, /* 23= CIF_MISC_OPTS */ 00250 YES, /* 24= CIF_OPT_OPTS */ 00251 YES, /* 25= CIF_STMT_TYPE */ 00252 YES, /* 26= CIF_GEOMETRY */ 00253 YES, /* 27= CIF_CONTINUATION */ 00254 YES, /* 28= CIF_F90_CALLSITE */ 00255 YES, /* 29= CIF_F90_COMBLK */ 00256 YES, /* 30= CIF_F90_CONST */ 00257 YES, /* 31= CIF_F90_ENTRY */ 00258 YES, /* 32= CIF_F90_LOOP */ 00259 YES, /* 33= CIF_F90_DERIVED_TYPE */ 00260 YES, /* 34= CIF_F90_LABEL */ 00261 YES, /* 35= CIF_F90_NAMELIST */ 00262 YES, /* 36= CIF_F90_OBJECT */ 00263 YES, /* 37= CIF_F90_MISC_OPTS */ 00264 YES, /* 38= CIF_F90_OPT_OPTS */ 00265 YES, /* 39= CIF_F90_BEGIN_SCOPE */ 00266 YES, /* 40= CIF_F90_END_SCOPE */ 00267 YES, /* 41= CIF_F90_SCOPE_INFO */ 00268 YES, /* 42= CIF_F90_USE_MODULE */ 00269 YES, /* 43= CIF_F90_RENAME */ 00270 YES, /* 44= CIF_F90_INT_BLOCK */ 00271 YES, /* 45= CIF_F90_VECTORIZATION */ 00272 YES, /* 46= CIF_BE_NODE */ 00273 YES, /* 47 = CIF_TRANSFORM */ 00274 YES, /* 48 = CIF_FILEDIR */ 00275 YES, /* 49 = CIF_UNITDIR */ 00276 YES, /* 50 = CIF_BE_FID */ 00277 YES, /* 51= CIF_C_TAG */ 00278 YES, /* 52= CIF_C_OPTS */ 00279 YES, /* 53= CIF_C_MESSAGE */ 00280 YES, /* 54= CIF_C_CONST */ 00281 YES, /* 55= CIF_C_ENTRY */ 00282 YES, /* 56= CIF_C_OBJECT */ 00283 YES, /* 57= CIF_C_LINT_DIRECTIVE */ 00284 YES, /* 58= CIF_C_MACRO_DEF */ 00285 YES, /* 59= CIF_C_MACRO_UNDEF */ 00286 YES, /* 60= CIF_C_MACRO_USAGE */ 00287 YES, /* 61= CIF_C_ENTRY_END */ 00288 NO, NO, NO, NO, NO, NO, NO, NO, /* 62-69 */ 00289 YES, /* 70= CIF_ORIG_CMD */ 00290 NO, NO, NO, NO, NO, NO, NO, NO, NO, /* 71-79 */ 00291 YES, /* 80= CIF_CC_TYPE */ 00292 YES, /* 81= CIF_CC_ENTRY */ 00293 YES, /* 82= CIF_CC_OBJ */ 00294 YES, /* 83= CIF_CC_SUBTYPE */ 00295 YES, /* 84= CIF_CC_ENUM */ 00296 YES, /* 85= CIF_CC_EXPR */ 00297 YES /* 86= CIF_SRC_POS */ 00298 00299 }; 00300 00301 /* Buffer to use when mapping a version 1 cif to a version 2 cif record. 00302 * Required because some records increased in size so reading a v2 record 00303 * into space for a v1 cif would not work. Data is read into this buffer and 00304 * shaped into the correct cif record structure that the application requested. 00305 */ 00306 struct Cif_generic *_cif_map_buffer = (struct Cif_generic *) NULL; 00307 00308 00309 static int lcifd; /* cif descriptor for current invocation */ 00310 static int lmode; /* memory mgmt mode for current invocation */ 00311 00312 static int binary_record __((struct Cif_generic **, FILE *)); 00313 00314 /* 00315 * We need this so that when returning a v1 cif, we do not 00316 * return the file record associated with the message catalog; 00317 * when we hit the file that matches this, it will not be returned. 00318 */ 00319 00320 static int global_msgfid = -1; 00321 00322 /* -------------------------------------------------------------------------- 00323 * ASCII record token scanning stuff 00324 * 00325 * The "token" routine returns a pointer to the next SEPARATOR or "\n" 00326 * delimited token in the current record. "delim" is set to the character 00327 * that terminated the token. The routine is initialized to begin a new 00328 * record by setting "ntoken" to the record buffer address. 00329 * -------------------------------------------------------------------------- 00330 */ 00331 00332 static char *ntoken; /* pointer to next token in buffer */ 00333 static char delim; /* character that terminated current token */ 00334 static char *token () { 00335 char *tok; 00336 00337 if (*ntoken == '\0') 00338 return ((char *)NULL); 00339 else { 00340 tok = ntoken; 00341 delim = *ntoken++; 00342 while (delim != SEPARATOR && delim != '\n' && delim != '\0') 00343 delim = *ntoken++; 00344 *(ntoken-1) = '\0'; 00345 return (tok); 00346 } 00347 } 00348 00349 00350 /* -------------------------------------------------------------------------- 00351 * "compuse" compares two usage records by file, line, and charpos. It is 00352 * passed to "qsort" to sort usage records. 00353 * -------------------------------------------------------------------------- 00354 */ 00355 00356 static int compuse (u1, u2) 00357 struct Cif_use *u1, *u2; 00358 { 00359 int ret; 00360 00361 if ((ret = ( u1->fid - u2->fid )) != 0) 00362 return (ret); 00363 else if ((ret = ( u1->line - u2->line )) != 0) 00364 return (ret); 00365 else 00366 return ( u1->cpos - u2->cpos ); 00367 } 00368 00369 /* -------------------------------------------------------------------------- 00370 * 00371 * Cif_Getrecord returns the next record from a CIF file. If the file is an 00372 * ASCII format file, the next record from the file is read and converted 00373 * into structure format. If a binary format file, the next record is read 00374 * from the file. In both cases, the neccessary space to contain the 00375 * structure and associated information is acquired. The status value is 00376 * returned via the function return value. The pointer to the structure is 00377 * returned by setting the "cif_record" argument to the structure pointer. 00378 * 00379 * -------------------------------------------------------------------------- 00380 */ 00381 00382 int Cif_Getrecord 00383 #ifdef __STDC__ 00384 (int cifd, struct Cif_generic **cif_record) 00385 #else 00386 (cifd, cif_record) 00387 int cifd; /* input CIF file descriptor */ 00388 struct Cif_generic **cif_record; /* pointer to pointer to CIF structure */ 00389 #endif 00390 { 00391 00392 int rtype; /* record type code */ 00393 int status = 0; /* status value */ 00394 00395 if (cifd < 0 || cifd >= CIF_FT_SIZE || _Cif_filetbl[cifd].form == NOT_A_CIF) 00396 return (CIF_NOTOPEN); 00397 else if (_Cif_filetbl[cifd].optype == 'w') 00398 return (CIF_BADREQ); 00399 lcifd = cifd; 00400 00401 /* 00402 * If memory management mode isn't set, then set to FIXED. If the mode is 00403 * FIXED, reset the amount of buffer used. 00404 */ 00405 00406 lmode = _Cif_filetbl[cifd].mode; 00407 if (lmode == CIF_MEM_DEFAULT) { 00408 if ((status = Cif_Memmode (cifd, CIF_MEM_FIXED)) != 0) 00409 return (status); 00410 lmode = _Cif_filetbl[cifd].mode; 00411 } 00412 if (lmode == CIF_MEM_FIXED) 00413 _Cif_memarea[_Cif_filetbl[cifd].fme].mused = 0; 00414 00415 if (_Cif_filetbl[cifd].form == ASCII_CIF) { 00416 00417 /* Read next record from file. Continue reading records until a 00418 * record that should be returned is encountered. The record must 00419 * legal for this CIF version and must be allowed by the record 00420 * mask for this file. 00421 */ 00422 00423 do { 00424 do { 00425 if (_Cif_filetbl[cifd].ifull == NO) { 00426 if (fgets(_Cif_filetbl[cifd].ip, CIF_BUFSIZE, _Cif_filetbl[cifd].fd) 00427 == NULL) 00428 { 00429 if (feof (_Cif_filetbl[cifd].fd)) 00430 return (CIF_EOF); 00431 else 00432 return (CIF_SYSERR); 00433 } 00434 } 00435 _Cif_filetbl[cifd].ifull = NO; 00436 ntoken = _Cif_filetbl[cifd].ip; 00437 rtype = atoi (token ()); 00438 } while (rtype >= CIF_MAXRECORD || ascii_record[rtype] == 0 || 00439 _Cif_filetbl[cifd].rmask[rtype] == '\0'); 00440 00441 /* Allocate space for record structure and call conversion 00442 * routine based on record type. 00443 */ 00444 00445 *cif_record = (struct Cif_generic *) _Cif_space[lmode] 00446 (_Cif_structsize[rtype][_Cif_filetbl[cifd].return_version], lcifd); 00447 if (*cif_record == NULL) 00448 status = CIF_NOMEM; 00449 else { 00450 (void) memset ((char *)*cif_record, 00451 '\0', 00452 _Cif_structsize 00453 [rtype][_Cif_filetbl[cifd].return_version]); 00454 00455 (*cif_record)->rectype = rtype; 00456 status = ascii_record[rtype] (*cif_record); 00457 00458 } 00459 /* 00460 * If status == maxrecord, we don't want to return this record. 00461 * This can only happen if we are returning a v1 cif, but reading a v2 00462 * and it is a stmt record (#25) with type CDIR; v1 didn't have that 00463 * record 00464 */ 00465 if (status == CIF_MAXRECORD && 00466 lmode == CIF_MEM_INDIV) 00467 Cif_Free(*cif_record); 00468 00469 } while (status == CIF_MAXRECORD); 00470 } 00471 00472 else /* form is BINARY_CIF so */ 00473 status = binary_record (cif_record, _Cif_filetbl[cifd].fd); 00474 00475 return (status); 00476 } 00477 00478 00479 00480 00481 /* -------------------------------------------------------------------------- 00482 * Binary record version mapping 00483 * 00484 * Converts a binary record from one version to another 00485 * -------------------------------------------------------------------------- 00486 */ 00487 int _Cif_binary_map_version (rtype, map_buffer, cr) 00488 int rtype; 00489 struct Cif_generic *map_buffer; 00490 struct Cif_generic *cr; 00491 { 00492 00493 switch (rtype) { 00494 00495 case CIF_OBJECT : { 00496 struct Cif_object *to = (struct Cif_object *) cr; 00497 struct Cif_object *from = (struct Cif_object *) map_buffer; 00498 00499 /* 00500 * copy the required bytes to fill the return version; if there are not 00501 * enough bytes to copy, that's okay (ie if v1 copied to v2), the buffer 00502 * has sufficient space after it to avoid memory problems. If copying a 00503 * smaller version (v1) into a larger, that's also okay as we will set 00504 * the new geometry and distribution fields added in v2, below. 00505 */ 00506 00507 (void) memcpy((char *) cr, (char *) map_buffer, 00508 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00509 00510 if (_Cif_filetbl[lcifd].return_version == 1) { 00511 if (from->storage == CIF_ST_DATA) /* in v2, static was split into bss and data, 00512 * but as bss has the same value as static (6), 00513 * that's okay, so we just have to map back the 00514 * data variant (8) 00515 */ 00516 to->storage = CIF_ST_STATIC; 00517 } 00518 else 00519 if (_Cif_filetbl[lcifd].version == 1) { 00520 /* returning v2, add the extra distribution and geomid */ 00521 to->geomid = 0; 00522 to->dist = 0; 00523 to->pointer = 0; 00524 } 00525 00526 break; 00527 } 00528 00529 case CIF_CONST : { 00530 struct Cif_const *to = (struct Cif_const *) cr; 00531 00532 /* 00533 * copy the required bytes to fill the return version; if there are not 00534 * enough bytes to copy, that's okay (ie if v1 copied to v2), the buffer 00535 * has sufficient space after it to avoid memory problems. If copying a 00536 * smaller version (v1) into a larger, that's also okay as we will set 00537 * the original form fields added in v2 below. 00538 */ 00539 00540 (void) memcpy((char *) cr, (char *) map_buffer, 00541 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00542 00543 if (_Cif_filetbl[lcifd].version == 1 && 00544 _Cif_filetbl[lcifd].return_version != 1) { 00545 /* returning v2, add the extra 00546 * original format fields 00547 */ 00548 00549 to->origform = 0; 00550 to->olen = 0; 00551 to->oform = (char *) NULL; 00552 } 00553 00554 break; 00555 } 00556 00557 00558 case CIF_FILE : { 00559 struct Cif_file *to = (struct Cif_file *) cr; 00560 00561 struct Cif_file *from = (struct Cif_file *) map_buffer; 00562 00563 (void) memcpy((char *) cr, (char *) map_buffer, 00564 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].version]); 00565 /* do NOT change this shortsize to "return_version" 00566 because we need to pick up the onlen field */ 00567 00568 break; 00569 } 00570 00571 case CIF_COMBLK : { 00572 struct Cif_comblk *to = (struct Cif_comblk *) cr; 00573 00574 /* 00575 * copy the required bytes to fill the return version; if there are not 00576 * enough bytes to copy, that's okay (ie if v1 copied to v2), the buffer 00577 * has sufficient space after it to avoid memory problems. If copying a 00578 * smaller veriosn (v1) into a larger, that's also okay as we will set 00579 * the new distribution field added in v2, below. 00580 */ 00581 00582 (void) memcpy((char *) cr, (char *) map_buffer, 00583 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00584 00585 if (_Cif_filetbl[lcifd].version == 1 && 00586 _Cif_filetbl[lcifd].return_version != 1) /* add the extra geomid */ 00587 to->dist = 0; 00588 00589 break; 00590 } 00591 00592 case CIF_USAGE : { 00593 struct Cif_usage *to = (struct Cif_usage *) cr; 00594 00595 /* 00596 * copy the required bytes to fill the return version; if there are not 00597 * enough bytes to copy, that's okay (ie if v1 copied to v2), the buffer 00598 * has sufficient space after it to avoid memory problems. If copying a 00599 * smaller version (v1) into a larger, that's also okay as we will set 00600 * the new nmembs and membs fields added in v2, below. 00601 */ 00602 00603 (void) memcpy((char *) cr, (char *) map_buffer, 00604 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00605 00606 if (_Cif_filetbl[lcifd].version == 1 && 00607 _Cif_filetbl[lcifd].return_version != 1) { 00608 to->nmembs = 0; 00609 to->membs = (long *) NULL; 00610 } 00611 00612 break; 00613 } 00614 00615 case CIF_MACH_CHAR : { 00616 struct Cif_mach_char *to = (struct Cif_mach_char *) cr; 00617 00618 /* 00619 * copy the required bytes to fill the return version; if there are not 00620 * enough bytes to copy, that's okay (ie if v1 copied to v2), the buffer 00621 * has sufficient space after it to avoid memory problems. If copying a 00622 * smaller veriosn (v1) into a larger, that's also okay as we will set 00623 * the new distribution field added in v2, below. 00624 */ 00625 00626 (void) memcpy((char *) cr, (char *) map_buffer, 00627 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00628 00629 if (_Cif_filetbl[lcifd].version == 1 && 00630 _Cif_filetbl[lcifd].return_version != 1) { /* add the extra fields */ 00631 to->numbanks = 0; /* number of memory banks */ 00632 to->numcpus = 0; /* number of cpus */ 00633 to->instbufsize = 0; /* instruction buffer size */ 00634 to->clockperiod = 0; /* clock period in picoseconds */ 00635 to->numclregs = 0; /* number of register clusters */ 00636 to->bankbusytime = 0; /* number of clock periods that the memory bank is reserved */ 00637 } 00638 00639 break; 00640 } 00641 00642 case CIF_C_MESSAGE : { 00643 struct Cif_c_message *to = (struct Cif_c_message *) cr; 00644 00645 (void) memcpy((char *) cr, (char *) map_buffer, 00646 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00647 00648 if (_Cif_filetbl[lcifd].version == 1 && 00649 _Cif_filetbl[lcifd].return_version != 1) 00650 /* add in extra msgcode field */ 00651 to->msgcode = 0; 00652 00653 break; 00654 } 00655 00656 case CIF_MISC_OPTS : { 00657 struct Cif_misc_opts *to = (struct Cif_misc_opts *) cr; 00658 00659 (void) memcpy((char *) cr, (char *) map_buffer, 00660 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00661 00662 if (_Cif_filetbl[lcifd].version == 1 && 00663 _Cif_filetbl[lcifd].return_version != 1) { /* add in extra v2 fields */ 00664 to->llen = 0; 00665 to->cifopt = 0; 00666 to->inputlen = 0; 00667 to->runtime = 0; 00668 to->numincs = 0; 00669 } 00670 00671 break; 00672 } 00673 00674 00675 case CIF_OPT_OPTS : { 00676 00677 if (_Cif_filetbl[lcifd].return_version == 1) { /* map a v2 cif to pass to a v1 application */ 00678 00679 struct Cif_opt_opts *from = (struct Cif_opt_opts *) map_buffer; 00680 struct Cif_opt_opts_1 *to = (struct Cif_opt_opts_1 *) cr; 00681 00682 to->values = from->values; 00683 00684 } else if (_Cif_filetbl[lcifd].version == 1) { 00685 /* a v1 cif to a v(>1) application */ 00686 00687 struct Cif_opt_opts_1 *from = (struct Cif_opt_opts_1 *) map_buffer; 00688 struct Cif_opt_opts *to = (struct Cif_opt_opts *) cr; 00689 00690 to->values = from->values; 00691 to->inlevel = 0; /* v1 cif didn't set this inline level field */ 00692 00693 } else { 00694 /* map v2 to v3 or vice versa */ 00695 (void) memcpy((char *) cr, (char *) map_buffer, 00696 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00697 } 00698 break; 00699 } 00700 00701 00702 case CIF_C_ENTRY : { 00703 00704 if (_Cif_filetbl[lcifd].return_version == 1) { /* map a v2 cif to pass to a v1 application */ 00705 00706 struct Cif_c_entry *from = (struct Cif_c_entry *) map_buffer; 00707 struct Cif_c_entry_1 *to = (struct Cif_c_entry_1 *) cr; 00708 00709 to->rectype = from->rectype; 00710 to->ptype = from->ptype; 00711 if (from->symclass == 5) 00712 to->symclass = 0; 00713 else 00714 to->symclass = from->symclass; 00715 to->retvalue = from->retvalue; 00716 to->varargs = from->varargs; 00717 to->scope = from->scope; 00718 to->nlen = from->nlen; 00719 to->symid = from->symid; 00720 to->nargs = from->nargs; 00721 to->nmods = from->nmods; 00722 to->qual = from->qual; 00723 to->btype = from->btype; 00724 00725 } 00726 else 00727 00728 if (_Cif_filetbl[lcifd].version == 1) { 00729 /* a v1 cif to a v(>1) application */ 00730 struct Cif_c_entry_1 *from = (struct Cif_c_entry_1 *) map_buffer; 00731 struct Cif_c_entry *to = (struct Cif_c_entry *) cr; 00732 00733 to->rectype = from->rectype; 00734 to->ptype = from->ptype; 00735 to->symclass = from->symclass; 00736 to->retvalue = from->retvalue; 00737 to->varargs = from->varargs; 00738 to->tagid = 0; 00739 to->scope = from->scope; 00740 to->nlen = from->nlen; 00741 to->symid = from->symid; 00742 to->nargs = from->nargs; 00743 to->nmods = from->nmods; 00744 to->qual = from->qual; 00745 to->btype = from->btype; 00746 to->link = 0; 00747 00748 } 00749 else { 00750 (void) memcpy((char *) cr, (char *) map_buffer, 00751 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00752 } 00753 00754 break; 00755 } 00756 00757 case CIF_C_TAG : { 00758 struct Cif_c_tag *tag = (struct Cif_c_tag *) cr; 00759 00760 (void) memcpy((char *) cr, (char *) map_buffer, 00761 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00762 00763 /* v1 entity value 10 maps to v2 enity values of 9 */ 00764 00765 if (_Cif_filetbl[lcifd].version == 1 && 00766 _Cif_filetbl[lcifd].return_version != 1 && 00767 tag->entity == 10) 00768 tag->entity = 9; 00769 else 00770 if (_Cif_filetbl[lcifd].version != 1 && 00771 _Cif_filetbl[lcifd].return_version == 1 && 00772 tag->entity == 9) 00773 tag->entity = 10; 00774 00775 break; 00776 } 00777 00778 case CIF_C_OBJECT : { 00779 00780 struct Cif_c_object *obj = (struct Cif_c_object *) cr; 00781 00782 (void) memcpy((char *) cr, (char *) map_buffer, 00783 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00784 00785 if (_Cif_filetbl[lcifd].return_version == 1) { /* map a v2 cif to pass to a v1 application */ 00786 00787 struct Cif_c_object *from = (struct Cif_c_object *) map_buffer; 00788 struct Cif_c_object_1 *to = (struct Cif_c_object_1 *) cr; 00789 00790 to->mods = from->mods; 00791 to->name = from->name; 00792 00793 } 00794 else 00795 00796 if (_Cif_filetbl[lcifd].version == 1) { 00797 /* a v1 cif to a v(>1) application */ 00798 00799 struct Cif_c_object_1 *from = (struct Cif_c_object_1 *) map_buffer; 00800 struct Cif_c_object *to = (struct Cif_c_object *) cr; 00801 00802 to->mods = from->mods; 00803 to->name = from->name; 00804 00805 } 00806 00807 if (_Cif_filetbl[lcifd].version == 1 && 00808 _Cif_filetbl[lcifd].return_version != 1 && 00809 (obj->entity == 11 || obj->entity == 12)) 00810 obj->entity --; 00811 else 00812 if (_Cif_filetbl[lcifd].version != 1 && 00813 _Cif_filetbl[lcifd].return_version == 1 && 00814 (obj->entity == 10 || obj->entity == 11)) 00815 obj->entity ++; 00816 00817 break; 00818 } 00819 00820 case CIF_MESSAGE : 00821 { 00822 (void) memcpy((char *) cr, (char *) map_buffer, 00823 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00824 00825 if (_Cif_filetbl[lcifd].return_version < 3 && 00826 _Cif_filetbl[lcifd].version == 3) { 00827 00828 struct Cif_message *from = (struct Cif_message *) map_buffer; 00829 struct Cif_message_1 *to = (struct Cif_message_1 *) cr; 00830 00831 to->fid = from->pfid; 00832 00833 ((struct Cif_message *)cr)->nlen = from->nlen; 00834 /* this kludge allows _Cif_binread() to read in the "name" 00835 field */ 00836 00837 } 00838 00839 break; 00840 } 00841 00842 00843 case CIF_F90_INT_BLOCK : 00844 case CIF_F90_DERIVED_TYPE : 00845 case CIF_BE_NODE : 00846 { 00847 00848 (void) memcpy((char *) cr, (char *) map_buffer, 00849 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00850 break; 00851 } 00852 00853 default: 00854 /* 00855 * if we are not going to return this record, make sure that what we 00856 * are copying matches what we read (eg there is not version 1 macro 00857 * def record, but we could open a v2 cif and read with a v1 application 00858 * which should never see the macro def, but it has to be read from the 00859 * file before the next one can be 00860 */ 00861 00862 if (_Cif_filetbl[lcifd].rmask[rtype] == '\0') { 00863 00864 (void) memcpy((char *) cr, (char *) map_buffer, 00865 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].version]); 00866 00867 } 00868 else { 00869 00870 (void) memcpy((char *) cr, (char *) map_buffer, 00871 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 00872 00873 } 00874 00875 /* 00876 * If we are returning a version 1 cif from a v2 cif on disk 00877 * and this is a stm_type and it is of type CDIR (80) then don't 00878 * return it as v1 cifs don't know about thie stmt type 00879 */ 00880 if (rtype == CIF_STMT_TYPE && 00881 CIFSTMT(cr)->type == CIF_TP_CDIR && 00882 _Cif_filetbl[lcifd].return_version == 1) { 00883 return( /* keep = */ 0 ); 00884 } 00885 00886 } 00887 00888 00889 return( /* keep = */ 1 ); 00890 00891 00892 } 00893 00894 00895 00896 /* -------------------------------------------------------------------------- 00897 * Binary record input routine. 00898 * 00899 * Read the prepended record type, get space for the record, read in the 00900 * structure, read in any variable fields. 00901 * -------------------------------------------------------------------------- 00902 */ 00903 static int binary_record (cif_record, fd) 00904 struct Cif_generic **cif_record; /* ptr to ptr to record */ 00905 FILE *fd; /* file descriptor of cif file */ 00906 { 00907 00908 int rtype, stat, size; 00909 register char *cp; 00910 struct Cif_generic *cr; 00911 struct Cif_generic rechdr; 00912 int keep = 1; 00913 00914 do { /* look for a valid (ie what the user has asked for) record type */ 00915 cp = (char *)&rechdr; 00916 00917 if (fread (cp, sizeof(char), 1, fd) != 1) { 00918 00919 if (feof(fd)) return (CIF_EOF); 00920 else return (CIF_SYSERR); 00921 00922 } 00923 00924 rtype = rechdr.rectype; 00925 00926 00927 if (rtype > CIF_MAXRECORD || valid_record[rtype] == NO) { 00928 return (CIF_BADFORM); 00929 } 00930 00931 /* If we are not going to return this record, just make sure that we allocate 00932 the correct amount of space to read it in, ie make it equal what is on 00933 disk, not what we have to return; same for memset below. */ 00934 00935 if (_Cif_filetbl[lcifd].rmask[rtype] == '\0') { 00936 00937 cr = *cif_record = (struct Cif_generic *) _Cif_space[lmode] 00938 (_Cif_structsize[rtype][_Cif_filetbl[lcifd].version], 00939 lcifd); 00940 00941 } 00942 else { 00943 00944 cr = *cif_record = (struct Cif_generic *) _Cif_space[lmode] 00945 (_Cif_structsize[rtype][_Cif_filetbl[lcifd].return_version], 00946 lcifd); 00947 00948 } 00949 00950 /* We are in trouble if there's no memory...best we can do is get out of here */ 00951 if (cr == NULL) 00952 return (CIF_NOMEM); 00953 00954 00955 if (_Cif_filetbl[lcifd].rmask[rtype] == '\0') { 00956 00957 (void) memset ((char *)cr, '\0', 00958 _Cif_structsize[rtype][_Cif_filetbl[lcifd].version]); 00959 00960 } 00961 else { 00962 00963 (void) memset ((char *)cr, '\0', 00964 _Cif_structsize[rtype][_Cif_filetbl[lcifd].return_version]); 00965 00966 } 00967 00968 cp = (char *)cr + 1; 00969 size = _Cif_shortsize[rtype][_Cif_filetbl[lcifd].version] - 1; 00970 00971 /* If the cif versions are not equal, we have to map the data, ie some 00972 records changed between cif verions, became larger or values within 00973 them changed */ 00974 00975 /* 00976 * A new problem has been discovered recently in the structure of 00977 * the following code, but it is now too close to release to fix it 00978 * the right way. A kludge work-around to the immediate problem 00979 * has been implemented and warning comments have been placed at a 00980 * few critical places. This note is left as a reminder to come 00981 * back later and do the full fix. 00982 * 00983 * When the CIF file is version 3 and the user asks for version 2, 00984 * the following code reads in the fixed portion of the record, 00985 * calls _Cif_binary_map_version() to convert it to version 2, and 00986 * then passes the V2 record to _Cif_binread() to read in the 00987 * "auxiliary" fields. However, for some records like CIF_MESSAGE 00988 * and CIF_FILE, _Cif_binread() needs information from the V3 record 00989 * to correctly read in the auxiliary fields. 00990 * 00991 * So, this code should be restructured to read in both the fixed 00992 * and auxiliary portions of the current record, and then call 00993 * _Cif_binary_map_version() to convert both parts. This will 00994 * require lots of simple changes to _Cif_binread() and 00995 * _Cif_binary_map_version(). This was deemed to be too risky 00996 * since we are (in theory) getting close to field test. 00997 * TWH 7/13/95 00998 */ 00999 01000 if (_Cif_filetbl[lcifd].version == _Cif_filetbl[lcifd].return_version) { 01001 01002 if (fread (cp, size, 1, fd) != 1) 01003 IO_ERROR; 01004 } 01005 else { /* need to map between versions */ 01006 01007 /* create a temporary, static buffer in which to read data into, just 01008 in case the cif on disk is larger than the cif record to be returned 01009 (eg cif v2 on disk; application wants a v1) */ 01010 01011 if (_cif_map_buffer == (struct Cif_generic *) NULL) 01012 _cif_map_buffer = (struct Cif_generic *) malloc(CIF_MAX_SSIZE); 01013 01014 (void) memset ((char *)_cif_map_buffer, '\0', 01015 _Cif_shortsize[rtype][_Cif_filetbl[lcifd].return_version]); 01016 01017 if (fread ((char *) _cif_map_buffer + 1, size, 1, fd) != 1) 01018 IO_ERROR; 01019 01020 keep = _Cif_binary_map_version(rtype, _cif_map_buffer, cr); 01021 01022 } 01023 01024 01025 cr->rectype = rtype; 01026 01027 if ((stat = _Cif_binread (lcifd, rtype, cr, fd)) < 0) 01028 return (stat); 01029 01030 /* 01031 * User doesn't want this record (or it's from a cif that the 01032 * application can't read (eg v2 for a v1 application ), so free 01033 * up this record space 01034 */ 01035 01036 if ((keep == 0 || 01037 _Cif_filetbl[lcifd].rmask[rtype] == '\0') && 01038 _Cif_filetbl[lcifd].mode == CIF_MEM_INDIV) 01039 Cif_Free(cr); 01040 01041 } 01042 while (keep == 0 || _Cif_filetbl[lcifd].rmask[rtype] == '\0'); 01043 01044 return (rtype); 01045 01046 } 01047 01048 /* -------------------------------------------------------------------------- 01049 * strlist process a list of string tokens and builds an array of pointers to 01050 * character strings. 01051 * -------------------------------------------------------------------------- 01052 */ 01053 01054 static int strlist(args) 01055 register char ***args; /* number of strings in the list */ 01056 { 01057 register int n, i, len; 01058 register char *c; 01059 char **aptr; 01060 01061 aptr = NULL; 01062 if ( (n = atoi (token()) ) > 0) { 01063 aptr = (char **)_Cif_space[lmode] (sizeof(char *)*n, lcifd); 01064 if (aptr == NULL) 01065 return (CIF_NOMEM); 01066 for (i = 0; i < n; i++) { 01067 c = token(); 01068 len = strlen (c); 01069 aptr[i] = _Cif_space[lmode] (len+1, lcifd); 01070 if (aptr[i] == NULL) 01071 return (CIF_NOMEM); 01072 (void) strcpy (aptr[i], c); 01073 } 01074 } 01075 *args = aptr; 01076 return(n); 01077 } 01078 01079 /* -------------------------------------------------------------------------- 01080 * llist processes a list of integer tokens and builds an array of pointers to 01081 * long ints. 01082 * -------------------------------------------------------------------------- 01083 */ 01084 01085 static int llist(args, varargs) 01086 long **args; 01087 int *varargs; 01088 { 01089 register int n, i; 01090 register char *c; 01091 register long *aptr; 01092 01093 c = token(); 01094 01095 /* String could be "*" (unknown) or "*n" for n known arguments 01096 * in a varargs list. Set the varargs flag if "*" appears. 01097 */ 01098 01099 if (varargs != NULL) { 01100 *varargs = 0; 01101 if (*c == '*') { 01102 *varargs = 1; 01103 c++; 01104 } 01105 } 01106 01107 aptr = NULL; 01108 if ( (n = atoi (c) ) > 0) { 01109 aptr = (long *)_Cif_space[lmode] (sizeof(long)*n, lcifd); 01110 if (aptr == NULL) 01111 return (CIF_NOMEM); 01112 for (i = 0; i < n; i++) 01113 aptr[i] = atoi (token()); 01114 } 01115 *args = aptr; 01116 return(n); 01117 } 01118 01119 /* -------------------------------------------------------------------------- 01120 * filltype processes a C type descriptor. The hex digit string and 01121 * associated id fields are returned as the basic type, qualifier, and 01122 * modifier structure. 01123 * -------------------------------------------------------------------------- 01124 */ 01125 01126 static int filltype(basic, qual, tmod) 01127 register int *basic; 01128 register int *qual; 01129 register struct Cif_tmod **tmod; 01130 { 01131 register char *c; 01132 register char *c_array; 01133 register int len, n, i, funcseen = NO; 01134 static char digit[ ] = { '\0', '\0' }; 01135 struct Cif_tmod *tm; 01136 01137 /* Get the basic type (last two hex digits) and the qualifier (3rd from 01138 * last hex digit. If that's all, return. 01139 */ 01140 01141 len = strlen(c = token()); 01142 01143 *basic = strtol(&c[len-2], (char **)NULL, 16); 01144 c[len-2] = '\0'; 01145 *qual = strtol(&c[len-3], (char **)NULL, 16); 01146 c[len-3] = '\0'; 01147 len -= 3; 01148 if (len <= 0) { 01149 *tmod = (struct Cif_tmod *)NULL; 01150 return (0); 01151 } 01152 01153 /* Get Type modifiers -- 4th - 15th hex digits */ 01154 01155 tm= (struct Cif_tmod *)_Cif_space[lmode](sizeof(struct Cif_tmod)*len, lcifd); 01156 if (tm == NULL) 01157 return (CIF_NOMEM); 01158 01159 /* Go through the hex digits from left to right, grabbing another 01160 * token for each "array of" and all but the last "function 01161 * returning" modifier 01162 */ 01163 01164 for (i = 0; i < len; i++) { 01165 digit[0] = c[i]; 01166 01167 /* Save the modifier (hex. digit). */ 01168 01169 tm[i].mod = n = strtol(digit, (char **)NULL, 16); 01170 01171 /* If an "array of" type, grab the next token 01172 * which will be a dimension value. If a "function 01173 * returning" type, grab the next token ONLY if 01174 * it is NOT the first "function returning" type. 01175 * If it is the first "function returning" types, 01176 * bypass getting the next token 01177 */ 01178 01179 if (n == CIF_TMC_ARRAY) { 01180 c_array = token(); 01181 if (c_array != (char *) NULL) 01182 if (atol(c_array) < 0) 01183 tm[i].val = 0; 01184 else 01185 tm[i].val = atol(c_array); 01186 else 01187 tm[i].val = 0; 01188 } 01189 else if (n == CIF_TMC_FUNCNOPR || n == CIF_TMC_FUNCPRO) { 01190 if (funcseen == NO) { 01191 funcseen = YES; 01192 tm[i].val = 0; 01193 continue; 01194 } 01195 else 01196 tm[i].val = atol(token()); 01197 } 01198 else 01199 tm[i].val = 0; 01200 } 01201 *tmod = tm; 01202 return (len); 01203 } 01204 01205 /* -------------------------------------------------------------------------- 01206 * ASCII record conversion routines 01207 * 01208 * Each routine accepts a pointer of the generic structure type, casts it to 01209 * the appropriate type, scans the current record via the "token" routine, 01210 * converts the tokens to binary values, and fills in the record structure. 01211 * -------------------------------------------------------------------------- 01212 */ 01213 01214 static int ascii_c_const (con) 01215 struct Cif_c_const *con; 01216 { 01217 register char *c1, *c2; 01218 register long i; 01219 01220 con->symid = atol (token()); 01221 con->btype = strtol (token(), (char **)NULL, 16); 01222 c1 = token(); 01223 i = strlen (c1) + 1; 01224 if (delim == SEPARATOR) { 01225 c2 = token(); 01226 i += strlen (c2) + 1; 01227 } 01228 else 01229 c2 = NULL; 01230 con->vlen = i; 01231 con->value = _Cif_space[lmode] (i, lcifd); 01232 if (con->value == NULL) 01233 return (CIF_NOMEM); 01234 (void) strcpy (con->value, c1); 01235 if (c2 != NULL) 01236 (void) strcpy (con->value+strlen(c1)+1, c2); 01237 return (CIF_C_CONST); 01238 01239 } 01240 01241 01242 /* V1 and V2 differences : v2 has a tag id field; the symclass can have the value 5 */ 01243 01244 static int ascii_c_entry (ent) 01245 struct Cif_c_entry *ent; 01246 { 01247 register long i; 01248 register char *c; 01249 int basic, qual, v; 01250 01251 /* If the user wants a v1 cif, then we need to use a different data 01252 structure */ 01253 01254 if (_Cif_filetbl[lcifd].return_version == 1) { 01255 struct Cif_c_entry_1 *ent1 = (struct Cif_c_entry_1 *) ent; 01256 int symclass; 01257 01258 c = token(); 01259 ent1->nlen = i = strlen (c); 01260 ent1->name = _Cif_space[lmode] (i+1, lcifd); 01261 if (ent1->name == NULL) 01262 return (CIF_NOMEM); 01263 (void) strcpy (ent1->name, c); 01264 ent1->symid = atol (token()); 01265 ent1->ptype = atoi (token()); 01266 symclass = atoi (token()); 01267 if (_Cif_filetbl[lcifd].version != 1 && /* a v2 or greater cif */ 01268 symclass == 5) 01269 symclass = 0; /* symclass of 5 doesn't exist in a v1 cif */ 01270 01271 ent1->symclass = symclass; 01272 ent1->scope = atoi (token()); 01273 01274 /* No tag id in v1 c_entry record */ 01275 /* ent1->tagid = atol (token()); */ 01276 01277 if (_Cif_filetbl[lcifd].version != 1) /* but we are reading a v2 cif 01278 which has the tag id, so skip it */ 01279 (void) token(); 01280 01281 c = token(); 01282 ent1->retvalue = (*c == 'F') ? 0 : ((*c == 'T') ? 1 : 2); 01283 if ((i = llist(&(ent1->argids), &v)) < 0) 01284 return (CIF_NOMEM); 01285 ent1->nargs = i; 01286 ent1->varargs = v; 01287 if ((i = filltype(&basic, &qual, &(ent1->mods))) < 0) 01288 return (CIF_NOMEM); 01289 ent1->nmods = i; 01290 ent1->qual = qual; 01291 ent1->btype = basic; 01292 01293 } 01294 else { /* User wants a v2 cif */ 01295 01296 c = token(); 01297 ent->nlen = i = strlen (c); 01298 ent->name = _Cif_space[lmode] (i+1, lcifd); 01299 if (ent->name == NULL) 01300 return (CIF_NOMEM); 01301 (void) strcpy (ent->name, c); 01302 ent->symid = atol (token()); 01303 ent->ptype = atoi (token()); 01304 ent->symclass = atoi (token()); 01305 ent->scope = atoi (token()); 01306 01307 if (_Cif_filetbl[lcifd].version != 1) /* v1 cif doesn't have a tag id */ 01308 ent->tagid = atol (token()); 01309 /* else the tagid value has already been set to zero */ 01310 01311 c = token(); 01312 ent->retvalue = (*c == 'F') ? 0 : ((*c == 'T') ? 1 : ((*c == 'I') ? 3 : 2)); 01313 if ((i = llist(&(ent->argids), &v)) < 0) 01314 return (CIF_NOMEM); 01315 ent->nargs = i; 01316 ent->varargs = v; 01317 if ((i = filltype(&basic, &qual, &(ent->mods))) < 0) 01318 return (CIF_NOMEM); 01319 ent->nmods = i; 01320 ent->qual = qual; 01321 ent->btype = basic; 01322 if (delim == SEPARATOR) { 01323 ent->link = atol(token()); 01324 } 01325 } 01326 01327 return (CIF_C_ENTRY); 01328 } 01329 01330 01331 01332 static int ascii_c_entry_end (ent_end) 01333 struct Cif_c_entry_end *ent_end; 01334 { 01335 register long i; 01336 register char *c; 01337 01338 c = token(); 01339 ent_end->nlen = i = strlen (c); 01340 ent_end->name = _Cif_space[lmode] (i+1, lcifd); 01341 if (ent_end->name == NULL) 01342 return (CIF_NOMEM); 01343 (void) strcpy (ent_end->name, c); 01344 ent_end->symid = atol (token()); 01345 ent_end->fid = atol (token()); 01346 ent_end->strline = atol (token()); 01347 ent_end->endline = atol (token()); 01348 01349 return (CIF_C_ENTRY_END); 01350 } 01351 01352 01353 static int ascii_c_lint_directive (lint_dir) 01354 struct Cif_c_lint_directive *lint_dir; 01355 { 01356 register long i; 01357 register char *c; 01358 01359 c = token(); 01360 lint_dir->nlen = i = strlen (c); 01361 lint_dir->name = _Cif_space[lmode] (i+1, lcifd); 01362 if (lint_dir->name == NULL) 01363 return (CIF_NOMEM); 01364 (void) strcpy (lint_dir->name, c); 01365 lint_dir->val = atol (token()); 01366 lint_dir->objid = atol (token()); 01367 lint_dir->fid = atol (token()); 01368 lint_dir->strline = atol (token()); 01369 lint_dir->strpos = atol (token()); 01370 lint_dir->endline = atol (token()); 01371 lint_dir->endpos = atol (token()); 01372 01373 return (CIF_C_LINT_DIRECTIVE); 01374 } 01375 01376 static int ascii_c_macro_def (macro_def) 01377 struct Cif_c_macro_def *macro_def; 01378 { 01379 register long i; 01380 register char *c; 01381 01382 macro_def->symid = atol (token()); 01383 01384 c = token(); 01385 macro_def->nlen = i = strlen (c); 01386 macro_def->name = _Cif_space[lmode] (i+1, lcifd); 01387 if (macro_def->name == NULL) 01388 return (CIF_NOMEM); 01389 (void) strcpy (macro_def->name, c); 01390 01391 macro_def->fid = atol (token()); 01392 macro_def->strline = atol (token()); 01393 macro_def->strpos = atol (token()); 01394 macro_def->endline = atol (token()); 01395 macro_def->endpos = atol (token()); 01396 01397 return (CIF_C_MACRO_DEF); 01398 } 01399 01400 static int ascii_c_macro_undef (macro_undef) 01401 struct Cif_c_macro_undef *macro_undef; 01402 { 01403 01404 macro_undef->symid = atol (token()); 01405 macro_undef->fid = atol (token()); 01406 macro_undef->line = atol (token()); 01407 macro_undef->cpos = atol (token()); 01408 01409 return (CIF_C_MACRO_UNDEF); 01410 } 01411 01412 static int ascii_c_macro_usage (macro_use) 01413 struct Cif_c_macro_usage *macro_use; 01414 { 01415 macro_use->useid = atol(token()); 01416 macro_use->symid = atol(token()); 01417 macro_use->fid = atol(token()); 01418 macro_use->strline = atol(token()); 01419 macro_use->strpos = atol(token()); 01420 macro_use->endline = atol(token()); 01421 macro_use->endpos = atol(token()); 01422 01423 return (CIF_C_MACRO_USAGE); 01424 } 01425 01426 01427 /* v1 to v2 difference : v2 has a message code value */ 01428 01429 static int ascii_c_message (msg) 01430 struct Cif_c_message *msg; 01431 { 01432 register char *c; 01433 register int tmp; 01434 01435 /* If the user wants a v1 cif, then we need to use a different data 01436 structure */ 01437 01438 if (_Cif_filetbl[lcifd].return_version == 1) { 01439 struct Cif_c_message_1 *msg1 = (struct Cif_c_message_1 *) msg; 01440 01441 msg1->severity = atoi(token()); 01442 msg1->msgno = atoi(token()); 01443 01444 /* No message code in v1 c_message record */ 01445 01446 /* msg->msgcode = atoi(token()); */ 01447 01448 if (_Cif_filetbl[lcifd].version != 1) /* but we are reading a v2 cif 01449 which has the message code, so skip it */ 01450 (void) token(); 01451 01452 msg1->fid = atol(token()); 01453 msg1->fline = atol(token()); 01454 c = token(); 01455 msg1->flinesuf = *c; 01456 msg1->incid = atol(token()); 01457 msg1->iline = atol(token()); 01458 tmp = strlist(&(msg1->args)); 01459 if (tmp < 0) 01460 return (CIF_NOMEM); 01461 msg1->nargs = tmp; 01462 } 01463 else { /* a v2 cif */ 01464 01465 msg->severity = atoi(token()); 01466 msg->msgno = atoi(token()); 01467 01468 if (_Cif_filetbl[lcifd].version != 1) /* v1 cif doesn't have a message code id */ 01469 msg->msgcode = atoi(token()); 01470 /* else the message code value has already been set to zero */ 01471 01472 msg->fid = atol(token()); 01473 msg->fline = atol(token()); 01474 c = token(); 01475 msg->flinesuf = *c; 01476 msg->incid = atol(token()); 01477 msg->iline = atol(token()); 01478 tmp = strlist(&(msg->args)); 01479 if (tmp < 0) 01480 return (CIF_NOMEM); 01481 msg->nargs = tmp; 01482 } 01483 01484 return (CIF_C_MESSAGE); 01485 } 01486 01487 01488 01489 /* v1 to v2 difference : entity value 11 -> 10, 12 -> 11 */ 01490 01491 static int ascii_c_object (obj) 01492 struct Cif_c_object *obj; 01493 { 01494 register char *c; 01495 register int i; 01496 int basic, qual; 01497 01498 01499 /* 01500 * If the user wants a v1 cif, then we need to use a different data 01501 * structure 01502 */ 01503 01504 if (_Cif_filetbl[lcifd].return_version == 1) { 01505 struct Cif_c_object_1 *obj1 = (struct Cif_c_object_1 *) obj; 01506 01507 c = token(); 01508 obj1->nlen = i = strlen (c); 01509 obj1->name = _Cif_space[lmode] (i+1, lcifd); 01510 if (obj1->name == NULL) 01511 return (CIF_NOMEM); 01512 (void) strcpy (obj1->name, c); 01513 obj1->symid = atol (token()); 01514 obj1->entity = atoi (token()); 01515 01516 /* v1 entity values 11 and 12 map to v2 enity values of 10 and 11 */ 01517 01518 if (_Cif_filetbl[lcifd].version != 1 && 01519 (obj1->entity == 10 || obj1->entity == 11)) 01520 obj1->entity ++; 01521 01522 obj1->symclass = atoi (token()); 01523 obj1->scope = atoi (token()); 01524 obj1->tagid = atol (token()); 01525 obj1->psymid = atol (token()); 01526 obj1->size = atoi (token()); 01527 if ((i = filltype(&basic, &qual, &(obj1->mods))) < 0) 01528 return (CIF_NOMEM); 01529 obj1->nmods = i; 01530 obj1->qual = qual; 01531 obj1->btype = basic; 01532 01533 } 01534 else { /* return a v2 cif */ 01535 01536 c = token(); 01537 obj->nlen = i = strlen (c); 01538 obj->name = _Cif_space[lmode] (i+1, lcifd); 01539 if (obj->name == NULL) 01540 return (CIF_NOMEM); 01541 (void) strcpy (obj->name, c); 01542 obj->symid = atol (token()); 01543 obj->entity = atoi (token()); 01544 01545 /* v1 entity values 11 and 12 map to v2 enity values of 10 and 11 */ 01546 01547 if (_Cif_filetbl[lcifd].version == 1 && 01548 (obj->entity == 11 || obj->entity == 12)) 01549 obj->entity --; 01550 01551 obj->symclass = atoi (token()); 01552 obj->scope = atoi (token()); 01553 obj->tagid = atol (token()); 01554 obj->psymid = atol (token()); 01555 obj->size = atoi (token()); 01556 if ((i = filltype(&basic, &qual, &(obj->mods))) < 0) 01557 return (CIF_NOMEM); 01558 obj->nmods = i; 01559 obj->qual = qual; 01560 obj->btype = basic; 01561 01562 if (delim == SEPARATOR) { 01563 obj->link = atol(token()); 01564 } 01565 } 01566 01567 return (CIF_C_OBJECT); 01568 } 01569 01570 static int ascii_c_opts (opt) 01571 struct Cif_c_opts *opt; 01572 { 01573 register char *c; 01574 register long i; 01575 01576 c = token(); 01577 opt->nlen = i = strlen (c); 01578 opt->name = _Cif_space[lmode] (i+1, lcifd); 01579 if (opt->name == NULL) 01580 return (CIF_NOMEM); 01581 (void) strcpy (opt->name, c); 01582 (void) strcpy (opt->bopts, token()); 01583 opt->msglev = atoi(token()); 01584 opt->truncval = atoi (token()); 01585 opt->debug = *token(); 01586 (void) strncpy (opt->report, token(), sizeof(opt->report)); 01587 opt->atsklev = atoi (token()); 01588 opt->inlnlev = atoi (token()); 01589 opt->sclrlev = atoi (token()); 01590 opt->vctrlev = atoi (token()); 01591 if ((i = strlist(&(opt->incs))) < 0) 01592 return (CIF_NOMEM); 01593 opt->nincs = i; 01594 if ((i = strlist(&(opt->defs))) < 0) 01595 return (CIF_NOMEM); 01596 opt->ndefs = i; 01597 if ((i = strlist(&(opt->udefs))) < 0) 01598 return (CIF_NOMEM); 01599 opt->nudefs = i; 01600 01601 return (CIF_C_OPTS); 01602 } 01603 01604 01605 /* v1 to v2 difference : entity value 10 -> 9 */ 01606 01607 static int ascii_c_tag (tag) 01608 struct Cif_c_tag *tag; 01609 { 01610 register char *c; 01611 register long i; 01612 int basic, qual; 01613 register int tmp; 01614 01615 c = token(); 01616 tag->nlen = i = strlen(c); 01617 tag->name = _Cif_space[lmode] (i+1, lcifd); 01618 if (tag->name == NULL) 01619 return (CIF_NOMEM); 01620 (void) strcpy (tag->name, c); 01621 tag->tagid = atol (token()); 01622 tag->entity = atoi (token()); 01623 01624 /* v1 entity value 10 maps to v2 enity values of 9 */ 01625 01626 if (_Cif_filetbl[lcifd].version == 1 && 01627 _Cif_filetbl[lcifd].return_version != 1 && 01628 tag->entity == 10) 01629 tag->entity = 9; 01630 else 01631 if (_Cif_filetbl[lcifd].version != 1 && 01632 _Cif_filetbl[lcifd].return_version == 1 && 01633 tag->entity == 9) 01634 tag->entity = 10; 01635 01636 tag->size = atoi (token()); 01637 tmp = llist(&(tag->memids), (int *) NULL); 01638 if (tmp < 0) 01639 return (CIF_NOMEM); 01640 tag->nmems = tmp; 01641 tmp = filltype(&basic, &qual, &(tag->mods)); 01642 if (tmp < 0) 01643 return (CIF_NOMEM); 01644 tag->nmods = tmp; 01645 tag->qual = qual; 01646 tag->btype = basic; 01647 01648 return (CIF_C_TAG); 01649 } 01650 01651 static int ascii_callsite (cs) 01652 struct Cif_callsite *cs; 01653 { 01654 01655 register long i; 01656 register int nargs; 01657 01658 cs->entryid = atol (token()); 01659 cs->fid = atol (token()); 01660 cs->line = atol (token()); 01661 cs->cpos = atol (token()); 01662 if ( (nargs = cs->nargs = atoi (token())) > 0) { 01663 cs->argids = (long *)_Cif_space[lmode] (sizeof(long)*nargs, lcifd); 01664 if (cs->argids == NULL) 01665 return (CIF_NOMEM); 01666 i = 0; 01667 while (i < nargs) 01668 cs->argids[i++] = atol (token()); 01669 } 01670 if (delim == SEPARATOR) 01671 cs->valused = (*token() == 'F' ? 0 : 1); 01672 return (CIF_CALLSITE); 01673 01674 } 01675 01676 static int ascii_cifhdr (hdr) 01677 struct Cif_cifhdr *hdr; 01678 { 01679 01680 (void) token(); /* must be "cif" */ 01681 hdr->version = atoi (token()+1); 01682 hdr->lang = _Cif_filetbl[lcifd].lang = atoi (token()); 01683 01684 /* 01685 * Set the srcfid, set earlier from looking 01686 * ahead to the srcfile record 01687 * in v1, this used to be an unused field, so no need to mask out 01688 */ 01689 01690 hdr->srcfid = _Cif_filetbl[lcifd].srcfid; 01691 01692 /* 01693 * F90 has a slightly different cif_usage record, so use a different 01694 * parse routine 01695 */ 01696 01697 #ifndef CRAY2 01698 if (_Cif_filetbl[lcifd].lang == CIF_LG_F90) { 01699 ascii_record[CIF_USAGE] = ascii_f90_usage; 01700 } 01701 else { 01702 ascii_record[CIF_USAGE] = ascii_usage; 01703 } 01704 #endif /* CRAY2 */ 01705 01706 (void) strcpy (hdr->cvers, token()); 01707 (void) strcpy (hdr->date, token()); 01708 (void) strcpy (hdr->time, token()); 01709 (void) strcpy (hdr->group, token()); 01710 hdr->msgfid = atol (token()); 01711 01712 /* 01713 * We need this so that when returning a v1 cif, we do not 01714 * return the file record associated with the message catalog 01715 */ 01716 01717 global_msgfid = hdr->msgfid; 01718 (void) strncpy (hdr->machname, token(), 8); 01719 (void) strncpy (hdr->hostcpu, token(), 8); 01720 hdr->hostcpu[8] = '\0'; /* make sure that the string is terminated */ 01721 hdr->canpos = _Cif_filetbl[lcifd].seek; 01722 hdr->form = ASCII_CIF_FORMAT; 01723 hdr->form = 0; 01724 return (CIF_CIFHDR); 01725 01726 } 01727 01728 static int ascii_comblk (cb) 01729 struct Cif_comblk *cb; 01730 { 01731 01732 register char *c; 01733 register long i; 01734 01735 /* 01736 * If the user wants a v1 cif, then we need to use a different data 01737 * structure 01738 */ 01739 01740 if (_Cif_filetbl[lcifd].return_version == 1) { 01741 struct Cif_comblk_1 *cb1 = (struct Cif_comblk_1 *) cb; 01742 01743 c = token(); 01744 cb1->nlen = i = strlen (c); 01745 cb1->name = _Cif_space[lmode] (i+1, lcifd); 01746 if (cb1->name == NULL) 01747 return (CIF_NOMEM); 01748 (void) strcpy (cb1->name, c); 01749 cb1->symid = atol (token()); 01750 cb1->cbtype = atoi (token()); 01751 cb1->length = atol (token()); 01752 01753 /* No distribution code in v1 c_message record */ 01754 01755 /* cb1->dist = atoi(token()); */ 01756 01757 if (_Cif_filetbl[lcifd].version != 1) /* but we are reading a v2 cif 01758 which has the distribution code, so skip it */ 01759 (void) token(); 01760 01761 } 01762 01763 else { /* version 2 cif */ 01764 01765 c = token(); 01766 cb->nlen = i = strlen (c); 01767 cb->name = _Cif_space[lmode] (i+1, lcifd); 01768 if (cb->name == NULL) 01769 return (CIF_NOMEM); 01770 (void) strcpy (cb->name, c); 01771 cb->symid = atol (token()); 01772 cb->cbtype = atoi (token()); 01773 cb->length = atol (token()); 01774 01775 if (_Cif_filetbl[lcifd].version != 1) { /* v1 cif doesn't have a distribution code id */ 01776 c = token(); 01777 if (c != (char *) NULL && 01778 *c != (char) NULL) 01779 cb->dist = atoi(c); 01780 } 01781 /* else the distribution code value has already been set to zero */ 01782 01783 } 01784 01785 return (CIF_COMBLK); 01786 01787 } 01788 01789 01790 static int ascii_const (con) 01791 struct Cif_const *con; 01792 { 01793 register int i; 01794 register char *c; 01795 register long attr; 01796 register int n; 01797 01798 /* 01799 * If the user wants a v1 cif, then we need to use a different data 01800 * structure 01801 */ 01802 01803 if (_Cif_filetbl[lcifd].return_version == 1) { 01804 struct Cif_const_1 *con1 = (struct Cif_const_1 *) con; 01805 01806 c = token(); 01807 con1->nlen = i= strlen (c); 01808 con1->name = _Cif_space[lmode] (i+1, lcifd); 01809 if (con1->name == NULL) 01810 return (CIF_NOMEM); 01811 (void) strcpy (con1->name, c); 01812 con1->symid = atol (token()); 01813 con1->dtype = atoi (token()); 01814 if (con1->dtype == 100) 01815 con1->dtype = 0; 01816 else 01817 (con1->dtype)++; 01818 01819 /* get constant value - multiple values not implemented */ 01820 01821 if ( (con1->nvalues = atoi (token())) == 1) { 01822 01823 con1->vlen = i = strlen (c = token()); 01824 con1->value = _Cif_space[lmode] (i+1, lcifd); 01825 if (con1->value == NULL) 01826 return (CIF_NOMEM); 01827 (void) strcpy (con1->value, c); 01828 01829 } 01830 01831 /* get attributes */ 01832 01833 attr = strtol (token(), (char **)NULL, 16); 01834 con1->imptype = ((attr & CO_ATTR_IMPTYPE) != 0); 01835 01836 /* No original form flag in v1 c_message record */ 01837 01838 /* cb1->origform = 0; */ 01839 /* cb1->olen = 0; */ 01840 /* cb1->oform = (char *) NULL; */ 01841 01842 if (_Cif_filetbl[lcifd].version != 1) { /* but we are reading a v2 cif 01843 * which has the original flag/value, 01844 * so skip them 01845 */ 01846 (void) token(); 01847 if (delim == SEPARATOR) 01848 (void) token(); 01849 } 01850 } 01851 else { /* version 2 cif */ 01852 c = token(); 01853 con->nlen = i= strlen (c); 01854 con->name = _Cif_space[lmode] (i+1, lcifd); 01855 if (con->name == NULL) 01856 return (CIF_NOMEM); 01857 (void) strcpy (con->name, c); 01858 con->symid = atol (token()); 01859 con->dtype = atoi (token()); 01860 if (con->dtype == 100) 01861 con->dtype = 0; 01862 else 01863 (con->dtype)++; 01864 01865 /* get constant value - multiple values not implemented */ 01866 01867 if ( (con->nvalues = atoi (token())) == 1) { 01868 con->vlen = i = strlen (c = token()); 01869 con->value = _Cif_space[lmode] (i+1, lcifd); 01870 if (con->value == NULL) 01871 return (CIF_NOMEM); 01872 (void) strcpy (con->value, c); 01873 } 01874 01875 /* get attributes */ 01876 01877 attr = strtol (token(), (char **)NULL, 16); 01878 con->imptype = ((attr & CO_ATTR_IMPTYPE) != 0); 01879 /* If character type, read the character length */ 01880 if ((attr & CO_ATTR_CHAR) != 0) { 01881 (void) token(); 01882 } 01883 01884 /* Read the dimensions - not stored in the cif */ 01885 if ((attr & CO_ATTR_DIM) != 0) { 01886 n = atoi(token()); 01887 01888 while (n > 0) { 01889 (void) token(); /* discard lower bound */ 01890 (void) token(); /* discard upper bound */ 01891 n--; 01892 } 01893 01894 } 01895 01896 if (_Cif_filetbl[lcifd].version != 1) { /* v1 cif doesn't have the oiginal 01897 * form fields 01898 */ 01899 con->origform = atoi(token()); 01900 if (con->origform) { 01901 c = token(); 01902 con->olen = i = strlen (c); 01903 con->oform = _Cif_space[lmode] (i+1, lcifd); 01904 if (con->oform == NULL) 01905 return (CIF_NOMEM); 01906 (void) strcpy (con->oform, c); 01907 } 01908 } 01909 /* else the original form fields have already been set to zero */ 01910 } 01911 return (CIF_CONST); 01912 01913 } 01914 01915 01916 static int ascii_edopts (eo) 01917 struct Cif_edopts *eo; 01918 { 01919 01920 eo->opts = strtol (token(), (char **)NULL, 16); 01921 return (CIF_EDOPTS); 01922 01923 } 01924 01925 static int ascii_entry (entry) 01926 struct Cif_entry *entry; 01927 { 01928 01929 register char *c; 01930 register long i, len; 01931 01932 c = token(); 01933 entry->nlen = len = strlen (c); 01934 entry->name = _Cif_space[lmode] (len+1, lcifd); 01935 if (entry->name == NULL) 01936 return (CIF_NOMEM); 01937 (void) strcpy (entry->name, c); 01938 entry->symid = atol (token()); 01939 entry->etype = atol (token()); 01940 entry->dtype = atol (token()); 01941 if (entry->dtype == 100) 01942 entry->dtype = 0; 01943 else 01944 (entry->dtype)++; 01945 01946 /* get argument ids */ 01947 01948 if ( (len = atoi (token())) >= 0) { 01949 entry->valargs = 1; 01950 if (len > 0) { 01951 entry->nargs = len; 01952 entry->argids = (long *)_Cif_space[lmode] (sizeof(long)*len, lcifd); 01953 if (entry->argids == NULL) 01954 return (CIF_NOMEM); 01955 for (i = 0; i < len; i++) 01956 (entry->argids)[i] = atol (token()); 01957 } 01958 } 01959 01960 /* get attributes */ 01961 01962 i = strtol (token(), (char **)NULL, 16); 01963 entry->recur = ((i & EN_ATTR_RECUR) != 0); 01964 entry->stmtfunc = ((i & EN_ATTR_STMTF) != 0); 01965 entry->extrn = ((i & EN_ATTR_EXTERN) != 0); 01966 entry->intrin = ((i & EN_ATTR_INTRIN) != 0); 01967 entry->imptype = ((i & EN_ATTR_IMPTYPE) != 0); 01968 if ((i & EN_ATTR_CHAR) != 0) 01969 entry->charlen = atol (token()); 01970 else 01971 entry->charlen = 0; 01972 return (CIF_ENTRY); 01973 01974 } 01975 01976 static int ascii_file (file) 01977 struct Cif_file *file; 01978 { 01979 01980 register char *c; 01981 register long len; 01982 01983 if (_Cif_filetbl[lcifd].return_version == 3) { 01984 01985 c = token(); 01986 01987 file->nlen = len = strlen (c); 01988 file->name = _Cif_space[lmode] (len+1, lcifd); 01989 if (file->name == NULL) 01990 return (CIF_NOMEM); 01991 (void) strcpy (file->name, c); 01992 file->fid = atol (token()); 01993 01994 if (delim == SEPARATOR) { 01995 01996 c = token(); 01997 01998 file->onlen = len = strlen (c); 01999 file->oname = _Cif_space[lmode] (len+1, lcifd); 02000 if (file->oname == NULL) 02001 return (CIF_NOMEM); 02002 (void) strcpy (file->oname, c); 02003 } 02004 } 02005 else { /* returning a v<3 CIF */ 02006 02007 struct Cif_file_1 *file1 = (struct Cif_file_1 *) file; 02008 02009 c = token(); 02010 02011 file1->nlen = len = strlen (c); 02012 file1->name = _Cif_space[lmode] (len+1, lcifd); 02013 if (file1->name == NULL) 02014 return (CIF_NOMEM); 02015 (void) strcpy (file1->name, c); 02016 file1->fid = atol (token()); 02017 02018 /* 02019 * If we are returning a version 1 cif and the file is the 02020 * message catalog, which didn't appear in v1 cif's 02021 * then don't return it. 02022 */ 02023 if (_Cif_filetbl[lcifd].lang == CIF_LG_F77 && 02024 file1->fid == global_msgfid && 02025 _Cif_filetbl[lcifd].return_version == 1) { 02026 return ( CIF_MAXRECORD ); /* flags an invalid record */ 02027 } 02028 02029 02030 } 02031 return (CIF_FILE); 02032 02033 } 02034 02035 static int ascii_include (inc) 02036 struct Cif_include *inc; 02037 { 02038 02039 inc->srcid = atol (token()); 02040 inc->line = atol (token()); 02041 inc->cpos = atol (token()); 02042 inc->incid = atol (token()); 02043 return (CIF_INCLUDE); 02044 02045 } 02046 02047 static int ascii_label (label) 02048 struct Cif_label *label; 02049 { 02050 02051 register char *c; 02052 register long i; 02053 02054 c = token(); 02055 label->nlen = i = strlen (c); 02056 label->name = _Cif_space[lmode] (i+1, lcifd); 02057 if (label->name == NULL) 02058 return (CIF_NOMEM); 02059 (void) strcpy (label->name, c); 02060 label->symid = atol (token()); 02061 label->ltype = atoi (token()); 02062 return (CIF_LABEL); 02063 02064 } 02065 02066 static int ascii_loop (loop) 02067 struct Cif_loop *loop; 02068 { 02069 02070 loop->lptype = atol (token()); 02071 loop->sfid = atol (token()); 02072 loop->strline = atol (token()); 02073 loop->strcpos = atol (token()); 02074 loop->efid = atol (token()); 02075 loop->endline = atol (token()); 02076 loop->endcpos = atol (token()); 02077 if (delim == SEPARATOR) 02078 loop->symid = atol (token()); 02079 if (delim == SEPARATOR) 02080 loop->labelid = atol (token()); 02081 return (CIF_LOOP); 02082 02083 } 02084 02085 /* --- Fortran machine characteristic values mask --- */ 02086 #define NFORTCHARS 8 02087 #define CIF_MCF_TAILGT 0x01 02088 #define CIF_MCF_BDM 0x02 02089 #define CIF_MCF_CIGS 0x04 02090 #define CIF_MCF_EMA 0x08 02091 #define CIF_MCF_READVL 0x10 02092 #define CIF_MCF_VPOP 0x20 02093 #define CIF_MCF_VRECUR 0x40 02094 #define CIF_MCF_AVL 0x80 02095 02096 02097 /* 02098 * Note. Machine characteristic became unnecessarily complicated 02099 * between C, F77 and F90 and from v1 to v2. F77 started off with 02100 * it's own subset of the full set. C provided a more complete 02101 * set of characteristics, so for F77 we mapped the compiler 02102 * provided list to be what C gave. In v2, F77 now provides 02103 * the more complete list (as do F90 for the start). But if a user 02104 * requires a v1 cif from a v2 cif, we have to mask out thouse bits 02105 * not previosly available. 02106 */ 02107 02108 02109 static int ascii_mach_char (mc) 02110 struct Cif_mach_char *mc; 02111 { 02112 int i; 02113 long valmask; 02114 02115 static int fort_mc[NFORTCHARS] = { 02116 CIF_MCF_TAILGT, 02117 CIF_MCF_BDM, 02118 CIF_MCF_CIGS, 02119 CIF_MCF_EMA, 02120 CIF_MCF_READVL, 02121 CIF_MCF_VPOP, 02122 CIF_MCF_VRECUR, 02123 CIF_MCF_AVL 02124 }; 02125 static int gen_mc[NFORTCHARS] = { 02126 CIF_MC_TAILGT, 02127 CIF_MC_BDM, 02128 CIF_MC_CIGS, 02129 CIF_MC_EMA, 02130 CIF_MC_READVL, 02131 CIF_MC_VPOP, 02132 CIF_MC_VRECUR, 02133 CIF_MC_AVL 02134 }; 02135 02136 /* 02137 * If the user wants a v1 cif, then we need to use a different data 02138 * structure 02139 */ 02140 02141 if (_Cif_filetbl[lcifd].return_version == 1) { 02142 struct Cif_mach_char_1 *mc1 = (struct Cif_mach_char_1 *) mc; 02143 02144 for (i = 0; i < 16; i++) mc1->cpuname[i] = '\0'; 02145 (void) strcpy (mc1->cpuname, token()); 02146 mc1->memspeed = atoi (token()); 02147 mc1->memsize = atol (token()); 02148 valmask = strtol (token(), (char **)NULL, 16); 02149 02150 /* 02151 * If we are reading a cft77 v2 cif, we may have more characteristics 02152 * then v1 could handle, and they will be in different bit places 02153 */ 02154 02155 if (_Cif_filetbl[lcifd].lang == CIF_LG_F77) { 02156 if (_Cif_filetbl[lcifd].version != 1) { 02157 /* 02158 * We have the correct bits, but some of them could 02159 * not be set in v1, so mask those out 02160 */ 02161 #ifdef CRAY2 02162 /* 02163 * On a Cray2, TAILGT was 0x01 in v1, it is now 0x02 02164 * It is the only valid cray2 value for a v1 cif 02165 */ 02166 if (mc1->valmask | CIF_MC_TAILGT_1) { 02167 mc1->valmask = CIF_MC_TAILGT; 02168 } 02169 else { 02170 mc1->valmask = 0; 02171 } 02172 #else /* Non-Cray2 have more bits to mask out */ 02173 mc1->valmask = valmask & CIF_MC_MASK; 02174 #endif /* CRAY2 */ 02175 02176 } 02177 else { /* 02178 * v1 to v1; map what the cif is giving to the correct 02179 * return values, consistent with C 02180 */ 02181 mc1->valmask = 0; 02182 for (i = 0; i < NFORTCHARS; i++) 02183 if (valmask & fort_mc[i]) mc1->valmask |= gen_mc[i]; 02184 } 02185 } 02186 else { /* valmask is already okay for C and F90 */ 02187 mc1->valmask = valmask; 02188 } 02189 /* 02190 * No : number of banks, number of cpus, instruction buffer size 02191 * clock period, number of cluster registers or bank busy time 02192 * fields in a version 1 cif 02193 */ 02194 02195 if (_Cif_filetbl[lcifd].version != 1 && 02196 delim == SEPARATOR) { 02197 /* 02198 * but we are reading a v2 cif which has them 02199 */ 02200 (void) token(); /* num banks */ 02201 (void) token(); /* num cpus */ 02202 (void) token(); /* instruction buffer size */ 02203 (void) token(); /* clock period */ 02204 (void) token(); /* number of cluster register sets */ 02205 (void) token(); /* bank busy time */ 02206 } 02207 02208 } 02209 else { /* return a v2 cif */ 02210 02211 (void) strcpy (mc->cpuname, token()); 02212 02213 mc->memspeed = atoi (token()); 02214 mc->memsize = atol (token()); 02215 valmask = strtol (token(), (char **)NULL, 16); 02216 02217 /* 02218 * we only have to go through this mapping business for F77, 02219 * C and F90 provide the right machine characteristics 02220 */ 02221 02222 if (_Cif_filetbl[lcifd].lang == CIF_LG_F77) { 02223 02224 /* 02225 * if it's a v1 cif, we have to map the bits still from 02226 * what the compiler provides to what we want 02227 */ 02228 02229 if (_Cif_filetbl[lcifd].version == 1) { 02230 mc->valmask = 0; 02231 for (i = 0; i < NFORTCHARS; i++) 02232 if (valmask & fort_mc[i]) mc->valmask |= gen_mc[i]; 02233 } 02234 else /* 02235 * v2 to v2, so just propagate the value which F77 is 02236 * now provide in the correct format 02237 */ 02238 mc->valmask = valmask; 02239 } 02240 else { /* C and F90 provide the correct format directly */ 02241 mc->valmask = valmask; 02242 } 02243 02244 /* Read the extra v2 cif fields (if present) : 02245 * number of banks, number of cpus, instruction buffer size 02246 * clock period, number of cluster registers or bank busy time 02247 */ 02248 02249 if (_Cif_filetbl[lcifd].version != 1 && 02250 delim == SEPARATOR) { 02251 02252 mc->numbanks = atol (token()); 02253 mc->numcpus = atol (token()); 02254 mc->instbufsize = atol (token()); 02255 mc->clockperiod = atol (token()); 02256 mc->numclregs = atol (token()); 02257 mc->bankbusytime = atol (token()); 02258 02259 if (delim == SEPARATOR) 02260 mc->tbitlen = atoi (token()); 02261 02262 } 02263 /* else they will already be set to zero */ 02264 02265 } 02266 02267 return (CIF_MACH_CHAR); 02268 02269 } 02270 02271 static int ascii_message (msg) 02272 struct Cif_message *msg; 02273 { 02274 register char *c; 02275 register long i; 02276 register int tmp; 02277 02278 if (_Cif_filetbl[lcifd].return_version <= 2) { 02279 struct Cif_message_1 *msg1 = (struct Cif_message_1 *) msg; 02280 02281 msg1->severity = atoi (token()); 02282 msg1->msgno = atol (token()); 02283 msg1->fid = atol (token()); 02284 msg1->uline = atol (token()); 02285 msg1->cpos = atoi (token()); 02286 msg1->fline = atol (token()); 02287 tmp = strlist(&(msg1->args)); 02288 if (tmp < 0) 02289 return (CIF_NOMEM); 02290 msg1->nargs = tmp; 02291 02292 } 02293 else { /* Version 3 CIF */ 02294 msg->severity = atoi (token()); 02295 msg->msgno = atol (token()); 02296 msg->fid = atol (token()); 02297 msg->uline = atol (token()); 02298 msg->cpos = atoi (token()); 02299 msg->fline = atol (token()); 02300 tmp = strlist(&(msg->args)); 02301 if (tmp < 0) 02302 return (CIF_NOMEM); 02303 msg->nargs = tmp; 02304 02305 /* scoping unit names are only present in V3 CIF's */ 02306 if (_Cif_filetbl[lcifd].version >= 3 && 02307 delim == SEPARATOR) { 02308 02309 c = token(); 02310 msg->nlen = i = strlen(c); 02311 msg->name = _Cif_space[lmode] (i+1, lcifd); 02312 if (msg->name == NULL) 02313 return (CIF_NOMEM); 02314 (void) strcpy (msg->name, c); 02315 if (delim == SEPARATOR) { 02316 msg->order = atoi(token()); 02317 if (delim == SEPARATOR) { 02318 msg->flags = atoi(token()); 02319 if (delim == SEPARATOR) { 02320 msg->pfid = atol(token()); 02321 } 02322 } 02323 } 02324 } 02325 else { 02326 /* We are creating a version 3 record from a Version 2 02327 * CIF. If this is subsequently passed to a Version 2 02328 * reading application, the pfid is copied into the fid 02329 * as that is the more correct value for V3 CIF's. When 02330 * messages are coming from inlined files the V2 CIF's 02331 * do not contain enough information to make use of the 02332 * two fid values, so the pfid value should be used. 02333 * Once we have a V3 record, libcif can not tell if this 02334 * came from a valid V3 CIF or from a V2->V3 mapping 02335 * process, so it is appropriate to copy the fid into 02336 * the pfid to allow it to be copied back again later 02337 * if necessary. 02338 */ 02339 msg->pfid = msg->fid; 02340 } 02341 02342 } 02343 02344 return (CIF_MESSAGE); 02345 } 02346 02347 static int ascii_misc_opts (mo) 02348 struct Cif_misc_opts *mo; 02349 { 02350 register int i, j; 02351 register char *c; 02352 register int tmp; 02353 02354 /* 02355 * If the user wants a v1 cif, then we need to use a different data 02356 * structure 02357 */ 02358 02359 if (_Cif_filetbl[lcifd].return_version == 1) { 02360 struct Cif_misc_opts_1 *mo1 = (struct Cif_misc_opts_1 *) mo; 02361 02362 mo1->malloc = atoi (token()); 02363 mo1->intlen = atoi (token()); 02364 mo1->msglvl = atoi (token()); 02365 mo1->vopt = atoi (token()); 02366 mo1->amode = atoi (token ()); 02367 mo1->trunc = atoi (token ()); 02368 mo1->truncval = atoi (token()); 02369 tmp = llist(&(mo1->msgno), (int *) NULL); 02370 if (tmp < 0) 02371 return (CIF_NOMEM); 02372 mo1->nmsgs = tmp; 02373 02374 tmp = strlist (&(mo1->cdirs)); 02375 if (tmp < 0) 02376 return (CIF_NOMEM); 02377 02378 mo1->ncdirs = tmp; 02379 c = token(); 02380 if ((mo1->onlen = i = strlen (c)) > 0) { 02381 mo1->objname = _Cif_space[lmode] (i+1, lcifd); 02382 if (mo1->objname == NULL) 02383 return (CIF_NOMEM); 02384 (void) strcpy (mo1->objname, c); 02385 } 02386 c = token(); 02387 if (c != (char *) NULL && (mo1->cnlen = i = strlen (c)) > 0) { 02388 mo1->calname = _Cif_space[lmode] (i+1, lcifd); 02389 if (mo1->calname == NULL) 02390 return (CIF_NOMEM); 02391 (void) strcpy (mo1->calname, c); 02392 } 02393 02394 c = token(); 02395 if (delim == SEPARATOR) { 02396 if (c != (char *) NULL && (mo1->inlen = i = strlen (c)) > 0) { 02397 mo1->inname = _Cif_space[lmode] (i+1, lcifd); 02398 if (mo1->inname == NULL) 02399 return (CIF_NOMEM); 02400 (void) strcpy (mo1->inname, c); 02401 } 02402 } 02403 02404 /* 02405 * No listing name, cif option, input length, run-time checking 02406 * or include file fields in a version 1 cif 02407 */ 02408 02409 if (_Cif_filetbl[lcifd].version != 1) { /* 02410 * but we are reading a v2 cif 02411 * which has the distribution and geometry 02412 * fields, so skip them 02413 */ 02414 (void) token(); /* listing name */ 02415 (void) token(); /* cif option */ 02416 (void) token(); /* input length */ 02417 (void) token(); /* run-time checking */ 02418 i = atoi(token()); /* number includes */ 02419 for (j = 0; j < i; j++) 02420 (void) token(); /* include file name */ 02421 } 02422 02423 02424 } 02425 02426 else { /* return a v2 cif */ 02427 02428 mo->malloc = atoi (token()); 02429 mo->intlen = atoi (token()); 02430 mo->msglvl = atoi (token()); 02431 mo->vopt = atoi (token()); 02432 mo->amode = atoi (token ()); 02433 mo->trunc = atoi (token ()); 02434 mo->truncval = atoi (token()); 02435 tmp = llist(&(mo->msgno), (int *) NULL); 02436 if (tmp < 0) 02437 return (CIF_NOMEM); 02438 mo->nmsgs = tmp; 02439 02440 tmp = strlist (&(mo->cdirs)); 02441 if (tmp < 0) 02442 return (CIF_NOMEM); 02443 mo->ncdirs = tmp; 02444 02445 c = token(); 02446 if ((mo->onlen = i = strlen (c)) > 0) { 02447 mo->objname = _Cif_space[lmode] (i+1, lcifd); 02448 if (mo->objname == NULL) 02449 return (CIF_NOMEM); 02450 (void) strcpy (mo->objname, c); 02451 } 02452 02453 c = token(); 02454 if ((mo->cnlen = i = strlen (c)) > 0) { 02455 mo->calname = _Cif_space[lmode] (i+1, lcifd); 02456 if (mo->calname == NULL) 02457 return (CIF_NOMEM); 02458 (void) strcpy (mo->calname, c); 02459 } 02460 02461 c = token(); 02462 if (delim == SEPARATOR) { 02463 if ((mo->inlen = i = strlen (c)) > 0) { 02464 mo->inname = _Cif_space[lmode] (i+1, lcifd); 02465 if (mo->inname == NULL) 02466 return (CIF_NOMEM); 02467 (void) strcpy (mo->inname, c); 02468 } 02469 } 02470 02471 /* Read the extra v2 cif fields */ 02472 02473 if (_Cif_filetbl[lcifd].version != 1) { 02474 02475 c = token(); 02476 if (delim == SEPARATOR) { 02477 if (c != (char *) NULL && (mo->llen = i = strlen (c)) > 0) { 02478 mo->lname = _Cif_space[lmode] (i+1, lcifd); 02479 if (mo->lname == NULL) 02480 return (CIF_NOMEM); 02481 (void) strcpy (mo->lname, c); 02482 } 02483 } 02484 02485 mo->cifopt = strtol (token(), (char **)NULL, 16); 02486 mo->inputlen = atoi(token()); 02487 mo->runtime = strtol (token(), (char **)NULL, 16); 02488 tmp = strlist (&(mo->incdirs)); 02489 if (tmp < 0) 02490 return (CIF_NOMEM); 02491 mo->numincs = tmp; 02492 } 02493 02494 } 02495 02496 02497 return (CIF_MISC_OPTS); 02498 02499 } 02500 02501 static int ascii_namelist (nl) 02502 struct Cif_namelist *nl; 02503 { 02504 02505 register long i; 02506 register char *c; 02507 02508 c = token(); 02509 nl->nlen = i = strlen (c); 02510 nl->name = _Cif_space[lmode] (i+1, lcifd); 02511 if (nl->name == NULL) 02512 return (CIF_NOMEM); 02513 (void) strcpy (nl->name, c); 02514 nl->symid = atol (token()); 02515 if ((nl->nids = atoi (token())) > 0) { 02516 nl->ids = (long *) _Cif_space[lmode] (sizeof(long)*nl->nids, lcifd); 02517 if (nl->ids == NULL) 02518 return (CIF_NOMEM); 02519 for (i = 0; i < (int) nl->nids; i++) 02520 (nl->ids)[i] = atol (token()); 02521 02522 } 02523 return (CIF_NAMELIST); 02524 02525 } 02526 02527 static int ascii_nd_msg (nmsg) 02528 struct Cif_nd_msg *nmsg; 02529 { 02530 register int tmp; 02531 02532 nmsg->severity = atoi (token()); 02533 nmsg->msgno = atol (token()); 02534 nmsg->fid = atol (token()); 02535 nmsg->fline = atol (token()); 02536 nmsg->cpos = atoi (token()); 02537 nmsg->uline = atol (token()); 02538 (void) strncpy (nmsg->group, token(), 16); 02539 nmsg->msgfid = atol (token()); 02540 02541 tmp = strlist(&(nmsg->args)); 02542 if (tmp < 0) 02543 return (CIF_NOMEM); 02544 nmsg->nargs = tmp; 02545 return (CIF_ND_MSG); 02546 02547 } 02548 02549 02550 /* v1 to v2 difference : v2 has a distribution field and geometry field added */ 02551 02552 static int ascii_object (obj) 02553 struct Cif_object *obj; 02554 { 02555 02556 register char *c; 02557 register long i, attr; 02558 struct Cif_dim *dim; 02559 02560 /* 02561 * If the user wants a v1 cif, then we need to use a different data 02562 * structure 02563 */ 02564 02565 if (_Cif_filetbl[lcifd].return_version == 1) { 02566 struct Cif_object_1 *obj1 = (struct Cif_object_1 *) obj; 02567 02568 c = token(); 02569 if ((obj1->nlen = i = strlen (c)) > 0) { 02570 obj1->name = _Cif_space[lmode] (i+1, lcifd); 02571 if (obj1->name == NULL) 02572 return (CIF_NOMEM); 02573 (void) strcpy (obj1->name, c); 02574 } 02575 else 02576 obj1->name = NULL; 02577 obj1->symid = atol (token()); 02578 obj1->dtype = atoi (token()); 02579 if (obj1->dtype == 100) 02580 obj1->dtype = 0; 02581 else 02582 (obj1->dtype)++; 02583 02584 obj1->symclass = atoi (token()); 02585 02586 obj1->storage = atol (token()); 02587 if ((i = atol (token())) >= 0) { 02588 obj1->valoffset = 1; 02589 obj1->offset = i; 02590 } 02591 02592 02593 /* get attributes */ 02594 attr = strtol (token(), (char **)NULL, 16); 02595 obj1->aarray = ((attr & CO_ATTR_AUTO) != 0); 02596 obj1->equiv = ((attr & CO_ATTR_EQUIV) != 0); 02597 obj1->data = ((attr & CO_ATTR_DATA) != 0); 02598 obj1->save = ((attr & CO_ATTR_SAVE) != 0); 02599 obj1->imptype = ((attr & CO_ATTR_IMPTYPE) != 0); 02600 02601 /* 02602 * PE_RESIDENT, pointee, array and geometry 02603 * declaration fields didn't exist on v1, so don't set them 02604 */ 02605 02606 /* 02607 obj1->peresident == ((attr & CO_ATTR_PE_RESIDENT) != 0); 02608 obj1->pointee == ((attr & CO_ATTR_POINTEE) != 0); 02609 obj1->array_dec == ((attr & CO_ATTR_ARRAY_DEC) != 0); 02610 obj1->geom_dec == ((attr & CO_ATTR_GEOM_DEC) != 0); 02611 */ 02612 02613 if ((attr & CO_ATTR_CHAR) != 0) { 02614 c = token (); 02615 if (*c == '*') 02616 obj1->cltype = 1; 02617 else 02618 obj1->charlen = atol (c); 02619 } 02620 else 02621 obj1->charlen = 0; 02622 if ((attr & CO_ATTR_DIM) == 0) 02623 obj1->ndims = 0; 02624 else { 02625 obj1->ndims = atoi (token()); 02626 dim = obj1->dim = (struct Cif_dim *)_Cif_space[lmode] 02627 (sizeof(struct Cif_dim)*obj1->ndims, lcifd); 02628 if (dim == NULL) 02629 return (CIF_NOMEM); 02630 for (i=0; i < (int) obj1->ndims; i++) { 02631 c = token (); 02632 if (*c == 'E') 02633 dim->ltype = CIF_DM_EXPR; 02634 else if (*c == '*') 02635 dim->ltype = CIF_DM_ASSUMED; 02636 else { 02637 dim->ltype = CIF_DM_CONSTANT; 02638 dim->lower = atol (c); 02639 } 02640 c = token (); 02641 if (*c == 'E') 02642 dim->utype = CIF_DM_EXPR; 02643 else if (*c == '*') 02644 dim->utype = CIF_DM_ASSUMED; 02645 else { 02646 dim->utype = CIF_DM_CONSTANT; 02647 dim->upper = atol (c); 02648 } 02649 dim++; 02650 } 02651 } 02652 02653 /* No distribution, geometry id or pointer id in v1 cif */ 02654 02655 /* obj1->distribution = atoi(token()); */ 02656 /* obj1->geomid = atoi(token()); */ 02657 /* obj1->pointer = atoi(token()); */ 02658 02659 if (_Cif_filetbl[lcifd].version != 1) { /* 02660 * but we are reading a v2 cif 02661 * which has the distribution and geometry 02662 * fields, so skip them 02663 */ 02664 (void) token(); /* distribution, geometry id and pointer id */ 02665 (void) token(); /* they wouldn't all be there, but that's okay, */ 02666 (void) token(); /* token will just keep giving the eol */ 02667 } 02668 02669 } 02670 else { /* returning a v2 cif */ 02671 c = token(); 02672 if ((obj->nlen = i = strlen (c)) > 0) { 02673 obj->name = _Cif_space[lmode] (i+1, lcifd); 02674 if (obj->name == NULL) 02675 return (CIF_NOMEM); 02676 (void) strcpy (obj->name, c); 02677 } 02678 else 02679 obj->name = NULL; 02680 obj->symid = atol (token()); 02681 obj->dtype = atoi (token()); 02682 if (obj->dtype == 100) 02683 obj->dtype = 0; 02684 else 02685 (obj->dtype)++; 02686 02687 obj->symclass = atoi (token()); 02688 obj->storage = atol (token()); 02689 if ((i = atol (token())) >= 0) { 02690 obj->valoffset = 1; 02691 obj->offset = i; 02692 } 02693 02694 02695 /* get attributes */ 02696 attr = strtol (token(), (char **)NULL, 16); 02697 obj->aarray = ((attr & CO_ATTR_AUTO) != 0); 02698 obj->equiv = ((attr & CO_ATTR_EQUIV) != 0); 02699 obj->data = ((attr & CO_ATTR_DATA) != 0); 02700 obj->save = ((attr & CO_ATTR_SAVE) != 0); 02701 obj->imptype = ((attr & CO_ATTR_IMPTYPE) != 0); 02702 02703 /* 02704 * There's no chance of getting these next few from a v1 cif, but 02705 * it does no harm to look 02706 */ 02707 02708 obj->peresident = ((attr & CO_ATTR_PE_RESIDENT) != 0); 02709 obj->pointee = ((attr & CO_ATTR_POINTEE) != 0); 02710 obj->arraydec = ((attr & CO_ATTR_ARRAY_DEC) != 0); 02711 obj->geomdec = ((attr & CO_ATTR_GEOM_DEC) != 0); 02712 02713 if ((attr & CO_ATTR_CHAR) != 0) { 02714 c = token (); 02715 if (*c == '*') 02716 obj->cltype = 1; 02717 else 02718 obj->charlen = atol (c); 02719 } 02720 else 02721 obj->charlen = 0; 02722 if ((attr & CO_ATTR_DIM) == 0) 02723 obj->ndims = 0; 02724 else { 02725 obj->ndims = atoi (token()); 02726 dim = obj->dim = (struct Cif_dim *)_Cif_space[lmode] 02727 (sizeof(struct Cif_dim)*obj->ndims, lcifd); 02728 02729 if (dim == NULL) 02730 return (CIF_NOMEM); 02731 for (i=0; i < (int) obj->ndims; i++) { 02732 c = token (); 02733 if (*c == 'E') 02734 dim->ltype = CIF_DM_EXPR; 02735 else if (*c == '*') 02736 dim->ltype = CIF_DM_ASSUMED; 02737 else { 02738 dim->ltype = CIF_DM_CONSTANT; 02739 dim->lower = atol (c); 02740 } 02741 c = token (); 02742 if (*c == 'E') 02743 dim->utype = CIF_DM_EXPR; 02744 else if (*c == '*') 02745 dim->utype = CIF_DM_ASSUMED; 02746 else { 02747 dim->utype = CIF_DM_CONSTANT; 02748 dim->upper = atol (c); 02749 } 02750 dim++; 02751 } 02752 } 02753 02754 if (_Cif_filetbl[lcifd].version != 1) { /* 02755 * v1 cif doesn't have the distribution, 02756 * geometry id or pointer fields 02757 */ 02758 /* 02759 * read the token first to see of it is not null; it is possible that 02760 * a non-MPP compkiler will not put out these fields, or they will be NULL 02761 */ 02762 02763 c = token(); 02764 if (c != (char *) NULL && 02765 *c != (char) NULL) 02766 obj->dist = atoi(c); 02767 02768 if (obj->pointee || obj->dist == 3) { /* 3 is SHARED dimensional */ 02769 c = token(); 02770 if (c != (char *) NULL && 02771 *c != (char) NULL) 02772 if (obj->pointee) 02773 obj->pointer = atol(c); 02774 else 02775 obj->geomid = atol(c); 02776 } 02777 /* else the distribution, geometry and pointer fields have already been set to zero */ 02778 02779 } 02780 } 02781 02782 return (CIF_OBJECT); 02783 02784 } 02785 02786 static int ascii_opt_opts (oo) 02787 struct Cif_opt_opts *oo; 02788 { 02789 /* 02790 * If the user wants a v1 cif, then we need to use a different data 02791 * structure 02792 */ 02793 02794 if (_Cif_filetbl[lcifd].return_version == 1) { 02795 struct Cif_opt_opts_1 *oo1 = (struct Cif_opt_opts_1 *) oo; 02796 02797 oo1->values = strtol (token(), (char **)NULL, 16); 02798 02799 /* No inline level field in a v1 cif */ 02800 02801 if (_Cif_filetbl[lcifd].version != 1) { /* 02802 * but we are reading a v2 cif 02803 * which has the inline level field 02804 */ 02805 if (oo1->values == CIF_OOF_INLINE) 02806 (void) token(); 02807 } 02808 02809 02810 } 02811 else { /* returning a v2 cif */ 02812 02813 oo->values = strtol (token(), (char **)NULL, 16); 02814 02815 if (_Cif_filetbl[lcifd].version != 1) { /* 02816 * v1 cif doesn't have the inline level field 02817 */ 02818 if (oo->values == CIF_OOF_INLINE) 02819 oo->inlevel = atoi(token()); 02820 } 02821 } 02822 02823 return (CIF_OPT_OPTS); 02824 02825 } 02826 02827 static int ascii_srcfile (src) 02828 struct Cif_srcfile *src; 02829 { 02830 02831 src->fid = atol (token()); 02832 if (delim == SEPARATOR) 02833 src->form = atoi (token()); 02834 else 02835 src->form = 0; 02836 return (CIF_SRCFILE); 02837 02838 } 02839 02840 static int ascii_transform (tran) 02841 struct Cif_transform *tran; 02842 { 02843 tran->type = atoi(token()); 02844 tran->fid = atol(token()); 02845 tran->line = atol(token()); 02846 02847 return (CIF_TRANSFORM); 02848 02849 } 02850 02851 static int ascii_stmt_type (stmt) 02852 struct Cif_stmt_type *stmt; 02853 { 02854 02855 stmt->type = atol (token()); 02856 stmt->fid = atol (token()); 02857 stmt->line = atol (token()); 02858 stmt->cpos = atol (token()); 02859 02860 if ( *ntoken != 0 ) 02861 stmt->efid = atol (token()); 02862 if ( *ntoken != 0 ) 02863 stmt->eline = atol (token()); 02864 if ( *ntoken != 0 ) 02865 stmt->ecpos = atol (token()); 02866 02867 /* If we are returning a version 1 cif and the stmt type == CDIR, 02868 * then don't return it as version 1 cif's didn't have cdir stmts 02869 */ 02870 02871 if (stmt->type == CIF_TP_CDIR && 02872 _Cif_filetbl[lcifd].return_version == 1) { 02873 return ( CIF_MAXRECORD ); /* flags an invalid record */ 02874 02875 } 02876 02877 return (CIF_STMT_TYPE); 02878 02879 } 02880 02881 static int ascii_summary (sum) 02882 struct Cif_summary *sum; 02883 { 02884 02885 (void) strcpy (sum->level, token()); 02886 (void) strcpy (sum->gdate, token()); 02887 (void) strcpy (sum->gtime, token()); 02888 (void) strcpy (sum->ctime, token()); 02889 sum->fldlen = atol (token()); 02890 sum->nlines = atol (token()); 02891 sum->csize = atol (token()); 02892 sum->dsize = atol (token()); 02893 return (CIF_SUMMARY); 02894 02895 } 02896 02897 02898 static int ascii_cdir (cdir) 02899 struct Cif_cdir *cdir; 02900 { 02901 register long i; 02902 02903 cdir->type = atoi (token()); 02904 cdir->fid = atol (token()); 02905 cdir->line = atol (token()); 02906 cdir->cpos = atol (token()); 02907 cdir->nids = atoi (token()); 02908 if (cdir->nids > 0) { 02909 cdir->ids = (long *)_Cif_space[lmode] (sizeof(long)*(cdir->nids), lcifd); 02910 for (i = 0; i < (int) cdir->nids; i++) { 02911 cdir->ids[i] = atol (token()); 02912 } 02913 } 02914 02915 return(CIF_CDIR); 02916 } 02917 02918 02919 static int ascii_cdir_doshared (dos) 02920 struct Cif_cdir_doshared *dos; 02921 { 02922 register long i; 02923 char *c; 02924 02925 dos->type = atoi (token()); 02926 c = token(); 02927 dos->random = (*c == '1' ? 1 : 0); 02928 dos->fid = atol (token()); 02929 dos->line = atol (token()); 02930 dos->cpos = atol (token()); 02931 c = token(); 02932 if (*c == 'E') { 02933 dos->mexpr = 1; 02934 dos->m = atol(c); 02935 } 02936 else { 02937 dos->mexpr = 0; 02938 } 02939 dos->mfid = atol (token()); 02940 dos->mline = atol (token()); 02941 dos->mcpos = atol (token()); 02942 dos->nids = atoi (token()); 02943 if (dos->nids > 0) { 02944 dos->ids = (long *)_Cif_space[lmode] (sizeof(long)*(dos->nids), lcifd); 02945 for (i = 0; i < (int) dos->nids; i++) { 02946 dos->ids[i] = atol (token()); 02947 } 02948 } 02949 02950 return(CIF_CDIR_DOSHARED); 02951 } 02952 02953 static int ascii_geometry (geom) 02954 struct Cif_geometry *geom; 02955 { 02956 register long i; 02957 char *c; 02958 struct Cif_geometry_dim *dim; 02959 02960 c = token(); 02961 if (c != (char *) NULL) { 02962 geom->nlen = i = strlen (c); 02963 geom->name = _Cif_space[lmode] (i+1, lcifd); 02964 if (geom->name == NULL) 02965 return (CIF_NOMEM); 02966 (void) strcpy (geom->name, c); 02967 } 02968 else 02969 geom->nlen = 0; 02970 02971 geom->geomid = atol (token()); 02972 geom->ndims = atoi (token()); 02973 dim = geom->dim = (struct Cif_geometry_dim *)_Cif_space[lmode] 02974 (sizeof(struct Cif_geometry_dim)*geom->ndims, lcifd); 02975 if (dim == NULL) 02976 return (CIF_NOMEM); 02977 for (i=0; i < (int) geom->ndims; i++) { 02978 dim->dist = strtol (token(), (char **)NULL, 16); 02979 c = token(); 02980 if (*c == 'E') { 02981 dim->wtype = 1; 02982 dim->weight = 0; 02983 } 02984 else { 02985 dim->wtype = 0; 02986 dim->weight = atol (c); 02987 } 02988 dim->wfid = atol (token()); 02989 dim->wline = atol (token()); 02990 dim->wcpos = atol (token()); 02991 c = token(); 02992 if (*c == 'E') { 02993 dim->btype = 1; 02994 dim->bsize = 0; 02995 } 02996 else { 02997 dim->btype = 0; 02998 dim->bsize = atol (c); 02999 } 03000 dim->bfid = atol (token()); 03001 dim->bline = atol (token()); 03002 dim->bcpos = atol (token()); 03003 03004 dim++; 03005 } 03006 03007 return(CIF_GEOMETRY); 03008 } 03009 03010 static int ascii_continuation (co) 03011 struct Cif_continuation *co; 03012 { 03013 char *c; 03014 03015 c = token(); 03016 co->type = (*c == '0' ? 0 : 1); 03017 co->fid = atol (token()); 03018 co->line = atol (token()); 03019 co->cpos = atol (token()); 03020 03021 return(CIF_CONTINUATION); 03022 } 03023 03024 03025 #ifndef CRAY2 03026 static int ascii_f90_callsite (cs) 03027 struct Cif_f90_callsite *cs; 03028 { 03029 register int i, j; 03030 register int nargs; 03031 register char *c; 03032 03033 cs->entryid = atol (token()); 03034 cs->scopeid = atol (token()); 03035 cs->fid = atol (token()); 03036 cs->line = atol (token()); 03037 cs->cpos = atol (token()); 03038 cs->procid = atol (token()); 03039 nargs = atoi (token()); 03040 if (nargs >= 0) 03041 cs->nargs = nargs; 03042 else 03043 cs->nargs = 0; 03044 if (nargs > 0) { 03045 03046 cs->argids = (long *)_Cif_space[lmode] (sizeof(long)*nargs, lcifd); 03047 if (cs->argids == NULL) 03048 return (CIF_NOMEM); 03049 03050 cs->nmembs = (int *)_Cif_space[lmode] (sizeof(long)*nargs, lcifd); 03051 if (cs->nmembs == NULL) 03052 return (CIF_NOMEM); 03053 03054 cs->membs = (long **)_Cif_space[lmode] (sizeof(long *)*nargs, lcifd); 03055 if (cs->membs == NULL) 03056 return (CIF_NOMEM); 03057 03058 for (i = 0; i < nargs; i++) { 03059 c = token(); 03060 /* 03061 * If the symbol id has members, this field will be %, 03062 * otherwise it is the symbol id 03063 */ 03064 03065 if (*c == '%') { 03066 cs->nmembs[i] = atoi (token()) - 1; 03067 cs->argids[i] = atol (token()); 03068 03069 cs->membs[i] = 03070 (long *)_Cif_space[lmode] (sizeof(long)*cs->nmembs[i], lcifd); 03071 for (j = 0; j < cs->nmembs[i]; j++) { 03072 cs->membs[i][j] = atol( token()); 03073 } 03074 /* now read the lst '%'...redundant really, but no harm done */ 03075 (void) token(); 03076 } 03077 else { 03078 cs->argids[i] = atol (c); 03079 cs->nmembs[i] = 0; 03080 cs->membs[i] = 0; 03081 } 03082 } 03083 03084 } 03085 03086 /* Not issued by the f90 compiler at all; left for comment only 03087 if (delim == SEPARATOR) 03088 cs->valused = (*token() == 'F' ? 0 : 1); 03089 */ 03090 03091 if (delim == SEPARATOR) { 03092 03093 cs->rank = 1; 03094 cs->ranks = (int *)_Cif_space[lmode] (sizeof(int)*nargs, lcifd); 03095 if (cs->ranks == NULL) 03096 return (CIF_NOMEM); 03097 03098 for (i = 0; i < nargs; i++) { 03099 cs->ranks[i] = atoi(token()); 03100 } 03101 } 03102 03103 return(CIF_F90_CALLSITE); 03104 } 03105 03106 03107 static int ascii_f90_comblk (cb) 03108 struct Cif_f90_comblk *cb; 03109 { 03110 register char *c; 03111 register long i; 03112 03113 c = token(); 03114 cb->nlen = i = strlen (c); 03115 cb->name = _Cif_space[lmode] (i+1, lcifd); 03116 if (cb->name == NULL) 03117 return (CIF_NOMEM); 03118 (void) strcpy (cb->name, c); 03119 cb->symid = atol (token()); 03120 cb->scopeid = atol (token()); 03121 cb->cbtype = atoi (token()); 03122 cb->moduleid = atol (token()); 03123 cb->length = atol (token()); 03124 c = token(); 03125 if (c != (char *) NULL) 03126 cb->dist = atoi (c); 03127 03128 return(CIF_F90_COMBLK); 03129 } 03130 03131 03132 static int ascii_f90_const (con) 03133 struct Cif_f90_const *con; 03134 { 03135 register int i; 03136 register char *c; 03137 03138 con->symid = atol (token()); 03139 con->scopeid = atol (token()); 03140 c = token(); 03141 con->aggregate = (*c == '0' ? 0 : 1); 03142 03143 /* get constant value - multiple values not implemented */ 03144 03145 if (con->aggregate == 0) { 03146 con->vlen = i = strlen (c = token()); 03147 con->value = _Cif_space[lmode] (i+1, lcifd); 03148 if (con->value == NULL) 03149 return (CIF_NOMEM); 03150 (void) strcpy (con->value, c); 03151 } 03152 else 03153 c = token(); /* pass the null field for an aggregate constant */ 03154 03155 con->fid = atol (token()); 03156 con->strline = atol (token()); 03157 con->strpos = atol (token()); 03158 con->endline = atol (token()); 03159 con->endpos = atol (token()); 03160 03161 return(CIF_F90_CONST); 03162 } 03163 03164 03165 static int ascii_f90_entry (entry) 03166 struct Cif_f90_entry *entry; 03167 { 03168 03169 register char *c; 03170 register long i, len; 03171 03172 c = token(); 03173 entry->nlen = len = strlen (c); 03174 entry->name = _Cif_space[lmode] (len+1, lcifd); 03175 if (entry->name == NULL) 03176 return (CIF_NOMEM); 03177 (void) strcpy (entry->name, c); 03178 entry->symid = atol (token()); 03179 entry->scopeid = atol (token()); 03180 entry->etype = atoi (token()); 03181 entry->ptype = atoi (token()); 03182 03183 /* get attributes */ 03184 03185 i = strtol (token(), (char **)NULL, 16); 03186 entry->defined = ((i & F90_EN_ATTR_DEFINED) != 0); 03187 entry->intblock = ((i & F90_EN_ATTR_INT_BLOCK) != 0); 03188 entry->referenced = ((i & F90_EN_ATTR_REFERENCED) != 0); 03189 entry->optional = ((i & F90_EN_ATTR_OPTIONAL) != 0); 03190 entry->priv = ((i & F90_EN_ATTR_PRIVATE) != 0); 03191 entry->recur = ((i & F90_EN_ATTR_RECUR) != 0); 03192 entry->useassoc = ((i & F90_EN_ATTR_USE) != 0); 03193 03194 entry->stmtfunc = (entry->etype == CIF_F90_ET_STMT); 03195 03196 entry->resultid = atol (token()); 03197 03198 entry->moduleid = atol (token()); 03199 03200 /* get argument ids */ 03201 03202 if ( (len = atoi (token())) >= 0) { 03203 entry->valargs = 1; 03204 if (len > 0) { 03205 entry->nargs = len; 03206 entry->argids = (long *)_Cif_space[lmode] (sizeof(long)*len, lcifd); 03207 if (entry->argids == NULL) 03208 return (CIF_NOMEM); 03209 for (i = 0; i < len; i++) 03210 (entry->argids)[i] = atol (token()); 03211 } 03212 } 03213 else { 03214 entry->valargs = 0; 03215 entry->nargs = 0; 03216 } 03217 03218 03219 return(CIF_F90_ENTRY); 03220 } 03221 03222 03223 static int ascii_f90_loop (loop) 03224 struct Cif_f90_loop *loop; 03225 { 03226 int statementID; 03227 03228 loop->scopeid = atol (token()); 03229 loop->lptype = atol (token()); 03230 loop->sfid = atol (token()); 03231 loop->strline = atol (token()); 03232 loop->strcpos = atol (token()); 03233 loop->efid = atol (token()); 03234 loop->endline = atol (token()); 03235 loop->endcpos = atol (token()); 03236 if (delim == SEPARATOR) 03237 loop->symid = atol (token()); 03238 if (delim == SEPARATOR) 03239 loop->labelid = atol (token()); 03240 if (delim == SEPARATOR) 03241 loop->nameid = atol (token()); 03242 /* Statement id's for the loops terminating line */ 03243 if (delim == SEPARATOR) { 03244 statementID = atol (token()); 03245 /* No space to hold the statement field directly, so we have 03246 * to split the value into 3 parts - done magically through 03247 * setStmtid */ 03248 setStmtid(loop, statementID); 03249 } 03250 03251 return(CIF_F90_LOOP); 03252 } 03253 03254 03255 static int ascii_f90_derived_type (dt) 03256 struct Cif_f90_derived_type *dt; 03257 { 03258 register char *c; 03259 register long i, len; 03260 03261 if (_Cif_filetbl[lcifd].return_version <= 2) { 03262 struct Cif_f90_derived_type_2 *dt2 = (struct Cif_f90_derived_type_2 *) dt; 03263 03264 c = token(); 03265 dt2->nlen = len = strlen (c); 03266 dt2->name = _Cif_space[lmode] (len+1, lcifd); 03267 if (dt2->name == NULL) 03268 return (CIF_NOMEM); 03269 (void) strcpy (dt2->name, c); 03270 dt2->symid = atol (token()); 03271 dt2->scopeid = atol (token()); 03272 dt2->dervtype = atol (token()); 03273 03274 dt2->flag = strtol (token(), (char **)NULL, 16); 03275 03276 dt2->sequence = ((dt2->flag & CIF_DRT_SEQUENCE) != 0); 03277 dt2->defprivate = ((dt2->flag & CIF_DRT_PRIVATE) != 0); 03278 dt2->comprivate = ((dt2->flag & CIF_DRT_COMP_PRIVATE) != 0); 03279 03280 /* read member ids */ 03281 03282 if ( (len = atoi (token())) > 0) { 03283 dt2->nmembs = len; 03284 dt2->memids = (long *)_Cif_space[lmode] (sizeof(long)*len, lcifd); 03285 if (dt2->memids == NULL) 03286 return (CIF_NOMEM); 03287 for (i = 0; i < len; i++) 03288 (dt2->memids)[i] = atol (token()); 03289 } 03290 } 03291 else { /* version 3 CIF record, as above + add the moduleid field */ 03292 c = token(); 03293 dt->nlen = len = strlen (c); 03294 dt->name = _Cif_space[lmode] (len+1, lcifd); 03295 if (dt->name == NULL) 03296 return (CIF_NOMEM); 03297 (void) strcpy (dt->name, c); 03298 dt->symid = atol (token()); 03299 dt->scopeid = atol (token()); 03300 dt->dervtype = atol (token()); 03301 03302 dt->flag = strtol (token(), (char **)NULL, 16); 03303 03304 dt->sequence = ((dt->flag & CIF_DRT_SEQUENCE) != 0); 03305 dt->defprivate = ((dt->flag & CIF_DRT_PRIVATE) != 0); 03306 dt->comprivate = ((dt->flag & CIF_DRT_COMP_PRIVATE) != 0); 03307 03308 /* read member ids */ 03309 03310 if ( (len = atoi (token())) > 0) { 03311 dt->nmembs = len; 03312 dt->memids = (long *)_Cif_space[lmode] (sizeof(long)*len, lcifd); 03313 if (dt->memids == NULL) 03314 return (CIF_NOMEM); 03315 for (i = 0; i < len; i++) 03316 (dt->memids)[i] = atol (token()); 03317 } 03318 03319 /* moduleid's are only present in V3 CIF's */ 03320 if (_Cif_filetbl[lcifd].version >= 3 && 03321 delim == SEPARATOR) { 03322 dt->moduleid = atol (token()); 03323 } 03324 } 03325 03326 return (CIF_F90_DERIVED_TYPE); 03327 } 03328 03329 03330 03331 static int ascii_f90_label (label) 03332 struct Cif_f90_label *label; 03333 { 03334 register char *c; 03335 register long i; 03336 03337 c = token(); 03338 label->nlen = i = strlen (c); 03339 label->name = _Cif_space[lmode] (i+1, lcifd); 03340 if (label->name == NULL) 03341 return (CIF_NOMEM); 03342 (void) strcpy (label->name, c); 03343 label->symid = atol (token()); 03344 label->scopeid = atol (token()); 03345 label->ltype = atoi (token()); 03346 03347 return(CIF_F90_LABEL); 03348 } 03349 03350 03351 static int ascii_f90_namelist (nl) 03352 struct Cif_f90_namelist *nl; 03353 { 03354 register long i; 03355 register char *c; 03356 03357 c = token(); 03358 nl->nlen = i = strlen (c); 03359 nl->name = _Cif_space[lmode] (i+1, lcifd); 03360 if (nl->name == NULL) 03361 return (CIF_NOMEM); 03362 (void) strcpy (nl->name, c); 03363 nl->symid = atol (token()); 03364 nl->scopeid = atol (token()); 03365 nl->moduleid = atol (token()); 03366 if ((nl->nids = atoi (token())) > 0) { 03367 nl->ids = (long *) _Cif_space[lmode] (sizeof(long)*nl->nids, lcifd); 03368 if (nl->ids == NULL) 03369 return (CIF_NOMEM); 03370 for (i = 0; i < (int) nl->nids; i++) 03371 (nl->ids)[i] = atol (token()); 03372 03373 } 03374 03375 return(CIF_F90_NAMELIST); 03376 } 03377 03378 03379 static int ascii_f90_object (obj) 03380 struct Cif_f90_object *obj; 03381 { 03382 register char *c; 03383 register long i, attr, storeagid; 03384 struct Cif_dim *dim; 03385 03386 c = token(); 03387 if ((obj->nlen = i = strlen (c)) > 0) { 03388 obj->name = _Cif_space[lmode] (i+1, lcifd); 03389 if (obj->name == NULL) 03390 return (CIF_NOMEM); 03391 (void) strcpy (obj->name, c); 03392 } 03393 else 03394 obj->name = NULL; 03395 obj->symid = atol (token()); 03396 obj->scopeid = atol (token()); 03397 03398 /* 03399 * Map the compiler generated data type into a new value which 03400 * corresponds where it can with f77 and is non-overlapping for 03401 * other cases that have no direct equivalent; see CIF_[F90_]_DT_?? in cif.h 03402 */ 03403 obj->dtype = atoi (token()); 03404 if (_Cif_filetbl[lcifd].version < 3) { 03405 if (obj->dtype < CIF_F90_DT_MAX) 03406 obj->dtype = _Cif_f90_to_f77_dtypes[obj->dtype]; 03407 /* else it's a derived type, so leave the number */ 03408 } 03409 03410 obj->symclass = atoi (token()); 03411 obj->storage = atol (token()); 03412 03413 c = token(); 03414 if (c != (char *) NULL && 03415 *c != (char) NULL) { 03416 storeagid = atol(c); 03417 if (storeagid < 0) 03418 obj->storageid = 0; 03419 else 03420 obj->storageid = storeagid; 03421 } 03422 03423 c = token(); 03424 if (*c != 0 && 03425 (i = atol (c)) >= 0) { 03426 obj->valoffset = 1; 03427 obj->offset = i; 03428 } 03429 03430 03431 /* get attributes */ 03432 attr = strtol (token(), (char **)NULL, 16); 03433 obj->imptype = ((attr & F90_CO_ATTR_IMPTYPE) != 0); 03434 obj->pointee = ((attr & F90_CO_ATTR_POINTEE) != 0); 03435 obj->deftype = ((attr & F90_CO_ATTR_DEF_TYPE) != 0); 03436 obj->startype = ((attr & F90_CO_ATTR_STAR_TYPE) != 0); 03437 obj->kindtype = ((attr & F90_CO_ATTR_KIND_TYPE) != 0); 03438 obj->save = ((attr & F90_CO_ATTR_SAVE) != 0); 03439 obj->data = ((attr & F90_CO_ATTR_DATA) != 0); 03440 obj->equiv = ((attr & F90_CO_ATTR_EQUIV) != 0); 03441 obj->arraydec = ((attr & F90_CO_ATTR_ARRAY_DEC) != 0); 03442 obj->geomdec = ((attr & F90_CO_ATTR_GEOM_DEC) != 0); 03443 obj->peresident = ((attr & F90_CO_ATTR_PE_RESIDENT) != 0); 03444 obj->allocatable = ((attr & F90_CO_ATTR_ALLOCATABLE) != 0); 03445 obj->intentin = ((attr & F90_CO_ATTR_INTENTIN) != 0); 03446 obj->intentout = ((attr & F90_CO_ATTR_INTENTOUT) != 0); 03447 obj->intentinout = ((attr & F90_CO_ATTR_INTENTINOUT) != 0); 03448 obj->optional = ((attr & F90_CO_ATTR_OPTIONAL) != 0); 03449 obj->pointer = ((attr & F90_CO_ATTR_POINTER) != 0); 03450 obj->priv = ((attr & F90_CO_ATTR_PRIVATE) != 0); 03451 obj->target = ((attr & F90_CO_ATTR_TARGET) != 0); 03452 obj->localname = ((attr & F90_CO_ATTR_LOCAL_NAME) != 0); 03453 03454 /* we only get a derived type is when this object is a component of structure */ 03455 03456 if (obj->symclass == CIF_F90_SC_STRUCT) 03457 obj->dervid = atol (token()); 03458 else 03459 c = token(); 03460 03461 c = token (); 03462 if (*c == 'E') 03463 obj->chartype = CIF_DM_EXPR; 03464 else if (*c == '*') 03465 obj->chartype = CIF_DM_ASSUMED; 03466 else { 03467 obj->chartype = CIF_DM_CONSTANT; 03468 obj->charlen = atol (c); 03469 } 03470 03471 obj->ndims = atoi (token()); 03472 03473 if (obj->ndims == 0) { 03474 c = token(); /* remove the array type which isn't valid for a non-array (scalar) */ 03475 } 03476 else { 03477 obj->atype = atoi(token()); 03478 if (obj->atype != CIF_AT_DEFERRED) { /* deferred arrays have have all dimensions 03479 * assumed as ':', so are not given in the cif 03480 */ 03481 03482 dim = obj->dim = (struct Cif_dim *)_Cif_space[lmode] 03483 (sizeof(struct Cif_dim)*obj->ndims, lcifd); 03484 if (dim == NULL) 03485 return (CIF_NOMEM); 03486 for (i=0; i < (int) obj->ndims; i++) { 03487 c = token (); 03488 if (*c == 'E') { 03489 dim->ltype = CIF_DM_EXPR; 03490 dim->lower = 0; 03491 } else if (*c == '*') { 03492 dim->ltype = CIF_DM_ASSUMED; 03493 dim->lower = 0; 03494 } else { 03495 dim->ltype = CIF_DM_CONSTANT; 03496 dim->lower = atol (c); 03497 } 03498 if (obj->atype == CIF_AT_ASSUMED) { 03499 dim->utype = CIF_DM_ASSUMED; 03500 dim->upper = 0; 03501 } 03502 else { 03503 c = token (); 03504 if (*c == 'E') { 03505 dim->utype = CIF_DM_EXPR; 03506 dim->upper = 0; 03507 } else if (*c == '*') { 03508 dim->utype = CIF_DM_ASSUMED; 03509 dim->upper = 0; 03510 } else { 03511 dim->utype = CIF_DM_CONSTANT; 03512 dim->upper = atol (c); 03513 } 03514 } 03515 dim++; 03516 } 03517 } 03518 } 03519 03520 /* read distribution code, arrays only */ 03521 c = token(); 03522 if (c != (char *) NULL && 03523 *c != (char) NULL) { 03524 obj->dist = atoi (c); 03525 } 03526 03527 /* read geometry id, present only for certain array distributions */ 03528 c = token(); 03529 if (c != (char *) NULL && 03530 *c != (char) NULL) { 03531 obj->geomid = atol (c); 03532 } 03533 03534 /* read pointer id, only if this is a CRI pointee */ 03535 03536 c = token(); 03537 if (c != (char *) NULL && 03538 *c != (char) NULL) { 03539 obj->pointerid = atol (c); 03540 } 03541 03542 return(CIF_F90_OBJECT); 03543 } 03544 03545 03546 static int ascii_f90_misc_opts (mo) 03547 struct Cif_f90_misc_opts *mo; 03548 { 03549 register int i; 03550 register char *c; 03551 register int tmp; 03552 03553 mo->intlen = atoi (token()); 03554 mo->msglvl = atoi (token()); 03555 mo->vopt = atoi (token()); 03556 mo->trunc = atoi (token ()); 03557 mo->truncval = atoi (token()); 03558 tmp = llist(&(mo->msgno), (int *) NULL); 03559 if (tmp < 0) 03560 return (CIF_NOMEM); 03561 mo->nmsgs = tmp; 03562 03563 tmp = strlist (&(mo->cdirs)); 03564 if (tmp < 0) 03565 return (CIF_NOMEM); 03566 mo->ncdirs = tmp; 03567 03568 c = token(); 03569 if ((mo->onlen = i = strlen (c)) > 0) { 03570 mo->objname = _Cif_space[lmode] (i+1, lcifd); 03571 if (mo->objname == NULL) 03572 return (CIF_NOMEM); 03573 (void) strcpy (mo->objname, c); 03574 } 03575 c = token(); 03576 if ((mo->cnlen = i = strlen (c)) > 0) { 03577 mo->calname = _Cif_space[lmode] (i+1, lcifd); 03578 if (mo->calname == NULL) 03579 return (CIF_NOMEM); 03580 (void) strcpy (mo->calname, c); 03581 } 03582 03583 c = token(); 03584 if ((mo->inlen = i = strlen (c)) > 0) { 03585 mo->inname = _Cif_space[lmode] (i+1, lcifd); 03586 if (mo->inname == NULL) 03587 return (CIF_NOMEM); 03588 (void) strcpy (mo->inname, c); 03589 } 03590 03591 c = token(); 03592 if ((mo->ciflen = i = strlen (c)) > 0) { 03593 mo->cifname = _Cif_space[lmode] (i+1, lcifd); 03594 if (mo->cifname == NULL) 03595 return (CIF_NOMEM); 03596 (void) strcpy (mo->cifname, c); 03597 } 03598 03599 mo->cifopts = strtol (token(), (char **)NULL, 16); 03600 mo->swidth = atoi (token ()); 03601 03602 tmp = strlist (&(mo->Pdirs)); 03603 if (tmp < 0) 03604 return (CIF_NOMEM); 03605 mo->nPdirs = tmp; 03606 03607 tmp = strlist (&(mo->pdirs)); 03608 if (tmp < 0) 03609 return (CIF_NOMEM); 03610 mo->npdirs = tmp; 03611 03612 c = token(); 03613 mo->srcform = (*c == '0' ? 0 : 1); 03614 03615 /* 03616 * If we are not at a separator, we must be at the end of line, 03617 * which means that there are no more records 03618 */ 03619 if (delim == SEPARATOR) { 03620 mo->runtime = strtol (token(), (char **)NULL, 16); 03621 } 03622 03623 return(CIF_F90_MISC_OPTS); 03624 } 03625 03626 03627 static int ascii_f90_opt_opts (opt) 03628 struct Cif_f90_opt_opts *opt; 03629 { 03630 register int i; 03631 struct Cif_f90_level_opts *optlevel; 03632 03633 opt->values = strtol (token(), (char **)NULL, 16); 03634 opt->noptlevels = atoi (token()); 03635 optlevel = opt->lopts = (struct Cif_f90_level_opts *)_Cif_space[lmode] 03636 (sizeof(struct Cif_f90_level_opts)*opt->noptlevels, lcifd); 03637 if (optlevel== NULL) 03638 return (CIF_NOMEM); 03639 for (i=0; i < (int) opt->noptlevels; i++) { 03640 optlevel->optinlevel = strtol (token(), (char **)NULL, 16); 03641 optlevel->level = atoi (token ()); 03642 optlevel++; 03643 } 03644 opt->newdef = 1; /* internal flag set on this version of the cif 03645 * to allow cifbinread to correctly read both old 03646 * and new binary formats */ 03647 03648 return(CIF_F90_OPT_OPTS); 03649 } 03650 03651 03652 static int ascii_f90_begin_scope (bs) 03653 struct Cif_f90_begin_scope *bs; 03654 { 03655 bs->scopeid = atol (token ()); 03656 bs->symid = atol (token ()); 03657 bs->fid = atol (token ()); 03658 bs->line = atol (token ()); 03659 bs->cpos = atol (token ()); 03660 bs->stype = atol (token ()); 03661 bs->level = atoi (token ()); 03662 bs->parentid = atol (token ()); 03663 03664 return(CIF_F90_BEGIN_SCOPE); 03665 } 03666 03667 03668 static int ascii_f90_end_scope (es) 03669 struct Cif_f90_end_scope *es; 03670 { 03671 es->scopeid = atol (token ()); 03672 es->fid = atol (token ()); 03673 es->line = atol (token ()); 03674 es->cpos = atol (token ()); 03675 es->error = atoi (token ()); 03676 03677 return(CIF_F90_END_SCOPE); 03678 } 03679 03680 03681 static int ascii_f90_scope_info (si) 03682 struct Cif_f90_scope_info *si; 03683 { 03684 register long attr; 03685 register int i; 03686 03687 si->scopeid = atol (token ()); 03688 03689 attr = strtol (token(), (char **)NULL, 16); 03690 si->impnone = ((attr & SC_ATTR_IMPNONE) != 0); 03691 si->doesio = ((attr & SC_ATTR_IO) != 0); 03692 si->hascalls = ((attr & SC_ATTR_CALL) != 0); 03693 si->hascmics = ((attr & SC_ATTR_CMIC) != 0); 03694 03695 /* 03696 * If we are not at a separator, we must be at the end of line, 03697 * which means that there are no more records 03698 */ 03699 if (delim == SEPARATOR) { 03700 si->numalts = atoi (token ()); 03701 if (si->numalts > 0) { 03702 si->entryids = 03703 (long *) _Cif_space[lmode] (sizeof(long)*si->numalts, lcifd); 03704 if (si->entryids == NULL) 03705 return (CIF_NOMEM); 03706 for (i = 0; i < (int) si->numalts; i++) 03707 (si->entryids)[i] = atol (token()); 03708 } 03709 } 03710 03711 return(CIF_F90_SCOPE_INFO); 03712 } 03713 03714 03715 static int ascii_f90_use_module (um) 03716 struct Cif_f90_use_module *um; 03717 { 03718 um->modid = atol (token ()); 03719 um->modfid = atol (token ()); 03720 um->direct = atoi (token ()); 03721 03722 return(CIF_F90_USE_MODULE); 03723 } 03724 03725 03726 static int ascii_f90_rename (rn) 03727 struct Cif_f90_rename *rn; 03728 { 03729 register char *c; 03730 register int i; 03731 register int max_id = 5; 03732 03733 rn->scopeid = atol (token ()); 03734 c = token(); 03735 if ((rn->nlen = i = strlen (c)) > 0) { 03736 rn->name = _Cif_space[lmode] (i+1, lcifd); 03737 if (rn->name == NULL) 03738 return (CIF_NOMEM); 03739 (void) strcpy (rn->name, c); 03740 } 03741 03742 rn->nameid = atol (token ()); 03743 rn->modid = atol (token ()); 03744 03745 c = token(); 03746 if ((rn->orignlen = i = strlen (c)) > 0) { 03747 rn->origname = _Cif_space[lmode] (i+1, lcifd); 03748 if (rn->origname == NULL) 03749 return (CIF_NOMEM); 03750 (void) strcpy (rn->origname, c); 03751 } 03752 03753 rn->origmodid = atol (token ()); 03754 03755 /* 03756 * Assume a max of 5 and increase as necessary; will an object 03757 * ever be renamed more than 5 times ? 03758 */ 03759 03760 rn->localid = (long *) malloc (sizeof(long) * max_id); 03761 i = 0; 03762 while (1) { 03763 c = token(); 03764 if (c != (char *) NULL && 03765 *c != (char) NULL) { 03766 03767 rn->localid[i] = atol (c); 03768 i++; 03769 if (i == max_id) { 03770 max_id+=5; 03771 rn->localid = (long *) realloc((char *) rn->localid, 03772 sizeof(long) * max_id); 03773 } 03774 } 03775 else { 03776 break; 03777 } 03778 } 03779 rn->nlocalids = i; 03780 03781 return(CIF_F90_RENAME); 03782 } 03783 03784 03785 static int ascii_f90_int_block (ib) 03786 struct Cif_f90_int_block *ib; 03787 { 03788 register char *c; 03789 register int i; 03790 03791 if (_Cif_filetbl[lcifd].return_version <= 2) { 03792 struct Cif_f90_int_block_2 *ib2 = (struct Cif_f90_int_block_2 *) ib; 03793 03794 c = token(); 03795 if ((ib2->nlen = i = strlen (c)) > 0) { 03796 ib2->name = _Cif_space[lmode] (i+1, lcifd); 03797 if (ib2->name == NULL) 03798 return (CIF_NOMEM); 03799 (void) strcpy (ib2->name, c); 03800 } 03801 03802 ib2->intid = atol (token ()); 03803 ib2->scopeid = atol (token()); 03804 ib2->type = atoi (token ()); 03805 03806 /* 03807 * this next field could be a set of attributes, but for now it's 03808 * only possible value is 1 for PRIVATE 03809 */ 03810 03811 ib2->priv = (*token() == '1'); 03812 03813 if ((ib2->numints = atoi (token())) > 0) { 03814 ib2->procids = (long *) _Cif_space[lmode] (sizeof(long)*ib2->numints, lcifd); 03815 if (ib2->procids == NULL) 03816 return (CIF_NOMEM); 03817 for (i = 0; i < (int) ib2->numints; i++) 03818 (ib2->procids)[i] = atol (token()); 03819 03820 } 03821 } 03822 else { /* version 3 CIF record, as above + add the moduleid field */ 03823 03824 c = token(); 03825 if ((ib->nlen = i = strlen (c)) > 0) { 03826 ib->name = _Cif_space[lmode] (i+1, lcifd); 03827 if (ib->name == NULL) 03828 return (CIF_NOMEM); 03829 (void) strcpy (ib->name, c); 03830 } 03831 03832 ib->intid = atol (token ()); 03833 ib->scopeid = atol (token()); 03834 ib->type = atoi (token ()); 03835 03836 /* 03837 * this next field could be a set of attributes, but for now it's 03838 * only possible value is 1 for PRIVATE 03839 */ 03840 03841 ib->priv = (*token() == '1'); 03842 03843 if ((ib->numints = atoi (token())) > 0) { 03844 ib->procids = (long *) _Cif_space[lmode] (sizeof(long)*ib->numints, lcifd); 03845 if (ib->procids == NULL) 03846 return (CIF_NOMEM); 03847 for (i = 0; i < (int) ib->numints; i++) 03848 (ib->procids)[i] = atol (token()); 03849 } 03850 03851 /* moduleid's are only present in V3 CIF's */ 03852 if (_Cif_filetbl[lcifd].version >= 3 && 03853 delim == SEPARATOR) { 03854 ib->moduleid = atol (token()); 03855 } 03856 } 03857 03858 return(CIF_F90_INT_BLOCK); 03859 } 03860 03861 03862 static int ascii_f90_vectorization (vect) 03863 struct Cif_f90_vectorization *vect; 03864 { 03865 (void) fprintf(stderr, "libcif: vectorization message %p\n", vect); 03866 return(CIF_F90_VECTORIZATION); 03867 } 03868 #endif /* ndef CRAY2 */ 03869 03870 03871 03872 03873 03874 static int ascii_unit (unit) 03875 struct Cif_unit *unit; 03876 { 03877 register int i; 03878 register char *c; 03879 03880 c = token(); 03881 unit->nlen = i = strlen (c); 03882 unit->name = _Cif_space[lmode] (i+1, lcifd); 03883 if (unit->name == NULL) 03884 return (CIF_NOMEM); 03885 (void) strcpy (unit->name, c); 03886 unit->fid = atol (token()); 03887 unit->line = atol (token()); 03888 unit->cpos = atol (token()); 03889 return (CIF_UNIT); 03890 03891 } 03892 03893 static int ascii_endunit (eu) 03894 struct Cif_endunit *eu; 03895 { 03896 register int i; 03897 register char *c; 03898 03899 c = token(); 03900 eu->nlen = i = strlen (c); 03901 eu->name = _Cif_space[lmode] (i+1, lcifd); 03902 if (eu->name == NULL) 03903 return (CIF_NOMEM); 03904 (void) strcpy (eu->name, c); 03905 eu->fid = atol (token()); 03906 eu->line = atol (token()); 03907 eu->cpos = atol (token()); 03908 return (CIF_ENDUNIT); 03909 03910 } 03911 03912 static int ascii_usage (usage) 03913 struct Cif_usage *usage; 03914 { 03915 # define UBINCR 5 /* use buffer increment value */ 03916 03917 register char *c; 03918 long i, nuses, note_pos = -10; /* a file position, note 0 and -1 have meaning, so 03919 * -10 is used to be 'undefined' 03920 */ 03921 03922 long utype; 03923 03924 static struct Cif_use *ubuff = NULL; /* pointer to base of use buffer */ 03925 static int ubi; /* index to next slot in ubuff */ 03926 static int ubsize = 0; /* current max size of ubuff */ 03927 03928 03929 /* 03930 * If the user wants a v1 cif, then we need to use a different data 03931 * structure 03932 */ 03933 03934 if (_Cif_filetbl[lcifd].return_version == 1) { 03935 struct Cif_usage_1 *usage1 = (struct Cif_usage_1 *) usage; 03936 03937 usage1->symid = atol (token()); 03938 ubi = 0; 03939 03940 while (1) { 03941 03942 /* count up number of uses in record */ 03943 03944 i = 0; 03945 c = ntoken; 03946 while (*c != '\0') 03947 if (*c++ == SEPARATOR) i++; 03948 nuses = (++i) / 4; 03949 03950 /* if not enough space in use buffer, make buffer bigger */ 03951 03952 if (ubi + nuses > ubsize) { 03953 if (ubsize == 0) { 03954 ubsize = UBINCR; 03955 03956 ubuff = (struct Cif_use *) malloc (sizeof(struct Cif_use)*UBINCR); 03957 } 03958 else { 03959 ubsize += UBINCR; 03960 ubuff = (struct Cif_use *)realloc (ubuff, 03961 sizeof(struct Cif_use)*ubsize); 03962 } 03963 if (ubuff == NULL) 03964 return (CIF_NOMEM); 03965 } 03966 for (i = 0; i < nuses; i++) { 03967 ubuff[ubi].fid = atol (token()); 03968 ubuff[ubi].line = atol (token()); 03969 ubuff[ubi].cpos = atol (token()); 03970 03971 /* 03972 * Fortran and C usage values have different meanings 03973 * In C, values are in hex and bit significant; 03974 * Fortran is decimal and different nummeric values 03975 * represent different usages with no bit significance 03976 */ 03977 03978 if (_Cif_filetbl[lcifd].lang == CIF_LG_C || 03979 _Cif_filetbl[lcifd].lang == CIF_LG_CC) { 03980 ubuff[ubi].utype = 03981 strtol (token(), (char **)NULL, 16); 03982 } 03983 else { 03984 utype = atol (token()); 03985 ubuff[ubi].utype = utype % 100; 03986 /* 03987 * in a v2 cif, a usage type > 100 indicates that the object 03988 * is used in a data statement 03989 */ 03990 if (_Cif_filetbl[lcifd].return_version != 1) { 03991 if (_Cif_filetbl[lcifd].return_version != 1) { 03992 if (utype >= 200) 03993 ubuff[ubi].init = 1; 03994 else 03995 if (utype >= 100) 03996 ubuff[ubi].data = 1; 03997 } 03998 } 03999 } 04000 ubi++; 04001 } 04002 04003 /* 04004 * Read next record. If usage and same object, go back and add to 04005 * current list. Otherwise, mark that buffer contains record and go on. 04006 */ 04007 04008 /* 04009 * note where we are now so that if the next record is not 04010 * a usage we can position the curent pos at it correctly 04011 */ 04012 04013 note_pos = Cif_Getpos(lcifd); 04014 04015 if (fgets (_Cif_filetbl[lcifd].ip, CIF_BUFSIZE, _Cif_filetbl[lcifd].fd) 04016 == NULL) 04017 { 04018 if (feof(_Cif_filetbl[lcifd].fd)) 04019 break; 04020 else 04021 return (CIF_SYSERR); 04022 } 04023 ntoken = _Cif_filetbl[lcifd].ip; 04024 if (atoi (token ()) != CIF_USAGE) { 04025 _Cif_filetbl[lcifd].ifull = YES; 04026 break; 04027 } 04028 else if (atol (token ()) != usage1->symid) { 04029 _Cif_filetbl[lcifd].ifull = YES; 04030 break; 04031 } 04032 } 04033 04034 /* Make sure that the file position is correct before we continue */ 04035 04036 if (note_pos != -10) 04037 (void) Cif_Setpos(lcifd, note_pos); 04038 04039 /* Sort the usages, allocate a new buffer, and copy them over */ 04040 04041 if (ubi > 1) 04042 (void) qsort ( (char *)ubuff, ubi, sizeof(struct Cif_use), (int(*)()) compuse); 04043 i = sizeof(struct Cif_use) * ubi; 04044 usage1->use = (struct Cif_use *)_Cif_space[lmode] (i, lcifd); 04045 if (usage1->use == NULL) 04046 return (CIF_NOMEM); 04047 (void) memcpy ((char *)usage1->use, (char *)ubuff, i); 04048 usage1->nuses = ubi; 04049 } 04050 04051 else { /* returning a v2 cif */ 04052 04053 usage->symid = atol (token()); 04054 ubi = 0; 04055 04056 while (1) { 04057 04058 /* count up number of uses in record */ 04059 04060 i = 0; 04061 c = ntoken; 04062 while (*c != '\0') 04063 if (*c++ == SEPARATOR) i++; 04064 nuses = (++i) / 4; 04065 04066 /* if not enough space in use buffer, make buffer bigger */ 04067 04068 if (ubi + nuses > ubsize) { 04069 if (ubsize == 0) { 04070 ubsize = UBINCR; 04071 ubuff = (struct Cif_use *) malloc (sizeof(struct Cif_use)*UBINCR); 04072 } 04073 else { 04074 ubsize += UBINCR; 04075 ubuff = (struct Cif_use *)realloc (ubuff, 04076 sizeof(struct Cif_use)*ubsize); 04077 } 04078 if (ubuff == NULL) 04079 return (CIF_NOMEM); 04080 } 04081 for (i = 0; i < nuses; i++) { 04082 (void) memset((char *)&ubuff[ubi], 0, sizeof(struct Cif_use)); 04083 ubuff[ubi].fid = atol (token()); 04084 ubuff[ubi].line = atol (token()); 04085 ubuff[ubi].cpos = atol (token()); 04086 04087 /* Fortran and C usage values have different meanings 04088 * In C, values are in hex and bit significant; 04089 * Fortran is decimal and different nummeric values 04090 * represent different usages with no bit significance 04091 */ 04092 04093 if (_Cif_filetbl[lcifd].lang == CIF_LG_C || 04094 _Cif_filetbl[lcifd].lang == CIF_LG_CC) { 04095 ubuff[ubi].utype = 04096 strtol (token(), (char **)NULL, 16); 04097 } 04098 else { 04099 utype = atol (token()); 04100 ubuff[ubi].utype = utype % 100; 04101 /* 04102 * in a v2 cif, a usage type > 100 indicates that the object 04103 * is used in a data statement 04104 */ 04105 if (_Cif_filetbl[lcifd].return_version != 1) { 04106 if (_Cif_filetbl[lcifd].return_version != 1) { 04107 if (utype >= 200) 04108 ubuff[ubi].init = 1; 04109 else 04110 if (utype >= 100) 04111 ubuff[ubi].data = 1; 04112 } 04113 } 04114 } 04115 ubi++; 04116 } 04117 04118 /* 04119 * Read next record. If usage and same object, go back and add to 04120 * current list. Otherwise, mark that buffer contains record and go on. 04121 */ 04122 04123 /* 04124 * note where we are now so that if the next record is not 04125 * a usage we can position the curent pos at it correctly 04126 */ 04127 04128 note_pos = Cif_Getpos(lcifd); 04129 04130 if (fgets (_Cif_filetbl[lcifd].ip, CIF_BUFSIZE, _Cif_filetbl[lcifd].fd) 04131 == NULL) 04132 { 04133 if (feof(_Cif_filetbl[lcifd].fd)) 04134 break; 04135 else 04136 return (CIF_SYSERR); 04137 } 04138 ntoken = _Cif_filetbl[lcifd].ip; 04139 if (atoi (token ()) != CIF_USAGE) { 04140 _Cif_filetbl[lcifd].ifull = YES; 04141 break; 04142 } 04143 else if (atol (token ()) != usage->symid) { 04144 _Cif_filetbl[lcifd].ifull = YES; 04145 break; 04146 } 04147 } 04148 04149 /* Make sure that the file position is correct before we continue */ 04150 04151 if (note_pos != -10) 04152 (void) Cif_Setpos(lcifd, note_pos); 04153 04154 /* Sort the usages, allocate a new buffer, and copy them over */ 04155 04156 if (ubi > 1) 04157 (void) qsort ( (char *)ubuff, ubi, sizeof(struct Cif_use), (int(*)()) compuse); 04158 i = sizeof(struct Cif_use) * ubi; 04159 usage->use = (struct Cif_use *)_Cif_space[lmode] (i, lcifd); 04160 if (usage->use == NULL) 04161 return (CIF_NOMEM); 04162 (void) memcpy ((char *)usage->use, (char *)ubuff, i); 04163 usage->nuses = ubi; 04164 04165 } 04166 04167 return (CIF_USAGE); 04168 04169 } 04170 04171 04172 /* 04173 * cif_usage changed slightly for f90 in that only one usage will 04174 * be created per record and that there is an optional new last field 04175 * which describes the member symbol id's; that is if a%b%c is referenced, 04176 * a will be given as the usual symbol id, b and c will be the member symbol 04177 * id's. As such it is easier to parse these separately. 04178 */ 04179 04180 static int ascii_f90_usage (usage) 04181 struct Cif_usage *usage; 04182 { 04183 long i; 04184 long utype; 04185 04186 static struct Cif_use *ubuff = NULL; /* pointer to base of use buffer */ 04187 04188 usage->symid = atol (token()); 04189 04190 ubuff = (struct Cif_use *) _Cif_space[lmode] (sizeof(struct Cif_use), 04191 lcifd); 04192 ubuff->fid = atol (token()); 04193 ubuff->line = atol (token()); 04194 ubuff->cpos = atol (token()); 04195 utype = atol(token()); 04196 ubuff->utype = utype % 100; 04197 /* 04198 * in a v2 cif, a usage type > 100 indicates that the object 04199 * is used in a data statement 04200 */ 04201 ubuff->init = 0; 04202 ubuff->data = 0; 04203 if (_Cif_filetbl[lcifd].return_version != 1) { 04204 if (utype >= 200) 04205 ubuff->init = 1; 04206 else 04207 if (utype >= 100) 04208 ubuff->data = 1; 04209 } 04210 04211 /* 04212 * Now see if there are any extra symol id's which will represent the 04213 * parent symbol id's (see comment at head of this function) 04214 */ 04215 04216 /* There are still things to read if we are just at a delimiter */ 04217 04218 if (delim == SEPARATOR) { 04219 usage->nmembs = atoi (token()); 04220 if (usage->nmembs > 0) { 04221 usage->membs = (long *) _Cif_space[lmode] ((sizeof(long) * usage->nmembs), 04222 lcifd); 04223 for (i = 0; i < (int) usage->nmembs; i++) { 04224 usage->membs[i] = atol (token()); 04225 } 04226 } 04227 } 04228 04229 usage->use = ubuff; 04230 usage->nuses = 1; 04231 04232 return (CIF_USAGE); 04233 04234 } 04235 04236 04237 #ifndef CRAY2 04238 static int ascii_BE_node (ent) 04239 struct Cif_BE_node *ent; 04240 { 04241 char *cp; 04242 int i, n; 04243 04244 if ( _Cif_filetbl[lcifd].return_version == 2 ) { 04245 04246 struct Cif_BE_node_2 *v2 = (struct Cif_BE_node_2 *) ent; 04247 v2->block = atoi (token()); 04248 v2->blocklet = atoi (token()); 04249 v2->is_entry = atoi (token()); 04250 v2->nsuccs = n = atoi (token()); 04251 if ( n < 0 ) { 04252 return( CIF_BADFORM ); 04253 } else if ( n == 0 ) { 04254 v2->succs = (int *) NULL; 04255 } else { 04256 v2->succs = (int *) 04257 _Cif_space[ lmode ](n * sizeof( int ), lcifd); 04258 if ( v2->succs == NULL ) 04259 return( CIF_NOMEM ); 04260 for ( i = 0; i < n; i++ ) { 04261 v2->succs[ i ] = atoi (token()); 04262 } 04263 } 04264 v2->nlines = n = atoi (token()); 04265 if ( n < 0 ) { 04266 return( CIF_BADFORM ); 04267 } else if ( n == 0 ) { 04268 v2->lines = (int *) NULL; 04269 } else { 04270 if ( _Cif_filetbl[lcifd].version >= 3 ) { 04271 /* user wants V2 record, but this is V3 04272 * so read up fids and toss them */ 04273 for ( i = 0; i < n; i++ ) { 04274 (void) token(); 04275 } 04276 } 04277 v2->lines = (int *) 04278 _Cif_space[ lmode ](n * sizeof( int ), lcifd); 04279 if ( v2->lines == NULL ) 04280 return( CIF_NOMEM ); 04281 for ( i = 0; i < n; i++ ) { 04282 v2->lines[ i ] = atoi (token()); 04283 } 04284 } 04285 v2->type = atoi (token()); 04286 v2->subtype = atoi (token()); 04287 v2->index = atoi (token()); 04288 cp = token(); 04289 n = strlen (cp); 04290 v2->label = _Cif_space[ lmode ](n+1, lcifd); 04291 if ( v2->label == NULL ) 04292 return( CIF_NOMEM ); 04293 (void) strcpy( v2->label, cp ); 04294 for ( i = 0; i < CIF_IT_MAX; i++ ) { 04295 v2->icnt[ i ] = atoi (token()); 04296 } 04297 v2->app_before = atoi (token()); 04298 v2->app_after = atoi (token()); 04299 v2->clocks = atoi (token()); 04300 04301 } else { /* user wants a V3 format record */ 04302 04303 ent->block = atoi (token()); 04304 ent->blocklet = atoi (token()); 04305 ent->is_entry = atoi (token()); 04306 ent->nsuccs = n = atoi (token()); 04307 if ( n < 0 ) { 04308 return( CIF_BADFORM ); 04309 } else if ( n == 0 ) { 04310 ent->succs = (int *) NULL; 04311 } else { 04312 ent->succs = (int *) 04313 _Cif_space[ lmode ](n * sizeof( int ), lcifd); 04314 if ( ent->succs == NULL ) 04315 return( CIF_NOMEM ); 04316 for ( i = 0; i < n; i++ ) { 04317 ent->succs[ i ] = atoi (token()); 04318 } 04319 } 04320 ent->nlines = n = atoi (token()); 04321 if ( n < 0 ) { 04322 return( CIF_BADFORM ); 04323 } else if ( n == 0 ) { 04324 ent->fid = (int *) NULL; 04325 ent->lines = (int *) NULL; 04326 } else { 04327 ent->fid = (int *) 04328 _Cif_space[ lmode ](n * sizeof( int ), lcifd); 04329 if ( ent->fid == NULL ) 04330 return( CIF_NOMEM ); 04331 ent->lines = (int *) 04332 _Cif_space[ lmode ](n * sizeof( int ), lcifd); 04333 if ( ent->lines == NULL ) 04334 return( CIF_NOMEM ); 04335 if ( _Cif_filetbl[lcifd].version >= 3 ) { 04336 for ( i = 0; i < n; i++ ) { 04337 ent->fid[ i ] = atoi (token()); 04338 } 04339 for ( i = 0; i < n; i++ ) { 04340 ent->lines[ i ] = atoi (token()); 04341 } 04342 } else { 04343 for ( i = 0; i < n; i++ ) { 04344 ent->fid[ i ] = 0; 04345 ent->lines[ i ] = atoi (token()); 04346 } 04347 } 04348 } 04349 ent->type = atoi (token()); 04350 ent->subtype = atoi (token()); 04351 ent->index = atoi (token()); 04352 cp = token(); 04353 n = strlen (cp); 04354 ent->label = _Cif_space[ lmode ](n+1, lcifd); 04355 if ( ent->label == NULL ) 04356 return( CIF_NOMEM ); 04357 (void) strcpy( ent->label, cp ); 04358 for ( i = 0; i < CIF_IT_MAX; i++ ) { 04359 ent->icnt[ i ] = atoi (token()); 04360 } 04361 ent->app_before = atoi (token()); 04362 ent->app_after = atoi (token()); 04363 ent->clocks = atoi (token()); 04364 if ( *ntoken != 0 ) 04365 return( CIF_BADFORM ); 04366 } 04367 return( CIF_BE_NODE ); 04368 } 04369 04370 04371 static int ascii_BE_fid (ent) 04372 struct Cif_BE_fid *ent; 04373 { 04374 char *cp; 04375 int i, n; 04376 04377 ent->block = atoi (token()); 04378 ent->blocklet = atoi (token()); 04379 04380 ent->nfid = n = atoi (token()); 04381 if ( n < 0 ) { 04382 return( CIF_BADFORM ); 04383 } else if ( n == 0 ) { 04384 ent->fid = (int *) NULL; 04385 } else { 04386 ent->fid = (int *) 04387 _Cif_space[ lmode ](n * sizeof( int ), lcifd); 04388 if ( ent->fid == NULL ) 04389 return( CIF_NOMEM ); 04390 for ( i = 0; i < n; i++ ) { 04391 ent->fid[ i ] = atoi (token()); 04392 } 04393 } 04394 return( CIF_BE_FID ); 04395 } 04396 #endif /* CRAY2 */ 04397 04398 04399 static int ascii_cc_type (spos) 04400 struct Cif_cc_type *spos; 04401 { 04402 int i, n; 04403 char *c; 04404 04405 spos->scopeid = atoi(token()); 04406 spos->ptype = atol(token()); 04407 spos->size = atol(token()); 04408 spos->typeId = atol(token()); 04409 spos->type = atoi(token()); 04410 04411 switch( spos->type ) { 04412 case CIF_CCT_INT: 04413 spos->flags = atoi(token()); 04414 spos->prec = atoi(token()); 04415 break; 04416 case CIF_CCT_FLOAT: 04417 spos->subtype = atoi(token()); 04418 break; 04419 case CIF_CCT_COMPLEX: 04420 spos->subtype = atoi(token()); 04421 break; 04422 case CIF_CCT_CLASS: 04423 case CIF_CCT_STRUCT: 04424 case CIF_CCT_UNION: 04425 case CIF_CCT_ENUM: 04426 c = token(); 04427 spos->nlen = i = strlen (c); 04428 spos->name = _Cif_space[lmode] (i+1, lcifd); 04429 if (spos->name == NULL) 04430 return (CIF_NOMEM); 04431 (void) strcpy (spos->name, c); 04432 spos->symid = atoi(token()); 04433 spos->nmem = i = atoi(token()); 04434 i *= sizeof( int ); 04435 spos->mem = (int *)_Cif_space[lmode] (i, lcifd); 04436 if (spos->mem == NULL) 04437 return (CIF_NOMEM); 04438 for ( i = 0; i < (int)spos->nmem; i++ ) 04439 spos->mem[ i ] = atoi(token()); 04440 break; 04441 case CIF_CCT_TYPEDEF: 04442 c = token(); 04443 spos->nlen = i = strlen (c); 04444 spos->name = _Cif_space[lmode] (i+1, lcifd); 04445 if (spos->name == NULL) 04446 return (CIF_NOMEM); 04447 (void) strcpy (spos->name, c); 04448 spos->symid = atoi(token()); 04449 spos->btype = atoi(token()); 04450 break; 04451 case CIF_CCT_QUALIFIED: 04452 spos->btype = atoi(token()); 04453 spos->flags = atoi(token()); 04454 break; 04455 case CIF_CCT_FUNCTION: 04456 spos->rtype = atoi(token()); 04457 spos->flags = atoi(token()); 04458 spos->nmem = i = atoi(token()); 04459 i *= sizeof( int ); 04460 spos->mem = (int *)_Cif_space[lmode] (i, lcifd); 04461 if (spos->mem == NULL) 04462 return (CIF_NOMEM); 04463 for ( i = 0; i < (int)spos->nmem; i++ ) 04464 spos->mem[ i ] = atoi(token()); 04465 break; 04466 case CIF_CCT_POINTER: 04467 spos->btype = atoi(token()); 04468 break; 04469 case CIF_CCT_ARRAY: 04470 break; 04471 case CIF_CCT_PTRMEM: 04472 break; 04473 case CIF_CCT_TEMPAR: 04474 break; 04475 } 04476 04477 if ( spos->name == NULL ) { 04478 spos->nlen = i = 0; 04479 spos->name = _Cif_space[lmode] (i+1, lcifd); 04480 if (spos->name == NULL) 04481 return (CIF_NOMEM); 04482 (void) strcpy (spos->name, ""); 04483 } 04484 04485 return( CIF_CC_TYPE ); 04486 } 04487 04488 04489 static int ascii_cc_entry (spos) 04490 struct Cif_cc_entry *spos; 04491 { 04492 register int i, n; 04493 register char *c; 04494 04495 c = token(); 04496 spos->nlen = i = strlen (c); 04497 spos->name = _Cif_space[lmode] (i+1, lcifd); 04498 if (spos->name == NULL) 04499 return (CIF_NOMEM); 04500 (void) strcpy (spos->name, c); 04501 04502 c = token(); 04503 spos->elen = i = strlen (c); 04504 spos->ename = _Cif_space[lmode] (i+1, lcifd); 04505 if (spos->ename == NULL) 04506 return (CIF_NOMEM); 04507 (void) strcpy (spos->ename, c); 04508 04509 spos->symid = atoi(token()); 04510 spos->linkage = atol(token()); 04511 spos->typeId = atol(token()); 04512 spos->attr = atoi(token()); 04513 spos->scopeid = atoi(token()); 04514 spos->ptype = atoi(token()); 04515 spos->sfid = atoi(token()); 04516 spos->sline = atoi(token()); 04517 spos->scol = atoi(token()); 04518 spos->efid = atoi(token()); 04519 spos->eline = atoi(token()); 04520 spos->ecol = atoi(token()); 04521 spos->fsymid = atoi(token()); 04522 04523 spos->nparam = i = atoi(token()); 04524 i *= sizeof( int ); 04525 spos->param = (int *)_Cif_space[lmode] (i, lcifd); 04526 if (spos->param == NULL) 04527 return (CIF_NOMEM); 04528 for ( i = 0; i < (int)spos->nparam; i++ ) 04529 spos->param[ i ] = atoi(token()); 04530 04531 return( CIF_CC_ENTRY ); 04532 } 04533 04534 04535 static int ascii_cc_obj (spos) 04536 struct Cif_cc_obj *spos; 04537 { 04538 register int i; 04539 register char *c; 04540 04541 c = token(); 04542 spos->nlen = i = strlen (c); 04543 spos->name = _Cif_space[lmode] (i+1, lcifd); 04544 if (spos->name == NULL) 04545 return (CIF_NOMEM); 04546 (void) strcpy (spos->name, c); 04547 04548 spos->symid = atoi(token()); 04549 spos->typeId = atol(token()); 04550 spos->symcl = atol(token()); 04551 spos->linkage = atol(token()); 04552 spos->storage = atol(token()); 04553 spos->scopeid = atol(token()); 04554 spos->offset = atol(token()); 04555 spos->ptype = atoi(token()); 04556 return( CIF_CC_OBJ ); 04557 } 04558 04559 04560 static int ascii_cc_subtype (spos) 04561 struct Cif_cc_subtype *spos; 04562 { 04563 spos->symid = atoi(token()); 04564 spos->symkind = atoi(token()); 04565 spos->subkind = atoi(token()); 04566 spos->flags = atol(token()); 04567 spos->ptype = atoi(token()); 04568 return( CIF_CC_SUBTYPE ); 04569 } 04570 04571 04572 static int ascii_cc_enum (spos) 04573 struct Cif_cc_enum *spos; 04574 { 04575 register int i; 04576 register char *c; 04577 04578 spos->symid = atoi(token()); 04579 c = token(); 04580 spos->nlen = i = strlen (c); 04581 spos->name = _Cif_space[lmode] (i+1, lcifd); 04582 if (spos->name == NULL) 04583 return (CIF_NOMEM); 04584 (void) strcpy (spos->name, c); 04585 04586 spos->typeId = atol(token()); 04587 c = token(); 04588 spos->vlen = i = strlen (c); 04589 spos->value = _Cif_space[lmode] (i+1, lcifd); 04590 if (spos->value == NULL) 04591 return (CIF_NOMEM); 04592 (void) strcpy (spos->value, c); 04593 return( CIF_CC_ENUM ); 04594 } 04595 04596 04597 static int ascii_cc_expr (spos) 04598 struct Cif_cc_expr *spos; 04599 { 04600 spos->exprid = atoi(token()); 04601 spos->type = atol(token()); 04602 spos->fid = atol(token()); 04603 spos->line = atol(token()); 04604 spos->col = atol(token()); 04605 spos->noper = atol(token()); 04606 /* need to get operands */ 04607 return( CIF_CC_EXPR ); 04608 } 04609 04610 04611 static int ascii_src_pos (spos) 04612 struct Cif_src_pos *spos; 04613 { 04614 spos->kind = atoi(token()); 04615 04616 spos->srcid = atol(token()); 04617 spos->psrcid = atol(token()); 04618 04619 spos->sline = atol(token()); 04620 spos->scol = atoi(token()); 04621 04622 if (spos->kind == CIF_SRC_KIND_MAIN || 04623 spos->kind == CIF_SRC_KIND_INCLUDE || 04624 spos->kind == CIF_SRC_KIND_INLINE || 04625 spos->kind == CIF_SRC_KIND_TAIL) 04626 spos->fid = atol(token()); 04627 else { /* macro */ 04628 spos->eline = atol(token()); 04629 spos->ecol = atoi(token()); 04630 spos->symid = atol(token()); 04631 } 04632 04633 return( CIF_SRC_POS ); 04634 } 04635 04636 04637 static int ascii_orig_cmd (ocmd) 04638 struct Cif_orig_cmd *ocmd; 04639 { 04640 register int i; 04641 register char *c; 04642 04643 c = token(); 04644 ocmd->nlen = i = strlen (c); 04645 ocmd->name = _Cif_space[lmode] (i+1, lcifd); 04646 if (ocmd->name == NULL) 04647 return (CIF_NOMEM); 04648 (void) strcpy (ocmd->name, c); 04649 04650 return( CIF_ORIG_CMD ); 04651 } 04652