Mercurial > hg > xemacs-beta
annotate src/alloca.c @ 5882:bbe4146603db
Reduce regexp usage, now CL-oriented non-regexp code available, core Lisp
lisp/ChangeLog addition:
2015-04-01 Aidan Kehoe <kehoea@parhasard.net>
When calling #'string-match with a REGEXP without regular
expression special characters, call #'search, #'mismatch, #'find,
etc. instead, making our code less likely to side-effect other
functions' match data and a little faster.
* apropos.el (apropos-command):
* apropos.el (apropos):
Call (position ?\n ...) rather than (string-match "\n" ...) here.
* buff-menu.el:
* buff-menu.el (buffers-menu-omit-invisible-buffers):
Don't fire up the regexp engine just to check if a string starts
with a space.
* buff-menu.el (select-buffers-tab-buffers-by-mode):
Don't fire up the regexp engine just to compare mode basenames.
* buff-menu.el (format-buffers-tab-line):
* buff-menu.el (build-buffers-tab-internal): Moved to being a
label within the following.
* buff-menu.el (buffers-tab-items): Use the label.
* bytecomp.el (byte-compile-log-1):
Don't fire up the regexp engine just to look for a newline.
* cus-edit.el (get):
Ditto.
* cus-edit.el (custom-variable-value-create):
Ditto, but for a colon.
* descr-text.el (describe-text-sexp):
Ditto.
* descr-text.el (describe-char-unicode-data):
Use #'split-string-by-char given that we're just looking for a
semicolon.
* descr-text.el (describe-char):
Don't fire up the regexp engine just to look for a newline.
* disass.el (disassemble-internal):
Ditto.
* files.el (file-name-sans-extension):
Implement this using #'position.
* files.el (file-name-extension):
Correct this function's docstring, implement it in terms of
#'position.
* files.el (insert-directory):
Don't fire up the regexp engine to split a string by space; don't
reverse the list of switches, this is actually a longstand bug as
far as I can see.
* gnuserv.el (gnuserv-process-filter):
Use #'position here, instead of consing inside #'split-string
needlessly.
* gtk-file-dialog.el (gtk-file-dialog-update-dropdown):
Use #'split-string-by-char here, don't fire up #'split-string for
directory-sep-char.
* gtk-font-menu.el (hack-font-truename):
Implement this more cheaply in terms of #'find,
#'split-string-by-char, #'equal, rather than #'string-match,
#'split-string, #'string-equal.
* hyper-apropos.el (hyper-apropos-grok-functions):
* hyper-apropos.el (hyper-apropos-grok-variables):
Look for a newline using #'position rather than #'string-match in
these functions.
* info.el (Info-insert-dir):
* info.el (Info-insert-file-contents):
* info.el (Info-follow-reference):
* info.el (Info-extract-menu-node-name):
* info.el (Info-menu):
Look for fixed strings using #'position or #'search as appropriate
in this file.
* ldap.el (ldap-decode-string):
* ldap.el (ldap-encode-string):
#'encode-coding-string, #'decode-coding-string are always
available, don't check if they're fboundp.
* ldap.el (ldap-decode-address):
* ldap.el (ldap-encode-address):
Use #'split-string-by-char in these functions.
* lisp-mnt.el (lm-creation-date):
* lisp-mnt.el (lm-last-modified-date):
Don't fire up the regexp engine just to look for spaces in this file.
* menubar-items.el (default-menubar):
Use (not (mismatch ...)) rather than #'string-match here, for
simple regexp.
Use (search "beta" ...) rather than (string-match "beta" ...)
* menubar-items.el (sort-buffers-menu-alphabetically):
* menubar-items.el (sort-buffers-menu-by-mode-then-alphabetically):
* menubar-items.el (group-buffers-menu-by-mode-then-alphabetically):
Don't fire up the regexp engine to check if a string starts with
a space or an asterisk.
Use the more fine-grained results of #'compare-strings; compare
case-insensitively for the buffer menu.
* menubar-items.el (list-all-buffers):
* menubar-items.el (tutorials-menu-filter):
Use #'equal rather than #'string-equal, which, in this context,
has the drawback of not having a bytecode, and no redeeming
features.
* minibuf.el:
* minibuf.el (un-substitute-in-file-name):
Use #'count, rather than counting the occurences of $ using the
regexp engine.
* minibuf.el (read-file-name-internal-1):
Don't fire up the regexp engine to search for ?=.
* mouse.el (mouse-eval-sexp):
Check for newline with #'find.
* msw-font-menu.el (mswindows-reset-device-font-menus):
Split a string by newline with #'split-string-by-char.
* mule/japanese.el:
* mule/japanese.el ("Japanese"):
Use #'search rather than #'string-match; canoncase before
comparing; fix a bug I had introduced where I had been making case
insensitive comparisons where the case mattered.
* mule/korea-util.el (default-korean-keyboard):
Look for ?3 using #'find, not #'string-march.
* mule/korea-util.el (quail-hangul-switch-hanja):
Search for a fixed string using #'search.
* mule/mule-cmds.el (set-locale-for-language-environment):
#'position, #'substitute rather than #'string-match,
#'replace-in-string.
* newcomment.el (comment-make-extra-lines):
Use #'search rather than #'string-match for a simple string.
* package-get.el (package-get-remote-filename):
Use #'position when looking for ?@
* process.el (setenv):
* process.el (read-envvar-name):
Use #'position when looking for ?=.
* replace.el (map-query-replace-regexp):
Use #'split-string-by-char instead of using an inline
implementation of it.
* select.el (select-convert-from-cf-text):
* select.el (select-convert-from-cf-unicodetext):
Use #'position rather than #'string-match in these functions.
* setup-paths.el (paths-emacs-data-root-p):
Use #'search when looking for simple string.
* sound.el (load-sound-file):
Use #'split-string-by-char rather than an inline reimplementation
of same.
* startup.el (splash-screen-window-body):
* startup.el (splash-screen-tty-body):
Search for simple strings using #'search.
* version.el (emacs-version):
Ditto.
* x-font-menu.el (hack-font-truename):
Implement this more cheaply in terms of #'find,
#'split-string-by-char, #'equal, rather than #'string-match,
#'split-string, #'string-equal.
* x-font-menu.el (x-reset-device-font-menus-core):
Use #'split-string-by-char here.
* x-init.el (x-initialize-keyboard):
Search for a simple string using #'search.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 01 Apr 2015 14:28:20 +0100 |
| parents | d363790fd936 |
| children | e2fae7783046 |
| rev | line source |
|---|---|
| 428 | 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 /* Synched up with: FSF 19.30. */ | |
| 25 | |
| 442 | 26 /* Authorship: |
| 428 | 27 |
| 28 FSF: A long time ago. | |
| 851 | 29 Some cleanups for XEmacs. |
| 428 | 30 */ |
| 31 | |
| 32 #ifdef HAVE_CONFIG_H | |
| 33 #include <config.h> | |
| 34 #endif | |
| 35 | |
| 36 #ifdef emacs | |
| 851 | 37 #include "lisp.h" |
| 38 #endif | |
| 428 | 39 |
| 40 /* If your stack is a linked list of frames, you have to | |
| 41 provide an "address metric" ADDRESS_FUNCTION macro. */ | |
| 42 | |
| 43 #if defined (CRAY) && defined (CRAY_STACKSEG_END) | |
| 44 long i00afunc (); | |
| 45 #define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg)) | |
| 46 #else | |
| 47 #define ADDRESS_FUNCTION(arg) &(arg) | |
| 48 #endif | |
| 49 | |
| 50 typedef void *pointer; | |
| 51 | |
| 442 | 52 #ifndef NULL |
| 428 | 53 #define NULL 0 |
| 54 #endif | |
| 55 | |
| 56 /* Define STACK_DIRECTION if you know the direction of stack | |
| 57 growth for your system; otherwise it will be automatically | |
| 58 deduced at run-time. | |
| 59 | |
| 60 STACK_DIRECTION > 0 => grows toward higher addresses | |
| 61 STACK_DIRECTION < 0 => grows toward lower addresses | |
| 62 STACK_DIRECTION = 0 => direction of growth unknown */ | |
| 63 | |
| 64 #ifndef STACK_DIRECTION | |
| 65 #define STACK_DIRECTION 0 /* Direction unknown. */ | |
| 66 #endif | |
| 67 | |
| 68 #if STACK_DIRECTION != 0 | |
| 69 | |
| 70 #define STACK_DIR STACK_DIRECTION /* Known at compile-time. */ | |
| 71 | |
| 72 #else /* STACK_DIRECTION == 0; need run-time code. */ | |
| 73 | |
| 74 static int stack_dir; /* 1 or -1 once known. */ | |
| 75 #define STACK_DIR stack_dir | |
| 76 | |
| 77 static void | |
| 1111 | 78 find_stack_direction (void) |
| 428 | 79 { |
| 80 static char *addr = NULL; /* Address of first `dummy', once known. */ | |
|
5382
d363790fd936
Remove use of auto keyword. It is default and will be illegal in C++0X.
Mats Lidell <matsl@xemacs.org>
parents:
5050
diff
changeset
|
81 char dummy; /* To get stack address. */ |
| 428 | 82 |
| 83 if (addr == NULL) | |
| 84 { /* Initial entry. */ | |
| 85 addr = ADDRESS_FUNCTION (dummy); | |
| 86 | |
| 87 find_stack_direction (); /* Recurse once. */ | |
| 88 } | |
| 89 else | |
| 90 { | |
| 91 /* Second entry. */ | |
| 92 if (ADDRESS_FUNCTION (dummy) > addr) | |
| 93 stack_dir = 1; /* Stack grew upward. */ | |
| 94 else | |
| 95 stack_dir = -1; /* Stack grew downward. */ | |
| 96 } | |
| 97 } | |
| 98 | |
| 99 #endif /* STACK_DIRECTION == 0 */ | |
| 100 | |
| 101 /* An "alloca header" is used to: | |
| 102 (a) chain together all alloca'ed blocks; | |
| 103 (b) keep track of stack depth. | |
| 104 | |
| 105 It is very important that sizeof(header) agree with malloc | |
| 106 alignment chunk size. The following default should work okay. */ | |
| 107 | |
| 851 | 108 #ifndef ALIGNMENT_SIZE |
| 109 #define ALIGNMENT_SIZE sizeof(double) | |
| 428 | 110 #endif |
| 111 | |
| 112 typedef union hdr | |
| 113 { | |
| 851 | 114 char align[ALIGNMENT_SIZE]; /* To force sizeof(header). */ |
| 428 | 115 struct |
| 116 { | |
| 117 union hdr *next; /* For chaining headers. */ | |
| 118 char *deep; /* For stack depth measure. */ | |
| 119 } h; | |
| 120 } header; | |
| 121 | |
| 122 static header *last_alloca_header = NULL; /* -> last alloca header. */ | |
| 123 | |
| 124 /* Return a pointer to at least SIZE bytes of storage, | |
| 125 which will be automatically reclaimed upon exit from | |
| 126 the procedure that called alloca. Originally, this space | |
| 127 was supposed to be taken from the current stack frame of the | |
| 128 caller, but that method cannot be made to work for some | |
| 129 implementations of C, for example under Gould's UTX/32. */ | |
| 130 | |
| 131 pointer | |
| 851 | 132 xemacs_c_alloca (unsigned int size) |
| 428 | 133 { |
|
5382
d363790fd936
Remove use of auto keyword. It is default and will be illegal in C++0X.
Mats Lidell <matsl@xemacs.org>
parents:
5050
diff
changeset
|
134 char probe; /* Probes stack depth: */ |
| 442 | 135 register char *depth = ADDRESS_FUNCTION (probe); |
| 428 | 136 |
| 137 #if STACK_DIRECTION == 0 | |
| 138 if (STACK_DIR == 0) /* Unknown growth direction. */ | |
| 139 find_stack_direction (); | |
| 140 #endif | |
| 141 | |
| 142 /* Reclaim garbage, defined as all alloca'd storage that | |
| 143 was allocated from deeper in the stack than currently. */ | |
| 144 | |
| 145 { | |
| 2965 | 146 header *hp; /* Traverses linked list. */ |
| 428 | 147 |
| 148 for (hp = last_alloca_header; hp != NULL;) | |
| 149 if ((STACK_DIR > 0 && hp->h.deep > depth) | |
| 150 || (STACK_DIR < 0 && hp->h.deep < depth)) | |
| 151 { | |
| 442 | 152 register header *np = hp->h.next; |
| 428 | 153 |
| 851 | 154 #ifdef emacs |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
2965
diff
changeset
|
155 xfree (hp); /* Collect garbage. */ |
| 851 | 156 #else |
| 157 free (hp); /* Collect garbage. */ | |
| 158 #endif | |
| 428 | 159 |
| 160 hp = np; /* -> next header. */ | |
| 161 } | |
| 162 else | |
| 163 break; /* Rest are not deeper. */ | |
| 164 | |
| 165 last_alloca_header = hp; /* -> last valid storage. */ | |
| 166 } | |
| 167 | |
| 851 | 168 #ifdef emacs |
| 169 need_to_check_c_alloca = size > 0 || last_alloca_header; | |
| 170 recompute_funcall_allocation_flag (); | |
| 171 #endif | |
| 172 | |
| 428 | 173 if (size == 0) |
| 174 return NULL; /* No allocation required. */ | |
| 175 | |
| 176 /* Allocate combined header + user data storage. */ | |
| 177 | |
| 178 { | |
| 851 | 179 #ifdef emacs |
| 2965 | 180 register pointer new_ = xmalloc (sizeof (header) + size); |
| 851 | 181 #else |
| 2965 | 182 register pointer new_ = malloc (sizeof (header) + size); |
| 851 | 183 #endif |
| 428 | 184 /* Address of header. */ |
| 185 | |
| 2965 | 186 ((header *) new_)->h.next = last_alloca_header; |
| 187 ((header *) new_)->h.deep = depth; | |
| 428 | 188 |
| 2965 | 189 last_alloca_header = (header *) new_; |
| 428 | 190 |
| 191 /* User storage begins just after header. */ | |
| 192 | |
| 2965 | 193 return (pointer) ((char *) new_ + sizeof (header)); |
| 428 | 194 } |
| 195 } | |
| 196 | |
| 197 #if defined (CRAY) && defined (CRAY_STACKSEG_END) | |
| 198 | |
| 199 #ifdef DEBUG_I00AFUNC | |
| 200 #include <stdio.h> | |
| 201 #endif | |
| 202 | |
| 203 #ifndef CRAY_STACK | |
| 204 #define CRAY_STACK | |
| 205 #ifndef CRAY2 | |
| 206 /* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */ | |
| 207 struct stack_control_header | |
| 208 { | |
| 209 long shgrow:32; /* Number of times stack has grown. */ | |
| 210 long shaseg:32; /* Size of increments to stack. */ | |
| 211 long shhwm:32; /* High water mark of stack. */ | |
| 212 long shsize:32; /* Current size of stack (all segments). */ | |
| 213 }; | |
| 214 | |
| 215 /* The stack segment linkage control information occurs at | |
| 216 the high-address end of a stack segment. (The stack | |
| 217 grows from low addresses to high addresses.) The initial | |
| 218 part of the stack segment linkage control information is | |
| 219 0200 (octal) words. This provides for register storage | |
| 220 for the routine which overflows the stack. */ | |
| 221 | |
| 222 struct stack_segment_linkage | |
| 223 { | |
| 224 long ss[0200]; /* 0200 overflow words. */ | |
| 225 long sssize:32; /* Number of words in this segment. */ | |
| 226 long ssbase:32; /* Offset to stack base. */ | |
| 227 long:32; | |
| 228 long sspseg:32; /* Offset to linkage control of previous | |
| 229 segment of stack. */ | |
| 230 long:32; | |
| 231 long sstcpt:32; /* Pointer to task common address block. */ | |
| 232 long sscsnm; /* Private control structure number for | |
| 233 microtasking. */ | |
| 234 long ssusr1; /* Reserved for user. */ | |
| 235 long ssusr2; /* Reserved for user. */ | |
| 236 long sstpid; /* Process ID for pid based multi-tasking. */ | |
| 237 long ssgvup; /* Pointer to multitasking thread giveup. */ | |
| 238 long sscray[7]; /* Reserved for Cray Research. */ | |
| 239 long ssa0; | |
| 240 long ssa1; | |
| 241 long ssa2; | |
| 242 long ssa3; | |
| 243 long ssa4; | |
| 244 long ssa5; | |
| 245 long ssa6; | |
| 246 long ssa7; | |
| 247 long sss0; | |
| 248 long sss1; | |
| 249 long sss2; | |
| 250 long sss3; | |
| 251 long sss4; | |
| 252 long sss5; | |
| 253 long sss6; | |
| 254 long sss7; | |
| 255 }; | |
| 256 | |
| 257 #else /* CRAY2 */ | |
| 258 /* The following structure defines the vector of words | |
| 259 returned by the STKSTAT library routine. */ | |
| 260 struct stk_stat | |
| 261 { | |
| 262 long now; /* Current total stack size. */ | |
| 263 long maxc; /* Amount of contiguous space which would | |
| 264 be required to satisfy the maximum | |
| 265 stack demand to date. */ | |
| 266 long high_water; /* Stack high-water mark. */ | |
| 267 long overflows; /* Number of stack overflow ($STKOFEN) calls. */ | |
| 268 long hits; /* Number of internal buffer hits. */ | |
| 269 long extends; /* Number of block extensions. */ | |
| 270 long stko_mallocs; /* Block allocations by $STKOFEN. */ | |
| 271 long underflows; /* Number of stack underflow calls ($STKRETN). */ | |
| 272 long stko_free; /* Number of deallocations by $STKRETN. */ | |
| 273 long stkm_free; /* Number of deallocations by $STKMRET. */ | |
| 274 long segments; /* Current number of stack segments. */ | |
| 275 long maxs; /* Maximum number of stack segments so far. */ | |
| 276 long pad_size; /* Stack pad size. */ | |
| 277 long current_address; /* Current stack segment address. */ | |
| 278 long current_size; /* Current stack segment size. This | |
| 279 number is actually corrupted by STKSTAT to | |
| 280 include the fifteen word trailer area. */ | |
| 281 long initial_address; /* Address of initial segment. */ | |
| 282 long initial_size; /* Size of initial segment. */ | |
| 283 }; | |
| 284 | |
| 285 /* The following structure describes the data structure which trails | |
| 286 any stack segment. I think that the description in 'asdef' is | |
| 287 out of date. I only describe the parts that I am sure about. */ | |
| 288 | |
| 289 struct stk_trailer | |
| 290 { | |
| 291 long this_address; /* Address of this block. */ | |
| 292 long this_size; /* Size of this block (does not include | |
| 293 this trailer). */ | |
| 294 long unknown2; | |
| 295 long unknown3; | |
| 296 long link; /* Address of trailer block of previous | |
| 297 segment. */ | |
| 298 long unknown5; | |
| 299 long unknown6; | |
| 300 long unknown7; | |
| 301 long unknown8; | |
| 302 long unknown9; | |
| 303 long unknown10; | |
| 304 long unknown11; | |
| 305 long unknown12; | |
| 306 long unknown13; | |
| 307 long unknown14; | |
| 308 }; | |
| 309 | |
| 310 #endif /* CRAY2 */ | |
| 311 #endif /* not CRAY_STACK */ | |
| 312 | |
| 313 #ifdef CRAY2 | |
| 314 /* Determine a "stack measure" for an arbitrary ADDRESS. | |
| 315 I doubt that "lint" will like this much. */ | |
| 316 | |
| 317 static long | |
| 318 i00afunc (long *address) | |
| 319 { | |
| 320 struct stk_stat status; | |
| 321 struct stk_trailer *trailer; | |
| 322 long *block, size; | |
| 323 long result = 0; | |
| 324 | |
| 325 /* We want to iterate through all of the segments. The first | |
| 326 step is to get the stack status structure. We could do this | |
| 327 more quickly and more directly, perhaps, by referencing the | |
| 328 $LM00 common block, but I know that this works. */ | |
| 329 | |
| 330 STKSTAT (&status); | |
| 331 | |
| 332 /* Set up the iteration. */ | |
| 333 | |
| 334 trailer = (struct stk_trailer *) (status.current_address | |
| 335 + status.current_size | |
| 336 - 15); | |
| 337 | |
| 338 /* There must be at least one stack segment. Therefore it is | |
| 339 a fatal error if "trailer" is null. */ | |
| 340 | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
341 assert (trailer != 0); |
| 428 | 342 |
| 343 /* Discard segments that do not contain our argument address. */ | |
| 344 | |
| 345 while (trailer != 0) | |
| 346 { | |
| 347 block = (long *) trailer->this_address; | |
| 348 size = trailer->this_size; | |
| 349 if (block == 0 || size == 0) | |
| 2500 | 350 ABORT (); |
| 428 | 351 trailer = (struct stk_trailer *) trailer->link; |
| 352 if ((block <= address) && (address < (block + size))) | |
| 353 break; | |
| 354 } | |
| 355 | |
| 356 /* Set the result to the offset in this segment and add the sizes | |
| 357 of all predecessor segments. */ | |
| 358 | |
| 359 result = address - block; | |
| 360 | |
| 361 if (trailer == 0) | |
| 362 { | |
| 363 return result; | |
| 364 } | |
| 365 | |
| 366 do | |
| 367 { | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4976
diff
changeset
|
368 assert (trailer->this_size > 0); |
| 428 | 369 result += trailer->this_size; |
| 370 trailer = (struct stk_trailer *) trailer->link; | |
| 371 } | |
| 372 while (trailer != 0); | |
| 373 | |
| 374 /* We are done. Note that if you present a bogus address (one | |
| 375 not in any segment), you will get a different number back, formed | |
| 376 from subtracting the address of the first block. This is probably | |
| 377 not what you want. */ | |
| 378 | |
| 379 return (result); | |
| 380 } | |
| 381 | |
| 382 #else /* not CRAY2 */ | |
| 383 /* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP. | |
| 384 Determine the number of the cell within the stack, | |
| 385 given the address of the cell. The purpose of this | |
| 386 routine is to linearize, in some sense, stack addresses | |
| 387 for alloca. */ | |
| 388 | |
| 389 static long | |
| 390 i00afunc (long address) | |
| 391 { | |
| 392 long stkl = 0; | |
| 393 | |
| 394 long size, pseg, this_segment, stack; | |
| 395 long result = 0; | |
| 396 | |
| 397 struct stack_segment_linkage *ssptr; | |
| 398 | |
| 399 /* Register B67 contains the address of the end of the | |
| 400 current stack segment. If you (as a subprogram) store | |
| 401 your registers on the stack and find that you are past | |
| 402 the contents of B67, you have overflowed the segment. | |
| 403 | |
| 404 B67 also points to the stack segment linkage control | |
| 405 area, which is what we are really interested in. */ | |
| 406 | |
| 407 stkl = CRAY_STACKSEG_END (); | |
| 408 ssptr = (struct stack_segment_linkage *) stkl; | |
| 409 | |
| 410 /* If one subtracts 'size' from the end of the segment, | |
| 411 one has the address of the first word of the segment. | |
| 412 | |
| 413 If this is not the first segment, 'pseg' will be | |
| 414 nonzero. */ | |
| 415 | |
| 416 pseg = ssptr->sspseg; | |
| 417 size = ssptr->sssize; | |
| 418 | |
| 419 this_segment = stkl - size; | |
| 420 | |
| 421 /* It is possible that calling this routine itself caused | |
| 422 a stack overflow. Discard stack segments which do not | |
| 423 contain the target address. */ | |
| 424 | |
| 425 while (!(this_segment <= address && address <= stkl)) | |
| 426 { | |
| 427 #ifdef DEBUG_I00AFUNC | |
| 428 fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl); | |
| 429 #endif | |
| 430 if (pseg == 0) | |
| 431 break; | |
| 432 stkl = stkl - pseg; | |
| 433 ssptr = (struct stack_segment_linkage *) stkl; | |
| 434 size = ssptr->sssize; | |
| 435 pseg = ssptr->sspseg; | |
| 436 this_segment = stkl - size; | |
| 437 } | |
| 438 | |
| 439 result = address - this_segment; | |
| 440 | |
| 441 /* If you subtract pseg from the current end of the stack, | |
| 442 you get the address of the previous stack segment's end. | |
| 443 This seems a little convoluted to me, but I'll bet you save | |
| 444 a cycle somewhere. */ | |
| 445 | |
| 446 while (pseg != 0) | |
| 447 { | |
| 448 #ifdef DEBUG_I00AFUNC | |
| 449 fprintf (stderr, "%011o %011o\n", pseg, size); | |
| 450 #endif | |
| 451 stkl = stkl - pseg; | |
| 452 ssptr = (struct stack_segment_linkage *) stkl; | |
| 453 size = ssptr->sssize; | |
| 454 pseg = ssptr->sspseg; | |
| 455 result += size; | |
| 456 } | |
| 457 return (result); | |
| 458 } | |
| 459 | |
| 460 #endif /* not CRAY2 */ | |
| 461 #endif /* CRAY */ |