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