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