428
+ − 1 /* alloca.c -- allocate automatically reclaimed memory
+ − 2 (Mostly) portable public-domain implementation -- D A Gwyn
+ − 3
+ − 4 This implementation of the PWB library alloca function,
+ − 5 which is used to allocate space off the run-time stack so
+ − 6 that it is automatically reclaimed upon procedure exit,
+ − 7 was inspired by discussions with J. Q. Johnson of Cornell.
+ − 8 J.Otto Tennant <jot@cray.com> contributed the Cray support.
+ − 9
+ − 10 There are some preprocessor constants that can
+ − 11 be defined when compiling for your specific system, for
+ − 12 improved efficiency; however, the defaults should be okay.
+ − 13
+ − 14 The general concept of this implementation is to keep
+ − 15 track of all alloca-allocated blocks, and reclaim any
+ − 16 that are found to be deeper in the stack than the current
+ − 17 invocation. This heuristic does not reclaim storage as
+ − 18 soon as it becomes invalid, but it will do so eventually.
+ − 19
+ − 20 As a special case, alloca(0) reclaims storage without
+ − 21 allocating any. It is a good idea to use alloca(0) in
+ − 22 your main control loop, etc. to force garbage collection. */
+ − 23
+ − 24 /* Synched up with: FSF 19.30. */
+ − 25
442
+ − 26 /* Authorship:
428
+ − 27
+ − 28 FSF: A long time ago.
851
+ − 29 Some cleanups for XEmacs.
428
+ − 30 */
+ − 31
+ − 32 #ifdef HAVE_CONFIG_H
+ − 33 #include <config.h>
+ − 34 #endif
+ − 35
+ − 36 #ifdef emacs
851
+ − 37 #include "lisp.h"
+ − 38 #endif
428
+ − 39
+ − 40 /* If your stack is a linked list of frames, you have to
+ − 41 provide an "address metric" ADDRESS_FUNCTION macro. */
+ − 42
+ − 43 #if defined (CRAY) && defined (CRAY_STACKSEG_END)
+ − 44 long i00afunc ();
+ − 45 #define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
+ − 46 #else
+ − 47 #define ADDRESS_FUNCTION(arg) &(arg)
+ − 48 #endif
+ − 49
+ − 50 typedef void *pointer;
+ − 51
442
+ − 52 #ifndef NULL
428
+ − 53 #define NULL 0
+ − 54 #endif
+ − 55
+ − 56 /* Define STACK_DIRECTION if you know the direction of stack
+ − 57 growth for your system; otherwise it will be automatically
+ − 58 deduced at run-time.
+ − 59
+ − 60 STACK_DIRECTION > 0 => grows toward higher addresses
+ − 61 STACK_DIRECTION < 0 => grows toward lower addresses
+ − 62 STACK_DIRECTION = 0 => direction of growth unknown */
+ − 63
+ − 64 #ifndef STACK_DIRECTION
+ − 65 #define STACK_DIRECTION 0 /* Direction unknown. */
+ − 66 #endif
+ − 67
+ − 68 #if STACK_DIRECTION != 0
+ − 69
+ − 70 #define STACK_DIR STACK_DIRECTION /* Known at compile-time. */
+ − 71
+ − 72 #else /* STACK_DIRECTION == 0; need run-time code. */
+ − 73
+ − 74 static int stack_dir; /* 1 or -1 once known. */
+ − 75 #define STACK_DIR stack_dir
+ − 76
+ − 77 static void
1111
+ − 78 find_stack_direction (void)
428
+ − 79 {
+ − 80 static char *addr = NULL; /* Address of first `dummy', once known. */
+ − 81 auto char dummy; /* To get stack address. */
+ − 82
+ − 83 if (addr == NULL)
+ − 84 { /* Initial entry. */
+ − 85 addr = ADDRESS_FUNCTION (dummy);
+ − 86
+ − 87 find_stack_direction (); /* Recurse once. */
+ − 88 }
+ − 89 else
+ − 90 {
+ − 91 /* Second entry. */
+ − 92 if (ADDRESS_FUNCTION (dummy) > addr)
+ − 93 stack_dir = 1; /* Stack grew upward. */
+ − 94 else
+ − 95 stack_dir = -1; /* Stack grew downward. */
+ − 96 }
+ − 97 }
+ − 98
+ − 99 #endif /* STACK_DIRECTION == 0 */
+ − 100
+ − 101 /* An "alloca header" is used to:
+ − 102 (a) chain together all alloca'ed blocks;
+ − 103 (b) keep track of stack depth.
+ − 104
+ − 105 It is very important that sizeof(header) agree with malloc
+ − 106 alignment chunk size. The following default should work okay. */
+ − 107
851
+ − 108 #ifndef ALIGNMENT_SIZE
+ − 109 #define ALIGNMENT_SIZE sizeof(double)
428
+ − 110 #endif
+ − 111
+ − 112 typedef union hdr
+ − 113 {
851
+ − 114 char align[ALIGNMENT_SIZE]; /* To force sizeof(header). */
428
+ − 115 struct
+ − 116 {
+ − 117 union hdr *next; /* For chaining headers. */
+ − 118 char *deep; /* For stack depth measure. */
+ − 119 } h;
+ − 120 } header;
+ − 121
+ − 122 static header *last_alloca_header = NULL; /* -> last alloca header. */
+ − 123
+ − 124 /* Return a pointer to at least SIZE bytes of storage,
+ − 125 which will be automatically reclaimed upon exit from
+ − 126 the procedure that called alloca. Originally, this space
+ − 127 was supposed to be taken from the current stack frame of the
+ − 128 caller, but that method cannot be made to work for some
+ − 129 implementations of C, for example under Gould's UTX/32. */
+ − 130
+ − 131 pointer
851
+ − 132 xemacs_c_alloca (unsigned int size)
428
+ − 133 {
+ − 134 auto char probe; /* Probes stack depth: */
442
+ − 135 register char *depth = ADDRESS_FUNCTION (probe);
428
+ − 136
+ − 137 #if STACK_DIRECTION == 0
+ − 138 if (STACK_DIR == 0) /* Unknown growth direction. */
+ − 139 find_stack_direction ();
+ − 140 #endif
+ − 141
+ − 142 /* Reclaim garbage, defined as all alloca'd storage that
+ − 143 was allocated from deeper in the stack than currently. */
+ − 144
+ − 145 {
2965
+ − 146 header *hp; /* Traverses linked list. */
428
+ − 147
+ − 148 for (hp = last_alloca_header; hp != NULL;)
+ − 149 if ((STACK_DIR > 0 && hp->h.deep > depth)
+ − 150 || (STACK_DIR < 0 && hp->h.deep < depth))
+ − 151 {
442
+ − 152 register header *np = hp->h.next;
428
+ − 153
851
+ − 154 #ifdef emacs
1726
+ − 155 xfree (hp, header *); /* Collect garbage. */
851
+ − 156 #else
+ − 157 free (hp); /* Collect garbage. */
+ − 158 #endif
428
+ − 159
+ − 160 hp = np; /* -> next header. */
+ − 161 }
+ − 162 else
+ − 163 break; /* Rest are not deeper. */
+ − 164
+ − 165 last_alloca_header = hp; /* -> last valid storage. */
+ − 166 }
+ − 167
851
+ − 168 #ifdef emacs
+ − 169 need_to_check_c_alloca = size > 0 || last_alloca_header;
+ − 170 recompute_funcall_allocation_flag ();
+ − 171 #endif
+ − 172
428
+ − 173 if (size == 0)
+ − 174 return NULL; /* No allocation required. */
+ − 175
+ − 176 /* Allocate combined header + user data storage. */
+ − 177
+ − 178 {
851
+ − 179 #ifdef emacs
2965
+ − 180 register pointer new_ = xmalloc (sizeof (header) + size);
851
+ − 181 #else
2965
+ − 182 register pointer new_ = malloc (sizeof (header) + size);
851
+ − 183 #endif
428
+ − 184 /* Address of header. */
+ − 185
2965
+ − 186 ((header *) new_)->h.next = last_alloca_header;
+ − 187 ((header *) new_)->h.deep = depth;
428
+ − 188
2965
+ − 189 last_alloca_header = (header *) new_;
428
+ − 190
+ − 191 /* User storage begins just after header. */
+ − 192
2965
+ − 193 return (pointer) ((char *) new_ + sizeof (header));
428
+ − 194 }
+ − 195 }
+ − 196
+ − 197 #if defined (CRAY) && defined (CRAY_STACKSEG_END)
+ − 198
+ − 199 #ifdef DEBUG_I00AFUNC
+ − 200 #include <stdio.h>
+ − 201 #endif
+ − 202
+ − 203 #ifndef CRAY_STACK
+ − 204 #define CRAY_STACK
+ − 205 #ifndef CRAY2
+ − 206 /* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
+ − 207 struct stack_control_header
+ − 208 {
+ − 209 long shgrow:32; /* Number of times stack has grown. */
+ − 210 long shaseg:32; /* Size of increments to stack. */
+ − 211 long shhwm:32; /* High water mark of stack. */
+ − 212 long shsize:32; /* Current size of stack (all segments). */
+ − 213 };
+ − 214
+ − 215 /* The stack segment linkage control information occurs at
+ − 216 the high-address end of a stack segment. (The stack
+ − 217 grows from low addresses to high addresses.) The initial
+ − 218 part of the stack segment linkage control information is
+ − 219 0200 (octal) words. This provides for register storage
+ − 220 for the routine which overflows the stack. */
+ − 221
+ − 222 struct stack_segment_linkage
+ − 223 {
+ − 224 long ss[0200]; /* 0200 overflow words. */
+ − 225 long sssize:32; /* Number of words in this segment. */
+ − 226 long ssbase:32; /* Offset to stack base. */
+ − 227 long:32;
+ − 228 long sspseg:32; /* Offset to linkage control of previous
+ − 229 segment of stack. */
+ − 230 long:32;
+ − 231 long sstcpt:32; /* Pointer to task common address block. */
+ − 232 long sscsnm; /* Private control structure number for
+ − 233 microtasking. */
+ − 234 long ssusr1; /* Reserved for user. */
+ − 235 long ssusr2; /* Reserved for user. */
+ − 236 long sstpid; /* Process ID for pid based multi-tasking. */
+ − 237 long ssgvup; /* Pointer to multitasking thread giveup. */
+ − 238 long sscray[7]; /* Reserved for Cray Research. */
+ − 239 long ssa0;
+ − 240 long ssa1;
+ − 241 long ssa2;
+ − 242 long ssa3;
+ − 243 long ssa4;
+ − 244 long ssa5;
+ − 245 long ssa6;
+ − 246 long ssa7;
+ − 247 long sss0;
+ − 248 long sss1;
+ − 249 long sss2;
+ − 250 long sss3;
+ − 251 long sss4;
+ − 252 long sss5;
+ − 253 long sss6;
+ − 254 long sss7;
+ − 255 };
+ − 256
+ − 257 #else /* CRAY2 */
+ − 258 /* The following structure defines the vector of words
+ − 259 returned by the STKSTAT library routine. */
+ − 260 struct stk_stat
+ − 261 {
+ − 262 long now; /* Current total stack size. */
+ − 263 long maxc; /* Amount of contiguous space which would
+ − 264 be required to satisfy the maximum
+ − 265 stack demand to date. */
+ − 266 long high_water; /* Stack high-water mark. */
+ − 267 long overflows; /* Number of stack overflow ($STKOFEN) calls. */
+ − 268 long hits; /* Number of internal buffer hits. */
+ − 269 long extends; /* Number of block extensions. */
+ − 270 long stko_mallocs; /* Block allocations by $STKOFEN. */
+ − 271 long underflows; /* Number of stack underflow calls ($STKRETN). */
+ − 272 long stko_free; /* Number of deallocations by $STKRETN. */
+ − 273 long stkm_free; /* Number of deallocations by $STKMRET. */
+ − 274 long segments; /* Current number of stack segments. */
+ − 275 long maxs; /* Maximum number of stack segments so far. */
+ − 276 long pad_size; /* Stack pad size. */
+ − 277 long current_address; /* Current stack segment address. */
+ − 278 long current_size; /* Current stack segment size. This
+ − 279 number is actually corrupted by STKSTAT to
+ − 280 include the fifteen word trailer area. */
+ − 281 long initial_address; /* Address of initial segment. */
+ − 282 long initial_size; /* Size of initial segment. */
+ − 283 };
+ − 284
+ − 285 /* The following structure describes the data structure which trails
+ − 286 any stack segment. I think that the description in 'asdef' is
+ − 287 out of date. I only describe the parts that I am sure about. */
+ − 288
+ − 289 struct stk_trailer
+ − 290 {
+ − 291 long this_address; /* Address of this block. */
+ − 292 long this_size; /* Size of this block (does not include
+ − 293 this trailer). */
+ − 294 long unknown2;
+ − 295 long unknown3;
+ − 296 long link; /* Address of trailer block of previous
+ − 297 segment. */
+ − 298 long unknown5;
+ − 299 long unknown6;
+ − 300 long unknown7;
+ − 301 long unknown8;
+ − 302 long unknown9;
+ − 303 long unknown10;
+ − 304 long unknown11;
+ − 305 long unknown12;
+ − 306 long unknown13;
+ − 307 long unknown14;
+ − 308 };
+ − 309
+ − 310 #endif /* CRAY2 */
+ − 311 #endif /* not CRAY_STACK */
+ − 312
+ − 313 #ifdef CRAY2
+ − 314 /* Determine a "stack measure" for an arbitrary ADDRESS.
+ − 315 I doubt that "lint" will like this much. */
+ − 316
+ − 317 static long
+ − 318 i00afunc (long *address)
+ − 319 {
+ − 320 struct stk_stat status;
+ − 321 struct stk_trailer *trailer;
+ − 322 long *block, size;
+ − 323 long result = 0;
+ − 324
+ − 325 /* We want to iterate through all of the segments. The first
+ − 326 step is to get the stack status structure. We could do this
+ − 327 more quickly and more directly, perhaps, by referencing the
+ − 328 $LM00 common block, but I know that this works. */
+ − 329
+ − 330 STKSTAT (&status);
+ − 331
+ − 332 /* Set up the iteration. */
+ − 333
+ − 334 trailer = (struct stk_trailer *) (status.current_address
+ − 335 + status.current_size
+ − 336 - 15);
+ − 337
+ − 338 /* There must be at least one stack segment. Therefore it is
+ − 339 a fatal error if "trailer" is null. */
+ − 340
+ − 341 if (trailer == 0)
2500
+ − 342 ABORT ();
428
+ − 343
+ − 344 /* Discard segments that do not contain our argument address. */
+ − 345
+ − 346 while (trailer != 0)
+ − 347 {
+ − 348 block = (long *) trailer->this_address;
+ − 349 size = trailer->this_size;
+ − 350 if (block == 0 || size == 0)
2500
+ − 351 ABORT ();
428
+ − 352 trailer = (struct stk_trailer *) trailer->link;
+ − 353 if ((block <= address) && (address < (block + size)))
+ − 354 break;
+ − 355 }
+ − 356
+ − 357 /* Set the result to the offset in this segment and add the sizes
+ − 358 of all predecessor segments. */
+ − 359
+ − 360 result = address - block;
+ − 361
+ − 362 if (trailer == 0)
+ − 363 {
+ − 364 return result;
+ − 365 }
+ − 366
+ − 367 do
+ − 368 {
+ − 369 if (trailer->this_size <= 0)
2500
+ − 370 ABORT ();
428
+ − 371 result += trailer->this_size;
+ − 372 trailer = (struct stk_trailer *) trailer->link;
+ − 373 }
+ − 374 while (trailer != 0);
+ − 375
+ − 376 /* We are done. Note that if you present a bogus address (one
+ − 377 not in any segment), you will get a different number back, formed
+ − 378 from subtracting the address of the first block. This is probably
+ − 379 not what you want. */
+ − 380
+ − 381 return (result);
+ − 382 }
+ − 383
+ − 384 #else /* not CRAY2 */
+ − 385 /* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP.
+ − 386 Determine the number of the cell within the stack,
+ − 387 given the address of the cell. The purpose of this
+ − 388 routine is to linearize, in some sense, stack addresses
+ − 389 for alloca. */
+ − 390
+ − 391 static long
+ − 392 i00afunc (long address)
+ − 393 {
+ − 394 long stkl = 0;
+ − 395
+ − 396 long size, pseg, this_segment, stack;
+ − 397 long result = 0;
+ − 398
+ − 399 struct stack_segment_linkage *ssptr;
+ − 400
+ − 401 /* Register B67 contains the address of the end of the
+ − 402 current stack segment. If you (as a subprogram) store
+ − 403 your registers on the stack and find that you are past
+ − 404 the contents of B67, you have overflowed the segment.
+ − 405
+ − 406 B67 also points to the stack segment linkage control
+ − 407 area, which is what we are really interested in. */
+ − 408
+ − 409 stkl = CRAY_STACKSEG_END ();
+ − 410 ssptr = (struct stack_segment_linkage *) stkl;
+ − 411
+ − 412 /* If one subtracts 'size' from the end of the segment,
+ − 413 one has the address of the first word of the segment.
+ − 414
+ − 415 If this is not the first segment, 'pseg' will be
+ − 416 nonzero. */
+ − 417
+ − 418 pseg = ssptr->sspseg;
+ − 419 size = ssptr->sssize;
+ − 420
+ − 421 this_segment = stkl - size;
+ − 422
+ − 423 /* It is possible that calling this routine itself caused
+ − 424 a stack overflow. Discard stack segments which do not
+ − 425 contain the target address. */
+ − 426
+ − 427 while (!(this_segment <= address && address <= stkl))
+ − 428 {
+ − 429 #ifdef DEBUG_I00AFUNC
+ − 430 fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
+ − 431 #endif
+ − 432 if (pseg == 0)
+ − 433 break;
+ − 434 stkl = stkl - pseg;
+ − 435 ssptr = (struct stack_segment_linkage *) stkl;
+ − 436 size = ssptr->sssize;
+ − 437 pseg = ssptr->sspseg;
+ − 438 this_segment = stkl - size;
+ − 439 }
+ − 440
+ − 441 result = address - this_segment;
+ − 442
+ − 443 /* If you subtract pseg from the current end of the stack,
+ − 444 you get the address of the previous stack segment's end.
+ − 445 This seems a little convoluted to me, but I'll bet you save
+ − 446 a cycle somewhere. */
+ − 447
+ − 448 while (pseg != 0)
+ − 449 {
+ − 450 #ifdef DEBUG_I00AFUNC
+ − 451 fprintf (stderr, "%011o %011o\n", pseg, size);
+ − 452 #endif
+ − 453 stkl = stkl - pseg;
+ − 454 ssptr = (struct stack_segment_linkage *) stkl;
+ − 455 size = ssptr->sssize;
+ − 456 pseg = ssptr->sspseg;
+ − 457 result += size;
+ − 458 }
+ − 459 return (result);
+ − 460 }
+ − 461
+ − 462 #endif /* not CRAY2 */
+ − 463 #endif /* CRAY */
