gvpe/lib/alloca.c

/* alloca.c -- allocate automatically reclaimed memory
   (Mostly) portable public-domain implementation -- D A Gwyn

   This implementation of the PWB library alloca function,
   which is used to allocate space off the run-time stack so
   that it is automatically reclaimed upon procedure exit,
   was inspired by discussions with J. Q. Johnson of Cornell.
   J.Otto Tennant <jot@cray.com> contributed the Cray support.

   There are some preprocessor constants that can
   be defined when compiling for your specific system, for
   improved efficiency; however, the defaults should be okay.

   The general concept of this implementation is to keep
   track of all alloca-allocated blocks, and reclaim any
   that are found to be deeper in the stack than the current
   invocation.  This heuristic does not reclaim storage as
   soon as it becomes invalid, but it will do so eventually.

   As a special case, alloca(0) reclaims storage without
   allocating any.  It is a good idea to use alloca(0) in
   your main control loop, etc. to force garbage collection.  */

#ifdef HAVE_CONFIG_H
# include <config.h>
#endif

#ifdef emacs
# include "blockinput.h"
#endif

/* If compiling with GCC 2, this file's not needed.  */
#if !defined (__GNUC__) || __GNUC__ < 2

/* If someone has defined alloca as a macro,
   there must be some other way alloca is supposed to work.  */
# ifndef alloca

#  ifdef emacs
#   ifdef static
/* actually, only want this if static is defined as ""
   -- this is for usg, in which emacs must undefine static
   in order to make unexec workable
   */
#    ifndef STACK_DIRECTION
you
lose
-- must know STACK_DIRECTION at compile-time
#    endif /* STACK_DIRECTION undefined */
#   endif /* static */
#  endif /* emacs */

/* If your stack is a linked list of frames, you have to
   provide an "address metric" ADDRESS_FUNCTION macro.  */

#  if defined (CRAY) && defined (CRAY_STACKSEG_END)
long i00afunc ();
#   define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
#  else
#   define ADDRESS_FUNCTION(arg) &(arg)
#  endif

#  if __STDC__
typedef void *pointer;
#  else
typedef char *pointer;
#  endif

#  ifndef NULL
#   define NULL 0
#  endif

/* Different portions of Emacs need to call different versions of
   malloc.  The Emacs executable needs alloca to call xmalloc, because
   ordinary malloc isn't protected from input signals.  On the other
   hand, the utilities in lib-src need alloca to call malloc; some of
   them are very simple, and don't have an xmalloc routine.

   Non-Emacs programs expect this to call xmalloc.

   Callers below should use malloc.  */

#  ifndef emacs
#   define malloc xmalloc
#  endif
extern pointer malloc ();

/* Define STACK_DIRECTION if you know the direction of stack
   growth for your system; otherwise it will be automatically
   deduced at run-time.

   STACK_DIRECTION > 0 => grows toward higher addresses
   STACK_DIRECTION < 0 => grows toward lower addresses
   STACK_DIRECTION = 0 => direction of growth unknown  */

#  ifndef STACK_DIRECTION
#   define STACK_DIRECTION      0       /* Direction unknown.  */
#  endif

#  if STACK_DIRECTION != 0

#   define STACK_DIR    STACK_DIRECTION /* Known at compile-time.  */

#  else /* STACK_DIRECTION == 0; need run-time code.  */

static int stack_dir;           /* 1 or -1 once known.  */
#   define STACK_DIR    stack_dir

static void
find_stack_direction ()
{
  static char *addr = NULL;     /* Address of first `dummy', once known.  */
  auto char dummy;              /* To get stack address.  */

  if (addr == NULL)
    {                           /* Initial entry.  */
      addr = ADDRESS_FUNCTION (dummy);

      find_stack_direction ();  /* Recurse once.  */
    }
  else
    {
      /* Second entry.  */
      if (ADDRESS_FUNCTION (dummy) > addr)
        stack_dir = 1;          /* Stack grew upward.  */
      else
        stack_dir = -1;         /* Stack grew downward.  */
    }
}

#  endif /* STACK_DIRECTION == 0 */

/* An "alloca header" is used to:
   (a) chain together all alloca'ed blocks;
   (b) keep track of stack depth.

   It is very important that sizeof(header) agree with malloc
   alignment chunk size.  The following default should work okay.  */

#  ifndef       ALIGN_SIZE
#   define ALIGN_SIZE   sizeof(double)
#  endif

typedef union hdr
{
  char align[ALIGN_SIZE];       /* To force sizeof(header).  */
  struct
    {
      union hdr *next;          /* For chaining headers.  */
      char *deep;               /* For stack depth measure.  */
    } h;
} header;

static header *last_alloca_header = NULL;       /* -> last alloca header.  */

