1193323Sed/* alloca.c -- allocate automatically reclaimed memory 2193323Sed (Mostly) portable public-domain implementation -- D A Gwyn 3193323Sed 4193323Sed This implementation of the PWB library alloca function, 5193323Sed which is used to allocate space off the run-time stack so 6193323Sed that it is automatically reclaimed upon procedure exit, 7193323Sed was inspired by discussions with J. Q. Johnson of Cornell. 8193323Sed J.Otto Tennant <jot@cray.com> contributed the Cray support. 9193323Sed 10193323Sed There are some preprocessor constants that can 11193323Sed be defined when compiling for your specific system, for 12193323Sed improved efficiency; however, the defaults should be okay. 13193323Sed 14193323Sed The general concept of this implementation is to keep 15193323Sed track of all alloca-allocated blocks, and reclaim any 16193323Sed that are found to be deeper in the stack than the current 17193323Sed invocation. This heuristic does not reclaim storage as 18193323Sed soon as it becomes invalid, but it will do so eventually. 19193323Sed 20193323Sed As a special case, alloca(0) reclaims storage without 21193323Sed allocating any. It is a good idea to use alloca(0) in 22193323Sed your main control loop, etc. to force garbage collection. */ 23193323Sed 24198090Srdivacky#ifdef HAVE_CONFIG_H 25193323Sed# include <config.h> 26199989Srdivacky#endif 27199989Srdivacky 28199989Srdivacky#include <alloca.h> 29193323Sed 30199989Srdivacky#include <string.h> 31193323Sed#include <stdlib.h> 32198090Srdivacky 33193323Sed#ifdef emacs 34193323Sed# include "lisp.h" 35193323Sed# include "blockinput.h" 36193323Sed# ifdef EMACS_FREE 37193323Sed# undef free 38193323Sed# define free EMACS_FREE 39193323Sed# endif 40193323Sed#else 41193323Sed# define memory_full() abort () 42193323Sed#endif 43193323Sed 44193323Sed/* If compiling with GCC 2, this file's not needed. */ 45193323Sed#if !defined (__GNUC__) || __GNUC__ < 2 46193323Sed 47193323Sed/* If someone has defined alloca as a macro, 48193323Sed there must be some other way alloca is supposed to work. */ 49193323Sed# ifndef alloca 50193323Sed 51193323Sed# ifdef emacs 52193323Sed# ifdef static 53193323Sed/* actually, only want this if static is defined as "" 54193323Sed -- this is for usg, in which emacs must undefine static 55193323Sed in order to make unexec workable 56193323Sed */ 57193323Sed# ifndef STACK_DIRECTION 58193323Sedyou 59193323Sedlose 60198892Srdivacky-- must know STACK_DIRECTION at compile-time 61199989Srdivacky/* Using #error here is not wise since this file should work for 62199989Srdivacky old and obscure compilers. */ 63199989Srdivacky# endif /* STACK_DIRECTION undefined */ 64199989Srdivacky# endif /* static */ 65199989Srdivacky# endif /* emacs */ 66199989Srdivacky 67193323Sed/* If your stack is a linked list of frames, you have to 68193323Sed provide an "address metric" ADDRESS_FUNCTION macro. */ 69193323Sed 70193323Sed# if defined (CRAY) && defined (CRAY_STACKSEG_END) 71193323Sedlong i00afunc (); 72193323Sed# define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg)) 73193323Sed# else 74193323Sed# define ADDRESS_FUNCTION(arg) &(arg) 75193323Sed# endif 76199989Srdivacky 77193323Sed/* Define STACK_DIRECTION if you know the direction of stack 78193323Sed growth for your system; otherwise it will be automatically 79193323Sed deduced at run-time. 80193323Sed 81193323Sed STACK_DIRECTION > 0 => grows toward higher addresses 82193323Sed STACK_DIRECTION < 0 => grows toward lower addresses 83193323Sed STACK_DIRECTION = 0 => direction of growth unknown */ 84193323Sed 85199481Srdivacky# ifndef STACK_DIRECTION 86193323Sed# define STACK_DIRECTION 0 /* Direction unknown. */ 87193323Sed# endif 88193323Sed 89198892Srdivacky# if STACK_DIRECTION != 0 90193323Sed 91193323Sed# define STACK_DIR STACK_DIRECTION /* Known at compile-time. */ 92193323Sed 93193323Sed# else /* STACK_DIRECTION == 0; need run-time code. */ 94198090Srdivacky 95199481Srdivackystatic int stack_dir; /* 1 or -1 once known. */ 96198090Srdivacky# define STACK_DIR stack_dir 97198090Srdivacky 98198090Srdivackystatic void 99198090Srdivackyfind_stack_direction (void) 100193323Sed{ 101193323Sed static char *addr = NULL; /* Address of first `dummy', once known. */ 102193323Sed auto char dummy; /* To get stack address. */ 103193323Sed 104193323Sed if (addr == NULL) 105193323Sed { /* Initial entry. */ 106193323Sed addr = ADDRESS_FUNCTION (dummy); 107193323Sed 108193323Sed find_stack_direction (); /* Recurse once. */ 109193323Sed } 110193323Sed else 111193323Sed { 112193323Sed /* Second entry. */ 113193323Sed if (ADDRESS_FUNCTION (dummy) > addr) 114193323Sed stack_dir = 1; /* Stack grew upward. */ 115193323Sed else 116193323Sed stack_dir = -1; /* Stack grew downward. */ 117193323Sed } 118193323Sed} 119193323Sed 120193323Sed# endif /* STACK_DIRECTION == 0 */ 121193323Sed 122193323Sed/* An "alloca header" is used to: 123193323Sed (a) chain together all alloca'ed blocks; 124198892Srdivacky (b) keep track of stack depth. 125193323Sed 126193323Sed It is very important that sizeof(header) agree with malloc 127193323Sed alignment chunk size. The following default should work okay. */ 128193323Sed 129193323Sed# ifndef ALIGN_SIZE 130193323Sed# define ALIGN_SIZE sizeof(double) 131193323Sed# endif 132193323Sed 133198090Srdivackytypedef union hdr 134193323Sed{ 135193323Sed char align[ALIGN_SIZE]; /* To force sizeof(header). */ 136193323Sed struct 137193323Sed { 138193323Sed union hdr *next; /* For chaining headers. */ 139193323Sed char *deep; /* For stack depth measure. */ 140193323Sed } h; 141193323Sed} header; 142193323Sed 143198090Srdivackystatic header *last_alloca_header = NULL; /* -> last alloca header. */ 144193323Sed 145193323Sed/* Return a pointer to at least SIZE bytes of storage, 146193323Sed which will be automatically reclaimed upon exit from 147193323Sed the procedure that called alloca. Originally, this space 148193323Sed was supposed to be taken from the current stack frame of the 149193323Sed caller, but that method cannot be made to work for some 150193323Sed implementations of C, for example under Gould's UTX/32. */ 151193323Sed 152193323Sedvoid * 153193323Sedalloca (size_t size) 154193323Sed{ 155193323Sed auto char probe; /* Probes stack depth: */ 156202878Srdivacky register char *depth = ADDRESS_FUNCTION (probe); 157202878Srdivacky 158202878Srdivacky# if STACK_DIRECTION == 0 159202878Srdivacky if (STACK_DIR == 0) /* Unknown growth direction. */ 160202878Srdivacky find_stack_direction (); 161202878Srdivacky# endif 162202878Srdivacky 163202878Srdivacky /* Reclaim garbage, defined as all alloca'd storage that 164202878Srdivacky was allocated from deeper in the stack than currently. */ 165202878Srdivacky 166193323Sed { 167193323Sed register header *hp; /* Traverses linked list. */ 168193323Sed 169193323Sed# ifdef emacs 170193323Sed BLOCK_INPUT; 171193323Sed# endif 172193323Sed 173193323Sed for (hp = last_alloca_header; hp != NULL;) 174193323Sed if ((STACK_DIR > 0 && hp->h.deep > depth) 175193323Sed || (STACK_DIR < 0 && hp->h.deep < depth)) 176193323Sed { 177193323Sed register header *np = hp->h.next; 178193323Sed 179193323Sed free (hp); /* Collect garbage. */ 180193323Sed 181193323Sed hp = np; /* -> next header. */ 182193323Sed } 183193323Sed else 184193323Sed break; /* Rest are not deeper. */ 185193323Sed 186193323Sed last_alloca_header = hp; /* -> last valid storage. */ 187198892Srdivacky 188193323Sed# ifdef emacs 189193323Sed UNBLOCK_INPUT; 190193323Sed# endif 191198090Srdivacky } 192198090Srdivacky 193198090Srdivacky if (size == 0) 194198090Srdivacky return NULL; /* No allocation required. */ 195198090Srdivacky 196198090Srdivacky /* Allocate combined header + user data storage. */ 197193323Sed 198193323Sed { 199193323Sed /* Address of header. */ 200193323Sed register header *new; 201193323Sed 202193323Sed size_t combined_size = sizeof (header) + size; 203193323Sed if (combined_size < sizeof (header)) 204193323Sed memory_full (); 205202878Srdivacky 206202878Srdivacky new = malloc (combined_size); 207202878Srdivacky 208202878Srdivacky if (! new) 209202878Srdivacky memory_full (); 210202878Srdivacky 211202878Srdivacky new->h.next = last_alloca_header; 212202878Srdivacky new->h.deep = depth; 213202878Srdivacky 214202878Srdivacky last_alloca_header = new; 215193323Sed 216198090Srdivacky /* User storage begins just after header. */ 217198892Srdivacky 218198090Srdivacky return (void *) (new + 1); 219199989Srdivacky } 220199989Srdivacky} 221199989Srdivacky 222199989Srdivacky# if defined (CRAY) && defined (CRAY_STACKSEG_END) 223199989Srdivacky 224198090Srdivacky# ifdef DEBUG_I00AFUNC 225199989Srdivacky# include <stdio.h> 226199989Srdivacky# endif 227198090Srdivacky 228198090Srdivacky# ifndef CRAY_STACK 229198090Srdivacky# define CRAY_STACK 230198892Srdivacky# ifndef CRAY2 231198892Srdivacky/* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */ 232198892Srdivackystruct stack_control_header 233198892Srdivacky { 234198090Srdivacky long shgrow:32; /* Number of times stack has grown. */ 235198090Srdivacky long shaseg:32; /* Size of increments to stack. */ 236193323Sed long shhwm:32; /* High water mark of stack. */ 237193323Sed long shsize:32; /* Current size of stack (all segments). */ 238193323Sed }; 239193323Sed 240193323Sed/* The stack segment linkage control information occurs at 241193323Sed the high-address end of a stack segment. (The stack 242193323Sed grows from low addresses to high addresses.) The initial 243193323Sed part of the stack segment linkage control information is 244193323Sed 0200 (octal) words. This provides for register storage 245193323Sed for the routine which overflows the stack. */ 246193323Sed 247193323Sedstruct stack_segment_linkage 248193323Sed { 249193323Sed long ss[0200]; /* 0200 overflow words. */ 250193323Sed long sssize:32; /* Number of words in this segment. */ 251193323Sed long ssbase:32; /* Offset to stack base. */ 252193323Sed long:32; 253193323Sed long sspseg:32; /* Offset to linkage control of previous 254193323Sed segment of stack. */ 255193323Sed long:32; 256193323Sed long sstcpt:32; /* Pointer to task common address block. */ 257199989Srdivacky long sscsnm; /* Private control structure number for 258199989Srdivacky microtasking. */ 259199989Srdivacky long ssusr1; /* Reserved for user. */ 260193323Sed long ssusr2; /* Reserved for user. */ 261193323Sed long sstpid; /* Process ID for pid based multi-tasking. */ 262193323Sed long ssgvup; /* Pointer to multitasking thread giveup. */ 263193323Sed long sscray[7]; /* Reserved for Cray Research. */ 264193323Sed long ssa0; 265199989Srdivacky long ssa1; 266199989Srdivacky long ssa2; 267199989Srdivacky long ssa3; 268199989Srdivacky long ssa4; 269193323Sed long ssa5; 270193323Sed long ssa6; 271199989Srdivacky long ssa7; 272199989Srdivacky long sss0; 273199989Srdivacky long sss1; 274199989Srdivacky long sss2; 275199989Srdivacky long sss3; 276199989Srdivacky long sss4; 277199989Srdivacky long sss5; 278199989Srdivacky long sss6; 279199989Srdivacky long sss7; 280199989Srdivacky }; 281199989Srdivacky 282199989Srdivacky# else /* CRAY2 */ 283199989Srdivacky/* The following structure defines the vector of words 284199989Srdivacky returned by the STKSTAT library routine. */ 285199989Srdivackystruct stk_stat 286199989Srdivacky { 287199989Srdivacky long now; /* Current total stack size. */ 288199989Srdivacky long maxc; /* Amount of contiguous space which would 289199989Srdivacky be required to satisfy the maximum 290199989Srdivacky stack demand to date. */ 291199989Srdivacky long high_water; /* Stack high-water mark. */ 292199989Srdivacky long overflows; /* Number of stack overflow ($STKOFEN) calls. */ 293204642Srdivacky long hits; /* Number of internal buffer hits. */ 294199989Srdivacky long extends; /* Number of block extensions. */ 295199989Srdivacky long stko_mallocs; /* Block allocations by $STKOFEN. */ 296193323Sed long underflows; /* Number of stack underflow calls ($STKRETN). */ 297199989Srdivacky long stko_free; /* Number of deallocations by $STKRETN. */ 298199989Srdivacky long stkm_free; /* Number of deallocations by $STKMRET. */ 299199989Srdivacky long segments; /* Current number of stack segments. */ 300199989Srdivacky long maxs; /* Maximum number of stack segments so far. */ 301199989Srdivacky long pad_size; /* Stack pad size. */ 302199989Srdivacky long current_address; /* Current stack segment address. */ 303198113Srdivacky long current_size; /* Current stack segment size. This 304198090Srdivacky number is actually corrupted by STKSTAT to 305198090Srdivacky include the fifteen word trailer area. */ 306199989Srdivacky long initial_address; /* Address of initial segment. */ 307199989Srdivacky long initial_size; /* Size of initial segment. */ 308199989Srdivacky }; 309193323Sed 310193323Sed/* The following structure describes the data structure which trails 311199989Srdivacky any stack segment. I think that the description in 'asdef' is 312199989Srdivacky out of date. I only describe the parts that I am sure about. */ 313199989Srdivacky 314199989Srdivackystruct stk_trailer 315199989Srdivacky { 316199989Srdivacky long this_address; /* Address of this block. */ 317199989Srdivacky long this_size; /* Size of this block (does not include 318199989Srdivacky this trailer). */ 319199989Srdivacky long unknown2; 320199989Srdivacky long unknown3; 321199989Srdivacky long link; /* Address of trailer block of previous 322199989Srdivacky segment. */ 323199989Srdivacky long unknown5; 324199989Srdivacky long unknown6; 325199989Srdivacky long unknown7; 326199989Srdivacky long unknown8; 327199989Srdivacky long unknown9; 328199989Srdivacky long unknown10; 329199989Srdivacky long unknown11; 330199989Srdivacky long unknown12; 331199989Srdivacky long unknown13; 332199989Srdivacky long unknown14; 333199989Srdivacky }; 334199989Srdivacky 335199989Srdivacky# endif /* CRAY2 */ 336199989Srdivacky# endif /* not CRAY_STACK */ 337199989Srdivacky 338199989Srdivacky# ifdef CRAY2 339199989Srdivacky/* Determine a "stack measure" for an arbitrary ADDRESS. 340199989Srdivacky I doubt that "lint" will like this much. */ 341199989Srdivacky 342199989Srdivackystatic long 343199989Srdivackyi00afunc (long *address) 344199989Srdivacky{ 345199989Srdivacky struct stk_stat status; 346199989Srdivacky struct stk_trailer *trailer; 347199989Srdivacky long *block, size; 348199989Srdivacky long result = 0; 349199989Srdivacky 350199989Srdivacky /* We want to iterate through all of the segments. The first 351199989Srdivacky step is to get the stack status structure. We could do this 352199989Srdivacky more quickly and more directly, perhaps, by referencing the 353199989Srdivacky $LM00 common block, but I know that this works. */ 354199989Srdivacky 355199989Srdivacky STKSTAT (&status); 356199989Srdivacky 357199989Srdivacky /* Set up the iteration. */ 358199989Srdivacky 359199989Srdivacky trailer = (struct stk_trailer *) (status.current_address 360199989Srdivacky + status.current_size 361199989Srdivacky - 15); 362199989Srdivacky 363199989Srdivacky /* There must be at least one stack segment. Therefore it is 364199989Srdivacky a fatal error if "trailer" is null. */ 365199989Srdivacky 366199989Srdivacky if (trailer == 0) 367199989Srdivacky abort (); 368199989Srdivacky 369199989Srdivacky /* Discard segments that do not contain our argument address. */ 370199989Srdivacky 371199989Srdivacky while (trailer != 0) 372199989Srdivacky { 373199989Srdivacky block = (long *) trailer->this_address; 374199989Srdivacky size = trailer->this_size; 375199989Srdivacky if (block == 0 || size == 0) 376199989Srdivacky abort (); 377193323Sed trailer = (struct stk_trailer *) trailer->link; 378193323Sed if ((block <= address) && (address < (block + size))) 379193323Sed break; 380193323Sed } 381193323Sed 382193323Sed /* Set the result to the offset in this segment and add the sizes 383193323Sed of all predecessor segments. */ 384193323Sed 385193323Sed result = address - block; 386193323Sed 387193323Sed if (trailer == 0) 388193323Sed { 389193323Sed return result; 390193323Sed } 391193323Sed 392193323Sed do 393193323Sed { 394193323Sed if (trailer->this_size <= 0) 395193323Sed abort (); 396193323Sed result += trailer->this_size; 397193323Sed trailer = (struct stk_trailer *) trailer->link; 398193323Sed } 399199989Srdivacky while (trailer != 0); 400199989Srdivacky 401199989Srdivacky /* We are done. Note that if you present a bogus address (one 402199989Srdivacky not in any segment), you will get a different number back, formed 403199989Srdivacky from subtracting the address of the first block. This is probably 404199989Srdivacky not what you want. */ 405199989Srdivacky 406199989Srdivacky return (result); 407199989Srdivacky} 408199989Srdivacky 409199989Srdivacky# else /* not CRAY2 */ 410199989Srdivacky/* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP. 411199989Srdivacky Determine the number of the cell within the stack, 412199989Srdivacky given the address of the cell. The purpose of this 413199989Srdivacky routine is to linearize, in some sense, stack addresses 414199989Srdivacky for alloca. */ 415199989Srdivacky 416199989Srdivackystatic long 417199989Srdivackyi00afunc (long address) 418199989Srdivacky{ 419199989Srdivacky long stkl = 0; 420199989Srdivacky 421199989Srdivacky long size, pseg, this_segment, stack; 422199989Srdivacky long result = 0; 423199989Srdivacky 424199989Srdivacky struct stack_segment_linkage *ssptr; 425199989Srdivacky 426199989Srdivacky /* Register B67 contains the address of the end of the 427199989Srdivacky current stack segment. If you (as a subprogram) store 428199989Srdivacky your registers on the stack and find that you are past 429199989Srdivacky the contents of B67, you have overflowed the segment. 430199989Srdivacky 431199989Srdivacky B67 also points to the stack segment linkage control 432199989Srdivacky area, which is what we are really interested in. */ 433199989Srdivacky 434199989Srdivacky stkl = CRAY_STACKSEG_END (); 435199989Srdivacky ssptr = (struct stack_segment_linkage *) stkl; 436199989Srdivacky 437199989Srdivacky /* If one subtracts 'size' from the end of the segment, 438193323Sed one has the address of the first word of the segment. 439199989Srdivacky 440199989Srdivacky If this is not the first segment, 'pseg' will be 441199989Srdivacky nonzero. */ 442199989Srdivacky 443199989Srdivacky pseg = ssptr->sspseg; 444199989Srdivacky size = ssptr->sssize; 445199989Srdivacky 446193323Sed this_segment = stkl - size; 447193323Sed 448199989Srdivacky /* It is possible that calling this routine itself caused 449199989Srdivacky a stack overflow. Discard stack segments which do not 450199989Srdivacky contain the target address. */ 451193323Sed 452199989Srdivacky while (!(this_segment <= address && address <= stkl)) 453199989Srdivacky { 454199989Srdivacky# ifdef DEBUG_I00AFUNC 455193323Sed fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl); 456199989Srdivacky# endif 457199989Srdivacky if (pseg == 0) 458199989Srdivacky break; 459199989Srdivacky stkl = stkl - pseg; 460199989Srdivacky ssptr = (struct stack_segment_linkage *) stkl; 461199989Srdivacky size = ssptr->sssize; 462199989Srdivacky pseg = ssptr->sspseg; 463199989Srdivacky this_segment = stkl - size; 464199989Srdivacky } 465199989Srdivacky 466199989Srdivacky result = address - this_segment; 467199989Srdivacky 468199989Srdivacky /* If you subtract pseg from the current end of the stack, 469199989Srdivacky you get the address of the previous stack segment's end. 470199989Srdivacky This seems a little convoluted to me, but I'll bet you save 471199989Srdivacky a cycle somewhere. */ 472199989Srdivacky 473199989Srdivacky while (pseg != 0) 474199989Srdivacky { 475199989Srdivacky# ifdef DEBUG_I00AFUNC 476199989Srdivacky fprintf (stderr, "%011o %011o\n", pseg, size); 477199989Srdivacky# endif 478199989Srdivacky stkl = stkl - pseg; 479199989Srdivacky ssptr = (struct stack_segment_linkage *) stkl; 480199989Srdivacky size = ssptr->sssize; 481199989Srdivacky pseg = ssptr->sspseg; 482199989Srdivacky result += size; 483199989Srdivacky } 484199989Srdivacky return (result); 485193323Sed} 486199989Srdivacky 487199989Srdivacky# endif /* not CRAY2 */ 488199989Srdivacky# endif /* CRAY */ 489193323Sed 490199989Srdivacky# endif /* no alloca */ 491199989Srdivacky#endif /* not GCC version 2 */ 492199989Srdivacky