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