annotate src/alloca.c @ 617:af57a77cbc92

[xemacs-hg @ 2001-06-18 07:09:50 by ben] --------------------------------------------------------------- DOCUMENTATION FIXES: --------------------------------------------------------------- eval.c: Correct documentation. elhash.c: Doc correction. --------------------------------------------------------------- LISP OBJECT CLEANUP: --------------------------------------------------------------- bytecode.h, buffer.h, casetab.h, chartab.h, console-msw.h, console.h, database.c, device.h, eldap.h, elhash.h, events.h, extents.h, faces.h, file-coding.h, frame.h, glyphs.h, gui-x.h, gui.h, keymap.h, lisp-disunion.h, lisp-union.h, lisp.h, lrecord.h, lstream.h, mule-charset.h, objects.h, opaque.h, postgresql.h, process.h, rangetab.h, specifier.h, toolbar.h, tooltalk.h, ui-gtk.h: Add wrap_* to all objects (it was already there for a few of them) -- an expression to encapsulate a pointer into a Lisp object, rather than the inconvenient XSET*. "wrap" was chosen because "make" as in make_int(), make_char() is not appropriate. (It implies allocation. The issue does not exist for ints and chars because they are not allocated.) Full error checking has been added to these expressions. When used without error checking, non-union build, use of these expressions will incur no loss of efficiency. (In fact, XSET* is now defined in terms of wrap_* in a non-union build.) In a union build, you will also get no loss of efficiency provided that you have a decent optimizing compiler, and a compiler that either understands inlines or automatically inlines those particular functions. (And since people don't normally do their production builds on union, it doesn't matter.) Update the sample Lisp object definition in lrecord.h accordingly. dumper.c: Fix places in dumper that referenced wrap_object to reference its new name, wrap_pointer_1. buffer.c, bufslots.h, conslots.h, console.c, console.h, devslots.h, device.c, device.h, frame.c, frame.h, frameslots.h, window.c, window.h, winslots.h: -- Extract out the Lisp objects of `struct device' into devslots.h, just like for the other structures. -- Extract out the remaining (not copied into the window config) Lisp objects in `struct window' into winslots.h; use different macros (WINDOW_SLOT vs. WINDOW_SAVED_SLOT) to differentiate them. -- Eliminate the `dead' flag of `struct frame', since it duplicates information already available in `framemeths', and fix FRAME_LIVE_P accordingly. (Devices and consoles already work this way.) -- In *slots.h, switch to system where MARKED_SLOT is automatically undef'd at the end of the file. (Follows what winslots.h already does.) -- Update the comments at the beginning of *slots.h to be accurate. -- When making any of the above objects dead, zero it out entirely and reset all Lisp object slots to Qnil. (We were already doing this somewhat, but not consistently.) This (1) Eliminates the possibility of extra objects hanging around that ought to be GC'd, (2) Causes an immediate crash if anyone tries to access a structure in one of these objects, (3) Ensures consistent behavior wrt dead objects. dialog-msw.c: Use internal_object_printer, since this object should not escape. --------------------------------------------------------------- FIXING A CRASH THAT I HIT ONCE (AND A RELATED BAD BEHAVIOR): --------------------------------------------------------------- eval.c: Fix up some comments about the FSF implementation. Fix two nasty bugs: (1) condition_case_unwind frees the conses sitting in the catch->tag slot too quickly, resulting in a crash that I hit. (2) catches need to be unwound one at a time when calling unwind-protect code, rather than all at once at the end; otherwise, incorrect behavior can result. (A comment shows exactly how.) backtrace.h: Improve comment about FSF differences in the handler stack. --------------------------------------------------------------- FIXING A CRASH THAT I REPEATEDLY HIT WHEN USING THE MOUSE WHEEL UNDER MSWINDOWS: --------------------------------------------------------------- Basic idea: My crash is due either to a dead, non-marked, GC-collected frame inside of a window mirror, or a prematurely freed window mirror. We need to mark the Lisp objects inside of window mirrors. Tracking the lifespan of window mirrors and scrollbar instances is extremely hard, and there may well be lurking bugs where such objects are freed too soon. The only safe way to fix these problems (and it fixes both problems at once) is to make both of these structures Lisp objects. lrecord.h, emacs.c, inline.c, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, scrollbar.h, symsinit.h: Make scrollbar instances actual Lisp objects. Mark the window mirrors in them. inline.c needs to know about scrollbar.h now. Record the new type in lrecord.h. Fix up scrollbar-*.c appropriately. Create a hash table in scrollbar-msw.c so that the scrollbar instances stored in scrollbar HWND's are properly GC-protected. Create complex_vars_of_scrollbar_mswindows() to create the hash table at startup, and call it from emacs.c. Don't store the scrollbar instance as a property of the GTK scrollbar, as it's not used and if we did this, we'd have to separately GC-protect it in a hash table, like in MS Windows. lrecord.h, frame.h, frame.c, frameslots.h, redisplay.c, window.c, window.h: Move mark_window_mirror from redisplay.c to window.c. Make window mirrors actual Lisp objects. Tell lrecord.h about them. Change the window mirror member of struct frame from a pointer to a Lisp object, and add XWINDOW_MIRROR in appropriate places. Mark the scrollbar instances in the window mirror. redisplay.c, redisplay.h, alloc.c: Delete mark_redisplay. Don't call mark_redisplay. We now mark frame-specific structures in mark_frame. NOTE: I also deleted an extremely questionable call to update_frame_window_mirrors(). It was extremely questionable before, and now totally impossible, since it will create Lisp objects during redisplay. frame.c: Mark the scrollbar instances, which are now Lisp objects. Call mark_gutter() here, not in mark_redisplay(). gutter.c: Update comments about correct marking. --------------------------------------------------------------- ISSUES BROUGHT UP BY MARTIN: --------------------------------------------------------------- buffer.h: Put back these macros the way Steve T and I think they ought to be. I already explained in a previous changelog entry why I think these macros should be the way I'd defined them. Once again: We fix these macros so they don't care about the type of their lvalues. The non-C-string equivalents of these already function in the same way, and it's correct because it should be OK to pass in a CBufbyte *, a BufByte *, a Char_Binary *, an UChar_Binary *, etc. The whole reason for these different types is to work around errors caused by signed-vs-unsigned non-matching types. Any possible error that might be caught in a DFC macro would also be caught wherever the argument is used elsewhere. So creating multiple macro versions would add no useful error-checking and just further complicate an already complicated area. As for Martin's "ANSI aliasing" bug, XEmacs is not ANSI-aliasing clean and probably never will be. Unless the board agrees to change XEmacs in this way (and we really don't want to go down that road), this is not a bug. sound.h: Undo Martin's type change. signal.c: Fix problem identified by Martin with Linux and g++ due to non-standard declaration of setitimer(). systime.h: Update the docs for "qxe_" to point out why making the encapsulation explicit is always the right way to go. (setitimer() itself serves as an example.) For 21.4: update-elc-2.el: Correct misplaced parentheses, making lisp/mule not get recompiled.
author ben
date Mon, 18 Jun 2001 07:10:32 +0000
parents 3078fd1074e8
children e7ee5f8bde58
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* alloca.c -- allocate automatically reclaimed memory
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 (Mostly) portable public-domain implementation -- D A Gwyn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 This implementation of the PWB library alloca function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 which is used to allocate space off the run-time stack so
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 that it is automatically reclaimed upon procedure exit,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 was inspired by discussions with J. Q. Johnson of Cornell.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 J.Otto Tennant <jot@cray.com> contributed the Cray support.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 There are some preprocessor constants that can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 be defined when compiling for your specific system, for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 improved efficiency; however, the defaults should be okay.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 The general concept of this implementation is to keep
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 track of all alloca-allocated blocks, and reclaim any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 that are found to be deeper in the stack than the current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 invocation. This heuristic does not reclaim storage as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 soon as it becomes invalid, but it will do so eventually.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 As a special case, alloca(0) reclaims storage without
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 allocating any. It is a good idea to use alloca(0) in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 your main control loop, etc. to force garbage collection. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* Synched up with: FSF 19.30. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
26 /* Authorship:
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 FSF: A long time ago.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 Very few changes for XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 #ifdef HAVE_CONFIG_H
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 /* XEmacs: If compiling with GCC 2, this file is theoretically not needed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 However, alloca() is broken under GCC 2 on many machines: you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 cannot put a call to alloca() as part of an argument to a function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 /* If someone has defined alloca as a macro,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 there must be some other way alloca is supposed to work. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 /* XEmacs sometimes uses the C alloca even when a builtin alloca is available,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 because it's safer. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 #if defined (EMACS_WANTS_C_ALLOCA) || (!defined (alloca) && (!defined (__GNUC__) || __GNUC__ < 2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #ifdef emacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #ifdef static
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 /* actually, only want this if static is defined as ""
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 -- this is for usg, in which emacs must undefine static
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 in order to make unexec workable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #ifndef STACK_DIRECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 you
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 lose
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 -- must know STACK_DIRECTION at compile-time
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 #endif /* STACK_DIRECTION undefined */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 #endif /* static */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 #endif /* emacs */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 /* If your stack is a linked list of frames, you have to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 provide an "address metric" ADDRESS_FUNCTION macro. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 #if defined (CRAY) && defined (CRAY_STACKSEG_END)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 long i00afunc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 #define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 #define ADDRESS_FUNCTION(arg) &(arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 #ifdef __STDC__ /* XEmacs change */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 typedef void *pointer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 typedef char *pointer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 /* XEmacs: With ERROR_CHECK_MALLOC defined, there is no xfree -- it's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 a macro that does some stuff to try and trap invalid frees,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 and then calls xfree_1 to actually do the work. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 #ifdef emacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 # ifdef ERROR_CHECK_MALLOC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 void xfree_1 (pointer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 # define xfree xfree_1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 # else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 void xfree (pointer);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 # endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
89 #ifndef NULL
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 #define NULL 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 /* Different portions of Emacs need to call different versions of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 malloc. The Emacs executable needs alloca to call xmalloc, because
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 ordinary malloc isn't protected from input signals. On the other
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 hand, the utilities in lib-src need alloca to call malloc; some of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 them are very simple, and don't have an xmalloc routine.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 Non-Emacs programs expect this to call use xmalloc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 Callers below should use malloc. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102
448
3078fd1074e8 Import from CVS: tag r21-2-39
cvs
parents: 442
diff changeset
103 #ifdef emacs
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 #define malloc xmalloc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 #endif
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
106 #ifndef WIN32_NATIVE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 extern pointer malloc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 extern void *malloc();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 /* Define STACK_DIRECTION if you know the direction of stack
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 growth for your system; otherwise it will be automatically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 deduced at run-time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 STACK_DIRECTION > 0 => grows toward higher addresses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 STACK_DIRECTION < 0 => grows toward lower addresses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 STACK_DIRECTION = 0 => direction of growth unknown */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 #ifndef STACK_DIRECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 #define STACK_DIRECTION 0 /* Direction unknown. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 #if STACK_DIRECTION != 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 #define STACK_DIR STACK_DIRECTION /* Known at compile-time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 #else /* STACK_DIRECTION == 0; need run-time code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 static int stack_dir; /* 1 or -1 once known. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 #define STACK_DIR stack_dir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 find_stack_direction ()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 static char *addr = NULL; /* Address of first `dummy', once known. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 auto char dummy; /* To get stack address. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 if (addr == NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 { /* Initial entry. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 addr = ADDRESS_FUNCTION (dummy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 find_stack_direction (); /* Recurse once. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 /* Second entry. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 if (ADDRESS_FUNCTION (dummy) > addr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 stack_dir = 1; /* Stack grew upward. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 stack_dir = -1; /* Stack grew downward. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 #endif /* STACK_DIRECTION == 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 /* An "alloca header" is used to:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 (a) chain together all alloca'ed blocks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (b) keep track of stack depth.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 It is very important that sizeof(header) agree with malloc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 alignment chunk size. The following default should work okay. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 #ifndef ALIGN_SIZE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 #define ALIGN_SIZE sizeof(double)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 typedef union hdr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 char align[ALIGN_SIZE]; /* To force sizeof(header). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 union hdr *next; /* For chaining headers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 char *deep; /* For stack depth measure. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 } h;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 } header;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 static header *last_alloca_header = NULL; /* -> last alloca header. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 /* Return a pointer to at least SIZE bytes of storage,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 which will be automatically reclaimed upon exit from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 the procedure that called alloca. Originally, this space
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 was supposed to be taken from the current stack frame of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 caller, but that method cannot be made to work for some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 implementations of C, for example under Gould's UTX/32. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 pointer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 #ifdef EMACS_WANTS_C_ALLOCA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 c_alloca (size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 alloca (size)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 unsigned size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 auto char probe; /* Probes stack depth: */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
196 register char *depth = ADDRESS_FUNCTION (probe);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 #if STACK_DIRECTION == 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 if (STACK_DIR == 0) /* Unknown growth direction. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 find_stack_direction ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 /* Reclaim garbage, defined as all alloca'd storage that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 was allocated from deeper in the stack than currently. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
207 register header *hp; /* Traverses linked list. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 for (hp = last_alloca_header; hp != NULL;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 if ((STACK_DIR > 0 && hp->h.deep > depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 || (STACK_DIR < 0 && hp->h.deep < depth))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
213 register header *np = hp->h.next;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 free ((pointer) hp); /* Collect garbage. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 hp = np; /* -> next header. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 break; /* Rest are not deeper. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 last_alloca_header = hp; /* -> last valid storage. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 if (size == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 return NULL; /* No allocation required. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 /* Allocate combined header + user data storage. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
231 register pointer new = malloc (sizeof (header) + size);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 /* Address of header. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 ((header *) new)->h.next = last_alloca_header;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 ((header *) new)->h.deep = depth;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 last_alloca_header = (header *) new;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 /* User storage begins just after header. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 return (pointer) ((char *) new + sizeof (header));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 #if defined (CRAY) && defined (CRAY_STACKSEG_END)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 #ifdef DEBUG_I00AFUNC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 #include <stdio.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 #ifndef CRAY_STACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 #define CRAY_STACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 #ifndef CRAY2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 /* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 struct stack_control_header
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 long shgrow:32; /* Number of times stack has grown. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 long shaseg:32; /* Size of increments to stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 long shhwm:32; /* High water mark of stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 long shsize:32; /* Current size of stack (all segments). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 /* The stack segment linkage control information occurs at
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 the high-address end of a stack segment. (The stack
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 grows from low addresses to high addresses.) The initial
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 part of the stack segment linkage control information is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 0200 (octal) words. This provides for register storage
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 for the routine which overflows the stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 struct stack_segment_linkage
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 long ss[0200]; /* 0200 overflow words. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 long sssize:32; /* Number of words in this segment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 long ssbase:32; /* Offset to stack base. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 long:32;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 long sspseg:32; /* Offset to linkage control of previous
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 segment of stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 long:32;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 long sstcpt:32; /* Pointer to task common address block. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 long sscsnm; /* Private control structure number for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 microtasking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 long ssusr1; /* Reserved for user. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 long ssusr2; /* Reserved for user. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 long sstpid; /* Process ID for pid based multi-tasking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 long ssgvup; /* Pointer to multitasking thread giveup. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 long sscray[7]; /* Reserved for Cray Research. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 long ssa0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 long ssa1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 long ssa2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 long ssa3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 long ssa4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 long ssa5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 long ssa6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 long ssa7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 long sss0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 long sss1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 long sss2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 long sss3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 long sss4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 long sss5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 long sss6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 long sss7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 #else /* CRAY2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 /* The following structure defines the vector of words
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 returned by the STKSTAT library routine. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 struct stk_stat
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 long now; /* Current total stack size. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 long maxc; /* Amount of contiguous space which would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 be required to satisfy the maximum
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 stack demand to date. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 long high_water; /* Stack high-water mark. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 long overflows; /* Number of stack overflow ($STKOFEN) calls. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 long hits; /* Number of internal buffer hits. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 long extends; /* Number of block extensions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 long stko_mallocs; /* Block allocations by $STKOFEN. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 long underflows; /* Number of stack underflow calls ($STKRETN). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 long stko_free; /* Number of deallocations by $STKRETN. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 long stkm_free; /* Number of deallocations by $STKMRET. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 long segments; /* Current number of stack segments. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 long maxs; /* Maximum number of stack segments so far. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 long pad_size; /* Stack pad size. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 long current_address; /* Current stack segment address. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 long current_size; /* Current stack segment size. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 number is actually corrupted by STKSTAT to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 include the fifteen word trailer area. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 long initial_address; /* Address of initial segment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 long initial_size; /* Size of initial segment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 /* The following structure describes the data structure which trails
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 any stack segment. I think that the description in 'asdef' is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 out of date. I only describe the parts that I am sure about. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 struct stk_trailer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 long this_address; /* Address of this block. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 long this_size; /* Size of this block (does not include
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 this trailer). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 long unknown2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 long unknown3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 long link; /* Address of trailer block of previous
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 segment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 long unknown5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 long unknown6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 long unknown7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 long unknown8;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 long unknown9;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 long unknown10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 long unknown11;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 long unknown12;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 long unknown13;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 long unknown14;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 #endif /* CRAY2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 #endif /* not CRAY_STACK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 #ifdef CRAY2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 /* Determine a "stack measure" for an arbitrary ADDRESS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 I doubt that "lint" will like this much. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 static long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 i00afunc (long *address)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 struct stk_stat status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 struct stk_trailer *trailer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 long *block, size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 long result = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 /* We want to iterate through all of the segments. The first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 step is to get the stack status structure. We could do this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 more quickly and more directly, perhaps, by referencing the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 $LM00 common block, but I know that this works. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 STKSTAT (&status);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 /* Set up the iteration. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 trailer = (struct stk_trailer *) (status.current_address
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 + status.current_size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 - 15);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 /* There must be at least one stack segment. Therefore it is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 a fatal error if "trailer" is null. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 if (trailer == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 /* Discard segments that do not contain our argument address. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 while (trailer != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 block = (long *) trailer->this_address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 size = trailer->this_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 if (block == 0 || size == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 trailer = (struct stk_trailer *) trailer->link;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 if ((block <= address) && (address < (block + size)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 /* Set the result to the offset in this segment and add the sizes
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 of all predecessor segments. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 result = address - block;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 if (trailer == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 if (trailer->this_size <= 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 result += trailer->this_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 trailer = (struct stk_trailer *) trailer->link;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 while (trailer != 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 /* We are done. Note that if you present a bogus address (one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 not in any segment), you will get a different number back, formed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 from subtracting the address of the first block. This is probably
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 not what you want. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 return (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 #else /* not CRAY2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 /* Stack address function for a CRAY-1, CRAY X-MP, or CRAY Y-MP.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 Determine the number of the cell within the stack,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 given the address of the cell. The purpose of this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 routine is to linearize, in some sense, stack addresses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 for alloca. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 static long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 i00afunc (long address)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 long stkl = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 long size, pseg, this_segment, stack;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 long result = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 struct stack_segment_linkage *ssptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 /* Register B67 contains the address of the end of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 current stack segment. If you (as a subprogram) store
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 your registers on the stack and find that you are past
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 the contents of B67, you have overflowed the segment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 B67 also points to the stack segment linkage control
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 area, which is what we are really interested in. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 stkl = CRAY_STACKSEG_END ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 ssptr = (struct stack_segment_linkage *) stkl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 /* If one subtracts 'size' from the end of the segment,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 one has the address of the first word of the segment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 If this is not the first segment, 'pseg' will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 nonzero. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 pseg = ssptr->sspseg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 size = ssptr->sssize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 this_segment = stkl - size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 /* It is possible that calling this routine itself caused
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 a stack overflow. Discard stack segments which do not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 contain the target address. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 while (!(this_segment <= address && address <= stkl))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 #ifdef DEBUG_I00AFUNC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 if (pseg == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 stkl = stkl - pseg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 ssptr = (struct stack_segment_linkage *) stkl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 size = ssptr->sssize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 pseg = ssptr->sspseg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 this_segment = stkl - size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 result = address - this_segment;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 /* If you subtract pseg from the current end of the stack,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 you get the address of the previous stack segment's end.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 This seems a little convoluted to me, but I'll bet you save
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 a cycle somewhere. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 while (pseg != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 #ifdef DEBUG_I00AFUNC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 fprintf (stderr, "%011o %011o\n", pseg, size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 stkl = stkl - pseg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 ssptr = (struct stack_segment_linkage *) stkl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 size = ssptr->sssize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 pseg = ssptr->sspseg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 result += size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 return (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 #endif /* not CRAY2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 #endif /* CRAY */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 #endif /* complicated expression at top of file */