1 /*
2 Code that allows a user to dictate what malloc() PETSc uses.
3 */
4 #include <petscsys.h> /*I "petscsys.h" I*/
5 #include <stdarg.h>
6 #if defined(PETSC_HAVE_MALLOC_H)
7 #include <malloc.h>
8 #endif
9 #if defined(PETSC_HAVE_MEMKIND)
10 #include <errno.h>
11 #include <memkind.h>
12 typedef enum {PETSC_MK_DEFAULT=0,PETSC_MK_HBW_PREFERRED=1} PetscMemkindType;
13 PetscMemkindType currentmktype = PETSC_MK_HBW_PREFERRED;
14 PetscMemkindType previousmktype = PETSC_MK_HBW_PREFERRED;
15 #endif
16 /*
17 We want to make sure that all mallocs of double or complex numbers are complex aligned.
18 1) on systems with memalign() we call that routine to get an aligned memory location
19 2) on systems without memalign() we
20 - allocate one sizeof(PetscScalar) extra space
21 - we shift the pointer up slightly if needed to get PetscScalar aligned
22 - if shifted we store at ptr[-1] the amount of shift (plus a classid)
23 */
24 #define SHIFT_CLASSID 456123
25
PetscMallocAlign(size_t mem,PetscBool clear,int line,const char func[],const char file[],void ** result)26 PETSC_EXTERN PetscErrorCode PetscMallocAlign(size_t mem,PetscBool clear,int line,const char func[],const char file[],void **result)
27 {
28 PetscErrorCode ierr;
29 #if defined(PETSC_HAVE_MEMKIND)
30 int err;
31 #endif
32
33 if (!mem) {*result = NULL; return 0;}
34 #if defined(PETSC_HAVE_MEMKIND)
35 {
36 if (!currentmktype) err = memkind_posix_memalign(MEMKIND_DEFAULT,result,PETSC_MEMALIGN,mem);
37 else err = memkind_posix_memalign(MEMKIND_HBW_PREFERRED,result,PETSC_MEMALIGN,mem);
38 if (err == EINVAL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Memkind: invalid 3rd or 4th argument of memkind_posix_memalign()");
39 if (err == ENOMEM) PetscInfo1(0,"Memkind: fail to request HBW memory %.0f, falling back to normal memory\n",(PetscLogDouble)mem);
40 if (clear) {ierr = PetscMemzero(*result,mem);CHKERRQ(ierr);}
41 }
42 #else
43 # if defined(PETSC_HAVE_DOUBLE_ALIGN_MALLOC) && (PETSC_MEMALIGN == 8)
44 if (clear) {
45 *result = calloc(1+mem/sizeof(int),sizeof(int));
46 } else {
47 *result = malloc(mem);
48 }
49 if (PetscLogMemory) {ierr = PetscMemzero(*result,mem);CHKERRQ(ierr);}
50
51 # elif defined(PETSC_HAVE_MEMALIGN)
52 *result = memalign(PETSC_MEMALIGN,mem);
53 if (clear || PetscLogMemory) {
54 ierr = PetscMemzero(*result,mem);CHKERRQ(ierr);
55 }
56 # else
57 {
58 int *ptr;
59 /*
60 malloc space for two extra chunks and shift ptr 1 + enough to get it PetscScalar aligned
61 */
62 if (clear) {
63 ptr = (int*)calloc(1+(mem + 2*PETSC_MEMALIGN)/sizeof(int),sizeof(int));
64 } else {
65 ptr = (int*)malloc(mem + 2*PETSC_MEMALIGN);
66 }
67 if (ptr) {
68 int shift = (int)(((PETSC_UINTPTR_T) ptr) % PETSC_MEMALIGN);
69 shift = (2*PETSC_MEMALIGN - shift)/sizeof(int);
70 ptr[shift-1] = shift + SHIFT_CLASSID;
71 ptr += shift;
72 *result = (void*)ptr;
73 if (PetscLogMemory) {ierr = PetscMemzero(*result,mem);CHKERRQ(ierr);}
74 } else {
75 *result = NULL;
76 }
77 }
78 # endif
79 #endif
80
81 if (!*result) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_MEM,PETSC_ERROR_INITIAL,"Memory requested %.0f",(PetscLogDouble)mem);
82 return 0;
83 }
84
PetscFreeAlign(void * ptr,int line,const char func[],const char file[])85 PETSC_EXTERN PetscErrorCode PetscFreeAlign(void *ptr,int line,const char func[],const char file[])
86 {
87 if (!ptr) return 0;
88 #if defined(PETSC_HAVE_MEMKIND)
89 memkind_free(0,ptr); /* specify the kind to 0 so that memkind will look up for the right type */
90 #else
91 # if (!(defined(PETSC_HAVE_DOUBLE_ALIGN_MALLOC) && (PETSC_MEMALIGN == 8)) && !defined(PETSC_HAVE_MEMALIGN))
92 {
93 /*
94 Previous int tells us how many ints the pointer has been shifted from
95 the original address provided by the system malloc().
96 */
97 int shift = *(((int*)ptr)-1) - SHIFT_CLASSID;
98 if (shift > PETSC_MEMALIGN-1) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"Likely memory corruption in heap");
99 if (shift < 0) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"Likely memory corruption in heap");
100 ptr = (void*)(((int*)ptr) - shift);
101 }
102 # endif
103
104 # if defined(PETSC_HAVE_FREE_RETURN_INT)
105 int err = free(ptr);
106 if (err) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"System free returned error %d\n",err);
107 # else
108 free(ptr);
109 # endif
110 #endif
111 return 0;
112 }
113
PetscReallocAlign(size_t mem,int line,const char func[],const char file[],void ** result)114 PETSC_EXTERN PetscErrorCode PetscReallocAlign(size_t mem, int line, const char func[], const char file[], void **result)
115 {
116 PetscErrorCode ierr;
117
118 if (!mem) {
119 ierr = PetscFreeAlign(*result, line, func, file);
120 if (ierr) return ierr;
121 *result = NULL;
122 return 0;
123 }
124 #if defined(PETSC_HAVE_MEMKIND)
125 if (!currentmktype) *result = memkind_realloc(MEMKIND_DEFAULT,*result,mem);
126 else *result = memkind_realloc(MEMKIND_HBW_PREFERRED,*result,mem);
127 #else
128 # if (!(defined(PETSC_HAVE_DOUBLE_ALIGN_MALLOC) && (PETSC_MEMALIGN == 8)) && !defined(PETSC_HAVE_MEMALIGN))
129 {
130 /*
131 Previous int tells us how many ints the pointer has been shifted from
132 the original address provided by the system malloc().
133 */
134 int shift = *(((int*)*result)-1) - SHIFT_CLASSID;
135 if (shift > PETSC_MEMALIGN-1) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"Likely memory corruption in heap");
136 if (shift < 0) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"Likely memory corruption in heap");
137 *result = (void*)(((int*)*result) - shift);
138 }
139 # endif
140
141 # if (defined(PETSC_HAVE_DOUBLE_ALIGN_MALLOC) && (PETSC_MEMALIGN == 8)) || defined(PETSC_HAVE_MEMALIGN)
142 *result = realloc(*result, mem);
143 # else
144 {
145 /*
146 malloc space for two extra chunks and shift ptr 1 + enough to get it PetscScalar aligned
147 */
148 int *ptr = (int *) realloc(*result, mem + 2*PETSC_MEMALIGN);
149 if (ptr) {
150 int shift = (int)(((PETSC_UINTPTR_T) ptr) % PETSC_MEMALIGN);
151 shift = (2*PETSC_MEMALIGN - shift)/sizeof(int);
152 ptr[shift-1] = shift + SHIFT_CLASSID;
153 ptr += shift;
154 *result = (void*)ptr;
155 } else {
156 *result = NULL;
157 }
158 }
159 # endif
160 #endif
161 if (!*result) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_MEM,PETSC_ERROR_INITIAL,"Memory requested %.0f",(PetscLogDouble)mem);
162 #if defined(PETSC_HAVE_MEMALIGN)
163 /* There are no standard guarantees that realloc() maintains the alignment of memalign(), so I think we have to
164 * realloc and, if the alignment is wrong, malloc/copy/free. */
165 if (((size_t) (*result)) % PETSC_MEMALIGN) {
166 void *newResult;
167 # if defined(PETSC_HAVE_MEMKIND)
168 {
169 int err;
170 if (!currentmktype) err = memkind_posix_memalign(MEMKIND_DEFAULT,&newResult,PETSC_MEMALIGN,mem);
171 else err = memkind_posix_memalign(MEMKIND_HBW_PREFERRED,&newResult,PETSC_MEMALIGN,mem);
172 if (err == EINVAL) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_MEM,"Memkind: invalid 3rd or 4th argument of memkind_posix_memalign()");
173 if (err == ENOMEM) PetscInfo1(0,"Memkind: fail to request HBW memory %.0f, falling back to normal memory\n",(PetscLogDouble)mem);
174 }
175 # else
176 newResult = memalign(PETSC_MEMALIGN,mem);
177 # endif
178 if (!newResult) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_MEM,PETSC_ERROR_INITIAL,"Memory requested %.0f",(PetscLogDouble)mem);
179 ierr = PetscMemcpy(newResult,*result,mem);
180 if (ierr) return ierr;
181 # if defined(PETSC_HAVE_FREE_RETURN_INT)
182 {
183 int err = free(*result);
184 if (err) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"System free returned error %d\n",err);
185 }
186 # else
187 # if defined(PETSC_HAVE_MEMKIND)
188 memkind_free(0,*result);
189 # else
190 free(*result);
191 # endif
192 # endif
193 *result = newResult;
194 }
195 #endif
196 return 0;
197 }
198
199 PetscErrorCode (*PetscTrMalloc)(size_t,PetscBool,int,const char[],const char[],void**) = PetscMallocAlign;
200 PetscErrorCode (*PetscTrFree)(void*,int,const char[],const char[]) = PetscFreeAlign;
201 PetscErrorCode (*PetscTrRealloc)(size_t,int,const char[],const char[],void**) = PetscReallocAlign;
202
203 PETSC_INTERN PetscBool petscsetmallocvisited;
204 PetscBool petscsetmallocvisited = PETSC_FALSE;
205
206 /*@C
207 PetscMallocSet - Sets the routines used to do mallocs and frees.
208 This routine MUST be called before PetscInitialize() and may be
209 called only once.
210
211 Not Collective
212
213 Input Parameters:
214 + imalloc - the routine that provides the malloc (also provides calloc(), which is used depends on the second argument)
215 . ifree - the routine that provides the free
216 - iralloc - the routine that provides the realloc
217
218 Level: developer
219
220 @*/
PetscMallocSet(PetscErrorCode (* imalloc)(size_t,PetscBool,int,const char[],const char[],void **),PetscErrorCode (* ifree)(void *,int,const char[],const char[]),PetscErrorCode (* iralloc)(size_t,int,const char[],const char[],void **))221 PetscErrorCode PetscMallocSet(PetscErrorCode (*imalloc)(size_t,PetscBool,int,const char[],const char[],void**),
222 PetscErrorCode (*ifree)(void*,int,const char[],const char[]),
223 PetscErrorCode (*iralloc)(size_t, int, const char[], const char[], void **))
224 {
225 PetscFunctionBegin;
226 if (petscsetmallocvisited && (imalloc != PetscTrMalloc || ifree != PetscTrFree)) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"cannot call multiple times");
227 PetscTrMalloc = imalloc;
228 PetscTrFree = ifree;
229 PetscTrRealloc = iralloc;
230 petscsetmallocvisited = PETSC_TRUE;
231 PetscFunctionReturn(0);
232 }
233
234 /*@C
235 PetscMallocClear - Resets the routines used to do mallocs and frees to the defaults.
236
237 Not Collective
238
239 Level: developer
240
241 Notes:
242 In general one should never run a PETSc program with different malloc() and
243 free() settings for different parts; this is because one NEVER wants to
244 free() an address that was malloced by a different memory management system
245
246 Called in PetscFinalize() so that if PetscInitialize() is called again it starts with a fresh slate of allocation information
247
248 @*/
PetscMallocClear(void)249 PetscErrorCode PetscMallocClear(void)
250 {
251 PetscFunctionBegin;
252 PetscTrMalloc = PetscMallocAlign;
253 PetscTrFree = PetscFreeAlign;
254 PetscTrRealloc = PetscReallocAlign;
255 petscsetmallocvisited = PETSC_FALSE;
256 PetscFunctionReturn(0);
257 }
258
PetscMemoryTrace(const char label[])259 PetscErrorCode PetscMemoryTrace(const char label[])
260 {
261 PetscErrorCode ierr;
262 PetscLogDouble mem,mal;
263 static PetscLogDouble oldmem = 0,oldmal = 0;
264
265 PetscFunctionBegin;
266 ierr = PetscMemoryGetCurrentUsage(&mem);CHKERRQ(ierr);
267 ierr = PetscMallocGetCurrentUsage(&mal);CHKERRQ(ierr);
268
269 ierr = PetscPrintf(PETSC_COMM_WORLD,"%s High water %8.3f MB increase %8.3f MB Current %8.3f MB increase %8.3f MB\n",label,mem*1e-6,(mem - oldmem)*1e-6,mal*1e-6,(mal - oldmal)*1e-6);CHKERRQ(ierr);
270 oldmem = mem;
271 oldmal = mal;
272 PetscFunctionReturn(0);
273 }
274
275 static PetscErrorCode (*PetscTrMallocOld)(size_t,PetscBool,int,const char[],const char[],void**) = PetscMallocAlign;
276 static PetscErrorCode (*PetscTrReallocOld)(size_t,int,const char[],const char[],void**) = PetscReallocAlign;
277 static PetscErrorCode (*PetscTrFreeOld)(void*,int,const char[],const char[]) = PetscFreeAlign;
278
279 /*@C
280 PetscMallocSetDRAM - Set PetscMalloc to use DRAM.
281 If memkind is available, change the memkind type. Otherwise, switch the
282 current malloc and free routines to the PetscMallocAlign and
283 PetscFreeAlign (PETSc default).
284
285 Not Collective
286
287 Level: developer
288
289 Notes:
290 This provides a way to do the allocation on DRAM temporarily. One
291 can switch back to the previous choice by calling PetscMallocReset().
292
293 .seealso: PetscMallocReset()
294 @*/
PetscMallocSetDRAM(void)295 PetscErrorCode PetscMallocSetDRAM(void)
296 {
297 PetscFunctionBegin;
298 if (PetscTrMalloc == PetscMallocAlign) {
299 #if defined(PETSC_HAVE_MEMKIND)
300 previousmktype = currentmktype;
301 currentmktype = PETSC_MK_DEFAULT;
302 #endif
303 } else {
304 /* Save the previous choice */
305 PetscTrMallocOld = PetscTrMalloc;
306 PetscTrReallocOld = PetscTrRealloc;
307 PetscTrFreeOld = PetscTrFree;
308 PetscTrMalloc = PetscMallocAlign;
309 PetscTrFree = PetscFreeAlign;
310 PetscTrRealloc = PetscReallocAlign;
311 }
312 PetscFunctionReturn(0);
313 }
314
315 /*@C
316 PetscMallocResetDRAM - Reset the changes made by PetscMallocSetDRAM
317
318 Not Collective
319
320 Level: developer
321
322 .seealso: PetscMallocSetDRAM()
323 @*/
PetscMallocResetDRAM(void)324 PetscErrorCode PetscMallocResetDRAM(void)
325 {
326 PetscFunctionBegin;
327 if (PetscTrMalloc == PetscMallocAlign) {
328 #if defined(PETSC_HAVE_MEMKIND)
329 currentmktype = previousmktype;
330 #endif
331 } else {
332 /* Reset to the previous choice */
333 PetscTrMalloc = PetscTrMallocOld;
334 PetscTrRealloc = PetscTrReallocOld;
335 PetscTrFree = PetscTrFreeOld;
336 }
337 PetscFunctionReturn(0);
338 }
339
340 static PetscBool petscmalloccoalesce =
341 #if defined(PETSC_USE_MALLOC_COALESCED)
342 PETSC_TRUE;
343 #else
344 PETSC_FALSE;
345 #endif
346
347 /*@C
348 PetscMallocSetCoalesce - Use coalesced malloc when allocating groups of objects
349
350 Not Collective
351
352 Input Parameters:
353 . coalesce - PETSC_TRUE to use coalesced malloc for multi-object allocation.
354
355 Options Database Keys:
356 . -malloc_coalesce - turn coalesced malloc on or off
357
358 Note:
359 PETSc uses coalesced malloc by default for optimized builds and not for debugging builds. This default can be changed via the command-line option -malloc_coalesce or by calling this function.
360 This function can only be called immediately after PetscInitialize()
361
362 Level: developer
363
364 .seealso: PetscMallocA()
365 @*/
PetscMallocSetCoalesce(PetscBool coalesce)366 PetscErrorCode PetscMallocSetCoalesce(PetscBool coalesce)
367 {
368 PetscFunctionBegin;
369 petscmalloccoalesce = coalesce;
370 PetscFunctionReturn(0);
371 }
372
373 /*@C
374 PetscMallocA - Allocate and optionally clear one or more objects, possibly using coalesced malloc
375
376 Not Collective
377
378 Input Parameters:
379 + n - number of objects to allocate (at least 1)
380 . clear - use calloc() to allocate space initialized to zero
381 . lineno - line number to attribute allocation (typically __LINE__)
382 . function - function to attribute allocation (typically PETSC_FUNCTION_NAME)
383 . filename - file name to attribute allocation (typically __FILE__)
384 - bytes0 - first of n object sizes
385
386 Output Parameters:
387 . ptr0 - first of n pointers to allocate
388
389 Notes:
390 This function is not normally called directly by users, but rather via the macros PetscMalloc1(), PetscMalloc2(), or PetscCalloc1(), etc.
391
392 Level: developer
393
394 .seealso: PetscMallocAlign(), PetscMallocSet(), PetscMalloc1(), PetscMalloc2(), PetscMalloc3(), PetscMalloc4(), PetscMalloc5(), PetscMalloc6(), PetscMalloc7(), PetscCalloc1(), PetscCalloc2(), PetscCalloc3(), PetscCalloc4(), PetscCalloc5(), PetscCalloc6(), PetscCalloc7(), PetscFreeA()
395 @*/
PetscMallocA(int n,PetscBool clear,int lineno,const char * function,const char * filename,size_t bytes0,void * ptr0,...)396 PetscErrorCode PetscMallocA(int n,PetscBool clear,int lineno,const char *function,const char *filename,size_t bytes0,void *ptr0,...)
397 {
398 PetscErrorCode ierr;
399 va_list Argp;
400 size_t bytes[8],sumbytes;
401 void **ptr[8];
402 int i;
403
404 PetscFunctionBegin;
405 if (n > 8) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Attempt to allocate %d objects but only 8 supported",n);
406 bytes[0] = bytes0;
407 ptr[0] = (void**)ptr0;
408 sumbytes = (bytes0 + PETSC_MEMALIGN-1) & ~(PETSC_MEMALIGN-1);
409 va_start(Argp,ptr0);
410 for (i=1; i<n; i++) {
411 bytes[i] = va_arg(Argp,size_t);
412 ptr[i] = va_arg(Argp,void**);
413 sumbytes += (bytes[i] + PETSC_MEMALIGN-1) & ~(PETSC_MEMALIGN-1);
414 }
415 va_end(Argp);
416 if (petscmalloccoalesce) {
417 char *p;
418 ierr = (*PetscTrMalloc)(sumbytes,clear,lineno,function,filename,(void**)&p);CHKERRQ(ierr);
419 for (i=0; i<n; i++) {
420 *ptr[i] = bytes[i] ? p : NULL;
421 p = (char*)PetscAddrAlign(p + bytes[i]);
422 }
423 } else {
424 for (i=0; i<n; i++) {
425 ierr = (*PetscTrMalloc)(bytes[i],clear,lineno,function,filename,(void**)ptr[i]);CHKERRQ(ierr);
426 }
427 }
428 PetscFunctionReturn(0);
429 }
430
431 /*@C
432 PetscFreeA - Free one or more objects, possibly allocated using coalesced malloc
433
434 Not Collective
435
436 Input Parameters:
437 + n - number of objects to free (at least 1)
438 . lineno - line number to attribute deallocation (typically __LINE__)
439 . function - function to attribute deallocation (typically PETSC_FUNCTION_NAME)
440 . filename - file name to attribute deallocation (typically __FILE__)
441 - ptr0 ... - first of n pointers to free
442
443 Note:
444 This function is not normally called directly by users, but rather via the macros PetscFree(), PetscFree2(), etc.
445
446 The pointers are zeroed to prevent users from accidently reusing space that has been freed.
447
448 Level: developer
449
450 .seealso: PetscMallocAlign(), PetscMallocSet(), PetscMallocA(), PetscFree1(), PetscFree2(), PetscFree3(), PetscFree4(), PetscFree5(), PetscFree6(), PetscFree7()
451 @*/
PetscFreeA(int n,int lineno,const char * function,const char * filename,void * ptr0,...)452 PetscErrorCode PetscFreeA(int n,int lineno,const char *function,const char *filename,void *ptr0,...)
453 {
454 PetscErrorCode ierr;
455 va_list Argp;
456 void **ptr[8];
457 int i;
458
459 PetscFunctionBegin;
460 if (n > 8) SETERRQ1(PETSC_COMM_SELF,PETSC_ERR_ARG_OUTOFRANGE,"Attempt to allocate %d objects but only up to 8 supported",n);
461 ptr[0] = (void**)ptr0;
462 va_start(Argp,ptr0);
463 for (i=1; i<n; i++) {
464 ptr[i] = va_arg(Argp,void**);
465 }
466 va_end(Argp);
467 if (petscmalloccoalesce) {
468 for (i=0; i<n; i++) { /* Find first nonempty allocation */
469 if (*ptr[i]) break;
470 }
471 while (--n > i) {
472 *ptr[n] = NULL;
473 }
474 ierr = (*PetscTrFree)(*ptr[n],lineno,function,filename);CHKERRQ(ierr);
475 *ptr[n] = NULL;
476 } else {
477 while (--n >= 0) {
478 ierr = (*PetscTrFree)(*ptr[n],lineno,function,filename);CHKERRQ(ierr);
479 *ptr[n] = NULL;
480 }
481 }
482 PetscFunctionReturn(0);
483 }
484