6
* Portable dynamic memory allocator.
28
#ifdef ENABLE_ARMCI_MEM_OPTION
29
extern void* ARMCI_Malloc_local(long bytes);
35
* segment = heap_region stack_region
36
* region = block block block ...
37
* block = AD gap1 guard1 client_space guard2 gap2
39
* A segment of memory is obtained from the OS upon initialization.
40
* The low end of the segment is managed as a heap; the heap region
41
* grows from low addresses to high addresses. The high end of the
42
* segment is managed as a stack; the stack region grows from high
43
* addresses to low addresses.
45
* Each region consists of a series of contiguous blocks, one per
46
* allocation request, and possibly some unused space. Blocks in
47
* the heap region are either in use by the client (allocated and
48
* not yet deallocated) or not in use by the client (allocated and
49
* already deallocated). A block on the rightmost end of the heap
50
* region becomes part of the unused space upon deallocation.
51
* Blocks in the stack region are always in use by the client,
52
* because when a stack block is deallocated, it becomes part of
55
* A block consists of the client space, i.e., the range of memory
56
* available for use by the application; guard words adjacent to
57
* each end of the client space to help detect improper memory access
58
* by the client; bookkeeping info (in an "allocation descriptor,"
59
* AD); and two gaps, each zero or more bytes long, to satisfy
60
* alignment constraints (specifically, to ensure that AD and
61
* client_space are aligned properly).
68
/* return value for returns that should never execute */
69
#define DONTCARE (Integer)0
71
/* default total # of bytes */
72
#define DEFAULT_TOTAL_HEAP 524288 /* 2^19 */
73
#define DEFAULT_TOTAL_STACK 524288 /* 2^19 */
75
/* estimate of max # of outstanding allocation requests */
76
#define DEFAULT_REQUESTS_HEAP 1
77
#define DEFAULT_REQUESTS_STACK 1
79
/* bytes per address */
82
/* per-allocation storage overhead, excluding alignment gaps */
83
#define BLOCK_OVERHEAD_FIXED (sizeof(AD) + (2 * sizeof(Guard)))
85
/* block lengths are integral multiples of this */
87
* Note that for machines such as the KSR on which sizeof(pointer)
88
* and sizeof(long) are different than sizeof(int), alignment issues
89
* can be tricky. For example, the fields of a struct (e.g.,
90
* client_space of AD) can be improperly aligned if the struct is
91
* dynamically placed (by MA) in such a way that the first field is
92
* properly aligned but sizes of subsequent fields accumulate to cause
93
* a later field to be misaligned. By defining the unit of alignment
94
* to be the biggest of the integer and pointer types, part of the
95
* problem is solved, but the sum of sizes of preceding fields can
96
* still potentially cause difficulty.
98
#if defined(BGP) || defined(BGQ)
101
#define ALIGNMENT sizeof(long)
104
/* min size of block split and placed on free list */
105
#define MINBLOCKSIZE mai_round((long)(ALIGNMENT + BLOCK_OVERHEAD_FIXED), \
108
/* signatures for guard words */
109
#define GUARD1 (Guard)0xaaaaaaaa /* start signature */
110
#define GUARD2 (Guard)0x55555555 /* stop signature */
116
typedef unsigned int Guard; /* for detection of memory trashing */
117
typedef unsigned long ulongi; /* for brevity */
119
/* allocation request for a block */
122
Integer datatype; /* of elements */
123
Integer nelem; /* # of elements */
126
/* allocation descriptor for a block */
129
Integer datatype; /* of elements */
130
Integer nelem; /* # of elements */
131
char name[MA_NAMESIZE]; /* given by client */
132
Pointer client_space; /* start of client space */
133
ulongi nbytes; /* total # of bytes */
134
struct _AD *next; /* AD in linked list */
135
ulongi checksum; /* of AD */
138
/* block location for mh2ad */
151
private Boolean ad_big_enough(AD *ad, Pointer ar);
152
private Boolean ad_eq(AD *ad, Pointer ad_target);
153
private Boolean ad_gt(AD *ad, Pointer ad_target);
154
private Boolean ad_le(AD *ad, Pointer ad_target);
155
private Boolean ad_lt(AD *ad, Pointer ad_target);
156
private void ad_print(AD *ad, char *block_type);
157
private void balloc_after(AR *ar, Pointer address, Pointer *client_space, ulongi *nbytes);
158
private void balloc_before(AR *ar, Pointer address, Pointer *client_space, ulongi *nbytes);
159
private void block_free_heap(AD *ad);
160
private AD *block_split(AD *ad, ulongi bytes_needed, Boolean insert_free);
161
private ulongi checksum(AD *ad);
164
private void debug_ad_print(AD *ad);
167
private Boolean guard_check(AD *ad);
168
private void guard_set(AD *ad);
169
private void list_coalesce(AD *list);
170
private AD *list_delete(AD *ad, AD **list);
171
private int list_delete_many(AD **list, Boolean (*pred)(), Pointer closure, void (*action)());
172
private AD *list_delete_one(AD **list, Boolean (*pred)(), Pointer closure);
173
private void list_insert(AD *ad, AD **list);
174
private void list_insert_ordered(AD *ad, AD **list, Boolean (*pred)());
175
private Boolean list_member(AD *ad, AD *list);
176
private int list_print(AD *list, char *block_type, int index_base);
177
private void list_verify(AD *list, char *block_type, char *preamble, int *blocks, int *bad_blocks, int *bad_checksums, int *bad_lguards, int *bad_rguards);
178
private Integer ma_max_heap_frag_nelem(Integer datatype, Integer min_nelem);
179
private Integer ma_nelem(Pointer address, ulongi length, Integer datatype);
180
private void ma_preinitialize(char *caller);
181
private Boolean mh2ad(Integer memhandle, AD **adout, BlockLocation location, char *caller);
182
private void mh_free(AD *ad);
183
private long mai_round(long value, ulongi unit);
184
private void str_ncopy(char *to, char *from, int maxchars);
186
/* foreign routines */
188
extern Integer ma_set_sizes_(); /* from the MA FORTRAN interface */
194
/* base addresses of the datatypes */
195
private Pointer ma_base[] =
197
(Pointer)ma_cb_char, /* MT_C_CHAR */
198
(Pointer)ma_cb_int, /* MT_C_INT */
199
(Pointer)ma_cb_long, /* MT_C_LONGINT */
200
(Pointer)ma_cb_float, /* MT_C_FLOAT */
201
(Pointer)ma_cb_dbl, /* MT_C_DBL */
202
(Pointer)ma_cb_ldbl, /* MT_C_LDBL */
203
(Pointer)ma_cb_scpl, /* MT_C_SCPL */
204
(Pointer)ma_cb_dcpl, /* MT_C_DCPL */
205
(Pointer)ma_cb_ldcpl, /* MT_C_LDCPL */
213
(Pointer)ma_cb_longlong /* MT_C_LONGLONG */
216
/* names of the datatypes */
217
private char *ma_datatype[] =
225
"single precision complex",
226
"double precision complex",
227
"long double precision complex",
233
"single precision complex",
234
"double precision complex",
238
/* numbers of bytes in the datatypes */
239
private int ma_sizeof[] =
241
sizeof(char), /* MT_C_CHAR */
242
sizeof(int), /* MT_C_INT */
243
sizeof(long int), /* MT_C_LONGINT */
244
sizeof(float), /* MT_C_FLOAT */
245
sizeof(double), /* MT_C_DBL */
246
sizeof(MA_LongDouble), /* MT_C_LDBL */
247
sizeof(MA_SingleComplex), /* MT_C_SCPL */
248
sizeof(MA_DoubleComplex), /* MT_C_DCPL */
249
sizeof(MA_LongDoubleComplex), /* MT_C_LDCPL */
257
sizeof(long long) /* MT_C_LONGLONG */
261
* Initially, ma_hp points to the start of the segment, and ma_sp
262
* points to the first address past the end of the segment. The
263
* start of the segment is always pointed to by ma_segment, and
264
* the first address past the end of the segment is always pointed
265
* to by ma_eos. The (unenforced) boundary between the heap region
266
* and the stack region, defined at initialization, is always pointed
267
* to by ma_partition.
269
* ................................................
271
* ma_segment, ma_hp ma_partition ma_eos, ma_sp
273
* Later, ma_hp points to the first address past the end of the
274
* rightmost heap block, and ma_sp points to the leftmost stack block.
276
* hhhhhhhhhhhhhhhh.....................sssssssssss
278
* ma_segment ma_hp ma_partition ma_sp ma_eos
281
private Pointer ma_segment; /* memory from OS */
282
private Pointer ma_partition; /* boundary between heap and stack */
283
private Pointer ma_eos; /* end of segment */
284
private Pointer ma_hp; /* heap pointer */
285
private Pointer ma_sp; /* stack pointer */
287
private AD *ma_hfree; /* free list for heap */
288
private AD *ma_hused; /* used list for heap */
289
private AD *ma_sused; /* used list for stack */
291
/* toggled when ma_preinitialize succeeds */
292
private Boolean ma_preinitialized = MA_FALSE;
294
/* toggled when MA_init succeeds */
295
private Boolean ma_initialized = MA_FALSE;
297
/* invoke MA_verify_allocator_stuff in each public routine? */
298
private Boolean ma_auto_verify = MA_FALSE;
300
/* print push/pop/alloc/free? */
301
private Boolean ma_trace = MA_FALSE;
303
/* base arrays for the C datatypes */
304
public char ma_cb_char[2]; /* MT_C_CHAR */
305
public int ma_cb_int[2]; /* MT_C_INT */
306
public long ma_cb_long[2]; /* MT_C_LONGINT */
307
public long long ma_cb_longlong[2];/* MT_C_LONGLONG */
308
public float ma_cb_float[2]; /* MT_C_FLOAT */
309
public double ma_cb_dbl[2]; /* MT_C_DBL */
310
public MA_LongDouble ma_cb_ldbl[2]; /* MT_C_LDBL */
311
public MA_SingleComplex ma_cb_scpl[2]; /* MT_C_SCPL */
312
public MA_DoubleComplex ma_cb_dcpl[2]; /* MT_C_DCPL */
313
public MA_LongDoubleComplex ma_cb_ldcpl[2]; /* MT_C_LDCPL */
315
/* requested power-of-two alignment */
316
private Integer ma_numalign = 0;
322
/* minimum of two values */
326
#define min(a, b) (((b) < (a)) ? (b) : (a))
328
/* maximum of two values */
332
#define max(a, b) (((b) > (a)) ? (b) : (a))
334
/* proper word ending corresponding to n */
335
#define plural(n) (((n) == 1) ? "" : "s")
337
/* convert between internal and external datatype values */
338
#define mt_import(d) ((d) - MT_BASE)
339
#define mt_export(d) ((d) + MT_BASE)
341
/* return nonzero if d is a valid (external) datatype */
342
#define mt_valid(d) (((d) >= MT_FIRST) && ((d) <= MT_LAST))
344
/* convert between pointer (address) and equivalent byte address */
345
#define p2b(p) ((ulongi)(p) * BPA)
346
#define b2p(b) ((Pointer)((b) / BPA))
348
/* return nonzero if a is a potentially valid address */
349
#define reasonable_address(a) (((a) >= ma_segment) && ((a) < ma_eos))
351
/* worst case bytes of overhead for any block of elements of datatype d */
352
#define max_block_overhead(d) \
353
(BLOCK_OVERHEAD_FIXED + (ma_sizeof[d] - 1) + (ALIGNMENT - 1))
355
/* compute 0-based index for client_space from AD */
356
#define client_space_index(ad) \
357
((MA_AccessIndex)((long)((ad)->client_space - ma_base[(ad)->datatype]) / \
358
ma_sizeof[(ad)->datatype]))
360
/* compute address of guard from AD */
361
#define guard1(ad) ((Pointer)((ad)->client_space - sizeof(Guard)))
362
#define guard2(ad) ((Pointer)((ad)->client_space \
363
+ ((ad)->nelem * ma_sizeof[(ad)->datatype])))
366
* When reading or writing guard values, it is necessary to do an
367
* explicit byte copy to avoid bus errors caused by guards that
368
* are not suitably aligned.
371
/* copy from guard to value */
372
#define guard_read(guard, value) bytecopy((guard), (value), sizeof(Guard))
374
/* copy from value to guard */
375
#define guard_write(guard, value) bytecopy((value), (guard), sizeof(Guard))
383
/* the number of routines for which calls are counted */
384
#define NUMROUTINES ((int)FID_MA_verify_allocator_stuff + 1)
386
/* function identifiers */
389
FID_MA_alloc_get = 0,
390
FID_MA_allocate_heap,
393
FID_MA_free_heap_piece,
396
FID_MA_get_next_memhandle,
401
FID_MA_init_memhandle_iterator,
402
FID_MA_inquire_avail,
404
FID_MA_inquire_heap_check_stack,
405
FID_MA_inquire_heap_no_partition,
406
FID_MA_inquire_stack,
407
FID_MA_inquire_stack_check_heap,
408
FID_MA_inquire_stack_no_partition,
413
FID_MA_set_auto_verify,
414
FID_MA_set_error_print,
415
FID_MA_set_hard_fail,
418
FID_MA_sizeof_overhead,
419
FID_MA_summarize_allocated_blocks,
421
FID_MA_verify_allocator_stuff
424
/* MA usage statistics */
427
ulongi hblocks; /* current # of heap blocks */
428
ulongi hblocks_max; /* max # of heap blocks */
429
ulongi hbytes; /* current # of heap bytes */
430
ulongi hbytes_max; /* max # of heap bytes */
431
ulongi sblocks; /* current # of stack blocks */
432
ulongi sblocks_max; /* max # of stack blocks */
433
ulongi sbytes; /* current # of stack bytes */
434
ulongi sbytes_max; /* max # of stack bytes */
435
ulongi calls[NUMROUTINES];/* # of calls to each routine */
438
/* names of the routines */
439
private char *ma_routines[] =
445
"MA_free_heap_piece",
448
"MA_get_next_memhandle",
453
"MA_init_memhandle_iterator",
456
"MA_inquire_heap_check_stack",
457
"MA_inquire_heap_no_partition",
459
"MA_inquire_stack_check_heap",
460
"MA_inquire_stack_no_partition",
465
"MA_set_auto_verify",
466
"MA_set_error_print",
470
"MA_sizeof_overhead",
471
"MA_summarize_allocated_blocks",
473
"MA_verify_allocator_stuff"
476
/* MA usage statistics */
477
private Stats ma_stats;
485
/* ------------------------------------------------------------------------- */
487
* Return MA_TRUE if ad can satisfy ar, else return MA_FALSE.
488
* If ad can satisfy ar, set its client_space and nbytes fields
489
* after performing any splitting.
491
/* ------------------------------------------------------------------------- */
493
private Boolean ad_big_enough(ad, ar)
494
AD *ad; /* the AD to test */
495
Pointer ar; /* allocation request */
497
Pointer client_space; /* location of client_space */
498
ulongi nbytes; /* length of block for ar */
500
/* perform trial allocation to determine size */
501
balloc_after((AR *)ar, (Pointer)ad, &client_space, &nbytes);
503
if (nbytes <= ad->nbytes)
505
/* ad is big enough; split block if necessary */
506
(void)block_split(ad, nbytes, MA_TRUE);
508
/* set fields appropriately */
509
ad->client_space = client_space;
515
/* ad is not big enough */
519
/* ------------------------------------------------------------------------- */
521
* Return MA_TRUE if ad == ad_target, else return MA_FALSE.
523
/* ------------------------------------------------------------------------- */
525
private Boolean ad_eq(ad, ad_target)
526
AD *ad; /* the AD to test */
527
Pointer ad_target; /* the AD to match */
529
return (ad == (AD *)ad_target) ? MA_TRUE : MA_FALSE;
532
/* ------------------------------------------------------------------------- */
534
* Return MA_TRUE if ad > ad_target, else return MA_FALSE.
536
/* ------------------------------------------------------------------------- */
538
private Boolean ad_gt(ad, ad_target)
539
AD *ad; /* the AD to test */
540
Pointer ad_target; /* the AD to match */
542
return (ad > (AD *)ad_target) ? MA_TRUE : MA_FALSE;
545
/* ------------------------------------------------------------------------- */
547
* Return MA_TRUE if ad <= ad_target, else return MA_FALSE.
549
/* ------------------------------------------------------------------------- */
551
private Boolean ad_le(ad, ad_target)
552
AD *ad; /* the AD to test */
553
Pointer ad_target; /* the AD to match */
555
return (ad <= (AD *)ad_target) ? MA_TRUE : MA_FALSE;
558
/* ------------------------------------------------------------------------- */
560
* Return MA_TRUE if ad < ad_target, else return MA_FALSE.
562
/* ------------------------------------------------------------------------- */
564
private Boolean ad_lt(ad, ad_target)
565
AD *ad; /* the AD to test */
566
Pointer ad_target; /* the AD to match */
568
return (ad < (AD *)ad_target) ? MA_TRUE : MA_FALSE;
571
/* ------------------------------------------------------------------------- */
573
* Print identifying information about the given AD to stdout.
575
/* ------------------------------------------------------------------------- */
577
private void ad_print(ad, block_type)
578
AD *ad; /* to print */
579
char *block_type; /* for output */
581
Integer memhandle; /* memhandle for AD */
583
/* convert AD to memhandle */
584
memhandle = ma_table_lookup_assoc((TableData)ad);
586
/* print to stdout */
587
(void)printf("%s block '%s', handle ",
590
if (memhandle == TABLE_HANDLE_NONE)
591
(void)printf("unknown");
595
(void)printf(", address 0x%lx",
599
/* ------------------------------------------------------------------------- */
601
* Allocate a block suitable for ar starting at address. No fields of
602
* the new block are modified.
604
/* ------------------------------------------------------------------------- */
606
private void balloc_after(ar, address, client_space, nbytes)
607
AR *ar; /* allocation request */
608
Pointer address; /* to allocate after */
609
Pointer *client_space; /* RETURN: location of client_space */
610
ulongi *nbytes; /* RETURN: length of block */
612
Integer datatype; /* of elements in this block */
613
ulongi L_client_space; /* length of client_space */
614
Pointer A_client_space; /* address of client_space */
615
int L_gap1; /* length of gap1 */
616
int L_gap2; /* length of gap2 */
618
ulongi B_address; /* byte equivalent of address */
619
ulongi B_base; /* byte equivalent of ma_base[datatype] */
620
ulongi B_client_space; /* byte equivalent of A_client_space */
622
datatype = ar->datatype;
624
B_address = p2b(address);
625
B_base = p2b(ma_base[datatype]);
628
* To ensure that client_space is properly aligned:
630
* (A(client_space) - ma_base[datatype]) % ma_sizeof[datatype] == 0
634
* A(client_space) == address + L(AD) + L(gap1) + L(guard1)
637
L_client_space = ar->nelem * ma_sizeof[datatype];
639
L_gap1 = ((long)B_base
642
- (long)sizeof(Guard))
643
% (long)ma_sizeof[datatype];
646
L_gap1 += ma_sizeof[datatype];
648
B_client_space = B_address + sizeof(AD) + L_gap1 + sizeof(Guard);
649
A_client_space = b2p(B_client_space);
650
B_client_space = p2b(A_client_space);
653
* To align client space according to overall alignment of absolute
654
* address on user requested 2^ma_numalign boundary.
655
* Note that if the base arrays are not aligned accordingly then
656
* this alignement request is not satisfiable and will be quietly
660
if (ma_numalign > 0) {
661
unsigned long mask = (1<<ma_numalign)-1;
662
int diff = ((unsigned long) B_client_space) & mask;
664
/* Check that the difference is a multiple of the type size.
665
* If so, then we can shift the client space which is already
666
* aligned to satisfy this requirement.
670
diff = (1<<ma_numalign) - diff;
671
if ((diff % ma_sizeof[datatype]) == 0 ) {
672
/*printf("bafter realigned diff=%d\n",diff);*/
673
A_client_space = b2p(B_client_space + diff);
674
B_client_space = p2b(A_client_space);
677
printf("did not realign diff=%d typelen=%d mod=%d\n",
678
diff, ma_sizeof[datatype], (diff % ma_sizeof[datatype]));
684
* To ensure that the AD is properly aligned:
686
* L(block) % ALIGNMENT == 0
690
* L(block) == A(client_space) + L(client_space) + L(guard2) + L(gap2)
694
L_gap2 = ((long)B_address
695
- (long)B_client_space
696
- (long)L_client_space
697
- (long)sizeof(Guard))
704
* set the return values
707
*client_space = A_client_space;
708
*nbytes = (ulongi)(B_client_space
715
/* ------------------------------------------------------------------------- */
717
* Allocate a block suitable for ar ending before address. No fields of
718
* the new block are modified.
720
/* ------------------------------------------------------------------------- */
722
private void balloc_before(ar, address, client_space, nbytes)
723
AR *ar; /* allocation request */
724
Pointer address; /* to allocate before */
725
Pointer *client_space; /* RETURN: location of client_space */
726
ulongi *nbytes; /* RETURN: length of block */
728
Integer datatype; /* of elements in this block */
729
ulongi L_client_space; /* length of client_space */
730
Pointer A_client_space; /* address of client_space */
731
int L_gap1; /* length of gap1 */
732
int L_gap2; /* length of gap2 */
734
ulongi B_address; /* byte equivalent of address */
735
ulongi B_base; /* byte equivalent of ma_base[datatype] */
736
ulongi B_client_space; /* byte equivalent of A_client_space */
738
datatype = ar->datatype;
740
B_address = p2b(address);
741
B_base = p2b(ma_base[datatype]);
744
* To ensure that client_space is properly aligned:
746
* (A(client_space) - ma_base[datatype]) % ma_sizeof[datatype] == 0
750
* A(client_space) == address - L(gap2) - L(guard2) - L(client_space)
753
L_client_space = ar->nelem * ma_sizeof[datatype];
759
% ma_sizeof[datatype];
762
L_gap2 += ma_sizeof[datatype];
764
B_client_space = B_address - L_gap2 - sizeof(Guard) - L_client_space;
765
A_client_space = b2p(B_client_space);
766
B_client_space = p2b(A_client_space);
769
* To align client space according to overall alignment of absolute
770
* address on user requested 2^ma_numalign boundary.
771
* Note that if the base arrays are not aligned accordingly then
772
* this alignement request is not satisfiable and will be quietly
776
if (ma_numalign > 0) {
777
unsigned long mask = (1<<ma_numalign)-1;
778
int diff = ((unsigned long) B_client_space) & mask;
780
/* Check that the difference is a multiple of the type size.
781
* If so, then we can shift the client space which is already
782
* aligned to satisfy this requirement.
786
if ((diff % ma_sizeof[datatype]) == 0 ) {
787
/* printf("bbefore realigned diff=%d\n",diff); */
788
A_client_space = b2p(B_client_space - diff);
789
B_client_space = p2b(A_client_space);
792
printf("did not realign diff=%d typelen=%d mod=%d\n",
793
diff, ma_sizeof[datatype], (diff % ma_sizeof[datatype]));
799
* To ensure that the AD is properly aligned:
801
* A(AD) % ALIGNMENT == 0
805
* A(AD) == A(client_space) - L(guard1) - L(gap1) - L(AD)
808
L_gap1 = (B_client_space
814
* set the return values
817
*client_space = A_client_space;
818
*nbytes = (ulongi)(B_address
825
/* ------------------------------------------------------------------------- */
827
* Reclaim the given block by updating ma_hp and ma_hfree.
829
/* ------------------------------------------------------------------------- */
831
private void block_free_heap(ad)
832
AD *ad; /* AD to free */
834
AD *ad2; /* traversal pointer */
835
AD *max_ad; /* rightmost AD */
837
/* find rightmost heap block */
838
for (max_ad = (AD *)NULL, ad2 = ma_hused; ad2; ad2 = ad2->next)
846
/* at least 1 block is in use */
848
/* set ma_hp to first address past end of max_ad */
849
ma_hp = (Pointer)max_ad + max_ad->nbytes;
851
/* delete any free list blocks that are no longer in heap region */
852
(void)list_delete_many(
858
/* if ad is in the heap region, add it to free list */
861
list_insert_ordered(ad, &ma_hfree, ad_lt);
862
list_coalesce(ma_hfree);
867
/* no blocks are in use */
869
/* set ma_hp to start of segment */
872
/* clear the free list */
873
ma_hfree = (AD *)NULL;
877
/* ------------------------------------------------------------------------- */
879
* If ad is sufficiently bigger than bytes_needed bytes, create a new
880
* block from the remainder, optionally insert it in the free list,
881
* and set the lengths of both blocks.
883
* Return a pointer to the new block (NULL if not created).
885
/* ------------------------------------------------------------------------- */
887
private AD *block_split(ad, bytes_needed, insert_free)
888
AD *ad; /* the AD to split */
889
ulongi bytes_needed; /* from ad */
890
Boolean insert_free; /* insert in free list? */
892
ulongi bytes_extra; /* in ad */
893
AD *ad2; /* the new AD */
895
/* caller ensures that ad->nbytes >= bytes_needed */
896
bytes_extra = ad->nbytes - bytes_needed;
898
if (bytes_extra >= ((ulongi)MINBLOCKSIZE))
900
/* create a new block */
901
ad2 = (AD *)((Pointer)ad + bytes_needed);
903
/* set the length of ad2 */
904
ad2->nbytes = bytes_extra;
908
/* insert ad2 into free list */
909
list_insert_ordered(ad2, &ma_hfree, ad_lt);
912
/* set the length of ad */
913
ad->nbytes = bytes_needed;
920
* If 0 <= bytes_extra < MINBLOCKSIZE then there are too few
921
* extra bytes to form a new block. In this case, we simply
922
* do nothing; ad will retain its original length (which is
923
* either perfect or slightly too big), and the entire block
924
* will be reclaimed upon deallocation, preventing any
932
/* ------------------------------------------------------------------------- */
934
* Compute and return a checksum for ad. Include all fields except name,
935
* next, and checksum.
937
/* ------------------------------------------------------------------------- */
939
private ulongi checksum(ad)
940
AD *ad; /* the AD to compute checksum for */
945
(ulongi)ad->client_space +
949
/* ------------------------------------------------------------------------- */
951
* Print to stderr the addresses of the fields of the given ad.
953
/* ------------------------------------------------------------------------- */
957
private void debug_ad_print(ad)
958
AD *ad; /* the AD to print */
960
#define NUMADFIELDS 7
962
char *fn[NUMADFIELDS]; /* field names */
963
long fa[NUMADFIELDS]; /* field addresses */
964
int i; /* loop index */
965
long address; /* other addresses */
967
/* set field names */
971
fn[3] = "client_space";
976
/* set field addresses */
977
fa[0] = (long)(&(ad->datatype));
978
fa[1] = (long)(&(ad->nelem));
979
fa[2] = (long)(&(ad->name));
980
fa[3] = (long)(&(ad->client_space));
981
fa[4] = (long)(&(ad->nbytes));
982
fa[5] = (long)(&(ad->next));
983
fa[6] = (long)(&(ad->checksum));
985
/* print AD fields to stderr */
986
(void)fprintf(stderr, "debug_ad_print:\n");
987
for (i = 0; i < NUMADFIELDS; i++)
988
(void)fprintf(stderr, "\t0x%lx mod4,8,16=%d,%d,%-2d ad->%s\n",
995
/* print other addresses to stderr */
996
address = (long)guard1(ad);
997
(void)fprintf(stderr, "\t0x%lx mod4,8,16=%d,%d,%-2d guard1\n",
1002
address = (long)ad->client_space;
1003
(void)fprintf(stderr, "\t0x%lx mod4,8,16=%d,%d,%-2d client_space\n",
1008
address = (long)guard2(ad);
1009
(void)fprintf(stderr, "\t0x%lx mod4,8,16=%d,%d,%-2d guard2\n",
1015
(void)fflush(stderr);
1020
/* ------------------------------------------------------------------------- */
1022
* Return MA_TRUE if the guards associated with ad contain valid signatures,
1023
* else return MA_FALSE.
1025
/* ------------------------------------------------------------------------- */
1027
private Boolean guard_check(ad)
1028
AD *ad; /* the AD to check guards for */
1030
Guard signature; /* value to be read */
1031
Pointer guard; /* address to read from */
1034
guard_read(guard, &signature);
1035
if (signature != GUARD1)
1039
guard_read(guard, &signature);
1040
if (signature != GUARD2)
1047
/* ------------------------------------------------------------------------- */
1049
* Write signatures into the guards associated with ad.
1051
/* ------------------------------------------------------------------------- */
1053
private void guard_set(ad)
1054
AD *ad; /* the AD to set guards for */
1056
Guard signature; /* value to be written */
1057
Pointer guard; /* address to write to */
1061
guard_write(guard, &signature);
1065
guard_write(guard, &signature);
1068
/* ------------------------------------------------------------------------- */
1070
* Coalesce list by merging any adjacent elements that are contiguous.
1071
* The list is assumed to be ordered by increasing addresses, i.e.,
1072
* addressOf(element i) < addressOf(element i+1).
1074
/* ------------------------------------------------------------------------- */
1076
private void list_coalesce(list)
1077
AD *list; /* the list to coalesce */
1079
AD *ad1; /* lead traversal pointer */
1080
AD *ad2; /* trailing traversal pointer */
1082
for (ad2 = list; ad2;)
1084
/* compute first address beyond ad2 */
1085
ad1 = (AD *)((Pointer)ad2 + ad2->nbytes);
1087
/* are ad2 and ad1 contiguous? */
1088
if (ad1 == ad2->next)
1090
/* yes; merge ad1 into ad2 */
1091
ad2->nbytes += ad1->nbytes;
1092
ad2->next = ad1->next;
1096
/* no; advance ad2 */
1102
/* ------------------------------------------------------------------------- */
1104
* Delete and return the first occurrence of ad from list. If ad is not
1105
* a member of list, return NULL.
1107
/* ------------------------------------------------------------------------- */
1109
private AD *list_delete(ad, list)
1110
AD *ad; /* the AD to delete */
1111
AD **list; /* the list to delete from */
1113
return list_delete_one(list, ad_eq, (Pointer)ad);
1116
/* ------------------------------------------------------------------------- */
1118
* Apply pred (with closure) to each element of list. Delete each element
1119
* that satisfies pred, after applying action to the element (if action is
1120
* not NULL). Return the number of elements deleted.
1122
/* ------------------------------------------------------------------------- */
1124
private int list_delete_many(list, pred, closure, action)
1125
AD **list; /* the list to search */
1126
Boolean (*pred)(); /* predicate */
1127
Pointer closure; /* for pred */
1128
void (*action)(); /* to apply before deletion */
1130
AD *ad1; /* lead traversal pointer */
1131
AD *ad2; /* trailing traversal pointer */
1132
int ndeleted = 0; /* # of elements deleted from list */
1134
for (ad2 = (AD *)NULL, ad1 = *list; ad1; ad1 = ad1->next)
1136
/* does ad1 match? */
1137
if ((*pred)(ad1, closure))
1139
/* yes; apply action, then delete ad1 from list */
1140
if (action != (void (*)())NULL)
1144
/* ad1 is second or later element */
1145
ad2->next = ad1->next;
1149
/* ad1 is first element */
1157
/* no; ad1 survives, so scoot ad2 along */
1162
/* return the # of elements deleted from list */
1166
/* ------------------------------------------------------------------------- */
1168
* Apply pred (with closure) to each element of list. Delete and return
1169
* the first element that satisfies pred. If no element satisfies pred,
1172
/* ------------------------------------------------------------------------- */
1174
private AD *list_delete_one(list, pred, closure)
1175
AD **list; /* the list to search */
1176
Boolean (*pred)(); /* predicate */
1177
Pointer closure; /* for pred */
1179
AD *ad1; /* lead traversal pointer */
1180
AD *ad2; /* trailing traversal pointer */
1182
for (ad2 = (AD *)NULL, ad1 = *list; ad1; ad2 = ad1, ad1 = ad1->next)
1184
/* does ad1 match? */
1185
if ((*pred)(ad1, closure))
1187
/* yes; delete ad1 from list */
1190
/* ad1 is second or later element */
1191
ad2->next = ad1->next;
1195
/* ad1 is first element */
1208
/* ------------------------------------------------------------------------- */
1210
* Insert ad into list.
1212
/* ------------------------------------------------------------------------- */
1214
private void list_insert(ad, list)
1215
AD *ad; /* the AD to insert */
1216
AD **list; /* the list to insert into */
1218
/* push ad onto list */
1223
/* ------------------------------------------------------------------------- */
1225
* Insert ad into list, immediately before the first element e
1226
* for which pred(ad, e) returns true. If there is no such element,
1227
* insert ad after the last element of list.
1229
/* ------------------------------------------------------------------------- */
1231
private void list_insert_ordered(ad, list, pred)
1232
AD *ad; /* the AD to insert */
1233
AD **list; /* the list to insert into */
1234
Boolean (*pred)(); /* predicate */
1236
AD *ad1; /* lead traversal pointer */
1237
AD *ad2; /* trailing traversal pointer */
1239
if (*list == (AD *)NULL)
1242
ad->next = (AD *)NULL;
1247
/* list has at least one element */
1248
for (ad2 = (AD *)NULL, ad1 = *list; ad1; ad2 = ad1, ad1 = ad1->next)
1250
/* does ad1 match? */
1251
if ((*pred)(ad, ad1))
1253
/* yes; insert ad before ad1 */
1256
/* ad1 is second or later element */
1261
/* ad1 is first element */
1271
/* append ad to list */
1273
ad->next = (AD *)NULL;
1276
/* ------------------------------------------------------------------------- */
1278
* Return MA_TRUE if ad is a member of list, else return MA_FALSE.
1280
/* ------------------------------------------------------------------------- */
1282
private Boolean list_member(ad, list)
1283
AD *ad; /* the AD to search for */
1284
AD *list; /* the list to search */
1286
AD *ad1; /* traversal pointer */
1288
for (ad1 = list; ad1; ad1 = ad1->next)
1290
/* ad is a member of list */
1293
/* ad is not a member of list */
1297
/* ------------------------------------------------------------------------- */
1299
* Print information to stdout about each block on list. Return the
1300
* number of blocks on list.
1302
/* ------------------------------------------------------------------------- */
1304
private int list_print(list, block_type, index_base)
1305
AD *list; /* to print */
1306
char *block_type; /* for output */
1307
int index_base; /* 0 (C) or 1 (FORTRAN) */
1309
AD *ad; /* traversal pointer */
1310
int nblocks; /* # of blocks on list */
1312
/* print each block on list */
1313
for (ad = list, nblocks = 0; ad; ad = ad->next, nblocks++)
1315
/* print to stdout */
1316
ad_print(ad, block_type);
1317
(void)printf(":\n");
1318
(void)printf("\ttype of elements:\t\t%s\n",
1319
ma_datatype[ad->datatype]);
1320
(void)printf("\tnumber of elements:\t\t%ld\n",
1322
(void)printf("\taddress of client space:\t0x%lx\n",
1323
(long)ad->client_space);
1324
(void)printf("\tindex for client space:\t\t%ld\n",
1325
(long)(client_space_index(ad) + index_base));
1326
(void)printf("\ttotal number of bytes:\t\t%lu\n",
1330
/* return the number of blocks on list */
1334
/* ------------------------------------------------------------------------- */
1336
* Check each block on list for checksum and guard errors. For each error
1337
* found, print a message to stdout. Return counts of the various errors
1338
* in the bad_ parameters.
1340
/* ------------------------------------------------------------------------- */
1342
private void list_verify(list, block_type, preamble, blocks,
1343
bad_blocks, bad_checksums, bad_lguards, bad_rguards)
1344
AD *list; /* to verify */
1345
char *block_type; /* for error messages */
1346
char *preamble; /* printed before first error message */
1347
int *blocks; /* RETURN: # of blocks */
1348
int *bad_blocks; /* RETURN: # of blocks having errors */
1349
int *bad_checksums; /* RETURN: # of blocks having bad checksum */
1350
int *bad_lguards; /* RETURN: # of blocks having bad guard1 */
1351
int *bad_rguards; /* RETURN: # of blocks having bad guard2 */
1353
AD *ad; /* traversal pointer */
1354
Boolean first_bad_block;/* first bad block found? */
1355
Boolean bad_block; /* problem in current block? */
1356
Guard signature; /* value to be read */
1357
Pointer guard; /* address to read from */
1365
first_bad_block = MA_TRUE;
1367
/* check each block on list */
1368
for (ad = list; ad; ad = ad->next)
1371
bad_block = MA_FALSE;
1373
/* check for checksum error */
1374
if (checksum(ad) != ad->checksum)
1376
/* print preamble if necessary */
1377
if (first_bad_block && (preamble != (char *)NULL))
1379
(void)printf(preamble);
1380
first_bad_block = MA_FALSE;
1383
/* print error message to stdout */
1384
ad_print(ad, block_type);
1385
(void)printf(":\n\t");
1386
(void)printf("current checksum %lu != stored checksum %lu\n",
1390
/* do bookkeeping */
1392
bad_block = MA_TRUE;
1395
/* check for bad guard1 */
1397
guard_read(guard, &signature);
1398
if (signature != GUARD1)
1400
/* print preamble if necessary */
1401
if (first_bad_block && (preamble != (char *)NULL))
1403
(void)printf(preamble);
1404
first_bad_block = MA_FALSE;
1407
/* print error message to stdout */
1408
ad_print(ad, block_type);
1409
(void)printf(":\n\t");
1411
"current left signature %u != proper left signature %u\n",
1415
/* do bookkeeping */
1417
bad_block = MA_TRUE;
1420
/* check for bad guard2 */
1422
guard_read(guard, &signature);
1423
if (signature != GUARD2)
1425
/* print preamble if necessary */
1426
if (first_bad_block && (preamble != (char *)NULL))
1428
(void)printf(preamble);
1429
first_bad_block = MA_FALSE;
1432
/* print error message to stdout */
1433
ad_print(ad, block_type);
1434
(void)printf(":\n\t");
1436
"current right signature %u != proper right signature %u\n",
1440
/* do bookkeeping */
1442
bad_block = MA_TRUE;
1445
/* if any errors, bump bad block count */
1451
/* ------------------------------------------------------------------------- */
1453
* Return the maximum number of datatype elements that can currently be
1454
* accomodated in a heap fragment (a block on the heap free list) entirely
1455
* within the heap region, or 0 if this number is less than min_nelem.
1457
/* ------------------------------------------------------------------------- */
1459
private Integer ma_max_heap_frag_nelem(datatype, min_nelem)
1460
Integer datatype; /* of elements */
1461
Integer min_nelem; /* for fragment to be considered */
1463
ulongi min_bytes; /* for fragment to be considered */
1464
AD *ad; /* traversal pointer */
1465
ulongi nbytes; /* in current fragment */
1466
Integer nelem; /* in current fragment */
1467
Integer max_nelem; /* result */
1469
/* set the threshold */
1470
min_bytes = (min_nelem * ma_sizeof[datatype]) + BLOCK_OVERHEAD_FIXED;
1472
/* search the heap free list */
1474
for (ad = ma_hfree; ad; ad = ad->next)
1477
* There are 3 cases to consider:
1479
* (a) fragment is outside heap region
1480
* (b) fragment straddles partition between heap and stack regions
1481
* (c) fragment is inside heap region
1484
if ((Pointer)ad >= ma_partition)
1486
/* case (a): reject */
1489
else if (((Pointer)ad + ad->nbytes) >= ma_partition)
1491
/* case (b): truncate fragment at partition */
1492
nbytes = (ulongi)(ma_partition - (Pointer)ad);
1496
/* case (c): accept */
1497
nbytes = ad->nbytes;
1500
if (nbytes >= min_bytes)
1502
nelem = ma_nelem((Pointer)ad, nbytes, datatype);
1503
max_nelem = max(max_nelem, nelem);
1507
/* return the result */
1511
/* ------------------------------------------------------------------------- */
1513
* Return the maximum number of datatype elements that can currently
1514
* be accomodated in length bytes starting at address.
1516
/* ------------------------------------------------------------------------- */
1518
private Integer ma_nelem(address, length, datatype)
1519
Pointer address; /* location of hypothetical block */
1520
ulongi length; /* length of hypothetical block */
1521
Integer datatype; /* of elements in hypothetical block */
1523
AR ar; /* allocation request */
1524
Pointer client_space; /* location of client_space */
1525
ulongi nbytes; /* length of block for ar */
1527
if (length <= BLOCK_OVERHEAD_FIXED)
1528
/* no point in computing anything */
1531
/* compute initial request */
1532
ar.datatype = datatype;
1533
ar.nelem = (length - BLOCK_OVERHEAD_FIXED) / ma_sizeof[datatype];
1535
/* make requests until one succeeds or we give up */
1536
while (ar.nelem > 0)
1538
/* perform trial allocation to determine size */
1539
balloc_after(&ar, address, &client_space, &nbytes);
1541
if (nbytes > length)
1542
/* not enough space for ar.nelem elements */
1545
/* enough space for ar.nelem elements */
1549
/* return the result */
1553
/* ------------------------------------------------------------------------- */
1555
* Perform operations necessary to allow certain functions to be invoked
1556
* before MA_init is called.
1558
/* ------------------------------------------------------------------------- */
1560
private void ma_preinitialize(caller)
1561
char *caller; /* name of calling routine */
1563
if (ma_preinitialized)
1566
/* call a FORTRAN routine to set bases and sizes of FORTRAN datatypes */
1567
if (ma_set_sizes_() == 0)
1569
(void)sprintf(ma_ebuf,
1570
"unable to set sizes of FORTRAN datatypes");
1571
ma_error(EL_Fatal, ET_Internal, caller, ma_ebuf);
1576
ma_preinitialized = MA_TRUE;
1579
/* ------------------------------------------------------------------------- */
1581
* If memhandle is valid according to location, return the corresponding AD
1582
* in adout and return MA_TRUE, else print an error message and return
1585
/* ------------------------------------------------------------------------- */
1587
private Boolean mh2ad(memhandle, adout, location, caller)
1588
Integer memhandle; /* the handle to verify and convert */
1589
AD **adout; /* RETURN: AD corresponding to memhandle */
1590
BlockLocation location; /* where AD must reside */
1591
char *caller; /* name of calling routine */
1594
Boolean check_checksum = MA_TRUE;
1595
Boolean check_guards = MA_TRUE;
1596
Boolean check_heap = MA_FALSE;
1597
Boolean check_stack = MA_FALSE;
1598
Boolean check_stacktop = MA_FALSE;
1599
Boolean check_heapandstack = MA_FALSE;
1603
case BL_HeapOrStack:
1604
check_heapandstack = MA_TRUE;
1607
check_heap = MA_TRUE;
1610
check_stack = MA_TRUE;
1613
check_stacktop = MA_TRUE;
1616
(void)sprintf(ma_ebuf,
1617
"invalid location: %d",
1619
ma_error(EL_Nonfatal, ET_Internal, "mh2ad", ma_ebuf);
1623
/* convert memhandle to AD */
1624
if (!ma_table_verify(memhandle, caller))
1627
ad = (AD *)ma_table_lookup(memhandle);
1629
/* attempt to avoid crashes due to corrupt addresses */
1630
if (!reasonable_address((Pointer)ad))
1632
(void)sprintf(ma_ebuf,
1633
"invalid block address (0x%lx) for memhandle %ld",
1634
(long)ad, (long)memhandle);
1635
ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1641
if (checksum(ad) != ad->checksum)
1643
(void)sprintf(ma_ebuf,
1644
"invalid checksum for memhandle %ld (name: '%s')",
1645
(long)memhandle, ad->name);
1646
ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1653
if (!guard_check(ad))
1655
(void)sprintf(ma_ebuf,
1656
"invalid guard(s) for memhandle %ld (name: '%s')",
1657
(long)memhandle, ad->name);
1658
ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1665
if (!list_member(ad, ma_hused))
1667
(void)sprintf(ma_ebuf,
1668
"memhandle %ld (name: '%s') not in heap",
1669
(long)memhandle, ad->name);
1670
ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1674
else if (check_stack)
1676
if (!list_member(ad, ma_sused))
1678
(void)sprintf(ma_ebuf,
1679
"memhandle %ld (name: '%s') not in stack",
1680
(long)memhandle, ad->name);
1681
ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1685
else if (check_stacktop)
1687
/* is it in the stack? */
1688
if (!list_member(ad, ma_sused))
1690
(void)sprintf(ma_ebuf,
1691
"memhandle %ld (name: '%s') not in stack",
1692
(long)memhandle, ad->name);
1693
ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1697
/* is it on top of the stack? */
1698
if ((Pointer)ad != ma_sp)
1700
(void)sprintf(ma_ebuf,
1701
"memhandle %ld (name: '%s') not top of stack",
1702
(long)memhandle, ad->name);
1703
ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1707
else if (check_heapandstack)
1709
if ((!list_member(ad, ma_hused)) && (!list_member(ad, ma_sused)))
1711
(void)sprintf(ma_ebuf,
1712
"memhandle %ld (name: '%s') not in heap or stack",
1713
(long)memhandle, ad->name);
1714
ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1724
/* ------------------------------------------------------------------------- */
1726
* Free the memhandle corresponding to the given AD.
1728
/* ------------------------------------------------------------------------- */
1730
private void mh_free(ad)
1731
AD *ad; /* the AD whose memhandle to free */
1733
Integer memhandle; /* memhandle for AD */
1735
/* convert AD to memhandle */
1736
if ((memhandle = ma_table_lookup_assoc((TableData)ad)) == TABLE_HANDLE_NONE)
1738
(void)sprintf(ma_ebuf,
1739
"cannot find memhandle for block address 0x%lx",
1741
ma_error(EL_Nonfatal, ET_Internal, "mh_free", ma_ebuf);
1744
/* free memhandle */
1745
ma_table_deallocate(memhandle);
1748
/* ------------------------------------------------------------------------- */
1750
* Return the first multiple of unit which is >= value.
1752
/* ------------------------------------------------------------------------- */
1754
private long mai_round(value, unit)
1755
long value; /* to round */
1756
ulongi unit; /* to round to */
1761
value &= ~(long)unit;
1765
/* ------------------------------------------------------------------------- */
1767
* Copy at most maxchars-1 non-NUL chars from from to to; NUL-terminate to.
1769
/* ------------------------------------------------------------------------- */
1771
private void str_ncopy(to, from, maxchars)
1772
char *to; /* space to copy to */
1773
char *from; /* space to copy from */
1774
int maxchars; /* max # of chars (including NUL) copied */
1776
if (from == (char *)NULL)
1782
/* copy up to maxchars chars */
1783
(void)strncpy(to, from, maxchars);
1785
/* ensure to is NUL-terminated */
1786
to[maxchars-1] = '\0';
1790
** public routines for internal use only
1793
/* ------------------------------------------------------------------------- */
1795
* Set the base address and size of the given datatype.
1797
/* ------------------------------------------------------------------------- */
1799
public Boolean MAi_inform_base(datatype, address1, address2)
1800
Integer datatype; /* to set size of */
1801
Pointer address1; /* of datatype element base */
1802
Pointer address2; /* of an adjacent datatype element */
1804
/* verify uninitialization */
1807
(void)sprintf(ma_ebuf,
1808
"MA already initialized");
1809
ma_error(EL_Nonfatal, ET_Internal, "MAi_inform_base", ma_ebuf);
1813
/* verify datatype */
1814
if (!mt_valid(datatype))
1816
(void)sprintf(ma_ebuf,
1817
"invalid datatype: %ld",
1819
ma_error(EL_Nonfatal, ET_Internal, "MAi_inform_base", ma_ebuf);
1823
/* convert datatype to internal (index-suitable) value */
1824
datatype = mt_import(datatype);
1826
/* set the base address of datatype */
1827
ma_base[datatype] = address1;
1829
/* set the size of datatype */
1830
ma_sizeof[datatype] = (int)(address2 - address1);
1837
Integer ma_set_sizes_()
1839
MAi_inform_base(MT_F_BYTE, &ma_cb_char[0], &ma_cb_char[1]);
1840
MAi_inform_base(MT_F_INT, &ma_cb_int[0], &ma_cb_int[1]);
1841
MAi_inform_base(MT_F_LOG, &ma_cb_int[0], &ma_cb_int[1]);
1842
MAi_inform_base(MT_F_REAL, &ma_cb_float[0], &ma_cb_float[1]);
1843
MAi_inform_base(MT_F_DBL, &ma_cb_dbl[0], &ma_cb_dbl[1]);
1844
MAi_inform_base(MT_F_SCPL, &ma_cb_scpl[0], &ma_cb_scpl[1]);
1845
MAi_inform_base(MT_F_DCPL, &ma_cb_dcpl[0], &ma_cb_dcpl[1]);
1850
/* ------------------------------------------------------------------------- */
1852
* Print debugging information about all blocks currently in use
1853
* on the heap or the stack.
1855
/* ------------------------------------------------------------------------- */
1857
public void MAi_summarize_allocated_blocks(index_base)
1858
int index_base; /* 0 (C) or 1 (FORTRAN) */
1860
int heap_blocks; /* # of blocks on heap used list */
1861
int stack_blocks; /* # of blocks on stack used list */
1864
ma_stats.calls[(int)FID_MA_summarize_allocated_blocks]++;
1868
if (ma_auto_verify && !MA_verify_allocator_stuff())
1872
/* verify index_base */
1873
if ((index_base != 0) && (index_base != 1))
1875
(void)sprintf(ma_ebuf,
1876
"invalid index_base: %d",
1878
ma_error(EL_Nonfatal, ET_Internal, "MAi_summarize_allocated_blocks", ma_ebuf);
1882
(void)printf("MA_summarize_allocated_blocks: starting scan ...\n");
1884
/* print blocks on the heap used list */
1885
heap_blocks = list_print(ma_hused, "heap", index_base);
1887
/* print blocks on the stack used list */
1888
stack_blocks = list_print(ma_sused, "stack", index_base);
1890
(void)printf("MA_summarize_allocated_blocks: scan completed: ");
1891
(void)printf("%d heap block%s, %d stack block%s\n",
1893
plural(heap_blocks),
1895
plural(stack_blocks));
1902
/* ------------------------------------------------------------------------- */
1904
* Convenience function that combines MA_allocate_heap and MA_get_index.
1906
/* ------------------------------------------------------------------------- */
1908
public Boolean MA_alloc_get(
1909
Integer datatype, /* of elements in this block */
1910
Integer nelem, /* # of elements in this block */
1911
const char *name, /* assigned to this block by client */
1912
Integer *memhandle, /* RETURN: handle for this block */
1913
MA_AccessIndex *index /* RETURN: index for this block */ )
1916
ma_stats.calls[(int)FID_MA_alloc_get]++;
1919
if (MA_allocate_heap(datatype, nelem, name, memhandle))
1920
/* MA_allocate_heap succeeded; try MA_get_index */
1921
return MA_get_index(*memhandle, index);
1923
/* MA_allocate_heap failed */
1927
/* ------------------------------------------------------------------------- */
1929
* Allocate a heap block big enough to hold nelem elements
1930
* of the given datatype.
1932
* Return MA_TRUE upon success, or MA_FALSE upon failure.
1934
/* ------------------------------------------------------------------------- */
1936
public Boolean MA_allocate_heap(
1937
Integer datatype, /* of elements in this block */
1938
Integer nelem, /* # of elements in this block */
1939
const char *name, /* assigned to this block by client */
1940
Integer *memhandle /* RETURN: handle for this block */ )
1942
AR ar; /* allocation request */
1943
AD *ad; /* AD for newly allocated block */
1944
Pointer client_space; /* location of client_space */
1945
ulongi nbytes; /* length of block for ar */
1946
Pointer new_hp; /* new ma_hp */
1949
ma_stats.calls[(int)FID_MA_allocate_heap]++;
1953
if (ma_auto_verify && !MA_verify_allocator_stuff())
1958
(void)printf("MA: allocating '%s' (%d)\n", name, (int)nelem);
1960
/* verify initialization */
1961
if (!ma_initialized)
1963
(void)sprintf(ma_ebuf,
1964
"block '%s', MA not yet initialized",
1966
ma_error(EL_Nonfatal, ET_External, "MA_allocate_heap", ma_ebuf);
1970
/* verify datatype */
1971
if (!mt_valid(datatype))
1973
(void)sprintf(ma_ebuf,
1974
"block '%s', invalid datatype: %ld",
1975
name, (long)datatype);
1976
ma_error(EL_Nonfatal, ET_External, "MA_allocate_heap", ma_ebuf);
1983
(void)sprintf(ma_ebuf,
1984
"block '%s', invalid nelem: %ld",
1986
ma_error(EL_Nonfatal, ET_External, "MA_allocate_heap", ma_ebuf);
1990
/* convert datatype to internal (index-suitable) value */
1991
datatype = mt_import(datatype);
1994
* attempt to allocate space
1997
ar.datatype = datatype;
2000
/* search the free list */
2001
ad = list_delete_one(&ma_hfree, ad_big_enough, (Pointer)&ar);
2003
/* if search of free list failed, try expanding heap region */
2004
if (ad == (AD *)NULL)
2006
/* perform trial allocation to determine size */
2007
balloc_after(&ar, ma_hp, &client_space, &nbytes);
2009
new_hp = ma_hp + nbytes;
2012
(void)sprintf(ma_ebuf,
2013
"block '%s', not enough space to allocate %lu bytes",
2015
ma_error(EL_Nonfatal, ET_External, "MA_allocate_heap", ma_ebuf);
2020
/* heap region expanded successfully */
2023
/* set fields appropriately */
2024
ad->client_space = client_space;
2025
ad->nbytes = nbytes;
2030
* space has been allocated
2033
/* initialize the AD */
2034
ad->datatype = datatype;
2036
str_ncopy(ad->name, (char*)name, MA_NAMESIZE);
2037
/* ad->client_space is already set */
2038
/* ad->nbytes is already set */
2039
list_insert(ad, &ma_hused);
2040
ad->checksum = checksum(ad);
2042
/* set the guards */
2049
/* update ma_hp if necessary */
2050
new_hp = (Pointer)ad + ad->nbytes;
2058
ma_stats.hblocks_max = max(ma_stats.hblocks, ma_stats.hblocks_max);
2059
ma_stats.hbytes += ad->nbytes;
2060
ma_stats.hbytes_max = max(ma_stats.hbytes, ma_stats.hbytes_max);
2063
/* convert AD to memhandle */
2064
if ((*memhandle = ma_table_allocate((TableData)ad)) == TABLE_HANDLE_NONE)
2072
/* ------------------------------------------------------------------------- */
2074
* Deallocate the given stack block and all stack blocks allocated
2077
* Return MA_TRUE upon success, or MA_FALSE upon failure.
2079
/* ------------------------------------------------------------------------- */
2081
public Boolean MA_chop_stack(Integer memhandle)/*the block to deallocate up to*/
2083
AD *ad; /* AD for memhandle */
2086
ma_stats.calls[(int)FID_MA_chop_stack]++;
2090
if (ma_auto_verify && !MA_verify_allocator_stuff())
2094
/* verify memhandle and convert to AD */
2095
if (!mh2ad(memhandle, &ad, BL_Stack, "MA_chop_stack"))
2098
/* delete block and all blocks above it from used list */
2101
list_delete_many(&ma_sused, ad_le, (Pointer)ad, mh_free);
2103
(void)list_delete_many(&ma_sused, ad_le, (Pointer)ad, mh_free);
2106
/* pop block and all blocks above it from stack */
2108
ma_stats.sbytes -= (((Pointer)ad + ad->nbytes) - ma_sp);
2110
ma_sp = (Pointer)ad + ad->nbytes;
2116
/* ------------------------------------------------------------------------- */
2118
* Deallocate the given heap block.
2120
* Return MA_TRUE upon success, or MA_FALSE upon failure.
2122
/* ------------------------------------------------------------------------- */
2124
public Boolean MA_free_heap(Integer memhandle) /* the block to deallocate */
2126
AD *ad; /* AD for memhandle */
2129
ma_stats.calls[(int)FID_MA_free_heap]++;
2133
if (ma_auto_verify && !MA_verify_allocator_stuff())
2137
/* verify memhandle and convert to AD */
2138
if (!mh2ad(memhandle, &ad, BL_Heap, "MA_free_heap"))
2142
(void)printf("MA: freeing '%s'\n", ad->name);
2144
/* delete block from used list */
2145
if (list_delete(ad, &ma_hused) != ad)
2147
(void)sprintf(ma_ebuf,
2148
"memhandle %ld (name: '%s') not on heap used list",
2149
(long)memhandle, ad->name);
2150
ma_error(EL_Nonfatal, ET_Internal, "MA_free_heap", ma_ebuf);
2156
ma_stats.hbytes -= ad->nbytes;
2159
/* reclaim the deallocated block */
2160
block_free_heap(ad);
2162
/* free memhandle */
2163
ma_table_deallocate(memhandle);
2169
/* ------------------------------------------------------------------------- */
2171
* Deallocate nelem elements from the given heap block.
2173
* The nelem elements (of the datatype specified when the heap block
2174
* was allocated) to be deallocated are assumed to be at the rightmost
2175
* (i.e., higher addresses) edge of the heap block.
2177
* Return MA_TRUE upon success, or MA_FALSE upon failure.
2179
/* ------------------------------------------------------------------------- */
2181
public Boolean MA_free_heap_piece(
2182
Integer memhandle, /* the block to deallocate a piece of */
2183
Integer nelem /* # of elements to deallocate */)
2185
AD *ad; /* AD for memhandle */
2186
AD *ad_reclaim; /* AD for data returned */
2187
AR ar; /* AR for data kept */
2188
Pointer client_space; /* location of client_space */
2189
ulongi nbytes; /* length of block for data kept */
2192
ma_stats.calls[(int)FID_MA_free_heap_piece]++;
2196
if (ma_auto_verify && !MA_verify_allocator_stuff())
2200
/* verify memhandle and convert to AD */
2201
if (!mh2ad(memhandle, &ad, BL_Heap, "MA_free_heap_piece"))
2207
(void)sprintf(ma_ebuf,
2208
"block '%s', invalid nelem: %ld",
2209
ad->name, (long)nelem);
2210
ma_error(EL_Nonfatal, ET_External, "MA_free_heap_piece", ma_ebuf);
2213
else if (nelem >= ad->nelem)
2215
/* deallocate the whole block */
2216
return MA_free_heap(memhandle);
2220
(void)printf("MA: freeing %ld elements of '%s'\n",
2221
(long)nelem, ad->name);
2223
/* set AR for data to keep */
2224
ar.datatype = ad->datatype;
2225
ar.nelem = ad->nelem - nelem;
2227
/* perform trial allocation to determine size */
2228
balloc_after(&ar, (Pointer)ad, &client_space, &nbytes);
2230
if (nbytes < ad->nbytes)
2232
/* ad has extra space; split block if possible */
2233
ad_reclaim = block_split(ad, nbytes, (Boolean)MA_FALSE);
2238
ma_stats.hbytes -= ad_reclaim->nbytes;
2241
/* reclaim the deallocated (new) block */
2242
block_free_heap(ad_reclaim);
2246
/* update surviving block */
2247
ad->nelem = ar.nelem;
2248
ad->checksum = checksum(ad);
2250
/* set the guards */
2261
/* ------------------------------------------------------------------------- */
2263
* Get the base index for the given block.
2265
* Return MA_TRUE upon success, or MA_FALSE upon failure.
2267
/* ------------------------------------------------------------------------- */
2269
public Boolean MA_get_index(
2270
Integer memhandle, /* block to get index for */
2271
MA_AccessIndex *index /* RETURN: base index */)
2273
AD *ad; /* AD for memhandle */
2276
ma_stats.calls[(int)FID_MA_get_index]++;
2280
if (ma_auto_verify && !MA_verify_allocator_stuff())
2284
/* verify memhandle and convert to AD */
2285
if (mh2ad(memhandle, &ad, BL_HeapOrStack, "MA_get_index"))
2288
*index = client_space_index(ad);
2300
/* ------------------------------------------------------------------------- */
2302
* Return the base address of the given datatype.
2304
/* ------------------------------------------------------------------------- */
2306
public Pointer MA_get_mbase(Integer datatype) /* to get base address of */
2309
ma_stats.calls[(int)FID_MA_get_mbase]++;
2312
/* preinitialize if necessary */
2313
ma_preinitialize("MA_get_mbase");
2315
/* verify datatype */
2316
if (!mt_valid(datatype))
2318
(void)sprintf(ma_ebuf,
2319
"invalid datatype: %ld",
2321
ma_error(EL_Fatal, ET_External, "MA_get_mbase", ma_ebuf);
2325
/* convert datatype to internal (index-suitable) value */
2326
datatype = mt_import(datatype);
2328
return ma_base[datatype];
2331
/* ------------------------------------------------------------------------- */
2333
* Get the handle for the next block in the scan of currently allocated
2336
* Return MA_TRUE upon success, or MA_FALSE upon failure.
2338
/* ------------------------------------------------------------------------- */
2340
public Boolean MA_get_next_memhandle(
2341
Integer *ithandle, /* handle for this iterator */
2342
Integer *memhandle /* RETURN: handle for the next block */)
2345
ma_stats.calls[(int)FID_MA_get_next_memhandle]++;
2349
if (ma_auto_verify && !MA_verify_allocator_stuff())
2353
/* not yet implemented */
2354
(void)sprintf(ma_ebuf,
2355
"not yet implemented");
2356
ma_error(EL_Nonfatal, ET_External, "MA_get_next_memhandle", ma_ebuf);
2360
/* ------------------------------------------------------------------------- */
2362
* Get the requested alignment.
2364
* Return MA_TRUE upon success, or MA_FALSE upon failure.
2366
/* ------------------------------------------------------------------------- */
2368
public Boolean MA_get_numalign(Integer *value)
2369
/* RETURN: requested alignment */
2372
ma_stats.calls[(int)FID_MA_get_numalign]++;
2375
*value = ma_numalign;
2379
/* ------------------------------------------------------------------------- */
2381
* Get the base pointer for the given block.
2383
* Return MA_TRUE upon success, or MA_FALSE upon failure.
2385
/* ------------------------------------------------------------------------- */
2387
/* JN converted to void* to avoid calling hassles */
2388
public Boolean MA_get_pointer(
2389
Integer memhandle, /* block to get pointer for */
2390
void *pointer /* RETURN: base pointer */)
2392
AD *ad; /* AD for memhandle */
2395
ma_stats.calls[(int)FID_MA_get_pointer]++;
2399
if (ma_auto_verify && !MA_verify_allocator_stuff())
2403
/* verify memhandle and convert to AD */
2404
if (mh2ad(memhandle, &ad, BL_HeapOrStack, "MA_get_pointer"))
2406
/* compute pointer */
2408
*pointer = ad->client_space;
2410
*(char**)pointer = ad->client_space;
2422
/* ------------------------------------------------------------------------- */
2424
* Initialize the memory allocator.
2426
* Return MA_TRUE upon success, or MA_FALSE upon failure.
2428
/* ------------------------------------------------------------------------- */
2430
public Boolean MA_init(
2431
Integer datatype, /* for computing storage requirement */
2432
Integer nominal_stack, /* # of datatype elements desired for stack */
2433
Integer nominal_heap /* # of datatype elements desired for heap */)
2435
ulongi heap_bytes; /* # of bytes for heap */
2436
ulongi stack_bytes; /* # of bytes for stack */
2437
ulongi total_bytes; /* total # of bytes */
2440
ma_stats.calls[(int)FID_MA_init]++;
2444
if (ma_auto_verify && !MA_verify_allocator_stuff())
2448
/* preinitialize if necessary */
2449
ma_preinitialize("MA_init");
2451
/* verify uninitialization */
2454
(void)sprintf(ma_ebuf,
2455
"MA already initialized");
2456
ma_error(EL_Nonfatal, ET_External, "MA_init", ma_ebuf);
2460
/* verify datatype */
2461
if (!mt_valid(datatype))
2463
(void)sprintf(ma_ebuf,
2464
"invalid datatype: %ld",
2466
ma_error(EL_Nonfatal, ET_External, "MA_init", ma_ebuf);
2470
/* convert datatype to internal (index-suitable) value */
2471
datatype = mt_import(datatype);
2473
/* compute # of bytes in heap */
2474
if (nominal_heap < 0)
2476
heap_bytes = DEFAULT_TOTAL_HEAP;
2480
heap_bytes = (nominal_heap * ma_sizeof[datatype]) +
2481
(DEFAULT_REQUESTS_HEAP * max_block_overhead(datatype));
2483
heap_bytes = (unsigned long)mai_round((long)heap_bytes, (ulongi)ALIGNMENT);
2485
/* compute # of bytes in stack */
2486
if (nominal_stack < 0)
2488
stack_bytes = DEFAULT_TOTAL_STACK;
2492
stack_bytes = (nominal_stack * ma_sizeof[datatype]) +
2493
(DEFAULT_REQUESTS_STACK * max_block_overhead(datatype));
2495
stack_bytes = (unsigned long)mai_round((long)stack_bytes, (ulongi)ALIGNMENT);
2497
/* segment consists of heap and stack */
2498
total_bytes = heap_bytes + stack_bytes;
2500
/* disable memory mapped malloc */
2501
mallopt(M_MMAP_MAX, 0);
2502
mallopt(M_TRIM_THRESHOLD, -1);
2504
/* allocate the segment of memory */
2505
#ifdef ENABLE_ARMCI_MEM_OPTION
2506
if(getenv("MA_USE_ARMCI_MEM"))
2508
ma_segment = (Pointer)ARMCI_Malloc_local(total_bytes);
2512
ma_segment = (Pointer)bytealloc(total_bytes);
2513
if (ma_segment == (Pointer)NULL)
2515
(void)sprintf(ma_ebuf,
2516
"could not allocate %lu bytes",
2518
ma_error(EL_Nonfatal, ET_External, "MA_init", ma_ebuf);
2523
* initialize management stuff
2526
/* partition is at (first address past) end of heap */
2527
ma_partition = ma_segment + heap_bytes;
2528
/* compute (first address past) end of segment */
2529
ma_eos = ma_segment + total_bytes;
2530
/* ma_hp initially points at start of segment */
2532
/* ma_sp initially points at end of segment */
2535
/* lists are all initially empty */
2536
ma_hfree = (AD *)NULL;
2537
ma_hused = (AD *)NULL;
2538
ma_sused = (AD *)NULL;
2540
/* we are now initialized */
2541
ma_initialized = MA_TRUE;
2547
/* ------------------------------------------------------------------------- */
2549
* Return MA_TRUE if MA_init has been called successfully,
2550
* else return MA_FALSE.
2552
/* ------------------------------------------------------------------------- */
2554
public Boolean MA_initialized()
2557
ma_stats.calls[(int)FID_MA_initialized]++;
2560
return ma_initialized;
2563
/* ------------------------------------------------------------------------- */
2565
* Initialize a scan of currently allocated blocks.
2567
* Return MA_TRUE upon success, or MA_FALSE upon failure.
2569
/* ------------------------------------------------------------------------- */
2571
public Boolean MA_init_memhandle_iterator( Integer *ithandle)
2574
ma_stats.calls[(int)FID_MA_init_memhandle_iterator]++;
2578
if (ma_auto_verify && !MA_verify_allocator_stuff())
2582
/* not yet implemented */
2583
(void)sprintf(ma_ebuf,
2584
"not yet implemented");
2585
ma_error(EL_Nonfatal, ET_External, "MA_init_memhandle_iterator", ma_ebuf);
2589
/* ------------------------------------------------------------------------- */
2591
* Return the maximum number of datatype elements that can currently
2592
* be allocated in the space between the heap and the stack, in a single
2593
* allocation request, ignoring the partition defined at initialization.
2595
* Note that this might not be the largest piece of memory available;
2596
* the heap may contain deallocated blocks that are larger.
2598
/* ------------------------------------------------------------------------- */
2600
public Integer MA_inquire_avail(Integer datatype)
2602
long gap_length; /* # of bytes between heap and stack */
2603
Integer nelem_gap; /* max elements containable in gap */
2606
ma_stats.calls[(int)FID_MA_inquire_avail]++;
2610
if (ma_auto_verify && !MA_verify_allocator_stuff())
2614
/* verify initialization */
2615
if (!ma_initialized)
2617
(void)sprintf(ma_ebuf,
2618
"MA not yet initialized");
2619
ma_error(EL_Nonfatal, ET_External, "MA_inquire_avail", ma_ebuf);
2623
/* verify datatype */
2624
if (!mt_valid(datatype))
2626
(void)sprintf(ma_ebuf,
2627
"invalid datatype: %ld",
2629
ma_error(EL_Fatal, ET_External, "MA_inquire_avail", ma_ebuf);
2633
/* convert datatype to internal (index-suitable) value */
2634
datatype = mt_import(datatype);
2637
* compute the # of elements for which space is available
2640
/* try space between heap and stack */
2641
gap_length = (long)(ma_sp - ma_hp);
2643
nelem_gap = ma_nelem(ma_hp, (ulongi)gap_length, datatype);
2651
/* ------------------------------------------------------------------------- */
2653
* Return the maximum number of datatype elements that can currently
2654
* be allocated in the heap, in a single allocation request,
2655
* honoring the partition defined at initialization.
2657
* This routine does not check the stack. Therefore, if the stack
2658
* has overgrown the partition, the answer returned by this routine
2659
* might be incorrect, i.e., there might be less memory available
2660
* than this routine indicates.
2662
/* ------------------------------------------------------------------------- */
2664
public Integer MA_inquire_heap(Integer datatype)
2666
long gap_length; /* # of bytes between heap and partition */
2667
Integer nelem_gap; /* max elements containable in gap */
2668
Integer nelem_frag; /* max elements containable in any frag */
2671
ma_stats.calls[(int)FID_MA_inquire_heap]++;
2675
if (ma_auto_verify && !MA_verify_allocator_stuff())
2679
/* verify initialization */
2680
if (!ma_initialized)
2682
(void)sprintf(ma_ebuf,
2683
"MA not yet initialized");
2684
ma_error(EL_Nonfatal, ET_External, "MA_inquire_heap", ma_ebuf);
2688
/* verify datatype */
2689
if (!mt_valid(datatype))
2691
(void)sprintf(ma_ebuf,
2692
"invalid datatype: %ld",
2694
ma_error(EL_Fatal, ET_External, "MA_inquire_heap", ma_ebuf);
2698
/* convert datatype to internal (index-suitable) value */
2699
datatype = mt_import(datatype);
2702
* compute the # of elements for which space is available
2705
/* try space between heap and partition */
2706
gap_length = (long)(ma_partition - ma_hp);
2708
nelem_gap = ma_nelem(ma_hp, (ulongi)gap_length, datatype);
2712
/* try heap fragments */
2713
nelem_frag = ma_max_heap_frag_nelem(datatype, nelem_gap);
2716
return max(nelem_gap, nelem_frag);
2719
/* ------------------------------------------------------------------------- */
2721
* Return the maximum number of datatype elements that can currently
2722
* be allocated in the heap, in a single allocation request,
2723
* honoring the partition defined at initialization.
2725
* This routine does check the stack. Therefore, whether or not the stack
2726
* has overgrown the partition, the answer returned by this routine
2727
* will be correct, i.e., there will be at least the memory available
2728
* that this routine indicates.
2730
* Note that this might not be the largest piece of memory available;
2731
* the space between the heap and the stack may be larger.
2733
/* ------------------------------------------------------------------------- */
2735
public Integer MA_inquire_heap_check_stack(Integer datatype)
2737
long gap_length; /* # of bytes between heap and partition */
2738
Integer nelem_gap; /* max elements containable in gap */
2739
Integer nelem_frag; /* max elements containable in any frag */
2742
ma_stats.calls[(int)FID_MA_inquire_heap_check_stack]++;
2746
if (ma_auto_verify && !MA_verify_allocator_stuff())
2750
/* verify initialization */
2751
if (!ma_initialized)
2753
(void)sprintf(ma_ebuf,
2754
"MA not yet initialized");
2755
ma_error(EL_Nonfatal, ET_External, "MA_inquire_heap_check_stack", ma_ebuf);
2759
/* verify datatype */
2760
if (!mt_valid(datatype))
2762
(void)sprintf(ma_ebuf,
2763
"invalid datatype: %ld",
2765
ma_error(EL_Fatal, ET_External, "MA_inquire_heap_check_stack", ma_ebuf);
2769
/* convert datatype to internal (index-suitable) value */
2770
datatype = mt_import(datatype);
2773
* compute the # of elements for which space is available
2776
/* try space between heap and partition or heap and stack */
2777
gap_length = min((long)(ma_partition - ma_hp), (long)(ma_sp - ma_hp));
2779
nelem_gap = ma_nelem(ma_hp, (ulongi)gap_length, datatype);
2783
/* try heap fragments */
2784
nelem_frag = ma_max_heap_frag_nelem(datatype, nelem_gap);
2787
return max(nelem_gap, nelem_frag);
2790
/* ------------------------------------------------------------------------- */
2792
* Return the maximum number of datatype elements that can currently
2793
* be allocated in the heap, in a single allocation request,
2794
* ignoring the partition defined at initialization.
2796
* This routine does check the stack. Therefore, whether or not the stack
2797
* has overgrown the partition, the answer returned by this routine
2798
* will be correct, i.e., there will be at least the memory available
2799
* that this routine indicates.
2801
* Note that this will be the largest piece of memory available.
2803
/* ------------------------------------------------------------------------- */
2805
public Integer MA_inquire_heap_no_partition(Integer datatype)
2807
long gap_length; /* # of bytes between heap and partition */
2808
Integer nelem_gap; /* max elements containable in gap */
2809
Integer nelem_frag; /* max elements containable in any frag */
2812
ma_stats.calls[(int)FID_MA_inquire_heap_no_partition]++;
2816
if (ma_auto_verify && !MA_verify_allocator_stuff())
2820
/* verify initialization */
2821
if (!ma_initialized)
2823
(void)sprintf(ma_ebuf,
2824
"MA not yet initialized");
2825
ma_error(EL_Nonfatal, ET_External, "MA_inquire_heap_no_partition", ma_ebuf);
2829
/* verify datatype */
2830
if (!mt_valid(datatype))
2832
(void)sprintf(ma_ebuf,
2833
"invalid datatype: %ld",
2835
ma_error(EL_Fatal, ET_External, "MA_inquire_heap_no_partition", ma_ebuf);
2839
/* convert datatype to internal (index-suitable) value */
2840
datatype = mt_import(datatype);
2843
* compute the # of elements for which space is available
2846
/* try space between heap and stack */
2847
gap_length = (long)(ma_sp - ma_hp);
2849
nelem_gap = ma_nelem(ma_hp, (ulongi)gap_length, datatype);
2853
/* try heap fragments */
2854
nelem_frag = ma_max_heap_frag_nelem(datatype, nelem_gap);
2857
return max(nelem_gap, nelem_frag);
2860
/* ------------------------------------------------------------------------- */
2862
* Return the maximum number of datatype elements that can currently
2863
* be allocated in the stack, in a single allocation request,
2864
* honoring the partition defined at initialization.
2866
* This routine does not check the heap. Therefore, if the heap
2867
* has overgrown the partition, the answer returned by this routine
2868
* might be incorrect, i.e., there might be less memory available
2869
* than this routine indicates.
2871
/* ------------------------------------------------------------------------- */
2873
public Integer MA_inquire_stack(Integer datatype)
2875
long gap_length; /* # of bytes between partition and stack */
2876
Integer nelem_gap; /* max elements containable in gap */
2879
ma_stats.calls[(int)FID_MA_inquire_stack]++;
2883
if (ma_auto_verify && !MA_verify_allocator_stuff())
2887
/* verify initialization */
2888
if (!ma_initialized)
2890
(void)sprintf(ma_ebuf,
2891
"MA not yet initialized");
2892
ma_error(EL_Nonfatal, ET_External, "MA_inquire_stack", ma_ebuf);
2896
/* verify datatype */
2897
if (!mt_valid(datatype))
2899
(void)sprintf(ma_ebuf,
2900
"invalid datatype: %ld",
2902
ma_error(EL_Fatal, ET_External, "MA_inquire_stack", ma_ebuf);
2906
/* convert datatype to internal (index-suitable) value */
2907
datatype = mt_import(datatype);
2910
* compute the # of elements for which space is available
2913
/* try space between partition and stack */
2914
gap_length = (long)(ma_sp - ma_partition);
2916
nelem_gap = ma_nelem(ma_partition, (ulongi)gap_length, datatype);
2924
/* ------------------------------------------------------------------------- */
2926
* Return the maximum number of datatype elements that can currently
2927
* be allocated in the stack, in a single allocation request,
2928
* honoring the partition defined at initialization.
2930
* This routine does check the heap. Therefore, whether or not the heap
2931
* has overgrown the partition, the answer returned by this routine
2932
* will be correct, i.e., there will be at least the memory available
2933
* that this routine indicates.
2935
* Note that this might not be the largest piece of memory available;
2936
* the space between the heap and the stack may be larger.
2938
/* ------------------------------------------------------------------------- */
2940
public Integer MA_inquire_stack_check_heap(Integer datatype)
2942
long gap_length; /* # of bytes between partition and stack */
2943
Integer nelem_gap; /* max elements containable in gap */
2946
ma_stats.calls[(int)FID_MA_inquire_stack_check_heap]++;
2950
if (ma_auto_verify && !MA_verify_allocator_stuff())
2954
/* verify initialization */
2955
if (!ma_initialized)
2957
(void)sprintf(ma_ebuf,
2958
"MA not yet initialized");
2959
ma_error(EL_Nonfatal, ET_External, "MA_inquire_stack_check_heap", ma_ebuf);
2963
/* verify datatype */
2964
if (!mt_valid(datatype))
2966
(void)sprintf(ma_ebuf,
2967
"invalid datatype: %ld",
2969
ma_error(EL_Fatal, ET_External, "MA_inquire_stack_check_heap", ma_ebuf);
2973
/* convert datatype to internal (index-suitable) value */
2974
datatype = mt_import(datatype);
2977
* compute the # of elements for which space is available
2980
/* try space between partition and stack or heap and stack */
2981
gap_length = min((long)(ma_sp - ma_partition), (long)(ma_sp - ma_hp));
2983
nelem_gap = ma_nelem(ma_partition, (ulongi)gap_length, datatype);
2991
/* ------------------------------------------------------------------------- */
2993
* Return the maximum number of datatype elements that can currently
2994
* be allocated in the stack, in a single allocation request,
2995
* ignoring the partition defined at initialization.
2997
* This routine does check the heap. Therefore, whether or not the heap
2998
* has overgrown the partition, the answer returned by this routine
2999
* will be correct, i.e., there will be at least the memory available
3000
* that this routine indicates.
3002
* Note that this might not be the largest piece of memory available;
3003
* the heap may contain deallocated blocks that are larger.
3005
* This routine is equivalent to MA_inquire_avail.
3007
/* ------------------------------------------------------------------------- */
3009
public Integer MA_inquire_stack_no_partition(Integer datatype)
3011
long gap_length; /* # of bytes between heap and partition */
3012
Integer nelem_gap; /* max elements containable in gap */
3015
ma_stats.calls[(int)FID_MA_inquire_stack_no_partition]++;
3019
if (ma_auto_verify && !MA_verify_allocator_stuff())
3023
/* verify initialization */
3024
if (!ma_initialized)
3026
(void)sprintf(ma_ebuf,
3027
"MA not yet initialized");
3028
ma_error(EL_Nonfatal, ET_External, "MA_inquire_stack_no_partition", ma_ebuf);
3032
/* verify datatype */
3033
if (!mt_valid(datatype))
3035
(void)sprintf(ma_ebuf,
3036
"invalid datatype: %ld",
3038
ma_error(EL_Fatal, ET_External, "MA_inquire_stack_no_partition", ma_ebuf);
3042
/* convert datatype to internal (index-suitable) value */
3043
datatype = mt_import(datatype);
3046
* compute the # of elements for which space is available
3049
/* try space between heap and stack */
3050
gap_length = (long)(ma_sp - ma_hp);
3052
nelem_gap = ma_nelem(ma_hp, (ulongi)gap_length, datatype);
3060
/* ------------------------------------------------------------------------- */
3062
* Deallocate the given stack block, which must be the one most recently
3065
* Return MA_TRUE upon success, or MA_FALSE upon failure.
3067
/* ------------------------------------------------------------------------- */
3069
public Boolean MA_pop_stack(Integer memhandle) /* the block to deallocate */
3071
AD *ad; /* AD for memhandle */
3074
ma_stats.calls[(int)FID_MA_pop_stack]++;
3078
if (ma_auto_verify && !MA_verify_allocator_stuff())
3082
/* verify memhandle and convert to AD */
3083
if (!mh2ad(memhandle, &ad, BL_StackTop, "MA_pop_stack"))
3087
(void)printf("MA: popping '%s'\n", ad->name);
3089
/* delete block from used list */
3090
if (list_delete(ad, &ma_sused) != ad)
3092
(void)sprintf(ma_ebuf,
3093
"memhandle %ld (name: '%s') not on stack used list",
3094
(long)memhandle, ad->name);
3095
ma_error(EL_Nonfatal, ET_Internal, "MA_pop_stack", ma_ebuf);
3099
/* pop block from stack */
3100
ma_sp += ad->nbytes;
3104
ma_stats.sbytes -= ad->nbytes;
3107
/* free memhandle */
3108
ma_table_deallocate(memhandle);
3114
/* ------------------------------------------------------------------------- */
3116
* Print usage statistics.
3118
/* ------------------------------------------------------------------------- */
3120
public void MA_print_stats(Boolean printroutines)
3124
int i; /* loop index */
3127
ma_stats.calls[(int)FID_MA_print_stats]++;
3131
if (ma_auto_verify && !MA_verify_allocator_stuff())
3135
(void)printf("MA usage statistics:\n");
3136
(void)printf("\n\tallocation statistics:\n");
3137
(void)printf("\t\t\t\t\t heap\t stack\n");
3138
(void)printf("\t\t\t\t\t ----\t -----\n");
3139
(void)printf("\tcurrent number of blocks\t%10lu\t%10lu\n",
3142
(void)printf("\tmaximum number of blocks\t%10lu\t%10lu\n",
3143
ma_stats.hblocks_max,
3144
ma_stats.sblocks_max);
3145
(void)printf("\tcurrent total bytes\t\t%10lu\t%10lu\n",
3148
(void)printf("\tmaximum total bytes\t\t%10lu\t%10lu\n",
3149
ma_stats.hbytes_max,
3150
ma_stats.sbytes_max);
3151
(void)printf("\tmaximum total K-bytes\t\t%10lu\t%10lu\n",
3152
((ma_stats.hbytes_max+999)/1000),
3153
((ma_stats.sbytes_max+999)/1000));
3154
(void)printf("\tmaximum total M-bytes\t\t%10lu\t%10lu\n",
3155
((ma_stats.hbytes_max+999999)/1000000),
3156
((ma_stats.sbytes_max+999999)/1000000));
3159
(void)printf("\n\tcalls per routine:\n");
3160
for (i = 0; i < NUMROUTINES; i++)
3161
(void)printf("\t\t%10lu %s\n",
3168
(void)sprintf(ma_ebuf,
3169
"unavailable; recompile MA with -DSTATS");
3170
ma_error(EL_Nonfatal, ET_External, "MA_print_stats", ma_ebuf);
3175
/* ------------------------------------------------------------------------- */
3177
* Convenience function that combines MA_push_stack and MA_get_index.
3179
/* ------------------------------------------------------------------------- */
3181
public Boolean MA_push_get(
3182
Integer datatype, /* of elements in this block */
3183
Integer nelem, /* # of elements in this block */
3184
const char *name, /* assigned to this block by client */
3185
Integer *memhandle, /* RETURN: handle for this block */
3186
MA_AccessIndex *index /* RETURN: index for this block */)
3189
ma_stats.calls[(int)FID_MA_push_get]++;
3192
if (MA_push_stack(datatype, nelem, name, memhandle))
3193
/* MA_push_stack succeeded; try MA_get_index */
3194
return MA_get_index(*memhandle, index);
3196
/* MA_push_stack failed */
3200
/* ------------------------------------------------------------------------- */
3202
* Allocate a stack block big enough to hold nelem elements
3203
* of the given datatype.
3205
* Return MA_TRUE upon success, or MA_FALSE upon failure.
3207
/* ------------------------------------------------------------------------- */
3209
public Boolean MA_push_stack(
3210
Integer datatype, /* of elements in this block */
3211
Integer nelem, /* # of elements in this block */
3212
const char *name, /* assigned to this block by client */
3213
Integer *memhandle /* RETURN: handle for this block */)
3215
AR ar; /* allocation request */
3216
AD *ad; /* AD for newly allocated block */
3217
Pointer client_space; /* location of client_space */
3218
ulongi nbytes; /* length of block for ar */
3219
Pointer new_sp; /* new ma_sp */
3222
ma_stats.calls[(int)FID_MA_push_stack]++;
3226
if (ma_auto_verify && !MA_verify_allocator_stuff())
3231
(void)printf("MA: pushing '%s' (%d)\n", name, (int)nelem);
3233
/* verify initialization */
3234
if (!ma_initialized)
3236
(void)sprintf(ma_ebuf,
3237
"block '%s', MA not yet initialized",
3239
ma_error(EL_Nonfatal, ET_External, "MA_push_stack", ma_ebuf);
3243
/* verify datatype */
3244
if (!mt_valid(datatype))
3246
(void)sprintf(ma_ebuf,
3247
"block '%s', invalid datatype: %ld",
3248
name, (long)datatype);
3249
ma_error(EL_Nonfatal, ET_External, "MA_push_stack", ma_ebuf);
3256
(void)sprintf(ma_ebuf,
3257
"block '%s', invalid nelem: %ld",
3259
ma_error(EL_Nonfatal, ET_External, "MA_push_stack", ma_ebuf);
3263
/* convert datatype to internal (index-suitable) value */
3264
datatype = mt_import(datatype);
3267
* attempt to allocate space
3270
ar.datatype = datatype;
3273
balloc_before(&ar, ma_sp, &client_space, &nbytes);
3275
new_sp = ma_sp - nbytes;
3276
/* if (new_sp < ma_hp) */
3277
if (((ulongi)(ma_sp - ma_hp)) < nbytes)
3279
(void)sprintf(ma_ebuf,
3280
"block '%s', not enough space to allocate %lu bytes",
3282
ma_error(EL_Nonfatal, ET_External, "MA_push_stack", ma_ebuf);
3291
* space has been allocated
3294
/* initialize the AD */
3295
ad->datatype = datatype;
3297
str_ncopy(ad->name, (char*)name, MA_NAMESIZE);
3298
ad->client_space = client_space;
3299
ad->nbytes = nbytes;
3300
list_insert(ad, &ma_sused);
3301
ad->checksum = checksum(ad);
3303
/* set the guards */
3315
ma_stats.sblocks_max = max(ma_stats.sblocks, ma_stats.sblocks_max);
3316
ma_stats.sbytes += ad->nbytes;
3317
ma_stats.sbytes_max = max(ma_stats.sbytes, ma_stats.sbytes_max);
3320
/* convert AD to memhandle */
3321
if ((*memhandle = ma_table_allocate((TableData)ad)) == TABLE_HANDLE_NONE)
3329
/* ------------------------------------------------------------------------- */
3331
* Set the ma_auto_verify flag to value and return its previous value.
3333
/* ------------------------------------------------------------------------- */
3335
public Boolean MA_set_auto_verify(Boolean value /* to set flag to */)
3337
Boolean old_value; /* of flag */
3340
ma_stats.calls[(int)FID_MA_set_auto_verify]++;
3343
old_value = ma_auto_verify;
3344
ma_auto_verify = value;
3348
/* ------------------------------------------------------------------------- */
3350
* Set the ma_error_print flag to value and return its previous value.
3352
/* ------------------------------------------------------------------------- */
3354
public Boolean MA_set_error_print(Boolean value /* to set flag to */)
3356
Boolean old_value; /* of flag */
3359
ma_stats.calls[(int)FID_MA_set_error_print]++;
3362
old_value = ma_error_print;
3363
ma_error_print = value;
3367
/* ------------------------------------------------------------------------- */
3369
* Set the ma_hard_fail flag to value and return its previous value.
3371
/* ------------------------------------------------------------------------- */
3373
public Boolean MA_set_hard_fail( Boolean value /* to set flag to */)
3375
Boolean old_value; /* of flag */
3378
ma_stats.calls[(int)FID_MA_set_hard_fail]++;
3381
old_value = ma_hard_fail;
3382
ma_hard_fail = value;
3386
/* ------------------------------------------------------------------------- */
3388
* Set the requested alignment.
3390
* Return MA_TRUE upon success, or MA_FALSE upon failure.
3392
/* ------------------------------------------------------------------------- */
3394
public Boolean MA_set_numalign(Integer value)
3397
ma_stats.calls[(int)FID_MA_set_numalign]++;
3400
if ((value < 0) || (value > 30))
3402
(void)sprintf(ma_ebuf,
3403
"invalid alignment: %ld",
3405
ma_error(EL_Nonfatal, ET_External, "MA_set_numalign", ma_ebuf);
3408
ma_numalign = value;
3412
/* ------------------------------------------------------------------------- */
3414
* Return the number of elements of datatype2 required to contain
3415
* nelem1 elements of datatype1.
3417
/* ------------------------------------------------------------------------- */
3419
public Integer MA_sizeof(
3420
Integer datatype1, /* of source elements */
3421
Integer nelem1, /* # of source elements */
3422
Integer datatype2 /* of target elements */)
3424
ulongi source_bytes; /* nelem1 * ma_sizeof[datatype1] */
3425
int ceiling; /* 1 iff ceiling alters result */
3428
ma_stats.calls[(int)FID_MA_sizeof]++;
3432
if (ma_auto_verify && !MA_verify_allocator_stuff())
3436
/* preinitialize if necessary */
3437
ma_preinitialize("MA_sizeof");
3439
/* verify datatype1 */
3440
if (!mt_valid(datatype1))
3442
(void)sprintf(ma_ebuf,
3443
"invalid datatype: %ld",
3445
ma_error(EL_Fatal, ET_External, "MA_sizeof", ma_ebuf);
3452
(void)sprintf(ma_ebuf,
3453
"invalid nelem: %ld",
3455
ma_error(EL_Fatal, ET_External, "MA_sizeof", ma_ebuf);
3459
/* verify datatype2 */
3460
if (!mt_valid(datatype2))
3462
(void)sprintf(ma_ebuf,
3463
"invalid datatype: %ld",
3465
ma_error(EL_Fatal, ET_External, "MA_sizeof", ma_ebuf);
3469
/* convert datatype1 to internal (index-suitable) value */
3470
datatype1 = mt_import(datatype1);
3472
/* convert datatype2 to internal (index-suitable) value */
3473
datatype2 = mt_import(datatype2);
3475
/* compute and return the result */
3476
source_bytes = nelem1 * ma_sizeof[datatype1];
3477
ceiling = (source_bytes % ma_sizeof[datatype2]) ? 1 : 0;
3478
return (Integer)((source_bytes / ma_sizeof[datatype2]) + ceiling);
3481
/* ------------------------------------------------------------------------- */
3483
* Return the number of elements of datatype required to contain
3484
* the worst case number of bytes of overhead for any block.
3486
/* ------------------------------------------------------------------------- */
3488
public Integer MA_sizeof_overhead(Integer datatype)
3490
int overhead_bytes; /* max bytes of overhead for any block */
3491
int ceiling; /* 1 iff ceiling alters result */
3492
int max_sizeof; /* max over i of ma_sizeof[i] */
3493
int biggest_datatype=0; /* corresponds to max_sizeof */
3494
int i; /* loop index */
3497
ma_stats.calls[(int)FID_MA_sizeof_overhead]++;
3501
if (ma_auto_verify && !MA_verify_allocator_stuff())
3505
/* preinitialize if necessary */
3506
ma_preinitialize("MA_sizeof_overhead");
3508
/* verify datatype */
3509
if (!mt_valid(datatype))
3511
(void)sprintf(ma_ebuf,
3512
"invalid datatype: %ld",
3514
ma_error(EL_Fatal, ET_External, "MA_sizeof_overhead", ma_ebuf);
3518
/* convert datatype to internal (index-suitable) value */
3519
datatype = mt_import(datatype);
3521
/* compute and return the result */
3522
for (max_sizeof = 0, i = 0; i < MT_NUMTYPES; i++)
3523
if (ma_sizeof[i] > max_sizeof)
3525
max_sizeof = ma_sizeof[i];
3526
biggest_datatype = i;
3528
overhead_bytes = max_block_overhead(biggest_datatype);
3529
ceiling = (overhead_bytes % ma_sizeof[datatype]) ? 1 : 0;
3530
return (Integer)((overhead_bytes / ma_sizeof[datatype]) + ceiling);
3533
/* ------------------------------------------------------------------------- */
3535
* Print debugging information about all blocks currently in use
3536
* on the heap or the stack.
3538
/* ------------------------------------------------------------------------- */
3540
public void MA_summarize_allocated_blocks()
3542
/* C indices are 0-based */
3543
MAi_summarize_allocated_blocks(0);
3546
/* ------------------------------------------------------------------------- */
3548
* Control tracing of allocation and deallocation operations.
3550
/* ------------------------------------------------------------------------- */
3552
public void MA_trace(Boolean value)
3557
/* ------------------------------------------------------------------------- */
3559
* Sanity check the internal state of MA and print the results.
3561
* Return MA_TRUE upon success, or MA_FALSE upon failure.
3563
/* ------------------------------------------------------------------------- */
3565
public Boolean MA_verify_allocator_stuff()
3569
char *preamble; /* printed before block error messages */
3572
int bad_heap_blocks;
3573
int bad_heap_checksums;
3574
int bad_heap_lguards;
3575
int bad_heap_rguards;
3577
int bad_stack_blocks;
3578
int bad_stack_checksums;
3579
int bad_stack_lguards;
3580
int bad_stack_rguards;
3583
ma_stats.calls[(int)FID_MA_verify_allocator_stuff]++;
3586
preamble = "MA_verify_allocator_stuff: starting scan ...\n";
3588
/* check each block on the heap used list */
3589
list_verify(ma_hused,
3594
&bad_heap_checksums,
3598
if (bad_heap_blocks > 0)
3599
/* only print preamble once */
3600
preamble = (char *)NULL;
3602
/* check each block on the stack used list */
3603
list_verify(ma_sused,
3608
&bad_stack_checksums,
3610
&bad_stack_rguards);
3612
if ((bad_heap_blocks > 0) || (bad_stack_blocks > 0))
3614
Boolean old_ma_error_print;
3616
/* print postamble */
3617
(void)printf("MA_verify_allocator_stuff: scan completed\n");
3619
/* construct a summary of the results */
3620
(void)sprintf(ma_ebuf, "\n\t\t\t\theap\tstack\n\t\t\t\t----\t-----\n\tchecksum errors\t\t%4d\t%5d\n\tleft signature errors\t%4d\t%5d\n\tright signature errors\t%4d\t%5d\n\ttotal bad blocks\t%4d\t%5d\n\ttotal blocks\t\t%4d\t%5d",
3622
bad_stack_checksums,
3632
/* print the summary on stderr */
3633
old_ma_error_print = ma_error_print;
3634
ma_error_print = MA_TRUE;
3635
ma_error(EL_Nonfatal, ET_External, "MA_verify_allocator_stuff", ma_ebuf);
3636
ma_error_print = old_ma_error_print;
3638
/* problems were found */
3642
/* no problems found */
3648
ma_stats.calls[(int)FID_MA_verify_allocator_stuff]++;
3651
(void)sprintf(ma_ebuf,
3652
"unavailable; recompile MA with -DVERIFY");
3653
ma_error(EL_Nonfatal, ET_External, "MA_verify_allocator_stuff", ma_ebuf);
added
removed
src/tools/ga-5-2/ma/ma.c
