1 #if HAVE_CONFIG_H
2 # include "config.h"
3 #endif
4
5 /*
6 * Portable dynamic memory allocator.
7 */
8
9 #if HAVE_STDIO_H
10 # include <stdio.h>
11 #endif
12 #if HAVE_STDLIB_H
13 # include <stdlib.h>
14 #endif
15 #if HAVE_STRING_H
16 # include <string.h>
17 #endif
18 #if HAVE_MALLOC_H
19 # include <malloc.h>
20 #endif
21 #include "error.h"
22 #include "farg.h"
23 #include "ma.h"
24 #include "memcpy.h"
25 #include "scope.h"
26 #include "table.h"
27
28 #ifdef ENABLE_ARMCI_MEM_OPTION
29 extern void* ARMCI_Malloc_local(long bytes);
30 #endif
31
32 /*
33 * Memory layout:
34 *
35 * segment = heap_region stack_region
36 * region = block block block ...
37 * block = AD gap1 guard1 client_space guard2 gap2
38 *
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.
44 *
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
53 * the unused space.
54 *
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).
62 */
63
64 /**
65 ** constants
66 **/
67
68 /* return value for returns that should never execute */
69 #define DONTCARE (Integer)0
70
71 /* default total # of bytes */
72 #define DEFAULT_TOTAL_HEAP 524288 /* 2^19 */
73 #define DEFAULT_TOTAL_STACK 524288 /* 2^19 */
74
75 /* estimate of max # of outstanding allocation requests */
76 #define DEFAULT_REQUESTS_HEAP 1
77 #define DEFAULT_REQUESTS_STACK 1
78
79 /* bytes per address */
80 #define BPA 1
81
82 /* per-allocation storage overhead, excluding alignment gaps */
83 #define BLOCK_OVERHEAD_FIXED (sizeof(AD) + (2 * sizeof(Guard)))
84
85 /* block lengths are integral multiples of this */
86 /*
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.
97 */
98 #if defined(BGQ)
99 #define ALIGNMENT 32
100 #else
101 #define ALIGNMENT sizeof(size_t)
102 #endif
103
104 /* min size of block split and placed on free list */
105 #define MINBLOCKSIZE mai_round((size_t)(ALIGNMENT + BLOCK_OVERHEAD_FIXED), \
106 (ulongi)ALIGNMENT)
107
108 /* signatures for guard words */
109 #define GUARD1 (Guard)0xaaaaaaaa /* start signature */
110 #define GUARD2 (Guard)0x55555555 /* stop signature */
111
112 /**
113 ** types
114 **/
115
116 typedef unsigned int Guard; /* for detection of memory trashing */
117 typedef size_t ulongi; /* for brevity */
118
119 /* allocation request for a block */
120 typedef struct _AR
121 {
122 Integer datatype; /* of elements */
123 Integer nelem; /* # of elements */
124 } AR;
125
126 /* allocation descriptor for a block */
127 typedef struct _AD
128 {
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 */
136 } AD;
137
138 /* block location for mh2ad */
139 typedef enum
140 {
141 BL_HeapOrStack,
142 BL_Heap,
143 BL_Stack,
144 BL_StackTop
145 } BlockLocation;
146
147 /**
148 ** function types
149 **/
150
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);
162
163 #ifdef DEBUG
164 private void debug_ad_print(AD *ad);
165 #endif /* DEBUG */
166
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 size_t mai_round(size_t value, ulongi unit);
184 private void str_ncopy(char *to, char *from, int maxchars);
185
186 /* foreign routines */
187
188 extern Integer ma_set_sizes_(); /* from the MA FORTRAN interface */
189
190 /**
191 ** variables
192 **/
193
194 /* base addresses of the datatypes */
195 private Pointer ma_base[] =
196 {
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 */
206 0, /* MT_F_BYTE */
207 0, /* MT_F_INT */
208 0, /* MT_F_LOG */
209 0, /* MT_F_REAL */
210 0, /* MT_F_DBL */
211 0, /* MT_F_SCPL */
212 0, /* MT_F_DCPL */
213 (Pointer)ma_cb_longlong /* MT_C_LONGLONG */
214 };
215
216 /* names of the datatypes */
217 private char *ma_datatype[] =
218 {
219 "char",
220 "int",
221 "long int",
222 "float",
223 "double",
224 "long double",
225 "single precision complex",
226 "double precision complex",
227 "long double precision complex",
228 "byte",
229 "integer",
230 "logical",
231 "real",
232 "double precision",
233 "single precision complex",
234 "double precision complex",
235 "long long"
236 };
237
238 /* numbers of bytes in the datatypes */
239 private int ma_sizeof[] =
240 {
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 */
250 0, /* MT_F_BYTE */
251 0, /* MT_F_INT */
252 0, /* MT_F_LOG */
253 0, /* MT_F_REAL */
254 0, /* MT_F_DBL */
255 0, /* MT_F_SCPL */
256 0, /* MT_F_DCPL */
257 sizeof(long long) /* MT_C_LONGLONG */
258 };
259
260 /*
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.
268 *
269 * ................................................
270 * ^ ^ ^
271 * ma_segment, ma_hp ma_partition ma_eos, ma_sp
272 *
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.
275 *
276 * hhhhhhhhhhhhhhhh.....................sssssssssss
277 * ^ ^ ^ ^ ^
278 * ma_segment ma_hp ma_partition ma_sp ma_eos
279 */
280
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 */
286
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 */
290
291 /* toggled when ma_preinitialize succeeds */
292 private Boolean ma_preinitialized = MA_FALSE;
293
294 /* toggled when MA_init succeeds */
295 private Boolean ma_initialized = MA_FALSE;
296
297 /* invoke MA_verify_allocator_stuff in each public routine? */
298 private Boolean ma_auto_verify = MA_FALSE;
299
300 /* print push/pop/alloc/free? */
301 private Boolean ma_trace = MA_FALSE;
302
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 */
314
315 #if NOFORT
316 public Integer ma_fb_byte[2];
317 public Integer ma_fb_integer[2];
318 public Logical ma_fb_logical[2];
319 public Real ma_fb_real[2];
320 public DoublePrecision ma_fb_dbl[2];
321 public SingleComplex ma_fb_scpl[2];
322 public DoubleComplex ma_fb_dcpl[2];
323 #endif
324
325 /* requested power-of-two alignment */
326 private Integer ma_numalign = 0;
327
328 /**
329 ** macros
330 **/
331
332 /* minimum of two values */
333 #ifdef min
334 #undef min
335 #endif
336 #define min(a, b) (((b) < (a)) ? (b) : (a))
337
338 /* maximum of two values */
339 #ifdef max
340 #undef max
341 #endif
342 #define max(a, b) (((b) > (a)) ? (b) : (a))
343
344 /* proper word ending corresponding to n */
345 #define plural(n) (((n) == 1) ? "" : "s")
346
347 /* convert between internal and external datatype values */
348 #define mt_import(d) ((d) - MT_BASE)
349 #define mt_export(d) ((d) + MT_BASE)
350
351 /* return nonzero if d is a valid (external) datatype */
352 #define mt_valid(d) (((d) >= MT_FIRST) && ((d) <= MT_LAST))
353
354 /* convert between pointer (address) and equivalent byte address */
355 #define p2b(p) ((ulongi)(p) * BPA)
356 #define b2p(b) ((Pointer)((b) / BPA))
357
358 /* return nonzero if a is a potentially valid address */
359 #define reasonable_address(a) (((a) >= ma_segment) && ((a) < ma_eos))
360
361 /* worst case bytes of overhead for any block of elements of datatype d */
362 #define max_block_overhead(d) \
363 (BLOCK_OVERHEAD_FIXED + (ma_sizeof[d] - 1) + (ALIGNMENT - 1))
364
365 /* compute 0-based index for client_space from AD */
366 #define client_space_index(ad) \
367 ((MA_AccessIndex)((size_t)((ad)->client_space - ma_base[(ad)->datatype]) / \
368 ma_sizeof[(ad)->datatype]))
369
370 /* compute address of guard from AD */
371 #define guard1(ad) ((Pointer)((ad)->client_space - sizeof(Guard)))
372 #define guard2(ad) ((Pointer)((ad)->client_space \
373 + ((ad)->nelem * ma_sizeof[(ad)->datatype])))
374
375 /*
376 * When reading or writing guard values, it is necessary to do an
377 * explicit byte copy to avoid bus errors caused by guards that
378 * are not suitably aligned.
379 */
380
381 /* copy from guard to value */
382 #define guard_read(guard, value) bytecopy((guard), (value), sizeof(Guard))
383
384 /* copy from value to guard */
385 #define guard_write(guard, value) bytecopy((value), (guard), sizeof(Guard))
386
387 /**
388 ** statistics stuff
389 **/
390
391 #ifdef STATS
392
393 /* the number of routines for which calls are counted */
394 #define NUMROUTINES ((int)FID_MA_verify_allocator_stuff + 1)
395
396 /* function identifiers */
397 typedef enum
398 {
399 FID_MA_alloc_get = 0,
400 FID_MA_allocate_heap,
401 FID_MA_chop_stack,
402 FID_MA_free_heap,
403 FID_MA_free_heap_piece,
404 FID_MA_get_index,
405 FID_MA_get_mbase,
406 FID_MA_get_next_memhandle,
407 FID_MA_get_numalign,
408 FID_MA_get_pointer,
409 FID_MA_init,
410 FID_MA_initialized,
411 FID_MA_init_memhandle_iterator,
412 FID_MA_inquire_avail,
413 FID_MA_inquire_heap,
414 FID_MA_inquire_heap_check_stack,
415 FID_MA_inquire_heap_no_partition,
416 FID_MA_inquire_stack,
417 FID_MA_inquire_stack_check_heap,
418 FID_MA_inquire_stack_no_partition,
419 FID_MA_pop_stack,
420 FID_MA_print_stats,
421 FID_MA_push_get,
422 FID_MA_push_stack,
423 FID_MA_set_auto_verify,
424 FID_MA_set_error_print,
425 FID_MA_set_hard_fail,
426 FID_MA_set_numalign,
427 FID_MA_sizeof,
428 FID_MA_sizeof_overhead,
429 FID_MA_summarize_allocated_blocks,
430 FID_MA_trace,
431 FID_MA_verify_allocator_stuff
432 } FID;
433
434 /* MA usage statistics */
435 typedef struct
436 {
437 ulongi hblocks; /* current # of heap blocks */
438 ulongi hblocks_max; /* max # of heap blocks */
439 ulongi hbytes; /* current # of heap bytes */
440 ulongi hbytes_max; /* max # of heap bytes */
441 ulongi sblocks; /* current # of stack blocks */
442 ulongi sblocks_max; /* max # of stack blocks */
443 ulongi sbytes; /* current # of stack bytes */
444 ulongi sbytes_max; /* max # of stack bytes */
445 ulongi calls[NUMROUTINES];/* # of calls to each routine */
446 } Stats;
447
448 /* names of the routines */
449 private char *ma_routines[] =
450 {
451 "MA_alloc_get",
452 "MA_allocate_heap",
453 "MA_chop_stack",
454 "MA_free_heap",
455 "MA_free_heap_piece",
456 "MA_get_index",
457 "MA_get_mbase",
458 "MA_get_next_memhandle",
459 "MA_get_numalign",
460 "MA_get_pointer",
461 "MA_init",
462 "MA_initialized",
463 "MA_init_memhandle_iterator",
464 "MA_inquire_avail",
465 "MA_inquire_heap",
466 "MA_inquire_heap_check_stack",
467 "MA_inquire_heap_no_partition",
468 "MA_inquire_stack",
469 "MA_inquire_stack_check_heap",
470 "MA_inquire_stack_no_partition",
471 "MA_pop_stack",
472 "MA_print_stats",
473 "MA_push_get",
474 "MA_push_stack",
475 "MA_set_auto_verify",
476 "MA_set_error_print",
477 "MA_set_hard_fail",
478 "MA_set_numalign",
479 "MA_sizeof",
480 "MA_sizeof_overhead",
481 "MA_summarize_allocated_blocks",
482 "MA_trace",
483 "MA_verify_allocator_stuff"
484 };
485
486 /* MA usage statistics */
487 private Stats ma_stats;
488
489 #endif /* STATS */
490
491 /**
492 ** private routines
493 **/
494
495 /* ------------------------------------------------------------------------- */
496 /*
497 * Return MA_TRUE if ad can satisfy ar, else return MA_FALSE.
498 * If ad can satisfy ar, set its client_space and nbytes fields
499 * after performing any splitting.
500 */
501 /* ------------------------------------------------------------------------- */
502
ad_big_enough(ad,ar)503 private Boolean ad_big_enough(ad, ar)
504 AD *ad; /* the AD to test */
505 Pointer ar; /* allocation request */
506 {
507 Pointer client_space; /* location of client_space */
508 ulongi nbytes; /* length of block for ar */
509
510 /* perform trial allocation to determine size */
511 balloc_after((AR *)ar, (Pointer)ad, &client_space, &nbytes);
512
513 if (nbytes <= ad->nbytes)
514 {
515 /* ad is big enough; split block if necessary */
516 (void)block_split(ad, nbytes, MA_TRUE);
517
518 /* set fields appropriately */
519 ad->client_space = client_space;
520
521 /* success */
522 return MA_TRUE;
523 }
524 else
525 /* ad is not big enough */
526 return MA_FALSE;
527 }
528
529 /* ------------------------------------------------------------------------- */
530 /*
531 * Return MA_TRUE if ad == ad_target, else return MA_FALSE.
532 */
533 /* ------------------------------------------------------------------------- */
534
ad_eq(ad,ad_target)535 private Boolean ad_eq(ad, ad_target)
536 AD *ad; /* the AD to test */
537 Pointer ad_target; /* the AD to match */
538 {
539 return (ad == (AD *)ad_target) ? MA_TRUE : MA_FALSE;
540 }
541
542 /* ------------------------------------------------------------------------- */
543 /*
544 * Return MA_TRUE if ad > ad_target, else return MA_FALSE.
545 */
546 /* ------------------------------------------------------------------------- */
547
ad_gt(ad,ad_target)548 private Boolean ad_gt(ad, ad_target)
549 AD *ad; /* the AD to test */
550 Pointer ad_target; /* the AD to match */
551 {
552 return (ad > (AD *)ad_target) ? MA_TRUE : MA_FALSE;
553 }
554
555 /* ------------------------------------------------------------------------- */
556 /*
557 * Return MA_TRUE if ad <= ad_target, else return MA_FALSE.
558 */
559 /* ------------------------------------------------------------------------- */
560
ad_le(ad,ad_target)561 private Boolean ad_le(ad, ad_target)
562 AD *ad; /* the AD to test */
563 Pointer ad_target; /* the AD to match */
564 {
565 return (ad <= (AD *)ad_target) ? MA_TRUE : MA_FALSE;
566 }
567
568 /* ------------------------------------------------------------------------- */
569 /*
570 * Return MA_TRUE if ad < ad_target, else return MA_FALSE.
571 */
572 /* ------------------------------------------------------------------------- */
573
ad_lt(ad,ad_target)574 private Boolean ad_lt(ad, ad_target)
575 AD *ad; /* the AD to test */
576 Pointer ad_target; /* the AD to match */
577 {
578 return (ad < (AD *)ad_target) ? MA_TRUE : MA_FALSE;
579 }
580
581 /* ------------------------------------------------------------------------- */
582 /*
583 * Print identifying information about the given AD to stdout.
584 */
585 /* ------------------------------------------------------------------------- */
586
ad_print(ad,block_type)587 private void ad_print(ad, block_type)
588 AD *ad; /* to print */
589 char *block_type; /* for output */
590 {
591 Integer memhandle; /* memhandle for AD */
592
593 /* convert AD to memhandle */
594 memhandle = ma_table_lookup_assoc((TableData)ad);
595
596 /* print to stdout */
597 (void)printf("%s block '%s', handle ",
598 block_type,
599 ad->name);
600 if (memhandle == TABLE_HANDLE_NONE)
601 (void)printf("unknown");
602 else
603 (void)printf("%ld",
604 (size_t)memhandle);
605 (void)printf(", address 0x%lx",
606 (size_t)ad);
607 }
608
609 /* ------------------------------------------------------------------------- */
610 /*
611 * Allocate a block suitable for ar starting at address. No fields of
612 * the new block are modified.
613 */
614 /* ------------------------------------------------------------------------- */
615
balloc_after(ar,address,client_space,nbytes)616 private void balloc_after(ar, address, client_space, nbytes)
617 AR *ar; /* allocation request */
618 Pointer address; /* to allocate after */
619 Pointer *client_space; /* RETURN: location of client_space */
620 ulongi *nbytes; /* RETURN: length of block */
621 {
622 Integer datatype; /* of elements in this block */
623 ulongi L_client_space; /* length of client_space */
624 Pointer A_client_space; /* address of client_space */
625 int L_gap1; /* length of gap1 */
626 int L_gap2; /* length of gap2 */
627
628 ulongi B_address; /* byte equivalent of address */
629 ulongi B_base; /* byte equivalent of ma_base[datatype] */
630 ulongi B_client_space; /* byte equivalent of A_client_space */
631
632 datatype = ar->datatype;
633
634 B_address = p2b(address);
635 B_base = p2b(ma_base[datatype]);
636
637 /*
638 * To ensure that client_space is properly aligned:
639 *
640 * (A(client_space) - ma_base[datatype]) % ma_sizeof[datatype] == 0
641 *
642 * where
643 *
644 * A(client_space) == address + L(AD) + L(gap1) + L(guard1)
645 */
646
647 L_client_space = ar->nelem * ma_sizeof[datatype];
648
649 L_gap1 = ((size_t)B_base
650 - (size_t)B_address
651 - (size_t)sizeof(AD)
652 - (size_t)sizeof(Guard))
653 % (size_t)ma_sizeof[datatype];
654
655 if (L_gap1 < 0)
656 L_gap1 += ma_sizeof[datatype];
657
658 B_client_space = B_address + sizeof(AD) + L_gap1 + sizeof(Guard);
659 A_client_space = b2p(B_client_space);
660 B_client_space = p2b(A_client_space);
661
662 /*
663 * To align client space according to overall alignment of absolute
664 * address on user requested 2^ma_numalign boundary.
665 * Note that if the base arrays are not aligned accordingly then
666 * this alignement request is not satisfiable and will be quietly
667 * ignored.
668 */
669
670 if (ma_numalign > 0) {
671 size_t mask = (1<<ma_numalign)-1;
672 int diff = ((size_t) B_client_space) & mask;
673
674 /* Check that the difference is a multiple of the type size.
675 * If so, then we can shift the client space which is already
676 * aligned to satisfy this requirement.
677 */
678
679 if (diff) {
680 diff = (1<<ma_numalign) - diff;
681 if ((diff % ma_sizeof[datatype]) == 0 ) {
682 /*printf("bafter realigned diff=%d\n",diff);*/
683 A_client_space = b2p(B_client_space + diff);
684 B_client_space = p2b(A_client_space);
685 }
686 /* else {
687 printf("did not realign diff=%d typelen=%d mod=%d\n",
688 diff, ma_sizeof[datatype], (diff % ma_sizeof[datatype]));
689 }*/
690 }
691 }
692
693 /*
694 * To ensure that the AD is properly aligned:
695 *
696 * L(block) % ALIGNMENT == 0
697 *
698 * where
699 *
700 * L(block) == A(client_space) + L(client_space) + L(guard2) + L(gap2)
701 * - address
702 */
703
704 L_gap2 = ((size_t)B_address
705 - (size_t)B_client_space
706 - (size_t)L_client_space
707 - (size_t)sizeof(Guard))
708 % (size_t)ALIGNMENT;
709
710 if (L_gap2 < 0)
711 L_gap2 += ALIGNMENT;
712
713 /*
714 * set the return values
715 */
716
717 *client_space = A_client_space;
718 *nbytes = (ulongi)(B_client_space
719 + L_client_space
720 + sizeof(Guard)
721 + L_gap2
722 - B_address);
723 }
724
725 /* ------------------------------------------------------------------------- */
726 /*
727 * Allocate a block suitable for ar ending before address. No fields of
728 * the new block are modified.
729 */
730 /* ------------------------------------------------------------------------- */
731
balloc_before(ar,address,client_space,nbytes)732 private void balloc_before(ar, address, client_space, nbytes)
733 AR *ar; /* allocation request */
734 Pointer address; /* to allocate before */
735 Pointer *client_space; /* RETURN: location of client_space */
736 ulongi *nbytes; /* RETURN: length of block */
737 {
738 Integer datatype; /* of elements in this block */
739 ulongi L_client_space; /* length of client_space */
740 Pointer A_client_space; /* address of client_space */
741 int L_gap1; /* length of gap1 */
742 int L_gap2; /* length of gap2 */
743
744 ulongi B_address; /* byte equivalent of address */
745 ulongi B_base; /* byte equivalent of ma_base[datatype] */
746 ulongi B_client_space; /* byte equivalent of A_client_space */
747
748 datatype = ar->datatype;
749
750 B_address = p2b(address);
751 B_base = p2b(ma_base[datatype]);
752
753 /*
754 * To ensure that client_space is properly aligned:
755 *
756 * (A(client_space) - ma_base[datatype]) % ma_sizeof[datatype] == 0
757 *
758 * where
759 *
760 * A(client_space) == address - L(gap2) - L(guard2) - L(client_space)
761 */
762
763 L_client_space = ar->nelem * ma_sizeof[datatype];
764
765 L_gap2 = (B_address
766 - sizeof(Guard)
767 - L_client_space
768 - B_base)
769 % ma_sizeof[datatype];
770
771 if (L_gap2 < 0)
772 L_gap2 += ma_sizeof[datatype];
773
774 B_client_space = B_address - L_gap2 - sizeof(Guard) - L_client_space;
775 A_client_space = b2p(B_client_space);
776 B_client_space = p2b(A_client_space);
777
778 /*
779 * To align client space according to overall alignment of absolute
780 * address on user requested 2^ma_numalign boundary.
781 * Note that if the base arrays are not aligned accordingly then
782 * this alignement request is not satisfiable and will be quietly
783 * ignored.
784 */
785
786 if (ma_numalign > 0) {
787 size_t mask = (1<<ma_numalign)-1;
788 int diff = ((size_t) B_client_space) & mask;
789
790 /* Check that the difference is a multiple of the type size.
791 * If so, then we can shift the client space which is already
792 * aligned to satisfy this requirement.
793 */
794
795 if (diff) {
796 if ((diff % ma_sizeof[datatype]) == 0 ) {
797 /* printf("bbefore realigned diff=%d\n",diff); */
798 A_client_space = b2p(B_client_space - diff);
799 B_client_space = p2b(A_client_space);
800 }
801 /* else {
802 printf("did not realign diff=%d typelen=%d mod=%d\n",
803 diff, ma_sizeof[datatype], (diff % ma_sizeof[datatype]));
804 }*/
805 }
806 }
807
808 /*
809 * To ensure that the AD is properly aligned:
810 *
811 * A(AD) % ALIGNMENT == 0
812 *
813 * where
814 *
815 * A(AD) == A(client_space) - L(guard1) - L(gap1) - L(AD)
816 */
817
818 L_gap1 = (B_client_space
819 - sizeof(Guard)
820 - sizeof(AD))
821 % ALIGNMENT;
822
823 /*
824 * set the return values
825 */
826
827 *client_space = A_client_space;
828 *nbytes = (ulongi)(B_address
829 - B_client_space
830 + sizeof(Guard)
831 + L_gap1
832 + sizeof(AD));
833 }
834
835 /* ------------------------------------------------------------------------- */
836 /*
837 * Reclaim the given block by updating ma_hp and ma_hfree.
838 */
839 /* ------------------------------------------------------------------------- */
840
block_free_heap(ad)841 private void block_free_heap(ad)
842 AD *ad; /* AD to free */
843 {
844 AD *ad2; /* traversal pointer */
845 AD *max_ad; /* rightmost AD */
846
847 /* find rightmost heap block */
848 for (max_ad = (AD *)NULL, ad2 = ma_hused; ad2; ad2 = ad2->next)
849 {
850 if (ad2 > max_ad)
851 max_ad = ad2;
852 }
853
854 if (max_ad)
855 {
856 /* at least 1 block is in use */
857
858 /* set ma_hp to first address past end of max_ad */
859 ma_hp = (Pointer)max_ad + max_ad->nbytes;
860
861 /* delete any free list blocks that are no longer in heap region */
862 (void)list_delete_many(
863 &ma_hfree,
864 ad_gt,
865 (Pointer)max_ad,
866 (void (*)())NULL);
867
868 /* if ad is in the heap region, add it to free list */
869 if (ad < max_ad)
870 {
871 list_insert_ordered(ad, &ma_hfree, ad_lt);
872 list_coalesce(ma_hfree);
873 }
874 }
875 else
876 {
877 /* no blocks are in use */
878
879 /* set ma_hp to start of segment */
880 ma_hp = ma_segment;
881
882 /* clear the free list */
883 ma_hfree = (AD *)NULL;
884 }
885 }
886
887 /* ------------------------------------------------------------------------- */
888 /*
889 * If ad is sufficiently bigger than bytes_needed bytes, create a new
890 * block from the remainder, optionally insert it in the free list,
891 * and set the lengths of both blocks.
892 *
893 * Return a pointer to the new block (NULL if not created).
894 */
895 /* ------------------------------------------------------------------------- */
896
block_split(ad,bytes_needed,insert_free)897 private AD *block_split(ad, bytes_needed, insert_free)
898 AD *ad; /* the AD to split */
899 ulongi bytes_needed; /* from ad */
900 Boolean insert_free; /* insert in free list? */
901 {
902 ulongi bytes_extra; /* in ad */
903 AD *ad2; /* the new AD */
904
905 /* caller ensures that ad->nbytes >= bytes_needed */
906 bytes_extra = ad->nbytes - bytes_needed;
907
908 if (bytes_extra >= ((ulongi)MINBLOCKSIZE))
909 {
910 /* create a new block */
911 ad2 = (AD *)((Pointer)ad + bytes_needed);
912
913 /* set the length of ad2 */
914 ad2->nbytes = bytes_extra;
915
916 if (insert_free)
917 {
918 /* insert ad2 into free list */
919 list_insert_ordered(ad2, &ma_hfree, ad_lt);
920 }
921
922 /* set the length of ad */
923 ad->nbytes = bytes_needed;
924
925 return ad2;
926 }
927 else
928 {
929 /*
930 * If 0 <= bytes_extra < MINBLOCKSIZE then there are too few
931 * extra bytes to form a new block. In this case, we simply
932 * do nothing; ad will retain its original length (which is
933 * either perfect or slightly too big), and the entire block
934 * will be reclaimed upon deallocation, preventing any
935 * memory leakage.
936 */
937
938 return (AD *)NULL;
939 }
940 }
941
942 /* ------------------------------------------------------------------------- */
943 /*
944 * Compute and return a checksum for ad. Include all fields except name,
945 * next, and checksum.
946 */
947 /* ------------------------------------------------------------------------- */
948
checksum(ad)949 private ulongi checksum(ad)
950 AD *ad; /* the AD to compute checksum for */
951 {
952 return (ulongi)(
953 ad->datatype +
954 ad->nelem +
955 (ulongi)ad->client_space +
956 ad->nbytes);
957 }
958
959 /* ------------------------------------------------------------------------- */
960 /*
961 * Print to stderr the addresses of the fields of the given ad.
962 */
963 /* ------------------------------------------------------------------------- */
964
965 #ifdef DEBUG
966
debug_ad_print(ad)967 private void debug_ad_print(ad)
968 AD *ad; /* the AD to print */
969 {
970 #define NUMADFIELDS 7
971
972 char *fn[NUMADFIELDS]; /* field names */
973 size_t fa[NUMADFIELDS]; /* field addresses */
974 int i; /* loop index */
975 size_t address; /* other addresses */
976
977 /* set field names */
978 fn[0] = "datatype";
979 fn[1] = "nelem";
980 fn[2] = "name";
981 fn[3] = "client_space";
982 fn[4] = "nbytes";
983 fn[5] = "next";
984 fn[6] = "checksum";
985
986 /* set field addresses */
987 fa[0] = (size_t)(&(ad->datatype));
988 fa[1] = (size_t)(&(ad->nelem));
989 fa[2] = (size_t)(&(ad->name));
990 fa[3] = (size_t)(&(ad->client_space));
991 fa[4] = (size_t)(&(ad->nbytes));
992 fa[5] = (size_t)(&(ad->next));
993 fa[6] = (size_t)(&(ad->checksum));
994
995 /* print AD fields to stderr */
996 (void)fprintf(stderr, "debug_ad_print:\n");
997 for (i = 0; i < NUMADFIELDS; i++)
998 (void)fprintf(stderr, "\t0x%lx mod4,8,16=%d,%d,%-2d ad->%s\n",
999 fa[i],
1000 fa[i] % 4,
1001 fa[i] % 8,
1002 fa[i] % 16,
1003 fn[i]);
1004
1005 /* print other addresses to stderr */
1006 address = (size_t)guard1(ad);
1007 (void)fprintf(stderr, "\t0x%lx mod4,8,16=%d,%d,%-2d guard1\n",
1008 address,
1009 address % 4,
1010 address % 8,
1011 address % 16);
1012 address = (size_t)ad->client_space;
1013 (void)fprintf(stderr, "\t0x%lx mod4,8,16=%d,%d,%-2d client_space\n",
1014 address,
1015 address % 4,
1016 address % 8,
1017 address % 16);
1018 address = (size_t)guard2(ad);
1019 (void)fprintf(stderr, "\t0x%lx mod4,8,16=%d,%d,%-2d guard2\n",
1020 address,
1021 address % 4,
1022 address % 8,
1023 address % 16);
1024
1025 (void)fflush(stderr);
1026 }
1027
1028 #endif /* DEBUG */
1029
1030 /* ------------------------------------------------------------------------- */
1031 /*
1032 * Return MA_TRUE if the guards associated with ad contain valid signatures,
1033 * else return MA_FALSE.
1034 */
1035 /* ------------------------------------------------------------------------- */
1036
guard_check(ad)1037 private Boolean guard_check(ad)
1038 AD *ad; /* the AD to check guards for */
1039 {
1040 Guard signature; /* value to be read */
1041 Pointer guard; /* address to read from */
1042
1043 guard = guard1(ad);
1044 guard_read(guard, &signature);
1045 if (signature != GUARD1)
1046 return MA_FALSE;
1047
1048 guard = guard2(ad);
1049 guard_read(guard, &signature);
1050 if (signature != GUARD2)
1051 return MA_FALSE;
1052
1053 /* success */
1054 return MA_TRUE;
1055 }
1056
1057 /* ------------------------------------------------------------------------- */
1058 /*
1059 * Write signatures into the guards associated with ad.
1060 */
1061 /* ------------------------------------------------------------------------- */
1062
guard_set(ad)1063 private void guard_set(ad)
1064 AD *ad; /* the AD to set guards for */
1065 {
1066 Guard signature; /* value to be written */
1067 Pointer guard; /* address to write to */
1068
1069 signature = GUARD1;
1070 guard = guard1(ad);
1071 guard_write(guard, &signature);
1072
1073 signature = GUARD2;
1074 guard = guard2(ad);
1075 guard_write(guard, &signature);
1076 }
1077
1078 /* ------------------------------------------------------------------------- */
1079 /*
1080 * Coalesce list by merging any adjacent elements that are contiguous.
1081 * The list is assumed to be ordered by increasing addresses, i.e.,
1082 * addressOf(element i) < addressOf(element i+1).
1083 */
1084 /* ------------------------------------------------------------------------- */
1085
list_coalesce(list)1086 private void list_coalesce(list)
1087 AD *list; /* the list to coalesce */
1088 {
1089 AD *ad1; /* lead traversal pointer */
1090 AD *ad2; /* trailing traversal pointer */
1091
1092 for (ad2 = list; ad2;)
1093 {
1094 /* compute first address beyond ad2 */
1095 ad1 = (AD *)((Pointer)ad2 + ad2->nbytes);
1096
1097 /* are ad2 and ad1 contiguous? */
1098 if (ad1 == ad2->next)
1099 {
1100 /* yes; merge ad1 into ad2 */
1101 ad2->nbytes += ad1->nbytes;
1102 ad2->next = ad1->next;
1103 }
1104 else
1105 {
1106 /* no; advance ad2 */
1107 ad2 = ad2->next;
1108 }
1109 }
1110 }
1111
1112 /* ------------------------------------------------------------------------- */
1113 /*
1114 * Delete and return the first occurrence of ad from list. If ad is not
1115 * a member of list, return NULL.
1116 */
1117 /* ------------------------------------------------------------------------- */
1118
list_delete(ad,list)1119 private AD *list_delete(ad, list)
1120 AD *ad; /* the AD to delete */
1121 AD **list; /* the list to delete from */
1122 {
1123 return list_delete_one(list, ad_eq, (Pointer)ad);
1124 }
1125
1126 /* ------------------------------------------------------------------------- */
1127 /*
1128 * Apply pred (with closure) to each element of list. Delete each element
1129 * that satisfies pred, after applying action to the element (if action is
1130 * not NULL). Return the number of elements deleted.
1131 */
1132 /* ------------------------------------------------------------------------- */
1133
list_delete_many(list,pred,closure,action)1134 private int list_delete_many(list, pred, closure, action)
1135 AD **list; /* the list to search */
1136 Boolean (*pred)(); /* predicate */
1137 Pointer closure; /* for pred */
1138 void (*action)(); /* to apply before deletion */
1139 {
1140 AD *ad1; /* lead traversal pointer */
1141 AD *ad2; /* trailing traversal pointer */
1142 int ndeleted = 0; /* # of elements deleted from list */
1143
1144 for (ad2 = (AD *)NULL, ad1 = *list; ad1; ad1 = ad1->next)
1145 {
1146 /* does ad1 match? */
1147 if ((*pred)(ad1, closure))
1148 {
1149 /* yes; apply action, then delete ad1 from list */
1150 if (action != (void (*)())NULL)
1151 (*action)(ad1);
1152 if (ad2)
1153 {
1154 /* ad1 is second or later element */
1155 ad2->next = ad1->next;
1156 }
1157 else
1158 {
1159 /* ad1 is first element */
1160 *list = ad1->next;
1161 }
1162
1163 ndeleted++;
1164 }
1165 else
1166 {
1167 /* no; ad1 survives, so scoot ad2 along */
1168 ad2 = ad1;
1169 }
1170 }
1171
1172 /* return the # of elements deleted from list */
1173 return ndeleted;
1174 }
1175
1176 /* ------------------------------------------------------------------------- */
1177 /*
1178 * Apply pred (with closure) to each element of list. Delete and return
1179 * the first element that satisfies pred. If no element satisfies pred,
1180 * return NULL.
1181 */
1182 /* ------------------------------------------------------------------------- */
1183
list_delete_one(list,pred,closure)1184 private AD *list_delete_one(list, pred, closure)
1185 AD **list; /* the list to search */
1186 Boolean (*pred)(); /* predicate */
1187 Pointer closure; /* for pred */
1188 {
1189 AD *ad1; /* lead traversal pointer */
1190 AD *ad2; /* trailing traversal pointer */
1191
1192 for (ad2 = (AD *)NULL, ad1 = *list; ad1; ad2 = ad1, ad1 = ad1->next)
1193 {
1194 /* does ad1 match? */
1195 if ((*pred)(ad1, closure))
1196 {
1197 /* yes; delete ad1 from list */
1198 if (ad2)
1199 {
1200 /* ad1 is second or later element */
1201 ad2->next = ad1->next;
1202 }
1203 else
1204 {
1205 /* ad1 is first element */
1206 *list = ad1->next;
1207 }
1208
1209 /* success */
1210 return ad1;
1211 }
1212 }
1213
1214 /* failure */
1215 return (AD *)NULL;
1216 }
1217
1218 /* ------------------------------------------------------------------------- */
1219 /*
1220 * Insert ad into list.
1221 */
1222 /* ------------------------------------------------------------------------- */
1223
list_insert(ad,list)1224 private void list_insert(ad, list)
1225 AD *ad; /* the AD to insert */
1226 AD **list; /* the list to insert into */
1227 {
1228 /* push ad onto list */
1229 ad->next = *list;
1230 *list = ad;
1231 }
1232
1233 /* ------------------------------------------------------------------------- */
1234 /*
1235 * Insert ad into list, immediately before the first element e
1236 * for which pred(ad, e) returns true. If there is no such element,
1237 * insert ad after the last element of list.
1238 */
1239 /* ------------------------------------------------------------------------- */
1240
list_insert_ordered(ad,list,pred)1241 private void list_insert_ordered(ad, list, pred)
1242 AD *ad; /* the AD to insert */
1243 AD **list; /* the list to insert into */
1244 Boolean (*pred)(); /* predicate */
1245 {
1246 AD *ad1; /* lead traversal pointer */
1247 AD *ad2; /* trailing traversal pointer */
1248
1249 if (*list == (AD *)NULL)
1250 {
1251 /* empty list */
1252 ad->next = (AD *)NULL;
1253 *list = ad;
1254 return;
1255 }
1256
1257 /* list has at least one element */
1258 for (ad2 = (AD *)NULL, ad1 = *list; ad1; ad2 = ad1, ad1 = ad1->next)
1259 {
1260 /* does ad1 match? */
1261 if ((*pred)(ad, ad1))
1262 {
1263 /* yes; insert ad before ad1 */
1264 if (ad2)
1265 {
1266 /* ad1 is second or later element */
1267 ad2->next = ad;
1268 }
1269 else
1270 {
1271 /* ad1 is first element */
1272 *list = ad;
1273 }
1274 ad->next = ad1;
1275
1276 /* success */
1277 return;
1278 }
1279 }
1280
1281 /* append ad to list */
1282 ad2->next = ad;
1283 ad->next = (AD *)NULL;
1284 }
1285
1286 /* ------------------------------------------------------------------------- */
1287 /*
1288 * Return MA_TRUE if ad is a member of list, else return MA_FALSE.
1289 */
1290 /* ------------------------------------------------------------------------- */
1291
list_member(ad,list)1292 private Boolean list_member(ad, list)
1293 AD *ad; /* the AD to search for */
1294 AD *list; /* the list to search */
1295 {
1296 AD *ad1; /* traversal pointer */
1297
1298 for (ad1 = list; ad1; ad1 = ad1->next)
1299 if (ad1 == ad)
1300 /* ad is a member of list */
1301 return MA_TRUE;
1302
1303 /* ad is not a member of list */
1304 return MA_FALSE;
1305 }
1306
1307 /* ------------------------------------------------------------------------- */
1308 /*
1309 * Print information to stdout about each block on list. Return the
1310 * number of blocks on list.
1311 */
1312 /* ------------------------------------------------------------------------- */
1313
list_print(list,block_type,index_base)1314 private int list_print(list, block_type, index_base)
1315 AD *list; /* to print */
1316 char *block_type; /* for output */
1317 int index_base; /* 0 (C) or 1 (FORTRAN) */
1318 {
1319 AD *ad; /* traversal pointer */
1320 int nblocks; /* # of blocks on list */
1321
1322 /* print each block on list */
1323 for (ad = list, nblocks = 0; ad; ad = ad->next, nblocks++)
1324 {
1325 /* print to stdout */
1326 ad_print(ad, block_type);
1327 (void)printf(":\n");
1328 (void)printf("\ttype of elements:\t\t%s\n",
1329 ma_datatype[ad->datatype]);
1330 (void)printf("\tnumber of elements:\t\t%ld\n",
1331 (size_t)ad->nelem);
1332 (void)printf("\taddress of client space:\t0x%lx\n",
1333 (size_t)ad->client_space);
1334 (void)printf("\tindex for client space:\t\t%ld\n",
1335 (size_t)(client_space_index(ad) + index_base));
1336 (void)printf("\ttotal number of bytes:\t\t%lu\n",
1337 ad->nbytes);
1338 }
1339
1340 /* return the number of blocks on list */
1341 return nblocks;
1342 }
1343
1344 /* ------------------------------------------------------------------------- */
1345 /*
1346 * Check each block on list for checksum and guard errors. For each error
1347 * found, print a message to stdout. Return counts of the various errors
1348 * in the bad_ parameters.
1349 */
1350 /* ------------------------------------------------------------------------- */
1351
list_verify(list,block_type,preamble,blocks,bad_blocks,bad_checksums,bad_lguards,bad_rguards)1352 private void list_verify(list, block_type, preamble, blocks,
1353 bad_blocks, bad_checksums, bad_lguards, bad_rguards)
1354 AD *list; /* to verify */
1355 char *block_type; /* for error messages */
1356 char *preamble; /* printed before first error message */
1357 int *blocks; /* RETURN: # of blocks */
1358 int *bad_blocks; /* RETURN: # of blocks having errors */
1359 int *bad_checksums; /* RETURN: # of blocks having bad checksum */
1360 int *bad_lguards; /* RETURN: # of blocks having bad guard1 */
1361 int *bad_rguards; /* RETURN: # of blocks having bad guard2 */
1362 {
1363 AD *ad; /* traversal pointer */
1364 Boolean first_bad_block;/* first bad block found? */
1365 Boolean bad_block; /* problem in current block? */
1366 Guard signature; /* value to be read */
1367 Pointer guard; /* address to read from */
1368
1369 /* initialize */
1370 *blocks = 0;
1371 *bad_blocks = 0;
1372 *bad_checksums = 0;
1373 *bad_lguards = 0;
1374 *bad_rguards = 0;
1375 first_bad_block = MA_TRUE;
1376
1377 /* check each block on list */
1378 for (ad = list; ad; ad = ad->next)
1379 {
1380 (*blocks)++;
1381 bad_block = MA_FALSE;
1382
1383 /* check for checksum error */
1384 if (checksum(ad) != ad->checksum)
1385 {
1386 /* print preamble if necessary */
1387 if (first_bad_block && (preamble != (char *)NULL))
1388 {
1389 (void)printf("%s",preamble);
1390 first_bad_block = MA_FALSE;
1391 }
1392
1393 /* print error message to stdout */
1394 ad_print(ad, block_type);
1395 (void)printf(":\n\t");
1396 (void)printf("current checksum %lu != stored checksum %lu\n",
1397 checksum(ad),
1398 ad->checksum);
1399
1400 /* do bookkeeping */
1401 (*bad_checksums)++;
1402 bad_block = MA_TRUE;
1403 }
1404
1405 /* check for bad guard1 */
1406 guard = guard1(ad);
1407 guard_read(guard, &signature);
1408 if (signature != GUARD1)
1409 {
1410 /* print preamble if necessary */
1411 if (first_bad_block && (preamble != (char *)NULL))
1412 {
1413 (void)printf("%s",preamble);
1414 first_bad_block = MA_FALSE;
1415 }
1416
1417 /* print error message to stdout */
1418 ad_print(ad, block_type);
1419 (void)printf(":\n\t");
1420 (void)printf(
1421 "current left signature %u != proper left signature %u\n",
1422 signature,
1423 GUARD1);
1424
1425 /* do bookkeeping */
1426 (*bad_lguards)++;
1427 bad_block = MA_TRUE;
1428 }
1429
1430 /* check for bad guard2 */
1431 guard = guard2(ad);
1432 guard_read(guard, &signature);
1433 if (signature != GUARD2)
1434 {
1435 /* print preamble if necessary */
1436 if (first_bad_block && (preamble != (char *)NULL))
1437 {
1438 (void)printf("%s",preamble);
1439 first_bad_block = MA_FALSE;
1440 }
1441
1442 /* print error message to stdout */
1443 ad_print(ad, block_type);
1444 (void)printf(":\n\t");
1445 (void)printf(
1446 "current right signature %u != proper right signature %u\n",
1447 signature,
1448 GUARD2);
1449
1450 /* do bookkeeping */
1451 (*bad_rguards)++;
1452 bad_block = MA_TRUE;
1453 }
1454
1455 /* if any errors, bump bad block count */
1456 if (bad_block)
1457 (*bad_blocks)++;
1458 }
1459 }
1460
1461 /* ------------------------------------------------------------------------- */
1462 /*
1463 * Return the maximum number of datatype elements that can currently be
1464 * accomodated in a heap fragment (a block on the heap free list) entirely
1465 * within the heap region, or 0 if this number is less than min_nelem.
1466 */
1467 /* ------------------------------------------------------------------------- */
1468
ma_max_heap_frag_nelem(datatype,min_nelem)1469 private Integer ma_max_heap_frag_nelem(datatype, min_nelem)
1470 Integer datatype; /* of elements */
1471 Integer min_nelem; /* for fragment to be considered */
1472 {
1473 ulongi min_bytes; /* for fragment to be considered */
1474 AD *ad; /* traversal pointer */
1475 ulongi nbytes; /* in current fragment */
1476 Integer nelem; /* in current fragment */
1477 Integer max_nelem; /* result */
1478
1479 /* set the threshold */
1480 min_bytes = (min_nelem * ma_sizeof[datatype]) + BLOCK_OVERHEAD_FIXED;
1481
1482 /* search the heap free list */
1483 max_nelem = 0;
1484 for (ad = ma_hfree; ad; ad = ad->next)
1485 {
1486 /*
1487 * There are 3 cases to consider:
1488 *
1489 * (a) fragment is outside heap region
1490 * (b) fragment straddles partition between heap and stack regions
1491 * (c) fragment is inside heap region
1492 */
1493
1494 if ((Pointer)ad >= ma_partition)
1495 {
1496 /* case (a): reject */
1497 continue;
1498 }
1499 else if (((Pointer)ad + ad->nbytes) >= ma_partition)
1500 {
1501 /* case (b): truncate fragment at partition */
1502 nbytes = (ulongi)(ma_partition - (Pointer)ad);
1503 }
1504 else
1505 {
1506 /* case (c): accept */
1507 nbytes = ad->nbytes;
1508 }
1509
1510 if (nbytes >= min_bytes)
1511 {
1512 nelem = ma_nelem((Pointer)ad, nbytes, datatype);
1513 max_nelem = max(max_nelem, nelem);
1514 }
1515 }
1516
1517 /* return the result */
1518 return max_nelem;
1519 }
1520
1521 /* ------------------------------------------------------------------------- */
1522 /*
1523 * Return the maximum number of datatype elements that can currently
1524 * be accomodated in length bytes starting at address.
1525 */
1526 /* ------------------------------------------------------------------------- */
1527
ma_nelem(address,length,datatype)1528 private Integer ma_nelem(address, length, datatype)
1529 Pointer address; /* location of hypothetical block */
1530 ulongi length; /* length of hypothetical block */
1531 Integer datatype; /* of elements in hypothetical block */
1532 {
1533 AR ar; /* allocation request */
1534 Pointer client_space; /* location of client_space */
1535 ulongi nbytes; /* length of block for ar */
1536
1537 if (length <= BLOCK_OVERHEAD_FIXED)
1538 /* no point in computing anything */
1539 return (Integer)0;
1540
1541 /* compute initial request */
1542 ar.datatype = datatype;
1543 ar.nelem = (length - BLOCK_OVERHEAD_FIXED) / ma_sizeof[datatype];
1544
1545 /* make requests until one succeeds or we give up */
1546 while (ar.nelem > 0)
1547 {
1548 /* perform trial allocation to determine size */
1549 balloc_after(&ar, address, &client_space, &nbytes);
1550
1551 if (nbytes > length)
1552 /* not enough space for ar.nelem elements */
1553 ar.nelem--;
1554 else
1555 /* enough space for ar.nelem elements */
1556 break;
1557 }
1558
1559 /* return the result */
1560 return ar.nelem;
1561 }
1562
1563 /* ------------------------------------------------------------------------- */
1564 /*
1565 * Perform operations necessary to allow certain functions to be invoked
1566 * before MA_init is called.
1567 */
1568 /* ------------------------------------------------------------------------- */
1569
ma_preinitialize(caller)1570 private void ma_preinitialize(caller)
1571 char *caller; /* name of calling routine */
1572 {
1573 if (ma_preinitialized)
1574 return;
1575
1576 /* call a FORTRAN routine to set bases and sizes of FORTRAN datatypes */
1577 if (ma_set_sizes_() == 0)
1578 {
1579 (void)sprintf(ma_ebuf,
1580 "unable to set sizes of FORTRAN datatypes");
1581 ma_error(EL_Fatal, ET_Internal, caller, ma_ebuf);
1582 return;
1583 }
1584
1585 /* success */
1586 ma_preinitialized = MA_TRUE;
1587 }
1588
1589 /* ------------------------------------------------------------------------- */
1590 /*
1591 * If memhandle is valid according to location, return the corresponding AD
1592 * in adout and return MA_TRUE, else print an error message and return
1593 * MA_FALSE.
1594 */
1595 /* ------------------------------------------------------------------------- */
1596
mh2ad(memhandle,adout,location,caller)1597 private Boolean mh2ad(memhandle, adout, location, caller)
1598 Integer memhandle; /* the handle to verify and convert */
1599 AD **adout; /* RETURN: AD corresponding to memhandle */
1600 BlockLocation location; /* where AD must reside */
1601 char *caller; /* name of calling routine */
1602 {
1603 AD *ad;
1604 Boolean check_checksum = MA_TRUE;
1605 Boolean check_guards = MA_TRUE;
1606 Boolean check_heap = MA_FALSE;
1607 Boolean check_stack = MA_FALSE;
1608 Boolean check_stacktop = MA_FALSE;
1609 Boolean check_heapandstack = MA_FALSE;
1610
1611 switch (location)
1612 {
1613 case BL_HeapOrStack:
1614 check_heapandstack = MA_TRUE;
1615 break;
1616 case BL_Heap:
1617 check_heap = MA_TRUE;
1618 break;
1619 case BL_Stack:
1620 check_stack = MA_TRUE;
1621 break;
1622 case BL_StackTop:
1623 check_stacktop = MA_TRUE;
1624 break;
1625 default:
1626 (void)sprintf(ma_ebuf,
1627 "invalid location: %d",
1628 (int)location);
1629 ma_error(EL_Nonfatal, ET_Internal, "mh2ad", ma_ebuf);
1630 return MA_FALSE;
1631 }
1632
1633 /* convert memhandle to AD */
1634 if (!ma_table_verify(memhandle, caller))
1635 return MA_FALSE;
1636 else
1637 ad = (AD *)ma_table_lookup(memhandle);
1638
1639 /* attempt to avoid crashes due to corrupt addresses */
1640 if (!reasonable_address((Pointer)ad))
1641 {
1642 (void)sprintf(ma_ebuf,
1643 "invalid block address (0x%lx) for memhandle %ld",
1644 (size_t)ad, (size_t)memhandle);
1645 ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1646 return MA_FALSE;
1647 }
1648
1649 if (check_checksum)
1650 {
1651 if (checksum(ad) != ad->checksum)
1652 {
1653 (void)sprintf(ma_ebuf,
1654 "invalid checksum for memhandle %ld (name: '%s')",
1655 (size_t)memhandle, ad->name);
1656 ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1657 return MA_FALSE;
1658 }
1659 }
1660
1661 if (check_guards)
1662 {
1663 if (!guard_check(ad))
1664 {
1665 (void)sprintf(ma_ebuf,
1666 "invalid guard(s) for memhandle %ld (name: '%s')",
1667 (size_t)memhandle, ad->name);
1668 ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1669 return MA_FALSE;
1670 }
1671 }
1672
1673 if (check_heap)
1674 {
1675 if (!list_member(ad, ma_hused))
1676 {
1677 (void)sprintf(ma_ebuf,
1678 "memhandle %ld (name: '%s') not in heap",
1679 (size_t)memhandle, ad->name);
1680 ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1681 return MA_FALSE;
1682 }
1683 }
1684 else if (check_stack)
1685 {
1686 if (!list_member(ad, ma_sused))
1687 {
1688 (void)sprintf(ma_ebuf,
1689 "memhandle %ld (name: '%s') not in stack",
1690 (size_t)memhandle, ad->name);
1691 ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1692 return MA_FALSE;
1693 }
1694 }
1695 else if (check_stacktop)
1696 {
1697 /* is it in the stack? */
1698 if (!list_member(ad, ma_sused))
1699 {
1700 (void)sprintf(ma_ebuf,
1701 "memhandle %ld (name: '%s') not in stack",
1702 (size_t)memhandle, ad->name);
1703 ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1704 return MA_FALSE;
1705 }
1706
1707 /* is it on top of the stack? */
1708 if ((Pointer)ad != ma_sp)
1709 {
1710 (void)sprintf(ma_ebuf,
1711 "memhandle %ld (name: '%s') not top of stack",
1712 (size_t)memhandle, ad->name);
1713 ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1714 return MA_FALSE;
1715 }
1716 }
1717 else if (check_heapandstack)
1718 {
1719 if ((!list_member(ad, ma_hused)) && (!list_member(ad, ma_sused)))
1720 {
1721 (void)sprintf(ma_ebuf,
1722 "memhandle %ld (name: '%s') not in heap or stack",
1723 (size_t)memhandle, ad->name);
1724 ma_error(EL_Nonfatal, ET_External, caller, ma_ebuf);
1725 return MA_FALSE;
1726 }
1727 }
1728
1729 /* ad is valid */
1730 *adout = ad;
1731 return MA_TRUE;
1732 }
1733
1734 /* ------------------------------------------------------------------------- */
1735 /*
1736 * Free the memhandle corresponding to the given AD.
1737 */
1738 /* ------------------------------------------------------------------------- */
1739
mh_free(ad)1740 private void mh_free(ad)
1741 AD *ad; /* the AD whose memhandle to free */
1742 {
1743 Integer memhandle; /* memhandle for AD */
1744
1745 /* convert AD to memhandle */
1746 if ((memhandle = ma_table_lookup_assoc((TableData)ad)) == TABLE_HANDLE_NONE)
1747 {
1748 (void)sprintf(ma_ebuf,
1749 "cannot find memhandle for block address 0x%lx",
1750 (size_t)ad);
1751 ma_error(EL_Nonfatal, ET_Internal, "mh_free", ma_ebuf);
1752 }
1753 else
1754 /* free memhandle */
1755 ma_table_deallocate(memhandle);
1756 }
1757
1758 /* ------------------------------------------------------------------------- */
1759 /*
1760 * Return the first multiple of unit which is >= value.
1761 */
1762 /* ------------------------------------------------------------------------- */
1763
mai_round(value,unit)1764 private size_t mai_round(value, unit)
1765 size_t value; /* to round */
1766 ulongi unit; /* to round to */
1767 {
1768 /* voodoo ... */
1769 unit--;
1770 value += unit;
1771 value &= ~(size_t)unit;
1772 return value;
1773 }
1774
1775 /* ------------------------------------------------------------------------- */
1776 /*
1777 * Copy at most maxchars-1 non-NUL chars from from to to; NUL-terminate to.
1778 */
1779 /* ------------------------------------------------------------------------- */
1780
str_ncopy(to,from,maxchars)1781 private void str_ncopy(to, from, maxchars)
1782 char *to; /* space to copy to */
1783 char *from; /* space to copy from */
1784 int maxchars; /* max # of chars (including NUL) copied */
1785 {
1786 if (from == (char *)NULL)
1787 {
1788 to[0] = '\0';
1789 return;
1790 }
1791
1792 /* copy up to maxchars chars */
1793 (void)strncpy(to, from, maxchars);
1794
1795 /* ensure to is NUL-terminated */
1796 to[maxchars-1] = '\0';
1797 }
1798
1799 /**
1800 ** public routines for internal use only
1801 **/
1802
1803 /* ------------------------------------------------------------------------- */
1804 /*
1805 * Set the base address and size of the given datatype.
1806 */
1807 /* ------------------------------------------------------------------------- */
1808
MAi_inform_base(datatype,address1,address2)1809 public Boolean MAi_inform_base(datatype, address1, address2)
1810 Integer datatype; /* to set size of */
1811 Pointer address1; /* of datatype element base */
1812 Pointer address2; /* of an adjacent datatype element */
1813 {
1814 /* verify uninitialization */
1815 if (ma_initialized)
1816 {
1817 (void)sprintf(ma_ebuf,
1818 "MA already initialized");
1819 ma_error(EL_Nonfatal, ET_Internal, "MAi_inform_base", ma_ebuf);
1820 return MA_FALSE;
1821 }
1822
1823 /* verify datatype */
1824 if (!mt_valid(datatype))
1825 {
1826 (void)sprintf(ma_ebuf,
1827 "invalid datatype: %ld",
1828 (size_t)datatype);
1829 ma_error(EL_Nonfatal, ET_Internal, "MAi_inform_base", ma_ebuf);
1830 return MA_FALSE;
1831 }
1832
1833 /* convert datatype to internal (index-suitable) value */
1834 datatype = mt_import(datatype);
1835
1836 /* set the base address of datatype */
1837 ma_base[datatype] = address1;
1838
1839 /* set the size of datatype */
1840 ma_sizeof[datatype] = (int)(address2 - address1);
1841
1842 /* success */
1843 return MA_TRUE;
1844 }
1845
1846 #if NOFORT
ma_set_sizes_()1847 Integer ma_set_sizes_()
1848 {
1849 MAi_inform_base(MT_F_BYTE, (Pointer)&ma_fb_byte[0], (Pointer)&ma_fb_byte[1]);
1850 MAi_inform_base(MT_F_INT, (Pointer)&ma_fb_integer[0], (Pointer)&ma_fb_integer[1]);
1851 MAi_inform_base(MT_F_LOG, (Pointer)&ma_fb_logical[0], (Pointer)&ma_fb_logical[1]);
1852 MAi_inform_base(MT_F_REAL, (Pointer)&ma_fb_real[0], (Pointer)&ma_fb_real[1]);
1853 MAi_inform_base(MT_F_DBL, (Pointer)&ma_fb_dbl[0], (Pointer)&ma_fb_dbl[1]);
1854 MAi_inform_base(MT_F_SCPL, (Pointer)&ma_fb_scpl[0], (Pointer)&ma_fb_scpl[1]);
1855 MAi_inform_base(MT_F_DCPL, (Pointer)&ma_fb_dcpl[0], (Pointer)&ma_fb_dcpl[1]);
1856 return 1;
1857 }
1858 #endif
1859
1860 /* ------------------------------------------------------------------------- */
1861 /*
1862 * Print debugging information about all blocks currently in use
1863 * on the heap or the stack.
1864 */
1865 /* ------------------------------------------------------------------------- */
1866
MAi_summarize_allocated_blocks(index_base)1867 public void MAi_summarize_allocated_blocks(index_base)
1868 int index_base; /* 0 (C) or 1 (FORTRAN) */
1869 {
1870 int heap_blocks; /* # of blocks on heap used list */
1871 int stack_blocks; /* # of blocks on stack used list */
1872
1873 #ifdef STATS
1874 ma_stats.calls[(int)FID_MA_summarize_allocated_blocks]++;
1875 #endif /* STATS */
1876
1877 #ifdef VERIFY
1878 if (ma_auto_verify && !MA_verify_allocator_stuff())
1879 return;
1880 #endif /* VERIFY */
1881
1882 /* verify index_base */
1883 if ((index_base != 0) && (index_base != 1))
1884 {
1885 (void)sprintf(ma_ebuf,
1886 "invalid index_base: %d",
1887 index_base);
1888 ma_error(EL_Nonfatal, ET_Internal, "MAi_summarize_allocated_blocks", ma_ebuf);
1889 return;
1890 }
1891
1892 (void)printf("MA_summarize_allocated_blocks: starting scan ...\n");
1893
1894 /* print blocks on the heap used list */
1895 heap_blocks = list_print(ma_hused, "heap", index_base);
1896
1897 /* print blocks on the stack used list */
1898 stack_blocks = list_print(ma_sused, "stack", index_base);
1899
1900 (void)printf("MA_summarize_allocated_blocks: scan completed: ");
1901 (void)printf("%d heap block%s, %d stack block%s\n",
1902 heap_blocks,
1903 plural(heap_blocks),
1904 stack_blocks,
1905 plural(stack_blocks));
1906 }
1907
1908 /**
1909 ** public routines
1910 **/
1911
1912 /* ------------------------------------------------------------------------- */
1913 /*
1914 * Convenience function that combines MA_allocate_heap and MA_get_index.
1915 */
1916 /* ------------------------------------------------------------------------- */
1917
MA_alloc_get(Integer datatype,Integer nelem,const char * name,Integer * memhandle,MA_AccessIndex * index)1918 public Boolean MA_alloc_get(
1919 Integer datatype, /* of elements in this block */
1920 Integer nelem, /* # of elements in this block */
1921 const char *name, /* assigned to this block by client */
1922 Integer *memhandle, /* RETURN: handle for this block */
1923 MA_AccessIndex *index /* RETURN: index for this block */ )
1924 {
1925 #ifdef STATS
1926 ma_stats.calls[(int)FID_MA_alloc_get]++;
1927 #endif /* STATS */
1928
1929 if (MA_allocate_heap(datatype, nelem, name, memhandle))
1930 /* MA_allocate_heap succeeded; try MA_get_index */
1931 return MA_get_index(*memhandle, index);
1932 else
1933 /* MA_allocate_heap failed */
1934 return MA_FALSE;
1935 }
1936
1937 /* ------------------------------------------------------------------------- */
1938 /*
1939 * Allocate a heap block big enough to hold nelem elements
1940 * of the given datatype.
1941 *
1942 * Return MA_TRUE upon success, or MA_FALSE upon failure.
1943 */
1944 /* ------------------------------------------------------------------------- */
1945
MA_allocate_heap(Integer datatype,Integer nelem,const char * name,Integer * memhandle)1946 public Boolean MA_allocate_heap(
1947 Integer datatype, /* of elements in this block */
1948 Integer nelem, /* # of elements in this block */
1949 const char *name, /* assigned to this block by client */
1950 Integer *memhandle /* RETURN: handle for this block */ )
1951 {
1952 AR ar; /* allocation request */
1953 AD *ad; /* AD for newly allocated block */
1954 Pointer client_space; /* location of client_space */
1955 ulongi nbytes; /* length of block for ar */
1956 Pointer new_hp; /* new ma_hp */
1957
1958 #ifdef STATS
1959 ma_stats.calls[(int)FID_MA_allocate_heap]++;
1960 #endif /* STATS */
1961
1962 #ifdef VERIFY
1963 if (ma_auto_verify && !MA_verify_allocator_stuff())
1964 return MA_FALSE;
1965 #endif /* VERIFY */
1966
1967 if (ma_trace)
1968 (void)printf("MA: allocating '%s' (%d)\n", name, (int)nelem);
1969
1970 /* verify initialization */
1971 if (!ma_initialized)
1972 {
1973 (void)sprintf(ma_ebuf,
1974 "block '%s', MA not yet initialized",
1975 name);
1976 ma_error(EL_Nonfatal, ET_External, "MA_allocate_heap", ma_ebuf);
1977 return MA_FALSE;
1978 }
1979
1980 /* verify datatype */
1981 if (!mt_valid(datatype))
1982 {
1983 (void)sprintf(ma_ebuf,
1984 "block '%s', invalid datatype: %ld",
1985 name, (size_t)datatype);
1986 ma_error(EL_Nonfatal, ET_External, "MA_allocate_heap", ma_ebuf);
1987 return MA_FALSE;
1988 }
1989
1990 /* verify nelem */
1991 if (nelem < 0)
1992 {
1993 (void)sprintf(ma_ebuf,
1994 "block '%s', invalid nelem: %ld",
1995 name, (size_t)nelem);
1996 ma_error(EL_Nonfatal, ET_External, "MA_allocate_heap", ma_ebuf);
1997 return MA_FALSE;
1998 }
1999
2000 /* convert datatype to internal (index-suitable) value */
2001 datatype = mt_import(datatype);
2002
2003 /*
2004 * attempt to allocate space
2005 */
2006
2007 ar.datatype = datatype;
2008 ar.nelem = nelem;
2009
2010 /* search the free list */
2011 ad = list_delete_one(&ma_hfree, ad_big_enough, (Pointer)&ar);
2012
2013 /* if search of free list failed, try expanding heap region */
2014 if (ad == (AD *)NULL)
2015 {
2016 /* perform trial allocation to determine size */
2017 balloc_after(&ar, ma_hp, &client_space, &nbytes);
2018
2019 new_hp = ma_hp + nbytes;
2020 if (new_hp > ma_sp)
2021 {
2022 (void)sprintf(ma_ebuf,
2023 "block '%s', not enough space to allocate %lu bytes",
2024 name, nbytes);
2025 ma_error(EL_Nonfatal, ET_External, "MA_allocate_heap", ma_ebuf);
2026 return MA_FALSE;
2027 }
2028 else
2029 {
2030 /* heap region expanded successfully */
2031 ad = (AD *)ma_hp;
2032
2033 /* set fields appropriately */
2034 ad->client_space = client_space;
2035 ad->nbytes = nbytes;
2036 }
2037 }
2038
2039 /*
2040 * space has been allocated
2041 */
2042
2043 /* initialize the AD */
2044 ad->datatype = datatype;
2045 ad->nelem = nelem;
2046 str_ncopy(ad->name, (char*)name, MA_NAMESIZE);
2047 /* ad->client_space is already set */
2048 /* ad->nbytes is already set */
2049 list_insert(ad, &ma_hused);
2050 ad->checksum = checksum(ad);
2051
2052 /* set the guards */
2053 guard_set(ad);
2054
2055 #ifdef DEBUG
2056 debug_ad_print(ad);
2057 #endif /* DEBUG */
2058
2059 /* update ma_hp if necessary */
2060 new_hp = (Pointer)ad + ad->nbytes;
2061 if (new_hp > ma_hp)
2062 {
2063 ma_hp = new_hp;
2064 }
2065
2066 #ifdef STATS
2067 ma_stats.hblocks++;
2068 ma_stats.hblocks_max = max(ma_stats.hblocks, ma_stats.hblocks_max);
2069 ma_stats.hbytes += ad->nbytes;
2070 ma_stats.hbytes_max = max(ma_stats.hbytes, ma_stats.hbytes_max);
2071 #endif /* STATS */
2072
2073 /* convert AD to memhandle */
2074 if ((*memhandle = ma_table_allocate((TableData)ad)) == TABLE_HANDLE_NONE)
2075 /* failure */
2076 return MA_FALSE;
2077 else
2078 /* success */
2079 return MA_TRUE;
2080 }
2081
2082 /* ------------------------------------------------------------------------- */
2083 /*
2084 * Deallocate the given stack block and all stack blocks allocated
2085 * after it.
2086 *
2087 * Return MA_TRUE upon success, or MA_FALSE upon failure.
2088 */
2089 /* ------------------------------------------------------------------------- */
2090
MA_chop_stack(Integer memhandle)2091 public Boolean MA_chop_stack(Integer memhandle)/*the block to deallocate up to*/
2092 {
2093 AD *ad; /* AD for memhandle */
2094
2095 #ifdef STATS
2096 ma_stats.calls[(int)FID_MA_chop_stack]++;
2097 #endif /* STATS */
2098
2099 #ifdef VERIFY
2100 if (ma_auto_verify && !MA_verify_allocator_stuff())
2101 return MA_FALSE;
2102 #endif /* VERIFY */
2103
2104 /* verify memhandle and convert to AD */
2105 if (!mh2ad(memhandle, &ad, BL_Stack, "MA_chop_stack"))
2106 return MA_FALSE;
2107
2108 /* delete block and all blocks above it from used list */
2109 #ifdef STATS
2110 ma_stats.sblocks -=
2111 list_delete_many(&ma_sused, ad_le, (Pointer)ad, mh_free);
2112 #else
2113 (void)list_delete_many(&ma_sused, ad_le, (Pointer)ad, mh_free);
2114 #endif /* STATS */
2115
2116 /* pop block and all blocks above it from stack */
2117 #ifdef STATS
2118 ma_stats.sbytes -= (((Pointer)ad + ad->nbytes) - ma_sp);
2119 #endif /* STATS */
2120 ma_sp = (Pointer)ad + ad->nbytes;
2121
2122 /* success */
2123 return MA_TRUE;
2124 }
2125
2126 /* ------------------------------------------------------------------------- */
2127 /*
2128 * Deallocate the given heap block.
2129 *
2130 * Return MA_TRUE upon success, or MA_FALSE upon failure.
2131 */
2132 /* ------------------------------------------------------------------------- */
2133
MA_free_heap(Integer memhandle)2134 public Boolean MA_free_heap(Integer memhandle) /* the block to deallocate */
2135 {
2136 AD *ad; /* AD for memhandle */
2137
2138 #ifdef STATS
2139 ma_stats.calls[(int)FID_MA_free_heap]++;
2140 #endif /* STATS */
2141
2142 #ifdef VERIFY
2143 if (ma_auto_verify && !MA_verify_allocator_stuff())
2144 return MA_FALSE;
2145 #endif /* VERIFY */
2146
2147 /* verify memhandle and convert to AD */
2148 if (!mh2ad(memhandle, &ad, BL_Heap, "MA_free_heap"))
2149 return MA_FALSE;
2150
2151 if (ma_trace)
2152 (void)printf("MA: freeing '%s'\n", ad->name);
2153
2154 /* delete block from used list */
2155 if (list_delete(ad, &ma_hused) != ad)
2156 {
2157 (void)sprintf(ma_ebuf,
2158 "memhandle %ld (name: '%s') not on heap used list",
2159 (size_t)memhandle, ad->name);
2160 ma_error(EL_Nonfatal, ET_Internal, "MA_free_heap", ma_ebuf);
2161 return MA_FALSE;
2162 }
2163
2164 #ifdef STATS
2165 ma_stats.hblocks--;
2166 ma_stats.hbytes -= ad->nbytes;
2167 #endif /* STATS */
2168
2169 /* reclaim the deallocated block */
2170 block_free_heap(ad);
2171
2172 /* free memhandle */
2173 ma_table_deallocate(memhandle);
2174
2175 /* success */
2176 return MA_TRUE;
2177 }
2178
2179 /* ------------------------------------------------------------------------- */
2180 /*
2181 * Deallocate nelem elements from the given heap block.
2182 *
2183 * The nelem elements (of the datatype specified when the heap block
2184 * was allocated) to be deallocated are assumed to be at the rightmost
2185 * (i.e., higher addresses) edge of the heap block.
2186 *
2187 * Return MA_TRUE upon success, or MA_FALSE upon failure.
2188 */
2189 /* ------------------------------------------------------------------------- */
2190
MA_free_heap_piece(Integer memhandle,Integer nelem)2191 public Boolean MA_free_heap_piece(
2192 Integer memhandle, /* the block to deallocate a piece of */
2193 Integer nelem /* # of elements to deallocate */)
2194 {
2195 AD *ad; /* AD for memhandle */
2196 AD *ad_reclaim; /* AD for data returned */
2197 AR ar; /* AR for data kept */
2198 Pointer client_space; /* location of client_space */
2199 ulongi nbytes; /* length of block for data kept */
2200
2201 #ifdef STATS
2202 ma_stats.calls[(int)FID_MA_free_heap_piece]++;
2203 #endif /* STATS */
2204
2205 #ifdef VERIFY
2206 if (ma_auto_verify && !MA_verify_allocator_stuff())
2207 return MA_FALSE;
2208 #endif /* VERIFY */
2209
2210 /* verify memhandle and convert to AD */
2211 if (!mh2ad(memhandle, &ad, BL_Heap, "MA_free_heap_piece"))
2212 return MA_FALSE;
2213
2214 /* verify nelem */
2215 if (nelem < 0)
2216 {
2217 (void)sprintf(ma_ebuf,
2218 "block '%s', invalid nelem: %ld",
2219 ad->name, (size_t)nelem);
2220 ma_error(EL_Nonfatal, ET_External, "MA_free_heap_piece", ma_ebuf);
2221 return MA_FALSE;
2222 }
2223 else if (nelem >= ad->nelem)
2224 {
2225 /* deallocate the whole block */
2226 return MA_free_heap(memhandle);
2227 }
2228
2229 if (ma_trace)
2230 (void)printf("MA: freeing %ld elements of '%s'\n",
2231 (size_t)nelem, ad->name);
2232
2233 /* set AR for data to keep */
2234 ar.datatype = ad->datatype;
2235 ar.nelem = ad->nelem - nelem;
2236
2237 /* perform trial allocation to determine size */
2238 balloc_after(&ar, (Pointer)ad, &client_space, &nbytes);
2239
2240 if (nbytes < ad->nbytes)
2241 {
2242 /* ad has extra space; split block if possible */
2243 ad_reclaim = block_split(ad, nbytes, (Boolean)MA_FALSE);
2244
2245 if (ad_reclaim)
2246 {
2247 #ifdef STATS
2248 ma_stats.hbytes -= ad_reclaim->nbytes;
2249 #endif /* STATS */
2250
2251 /* reclaim the deallocated (new) block */
2252 block_free_heap(ad_reclaim);
2253 }
2254 }
2255
2256 /* update surviving block */
2257 ad->nelem = ar.nelem;
2258 ad->checksum = checksum(ad);
2259
2260 /* set the guards */
2261 guard_set(ad);
2262
2263 #ifdef DEBUG
2264 debug_ad_print(ad);
2265 #endif /* DEBUG */
2266
2267 /* success */
2268 return MA_TRUE;
2269 }
2270
2271 /* ------------------------------------------------------------------------- */
2272 /*
2273 * Get the base index for the given block.
2274 *
2275 * Return MA_TRUE upon success, or MA_FALSE upon failure.
2276 */
2277 /* ------------------------------------------------------------------------- */
2278
MA_get_index(Integer memhandle,MA_AccessIndex * index)2279 public Boolean MA_get_index(
2280 Integer memhandle, /* block to get index for */
2281 MA_AccessIndex *index /* RETURN: base index */)
2282 {
2283 AD *ad; /* AD for memhandle */
2284
2285 #ifdef STATS
2286 ma_stats.calls[(int)FID_MA_get_index]++;
2287 #endif /* STATS */
2288
2289 #ifdef VERIFY
2290 if (ma_auto_verify && !MA_verify_allocator_stuff())
2291 return MA_FALSE;
2292 #endif /* VERIFY */
2293
2294 /* verify memhandle and convert to AD */
2295 if (mh2ad(memhandle, &ad, BL_HeapOrStack, "MA_get_index"))
2296 {
2297 /* compute index */
2298 *index = client_space_index(ad);
2299
2300 /* success */
2301 return MA_TRUE;
2302 }
2303 else
2304 {
2305 /* failure */
2306 return MA_FALSE;
2307 }
2308 }
2309
2310 /* ------------------------------------------------------------------------- */
2311 /*
2312 * Return the base address of the given datatype.
2313 */
2314 /* ------------------------------------------------------------------------- */
2315
MA_get_mbase(Integer datatype)2316 public Pointer MA_get_mbase(Integer datatype) /* to get base address of */
2317 {
2318 #ifdef STATS
2319 ma_stats.calls[(int)FID_MA_get_mbase]++;
2320 #endif /* STATS */
2321
2322 /* preinitialize if necessary */
2323 ma_preinitialize("MA_get_mbase");
2324
2325 /* verify datatype */
2326 if (!mt_valid(datatype))
2327 {
2328 (void)sprintf(ma_ebuf,
2329 "invalid datatype: %ld",
2330 (size_t)datatype);
2331 ma_error(EL_Fatal, ET_External, "MA_get_mbase", ma_ebuf);
2332 return NULL;
2333 }
2334
2335 /* convert datatype to internal (index-suitable) value */
2336 datatype = mt_import(datatype);
2337
2338 return ma_base[datatype];
2339 }
2340
2341 /* ------------------------------------------------------------------------- */
2342 /*
2343 * Get the handle for the next block in the scan of currently allocated
2344 * blocks.
2345 *
2346 * Return MA_TRUE upon success, or MA_FALSE upon failure.
2347 */
2348 /* ------------------------------------------------------------------------- */
2349
MA_get_next_memhandle(Integer * ithandle,Integer * memhandle)2350 public Boolean MA_get_next_memhandle(
2351 Integer *ithandle, /* handle for this iterator */
2352 Integer *memhandle /* RETURN: handle for the next block */)
2353 {
2354 #ifdef STATS
2355 ma_stats.calls[(int)FID_MA_get_next_memhandle]++;
2356 #endif /* STATS */
2357
2358 #ifdef VERIFY
2359 if (ma_auto_verify && !MA_verify_allocator_stuff())
2360 return MA_FALSE;
2361 #endif /* VERIFY */
2362
2363 /* not yet implemented */
2364 (void)sprintf(ma_ebuf,
2365 "not yet implemented");
2366 ma_error(EL_Nonfatal, ET_External, "MA_get_next_memhandle", ma_ebuf);
2367 return MA_FALSE;
2368 }
2369
2370 /* ------------------------------------------------------------------------- */
2371 /*
2372 * Get the requested alignment.
2373 *
2374 * Return MA_TRUE upon success, or MA_FALSE upon failure.
2375 */
2376 /* ------------------------------------------------------------------------- */
2377
MA_get_numalign(Integer * value)2378 public Boolean MA_get_numalign(Integer *value)
2379 /* RETURN: requested alignment */
2380 {
2381 #ifdef STATS
2382 ma_stats.calls[(int)FID_MA_get_numalign]++;
2383 #endif /* STATS */
2384
2385 *value = ma_numalign;
2386 return MA_TRUE;
2387 }
2388
2389 /* ------------------------------------------------------------------------- */
2390 /*
2391 * Get the base pointer for the given block.
2392 *
2393 * Return MA_TRUE upon success, or MA_FALSE upon failure.
2394 */
2395 /* ------------------------------------------------------------------------- */
2396
2397 /* JN converted to void* to avoid calling hassles */
MA_get_pointer(Integer memhandle,void * pointer)2398 public Boolean MA_get_pointer(
2399 Integer memhandle, /* block to get pointer for */
2400 void *pointer /* RETURN: base pointer */)
2401 {
2402 AD *ad; /* AD for memhandle */
2403
2404 #ifdef STATS
2405 ma_stats.calls[(int)FID_MA_get_pointer]++;
2406 #endif /* STATS */
2407
2408 #ifdef VERIFY
2409 if (ma_auto_verify && !MA_verify_allocator_stuff())
2410 return MA_FALSE;
2411 #endif /* VERIFY */
2412
2413 /* verify memhandle and convert to AD */
2414 if (mh2ad(memhandle, &ad, BL_HeapOrStack, "MA_get_pointer"))
2415 {
2416 /* compute pointer */
2417 #if 0
2418 *pointer = ad->client_space;
2419 #endif
2420 *(char**)pointer = ad->client_space;
2421
2422 /* success */
2423 return MA_TRUE;
2424 }
2425 else
2426 {
2427 /* failure */
2428 return MA_FALSE;
2429 }
2430 }
2431
2432 /* ------------------------------------------------------------------------- */
2433 /*
2434 * Initialize the memory allocator.
2435 *
2436 * Return MA_TRUE upon success, or MA_FALSE upon failure.
2437 */
2438 /* ------------------------------------------------------------------------- */
2439
MA_init(Integer datatype,Integer nominal_stack,Integer nominal_heap)2440 public Boolean MA_init(
2441 Integer datatype, /* for computing storage requirement */
2442 Integer nominal_stack, /* # of datatype elements desired for stack */
2443 Integer nominal_heap /* # of datatype elements desired for heap */)
2444 {
2445 ulongi heap_bytes; /* # of bytes for heap */
2446 ulongi stack_bytes; /* # of bytes for stack */
2447 ulongi total_bytes; /* total # of bytes */
2448
2449 #ifdef STATS
2450 ma_stats.calls[(int)FID_MA_init]++;
2451 #endif /* STATS */
2452
2453 #ifdef VERIFY
2454 if (ma_auto_verify && !MA_verify_allocator_stuff())
2455 return MA_FALSE;
2456 #endif /* VERIFY */
2457
2458 /* preinitialize if necessary */
2459 ma_preinitialize("MA_init");
2460
2461 /* verify uninitialization */
2462 if (ma_initialized)
2463 {
2464 (void)sprintf(ma_ebuf,
2465 "MA already initialized");
2466 ma_error(EL_Nonfatal, ET_External, "MA_init", ma_ebuf);
2467 return MA_FALSE;
2468 }
2469
2470 /* verify datatype */
2471 if (!mt_valid(datatype))
2472 {
2473 (void)sprintf(ma_ebuf,
2474 "invalid datatype: %ld",
2475 (size_t)datatype);
2476 ma_error(EL_Nonfatal, ET_External, "MA_init", ma_ebuf);
2477 return MA_FALSE;
2478 }
2479
2480 /* convert datatype to internal (index-suitable) value */
2481 datatype = mt_import(datatype);
2482
2483 /* compute # of bytes in heap */
2484 if (nominal_heap < 0)
2485 {
2486 heap_bytes = DEFAULT_TOTAL_HEAP;
2487 }
2488 else
2489 {
2490 heap_bytes = (nominal_heap * ma_sizeof[datatype]) +
2491 (DEFAULT_REQUESTS_HEAP * max_block_overhead(datatype));
2492 }
2493 heap_bytes = (size_t)mai_round((size_t)heap_bytes, (ulongi)ALIGNMENT);
2494
2495 /* compute # of bytes in stack */
2496 if (nominal_stack < 0)
2497 {
2498 stack_bytes = DEFAULT_TOTAL_STACK;
2499 }
2500 else
2501 {
2502 stack_bytes = (nominal_stack * ma_sizeof[datatype]) +
2503 (DEFAULT_REQUESTS_STACK * max_block_overhead(datatype));
2504 }
2505 stack_bytes = (size_t)mai_round((size_t)stack_bytes, (ulongi)ALIGNMENT);
2506
2507 /* segment consists of heap and stack */
2508 total_bytes = heap_bytes + stack_bytes;
2509 #ifdef NOUSE_MMAP
2510 /* disable memory mapped malloc */
2511 mallopt(M_MMAP_MAX, 0);
2512 mallopt(M_TRIM_THRESHOLD, -1);
2513 #endif
2514 /* allocate the segment of memory */
2515 #ifdef ENABLE_ARMCI_MEM_OPTION
2516 if(getenv("MA_USE_ARMCI_MEM"))
2517 {
2518 ma_segment = (Pointer)ARMCI_Malloc_local(total_bytes);
2519 }
2520 else
2521 #endif
2522 ma_segment = (Pointer)bytealloc(total_bytes);
2523 if (ma_segment == (Pointer)NULL)
2524 {
2525 (void)sprintf(ma_ebuf,
2526 "could not allocate %lu bytes",
2527 total_bytes);
2528 ma_error(EL_Nonfatal, ET_External, "MA_init", ma_ebuf);
2529 return MA_FALSE;
2530 }
2531
2532 /*
2533 * initialize management stuff
2534 */
2535
2536 /* partition is at (first address past) end of heap */
2537 ma_partition = ma_segment + heap_bytes;
2538 /* compute (first address past) end of segment */
2539 ma_eos = ma_segment + total_bytes;
2540 /* ma_hp initially points at start of segment */
2541 ma_hp = ma_segment;
2542 /* ma_sp initially points at end of segment */
2543 ma_sp = ma_eos;
2544
2545 /* lists are all initially empty */
2546 ma_hfree = (AD *)NULL;
2547 ma_hused = (AD *)NULL;
2548 ma_sused = (AD *)NULL;
2549
2550 /* we are now initialized */
2551 ma_initialized = MA_TRUE;
2552
2553 /* success */
2554 return MA_TRUE;
2555 }
2556
2557 /* ------------------------------------------------------------------------- */
2558 /*
2559 * Return MA_TRUE if MA_init has been called successfully,
2560 * else return MA_FALSE.
2561 */
2562 /* ------------------------------------------------------------------------- */
2563
MA_initialized()2564 public Boolean MA_initialized()
2565 {
2566 #ifdef STATS
2567 ma_stats.calls[(int)FID_MA_initialized]++;
2568 #endif /* STATS */
2569
2570 return ma_initialized;
2571 }
2572
2573 /* ------------------------------------------------------------------------- */
2574 /*
2575 * Initialize a scan of currently allocated blocks.
2576 *
2577 * Return MA_TRUE upon success, or MA_FALSE upon failure.
2578 */
2579 /* ------------------------------------------------------------------------- */
2580
MA_init_memhandle_iterator(Integer * ithandle)2581 public Boolean MA_init_memhandle_iterator( Integer *ithandle)
2582 {
2583 #ifdef STATS
2584 ma_stats.calls[(int)FID_MA_init_memhandle_iterator]++;
2585 #endif /* STATS */
2586
2587 #ifdef VERIFY
2588 if (ma_auto_verify && !MA_verify_allocator_stuff())
2589 return MA_FALSE;
2590 #endif /* VERIFY */
2591
2592 /* not yet implemented */
2593 (void)sprintf(ma_ebuf,
2594 "not yet implemented");
2595 ma_error(EL_Nonfatal, ET_External, "MA_init_memhandle_iterator", ma_ebuf);
2596 return MA_FALSE;
2597 }
2598
2599 /* ------------------------------------------------------------------------- */
2600 /*
2601 * Return the maximum number of datatype elements that can currently
2602 * be allocated in the space between the heap and the stack, in a single
2603 * allocation request, ignoring the partition defined at initialization.
2604 *
2605 * Note that this might not be the largest piece of memory available;
2606 * the heap may contain deallocated blocks that are larger.
2607 */
2608 /* ------------------------------------------------------------------------- */
2609
MA_inquire_avail(Integer datatype)2610 public Integer MA_inquire_avail(Integer datatype)
2611 {
2612 size_t gap_length; /* # of bytes between heap and stack */
2613 Integer nelem_gap; /* max elements containable in gap */
2614
2615 #ifdef STATS
2616 ma_stats.calls[(int)FID_MA_inquire_avail]++;
2617 #endif /* STATS */
2618
2619 #ifdef VERIFY
2620 if (ma_auto_verify && !MA_verify_allocator_stuff())
2621 return DONTCARE;
2622 #endif /* VERIFY */
2623
2624 /* verify initialization */
2625 if (!ma_initialized)
2626 {
2627 (void)sprintf(ma_ebuf,
2628 "MA not yet initialized");
2629 ma_error(EL_Nonfatal, ET_External, "MA_inquire_avail", ma_ebuf);
2630 return (Integer)0;
2631 }
2632
2633 /* verify datatype */
2634 if (!mt_valid(datatype))
2635 {
2636 (void)sprintf(ma_ebuf,
2637 "invalid datatype: %ld",
2638 (size_t)datatype);
2639 ma_error(EL_Fatal, ET_External, "MA_inquire_avail", ma_ebuf);
2640 return DONTCARE;
2641 }
2642
2643 /* convert datatype to internal (index-suitable) value */
2644 datatype = mt_import(datatype);
2645
2646 /*
2647 * compute the # of elements for which space is available
2648 */
2649
2650 /* try space between heap and stack */
2651 gap_length = (size_t)(ma_sp - ma_hp);
2652 if (gap_length > 0)
2653 nelem_gap = ma_nelem(ma_hp, (ulongi)gap_length, datatype);
2654 else
2655 nelem_gap = 0;
2656
2657 /* success */
2658 return nelem_gap;
2659 }
2660
2661 /* ------------------------------------------------------------------------- */
2662 /*
2663 * Return the maximum number of datatype elements that can currently
2664 * be allocated in the heap, in a single allocation request,
2665 * honoring the partition defined at initialization.
2666 *
2667 * This routine does not check the stack. Therefore, if the stack
2668 * has overgrown the partition, the answer returned by this routine
2669 * might be incorrect, i.e., there might be less memory available
2670 * than this routine indicates.
2671 */
2672 /* ------------------------------------------------------------------------- */
2673
MA_inquire_heap(Integer datatype)2674 public Integer MA_inquire_heap(Integer datatype)
2675 {
2676 size_t gap_length; /* # of bytes between heap and partition */
2677 Integer nelem_gap; /* max elements containable in gap */
2678 Integer nelem_frag; /* max elements containable in any frag */
2679
2680 #ifdef STATS
2681 ma_stats.calls[(int)FID_MA_inquire_heap]++;
2682 #endif /* STATS */
2683
2684 #ifdef VERIFY
2685 if (ma_auto_verify && !MA_verify_allocator_stuff())
2686 return DONTCARE;
2687 #endif /* VERIFY */
2688
2689 /* verify initialization */
2690 if (!ma_initialized)
2691 {
2692 (void)sprintf(ma_ebuf,
2693 "MA not yet initialized");
2694 ma_error(EL_Nonfatal, ET_External, "MA_inquire_heap", ma_ebuf);
2695 return (Integer)0;
2696 }
2697
2698 /* verify datatype */
2699 if (!mt_valid(datatype))
2700 {
2701 (void)sprintf(ma_ebuf,
2702 "invalid datatype: %ld",
2703 (size_t)datatype);
2704 ma_error(EL_Fatal, ET_External, "MA_inquire_heap", ma_ebuf);
2705 return DONTCARE;
2706 }
2707
2708 /* convert datatype to internal (index-suitable) value */
2709 datatype = mt_import(datatype);
2710
2711 /*
2712 * compute the # of elements for which space is available
2713 */
2714
2715 /* try space between heap and partition */
2716 gap_length = (size_t)(ma_partition - ma_hp);
2717 if (gap_length > 0)
2718 nelem_gap = ma_nelem(ma_hp, (ulongi)gap_length, datatype);
2719 else
2720 nelem_gap = 0;
2721
2722 /* try heap fragments */
2723 nelem_frag = ma_max_heap_frag_nelem(datatype, nelem_gap);
2724
2725 /* success */
2726 return max(nelem_gap, nelem_frag);
2727 }
2728
2729 /* ------------------------------------------------------------------------- */
2730 /*
2731 * Return the maximum number of datatype elements that can currently
2732 * be allocated in the heap, in a single allocation request,
2733 * honoring the partition defined at initialization.
2734 *
2735 * This routine does check the stack. Therefore, whether or not the stack
2736 * has overgrown the partition, the answer returned by this routine
2737 * will be correct, i.e., there will be at least the memory available
2738 * that this routine indicates.
2739 *
2740 * Note that this might not be the largest piece of memory available;
2741 * the space between the heap and the stack may be larger.
2742 */
2743 /* ------------------------------------------------------------------------- */
2744
MA_inquire_heap_check_stack(Integer datatype)2745 public Integer MA_inquire_heap_check_stack(Integer datatype)
2746 {
2747 size_t gap_length; /* # of bytes between heap and partition */
2748 Integer nelem_gap; /* max elements containable in gap */
2749 Integer nelem_frag; /* max elements containable in any frag */
2750
2751 #ifdef STATS
2752 ma_stats.calls[(int)FID_MA_inquire_heap_check_stack]++;
2753 #endif /* STATS */
2754
2755 #ifdef VERIFY
2756 if (ma_auto_verify && !MA_verify_allocator_stuff())
2757 return DONTCARE;
2758 #endif /* VERIFY */
2759
2760 /* verify initialization */
2761 if (!ma_initialized)
2762 {
2763 (void)sprintf(ma_ebuf,
2764 "MA not yet initialized");
2765 ma_error(EL_Nonfatal, ET_External, "MA_inquire_heap_check_stack", ma_ebuf);
2766 return (Integer)0;
2767 }
2768
2769 /* verify datatype */
2770 if (!mt_valid(datatype))
2771 {
2772 (void)sprintf(ma_ebuf,
2773 "invalid datatype: %ld",
2774 (size_t)datatype);
2775 ma_error(EL_Fatal, ET_External, "MA_inquire_heap_check_stack", ma_ebuf);
2776 return DONTCARE;
2777 }
2778
2779 /* convert datatype to internal (index-suitable) value */
2780 datatype = mt_import(datatype);
2781
2782 /*
2783 * compute the # of elements for which space is available
2784 */
2785
2786 /* try space between heap and partition or heap and stack */
2787 gap_length = min((size_t)(ma_partition - ma_hp), (size_t)(ma_sp - ma_hp));
2788 if (gap_length > 0)
2789 nelem_gap = ma_nelem(ma_hp, (ulongi)gap_length, datatype);
2790 else
2791 nelem_gap = 0;
2792
2793 /* try heap fragments */
2794 nelem_frag = ma_max_heap_frag_nelem(datatype, nelem_gap);
2795
2796 /* success */
2797 return max(nelem_gap, nelem_frag);
2798 }
2799
2800 /* ------------------------------------------------------------------------- */
2801 /*
2802 * Return the maximum number of datatype elements that can currently
2803 * be allocated in the heap, in a single allocation request,
2804 * ignoring the partition defined at initialization.
2805 *
2806 * This routine does check the stack. Therefore, whether or not the stack
2807 * has overgrown the partition, the answer returned by this routine
2808 * will be correct, i.e., there will be at least the memory available
2809 * that this routine indicates.
2810 *
2811 * Note that this will be the largest piece of memory available.
2812 */
2813 /* ------------------------------------------------------------------------- */
2814
MA_inquire_heap_no_partition(Integer datatype)2815 public Integer MA_inquire_heap_no_partition(Integer datatype)
2816 {
2817 size_t gap_length; /* # of bytes between heap and partition */
2818 Integer nelem_gap; /* max elements containable in gap */
2819 Integer nelem_frag; /* max elements containable in any frag */
2820
2821 #ifdef STATS
2822 ma_stats.calls[(int)FID_MA_inquire_heap_no_partition]++;
2823 #endif /* STATS */
2824
2825 #ifdef VERIFY
2826 if (ma_auto_verify && !MA_verify_allocator_stuff())
2827 return DONTCARE;
2828 #endif /* VERIFY */
2829
2830 /* verify initialization */
2831 if (!ma_initialized)
2832 {
2833 (void)sprintf(ma_ebuf,
2834 "MA not yet initialized");
2835 ma_error(EL_Nonfatal, ET_External, "MA_inquire_heap_no_partition", ma_ebuf);
2836 return (Integer)0;
2837 }
2838
2839 /* verify datatype */
2840 if (!mt_valid(datatype))
2841 {
2842 (void)sprintf(ma_ebuf,
2843 "invalid datatype: %ld",
2844 (size_t)datatype);
2845 ma_error(EL_Fatal, ET_External, "MA_inquire_heap_no_partition", ma_ebuf);
2846 return DONTCARE;
2847 }
2848
2849 /* convert datatype to internal (index-suitable) value */
2850 datatype = mt_import(datatype);
2851
2852 /*
2853 * compute the # of elements for which space is available
2854 */
2855
2856 /* try space between heap and stack */
2857 gap_length = (size_t)(ma_sp - ma_hp);
2858 if (gap_length > 0)
2859 nelem_gap = ma_nelem(ma_hp, (ulongi)gap_length, datatype);
2860 else
2861 nelem_gap = 0;
2862
2863 /* try heap fragments */
2864 nelem_frag = ma_max_heap_frag_nelem(datatype, nelem_gap);
2865
2866 /* success */
2867 return max(nelem_gap, nelem_frag);
2868 }
2869
2870 /* ------------------------------------------------------------------------- */
2871 /*
2872 * Return the maximum number of datatype elements that can currently
2873 * be allocated in the stack, in a single allocation request,
2874 * honoring the partition defined at initialization.
2875 *
2876 * This routine does not check the heap. Therefore, if the heap
2877 * has overgrown the partition, the answer returned by this routine
2878 * might be incorrect, i.e., there might be less memory available
2879 * than this routine indicates.
2880 */
2881 /* ------------------------------------------------------------------------- */
2882
MA_inquire_stack(Integer datatype)2883 public Integer MA_inquire_stack(Integer datatype)
2884 {
2885 size_t gap_length; /* # of bytes between partition and stack */
2886 Integer nelem_gap; /* max elements containable in gap */
2887
2888 #ifdef STATS
2889 ma_stats.calls[(int)FID_MA_inquire_stack]++;
2890 #endif /* STATS */
2891
2892 #ifdef VERIFY
2893 if (ma_auto_verify && !MA_verify_allocator_stuff())
2894 return DONTCARE;
2895 #endif /* VERIFY */
2896
2897 /* verify initialization */
2898 if (!ma_initialized)
2899 {
2900 (void)sprintf(ma_ebuf,
2901 "MA not yet initialized");
2902 ma_error(EL_Nonfatal, ET_External, "MA_inquire_stack", ma_ebuf);
2903 return (Integer)0;
2904 }
2905
2906 /* verify datatype */
2907 if (!mt_valid(datatype))
2908 {
2909 (void)sprintf(ma_ebuf,
2910 "invalid datatype: %ld",
2911 (size_t)datatype);
2912 ma_error(EL_Fatal, ET_External, "MA_inquire_stack", ma_ebuf);
2913 return DONTCARE;
2914 }
2915
2916 /* convert datatype to internal (index-suitable) value */
2917 datatype = mt_import(datatype);
2918
2919 /*
2920 * compute the # of elements for which space is available
2921 */
2922
2923 /* try space between partition and stack */
2924 gap_length = (size_t)(ma_sp - ma_partition);
2925 if (gap_length > 0)
2926 nelem_gap = ma_nelem(ma_partition, (ulongi)gap_length, datatype);
2927 else
2928 nelem_gap = 0;
2929
2930 /* success */
2931 return nelem_gap;
2932 }
2933
2934 /* ------------------------------------------------------------------------- */
2935 /*
2936 * Return the maximum number of datatype elements that can currently
2937 * be allocated in the stack, in a single allocation request,
2938 * honoring the partition defined at initialization.
2939 *
2940 * This routine does check the heap. Therefore, whether or not the heap
2941 * has overgrown the partition, the answer returned by this routine
2942 * will be correct, i.e., there will be at least the memory available
2943 * that this routine indicates.
2944 *
2945 * Note that this might not be the largest piece of memory available;
2946 * the space between the heap and the stack may be larger.
2947 */
2948 /* ------------------------------------------------------------------------- */
2949
MA_inquire_stack_check_heap(Integer datatype)2950 public Integer MA_inquire_stack_check_heap(Integer datatype)
2951 {
2952 size_t gap_length; /* # of bytes between partition and stack */
2953 Integer nelem_gap; /* max elements containable in gap */
2954
2955 #ifdef STATS
2956 ma_stats.calls[(int)FID_MA_inquire_stack_check_heap]++;
2957 #endif /* STATS */
2958
2959 #ifdef VERIFY
2960 if (ma_auto_verify && !MA_verify_allocator_stuff())
2961 return DONTCARE;
2962 #endif /* VERIFY */
2963
2964 /* verify initialization */
2965 if (!ma_initialized)
2966 {
2967 (void)sprintf(ma_ebuf,
2968 "MA not yet initialized");
2969 ma_error(EL_Nonfatal, ET_External, "MA_inquire_stack_check_heap", ma_ebuf);
2970 return (Integer)0;
2971 }
2972
2973 /* verify datatype */
2974 if (!mt_valid(datatype))
2975 {
2976 (void)sprintf(ma_ebuf,
2977 "invalid datatype: %ld",
2978 (size_t)datatype);
2979 ma_error(EL_Fatal, ET_External, "MA_inquire_stack_check_heap", ma_ebuf);
2980 return DONTCARE;
2981 }
2982
2983 /* convert datatype to internal (index-suitable) value */
2984 datatype = mt_import(datatype);
2985
2986 /*
2987 * compute the # of elements for which space is available
2988 */
2989
2990 /* try space between partition and stack or heap and stack */
2991 gap_length = min((size_t)(ma_sp - ma_partition), (size_t)(ma_sp - ma_hp));
2992 if (gap_length > 0)
2993 nelem_gap = ma_nelem(ma_partition, (ulongi)gap_length, datatype);
2994 else
2995 nelem_gap = 0;
2996
2997 /* success */
2998 return nelem_gap;
2999 }
3000
3001 /* ------------------------------------------------------------------------- */
3002 /*
3003 * Return the maximum number of datatype elements that can currently
3004 * be allocated in the stack, in a single allocation request,
3005 * ignoring the partition defined at initialization.
3006 *
3007 * This routine does check the heap. Therefore, whether or not the heap
3008 * has overgrown the partition, the answer returned by this routine
3009 * will be correct, i.e., there will be at least the memory available
3010 * that this routine indicates.
3011 *
3012 * Note that this might not be the largest piece of memory available;
3013 * the heap may contain deallocated blocks that are larger.
3014 *
3015 * This routine is equivalent to MA_inquire_avail.
3016 */
3017 /* ------------------------------------------------------------------------- */
3018
MA_inquire_stack_no_partition(Integer datatype)3019 public Integer MA_inquire_stack_no_partition(Integer datatype)
3020 {
3021 size_t gap_length; /* # of bytes between heap and partition */
3022 Integer nelem_gap; /* max elements containable in gap */
3023
3024 #ifdef STATS
3025 ma_stats.calls[(int)FID_MA_inquire_stack_no_partition]++;
3026 #endif /* STATS */
3027
3028 #ifdef VERIFY
3029 if (ma_auto_verify && !MA_verify_allocator_stuff())
3030 return DONTCARE;
3031 #endif /* VERIFY */
3032
3033 /* verify initialization */
3034 if (!ma_initialized)
3035 {
3036 (void)sprintf(ma_ebuf,
3037 "MA not yet initialized");
3038 ma_error(EL_Nonfatal, ET_External, "MA_inquire_stack_no_partition", ma_ebuf);
3039 return (Integer)0;
3040 }
3041
3042 /* verify datatype */
3043 if (!mt_valid(datatype))
3044 {
3045 (void)sprintf(ma_ebuf,
3046 "invalid datatype: %ld",
3047 (size_t)datatype);
3048 ma_error(EL_Fatal, ET_External, "MA_inquire_stack_no_partition", ma_ebuf);
3049 return DONTCARE;
3050 }
3051
3052 /* convert datatype to internal (index-suitable) value */
3053 datatype = mt_import(datatype);
3054
3055 /*
3056 * compute the # of elements for which space is available
3057 */
3058
3059 /* try space between heap and stack */
3060 gap_length = (size_t)(ma_sp - ma_hp);
3061 if (gap_length > 0)
3062 nelem_gap = ma_nelem(ma_hp, (ulongi)gap_length, datatype);
3063 else
3064 nelem_gap = 0;
3065
3066 /* success */
3067 return nelem_gap;
3068 }
3069
3070 /* ------------------------------------------------------------------------- */
3071 /*
3072 * Deallocate the given stack block, which must be the one most recently
3073 * allocated.
3074 *
3075 * Return MA_TRUE upon success, or MA_FALSE upon failure.
3076 */
3077 /* ------------------------------------------------------------------------- */
3078
MA_pop_stack(Integer memhandle)3079 public Boolean MA_pop_stack(Integer memhandle) /* the block to deallocate */
3080 {
3081 AD *ad; /* AD for memhandle */
3082
3083 #ifdef STATS
3084 ma_stats.calls[(int)FID_MA_pop_stack]++;
3085 #endif /* STATS */
3086
3087 #ifdef VERIFY
3088 if (ma_auto_verify && !MA_verify_allocator_stuff())
3089 return MA_FALSE;
3090 #endif /* VERIFY */
3091
3092 /* verify memhandle and convert to AD */
3093 if (!mh2ad(memhandle, &ad, BL_StackTop, "MA_pop_stack"))
3094 return MA_FALSE;
3095
3096 if (ma_trace)
3097 (void)printf("MA: popping '%s'\n", ad->name);
3098
3099 /* delete block from used list */
3100 if (list_delete(ad, &ma_sused) != ad)
3101 {
3102 (void)sprintf(ma_ebuf,
3103 "memhandle %ld (name: '%s') not on stack used list",
3104 (size_t)memhandle, ad->name);
3105 ma_error(EL_Nonfatal, ET_Internal, "MA_pop_stack", ma_ebuf);
3106 return MA_FALSE;
3107 }
3108
3109 /* pop block from stack */
3110 ma_sp += ad->nbytes;
3111
3112 #ifdef STATS
3113 ma_stats.sblocks--;
3114 ma_stats.sbytes -= ad->nbytes;
3115 #endif /* STATS */
3116
3117 /* free memhandle */
3118 ma_table_deallocate(memhandle);
3119
3120 /* success */
3121 return MA_TRUE;
3122 }
3123
3124 /* ------------------------------------------------------------------------- */
3125 /*
3126 * Print usage statistics.
3127 */
3128 /* ------------------------------------------------------------------------- */
3129
MA_print_stats(Boolean printroutines)3130 public void MA_print_stats(Boolean printroutines)
3131 {
3132 #ifdef STATS
3133
3134 int i; /* loop index */
3135
3136 #ifdef STATS
3137 ma_stats.calls[(int)FID_MA_print_stats]++;
3138 #endif /* STATS */
3139
3140 #ifdef VERIFY
3141 if (ma_auto_verify && !MA_verify_allocator_stuff())
3142 return;
3143 #endif /* VERIFY */
3144
3145 (void)printf("MA usage statistics:\n");
3146 (void)printf("\n\tallocation statistics:\n");
3147 (void)printf("\t\t\t\t\t heap\t stack\n");
3148 (void)printf("\t\t\t\t\t ----\t -----\n");
3149 (void)printf("\tcurrent number of blocks\t%10lu\t%10lu\n",
3150 ma_stats.hblocks,
3151 ma_stats.sblocks);
3152 (void)printf("\tmaximum number of blocks\t%10lu\t%10lu\n",
3153 ma_stats.hblocks_max,
3154 ma_stats.sblocks_max);
3155 (void)printf("\tcurrent total bytes\t\t%10lu\t%10lu\n",
3156 ma_stats.hbytes,
3157 ma_stats.sbytes);
3158 (void)printf("\tmaximum total bytes\t\t%10lu\t%10lu\n",
3159 ma_stats.hbytes_max,
3160 ma_stats.sbytes_max);
3161 (void)printf("\tmaximum total K-bytes\t\t%10lu\t%10lu\n",
3162 ((ma_stats.hbytes_max+999)/1000),
3163 ((ma_stats.sbytes_max+999)/1000));
3164 (void)printf("\tmaximum total M-bytes\t\t%10lu\t%10lu\n",
3165 ((ma_stats.hbytes_max+999999)/1000000),
3166 ((ma_stats.sbytes_max+999999)/1000000));
3167 if (printroutines)
3168 {
3169 (void)printf("\n\tcalls per routine:\n");
3170 for (i = 0; i < NUMROUTINES; i++)
3171 (void)printf("\t\t%10lu %s\n",
3172 ma_stats.calls[i],
3173 ma_routines[i]);
3174 }
3175
3176 #else
3177
3178 (void)sprintf(ma_ebuf,
3179 "unavailable; recompile MA with -DSTATS");
3180 ma_error(EL_Nonfatal, ET_External, "MA_print_stats", ma_ebuf);
3181
3182 #endif /* STATS */
3183 }
3184
3185 /* ------------------------------------------------------------------------- */
3186 /*
3187 * Convenience function that combines MA_push_stack and MA_get_index.
3188 */
3189 /* ------------------------------------------------------------------------- */
3190
MA_push_get(Integer datatype,Integer nelem,const char * name,Integer * memhandle,MA_AccessIndex * index)3191 public Boolean MA_push_get(
3192 Integer datatype, /* of elements in this block */
3193 Integer nelem, /* # of elements in this block */
3194 const char *name, /* assigned to this block by client */
3195 Integer *memhandle, /* RETURN: handle for this block */
3196 MA_AccessIndex *index /* RETURN: index for this block */)
3197 {
3198 #ifdef STATS
3199 ma_stats.calls[(int)FID_MA_push_get]++;
3200 #endif /* STATS */
3201
3202 if (MA_push_stack(datatype, nelem, name, memhandle))
3203 /* MA_push_stack succeeded; try MA_get_index */
3204 return MA_get_index(*memhandle, index);
3205 else
3206 /* MA_push_stack failed */
3207 return MA_FALSE;
3208 }
3209
3210 /* ------------------------------------------------------------------------- */
3211 /*
3212 * Allocate a stack block big enough to hold nelem elements
3213 * of the given datatype.
3214 *
3215 * Return MA_TRUE upon success, or MA_FALSE upon failure.
3216 */
3217 /* ------------------------------------------------------------------------- */
3218
MA_push_stack(Integer datatype,Integer nelem,const char * name,Integer * memhandle)3219 public Boolean MA_push_stack(
3220 Integer datatype, /* of elements in this block */
3221 Integer nelem, /* # of elements in this block */
3222 const char *name, /* assigned to this block by client */
3223 Integer *memhandle /* RETURN: handle for this block */)
3224 {
3225 AR ar; /* allocation request */
3226 AD *ad; /* AD for newly allocated block */
3227 Pointer client_space; /* location of client_space */
3228 ulongi nbytes; /* length of block for ar */
3229 Pointer new_sp; /* new ma_sp */
3230
3231 #ifdef STATS
3232 ma_stats.calls[(int)FID_MA_push_stack]++;
3233 #endif /* STATS */
3234
3235 #ifdef VERIFY
3236 if (ma_auto_verify && !MA_verify_allocator_stuff())
3237 return MA_FALSE;
3238 #endif /* VERIFY */
3239
3240 if (ma_trace)
3241 (void)printf("MA: pushing '%s' (%d)\n", name, (int)nelem);
3242
3243 /* verify initialization */
3244 if (!ma_initialized)
3245 {
3246 (void)sprintf(ma_ebuf,
3247 "block '%s', MA not yet initialized",
3248 name);
3249 ma_error(EL_Nonfatal, ET_External, "MA_push_stack", ma_ebuf);
3250 return MA_FALSE;
3251 }
3252
3253 /* verify datatype */
3254 if (!mt_valid(datatype))
3255 {
3256 (void)sprintf(ma_ebuf,
3257 "block '%s', invalid datatype: %ld",
3258 name, (size_t)datatype);
3259 ma_error(EL_Nonfatal, ET_External, "MA_push_stack", ma_ebuf);
3260 return MA_FALSE;
3261 }
3262
3263 /* verify nelem */
3264 if (nelem < 0)
3265 {
3266 (void)sprintf(ma_ebuf,
3267 "block '%s', invalid nelem: %ld",
3268 name, (size_t)nelem);
3269 ma_error(EL_Nonfatal, ET_External, "MA_push_stack", ma_ebuf);
3270 return MA_FALSE;
3271 }
3272
3273 /* convert datatype to internal (index-suitable) value */
3274 datatype = mt_import(datatype);
3275
3276 /*
3277 * attempt to allocate space
3278 */
3279
3280 ar.datatype = datatype;
3281 ar.nelem = nelem;
3282
3283 balloc_before(&ar, ma_sp, &client_space, &nbytes);
3284
3285 new_sp = ma_sp - nbytes;
3286 /* if (new_sp < ma_hp) */
3287 if (((ulongi)(ma_sp - ma_hp)) < nbytes)
3288 {
3289 (void)sprintf(ma_ebuf,
3290 "block '%s', not enough space to allocate %lu bytes",
3291 name, nbytes);
3292 ma_error(EL_Nonfatal, ET_External, "MA_push_stack", ma_ebuf);
3293 return MA_FALSE;
3294 }
3295 else
3296 {
3297 ad = (AD *)new_sp;
3298 }
3299
3300 /*
3301 * space has been allocated
3302 */
3303
3304 /* initialize the AD */
3305 ad->datatype = datatype;
3306 ad->nelem = nelem;
3307 str_ncopy(ad->name, (char*)name, MA_NAMESIZE);
3308 ad->client_space = client_space;
3309 ad->nbytes = nbytes;
3310 list_insert(ad, &ma_sused);
3311 ad->checksum = checksum(ad);
3312
3313 /* set the guards */
3314 guard_set(ad);
3315
3316 #ifdef DEBUG
3317 debug_ad_print(ad);
3318 #endif /* DEBUG */
3319
3320 /* update ma_sp */
3321 ma_sp = new_sp;
3322
3323 #ifdef STATS
3324 ma_stats.sblocks++;
3325 ma_stats.sblocks_max = max(ma_stats.sblocks, ma_stats.sblocks_max);
3326 ma_stats.sbytes += ad->nbytes;
3327 ma_stats.sbytes_max = max(ma_stats.sbytes, ma_stats.sbytes_max);
3328 #endif /* STATS */
3329
3330 /* convert AD to memhandle */
3331 if ((*memhandle = ma_table_allocate((TableData)ad)) == TABLE_HANDLE_NONE)
3332 /* failure */
3333 return MA_FALSE;
3334 else
3335 /* success */
3336 return MA_TRUE;
3337 }
3338
3339 /* ------------------------------------------------------------------------- */
3340 /*
3341 * Set the ma_auto_verify flag to value and return its previous value.
3342 */
3343 /* ------------------------------------------------------------------------- */
3344
MA_set_auto_verify(Boolean value)3345 public Boolean MA_set_auto_verify(Boolean value /* to set flag to */)
3346 {
3347 Boolean old_value; /* of flag */
3348
3349 #ifdef STATS
3350 ma_stats.calls[(int)FID_MA_set_auto_verify]++;
3351 #endif /* STATS */
3352
3353 old_value = ma_auto_verify;
3354 ma_auto_verify = value;
3355 return old_value;
3356 }
3357
3358 /* ------------------------------------------------------------------------- */
3359 /*
3360 * Set the ma_error_print flag to value and return its previous value.
3361 */
3362 /* ------------------------------------------------------------------------- */
3363
MA_set_error_print(Boolean value)3364 public Boolean MA_set_error_print(Boolean value /* to set flag to */)
3365 {
3366 Boolean old_value; /* of flag */
3367
3368 #ifdef STATS
3369 ma_stats.calls[(int)FID_MA_set_error_print]++;
3370 #endif /* STATS */
3371
3372 old_value = ma_error_print;
3373 ma_error_print = value;
3374 return old_value;
3375 }
3376
3377 /* ------------------------------------------------------------------------- */
3378 /*
3379 * Set the ma_hard_fail flag to value and return its previous value.
3380 */
3381 /* ------------------------------------------------------------------------- */
3382
MA_set_hard_fail(Boolean value)3383 public Boolean MA_set_hard_fail( Boolean value /* to set flag to */)
3384 {
3385 Boolean old_value; /* of flag */
3386
3387 #ifdef STATS
3388 ma_stats.calls[(int)FID_MA_set_hard_fail]++;
3389 #endif /* STATS */
3390
3391 old_value = ma_hard_fail;
3392 ma_hard_fail = value;
3393 return old_value;
3394 }
3395
3396 /* ------------------------------------------------------------------------- */
3397 /*
3398 * Set the requested alignment.
3399 *
3400 * Return MA_TRUE upon success, or MA_FALSE upon failure.
3401 */
3402 /* ------------------------------------------------------------------------- */
3403
MA_set_numalign(Integer value)3404 public Boolean MA_set_numalign(Integer value)
3405 {
3406 #ifdef STATS
3407 ma_stats.calls[(int)FID_MA_set_numalign]++;
3408 #endif /* STATS */
3409
3410 if ((value < 0) || (value > 30))
3411 {
3412 (void)sprintf(ma_ebuf,
3413 "invalid alignment: %ld",
3414 (size_t)value);
3415 ma_error(EL_Nonfatal, ET_External, "MA_set_numalign", ma_ebuf);
3416 return MA_FALSE;
3417 }
3418 ma_numalign = value;
3419 return MA_TRUE;
3420 }
3421
3422 /* ------------------------------------------------------------------------- */
3423 /*
3424 * Return the number of elements of datatype2 required to contain
3425 * nelem1 elements of datatype1.
3426 */
3427 /* ------------------------------------------------------------------------- */
3428
MA_sizeof(Integer datatype1,Integer nelem1,Integer datatype2)3429 public Integer MA_sizeof(
3430 Integer datatype1, /* of source elements */
3431 Integer nelem1, /* # of source elements */
3432 Integer datatype2 /* of target elements */)
3433 {
3434 ulongi source_bytes; /* nelem1 * ma_sizeof[datatype1] */
3435 int ceiling; /* 1 iff ceiling alters result */
3436
3437 #ifdef STATS
3438 ma_stats.calls[(int)FID_MA_sizeof]++;
3439 #endif /* STATS */
3440
3441 #ifdef VERIFY
3442 if (ma_auto_verify && !MA_verify_allocator_stuff())
3443 return DONTCARE;
3444 #endif /* VERIFY */
3445
3446 /* preinitialize if necessary */
3447 ma_preinitialize("MA_sizeof");
3448
3449 /* verify datatype1 */
3450 if (!mt_valid(datatype1))
3451 {
3452 (void)sprintf(ma_ebuf,
3453 "invalid datatype: %ld",
3454 (size_t)datatype1);
3455 ma_error(EL_Fatal, ET_External, "MA_sizeof", ma_ebuf);
3456 return DONTCARE;
3457 }
3458
3459 /* verify nelem1 */
3460 if (nelem1 < 0)
3461 {
3462 (void)sprintf(ma_ebuf,
3463 "invalid nelem: %ld",
3464 (size_t)nelem1);
3465 ma_error(EL_Fatal, ET_External, "MA_sizeof", ma_ebuf);
3466 return DONTCARE;
3467 }
3468
3469 /* verify datatype2 */
3470 if (!mt_valid(datatype2))
3471 {
3472 (void)sprintf(ma_ebuf,
3473 "invalid datatype: %ld",
3474 (size_t)datatype2);
3475 ma_error(EL_Fatal, ET_External, "MA_sizeof", ma_ebuf);
3476 return DONTCARE;
3477 }
3478
3479 /* convert datatype1 to internal (index-suitable) value */
3480 datatype1 = mt_import(datatype1);
3481
3482 /* convert datatype2 to internal (index-suitable) value */
3483 datatype2 = mt_import(datatype2);
3484
3485 /* compute and return the result */
3486 source_bytes = nelem1 * ma_sizeof[datatype1];
3487 ceiling = (source_bytes % ma_sizeof[datatype2]) ? 1 : 0;
3488 return (Integer)((source_bytes / ma_sizeof[datatype2]) + ceiling);
3489 }
3490
3491 /* ------------------------------------------------------------------------- */
3492 /*
3493 * Return the number of elements of datatype required to contain
3494 * the worst case number of bytes of overhead for any block.
3495 */
3496 /* ------------------------------------------------------------------------- */
3497
MA_sizeof_overhead(Integer datatype)3498 public Integer MA_sizeof_overhead(Integer datatype)
3499 {
3500 int overhead_bytes; /* max bytes of overhead for any block */
3501 int ceiling; /* 1 iff ceiling alters result */
3502 int max_sizeof; /* max over i of ma_sizeof[i] */
3503 int biggest_datatype=0; /* corresponds to max_sizeof */
3504 int i; /* loop index */
3505
3506 #ifdef STATS
3507 ma_stats.calls[(int)FID_MA_sizeof_overhead]++;
3508 #endif /* STATS */
3509
3510 #ifdef VERIFY
3511 if (ma_auto_verify && !MA_verify_allocator_stuff())
3512 return DONTCARE;
3513 #endif /* VERIFY */
3514
3515 /* preinitialize if necessary */
3516 ma_preinitialize("MA_sizeof_overhead");
3517
3518 /* verify datatype */
3519 if (!mt_valid(datatype))
3520 {
3521 (void)sprintf(ma_ebuf,
3522 "invalid datatype: %ld",
3523 (size_t)datatype);
3524 ma_error(EL_Fatal, ET_External, "MA_sizeof_overhead", ma_ebuf);
3525 return DONTCARE;
3526 }
3527
3528 /* convert datatype to internal (index-suitable) value */
3529 datatype = mt_import(datatype);
3530
3531 /* compute and return the result */
3532 for (max_sizeof = 0, i = 0; i < MT_NUMTYPES; i++)
3533 if (ma_sizeof[i] > max_sizeof)
3534 {
3535 max_sizeof = ma_sizeof[i];
3536 biggest_datatype = i;
3537 }
3538 overhead_bytes = max_block_overhead(biggest_datatype);
3539 ceiling = (overhead_bytes % ma_sizeof[datatype]) ? 1 : 0;
3540 return (Integer)((overhead_bytes / ma_sizeof[datatype]) + ceiling);
3541 }
3542
3543 /* ------------------------------------------------------------------------- */
3544 /*
3545 * Print debugging information about all blocks currently in use
3546 * on the heap or the stack.
3547 */
3548 /* ------------------------------------------------------------------------- */
3549
MA_summarize_allocated_blocks()3550 public void MA_summarize_allocated_blocks()
3551 {
3552 /* C indices are 0-based */
3553 MAi_summarize_allocated_blocks(0);
3554 }
3555
3556 /* ------------------------------------------------------------------------- */
3557 /*
3558 * Control tracing of allocation and deallocation operations.
3559 */
3560 /* ------------------------------------------------------------------------- */
3561
MA_trace(Boolean value)3562 public void MA_trace(Boolean value)
3563 {
3564 ma_trace = value;
3565 }
3566
3567 /* ------------------------------------------------------------------------- */
3568 /*
3569 * Sanity check the internal state of MA and print the results.
3570 *
3571 * Return MA_TRUE upon success, or MA_FALSE upon failure.
3572 */
3573 /* ------------------------------------------------------------------------- */
3574
MA_verify_allocator_stuff()3575 public Boolean MA_verify_allocator_stuff()
3576 {
3577 #ifdef VERIFY
3578
3579 char *preamble; /* printed before block error messages */
3580
3581 int heap_blocks;
3582 int bad_heap_blocks;
3583 int bad_heap_checksums;
3584 int bad_heap_lguards;
3585 int bad_heap_rguards;
3586 int stack_blocks;
3587 int bad_stack_blocks;
3588 int bad_stack_checksums;
3589 int bad_stack_lguards;
3590 int bad_stack_rguards;
3591
3592 #ifdef STATS
3593 ma_stats.calls[(int)FID_MA_verify_allocator_stuff]++;
3594 #endif /* STATS */
3595
3596 preamble = "MA_verify_allocator_stuff: starting scan ...\n";
3597
3598 /* check each block on the heap used list */
3599 list_verify(ma_hused,
3600 "heap",
3601 preamble,
3602 &heap_blocks,
3603 &bad_heap_blocks,
3604 &bad_heap_checksums,
3605 &bad_heap_lguards,
3606 &bad_heap_rguards);
3607
3608 if (bad_heap_blocks > 0)
3609 /* only print preamble once */
3610 preamble = (char *)NULL;
3611
3612 /* check each block on the stack used list */
3613 list_verify(ma_sused,
3614 "stack",
3615 preamble,
3616 &stack_blocks,
3617 &bad_stack_blocks,
3618 &bad_stack_checksums,
3619 &bad_stack_lguards,
3620 &bad_stack_rguards);
3621
3622 if ((bad_heap_blocks > 0) || (bad_stack_blocks > 0))
3623 {
3624 Boolean old_ma_error_print;
3625
3626 /* print postamble */
3627 (void)printf("MA_verify_allocator_stuff: scan completed\n");
3628
3629 /* construct a summary of the results */
3630 (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",
3631 bad_heap_checksums,
3632 bad_stack_checksums,
3633 bad_heap_lguards,
3634 bad_stack_lguards,
3635 bad_heap_rguards,
3636 bad_stack_rguards,
3637 bad_heap_blocks,
3638 bad_stack_blocks,
3639 heap_blocks,
3640 stack_blocks);
3641
3642 /* print the summary on stderr */
3643 old_ma_error_print = ma_error_print;
3644 ma_error_print = MA_TRUE;
3645 ma_error(EL_Nonfatal, ET_External, "MA_verify_allocator_stuff", ma_ebuf);
3646 ma_error_print = old_ma_error_print;
3647
3648 /* problems were found */
3649 return MA_FALSE;
3650 }
3651 else
3652 /* no problems found */
3653 return MA_TRUE;
3654
3655 #else
3656
3657 #ifdef STATS
3658 ma_stats.calls[(int)FID_MA_verify_allocator_stuff]++;
3659 #endif /* STATS */
3660
3661 (void)sprintf(ma_ebuf,
3662 "unavailable; recompile MA with -DVERIFY");
3663 ma_error(EL_Nonfatal, ET_External, "MA_verify_allocator_stuff", ma_ebuf);
3664 return MA_FALSE;
3665
3666 #endif /* VERIFY */
3667 }
3668