diff --git a/ma/f2c.c b/ma/f2c.c index 346a5d68a..7fe3193b8 100644 --- a/ma/f2c.c +++ b/ma/f2c.c @@ -335,3 +335,17 @@ public Boolean FATR f2c_verify_allocator_stuff_() { return MA_verify_allocator_stuff(); } + +public Boolean FATR f2c_count_heap_(datatype, nelem) + Integer *datatype; + Integer *nelem; +{ + return MA_count_heap(*datatype, *nelem); +} + +public Boolean FATR f2c_uncount_heap_(datatype, nelem) + Integer *datatype; + Integer *nelem; +{ + return MA_uncount_heap(*datatype, *nelem); +} diff --git a/ma/ma.c b/ma/ma.c index d5e2ce84f..4ba0b852c 100644 --- a/ma/ma.c +++ b/ma/ma.c @@ -429,6 +429,8 @@ typedef enum FID_MA_sizeof_overhead, FID_MA_summarize_allocated_blocks, FID_MA_trace, + FID_MA_count_heap, + FID_MA_uncount_heap, FID_MA_verify_allocator_stuff } FID; @@ -3688,3 +3690,135 @@ public Boolean MA_verify_allocator_stuff() #endif /* VERIFY */ } + +/* ------------------------------------------------------------------------- */ +/* + * Add the size of an _external_ allocation (i.e. Fortran allocate) to MA stats + * to allow applications (e.g. NWChem) to accurately track their memory + * consumption. + * + * Return MA_TRUE upon success, or MA_FALSE upon failure. + */ +/* ------------------------------------------------------------------------- */ + +public Boolean MA_count_heap( + Integer datatype, /* of elements in the block */ + Integer nelem /* # of elements in the block */ + ) +{ + ulongi nbytes; + +#ifdef STATS + ma_stats.calls[(int)FID_MA_count_heap]++; +#endif /* STATS */ + + if (ma_trace) + (void)printf("MA: counting (%d)\n", (int)nelem); + + /* verify initialization */ + if (!ma_initialized) + { + (void)sprintf(ma_ebuf, "MA not yet initialized"); + ma_error(EL_Nonfatal, ET_External, "MA_count_heap", ma_ebuf); + return MA_FALSE; + } + + /* verify datatype */ + if (!mt_valid(datatype)) + { + (void)sprintf(ma_ebuf, "invalid datatype: %ld", (size_t)datatype); + ma_error(EL_Nonfatal, ET_External, "MA_count_heap", ma_ebuf); + return MA_FALSE; + } + + /* verify nelem */ + if (nelem < 0) + { + (void)sprintf(ma_ebuf, "invalid nelem: %ld", (size_t)nelem); + ma_error(EL_Nonfatal, ET_External, "MA_count_heap", ma_ebuf); + return MA_FALSE; + } + + /* convert datatype to internal (index-suitable) value */ + datatype = mt_import(datatype); + + /* compute the number of bytes in an element */ + nbytes = ma_sizeof[datatype]; + + /* total number of bytes */ + nbytes *= nelem; + +#ifdef STATS + ma_stats.hblocks++; + ma_stats.hblocks_max = max(ma_stats.hblocks, ma_stats.hblocks_max); + ma_stats.hbytes += nbytes; + ma_stats.hbytes_max = max(ma_stats.hbytes, ma_stats.hbytes_max); +#endif /* STATS */ + + return MA_TRUE; +} + +/* ------------------------------------------------------------------------- */ +/* + * Subtract the size of an _external_ allocation (i.e. Fortran allocate) to MA stats + * to allow applications (e.g. NWChem) to accurately track their memory + * consumption. + * + * Return MA_TRUE upon success, or MA_FALSE upon failure. + */ +/* ------------------------------------------------------------------------- */ + +public Boolean MA_uncount_heap( + Integer datatype, /* of elements in the block */ + Integer nelem /* # of elements in the block */ + ) +{ + ulongi nbytes; + +#ifdef STATS + ma_stats.calls[(int)FID_MA_uncount_heap]++; +#endif /* STATS */ + + if (ma_trace) + (void)printf("MA: uncounting (%d)\n", (int)nelem); + + /* verify initialization */ + if (!ma_initialized) + { + (void)sprintf(ma_ebuf, "MA not yet initialized"); + ma_error(EL_Nonfatal, ET_External, "MA_uncount_heap", ma_ebuf); + return MA_FALSE; + } + + /* verify datatype */ + if (!mt_valid(datatype)) + { + (void)sprintf(ma_ebuf, "invalid datatype: %ld", (size_t)datatype); + ma_error(EL_Nonfatal, ET_External, "MA_uncount_heap", ma_ebuf); + return MA_FALSE; + } + + /* verify nelem */ + if (nelem < 0) + { + (void)sprintf(ma_ebuf, "invalid nelem: %ld", (size_t)nelem); + ma_error(EL_Nonfatal, ET_External, "MA_uncount_heap", ma_ebuf); + return MA_FALSE; + } + + /* convert datatype to internal (index-suitable) value */ + datatype = mt_import(datatype); + + /* compute the number of bytes in an element */ + nbytes = ma_sizeof[datatype]; + + /* total number of bytes */ + nbytes *= nelem; + +#ifdef STATS + ma_stats.hblocks--; + ma_stats.hbytes -= nbytes; +#endif /* STATS */ + + return MA_TRUE; +} diff --git a/ma/ma.h b/ma/ma.h index e54a8271a..63c914923 100644 --- a/ma/ma.h +++ b/ma/ma.h @@ -50,5 +50,7 @@ extern void MAi_summarize_allocated_blocks(int index_base); #define f2c_trace_ F77_FUNC_(f2c_trace,F2C_TRACE) #define f2c_verify_allocator_stuff_ F77_FUNC_(f2c_verify_allocator_stuff,F2C_VERIFY_ALLOCATOR_STUFF) #define ma_set_sizes_ F77_FUNC_(ma_set_sizes,MA_SET_SIZES) +#define f2c_count_heap_ F77_FUNC_(f2c_count_heap,F2C_COUNT_HEAP) +#define f2c_uncount_heap_ F77_FUNC_(f2c_uncount_heap,F2C_UNCOUNT_HEAP) #endif /* _ma_h */ diff --git a/ma/macdecls.h b/ma/macdecls.h index 1716e46a8..068b3324e 100644 --- a/ma/macdecls.h +++ b/ma/macdecls.h @@ -102,6 +102,13 @@ extern void MA_trace(Boolean value); extern Boolean MA_verify_allocator_stuff(); extern void MA_set_error_callback(void(*func)()); +extern Boolean MA_count_heap( + Integer datatype, /**< of elements in this block */ + Integer nelem /**< # of elements in this block */); +extern Boolean MA_uncount_heap( + Integer datatype, /**< of elements in this block */ + Integer nelem /**< # of elements in this block */); + extern void ma_set_error_callback(); /** diff --git a/ma/maf.F b/ma/maf.F index 871f5d3da..e15eb632b 100644 --- a/ma/maf.F +++ b/ma/maf.F @@ -675,4 +675,46 @@ logical function MA_verify_allocator_stuff () return end +c --------------------------------------------------------------- c +c --------------------------------------------------------------- c + + logical function MA_count_heap (datatype, nelem) + + implicit none + + integer datatype + integer nelem + +#include "maf2c.fh" + + if (f2c_count_heap(datatype, nelem) .eq. MA_TRUE) then + MA_count_heap = .true. + else + MA_count_heap = .false. + endif + + return + end + +c --------------------------------------------------------------- c +c --------------------------------------------------------------- c + + logical function MA_uncount_heap (datatype, nelem) + + implicit none + + integer datatype + integer nelem + +#include "maf2c.fh" + + if (f2c_uncount_heap(datatype, nelem) .eq. MA_TRUE) then + MA_uncount_heap = .true. + else + MA_uncount_heap = .false. + endif + + return + end + #undef MAF_INTERNAL diff --git a/ma/maf2c.fh b/ma/maf2c.fh index 425dd951a..4c139315d 100644 --- a/ma/maf2c.fh +++ b/ma/maf2c.fh @@ -56,6 +56,8 @@ c void f2c_print_stats c void f2c_summarize_allocated_blocks c void f2c_trace integer f2c_verify_allocator_stuff + integer f2c_count_heap + integer f2c_uncount_heap external f2c_alloc_get external f2c_allocate_heap @@ -89,3 +91,5 @@ c void f2c_trace external f2c_summarize_allocated_blocks external f2c_trace external f2c_verify_allocator_stuff + external f2c_count_heap + external f2c_uncount_heap