annotate src/alloca.c @ 185:3d6bfa290dbd r20-3b19

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