xref: /petsc/src/sys/fileio/sysio.c (revision 1b37a2a7cc4a4fb30c3e967db1c694c0a1013f51)
1 /*
2    This file contains simple binary read/write routines.
3  */
4 
5 #include <petscsys.h>
6 #include <petscbt.h>
7 #include <errno.h>
8 #include <fcntl.h>
9 #if defined(PETSC_HAVE_UNISTD_H)
10   #include <unistd.h>
11 #endif
12 #if defined(PETSC_HAVE_IO_H)
13   #include <io.h>
14 #endif
15 #if !defined(PETSC_HAVE_O_BINARY)
16   #define O_BINARY 0
17 #endif
18 
19 const char *const PetscFileModes[] = {"READ", "WRITE", "APPEND", "UPDATE", "APPEND_UPDATE", "PetscFileMode", "PETSC_FILE_", NULL};
20 
21 /*
22   PetscByteSwapEnum - Swap bytes in a  PETSc Enum
23 
24 */
25 static PetscErrorCode PetscByteSwapEnum(PetscEnum *buff, PetscInt n)
26 {
27   PetscInt  i, j;
28   PetscEnum tmp = ENUM_DUMMY;
29   char     *ptr1, *ptr2 = (char *)&tmp;
30 
31   PetscFunctionBegin;
32   for (j = 0; j < n; j++) {
33     ptr1 = (char *)(buff + j);
34     for (i = 0; i < (PetscInt)sizeof(PetscEnum); i++) ptr2[i] = ptr1[sizeof(PetscEnum) - 1 - i];
35     for (i = 0; i < (PetscInt)sizeof(PetscEnum); i++) ptr1[i] = ptr2[i];
36   }
37   PetscFunctionReturn(PETSC_SUCCESS);
38 }
39 
40 /*
41   PetscByteSwapBool - Swap bytes in a  PETSc Bool
42 
43 */
44 static PetscErrorCode PetscByteSwapBool(PetscBool *buff, PetscInt n)
45 {
46   PetscInt  i, j;
47   PetscBool tmp = PETSC_FALSE;
48   char     *ptr1, *ptr2 = (char *)&tmp;
49 
50   PetscFunctionBegin;
51   for (j = 0; j < n; j++) {
52     ptr1 = (char *)(buff + j);
53     for (i = 0; i < (PetscInt)sizeof(PetscBool); i++) ptr2[i] = ptr1[sizeof(PetscBool) - 1 - i];
54     for (i = 0; i < (PetscInt)sizeof(PetscBool); i++) ptr1[i] = ptr2[i];
55   }
56   PetscFunctionReturn(PETSC_SUCCESS);
57 }
58 
59 /*
60   PetscByteSwapInt - Swap bytes in a  PETSc integer (which may be 32 or 64-bits)
61 
62 */
63 static PetscErrorCode PetscByteSwapInt(PetscInt *buff, PetscInt n)
64 {
65   PetscInt i, j, tmp = 0;
66   char    *ptr1, *ptr2 = (char *)&tmp;
67 
68   PetscFunctionBegin;
69   for (j = 0; j < n; j++) {
70     ptr1 = (char *)(buff + j);
71     for (i = 0; i < (PetscInt)sizeof(PetscInt); i++) ptr2[i] = ptr1[sizeof(PetscInt) - 1 - i];
72     for (i = 0; i < (PetscInt)sizeof(PetscInt); i++) ptr1[i] = ptr2[i];
73   }
74   PetscFunctionReturn(PETSC_SUCCESS);
75 }
76 
77 /*
78   PetscByteSwapInt64 - Swap bytes in a  PETSc integer (64-bits)
79 
80 */
81 static PetscErrorCode PetscByteSwapInt64(PetscInt64 *buff, PetscInt n)
82 {
83   PetscInt   i, j;
84   PetscInt64 tmp = 0;
85   char      *ptr1, *ptr2 = (char *)&tmp;
86 
87   PetscFunctionBegin;
88   for (j = 0; j < n; j++) {
89     ptr1 = (char *)(buff + j);
90     for (i = 0; i < (PetscInt)sizeof(PetscInt64); i++) ptr2[i] = ptr1[sizeof(PetscInt64) - 1 - i];
91     for (i = 0; i < (PetscInt)sizeof(PetscInt64); i++) ptr1[i] = ptr2[i];
92   }
93   PetscFunctionReturn(PETSC_SUCCESS);
94 }
95 
96 /*
97   PetscByteSwapInt32 - Swap bytes in a  PETSc integer (32-bits)
98 
99 */
100 static PetscErrorCode PetscByteSwapInt32(PetscInt32 *buff, PetscInt n)
101 {
102   PetscInt   i, j;
103   PetscInt32 tmp = 0;
104   char      *ptr1, *ptr2 = (char *)&tmp;
105 
106   PetscFunctionBegin;
107   for (j = 0; j < n; j++) {
108     ptr1 = (char *)(buff + j);
109     for (i = 0; i < (PetscInt)sizeof(PetscInt32); i++) ptr2[i] = ptr1[sizeof(PetscInt32) - 1 - i];
110     for (i = 0; i < (PetscInt)sizeof(PetscInt32); i++) ptr1[i] = ptr2[i];
111   }
112   PetscFunctionReturn(PETSC_SUCCESS);
113 }
114 
115 /*
116   PetscByteSwapShort - Swap bytes in a short
117 */
118 static PetscErrorCode PetscByteSwapShort(short *buff, PetscInt n)
119 {
120   PetscInt i, j;
121   short    tmp;
122   char    *ptr1, *ptr2 = (char *)&tmp;
123 
124   PetscFunctionBegin;
125   for (j = 0; j < n; j++) {
126     ptr1 = (char *)(buff + j);
127     for (i = 0; i < (PetscInt)sizeof(short); i++) ptr2[i] = ptr1[sizeof(short) - 1 - i];
128     for (i = 0; i < (PetscInt)sizeof(short); i++) ptr1[i] = ptr2[i];
129   }
130   PetscFunctionReturn(PETSC_SUCCESS);
131 }
132 /*
133   PetscByteSwapLong - Swap bytes in a long
134 */
135 static PetscErrorCode PetscByteSwapLong(long *buff, PetscInt n)
136 {
137   PetscInt i, j;
138   long     tmp;
139   char    *ptr1, *ptr2 = (char *)&tmp;
140 
141   PetscFunctionBegin;
142   for (j = 0; j < n; j++) {
143     ptr1 = (char *)(buff + j);
144     for (i = 0; i < (PetscInt)sizeof(long); i++) ptr2[i] = ptr1[sizeof(long) - 1 - i];
145     for (i = 0; i < (PetscInt)sizeof(long); i++) ptr1[i] = ptr2[i];
146   }
147   PetscFunctionReturn(PETSC_SUCCESS);
148 }
149 
150 /*
151   PetscByteSwapReal - Swap bytes in a PetscReal
152 */
153 static PetscErrorCode PetscByteSwapReal(PetscReal *buff, PetscInt n)
154 {
155   PetscInt  i, j;
156   PetscReal tmp, *buff1 = (PetscReal *)buff;
157   char     *ptr1, *ptr2 = (char *)&tmp;
158 
159   PetscFunctionBegin;
160   for (j = 0; j < n; j++) {
161     ptr1 = (char *)(buff1 + j);
162     for (i = 0; i < (PetscInt)sizeof(PetscReal); i++) ptr2[i] = ptr1[sizeof(PetscReal) - 1 - i];
163     for (i = 0; i < (PetscInt)sizeof(PetscReal); i++) ptr1[i] = ptr2[i];
164   }
165   PetscFunctionReturn(PETSC_SUCCESS);
166 }
167 
168 /*
169   PetscByteSwapScalar - Swap bytes in a PetscScalar
170   The complex case is dealt with with an array of PetscReal, twice as long.
171 */
172 static PetscErrorCode PetscByteSwapScalar(PetscScalar *buff, PetscInt n)
173 {
174   PetscInt  i, j;
175   PetscReal tmp, *buff1 = (PetscReal *)buff;
176   char     *ptr1, *ptr2 = (char *)&tmp;
177 
178   PetscFunctionBegin;
179 #if defined(PETSC_USE_COMPLEX)
180   n *= 2;
181 #endif
182   for (j = 0; j < n; j++) {
183     ptr1 = (char *)(buff1 + j);
184     for (i = 0; i < (PetscInt)sizeof(PetscReal); i++) ptr2[i] = ptr1[sizeof(PetscReal) - 1 - i];
185     for (i = 0; i < (PetscInt)sizeof(PetscReal); i++) ptr1[i] = ptr2[i];
186   }
187   PetscFunctionReturn(PETSC_SUCCESS);
188 }
189 
190 /*
191   PetscByteSwapDouble - Swap bytes in a double
192 */
193 static PetscErrorCode PetscByteSwapDouble(double *buff, PetscInt n)
194 {
195   PetscInt i, j;
196   double   tmp, *buff1 = (double *)buff;
197   char    *ptr1, *ptr2 = (char *)&tmp;
198 
199   PetscFunctionBegin;
200   for (j = 0; j < n; j++) {
201     ptr1 = (char *)(buff1 + j);
202     for (i = 0; i < (PetscInt)sizeof(double); i++) ptr2[i] = ptr1[sizeof(double) - 1 - i];
203     for (i = 0; i < (PetscInt)sizeof(double); i++) ptr1[i] = ptr2[i];
204   }
205   PetscFunctionReturn(PETSC_SUCCESS);
206 }
207 
208 /*
209   PetscByteSwapFloat - Swap bytes in a float
210 */
211 static PetscErrorCode PetscByteSwapFloat(float *buff, PetscInt n)
212 {
213   PetscInt i, j;
214   float    tmp, *buff1 = (float *)buff;
215   char    *ptr1, *ptr2 = (char *)&tmp;
216 
217   PetscFunctionBegin;
218   for (j = 0; j < n; j++) {
219     ptr1 = (char *)(buff1 + j);
220     for (i = 0; i < (PetscInt)sizeof(float); i++) ptr2[i] = ptr1[sizeof(float) - 1 - i];
221     for (i = 0; i < (PetscInt)sizeof(float); i++) ptr1[i] = ptr2[i];
222   }
223   PetscFunctionReturn(PETSC_SUCCESS);
224 }
225 
226 PetscErrorCode PetscByteSwap(void *data, PetscDataType pdtype, PetscInt count)
227 {
228   PetscFunctionBegin;
229   if (pdtype == PETSC_INT) PetscCall(PetscByteSwapInt((PetscInt *)data, count));
230   else if (pdtype == PETSC_ENUM) PetscCall(PetscByteSwapEnum((PetscEnum *)data, count));
231   else if (pdtype == PETSC_BOOL) PetscCall(PetscByteSwapBool((PetscBool *)data, count));
232   else if (pdtype == PETSC_SCALAR) PetscCall(PetscByteSwapScalar((PetscScalar *)data, count));
233   else if (pdtype == PETSC_REAL) PetscCall(PetscByteSwapReal((PetscReal *)data, count));
234   else if (pdtype == PETSC_COMPLEX) PetscCall(PetscByteSwapReal((PetscReal *)data, 2 * count));
235   else if (pdtype == PETSC_INT64) PetscCall(PetscByteSwapInt64((PetscInt64 *)data, count));
236   else if (pdtype == PETSC_INT32) PetscCall(PetscByteSwapInt32((PetscInt32 *)data, count));
237   else if (pdtype == PETSC_DOUBLE) PetscCall(PetscByteSwapDouble((double *)data, count));
238   else if (pdtype == PETSC_FLOAT) PetscCall(PetscByteSwapFloat((float *)data, count));
239   else if (pdtype == PETSC_SHORT) PetscCall(PetscByteSwapShort((short *)data, count));
240   else if (pdtype == PETSC_LONG) PetscCall(PetscByteSwapLong((long *)data, count));
241   else if (pdtype == PETSC_CHAR) PetscFunctionReturn(PETSC_SUCCESS);
242   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown type: %d", pdtype);
243   PetscFunctionReturn(PETSC_SUCCESS);
244 }
245 
246 /*@C
247   PetscBinaryRead - Reads from a binary file.
248 
249   Not Collective
250 
251   Input Parameters:
252 + fd   - the file descriptor
253 . num  - the maximum number of items to read
254 - type - the type of items to read (`PETSC_INT`, `PETSC_REAL`, `PETSC_SCALAR`, etc.)
255 
256   Output Parameters:
257 + data  - the buffer, this is an array of the type that matches the value in `type`
258 - count - the number of items read, optional
259 
260   Level: developer
261 
262   Notes:
263   If `count` is not provided and the number of items read is less than
264   the maximum number of items to read, then this routine errors.
265 
266   `PetscBinaryRead()` uses byte swapping to work on all machines; the files
267   are written ALWAYS using big-endian ordering. On little-endian machines the numbers
268   are converted to the little-endian format when they are read in from the file.
269   When PETSc is ./configure with `--with-64-bit-indices` the integers are written to the
270   file as 64-bit integers, this means they can only be read back in when the option `--with-64-bit-indices`
271   is used.
272 
273 .seealso: `PetscBinaryWrite()`, `PetscBinaryOpen()`, `PetscBinaryClose()`, `PetscViewerBinaryGetDescriptor()`, `PetscBinarySynchronizedWrite()`,
274           `PetscBinarySynchronizedRead()`, `PetscBinarySynchronizedSeek()`
275 @*/
276 PetscErrorCode PetscBinaryRead(int fd, void *data, PetscInt num, PetscInt *count, PetscDataType type)
277 {
278   size_t typesize, m = (size_t)num, n = 0, maxblock = 65536;
279   char  *p = (char *)data;
280 #if defined(PETSC_USE_REAL___FLOAT128)
281   PetscBool readdouble = PETSC_FALSE;
282   double   *pdouble;
283 #endif
284   void *ptmp  = data;
285   char *fname = NULL;
286 
287   PetscFunctionBegin;
288   if (count) *count = 0;
289   PetscCheck(num >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Trying to read a negative amount of data %" PetscInt_FMT, num);
290   if (!num) PetscFunctionReturn(PETSC_SUCCESS);
291 
292   if (type == PETSC_FUNCTION) {
293     m     = 64;
294     type  = PETSC_CHAR;
295     fname = (char *)malloc(m * sizeof(char));
296     p     = (char *)fname;
297     ptmp  = (void *)fname;
298     PetscCheck(fname, PETSC_COMM_SELF, PETSC_ERR_MEM, "Cannot allocate space for function name");
299   }
300   if (type == PETSC_BIT_LOGICAL) m = PetscBTLength(m);
301 
302   PetscCall(PetscDataTypeGetSize(type, &typesize));
303 
304 #if defined(PETSC_USE_REAL___FLOAT128)
305   PetscCall(PetscOptionsGetBool(NULL, NULL, "-binary_read_double", &readdouble, NULL));
306   /* If using __float128 precision we still read in doubles from file */
307   if ((type == PETSC_REAL || type == PETSC_COMPLEX) && readdouble) {
308     PetscInt cnt = num * ((type == PETSC_REAL) ? 1 : 2);
309     PetscCall(PetscMalloc1(cnt, &pdouble));
310     p = (char *)pdouble;
311     typesize /= 2;
312   }
313 #endif
314 
315   m *= typesize;
316 
317   while (m) {
318     size_t len = (m < maxblock) ? m : maxblock;
319     int    ret = (int)read(fd, p, len);
320     if (ret < 0 && errno == EINTR) continue;
321     if (!ret && len > 0) break; /* Proxy for EOF */
322     PetscCheck(ret >= 0, PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Error reading from file due to \"%s\"", strerror(errno));
323     m -= (size_t)ret;
324     p += ret;
325     n += (size_t)ret;
326   }
327   PetscCheck(!m || count, PETSC_COMM_SELF, PETSC_ERR_FILE_READ, "Read past end of file");
328 
329   num = (PetscInt)(n / typesize); /* Should we require `n % typesize == 0` ? */
330   if (count) *count = num;        /* TODO: This is most likely wrong for PETSC_BIT_LOGICAL */
331 
332 #if defined(PETSC_USE_REAL___FLOAT128)
333   if ((type == PETSC_REAL || type == PETSC_COMPLEX) && readdouble) {
334     PetscInt   i, cnt = num * ((type == PETSC_REAL) ? 1 : 2);
335     PetscReal *preal = (PetscReal *)data;
336     if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwapDouble(pdouble, cnt));
337     for (i = 0; i < cnt; i++) preal[i] = pdouble[i];
338     PetscCall(PetscFree(pdouble));
339     PetscFunctionReturn(PETSC_SUCCESS);
340   }
341 #endif
342 
343   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(ptmp, type, num));
344 
345   if (type == PETSC_FUNCTION) {
346 #if defined(PETSC_SERIALIZE_FUNCTIONS)
347     PetscCall(PetscDLSym(NULL, fname, (void **)data));
348 #else
349     *(void **)data = NULL;
350 #endif
351     free(fname);
352   }
353   PetscFunctionReturn(PETSC_SUCCESS);
354 }
355 
356 /*@C
357   PetscBinaryWrite - Writes to a binary file.
358 
359   Not Collective
360 
361   Input Parameters:
362 + fd   - the file
363 . p    - the buffer, an array of the type that matches the value in `type`
364 . n    - the number of items to write
365 - type - the type of items to read (`PETSC_INT`, `PETSC_REAL` or `PETSC_SCALAR`)
366 
367   Level: advanced
368 
369   Notes:
370   `PetscBinaryWrite()` uses byte swapping to work on all machines; the files
371   are written using big-endian ordering to the file. On little-endian machines the numbers
372   are converted to the big-endian format when they are written to disk.
373   When PETSc is configured using `./configure with --with-64-bit-indices` the integers are written to the
374   file as 64-bit integers, this means they can only be read back in when the option `--with-64-bit-indices`
375   is used.
376 
377   If running with `__float128` precision the output of `PETSC_REAL` is in `__float128` unless one uses the `-binary_write_double` option
378 
379   The buffer `p` should be read-write buffer, and not static data.
380   This way, byte-swapping is done in-place, and then the buffer is
381   written to the file.
382 
383   This routine restores the original contents of the buffer, after
384   it is written to the file. This is done by byte-swapping in-place
385   the second time.
386 
387   Because byte-swapping may be done on the values in data it cannot be declared const
388 
389 .seealso: `PetscBinaryRead()`, `PetscBinaryOpen()`, `PetscBinaryClose()`, `PetscViewerBinaryGetDescriptor()`, `PetscBinarySynchronizedWrite()`,
390           `PetscBinarySynchronizedRead()`, `PetscBinarySynchronizedSeek()`
391 @*/
392 PetscErrorCode PetscBinaryWrite(int fd, const void *p, PetscInt n, PetscDataType type)
393 {
394   const char *pp = (char *)p;
395   int         err, wsize;
396   size_t      m = (size_t)n, maxblock = 65536;
397   const void *ptmp  = p;
398   char       *fname = NULL;
399 #if defined(PETSC_USE_REAL___FLOAT128)
400   PetscBool  writedouble = PETSC_FALSE;
401   double    *ppp;
402   PetscReal *pv;
403   PetscInt   i;
404 #endif
405   PetscDataType wtype = type;
406 
407   PetscFunctionBegin;
408   PetscCheck(n >= 0, PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Trying to write a negative amount of data %" PetscInt_FMT, n);
409   if (!n) PetscFunctionReturn(PETSC_SUCCESS);
410 
411   if (type == PETSC_FUNCTION) {
412 #if defined(PETSC_SERIALIZE_FUNCTIONS)
413     const char *fnametmp;
414 #endif
415     m     = 64;
416     fname = (char *)malloc(m * sizeof(char));
417     PetscCheck(fname, PETSC_COMM_SELF, PETSC_ERR_MEM, "Cannot allocate space for function name");
418 #if defined(PETSC_SERIALIZE_FUNCTIONS)
419     PetscCheck(n <= 1, PETSC_COMM_SELF, PETSC_ERR_SUP, "Can only binary view a single function at a time");
420     PetscCall(PetscFPTFind(*(void **)p, &fnametmp));
421     PetscCall(PetscStrncpy(fname, fnametmp, m));
422 #else
423     PetscCall(PetscStrncpy(fname, "", m));
424 #endif
425     wtype = PETSC_CHAR;
426     pp    = (char *)fname;
427     ptmp  = (void *)fname;
428   }
429 
430 #if defined(PETSC_USE_REAL___FLOAT128)
431   PetscCall(PetscOptionsGetBool(NULL, NULL, "-binary_write_double", &writedouble, NULL));
432   /* If using __float128 precision we still write in doubles to file */
433   if ((type == PETSC_SCALAR || type == PETSC_REAL || type == PETSC_COMPLEX) && writedouble) {
434     wtype = PETSC_DOUBLE;
435     PetscCall(PetscMalloc1(n, &ppp));
436     pv = (PetscReal *)pp;
437     for (i = 0; i < n; i++) ppp[i] = (double)pv[i];
438     pp   = (char *)ppp;
439     ptmp = (char *)ppp;
440   }
441 #endif
442 
443   if (wtype == PETSC_INT) m *= sizeof(PetscInt);
444   else if (wtype == PETSC_SCALAR) m *= sizeof(PetscScalar);
445 #if defined(PETSC_HAVE_COMPLEX)
446   else if (wtype == PETSC_COMPLEX) m *= sizeof(PetscComplex);
447 #endif
448   else if (wtype == PETSC_REAL) m *= sizeof(PetscReal);
449   else if (wtype == PETSC_DOUBLE) m *= sizeof(double);
450   else if (wtype == PETSC_FLOAT) m *= sizeof(float);
451   else if (wtype == PETSC_SHORT) m *= sizeof(short);
452   else if (wtype == PETSC_LONG) m *= sizeof(long);
453   else if (wtype == PETSC_CHAR) m *= sizeof(char);
454   else if (wtype == PETSC_ENUM) m *= sizeof(PetscEnum);
455   else if (wtype == PETSC_BOOL) m *= sizeof(PetscBool);
456   else if (wtype == PETSC_INT64) m *= sizeof(PetscInt64);
457   else if (wtype == PETSC_INT32) m *= sizeof(PetscInt32);
458   else if (wtype == PETSC_BIT_LOGICAL) m = PetscBTLength(m) * sizeof(char);
459   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown type: %d", wtype);
460 
461   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap((void *)ptmp, wtype, n));
462 
463   while (m) {
464     wsize = (m < maxblock) ? m : maxblock;
465     err   = write(fd, pp, wsize);
466     if (err < 0 && errno == EINTR) continue;
467     PetscCheck(err == wsize, PETSC_COMM_SELF, PETSC_ERR_FILE_WRITE, "Error writing to file total size %d err %d wsize %d due to \"%s\"", (int)n, (int)err, (int)wsize, strerror(errno));
468     m -= wsize;
469     pp += wsize;
470   }
471 
472   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap((void *)ptmp, wtype, n));
473 
474   if (type == PETSC_FUNCTION) free(fname);
475 #if defined(PETSC_USE_REAL___FLOAT128)
476   if ((type == PETSC_SCALAR || type == PETSC_REAL || type == PETSC_COMPLEX) && writedouble) PetscCall(PetscFree(ppp));
477 #endif
478   PetscFunctionReturn(PETSC_SUCCESS);
479 }
480 
481 /*@C
482   PetscBinaryOpen - Opens a PETSc binary file.
483 
484   Not Collective
485 
486   Input Parameters:
487 + name - filename
488 - mode - open mode of binary file, one of `FILE_MODE_READ`, `FILE_MODE_WRITE`, `FILE_MODE_APPEND`
489 
490   Output Parameter:
491 . fd - the file
492 
493   Level: advanced
494 
495 .seealso: `PetscBinaryRead()`, `PetscBinaryWrite()`, `PetscFileMode`, `PetscViewerFileSetMode()`, `PetscViewerBinaryGetDescriptor()`,
496           `PetscBinarySynchronizedWrite()`, `PetscBinarySynchronizedRead()`, `PetscBinarySynchronizedSeek()`
497 @*/
498 PetscErrorCode PetscBinaryOpen(const char name[], PetscFileMode mode, int *fd)
499 {
500   PetscFunctionBegin;
501   switch (mode) {
502   case FILE_MODE_READ:
503     *fd = open(name, O_BINARY | O_RDONLY, 0);
504     break;
505   case FILE_MODE_WRITE:
506     *fd = open(name, O_BINARY | O_WRONLY | O_CREAT | O_TRUNC, 0666);
507     break;
508   case FILE_MODE_APPEND:
509     *fd = open(name, O_BINARY | O_WRONLY | O_APPEND, 0);
510     break;
511   default:
512     SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP, "Unsupported file mode %s", PetscFileModes[mode]);
513   }
514   PetscCheck(*fd != -1, PETSC_COMM_SELF, PETSC_ERR_FILE_OPEN, "Cannot open file %s for %s due to \"%s\"", name, PetscFileModes[mode], strerror(errno));
515   PetscFunctionReturn(PETSC_SUCCESS);
516 }
517 
518 /*@
519   PetscBinaryClose - Closes a PETSc binary file.
520 
521   Not Collective
522 
523   Output Parameter:
524 . fd - the file
525 
526   Level: advanced
527 
528 .seealso: `PetscBinaryRead()`, `PetscBinaryWrite()`, `PetscBinaryOpen()`, `PetscBinarySynchronizedWrite()`, `PetscBinarySynchronizedRead()`,
529           `PetscBinarySynchronizedSeek()`
530 @*/
531 PetscErrorCode PetscBinaryClose(int fd)
532 {
533   PetscFunctionBegin;
534   PetscCheck(!close(fd), PETSC_COMM_SELF, PETSC_ERR_SYS, "close() failed on file descriptor");
535   PetscFunctionReturn(PETSC_SUCCESS);
536 }
537 
538 /*@C
539   PetscBinarySeek - Moves the file pointer on a PETSc binary file.
540 
541   Not Collective
542 
543   Input Parameters:
544 + fd     - the file
545 . off    - number of bytes to move. Use `PETSC_BINARY_INT_SIZE`, `PETSC_BINARY_SCALAR_SIZE`,
546             etc. in your calculation rather than `sizeof()` to compute byte lengths.
547 - whence - see `PetscBinarySeekType` for possible values
548 
549   Output Parameter:
550 . offset - new offset in file
551 
552   Level: developer
553 
554 .seealso: `PetscBinaryRead()`, `PetscBinarySeekType`, `PetscBinaryWrite()`, `PetscBinaryOpen()`, `PetscBinarySynchronizedWrite()`, `PetscBinarySynchronizedRead()`,
555           `PetscBinarySynchronizedSeek()`
556 @*/
557 PetscErrorCode PetscBinarySeek(int fd, off_t off, PetscBinarySeekType whence, off_t *offset)
558 {
559   int iwhence = 0;
560 
561   PetscFunctionBegin;
562   if (whence == PETSC_BINARY_SEEK_SET) iwhence = SEEK_SET;
563   else if (whence == PETSC_BINARY_SEEK_CUR) iwhence = SEEK_CUR;
564   else if (whence == PETSC_BINARY_SEEK_END) iwhence = SEEK_END;
565   else SETERRQ(PETSC_COMM_SELF, PETSC_ERR_ARG_OUTOFRANGE, "Unknown seek location");
566 #if defined(PETSC_HAVE_LSEEK)
567   *offset = lseek(fd, off, iwhence);
568 #elif defined(PETSC_HAVE__LSEEK)
569   *offset = _lseek(fd, (long)off, iwhence);
570 #else
571   SETERRQ(PETSC_COMM_SELF, PETSC_ERR_SUP_SYS, "System does not have a way of seeking on a file");
572 #endif
573   PetscFunctionReturn(PETSC_SUCCESS);
574 }
575 
576 /*@C
577   PetscBinarySynchronizedRead - Reads from a binary file, all MPI processes get the same values
578 
579   Collective
580 
581   Input Parameters:
582 + comm - the MPI communicator
583 . fd   - the file descriptor
584 . num  - the maximum number of items to read
585 - type - the type of items to read (`PETSC_INT`, `PETSC_REAL`, `PETSC_SCALAR`, etc.)
586 
587   Output Parameters:
588 + data  - the buffer, an array of the type that matches the value in `type`
589 - count - the number of items read, optional
590 
591   Level: developer
592 
593   Notes:
594   Does a `PetscBinaryRead()` followed by an `MPI_Bcast()`
595 
596   If `count` is not provided and the number of items read is less than
597   the maximum number of items to read, then this routine errors.
598 
599   `PetscBinarySynchronizedRead()` uses byte swapping to work on all machines.
600   The files  are written using big-endian ordering to the file. On little-endian machines the numbers
601   are converted to the big-endian format when they are written to disk.
602   When PETSc is configured using `./configure with --with-64-bit-indices` the integers are written to the
603   file as 64-bit integers, this means they can only be read back in when the option `--with-64-bit-indices`
604   is used.
605 
606 .seealso: `PetscBinaryWrite()`, `PetscBinaryOpen()`, `PetscBinaryClose()`, `PetscBinaryRead()`, `PetscBinarySynchronizedWrite()`,
607           `PetscBinarySynchronizedSeek()`
608 @*/
609 PetscErrorCode PetscBinarySynchronizedRead(MPI_Comm comm, int fd, void *data, PetscInt num, PetscInt *count, PetscDataType type)
610 {
611   PetscMPIInt  rank, size;
612   MPI_Datatype mtype;
613   PetscInt     ibuf[2] = {0, 0};
614   char        *fname   = NULL;
615   void        *fptr    = NULL;
616 
617   PetscFunctionBegin;
618   if (type == PETSC_FUNCTION) {
619     num   = 64;
620     type  = PETSC_CHAR;
621     fname = (char *)malloc(num * sizeof(char));
622     fptr  = data;
623     data  = (void *)fname;
624     PetscCheck(fname, PETSC_COMM_SELF, PETSC_ERR_MEM, "Cannot allocate space for function name");
625   }
626 
627   PetscCallMPI(MPI_Comm_rank(comm, &rank));
628   PetscCallMPI(MPI_Comm_size(comm, &size));
629   if (rank == 0) ibuf[0] = PetscBinaryRead(fd, data, num, count ? &ibuf[1] : NULL, type);
630   PetscCallMPI(MPI_Bcast(ibuf, 2, MPIU_INT, 0, comm));
631   PetscCall((PetscErrorCode)ibuf[0]);
632 
633   /* skip MPI call on potentially huge amounts of data when running with one process; this allows the amount of data to basically unlimited in that case */
634   if (size > 1) {
635     PetscCall(PetscDataTypeToMPIDataType(type, &mtype));
636     PetscCallMPI(MPI_Bcast(data, count ? ibuf[1] : num, mtype, 0, comm));
637   }
638   if (count) *count = ibuf[1];
639 
640   if (type == PETSC_FUNCTION) {
641 #if defined(PETSC_SERIALIZE_FUNCTIONS)
642     PetscCall(PetscDLLibrarySym(PETSC_COMM_SELF, &PetscDLLibrariesLoaded, NULL, fname, (void **)fptr));
643 #else
644     *(void **)fptr = NULL;
645 #endif
646     free(fname);
647   }
648   PetscFunctionReturn(PETSC_SUCCESS);
649 }
650 
651 /*@C
652   PetscBinarySynchronizedWrite - writes to a binary file.
653 
654   Collective
655 
656   Input Parameters:
657 + comm - the MPI communicator
658 . fd   - the file
659 . n    - the number of items to write
660 . p    - the buffer, an array of the type that matches the value in `type`
661 - type - the type of items to write (`PETSC_INT`, `PETSC_REAL` or `PETSC_SCALAR`)
662 
663   Level: developer
664 
665   Notes:
666   MPI rank 0 does a `PetscBinaryWrite()` the values on other MPI processes are not used
667 
668   The files  are written using big-endian ordering to the file. On little-endian machines the numbers
669   are converted to the big-endian format when they are written to disk.
670   When PETSc is configured using `./configure with --with-64-bit-indices` the integers are written to the
671   file as 64-bit integers, this means they can only be read back in when the option `--with-64-bit-indices`
672   is used.
673 
674   Because byte-swapping may be done on the values in data it cannot be declared const
675 
676   This is NOT like `PetscSynchronizedFPrintf()`! This routine ignores calls on all but MPI rank 0,
677   while `PetscSynchronizedFPrintf()` has all MPI processes print their strings in order.
678 
679 .seealso: `PetscBinaryWrite()`, `PetscBinaryOpen()`, `PetscBinaryClose()`, `PetscBinaryRead()`, `PetscBinarySynchronizedRead()`,
680           `PetscBinarySynchronizedSeek()`
681 @*/
682 PetscErrorCode PetscBinarySynchronizedWrite(MPI_Comm comm, int fd, const void *p, PetscInt n, PetscDataType type)
683 {
684   PetscMPIInt rank;
685 
686   PetscFunctionBegin;
687   PetscCallMPI(MPI_Comm_rank(comm, &rank));
688   if (rank == 0) PetscCall(PetscBinaryWrite(fd, p, n, type));
689   PetscFunctionReturn(PETSC_SUCCESS);
690 }
691 
692 /*@C
693   PetscBinarySynchronizedSeek - Moves the file pointer on a PETSc binary file.
694 
695   Input Parameters:
696 + comm   - the communicator to read with
697 . fd     - the file
698 . whence - see `PetscBinarySeekType` for possible values
699 - off    - number of bytes to move. Use `PETSC_BINARY_INT_SIZE`, `PETSC_BINARY_SCALAR_SIZE`,
700             etc. in your calculation rather than `sizeof()` to compute byte lengths.
701 
702   Output Parameter:
703 . offset - new offset in file
704 
705   Level: developer
706 
707 .seealso: `PetscBinaryRead()`, `PetscBinarySeekType`, `PetscBinaryWrite()`, `PetscBinaryOpen()`, `PetscBinarySynchronizedWrite()`, `PetscBinarySynchronizedRead()`,
708 
709 @*/
710 PetscErrorCode PetscBinarySynchronizedSeek(MPI_Comm comm, int fd, off_t off, PetscBinarySeekType whence, off_t *offset)
711 {
712   PetscMPIInt rank;
713 
714   PetscFunctionBegin;
715   PetscCallMPI(MPI_Comm_rank(comm, &rank));
716   if (rank == 0) PetscCall(PetscBinarySeek(fd, off, whence, offset));
717   PetscFunctionReturn(PETSC_SUCCESS);
718 }
719 
720 #if defined(PETSC_HAVE_MPIIO)
721 
722   #if defined(PETSC_USE_PETSC_MPI_EXTERNAL32)
723 /*
724       MPICH does not provide the external32 representation for MPI_File_set_view() so we need to provide the functions.
725     These are set into MPI in PetscInitialize() via MPI_Register_datarep()
726 
727     Note I use PetscMPIInt for the MPI error codes since that is what MPI uses (instead of the standard PetscErrorCode)
728 
729     The next three routines are not used because MPICH does not support their use
730 
731 */
732 PETSC_EXTERN PetscMPIInt PetscDataRep_extent_fn(MPI_Datatype datatype, MPI_Aint *file_extent, void *extra_state)
733 {
734   MPI_Aint    ub;
735   PetscMPIInt ierr;
736 
737   ierr = MPI_Type_get_extent(datatype, &ub, file_extent);
738   return ierr;
739 }
740 
741 PETSC_EXTERN PetscMPIInt PetscDataRep_read_conv_fn(void *userbuf, MPI_Datatype datatype, PetscMPIInt count, void *filebuf, MPI_Offset position, void *extra_state)
742 {
743   PetscDataType pdtype;
744   PetscMPIInt   ierr;
745   size_t        dsize;
746 
747   PetscCall(PetscMPIDataTypeToPetscDataType(datatype, &pdtype));
748   PetscCall(PetscDataTypeGetSize(pdtype, &dsize));
749 
750   /* offset is given in units of MPI_Datatype */
751   userbuf = ((char *)userbuf) + dsize * position;
752 
753   PetscCall(PetscMemcpy(userbuf, filebuf, count * dsize));
754   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(userbuf, pdtype, count));
755   return ierr;
756 }
757 
758 PetscMPIInt PetscDataRep_write_conv_fn(void *userbuf, MPI_Datatype datatype, PetscMPIInt count, void *filebuf, MPI_Offset position, void *extra_state)
759 {
760   PetscDataType pdtype;
761   PetscMPIInt   ierr;
762   size_t        dsize;
763 
764   PetscCall(PetscMPIDataTypeToPetscDataType(datatype, &pdtype));
765   PetscCall(PetscDataTypeGetSize(pdtype, &dsize));
766 
767   /* offset is given in units of MPI_Datatype */
768   userbuf = ((char *)userbuf) + dsize * position;
769 
770   PetscCall(PetscMemcpy(filebuf, userbuf, count * dsize));
771   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(filebuf, pdtype, count));
772   return ierr;
773 }
774   #endif
775 
776 PetscErrorCode MPIU_File_write_all(MPI_File fd, void *data, PetscMPIInt cnt, MPI_Datatype dtype, MPI_Status *status)
777 {
778   PetscDataType pdtype;
779 
780   PetscFunctionBegin;
781   PetscCall(PetscMPIDataTypeToPetscDataType(dtype, &pdtype));
782   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
783   PetscCallMPI(MPI_File_write_all(fd, data, cnt, dtype, status));
784   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
785   PetscFunctionReturn(PETSC_SUCCESS);
786 }
787 
788 PetscErrorCode MPIU_File_read_all(MPI_File fd, void *data, PetscMPIInt cnt, MPI_Datatype dtype, MPI_Status *status)
789 {
790   PetscDataType pdtype;
791 
792   PetscFunctionBegin;
793   PetscCall(PetscMPIDataTypeToPetscDataType(dtype, &pdtype));
794   PetscCallMPI(MPI_File_read_all(fd, data, cnt, dtype, status));
795   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
796   PetscFunctionReturn(PETSC_SUCCESS);
797 }
798 
799 PetscErrorCode MPIU_File_write_at(MPI_File fd, MPI_Offset off, void *data, PetscMPIInt cnt, MPI_Datatype dtype, MPI_Status *status)
800 {
801   PetscDataType pdtype;
802 
803   PetscFunctionBegin;
804   PetscCall(PetscMPIDataTypeToPetscDataType(dtype, &pdtype));
805   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
806   PetscCallMPI(MPI_File_write_at(fd, off, data, cnt, dtype, status));
807   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
808   PetscFunctionReturn(PETSC_SUCCESS);
809 }
810 
811 PetscErrorCode MPIU_File_read_at(MPI_File fd, MPI_Offset off, void *data, PetscMPIInt cnt, MPI_Datatype dtype, MPI_Status *status)
812 {
813   PetscDataType pdtype;
814 
815   PetscFunctionBegin;
816   PetscCall(PetscMPIDataTypeToPetscDataType(dtype, &pdtype));
817   PetscCallMPI(MPI_File_read_at(fd, off, data, cnt, dtype, status));
818   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
819   PetscFunctionReturn(PETSC_SUCCESS);
820 }
821 
822 PetscErrorCode MPIU_File_write_at_all(MPI_File fd, MPI_Offset off, void *data, PetscMPIInt cnt, MPI_Datatype dtype, MPI_Status *status)
823 {
824   PetscDataType pdtype;
825 
826   PetscFunctionBegin;
827   PetscCall(PetscMPIDataTypeToPetscDataType(dtype, &pdtype));
828   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
829   PetscCallMPI(MPI_File_write_at_all(fd, off, data, cnt, dtype, status));
830   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
831   PetscFunctionReturn(PETSC_SUCCESS);
832 }
833 
834 PetscErrorCode MPIU_File_read_at_all(MPI_File fd, MPI_Offset off, void *data, PetscMPIInt cnt, MPI_Datatype dtype, MPI_Status *status)
835 {
836   PetscDataType pdtype;
837 
838   PetscFunctionBegin;
839   PetscCall(PetscMPIDataTypeToPetscDataType(dtype, &pdtype));
840   PetscCallMPI(MPI_File_read_at_all(fd, off, data, cnt, dtype, status));
841   if (!PetscBinaryBigEndian()) PetscCall(PetscByteSwap(data, pdtype, cnt));
842   PetscFunctionReturn(PETSC_SUCCESS);
843 }
844 
845 #endif
846