annotate src/alloca.c @ 5043:d0c14ea98592

various frame-geometry fixes -------------------- ChangeLog entries follow: -------------------- src/ChangeLog addition: 2010-02-15 Ben Wing <ben@xemacs.org> * EmacsFrame.c: * EmacsFrame.c (EmacsFrameResize): * console-msw-impl.h: * console-msw-impl.h (struct mswindows_frame): * console-msw-impl.h (FRAME_MSWINDOWS_TARGET_RECT): * device-tty.c: * device-tty.c (tty_asynch_device_change): * event-msw.c: * event-msw.c (mswindows_wnd_proc): * faces.c (Fface_list): * faces.h: * frame-gtk.c: * frame-gtk.c (gtk_set_initial_frame_size): * frame-gtk.c (gtk_set_frame_size): * frame-msw.c: * frame-msw.c (mswindows_init_frame_1): * frame-msw.c (mswindows_set_frame_size): * frame-msw.c (mswindows_size_frame_internal): * frame-msw.c (msprinter_init_frame_3): * frame.c: * frame.c (enum): * frame.c (Fmake_frame): * frame.c (adjust_frame_size): * frame.c (store_minibuf_frame_prop): * frame.c (Fframe_property): * frame.c (Fframe_properties): * frame.c (Fframe_displayable_pixel_height): * frame.c (Fframe_displayable_pixel_width): * frame.c (internal_set_frame_size): * frame.c (Fset_frame_height): * frame.c (Fset_frame_pixel_height): * frame.c (Fset_frame_displayable_pixel_height): * frame.c (Fset_frame_width): * frame.c (Fset_frame_pixel_width): * frame.c (Fset_frame_displayable_pixel_width): * frame.c (Fset_frame_size): * frame.c (Fset_frame_pixel_size): * frame.c (Fset_frame_displayable_pixel_size): * frame.c (frame_conversion_internal_1): * frame.c (get_frame_displayable_pixel_size): * frame.c (change_frame_size_1): * frame.c (change_frame_size): * frame.c (generate_title_string): * frame.h: * gtk-xemacs.c: * gtk-xemacs.c (gtk_xemacs_size_request): * gtk-xemacs.c (gtk_xemacs_size_allocate): * gtk-xemacs.c (gtk_xemacs_paint): * gutter.c: * gutter.c (update_gutter_geometry): * redisplay.c (end_hold_frame_size_changes): * redisplay.c (redisplay_frame): * toolbar.c: * toolbar.c (update_frame_toolbars_geometry): * window.c: * window.c (frame_pixsize_valid_p): * window.c (check_frame_size): Various fixes to frame geometry to make it a bit easier to understand and fix some bugs. 1. IMPORTANT: Some renamings. Will need to be applied carefully to the carbon repository, in the following order: -- pixel_to_char_size -> pixel_to_frame_unit_size -- char_to_pixel_size -> frame_unit_to_pixel_size -- pixel_to_real_char_size -> pixel_to_char_size -- char_to_real_pixel_size -> char_to_pixel_size -- Reverse second and third arguments of change_frame_size() and change_frame_size_1() to try to make functions consistent in putting width before height. -- Eliminate old round_size_to_char, because it didn't really do anything differently from round_size_to_real_char() -- round_size_to_real_char -> round_size_to_char; any places that called the old round_size_to_char should just call the new one. 2. IMPORTANT FOR CARBON: The set_frame_size() method is now passed sizes in "frame units", like all other frame-sizing functions, rather than some hacked-up combination of char-cell units and total pixel size. This only affects window systems that use "pixelated geometry", and I'm not sure if Carbon is one of them. MS Windows is pixelated, X and GTK are not. For pixelated-geometry systems, the size in set_frame_size() is in displayable pixels rather than total pixels and needs to be converted appropriately; take a look at the changes made to mswindows_set_frame_size() method if necessary. 3. Add a big long comment in frame.c describing how frame geometry works. 4. Remove MS Windows-specific character height and width fields, duplicative and unused. 5. frame-displayable-pixel-* and set-frame-displayable-pixel-* didn't use to work on MS Windows, but they do now. 6. In general, clean up the handling of "pixelated geometry" so that fewer functions have to worry about this. This is really an abomination that should be removed entirely but that will have to happen later. Fix some buggy code in frame_conversion_internal() that happened to "work" because it was countered by oppositely buggy code in change_frame_size(). 7. Clean up some frame-size code in toolbar.c and use functions already provided in frame.c instead of rolling its own. 8. Fix check_frame_size() in window.c, which formerly didn't take pixelated geometry into account.
author Ben Wing <ben@xemacs.org>
date Mon, 15 Feb 2010 22:14:11 -0600
parents 16112448d484
children 6f2158fa75ed
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.
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
29 Some cleanups for XEmacs.
428
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 #ifdef emacs
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
37 #include "lisp.h"
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
38 #endif
428
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 your stack is a linked list of frames, you have to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 provide an "address metric" ADDRESS_FUNCTION macro. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #if defined (CRAY) && defined (CRAY_STACKSEG_END)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 long i00afunc ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 #define ADDRESS_FUNCTION(arg) (char *) i00afunc (&(arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #define ADDRESS_FUNCTION(arg) &(arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 typedef void *pointer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
52 #ifndef NULL
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 #define NULL 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 /* Define STACK_DIRECTION if you know the direction of stack
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 growth for your system; otherwise it will be automatically
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 deduced at run-time.
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 STACK_DIRECTION > 0 => grows toward higher addresses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 STACK_DIRECTION < 0 => grows toward lower addresses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 STACK_DIRECTION = 0 => direction of growth unknown */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 #ifndef STACK_DIRECTION
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 #define STACK_DIRECTION 0 /* Direction unknown. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 #if STACK_DIRECTION != 0
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 #define STACK_DIR STACK_DIRECTION /* Known at compile-time. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 #else /* STACK_DIRECTION == 0; need run-time code. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 static int stack_dir; /* 1 or -1 once known. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 #define STACK_DIR stack_dir
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 static void
1111
184461bc8de4 [xemacs-hg @ 2002-11-18 06:52:23 by ben]
ben
parents: 851
diff changeset
78 find_stack_direction (void)
428
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 static char *addr = NULL; /* Address of first `dummy', once known. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 auto char dummy; /* To get stack address. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 if (addr == NULL)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 { /* Initial entry. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 addr = ADDRESS_FUNCTION (dummy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 find_stack_direction (); /* Recurse once. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 /* Second entry. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 if (ADDRESS_FUNCTION (dummy) > addr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 stack_dir = 1; /* Stack grew upward. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 stack_dir = -1; /* Stack grew downward. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 }
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 #endif /* STACK_DIRECTION == 0 */
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 /* An "alloca header" is used to:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 (a) chain together all alloca'ed blocks;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 (b) keep track of stack depth.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 It is very important that sizeof(header) agree with malloc
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 alignment chunk size. The following default should work okay. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
108 #ifndef ALIGNMENT_SIZE
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
109 #define ALIGNMENT_SIZE sizeof(double)
428
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 typedef union hdr
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 {
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
114 char align[ALIGNMENT_SIZE]; /* To force sizeof(header). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 struct
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 union hdr *next; /* For chaining headers. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 char *deep; /* For stack depth measure. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 } h;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 } header;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 static header *last_alloca_header = NULL; /* -> last alloca header. */
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 /* Return a pointer to at least SIZE bytes of storage,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 which will be automatically reclaimed upon exit from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 the procedure that called alloca. Originally, this space
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 was supposed to be taken from the current stack frame of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 caller, but that method cannot be made to work for some
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 implementations of C, for example under Gould's UTX/32. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 pointer
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
132 xemacs_c_alloca (unsigned int size)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 auto char probe; /* Probes stack depth: */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
135 register char *depth = ADDRESS_FUNCTION (probe);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 #if STACK_DIRECTION == 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 if (STACK_DIR == 0) /* Unknown growth direction. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 find_stack_direction ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 /* Reclaim garbage, defined as all alloca'd storage that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 was allocated from deeper in the stack than currently. */
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 {
2965
0612d54a372a [xemacs-hg @ 2005-09-30 02:15:06 by ben]
ben
parents: 2500
diff changeset
146 header *hp; /* Traverses linked list. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 for (hp = last_alloca_header; hp != NULL;)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 if ((STACK_DIR > 0 && hp->h.deep > depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 || (STACK_DIR < 0 && hp->h.deep < depth))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
152 register header *np = hp->h.next;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
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
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
156 #else
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
157 free (hp); /* Collect garbage. */
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
158 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 hp = np; /* -> next header. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 break; /* Rest are not deeper. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 last_alloca_header = hp; /* -> last valid storage. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
168 #ifdef emacs
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
169 need_to_check_c_alloca = size > 0 || last_alloca_header;
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
170 recompute_funcall_allocation_flag ();
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
171 #endif
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
172
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 if (size == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 return NULL; /* No allocation required. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 /* Allocate combined header + user data storage. */
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 {
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
179 #ifdef emacs
2965
0612d54a372a [xemacs-hg @ 2005-09-30 02:15:06 by ben]
ben
parents: 2500
diff changeset
180 register pointer new_ = xmalloc (sizeof (header) + size);
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
181 #else
2965
0612d54a372a [xemacs-hg @ 2005-09-30 02:15:06 by ben]
ben
parents: 2500
diff changeset
182 register pointer new_ = malloc (sizeof (header) + size);
851
e7ee5f8bde58 [xemacs-hg @ 2002-05-23 11:46:08 by ben]
ben
parents: 448
diff changeset
183 #endif
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 /* Address of header. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185
2965
0612d54a372a [xemacs-hg @ 2005-09-30 02:15:06 by ben]
ben
parents: 2500
diff changeset
186 ((header *) new_)->h.next = last_alloca_header;
0612d54a372a [xemacs-hg @ 2005-09-30 02:15:06 by ben]
ben
parents: 2500
diff changeset
187 ((header *) new_)->h.deep = depth;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188
2965
0612d54a372a [xemacs-hg @ 2005-09-30 02:15:06 by ben]
ben
parents: 2500
diff changeset
189 last_alloca_header = (header *) new_;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 /* User storage begins just after header. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192
2965
0612d54a372a [xemacs-hg @ 2005-09-30 02:15:06 by ben]
ben
parents: 2500
diff changeset
193 return (pointer) ((char *) new_ + sizeof (header));
428
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 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 #if defined (CRAY) && defined (CRAY_STACKSEG_END)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 #ifdef DEBUG_I00AFUNC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 #include <stdio.h>
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 #ifndef CRAY_STACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 #define CRAY_STACK
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 #ifndef CRAY2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 /* Stack structures for CRAY-1, CRAY X-MP, and CRAY Y-MP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 struct stack_control_header
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 long shgrow:32; /* Number of times stack has grown. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 long shaseg:32; /* Size of increments to stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 long shhwm:32; /* High water mark of stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 long shsize:32; /* Current size of stack (all segments). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 };
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 /* The stack segment linkage control information occurs at
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 the high-address end of a stack segment. (The stack
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 grows from low addresses to high addresses.) The initial
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 part of the stack segment linkage control information is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 0200 (octal) words. This provides for register storage
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 for the routine which overflows the stack. */
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 struct stack_segment_linkage
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 long ss[0200]; /* 0200 overflow words. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 long sssize:32; /* Number of words in this segment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 long ssbase:32; /* Offset to stack base. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 long:32;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 long sspseg:32; /* Offset to linkage control of previous
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 segment of stack. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 long:32;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
231 long sstcpt:32; /* Pointer to task common address block. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 long sscsnm; /* Private control structure number for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 microtasking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 long ssusr1; /* Reserved for user. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 long ssusr2; /* Reserved for user. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 long sstpid; /* Process ID for pid based multi-tasking. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 long ssgvup; /* Pointer to multitasking thread giveup. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 long sscray[7]; /* Reserved for Cray Research. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 long ssa0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 long ssa1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 long ssa2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 long ssa3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 long ssa4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 long ssa5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 long ssa6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 long ssa7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 long sss0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248 long sss1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 long sss2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 long sss3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 long sss4;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 long sss5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 long sss6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 long sss7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 };
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 #else /* CRAY2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 /* The following structure defines the vector of words
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 returned by the STKSTAT library routine. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 struct stk_stat
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 long now; /* Current total stack size. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 long maxc; /* Amount of contiguous space which would
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 be required to satisfy the maximum
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 stack demand to date. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 long high_water; /* Stack high-water mark. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 long overflows; /* Number of stack overflow ($STKOFEN) calls. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 long hits; /* Number of internal buffer hits. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 long extends; /* Number of block extensions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 long stko_mallocs; /* Block allocations by $STKOFEN. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 long underflows; /* Number of stack underflow calls ($STKRETN). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 long stko_free; /* Number of deallocations by $STKRETN. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 long stkm_free; /* Number of deallocations by $STKMRET. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 long segments; /* Current number of stack segments. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 long maxs; /* Maximum number of stack segments so far. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 long pad_size; /* Stack pad size. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 long current_address; /* Current stack segment address. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 long current_size; /* Current stack segment size. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 number is actually corrupted by STKSTAT to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 include the fifteen word trailer area. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 long initial_address; /* Address of initial segment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 long initial_size; /* Size of initial segment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 /* The following structure describes the data structure which trails
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 any stack segment. I think that the description in 'asdef' is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 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
288
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 struct stk_trailer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 long this_address; /* Address of this block. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 long this_size; /* Size of this block (does not include
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 this trailer). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 long unknown2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 long unknown3;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 long link; /* Address of trailer block of previous
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 segment. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 long unknown5;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 long unknown6;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 long unknown7;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 long unknown8;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 long unknown9;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 long unknown10;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 long unknown11;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 long unknown12;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 long unknown13;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 long unknown14;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 };
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 #endif /* CRAY2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 #endif /* not CRAY_STACK */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 #ifdef CRAY2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 /* Determine a "stack measure" for an arbitrary ADDRESS.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 I doubt that "lint" will like this much. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 static long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 i00afunc (long *address)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 struct stk_stat status;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 struct stk_trailer *trailer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 long *block, size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 long result = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 /* We want to iterate through all of the segments. The first
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 step is to get the stack status structure. We could do this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 more quickly and more directly, perhaps, by referencing the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 $LM00 common block, but I know that this works. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 STKSTAT (&status);
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 /* Set up the iteration. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 trailer = (struct stk_trailer *) (status.current_address
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 + status.current_size
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 - 15);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 /* There must be at least one stack segment. Therefore it is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 a fatal error if "trailer" is null. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 if (trailer == 0)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1726
diff changeset
342 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 /* Discard segments that do not contain our argument address. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 while (trailer != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 block = (long *) trailer->this_address;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 size = trailer->this_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 if (block == 0 || size == 0)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1726
diff changeset
351 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 trailer = (struct stk_trailer *) trailer->link;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 if ((block <= address) && (address < (block + size)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 }
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 /* 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
358 of all predecessor segments. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 result = address - block;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 if (trailer == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 return result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 do
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 if (trailer->this_size <= 0)
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 1726
diff changeset
370 ABORT ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371 result += trailer->this_size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 trailer = (struct stk_trailer *) trailer->link;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 while (trailer != 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 /* We are done. Note that if you present a bogus address (one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377 not in any segment), you will get a different number back, formed
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 from subtracting the address of the first block. This is probably
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379 not what you want. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 return (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 #else /* not CRAY2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 /* 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
386 Determine the number of the cell within the stack,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387 given the address of the cell. The purpose of this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 routine is to linearize, in some sense, stack addresses
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 for alloca. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391 static long
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 i00afunc (long 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 long stkl = 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 long size, pseg, this_segment, stack;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 long result = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 struct stack_segment_linkage *ssptr;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 /* Register B67 contains the address of the end of the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 current stack segment. If you (as a subprogram) store
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 your registers on the stack and find that you are past
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 the contents of B67, you have overflowed the segment.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 B67 also points to the stack segment linkage control
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 area, which is what we are really interested in. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 stkl = CRAY_STACKSEG_END ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 ssptr = (struct stack_segment_linkage *) stkl;
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 /* If one subtracts 'size' from the end of the segment,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 one has the address of the first word of the segment.
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 If this is not the first segment, 'pseg' will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 nonzero. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 pseg = ssptr->sspseg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 size = ssptr->sssize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 this_segment = stkl - size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 /* It is possible that calling this routine itself caused
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 a stack overflow. Discard stack segments which do not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 contain the target address. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 while (!(this_segment <= address && address <= stkl))
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 #ifdef DEBUG_I00AFUNC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 fprintf (stderr, "%011o %011o %011o\n", this_segment, address, stkl);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 if (pseg == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 stkl = stkl - pseg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 ssptr = (struct stack_segment_linkage *) stkl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 size = ssptr->sssize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 pseg = ssptr->sspseg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 this_segment = stkl - size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 result = address - this_segment;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 /* If you subtract pseg from the current end of the stack,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 you get the address of the previous stack segment's end.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 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
446 a cycle somewhere. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 while (pseg != 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 #ifdef DEBUG_I00AFUNC
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 fprintf (stderr, "%011o %011o\n", pseg, size);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 stkl = stkl - pseg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 ssptr = (struct stack_segment_linkage *) stkl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 size = ssptr->sssize;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 pseg = ssptr->sspseg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 result += size;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 return (result);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 #endif /* not CRAY2 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 #endif /* CRAY */