|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
|
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/cifputrec.c 30.6 07/26/96 07:19:13"; 00038 00039 00040 /* ------------------------------------------------------------------------- 00041 * Cif_Putrecord writes out the provided record to a CIF file in binary form. 00042 * It writes out the record type value alone then writes out the record 00043 * structure, followed by any variable length information. Shortened forms 00044 * of some of the structures are used to avoid writing out pointers that 00045 * are used only in memory. 00046 * 00047 * Tabs are set up to be read with tab spacing = 3 00048 * -------------------------------------------------------------------------- 00049 */ 00050 00051 #define CIF_VERSION 3 00052 00053 #ifdef _ABSOFT 00054 #include "cif.h" 00055 #else 00056 #include <cif.h> 00057 #endif 00058 00059 #include <stdio.h> 00060 #include <string.h> 00061 #include <stdlib.h> 00062 #include <assert.h> 00063 00064 #include "cif_int.h" 00065 00066 static FILE *fd; /* file desciptor of cif file */ 00067 00068 00069 /* --- write_strlist outputs a list of strings --- */ 00070 static int write_strlist (sp, ns) 00071 char **sp; /* pointer to array of string pointers */ 00072 int ns; /* number of strings to write */ 00073 { 00074 int i; 00075 short slen[100]; /* array of string lengths */ 00076 00077 if (ns > 0) { 00078 for (i = 0; i < ns; i++) 00079 slen[i] = strlen (sp[i]); 00080 if (fwrite ((char *)slen, sizeof(short), i, fd) != i) 00081 return (CIF_SYSERR); 00082 for (i = 0; i < ns; i++) { 00083 if (fwrite ( sp[i], sizeof(char), slen[i], fd) != slen[i]) 00084 return (CIF_SYSERR); 00085 } 00086 } 00087 return (0); 00088 } 00089 00090 /* --- write_unitdir compacts and writes a CIF_UNITDIR record --- */ 00091 static int write_unitdir (cr) 00092 struct Cif_generic *cr; 00093 { 00094 int i, j; 00095 struct Cif_unitdir ut; 00096 struct Cif_urectbl ur[CIF_MAXRECORD]; 00097 struct Cif_urectbl *urp; 00098 00099 ut.rectype = CIF_UNITDIR; 00100 ut.maxsid = CIFUDIR(cr)->maxsid; 00101 urp = CIFUDIR(cr)->ur; 00102 for (i = j = 0; i < (int) CIFUDIR(cr)->nsections; i++) { 00103 if (urp[i].nrecords > 0) 00104 ur[j++] = urp[i]; 00105 } 00106 ut.nsections = j; 00107 if (fwrite (&ut, UNITDIR_SSIZE, 1, fd) != 1) return (CIF_SYSERR); 00108 if (fwrite (ur, URECTBL_SSIZE, j, fd) != j) return (CIF_SYSERR); 00109 return (0); 00110 00111 } 00112 00113 /* -------------------------------------------------------------------------- 00114 * Cif_Putrecord 00115 * -------------------------------------------------------------------------- 00116 */ 00117 00118 int Cif_Putrecord 00119 #ifdef __STDC__ 00120 (int cifd, struct Cif_generic *cr) 00121 #else 00122 (cifd, cr) 00123 int cifd; /* CIF file descriptor */ 00124 struct Cif_generic *cr; /* pointer to CIF structure */ 00125 #endif 00126 { 00127 00128 int i, j, n; 00129 int rtype; 00130 char *cp; 00131 unsigned char c; 00132 00133 if (cifd < 0 || cifd >= CIF_FT_SIZE || _Cif_filetbl[cifd].form == NOT_A_CIF) 00134 return (CIF_NOTOPEN); 00135 else if (_Cif_filetbl[cifd].optype == 'r') 00136 return (CIF_BADREQ); 00137 00138 fd = _Cif_filetbl[cifd].fd; 00139 rtype = cr->rectype; 00140 00141 if (rtype < 1 || rtype > CIF_MAXRECORD || _Cif_structsize == 0) 00142 return (CIF_BADFORM); 00143 00144 /* If CIF_UNITDIR, process separately because the unit record table must be 00145 * compressed. 00146 */ 00147 00148 if (rtype == CIF_UNITDIR) 00149 return (write_unitdir (cr)); 00150 00151 /* Write out the record type, then (possibly short) record structure itself 00152 * minus the record type then write out auxiliary information for each 00153 * record type that needs it. 00154 */ 00155 00156 if (fwrite((char *)cr, sizeof(char), 1, fd) != 1) return (CIF_SYSERR); 00157 cp = (char *)cr; 00158 00159 if (fwrite(++cp, _Cif_shortsize[rtype][_Cif_filetbl[cifd].version]-1, 1, fd) != 1) 00160 return (CIF_SYSERR); 00161 00162 switch (rtype) { 00163 00164 case CIF_CALLSITE: 00165 if ((i = CIFCS(cr)->nargs) > 0) { 00166 if (fwrite((char *)CIFCS(cr)->argids, sizeof(long), i, fd) != i) 00167 return (CIF_SYSERR); 00168 } 00169 break; 00170 00171 case CIF_COMBLK: 00172 /* Check which structures we should be using, v1 or v2 */ 00173 00174 if (_Cif_filetbl[cifd].version == 1) { 00175 00176 if (fwrite (CIFCB1(cr)->name, sizeof(char), CIFCB1(cr)->nlen, fd) != 00177 CIFCB1(cr)->nlen) return (CIF_SYSERR); 00178 00179 } 00180 else { /* use v2 cif records */ 00181 00182 if (fwrite (CIFCB(cr)->name, sizeof(char), CIFCB(cr)->nlen, fd) != 00183 CIFCB(cr)->nlen) return (CIF_SYSERR); 00184 00185 } 00186 break; 00187 00188 case CIF_CONST: 00189 /* Check which structures we should be using, v1 or v2 */ 00190 00191 if (_Cif_filetbl[cifd].version == 1) { 00192 00193 if (fwrite (CIFCON1(cr)->name, sizeof(char), CIFCON1(cr)->nlen, fd) != 00194 CIFCON1(cr)->nlen) return (CIF_SYSERR); 00195 if (fwrite (CIFCON1(cr)->value, sizeof(char), CIFCON1(cr)->vlen, fd) != 00196 CIFCON1(cr)->vlen) return (CIF_SYSERR); 00197 00198 } 00199 else { /* v2 cif */ 00200 00201 if (fwrite (CIFCON(cr)->name, sizeof(char), CIFCON(cr)->nlen, fd) != 00202 CIFCON(cr)->nlen) return (CIF_SYSERR); 00203 if (fwrite (CIFCON(cr)->value, sizeof(char), CIFCON(cr)->vlen, fd) != 00204 CIFCON(cr)->vlen) return (CIF_SYSERR); 00205 00206 if (CIFCON(cr)->origform) 00207 if (fwrite (CIFCON(cr)->oform, sizeof(char), CIFCON(cr)->olen, fd) != 00208 CIFCON(cr)->olen) return (CIF_SYSERR); 00209 00210 } 00211 break; 00212 00213 case CIF_ENTRY: 00214 if ((i = CIFENTRY(cr)->nargs) > 0) { 00215 if (fwrite (CIFENTRY(cr)->argids, sizeof(long), i, fd) != i) 00216 return (CIF_SYSERR); 00217 } 00218 if (fwrite (CIFENTRY(cr)->name, sizeof(char), CIFENTRY(cr)->nlen, fd) 00219 != CIFENTRY(cr)->nlen) return (CIF_SYSERR); 00220 break; 00221 00222 case CIF_FILE: 00223 if (_Cif_filetbl[cifd].version == 3) { 00224 if (fwrite (CIFFILE(cr)->name, sizeof(char), CIFFILE(cr)->nlen, fd) 00225 != CIFFILE(cr)->nlen) return (CIF_SYSERR); 00226 00227 if (fwrite (CIFFILE(cr)->oname, sizeof(char), CIFFILE(cr)->onlen, fd) 00228 != CIFFILE(cr)->onlen) return (CIF_SYSERR); 00229 } 00230 else { 00231 if (fwrite (CIFFILE1(cr)->name, sizeof(char), CIFFILE1(cr)->nlen, fd) 00232 != CIFFILE1(cr)->nlen) return (CIF_SYSERR); 00233 } 00234 break; 00235 00236 case CIF_LABEL: 00237 if (fwrite (CIFLABEL(cr)->name, sizeof(char), CIFLABEL(cr)->nlen, fd) 00238 != CIFLABEL(cr)->nlen) return (CIF_SYSERR); 00239 break; 00240 00241 case CIF_ORIG_CMD: 00242 if (fwrite (CIFOCMD(cr)->name, sizeof(char), CIFOCMD(cr)->nlen, fd) 00243 != CIFOCMD(cr)->nlen) return (CIF_SYSERR); 00244 break; 00245 00246 case CIF_MESSAGE: 00247 if (_Cif_filetbl[cifd].version == 3) { 00248 if (fwrite (CIFMSG(cr)->name, sizeof(char), CIFMSG(cr)->nlen, fd) 00249 != CIFMSG(cr)->nlen) return (CIF_SYSERR); 00250 if ((i = write_strlist (CIFMSG(cr)->args, (int) CIFMSG(cr)->nargs)) < 0) 00251 return (i); 00252 } 00253 else { 00254 if ((i = write_strlist (CIFMSG1(cr)->args, (int) CIFMSG1(cr)->nargs)) < 0) 00255 return (i); 00256 } 00257 break; 00258 00259 case CIF_MISC_OPTS: 00260 /* Check which structures we should be using, v1 or v2 */ 00261 00262 if (_Cif_filetbl[cifd].version == 1) { 00263 00264 if ((i = CIFMO1(cr)->nmsgs) > 0) { 00265 if (fwrite (CIFMO1(cr)->msgno, sizeof(long), i, fd) != i) 00266 return (CIF_SYSERR); 00267 } 00268 if ((i = write_strlist (CIFMO1(cr)->cdirs, (int) CIFMO1(cr)->ncdirs)) < 0) 00269 return (i); 00270 if ((i = CIFMO1(cr)->onlen) > 0) { 00271 if (fwrite (CIFMO1(cr)->objname, sizeof(char), i, fd) != i) 00272 return (CIF_SYSERR); 00273 } 00274 if ((i = CIFMO1(cr)->cnlen) > 0) { 00275 if (fwrite (CIFMO1(cr)->calname, sizeof(char), i, fd) != i) 00276 return (CIF_SYSERR); 00277 } 00278 if ((i = CIFMO1(cr)->inlen) > 0) { 00279 if (fwrite (CIFMO1(cr)->inname, sizeof(char), i, fd) != i) 00280 return (CIF_SYSERR); 00281 } 00282 } 00283 else { /* v2 cif structures */ 00284 00285 if ((i = CIFMO(cr)->nmsgs) > 0) { 00286 if (fwrite (CIFMO(cr)->msgno, sizeof(long), i, fd) != i) 00287 return (CIF_SYSERR); 00288 } 00289 if ((i = write_strlist (CIFMO(cr)->cdirs, (int) CIFMO(cr)->ncdirs)) < 0) 00290 return (i); 00291 if ((i = CIFMO(cr)->onlen) > 0) { 00292 if (fwrite (CIFMO(cr)->objname, sizeof(char), i, fd) != i) 00293 return (CIF_SYSERR); 00294 } 00295 if ((i = CIFMO(cr)->cnlen) > 0) { 00296 if (fwrite (CIFMO(cr)->calname, sizeof(char), i, fd) != i) 00297 return (CIF_SYSERR); 00298 } 00299 if ((i = CIFMO(cr)->inlen) > 0) { 00300 if (fwrite (CIFMO(cr)->inname, sizeof(char), i, fd) != i) 00301 return (CIF_SYSERR); 00302 } 00303 if ((i = CIFMO(cr)->llen) > 0) { 00304 if (fwrite (CIFMO(cr)->lname, sizeof(char), i, fd) != i) 00305 return (CIF_SYSERR); 00306 } 00307 00308 if ((i = write_strlist (CIFMO(cr)->incdirs, (int) CIFMO(cr)->numincs)) < 0) 00309 return (i); 00310 } 00311 break; 00312 00313 case CIF_NAMELIST: 00314 if (fwrite (CIFNL(cr)->name, sizeof(char), CIFNL(cr)->nlen, fd) != 00315 CIFNL(cr)->nlen) return (CIF_SYSERR); 00316 if (fwrite((char *)CIFNL(cr)->ids, sizeof(long), CIFNL(cr)->nids, fd) 00317 != CIFNL(cr)->nids) return (CIF_SYSERR); 00318 break; 00319 00320 case CIF_ND_MSG: 00321 if ((i = write_strlist (CIFNMSG(cr)->args, (int) CIFNMSG(cr)->nargs)) < 0) 00322 return (i); 00323 break; 00324 00325 case CIF_OBJECT: 00326 /* Check which structures we should be using, v1 or v2 */ 00327 00328 if (_Cif_filetbl[cifd].version == 1) { 00329 00330 if (CIFOBJ1(cr)->name != NULL) { 00331 if (fwrite (CIFOBJ1(cr)->name, sizeof(char), CIFOBJ1(cr)->nlen, fd) 00332 != CIFOBJ1(cr)->nlen) return (CIF_SYSERR); 00333 } 00334 if ((i = CIFOBJ1(cr)->ndims) > 0) { 00335 if (fwrite(CIFOBJ1(cr)->dim, DIM_SSIZE, i, fd) != i) 00336 return (CIF_SYSERR); 00337 } 00338 } 00339 else { /* use v2 cif records */ 00340 00341 if (CIFOBJ(cr)->name != NULL) { 00342 if (fwrite (CIFOBJ(cr)->name, sizeof(char), CIFOBJ(cr)->nlen, fd) 00343 != CIFOBJ(cr)->nlen) return (CIF_SYSERR); 00344 } 00345 if ((i = CIFOBJ(cr)->ndims) > 0) { 00346 if (fwrite(CIFOBJ(cr)->dim, DIM_SSIZE, i, fd) != i) 00347 return (CIF_SYSERR); 00348 } 00349 00350 } 00351 break; 00352 00353 case CIF_CDIR: 00354 if (fwrite((char *)CIFCDIR(cr)->ids, sizeof(long), CIFCDIR(cr)->nids, fd) 00355 != CIFCDIR(cr)->nids) return (CIF_SYSERR); 00356 break; 00357 00358 case CIF_CDIR_DOSHARED: 00359 if (fwrite((char *)CIFCDIRDO(cr)->ids, sizeof(long), CIFCDIRDO(cr)->nids, fd) 00360 != CIFCDIRDO(cr)->nids) return (CIF_SYSERR); 00361 break; 00362 00363 case CIF_GEOMETRY: 00364 if ((i = CIFGEOM(cr)->ndims) > 0) { 00365 if (fwrite(CIFGEOM(cr)->dim, GEOM_SSIZE, i, fd) != i) 00366 return (CIF_SYSERR); 00367 } 00368 if (CIFGEOM(cr)->name != NULL) { 00369 if (fwrite (CIFGEOM(cr)->name, sizeof(char), CIFGEOM(cr)->nlen, fd) 00370 != CIFGEOM(cr)->nlen) return (CIF_SYSERR); 00371 } 00372 break; 00373 00374 case CIF_UNIT: 00375 if (fwrite (CIFUNIT(cr)->name, sizeof(char), CIFUNIT(cr)->nlen, fd) 00376 != CIFUNIT(cr)->nlen) return (CIF_SYSERR); 00377 break; 00378 00379 case CIF_ENDUNIT: 00380 if (fwrite (CIFENDU(cr)->name, sizeof(char), CIFENDU(cr)->nlen, fd) 00381 != CIFENDU(cr)->nlen) return (CIF_SYSERR); 00382 break; 00383 00384 case CIF_USAGE: 00385 /* Check which structures we should be using, v1 or v2 */ 00386 00387 if (_Cif_filetbl[cifd].version == 1) { 00388 00389 if (fwrite (CIFUSAGE1(cr)->use, sizeof(struct Cif_use), 00390 CIFUSAGE1(cr)->nuses, fd) != CIFUSAGE1(cr)->nuses) 00391 return (CIF_SYSERR); 00392 00393 } 00394 else { /* writing a v2 cif */ 00395 00396 if (fwrite (CIFUSAGE(cr)->use, sizeof(struct Cif_use), 00397 CIFUSAGE(cr)->nuses, fd) != CIFUSAGE(cr)->nuses) 00398 return (CIF_SYSERR); 00399 00400 if (CIFUSAGE(cr)->nmembs > 0) { 00401 if (fwrite (CIFUSAGE(cr)->membs, sizeof(long), 00402 CIFUSAGE(cr)->nmembs, fd) != CIFUSAGE(cr)->nmembs) 00403 return (CIF_SYSERR); 00404 } 00405 } 00406 break; 00407 00408 case CIF_FILEDIR: 00409 { 00410 struct Cif_unittbl *ut; 00411 00412 ut = CIFFDIR(cr)->ut; 00413 for (i= 0; i < (int) CIFFDIR(cr)->nunits; i++, ut++) { 00414 if (fwrite (ut, UNITTBL_SSIZE, 1, fd) != 1) return (CIF_SYSERR); 00415 if (fwrite (ut->name, sizeof(char), ut->nlen, fd) != ut->nlen) 00416 return (CIF_SYSERR); 00417 } 00418 break; 00419 } 00420 00421 case CIF_C_TAG: 00422 00423 for (i = 0; i < (int) CIFCTAG(cr)->nmods; i++) { 00424 if (fwrite (&(CIFCTAG(cr)->mods[i]), TMOD_SSIZE, 1, fd) != 1) 00425 return (CIF_SYSERR); 00426 } 00427 00428 i = CIFCTAG(cr)->nmems; 00429 if (fwrite (CIFCTAG(cr)->memids, sizeof(long), i, fd) != i) 00430 return(CIF_SYSERR); 00431 if (fwrite (CIFCTAG(cr)->name, sizeof(char), CIFCTAG(cr)->nlen, fd) != 00432 CIFCTAG(cr)->nlen) return (CIF_SYSERR); 00433 00434 break; 00435 00436 case CIF_C_OPTS: 00437 if (fwrite (CIFCOPTS(cr)->name, sizeof(char), CIFCOPTS(cr)->nlen, fd) != 00438 CIFCOPTS(cr)->nlen) return (CIF_SYSERR); 00439 if ((i = write_strlist (CIFCOPTS(cr)->incs, (int) CIFCOPTS(cr)->nincs)) < 0) 00440 return (i); 00441 if ((i = write_strlist (CIFCOPTS(cr)->defs, (int) CIFCOPTS(cr)->ndefs)) < 0) 00442 return (i); 00443 if ((i = write_strlist (CIFCOPTS(cr)->udefs, (int) CIFCOPTS(cr)->nudefs)) < 0) 00444 return (i); 00445 break; 00446 00447 case CIF_C_MESSAGE: 00448 00449 /* Check which structures we should be using, v1 or v2 */ 00450 00451 if (_Cif_filetbl[cifd].version == 1) { 00452 00453 if ((i = write_strlist (CIFCMSG1(cr)->args, (int) CIFCMSG1(cr)->nargs)) < 0) 00454 return (i); 00455 00456 } 00457 else { /* writing a v2 cif */ 00458 00459 if ((i = write_strlist (CIFCMSG(cr)->args, (int) CIFCMSG(cr)->nargs)) < 0) 00460 return (i); 00461 } 00462 00463 break; 00464 00465 case CIF_C_CONST: 00466 if (fwrite (CIFCCON(cr)->value, sizeof(char), CIFCCON(cr)->vlen, fd) 00467 != CIFCCON(cr)->vlen) return (CIF_SYSERR); 00468 break; 00469 00470 case CIF_C_ENTRY: 00471 00472 /* Check which structures we should be using, v1 or v2 */ 00473 00474 if (_Cif_filetbl[cifd].version == 1) { 00475 00476 for (i = 0; i < (int) CIFCENTRY1(cr)->nmods; i++) { 00477 if (fwrite (&(CIFCENTRY1(cr)->mods[i]), TMOD_SSIZE, 1, fd) != 1) 00478 return (CIF_SYSERR); 00479 } 00480 if (fwrite (CIFCENTRY1(cr)->argids, sizeof(long), CIFCENTRY1(cr)->nargs, 00481 fd) != CIFCENTRY1(cr)->nargs) return (CIF_SYSERR); 00482 if (fwrite (CIFCENTRY1(cr)->name, sizeof(char), CIFCENTRY1(cr)->nlen, fd) 00483 != CIFCENTRY1(cr)->nlen) return (CIF_SYSERR); 00484 00485 } 00486 else { /* writing a v2 cif */ 00487 00488 for (i = 0; i < (int) CIFCENTRY(cr)->nmods; i++) { 00489 if (fwrite (&(CIFCENTRY(cr)->mods[i]), TMOD_SSIZE, 1, fd) != 1) 00490 return (CIF_SYSERR); 00491 } 00492 if (fwrite (CIFCENTRY(cr)->argids, sizeof(long), CIFCENTRY(cr)->nargs, 00493 fd) != CIFCENTRY(cr)->nargs) return (CIF_SYSERR); 00494 if (fwrite (CIFCENTRY(cr)->name, sizeof(char), CIFCENTRY(cr)->nlen, fd) 00495 != CIFCENTRY(cr)->nlen) return (CIF_SYSERR); 00496 } 00497 00498 break; 00499 00500 case CIF_C_OBJECT: 00501 for (i = 0; i < (int) CIFCOBJ(cr)->nmods; i++) { 00502 if (fwrite (&(CIFCOBJ(cr)->mods[i]), TMOD_SSIZE, 1, fd) != 1) 00503 return (CIF_SYSERR); 00504 } 00505 if (CIFCOBJ(cr)->nlen > 0) { 00506 if (fwrite (CIFCOBJ(cr)->name, sizeof(char), CIFCOBJ(cr)->nlen, fd) 00507 != CIFCOBJ(cr)->nlen) return (CIF_SYSERR); 00508 } 00509 break; 00510 00511 case CIF_C_LINT_DIRECTIVE: 00512 00513 if (CIFCLDIR(cr)->nlen > 0) { 00514 if (fwrite (CIFCLDIR(cr)->name, sizeof(char), CIFCLDIR(cr)->nlen, fd) 00515 != CIFCLDIR(cr)->nlen) return (CIF_SYSERR); 00516 } 00517 00518 break; 00519 00520 case CIF_C_MACRO_DEF: 00521 00522 if (CIFCMDEF(cr)->nlen > 0) { 00523 if (fwrite (CIFCMDEF(cr)->name, sizeof(char), CIFCMDEF(cr)->nlen, fd) 00524 != CIFCMDEF(cr)->nlen) return (CIF_SYSERR); 00525 } 00526 00527 break; 00528 00529 case CIF_C_ENTRY_END: 00530 00531 if (CIFCEEND(cr)->nlen > 0) { 00532 if (fwrite (CIFCEEND(cr)->name, sizeof(char), CIFCEEND(cr)->nlen, fd) 00533 != CIFCEEND(cr)->nlen) return (CIF_SYSERR); 00534 } 00535 00536 break; 00537 00538 case CIF_BE_NODE: 00539 if (_Cif_filetbl[cifd].version == 2) { 00540 00541 if ( (n = CIFBENODE2(cr)->nsuccs) > 0 ) { 00542 if ( (int) fwrite( (char *)CIFBENODE2(cr)->succs, sizeof( int ), n, fd ) < n ) 00543 return( CIF_SYSERR ); 00544 } 00545 if ( (n = CIFBENODE2(cr)->nlines) > 0 ) { 00546 if ( (int) fwrite( (char *)CIFBENODE2(cr)->lines, sizeof( int ), n, fd ) < n ) 00547 return( CIF_SYSERR ); 00548 } 00549 cp = CIFBENODE2(cr)->label; 00550 n = strlen( cp ); 00551 assert( n < 255 ); 00552 c = n; 00553 if ( (int) fwrite( &c, 1, 1, fd ) < 1 ) 00554 return( CIF_SYSERR ); 00555 if ( (int) fwrite( cp, 1, n, fd ) < n ) 00556 return( CIF_SYSERR ); 00557 00558 } else { /* version >= 3 */ 00559 00560 if ( (n = CIFBENODE(cr)->nsuccs) > 0 ) { 00561 if ( (int) fwrite( (char *)CIFBENODE(cr)->succs, sizeof( int ), n, fd ) < n ) 00562 return( CIF_SYSERR ); 00563 } 00564 if ( (n = CIFBENODE(cr)->nlines) > 0 ) { 00565 if ( (int) fwrite( (char *)CIFBENODE(cr)->fid, sizeof( int ), n, fd ) < n ) 00566 return( CIF_SYSERR ); 00567 if ( (int) fwrite( (char *)CIFBENODE(cr)->lines, sizeof( int ), n, fd ) < n ) 00568 return( CIF_SYSERR ); 00569 } 00570 cp = CIFBENODE(cr)->label; 00571 n = strlen( cp ); 00572 assert( n < 255 ); 00573 c = n; 00574 if ( (int) fwrite( &c, 1, 1, fd ) < 1 ) 00575 return( CIF_SYSERR ); 00576 if ( (int) fwrite( cp, 1, n, fd ) < n ) 00577 return( CIF_SYSERR ); 00578 } 00579 break; 00580 00581 case CIF_BE_FID: 00582 if ( (n = CIFBEFID(cr)->nfid) > 0 ) { 00583 if ( (int) fwrite( (char *)CIFBEFID(cr)->fid, sizeof( int ), n, fd ) < n ) 00584 return( CIF_SYSERR ); 00585 } 00586 break; 00587 00588 case CIF_F90_CALLSITE: 00589 if ((i = CIFF90CS(cr)->nargs) > 0) { 00590 if (fwrite((char *)CIFF90CS(cr)->argids, sizeof(long), i, fd) != i) 00591 return (CIF_SYSERR); 00592 if (fwrite((char *)CIFF90CS(cr)->nmembs, sizeof(int), i, fd) != i) 00593 return (CIF_SYSERR); 00594 00595 for (j = 0; j < (int) CIFF90CS(cr)->nargs; j++) { 00596 if (CIFF90CS(cr)->nmembs[j] > 0) 00597 if (fwrite((char *)CIFF90CS(cr)->membs[j], sizeof(long), CIFF90CS(cr)->nmembs[j], fd) != CIFF90CS(cr)->nmembs[j]) 00598 return (CIF_SYSERR); 00599 } 00600 00601 if (CIFF90CS(cr)->rank == 1) { 00602 00603 if (fwrite((char *)CIFF90CS(cr)->ranks, sizeof(int), i, fd) != i) 00604 return (CIF_SYSERR); 00605 00606 } 00607 00608 00609 00610 } 00611 break; 00612 00613 case CIF_F90_SCOPE_INFO: 00614 if ((i = CIFF90SI(cr)->numalts) > 0) { 00615 if (fwrite((char *)CIFF90SI(cr)->entryids, sizeof(long), i, fd) != i) 00616 return (CIF_SYSERR); 00617 } 00618 break; 00619 00620 case CIF_F90_COMBLK: 00621 if (fwrite (CIFF90CB(cr)->name, sizeof(char), CIFF90CB(cr)->nlen, fd) != 00622 CIFF90CB(cr)->nlen) return (CIF_SYSERR); 00623 break; 00624 00625 00626 case CIF_F90_CONST: 00627 if (fwrite (CIFF90CON(cr)->value, sizeof(char), CIFF90CON(cr)->vlen, fd) != 00628 CIFF90CON(cr)->vlen) return (CIF_SYSERR); 00629 00630 break; 00631 00632 case CIF_F90_ENTRY: 00633 00634 if ((i = CIFF90ENTRY(cr)->nargs) > 0) { 00635 if (fwrite (CIFF90ENTRY(cr)->argids, sizeof(long), i, fd) != i) 00636 return (CIF_SYSERR); 00637 } 00638 if (fwrite (CIFF90ENTRY(cr)->name, sizeof(char), CIFF90ENTRY(cr)->nlen, fd) 00639 != CIFF90ENTRY(cr)->nlen) return (CIF_SYSERR); 00640 00641 break; 00642 00643 00644 00645 00646 case CIF_F90_DERIVED_TYPE: 00647 /* Check which structures we should be using, v2 or v3 */ 00648 00649 if (_Cif_filetbl[cifd].version == 2) { 00650 00651 if (fwrite (CIFF90DTYPE2(cr)->name, sizeof(char), CIFF90DTYPE2(cr)->nlen, fd) 00652 != CIFF90DTYPE2(cr)->nlen) return (CIF_SYSERR); 00653 if ((i = CIFF90DTYPE2(cr)->nmembs) > 0) { 00654 if (fwrite (CIFF90DTYPE2(cr)->memids, sizeof(long), i, fd) != i) 00655 return (CIF_SYSERR); 00656 } 00657 } 00658 else { /* Version 3 CIF */ 00659 00660 if (fwrite (CIFF90DTYPE(cr)->name, sizeof(char), CIFF90DTYPE(cr)->nlen, fd) 00661 != CIFF90DTYPE(cr)->nlen) return (CIF_SYSERR); 00662 if ((i = CIFF90DTYPE(cr)->nmembs) > 0) { 00663 if (fwrite (CIFF90DTYPE(cr)->memids, sizeof(long), i, fd) != i) 00664 return (CIF_SYSERR); 00665 } 00666 } 00667 00668 break; 00669 00670 case CIF_F90_LABEL: 00671 if (fwrite (CIFF90LABEL(cr)->name, sizeof(char), CIFF90LABEL(cr)->nlen, fd) 00672 != CIFF90LABEL(cr)->nlen) return (CIF_SYSERR); 00673 break; 00674 00675 case CIF_F90_NAMELIST: 00676 00677 if (fwrite (CIFF90NL(cr)->name, sizeof(char), CIFF90NL(cr)->nlen, fd) != 00678 CIFF90NL(cr)->nlen) return (CIF_SYSERR); 00679 00680 if (fwrite((char *)CIFF90NL(cr)->ids, sizeof(long), CIFF90NL(cr)->nids, fd) 00681 != CIFF90NL(cr)->nids) return (CIF_SYSERR); 00682 00683 break; 00684 00685 case CIF_F90_OBJECT: 00686 if (CIFF90OBJ(cr)->name != NULL) { 00687 if (fwrite (CIFF90OBJ(cr)->name, sizeof(char), CIFF90OBJ(cr)->nlen, fd) 00688 != CIFF90OBJ(cr)->nlen) return (CIF_SYSERR); 00689 } 00690 if ((i = CIFF90OBJ(cr)->ndims) > 0 && 00691 CIFF90OBJ(cr)->atype != CIF_AT_DEFERRED) { /* deferred arrays have all 00692 * dimensions assumed to be ':' 00693 */ 00694 if (fwrite(CIFF90OBJ(cr)->dim, DIM_SSIZE, i, fd) != i) 00695 return (CIF_SYSERR); 00696 } 00697 break; 00698 00699 00700 case CIF_F90_MISC_OPTS: 00701 00702 if ((i = CIFF90MO(cr)->ciflen) > 0) { 00703 if (fwrite (CIFF90MO(cr)->cifname, sizeof(char), i, fd) != i) 00704 return (CIF_SYSERR); 00705 } 00706 00707 if ((i = write_strlist (CIFF90MO(cr)->Pdirs, (int) CIFF90MO(cr)->nPdirs)) < 0) 00708 return (i); 00709 00710 if ((i = write_strlist (CIFF90MO(cr)->pdirs, (int) CIFF90MO(cr)->npdirs)) < 0) 00711 return (i); 00712 if ((i = CIFF90MO(cr)->nmsgs) > 0) { 00713 if (fwrite (CIFF90MO(cr)->msgno, sizeof(long), i, fd) != i) 00714 return (CIF_SYSERR); 00715 } 00716 if ((i = write_strlist (CIFF90MO(cr)->cdirs, (int) CIFF90MO(cr)->ncdirs)) < 0) 00717 return (i); 00718 if ((i = CIFF90MO(cr)->onlen) > 0) { 00719 if (fwrite (CIFF90MO(cr)->objname, sizeof(char), i, fd) != i) 00720 return (CIF_SYSERR); 00721 } 00722 if ((i = CIFF90MO(cr)->cnlen) > 0) { 00723 if (fwrite (CIFF90MO(cr)->calname, sizeof(char), i, fd) != i) 00724 return (CIF_SYSERR); 00725 } 00726 if ((i = CIFF90MO(cr)->inlen) > 0) { 00727 if (fwrite (CIFF90MO(cr)->inname, sizeof(char), i, fd) != i) 00728 return (CIF_SYSERR); 00729 } 00730 break; 00731 00732 00733 case CIF_F90_OPT_OPTS: 00734 00735 if ((i = CIFF90OPTOPT(cr)->noptlevels) > 0) { 00736 if (fwrite (CIFF90OPTOPT(cr)->lopts, OPTS_SSIZE, i, fd) != i) 00737 return (CIF_SYSERR); 00738 } 00739 break; 00740 00741 case CIF_F90_INT_BLOCK: 00742 /* Check which structures we should be using, v2 or v3 */ 00743 00744 if (_Cif_filetbl[cifd].version == 2) { 00745 00746 if ((i = CIFF90IB2(cr)->nlen) > 0) { 00747 if (fwrite (CIFF90IB2(cr)->name, sizeof(char), i, fd) != i) 00748 return (CIF_SYSERR); 00749 } 00750 if ((i = CIFF90IB2(cr)->numints) > 0) { 00751 if (fwrite (CIFF90IB2(cr)->procids, sizeof(long), i, fd) != i) 00752 return (CIF_SYSERR); 00753 } 00754 } 00755 else { /* Version 3 CIF */ 00756 00757 if ((i = CIFF90IB(cr)->nlen) > 0) { 00758 if (fwrite (CIFF90IB(cr)->name, sizeof(char), i, fd) != i) 00759 return (CIF_SYSERR); 00760 } 00761 if ((i = CIFF90IB(cr)->numints) > 0) { 00762 if (fwrite (CIFF90IB(cr)->procids, sizeof(long), i, fd) != i) 00763 return (CIF_SYSERR); 00764 } 00765 } 00766 break; 00767 00768 case CIF_F90_RENAME: 00769 00770 if ((i = CIFF90RN(cr)->nlen) > 0) { 00771 if (fwrite (CIFF90RN(cr)->name, sizeof(char), i, fd) != i) 00772 return (CIF_SYSERR); 00773 } 00774 if ((i = CIFF90RN(cr)->orignlen) > 0) { 00775 if (fwrite (CIFF90RN(cr)->origname, sizeof(char), i, fd) != i) 00776 return (CIF_SYSERR); 00777 } 00778 00779 if ((i = CIFF90RN(cr)->nlocalids) > 0) { 00780 if (fwrite (CIFF90RN(cr)->localid, sizeof(long), i, fd) != i) 00781 return (CIF_SYSERR); 00782 } 00783 break; 00784 00785 case CIF_CC_TYPE: 00786 if ((i = CIFCCTYPE(cr)->nlen) > 0) { 00787 if (fwrite (CIFCCTYPE(cr)->name, sizeof(char), i, fd) != i) 00788 return (CIF_SYSERR); 00789 } 00790 if ( (n = CIFCCTYPE(cr)->nmem) > 0 ) { 00791 if ( (int) fwrite( (char *)CIFCCTYPE(cr)->mem, sizeof( int ), n, fd ) < n ) 00792 return( CIF_SYSERR ); 00793 } 00794 break; 00795 00796 case CIF_CC_ENTRY: 00797 if ((i = CIFCCENT(cr)->nlen) > 0) { 00798 if (fwrite (CIFCCENT(cr)->name, sizeof(char), i, fd) != i) 00799 return (CIF_SYSERR); 00800 } 00801 if ((i = CIFCCENT(cr)->elen) > 0) { 00802 if (fwrite (CIFCCENT(cr)->ename, sizeof(char), i, fd) != i) 00803 return (CIF_SYSERR); 00804 } 00805 if ( (n = CIFCCENT(cr)->nparam) > 0 ) { 00806 if ( (int) fwrite( (char *)CIFCCENT(cr)->param, sizeof( int ), n, fd ) < n ) 00807 return( CIF_SYSERR ); 00808 } 00809 break; 00810 00811 case CIF_CC_OBJ: 00812 if ((i = CIFCCOBJ(cr)->nlen) > 0) { 00813 if (fwrite (CIFCCOBJ(cr)->name, sizeof(char), i, fd) != i) 00814 return (CIF_SYSERR); 00815 } 00816 break; 00817 00818 case CIF_CC_ENUM: 00819 if ((i = CIFCCENUM(cr)->nlen) > 0) { 00820 if (fwrite (CIFCCENUM(cr)->name, sizeof(char), i, fd) != i) 00821 return (CIF_SYSERR); 00822 } 00823 if ((i = CIFCCENUM(cr)->vlen) > 0) { 00824 if (fwrite (CIFCCENUM(cr)->value, sizeof(char), i, fd) != i) 00825 return (CIF_SYSERR); 00826 } 00827 break; 00828 00829 case CIF_CC_EXPR: 00830 if ( (n = CIFCCEXPR(cr)->noper) > 0 ) { 00831 if ( (int) fwrite( (char *)CIFCCEXPR(cr)->oper, sizeof( int ), n, fd ) < n ) 00832 return( CIF_SYSERR ); 00833 } 00834 break; 00835 00836 default: 00837 break; 00838 00839 } 00840 return (0); 00841 }
1.7.6.1 