/* Return a pointer to at least SIZE bytes of storage,
   which will be automatically reclaimed upon exit from
   the procedure that called alloca.  Originally, this space
   was supposed to be taken from the current stack frame of the
   caller, but that method cannot be made to work for some
   implementations of C, for example under Gould's UTX/32.  */

pointer
alloca (size)
     unsigned size;
{
  auto char probe;              /* Probes stack depth: */
  register char *depth = ADDRESS_FUNCTION (probe);

#  if STACK_DIRECTION == 0
  if (STACK_DIR == 0)           /* Unknown growth direction.  */
    find_stack_direction ();
#  endif

  /* Reclaim garbage, defined as all alloca'd storage that
     was allocated from deeper in the stack than currently.  */

  {
    register header *hp;        /* Traverses linked list.  */

#  ifdef emacs
    BLOCK_INPUT;
#  endif

    for (hp = last_alloca_header; hp != NULL;)
      if ((STACK_DIR > 0 && hp->h.deep > depth)
          || (STACK_DIR < 0 && hp->h.deep < depth))
        {
          register header *np = hp->h.next;

          free ((pointer) hp);  /* Collect garbage.  */

          hp = np;              /* -> next header.  */
        }
      else
        break;                  /* Rest are not deeper.  */

    last_alloca_header = hp;    /* -> last valid storage.  */

#  ifdef emacs
    UNBLOCK_INPUT;
#  endif
  }

  if (size == 0)
    return NULL;                /* No allocation required.  */

  /* Allocate combined header + user data storage.  */

  {
    register pointer new = malloc (sizeof (header) + size);
    /* Address of header.  */

    ((header *) new)->h.next = last_alloca_header;
    ((header *) new)->h.deep = depth;

    last_alloca_header = (header *) new;

    /* User storage begins just after header.  */

    return (pointer) ((char *) new + sizeof (header));
  }
}

#  if defined (CRAY) && defined (CRAY_STACKSEG_END)

#   ifdef DEBUG_I00AFUNC
#    include <stdio.h>
#   endif

#   ifndef CRAY_STACK
#    define CRAY_STACK
#    ifndef CRAY2
/* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
struct stack_control_header
  {
    long shgrow:32;             /* Number of times stack has grown.  */
    long shaseg:32;             /* Size of increments to stack.  */
    long shhwm:32;              /* High water mark of stack.  */
    long shsize:32;             /* Current size of stack (all segments).  */
  };

/* The stack segment linkage control information occurs at
   the high-address end of a stack segment.  (The stack
   grows from low addresses to high addresses.)  The initial
   part of the stack segment linkage control information is
   0200 (octal) words.  This provides for register storage
   for the routine which overflows the stack.  */

struct stack_segment_linkage
  {
    long ss[0200];              /* 0200 overflow words.  */
    long sssize:32;             /* Number of words in this segment.  */
    long ssbase:32;             /* Offset to stack base.  */
    long:32;
    long sspseg:32;             /* Offset to linkage control of previous
                                   segment of stack.  */
    long:32;
    long sstcpt:32;             /* Pointer to task common address block.  */
    long sscsnm;                /* Private control structure number for
                                   microtasking.  */
    long ssusr1;                /* Reserved for user.  */
    long ssusr2;                /* Reserved for user.  */
    long sstpid;                /* Process ID for pid based multi-tasking.  */
    long ssgvup;                /* Pointer to multitasking thread giveup.  */
    long sscray[7];             /* Reserved for Cray Research.  */
    long ssa0;
    long ssa1;
    long ssa2;
    long ssa3;
    long ssa4;
    long ssa5;
    long ssa6;
    long ssa7;
    long sss0;
    long sss1;
    long sss2;
    long sss3;
    long sss4;
    long sss5;
    long sss6;
    long sss7;
  };

#    else /* CRAY2 */
/* The following structure defines the vector of words
   returned by the STKSTAT library routine.  */
struct stk_stat
  {
    long now;                   /* Current total stack size.  */
    long maxc;                  /* Amount of contiguous space which would
                                   be required to satisfy the maximum
                                   stack demand to date.  */
    long high_water;            /* Stack high-water mark.  */
    long overflows;             /* Number of stack overflow ($STKOFEN) calls.  */
    long hits;                  /* Number of internal buffer hits.  */
    long extends;               /* Number of block extensions.  */
    long stko_mallocs;          /* Block allocations by $STKOFEN.  */
    long underflows;            /* Number of stack underflow calls ($STKRETN).  */
    long stko_free;             /* Number of deallocations by $STKRETN.  */
    long stkm_free;             /* Number of deallocations by $STKMRET.  */
    long segments;              /* Current number of stack segments.  */
    long maxs;                  /* Maximum number of stack segments so far.  */
    long pad_size;              /* Stack pad size.  */
    long current_address;       /* Current stack segment address.  */
    long current_size;          /* Current stack segment size.  This
                                   number is actually corrupted by STKSTAT to
                                   include the fifteen word trailer area.  */
    long initial_address;       /* Address of initial segment.  */
    long initial_size;          /* Size of initial segment.  */
  };

