1 /* 2 * Copyright (c) 1995-2018, NVIDIA CORPORATION. All rights reserved. 3 * 4 * Licensed under the Apache License, Version 2.0 (the "License"); 5 * you may not use this file except in compliance with the License. 6 * You may obtain a copy of the License at 7 * 8 * http://www.apache.org/licenses/LICENSE-2.0 9 * 10 * Unless required by applicable law or agreed to in writing, software 11 * distributed under the License is distributed on an "AS IS" BASIS, 12 * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 * See the License for the specific language governing permissions and 14 * limitations under the License. 15 * 16 */ 17 18 /** \file 19 * \brief Global definitions and declarations for Fortran I/O library 20 */ 21 22 #include "fioMacros.h" 23 #include "stdioInterf.h" /* stubbed version of stdio.h */ 24 #include "cnfg.h" /* declarations for configuration items */ 25 26 #define GBL_SIZE_T_FORMAT "zu" 27 28 typedef int DBLINT64[2]; 29 typedef unsigned int DBLUINT64[2]; 30 31 /* declarations needed where integer*8 & logical*8 are supported and 32 * the natural integer is integer*4 (__BIGINT is __INT4). 33 */ 34 35 #define I64_MSH(t) t[1] 36 #define I64_LSH(t) t[0] 37 38 extern int __ftn_32in64_; 39 40 #ifndef LOCAL_DEBUG 41 #define LOCAL_DEBUG 0 42 #endif 43 44 typedef unsigned short WCHAR; 45 46 /* declare some external library functions required: */ 47 48 #define VOID void 49 50 WIN_MSVCRT_IMP char *WIN_CDECL getenv(const char *); 51 WIN_MSVCRT_IMP long WIN_CDECL strtol(const char *, char **, int); 52 WIN_MSVCRT_IMP char *WIN_CDECL strerror(int); 53 WIN_MSVCRT_IMP char *WIN_CDECL strstr(const char *, const char *); 54 55 typedef __INT_T INT; /* native integer at least 32 bits */ 56 typedef unsigned int UINT; /* unsigned 32 bit native integer */ 57 #define ISDIGIT(c) ((c) >= '0' && (c) <= '9') 58 59 /* 60 * Because of bugs in AT&T SysV R4 fwrite, it is necessary to use 61 * a special version of fwrite for line-buffered files. This 62 * is defined in the makefile as BROKEN_FWRITE. 63 */ 64 #undef FWRITE 65 #define FWRITE __io_fwrite 66 67 #define TRUE 1 68 #define FALSE 0 69 typedef int bool; 70 typedef char sbool; /* short boolean (for use in large structs) */ 71 72 /* true and false as represented in Fortran program at runtime: */ 73 #define FTN_TRUE GET_FIO_CNFG_FTN_TRUE 74 #define FTN_FALSE 0 75 76 #if LOCAL_DEBUG 77 #define assert(ex) \ 78 { \ 79 if (!(ex)) { \ 80 (VOID) __io_fprintf(__io_stderr(), \ 81 "Fio-assertion failed: file \"%s\", line %d\n", \ 82 __FILE__, __LINE__); \ 83 } \ 84 } 85 #else 86 #define assert(ex) 87 #endif 88 89 extern char *strcpy(); 90 #define STASH(str) (strcpy((char *)malloc(strlen(str) + 1), str)) 91 92 /* defs used by __fortio_error */ 93 94 #define ERR_FLAG 1 95 #define EOF_FLAG 2 96 #define EOR_FLAG 3 97 98 #define FIO_BITV_NONE 0x00 99 #define FIO_BITV_IOSTAT 0x01 100 #define FIO_BITV_ERR 0x02 101 #define FIO_BITV_EOF 0x04 102 #define FIO_BITV_EOR 0x08 103 #define FIO_BITV_IOMSG 0x10 104 105 #define FIO_STAT_INTERNAL_UNIT \ 106 99 /* must be kept in sync with \ 107 * iso_fortran_env.f90:IOSTAT_INQUIRE_INTERNAL_UNIT */ 108 109 /* 110 * maximum filename length in bytes which should be sufficient for 111 * most cases, including the names of scratch files. open & inquire 112 * will allow longer names, but must malloc/free temp space. 113 */ 114 115 #define MAX_NAMELEN 255 116 117 /* Fortran I/O error code definitions: */ 118 119 #define FIO_ERROR_OFFSET 200 /* smallest error value */ 120 /* 200 */ 121 #define FIO_ESPEC 201 122 #define FIO_ECOMPAT 202 123 #define FIO_ERECLEN 203 124 #define FIO_EREADONLY 204 125 #define FIO_EDISPOSE 205 126 #define FIO_ESCRATCH 206 127 #define FIO_EOPENED 207 128 #define FIO_EEXIST 208 129 #define FIO_ENOEXIST 209 130 #define FIO_ENOMEM 210 131 #define FIO_ENAME 211 132 #define FIO_EUNIT 212 133 #define FIO_ERECL 213 134 #define FIO_EWRITEONLY 214 135 #define FIO_EFORM 215 136 /* 216 */ 137 #define FIO_EEOF 217 138 #define FIO_EEOR 218 139 #define FIO_ETOOBIG 219 140 #define FIO_ETOOFAR 220 141 #define FIO_EFSYNTAX 221 142 #define FIO_EPAREN 222 143 #define FIO_EPT 223 144 #define FIO_ESTRING 224 145 #define FIO_ELEX 225 146 #define FIO_ELETTER 226 147 /* 227 */ 148 #define FIO_ENOGROUP 228 149 #define FIO_ENMLEOF 229 150 #define FIO_ESCALEF 230 151 #define FIO_EERR_DATA_CONVERSION 231 152 /* 232 */ 153 #define FIO_ETOOM 233 154 #define FIO_EEDITDSCR 234 155 #define FIO_EMISMATCH 235 156 #define FIO_EBIGREC 236 157 #define FIO_EQUAD 237 158 #define FIO_ETAB_VALUE_OUT_OF_RANGE 238 159 #define FIO_ENOTMEM 239 160 #define FIO_ELPAREN 240 161 #define FIO_EENDFMT 241 162 #define FIO_EDIRECT 242 163 #define FIO_EPNEST 243 164 #define FIO_ENONAME 244 165 #define FIO_ESYNTAX 245 166 #define FIO_EINFINITE_REVERSION 246 167 /* 247 */ 168 #define FIO_ESUBSC 248 169 #define FIO_EFGD 249 170 #define FIO_EDOT 250 171 #define FIO_ECHAR 251 172 #define FIO_EEOFERR 252 173 #define FIO_EDREAD 253 174 #define FIO_EREPCNT 254 175 #define FIO_EASYNC 255 176 #define FIO_EPOS 256 177 #define FIO_EPOSV 257 178 #define FIO_ENEWUNIT 258 179 180 #define FIRST_NEWUNIT -13 /* newunits are less than or equal to this */ 181 #define ILLEGAL_UNIT(u) \ 182 ((u) < 0 && ((u) > FIRST_NEWUNIT || (u) <= next_newunit)) 183 184 /* Fortran I/O file control block struct */ 185 186 typedef struct fcb { 187 struct fcb *next; /* pointer to next fcb in avail or allocd 188 * list. 189 */ 190 FILE *fp; /* UNIX file pointer from fopen(). Note that a 191 * non-NULL value for this field is what 192 * indicates that a particular FCB is in use. 193 */ 194 char *name; /* file name */ 195 int unit; /* unit number */ 196 __INT8_T reclen; /* access record length in bytes or words for 197 * direct access files 198 */ 199 __INT8_T 200 partial; /* Flag/count of bytes in last record when the last record is 201 * shorter than reclen. Set and used only during a direct, 202 * unformated read of last record . */ 203 int wordlen; /* length of words in bytes */ 204 __INT8_T nextrec; /* record number of next record */ 205 __INT8_T maxrec; /* maximum record number (direct access only) */ 206 __INT8_T skip; /* After a nonadvancing write statement, this 207 * field is the number of characters remaining 208 * in the buffer, i.e., it's possible that not 209 * all of data in the buffer is transferred to 210 * file. For example, the descriptors, T & TL 211 * could effect a record position before data 212 * which was already present in the buffer. 213 */ 214 char *skip_buff; /* If skip is nonzero, this field is a pointer 215 * to an allocated temporary which contains the 216 * characters remaining in the buffer and not 217 * transferred to file. Upon an ensuing write 218 * of the same file, the characters in the 219 * temporary buffer will be copied to the buffer 220 * used by fmtwrite.c. 221 */ 222 short status; /* FIO_OLD or FIO_SCRATCH */ 223 short dispose; /* KEEP, DELETE or SAVE */ 224 short acc; /* FIO_DIRECT or FIO_SEQUENTIAL (never APPEND)*/ 225 short action; /* READ, WRITE, or READWRITE */ 226 short blank; /* FIO_NULL or ZERO */ 227 short form; /* FIO_FORMATTED or FIO_UNFORMATTED */ 228 short pad; /* YES or NO */ 229 short pos; /* ASIS, REWIND, or APPEND */ 230 short delim; /* APOSTROPHE, QUOTE, or NONE */ 231 short coherent; /* coherency check for read & write (e.g. write 232 * followed by read needs a seek): 233 * 0 = no seek necessary for read/write 234 * 1 = coherent only if write. 235 * 2 = coherent only if read. 236 */ 237 short share; /* bit vector of file sharing values TBD */ 238 short decimal; /* COMMA, POINT, */ 239 short encoding; /* UTF-8, UNKNOWN */ 240 short round; /* UP, DOWN, ZERO, NEAREST, COMPATIBLE, 241 * PROCESSOR_DEFINED 242 */ 243 short sign; /* PLUS, SUPPRESS, PROCESSOR_DEFINED */ 244 sbool eof_flag; /* indicates that (imaginary) eof record has 245 * been read. Initially FALSE, set by ENDFILE 246 * or read past endoffile; cleared by REWIND 247 * and BACKSPACE 248 */ 249 sbool named; /* whether file is named or not */ 250 sbool stdunit; /* FCB connected to stdin/stderr/stdout */ 251 sbool truncflag; /* for sequential files only. If write 252 * stmt occurs, file must be truncated if 253 * necessary 254 */ 255 sbool binary; /* for unformatted files only, binary mode. 256 * if set, record length words are not present. 257 */ 258 sbool ispipe; /* FCB connected to a tty or named pipe */ 259 sbool nonadvance; /* last fmt write had advance=no */ 260 sbool eor_flag; /* nonadvancing unit is at the end-of-record; 261 * detected when the unit is a stdunit 262 */ 263 /* 264 * byte_swap, native: two flags set when the CONVERT open specifier 265 * is present. The default value (the CONVERT specifer is absent) 266 * for both flags is false. 267 */ 268 sbool byte_swap; /* unformatted data needs to be byte swapped */ 269 sbool native; /* unformatted data is in native format */ 270 sbool asy_rw; /* async read/write stmt active */ 271 struct asy *asyptr; /* pointer to asynch information,set by open */ 272 char *pread; /* points to buffer of already read line 273 * this is currently used in namelist only 274 * record is read per line, we must point back 275 * to a position after '=' for a child io. 276 */ 277 char *pback; /* need to keep track of the last line read 278 * used in nmlread too. 279 */ 280 } FIO_FCB; 281 282 /* 283 * FIO_FCB flags were moved to a separate header file because some low 284 * level routines (rounding in particular) need to access them without 285 * all the other global.h stuff 286 */ 287 #include "fio_fcb_flags.h" 288 289 /* 290 * declare structure representing a value found during list-directed/namelist 291 * read. This value is stored by __fortio_assign() 292 */ 293 /* WARNING: assumes BIGINT can hold any BIGLOG size */ 294 typedef struct atag { 295 int dtype; /* __BIGINT,__BIGLOG, __BIGREAL, __BIGCPLX, __(N)CHAR */ 296 union { /* value: depends on dtype */ 297 __BIGINT_T i; /* __BIGINT, __BIGLOG */ 298 __BIGREAL_T d; /* __BIGREAL */ 299 DBLINT64 i8; /* __INT8 */ 300 __INT8_T i8v; 301 DBLUINT64 ui8; /* __LOG8 */ 302 __INT8_UT ui8v; 303 struct { /* __STR, __NCHAR */ 304 int len; /* length of string */ 305 char *str; /* ptr to its characters */ 306 } c; 307 struct atag *cmplx; /* __BIGCPLX: ptr to 2 element TKNVAL, */ 308 /* [0] - real, [1] - imag, both are __BIGREAL */ 309 } val; 310 } AVAL; 311 312 /* declare global variables for Fortran I/O: */ 313 314 typedef struct { 315 FIO_FCB *fcbs; /* pointer to list of allocated fcbs */ 316 INT *enctab; /* pointer to buffer w encoded format */ 317 char *fname; /* file name for OPEN error messages */ 318 int fnamelen; 319 bool error; 320 bool eof; 321 bool pos_present; 322 seekoffx_t pos; 323 } FIO_TBL; 324 325 /* declare external variables/arrays used by Fortran I/O: */ 326 327 #include <errno.h> 328 329 extern FIO_TBL fioFcbTbls; 330 #ifdef WINNT 331 extern FIO_FCB *__get_fio_fcbs(void); 332 #define GET_FIO_FCBS __get_fio_fcbs() 333 #else 334 #define GET_FIO_FCBS fioFcbTbls.fcbs 335 336 #endif 337 338 extern int next_newunit; /* newunit counter */ 339 340 /*extern short __fortio_type_size[]; */ 341 342 /* #define FIO_TYPE_SIZE(i) __fortio_type_size[i] */ 343 #define FIO_TYPE_SIZE(i) (1 << GET_DIST_SHIFTS(i)) 344 345 extern char *envar_fortranopt; 346 347 /* declare external functions local to Fortran I/O: */ 348 349 extern int __fort_getpid(); 350 __INT_T __fort_time(void); 351 352 /***** assign.c *****/ 353 extern int __fortio_assign(char *, int, __CLEN_T, AVAL *); 354 355 /***** fpcvt.c *****/ 356 extern char *__fortio_ecvt(double, int, int *, int *, int); 357 extern char *__fortio_fcvt(__BIGREAL_T, int, int, int *, int *, int); 358 WIN_MSVCRT_IMP double WIN_CDECL strtod(const char *, char **); 359 #define __fortio_strtod(x, y) strtod(x, y) 360 361 /***** error.c *****/ 362 extern VOID set_gbl_newunit(bool newunit); 363 extern bool get_gbl_newunit(); 364 extern VOID __fortio_errinit(__INT_T, __INT_T, __INT_T *, char *); 365 extern VOID __fortio_errinit03(__INT_T unit, __INT_T bitv, __INT_T *iostat, 366 char *str); 367 extern VOID __fortio_errend(void); 368 extern VOID __fortio_errend03(void); 369 extern int f90_old_huge_rec_fmt(void); 370 extern int __fortio_error(int); 371 extern int __fortio_eoferr(int); 372 extern int __fortio_eorerr(int); 373 extern char *__fortio_errmsg(int); 374 extern int __fortio_check_format(void); 375 extern int __fortio_eor_crlf(void); 376 extern VOID __fortio_fmtinit(void); 377 extern VOID __fortio_fmtend(void); 378 #if defined(WINNT) 379 #define EOR_CRLF 1 380 #else 381 #define EOR_CRLF __fortio_eor_crlf() 382 #endif 383 extern int __fortio_no_minus_zero(void); 384 int __fortio_new_fp_formatter(void); 385 386 /***** hpfio.c *****/ 387 extern VOID __fort_status_init(__INT_T *, __INT_T *); 388 void __fortio_stat_init(__INT_T *bitv, __INT_T *iostat); 389 int __fortio_stat_bcst(int *stat); 390 #define DIST_STATUS_BCST(s) (s) 391 #define DIST_RBCSTL(a1, a2, a3, a4, a5, a6) 392 #define DIST_RBCST(a1, a2, a3, a4, a5) 393 394 /***** utils.c *****/ 395 extern FIO_FCB *__fortio_alloc_fcb(void); 396 extern VOID __fortio_free_fcb(FIO_FCB *); 397 extern VOID __fortio_cleanup_fcb(void); 398 extern FIO_FCB *__fortio_rwinit(int, int, __INT_T *, int); 399 extern FIO_FCB *__fortio_find_unit(int); 400 extern int __fortio_zeropad(FILE *, long); 401 extern bool __fortio_eq_str(char *, __CLEN_T, char *); 402 extern void *__fortio_fiofcb_asyptr(FIO_FCB *); 403 extern bool __fortio_fiofcb_asy_rw(FIO_FCB *); 404 extern void __fortio_set_asy_rw(FIO_FCB *, bool); 405 extern bool __fortio_fiofcb_stdunit(FIO_FCB *); 406 extern FILE *__fortio_fiofcb_fp(FIO_FCB *); 407 extern short __fortio_fiofcb_form(FIO_FCB *); 408 extern char *__fortio_fiofcb_name(FIO_FCB *); 409 extern void *__fortio_fiofcb_next(FIO_FCB *); 410 411 extern bool __fio_eq_str(char *str, int len, char *pattern); 412 extern VOID __fortio_swap_bytes(char *, int, long); 413