/* The following structure describes the data structure which trails
   any stack segment.  I think that the description in 'asdef' is
   out of date.  I only describe the parts that I am sure about.  */

struct stk_trailer
  {
    long this_address;          /* Address of this block.  */
    long this_size;             /* Size of this block (does not include
                                   this trailer).  */
    long unknown2;
    long unknown3;
    long link;                  /* Address of trailer block of previous
                                   segment.  */
    long unknown5;
    long unknown6;
    long unknown7;
    long unknown8;
    long unknown9;
    long unknown10;
    long unknown11;
    long unknown12;
    long unknown13;
    long unknown14;
  };

#    endif /* CRAY2 */
#   endif /* not CRAY_STACK */

#   ifdef CRAY2
/* Determine a "stack measure" for an arbitrary ADDRESS.
   I doubt that "lint" will like this much.  */

static long
i00afunc (long *address)
{
  struct stk_stat status;
  struct stk_trailer *trailer;
  long *block, size;
  long result = 0;

  /* We want to iterate through all of the segments.  The first
     step is to get the stack status structure.  We could do this
     more quickly and more directly, perhaps, by referencing the
     $LM00 common block, but I know that this works.  */

  STKSTAT (&status);

  /* Set up the iteration.  */

  trailer = (struct stk_trailer *) (status.current_address
                                    + status.current_size
                                    - 15);

  /* There must be at least one stack segment.  Therefore it is
     a fatal error if "trailer" is null.  */

  if (trailer == 0)
    abort ();

  /* Discard segments that do not contain our argument address.  */

  while (trailer != 0)
    {
      block = (long *) trailer->this_address;
      size = trailer->this_size;
      if (block == 0 || size == 0)
        abort ();
      trailer = (struct stk_trailer *) trailer->link;
      if ((block <= address) && (address < (block + size)))
        break;
    }

  /* Set the result to the offset in this segment and add the sizes
     of all predecessor segments.  */

  result = address - block;

  if (trailer == 0)
    {
      return result;
    }

  do
    {
      if (trailer->this_size <= 0)
        abort ();
      result += trailer->this_size;
      trailer = (struct stk_trailer *) trailer->link;
    }
  while (trailer != 0);

  /* We are done.  Note that if you present a bogus address (one
     not in any segment), you will get a different number back, formed
     from subtracting the address of the first block.  This is probably
     not what you want.  */

  return (result);
}

#   else /* not CRAY2 */
/* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP.
   Determine the number of the cell within the stack,
   given the address of the cell.  The purpose of this
   routine is to linearize, in some sense, stack addresses
   for alloca.  */

static long
i00afunc (long address)
{
  long stkl = 0;

  long size, pseg, this_segment, stack;
  long result = 0;

  struct stack_segment_linkage *ssptr;

  /* Register B67 contains the address of the end of the
     current stack segment.  If you (as a subprogram) store
     your registers on the stack and find that you are past
     the contents of B67, you have overflowed the segment.

     B67 also points to the stack segment linkage control
     area, which is what we are really interested in.  */

  stkl = CRAY_STACKSEG_END ();
  ssptr = (struct stack_segment_linkage *) stkl;

  /* If one subtracts 'size' from the end of the segment,
     one has the address of the first word of the segment.

     If this is not the first segment, 'pseg' will be
     nonzero.  */

  pseg = ssptr->sspseg;
  size = ssptr->sssize;

  this_segment = stkl - size;

  /* It is possible that calling this routine itself caused
     a stack overflow.  Discard stack segments which do not
     contain the target address.  */

  while (!(this_segment <= address && address <= stkl))
    {
#    ifdef DEBUG_I00AFUNC
      fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
#    endif
      if (pseg == 0)
        break;
      stkl = stkl - pseg;
      ssptr = (struct stack_segment_linkage *) stkl;
      size = ssptr->sssize;
      pseg = ssptr->sspseg;
      this_segment = stkl - size;
    }

  result = address - this_segment;

  /* If you subtract pseg from the current end of the stack,
     you get the address of the previous stack segment's end.
     This seems a little convoluted to me, but I'll bet you save
     a cycle somewhere.  */

  while (pseg != 0)
    {
#    ifdef DEBUG_I00AFUNC
      fprintf (stderr, "%011o %011o\n", pseg, size);
#    endif
      stkl = stkl - pseg;
      ssptr = (struct stack_segment_linkage *) stkl;
      size = ssptr->sssize;
      pseg = ssptr->sspseg;
      result += size;
    }
  return (result);
}

#   endif /* not CRAY2 */
#  endif /* CRAY */

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