Mercurial > emacs
annotate src/alloc.c @ 24206:d3649b38bb37
(w32_wnd_proc): Fix bug introduced by previous change;
the lwindow, rwindow and apps keys could not be used as function
keys, because they were being passed to TranslateMessage which
ignores them. Also, key was being changed to SPC.
author | Andrew Innes <andrewi@gnu.org> |
---|---|
date | Wed, 27 Jan 1999 21:53:27 +0000 |
parents | 2eb9e2f5aa33 |
children | 3bb745067f0e |
rev | line source |
---|---|
300 | 1 /* Storage allocation and gc for GNU Emacs Lisp interpreter. |
20708 | 2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 1998 |
3 Free Software Foundation, Inc. | |
300 | 4 |
5 This file is part of GNU Emacs. | |
6 | |
7 GNU Emacs is free software; you can redistribute it and/or modify | |
8 it under the terms of the GNU General Public License as published by | |
1784
11f62e53acff
Make scrollbar structures into lisp objects, so that they can be
Jim Blandy <jimb@redhat.com>
parents:
1562
diff
changeset
|
9 the Free Software Foundation; either version 2, or (at your option) |
300 | 10 any later version. |
11 | |
12 GNU Emacs is distributed in the hope that it will be useful, | |
13 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 GNU General Public License for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
18 along with GNU Emacs; see the file COPYING. If not, write to | |
14186
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14095
diff
changeset
|
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14095
diff
changeset
|
20 Boston, MA 02111-1307, USA. */ |
300 | 21 |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
22 /* Note that this declares bzero on OSF/1. How dumb. */ |
3003
5a73d384f45e
* syssignal.h: Don't #include <signal.h>
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
23 #include <signal.h> |
300 | 24 |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
4494
diff
changeset
|
25 #include <config.h> |
300 | 26 #include "lisp.h" |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
27 #include "intervals.h" |
356 | 28 #include "puresize.h" |
300 | 29 #ifndef standalone |
30 #include "buffer.h" | |
31 #include "window.h" | |
764 | 32 #include "frame.h" |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
33 #include "blockinput.h" |
11341 | 34 #include "keyboard.h" |
21084
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
35 #include "charset.h" |
300 | 36 #endif |
37 | |
638 | 38 #include "syssignal.h" |
39 | |
12096 | 40 extern char *sbrk (); |
41 | |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
42 #ifdef DOUG_LEA_MALLOC |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
43 #include <malloc.h> |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
44 #define __malloc_size_t int |
23973
2eb9e2f5aa33
(MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
23958
diff
changeset
|
45 |
2eb9e2f5aa33
(MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
23958
diff
changeset
|
46 /* Specify maximum number of areas to mmap. |
2eb9e2f5aa33
(MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
23958
diff
changeset
|
47 It would be nice to use a value that explicitly |
2eb9e2f5aa33
(MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
23958
diff
changeset
|
48 means "no limit". */ |
2eb9e2f5aa33
(MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
23958
diff
changeset
|
49 #define MMAP_MAX_AREAS 100000000 |
2eb9e2f5aa33
(MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
23958
diff
changeset
|
50 |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
51 #else |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
52 /* The following come from gmalloc.c. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
53 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
54 #if defined (__STDC__) && __STDC__ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
55 #include <stddef.h> |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
56 #define __malloc_size_t size_t |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
57 #else |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
58 #define __malloc_size_t unsigned int |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
59 #endif |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
60 extern __malloc_size_t _bytes_used; |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
61 extern int __malloc_extra_blocks; |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
62 #endif /* !defined(DOUG_LEA_MALLOC) */ |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
63 |
300 | 64 #define max(A,B) ((A) > (B) ? (A) : (B)) |
11727
53ccd2d608ee
(gc_cons_threshold): Change back to int.
Richard M. Stallman <rms@gnu.org>
parents:
11679
diff
changeset
|
65 #define min(A,B) ((A) < (B) ? (A) : (B)) |
300 | 66 |
67 /* Macro to verify that storage intended for Lisp objects is not | |
68 out of range to fit in the space for a pointer. | |
69 ADDRESS is the start of the block, and SIZE | |
70 is the amount of space within which objects can start. */ | |
71 #define VALIDATE_LISP_STORAGE(address, size) \ | |
72 do \ | |
73 { \ | |
74 Lisp_Object val; \ | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
75 XSETCONS (val, (char *) address + size); \ |
300 | 76 if ((char *) XCONS (val) != (char *) address + size) \ |
77 { \ | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
78 xfree (address); \ |
300 | 79 memory_full (); \ |
80 } \ | |
81 } while (0) | |
82 | |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
83 /* Value of _bytes_used, when spare_memory was freed. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
84 static __malloc_size_t bytes_used_when_full; |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
85 |
300 | 86 /* Number of bytes of consing done since the last gc */ |
87 int consing_since_gc; | |
88 | |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
89 /* Count the amount of consing of various sorts of space. */ |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
90 int cons_cells_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
91 int floats_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
92 int vector_cells_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
93 int symbols_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
94 int string_chars_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
95 int misc_objects_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
96 int intervals_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
97 |
300 | 98 /* Number of bytes of consing since gc before another gc should be done. */ |
11727
53ccd2d608ee
(gc_cons_threshold): Change back to int.
Richard M. Stallman <rms@gnu.org>
parents:
11679
diff
changeset
|
99 int gc_cons_threshold; |
300 | 100 |
101 /* Nonzero during gc */ | |
102 int gc_in_progress; | |
103 | |
14959
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
104 /* Nonzero means display messages at beginning and end of GC. */ |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
105 int garbage_collection_messages; |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
106 |
300 | 107 #ifndef VIRT_ADDR_VARIES |
108 extern | |
109 #endif /* VIRT_ADDR_VARIES */ | |
110 int malloc_sbrk_used; | |
111 | |
112 #ifndef VIRT_ADDR_VARIES | |
113 extern | |
114 #endif /* VIRT_ADDR_VARIES */ | |
115 int malloc_sbrk_unused; | |
116 | |
764 | 117 /* Two limits controlling how much undo information to keep. */ |
118 int undo_limit; | |
119 int undo_strong_limit; | |
300 | 120 |
19332
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
121 int total_conses, total_markers, total_symbols, total_string_size, total_vector_size; |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
122 int total_free_conses, total_free_markers, total_free_symbols; |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
123 #ifdef LISP_FLOAT_TYPE |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
124 int total_free_floats, total_floats; |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
125 #endif /* LISP_FLOAT_TYPE */ |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
126 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
127 /* Points to memory space allocated as "spare", |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
128 to be freed if we run out of memory. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
129 static char *spare_memory; |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
130 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
131 /* Amount of spare memory to keep in reserve. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
132 #define SPARE_MEMORY (1 << 14) |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
133 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
134 /* Number of extra blocks malloc should get when it needs more core. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
135 static int malloc_hysteresis; |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
136 |
12529 | 137 /* Nonzero when malloc is called for allocating Lisp object space. */ |
138 int allocating_for_lisp; | |
139 | |
300 | 140 /* Non-nil means defun should do purecopy on the function definition */ |
141 Lisp_Object Vpurify_flag; | |
142 | |
143 #ifndef HAVE_SHM | |
8817
48ff00bebef6
(pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
144 EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,}; /* Force it into data space! */ |
300 | 145 #define PUREBEG (char *) pure |
146 #else | |
147 #define pure PURE_SEG_BITS /* Use shared memory segment */ | |
148 #define PUREBEG (char *)PURE_SEG_BITS | |
356 | 149 |
150 /* This variable is used only by the XPNTR macro when HAVE_SHM is | |
151 defined. If we used the PURESIZE macro directly there, that would | |
152 make most of emacs dependent on puresize.h, which we don't want - | |
153 you should be able to change that without too much recompilation. | |
154 So map_in_data initializes pure_size, and the dependencies work | |
155 out. */ | |
8817
48ff00bebef6
(pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
156 EMACS_INT pure_size; |
300 | 157 #endif /* not HAVE_SHM */ |
158 | |
159 /* Index in pure at which next pure object will be allocated. */ | |
160 int pureptr; | |
161 | |
162 /* If nonzero, this is a warning delivered by malloc and not yet displayed. */ | |
163 char *pending_malloc_warning; | |
164 | |
6116
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
165 /* Pre-computed signal argument for use when memory is exhausted. */ |
6133
752d4237f869
(memory_signal_data): No longer static.
Richard M. Stallman <rms@gnu.org>
parents:
6116
diff
changeset
|
166 Lisp_Object memory_signal_data; |
6116
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
167 |
300 | 168 /* Maximum amount of C stack to save when a GC happens. */ |
169 | |
170 #ifndef MAX_SAVE_STACK | |
171 #define MAX_SAVE_STACK 16000 | |
172 #endif | |
173 | |
10413
bfe591f66299
(DONT_COPY_FLAG): Default this to 1.
Karl Heuer <kwzh@gnu.org>
parents:
10398
diff
changeset
|
174 /* Define DONT_COPY_FLAG to be some bit which will always be zero in a |
bfe591f66299
(DONT_COPY_FLAG): Default this to 1.
Karl Heuer <kwzh@gnu.org>
parents:
10398
diff
changeset
|
175 pointer to a Lisp_Object, when that pointer is viewed as an integer. |
bfe591f66299
(DONT_COPY_FLAG): Default this to 1.
Karl Heuer <kwzh@gnu.org>
parents:
10398
diff
changeset
|
176 (On most machines, pointers are even, so we can use the low bit. |
14036 | 177 Word-addressable architectures may need to override this in the m-file.) |
10413
bfe591f66299
(DONT_COPY_FLAG): Default this to 1.
Karl Heuer <kwzh@gnu.org>
parents:
10398
diff
changeset
|
178 When linking references to small strings through the size field, we |
bfe591f66299
(DONT_COPY_FLAG): Default this to 1.
Karl Heuer <kwzh@gnu.org>
parents:
10398
diff
changeset
|
179 use this slot to hold the bit that would otherwise be interpreted as |
bfe591f66299
(DONT_COPY_FLAG): Default this to 1.
Karl Heuer <kwzh@gnu.org>
parents:
10398
diff
changeset
|
180 the GC mark bit. */ |
10389
162b3e6c4610
(DONT_COPY_FLAG): New bit flag.
Richard M. Stallman <rms@gnu.org>
parents:
10340
diff
changeset
|
181 #ifndef DONT_COPY_FLAG |
10413
bfe591f66299
(DONT_COPY_FLAG): Default this to 1.
Karl Heuer <kwzh@gnu.org>
parents:
10398
diff
changeset
|
182 #define DONT_COPY_FLAG 1 |
10389
162b3e6c4610
(DONT_COPY_FLAG): New bit flag.
Richard M. Stallman <rms@gnu.org>
parents:
10340
diff
changeset
|
183 #endif /* no DONT_COPY_FLAG */ |
162b3e6c4610
(DONT_COPY_FLAG): New bit flag.
Richard M. Stallman <rms@gnu.org>
parents:
10340
diff
changeset
|
184 |
300 | 185 /* Buffer in which we save a copy of the C stack at each GC. */ |
186 | |
187 char *stack_copy; | |
188 int stack_copy_size; | |
189 | |
190 /* Non-zero means ignore malloc warnings. Set during initialization. */ | |
191 int ignore_warnings; | |
1318 | 192 |
13219
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
193 Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots; |
11374
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
194 |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
195 static void mark_object (), mark_buffer (), mark_kboards (); |
1318 | 196 static void clear_marks (), gc_sweep (); |
197 static void compact_strings (); | |
20495 | 198 |
199 extern int message_enable_multibyte; | |
300 | 200 |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
201 /* Versions of malloc and realloc that print warnings as memory gets full. */ |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
202 |
300 | 203 Lisp_Object |
204 malloc_warning_1 (str) | |
205 Lisp_Object str; | |
206 { | |
207 Fprinc (str, Vstandard_output); | |
208 write_string ("\nKilling some buffers may delay running out of memory.\n", -1); | |
209 write_string ("However, certainly by the time you receive the 95% warning,\n", -1); | |
210 write_string ("you should clean up, kill this Emacs, and start a new one.", -1); | |
211 return Qnil; | |
212 } | |
213 | |
214 /* malloc calls this if it finds we are near exhausting storage */ | |
20375
1dd0bd0749b5
(malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents:
20057
diff
changeset
|
215 |
1dd0bd0749b5
(malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents:
20057
diff
changeset
|
216 void |
300 | 217 malloc_warning (str) |
218 char *str; | |
219 { | |
220 pending_malloc_warning = str; | |
221 } | |
222 | |
20375
1dd0bd0749b5
(malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents:
20057
diff
changeset
|
223 void |
300 | 224 display_malloc_warning () |
225 { | |
226 register Lisp_Object val; | |
227 | |
228 val = build_string (pending_malloc_warning); | |
229 pending_malloc_warning = 0; | |
230 internal_with_output_to_temp_buffer (" *Danger*", malloc_warning_1, val); | |
231 } | |
232 | |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
233 #ifdef DOUG_LEA_MALLOC |
17831
9238a2254a23
(BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents:
17348
diff
changeset
|
234 # define BYTES_USED (mallinfo ().arena) |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
235 #else |
17831
9238a2254a23
(BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents:
17348
diff
changeset
|
236 # define BYTES_USED _bytes_used |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
237 #endif |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
238 |
300 | 239 /* Called if malloc returns zero */ |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
240 |
20375
1dd0bd0749b5
(malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents:
20057
diff
changeset
|
241 void |
300 | 242 memory_full () |
243 { | |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
244 #ifndef SYSTEM_MALLOC |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
245 bytes_used_when_full = BYTES_USED; |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
246 #endif |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
247 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
248 /* The first time we get here, free the spare memory. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
249 if (spare_memory) |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
250 { |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
251 free (spare_memory); |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
252 spare_memory = 0; |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
253 } |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
254 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
255 /* This used to call error, but if we've run out of memory, we could get |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
256 infinite recursion trying to build the string. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
257 while (1) |
18621
53b95f307c75
(memory_full): Pass Qnil to Fsignal for ERROR_SYMBOL.
Richard M. Stallman <rms@gnu.org>
parents:
18104
diff
changeset
|
258 Fsignal (Qnil, memory_signal_data); |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
259 } |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
260 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
261 /* Called if we can't allocate relocatable space for a buffer. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
262 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
263 void |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
264 buffer_memory_full () |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
265 { |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
266 /* If buffers use the relocating allocator, |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
267 no need to free spare_memory, because we may have plenty of malloc |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
268 space left that we could get, and if we don't, the malloc that fails |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
269 will itself cause spare_memory to be freed. |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
270 If buffers don't use the relocating allocator, |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
271 treat this like any other failing malloc. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
272 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
273 #ifndef REL_ALLOC |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
274 memory_full (); |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
275 #endif |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
276 |
6116
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
277 /* This used to call error, but if we've run out of memory, we could get |
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
278 infinite recursion trying to build the string. */ |
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
279 while (1) |
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
280 Fsignal (Qerror, memory_signal_data); |
300 | 281 } |
282 | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
283 /* Like malloc routines but check for no memory and block interrupt input. */ |
300 | 284 |
285 long * | |
286 xmalloc (size) | |
287 int size; | |
288 { | |
289 register long *val; | |
290 | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
291 BLOCK_INPUT; |
300 | 292 val = (long *) malloc (size); |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
293 UNBLOCK_INPUT; |
300 | 294 |
295 if (!val && size) memory_full (); | |
296 return val; | |
297 } | |
298 | |
299 long * | |
300 xrealloc (block, size) | |
301 long *block; | |
302 int size; | |
303 { | |
304 register long *val; | |
305 | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
306 BLOCK_INPUT; |
590 | 307 /* We must call malloc explicitly when BLOCK is 0, since some |
308 reallocs don't do this. */ | |
309 if (! block) | |
310 val = (long *) malloc (size); | |
600
a8d78999e46d
*** empty log message ***
Noah Friedman <friedman@splode.com>
parents:
590
diff
changeset
|
311 else |
590 | 312 val = (long *) realloc (block, size); |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
313 UNBLOCK_INPUT; |
300 | 314 |
315 if (!val && size) memory_full (); | |
316 return val; | |
317 } | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
318 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
319 void |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
320 xfree (block) |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
321 long *block; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
322 { |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
323 BLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
324 free (block); |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
325 UNBLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
326 } |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
327 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
328 /* Like malloc but used for allocating Lisp data. */ |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
329 |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
330 long * |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
331 lisp_malloc (size) |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
332 int size; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
333 { |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
334 register long *val; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
335 |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
336 BLOCK_INPUT; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
337 allocating_for_lisp++; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
338 val = (long *) malloc (size); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
339 allocating_for_lisp--; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
340 UNBLOCK_INPUT; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
341 |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
342 if (!val && size) memory_full (); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
343 return val; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
344 } |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
345 |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
346 void |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
347 lisp_free (block) |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
348 long *block; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
349 { |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
350 BLOCK_INPUT; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
351 allocating_for_lisp++; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
352 free (block); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
353 allocating_for_lisp--; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
354 UNBLOCK_INPUT; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
355 } |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
356 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
357 /* Arranging to disable input signals while we're in malloc. |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
358 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
359 This only works with GNU malloc. To help out systems which can't |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
360 use GNU malloc, all the calls to malloc, realloc, and free |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
361 elsewhere in the code should be inside a BLOCK_INPUT/UNBLOCK_INPUT |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
362 pairs; unfortunately, we have no idea what C library functions |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
363 might call malloc, so we can't really protect them unless you're |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
364 using GNU malloc. Fortunately, most of the major operating can use |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
365 GNU malloc. */ |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
366 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
367 #ifndef SYSTEM_MALLOC |
2507
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
368 extern void * (*__malloc_hook) (); |
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
369 static void * (*old_malloc_hook) (); |
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
370 extern void * (*__realloc_hook) (); |
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
371 static void * (*old_realloc_hook) (); |
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
372 extern void (*__free_hook) (); |
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
373 static void (*old_free_hook) (); |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
374 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
375 /* This function is used as the hook for free to call. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
376 |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
377 static void |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
378 emacs_blocked_free (ptr) |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
379 void *ptr; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
380 { |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
381 BLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
382 __free_hook = old_free_hook; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
383 free (ptr); |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
384 /* If we released our reserve (due to running out of memory), |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
385 and we have a fair amount free once again, |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
386 try to set aside another reserve in case we run out once more. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
387 if (spare_memory == 0 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
388 /* Verify there is enough space that even with the malloc |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
389 hysteresis this call won't run out again. |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
390 The code here is correct as long as SPARE_MEMORY |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
391 is substantially larger than the block size malloc uses. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
392 && (bytes_used_when_full |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
393 > BYTES_USED + max (malloc_hysteresis, 4) * SPARE_MEMORY)) |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
394 spare_memory = (char *) malloc (SPARE_MEMORY); |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
395 |
2507
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
396 __free_hook = emacs_blocked_free; |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
397 UNBLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
398 } |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
399 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
400 /* If we released our reserve (due to running out of memory), |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
401 and we have a fair amount free once again, |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
402 try to set aside another reserve in case we run out once more. |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
403 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
404 This is called when a relocatable block is freed in ralloc.c. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
405 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
406 void |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
407 refill_memory_reserve () |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
408 { |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
409 if (spare_memory == 0) |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
410 spare_memory = (char *) malloc (SPARE_MEMORY); |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
411 } |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
412 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
413 /* This function is the malloc hook that Emacs uses. */ |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
414 |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
415 static void * |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
416 emacs_blocked_malloc (size) |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
417 unsigned size; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
418 { |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
419 void *value; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
420 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
421 BLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
422 __malloc_hook = old_malloc_hook; |
17831
9238a2254a23
(BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents:
17348
diff
changeset
|
423 #ifdef DOUG_LEA_MALLOC |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
424 mallopt (M_TOP_PAD, malloc_hysteresis * 4096); |
17831
9238a2254a23
(BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents:
17348
diff
changeset
|
425 #else |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
426 __malloc_extra_blocks = malloc_hysteresis; |
17831
9238a2254a23
(BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents:
17348
diff
changeset
|
427 #endif |
3581
152fd924c7bb
* alloc.c (emacs_blocked_malloc, emacs_blocked_realloc): Cast the
Jim Blandy <jimb@redhat.com>
parents:
3536
diff
changeset
|
428 value = (void *) malloc (size); |
2507
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
429 __malloc_hook = emacs_blocked_malloc; |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
430 UNBLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
431 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
432 return value; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
433 } |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
434 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
435 static void * |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
436 emacs_blocked_realloc (ptr, size) |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
437 void *ptr; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
438 unsigned size; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
439 { |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
440 void *value; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
441 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
442 BLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
443 __realloc_hook = old_realloc_hook; |
3581
152fd924c7bb
* alloc.c (emacs_blocked_malloc, emacs_blocked_realloc): Cast the
Jim Blandy <jimb@redhat.com>
parents:
3536
diff
changeset
|
444 value = (void *) realloc (ptr, size); |
2507
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
445 __realloc_hook = emacs_blocked_realloc; |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
446 UNBLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
447 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
448 return value; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
449 } |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
450 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
451 void |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
452 uninterrupt_malloc () |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
453 { |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
454 if (__free_hook != emacs_blocked_free) |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
455 old_free_hook = __free_hook; |
2507
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
456 __free_hook = emacs_blocked_free; |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
457 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
458 if (__malloc_hook != emacs_blocked_malloc) |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
459 old_malloc_hook = __malloc_hook; |
2507
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
460 __malloc_hook = emacs_blocked_malloc; |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
461 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
462 if (__realloc_hook != emacs_blocked_realloc) |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
463 old_realloc_hook = __realloc_hook; |
2507
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
464 __realloc_hook = emacs_blocked_realloc; |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
465 } |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
466 #endif |
300 | 467 |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
468 /* Interval allocation. */ |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
469 |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
470 #ifdef USE_TEXT_PROPERTIES |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
471 #define INTERVAL_BLOCK_SIZE \ |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
472 ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval)) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
473 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
474 struct interval_block |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
475 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
476 struct interval_block *next; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
477 struct interval intervals[INTERVAL_BLOCK_SIZE]; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
478 }; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
479 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
480 struct interval_block *interval_block; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
481 static int interval_block_index; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
482 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
483 INTERVAL interval_free_list; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
484 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
485 /* Total number of interval blocks now in use. */ |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
486 int n_interval_blocks; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
487 |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
488 static void |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
489 init_intervals () |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
490 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
491 interval_block |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
492 = (struct interval_block *) lisp_malloc (sizeof (struct interval_block)); |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
493 interval_block->next = 0; |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
494 bzero ((char *) interval_block->intervals, sizeof interval_block->intervals); |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
495 interval_block_index = 0; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
496 interval_free_list = 0; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
497 n_interval_blocks = 1; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
498 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
499 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
500 #define INIT_INTERVALS init_intervals () |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
501 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
502 INTERVAL |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
503 make_interval () |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
504 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
505 INTERVAL val; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
506 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
507 if (interval_free_list) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
508 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
509 val = interval_free_list; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
510 interval_free_list = interval_free_list->parent; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
511 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
512 else |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
513 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
514 if (interval_block_index == INTERVAL_BLOCK_SIZE) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
515 { |
12529 | 516 register struct interval_block *newi; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
517 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
518 newi = (struct interval_block *) lisp_malloc (sizeof (struct interval_block)); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
519 |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
520 VALIDATE_LISP_STORAGE (newi, sizeof *newi); |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
521 newi->next = interval_block; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
522 interval_block = newi; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
523 interval_block_index = 0; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
524 n_interval_blocks++; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
525 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
526 val = &interval_block->intervals[interval_block_index++]; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
527 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
528 consing_since_gc += sizeof (struct interval); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
529 intervals_consed++; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
530 RESET_INTERVAL (val); |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
531 return val; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
532 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
533 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
534 static int total_free_intervals, total_intervals; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
535 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
536 /* Mark the pointers of one interval. */ |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
537 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
538 static void |
1957
54c8c66cd9ac
(mark_interval): Add ignored arg.
Richard M. Stallman <rms@gnu.org>
parents:
1939
diff
changeset
|
539 mark_interval (i, dummy) |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
540 register INTERVAL i; |
1957
54c8c66cd9ac
(mark_interval): Add ignored arg.
Richard M. Stallman <rms@gnu.org>
parents:
1939
diff
changeset
|
541 Lisp_Object dummy; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
542 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
543 if (XMARKBIT (i->plist)) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
544 abort (); |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
545 mark_object (&i->plist); |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
546 XMARK (i->plist); |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
547 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
548 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
549 static void |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
550 mark_interval_tree (tree) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
551 register INTERVAL tree; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
552 { |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
553 /* No need to test if this tree has been marked already; this |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
554 function is always called through the MARK_INTERVAL_TREE macro, |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
555 which takes care of that. */ |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
556 |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
557 /* XMARK expands to an assignment; the LHS of an assignment can't be |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
558 a cast. */ |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
559 XMARK (* (Lisp_Object *) &tree->parent); |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
560 |
1957
54c8c66cd9ac
(mark_interval): Add ignored arg.
Richard M. Stallman <rms@gnu.org>
parents:
1939
diff
changeset
|
561 traverse_intervals (tree, 1, 0, mark_interval, Qnil); |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
562 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
563 |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
564 #define MARK_INTERVAL_TREE(i) \ |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
565 do { \ |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
566 if (!NULL_INTERVAL_P (i) \ |
18621
53b95f307c75
(memory_full): Pass Qnil to Fsignal for ERROR_SYMBOL.
Richard M. Stallman <rms@gnu.org>
parents:
18104
diff
changeset
|
567 && ! XMARKBIT (*(Lisp_Object *) &i->parent)) \ |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
568 mark_interval_tree (i); \ |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
569 } while (0) |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
570 |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
571 /* The oddity in the call to XUNMARK is necessary because XUNMARK |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3581
diff
changeset
|
572 expands to an assignment to its argument, and most C compilers don't |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
573 support casts on the left operand of `='. */ |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
574 #define UNMARK_BALANCE_INTERVALS(i) \ |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
575 { \ |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
576 if (! NULL_INTERVAL_P (i)) \ |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
577 { \ |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
578 XUNMARK (* (Lisp_Object *) (&(i)->parent)); \ |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
579 (i) = balance_intervals (i); \ |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
580 } \ |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
581 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
582 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
583 #else /* no interval use */ |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
584 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
585 #define INIT_INTERVALS |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
586 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
587 #define UNMARK_BALANCE_INTERVALS(i) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
588 #define MARK_INTERVAL_TREE(i) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
589 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
590 #endif /* no interval use */ |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
591 |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
592 /* Floating point allocation. */ |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
593 |
300 | 594 #ifdef LISP_FLOAT_TYPE |
595 /* Allocation of float cells, just like conses */ | |
596 /* We store float cells inside of float_blocks, allocating a new | |
597 float_block with malloc whenever necessary. Float cells reclaimed by | |
598 GC are put on a free list to be reallocated before allocating | |
599 any new float cells from the latest float_block. | |
600 | |
601 Each float_block is just under 1020 bytes long, | |
602 since malloc really allocates in units of powers of two | |
603 and uses 4 bytes for its own overhead. */ | |
604 | |
605 #define FLOAT_BLOCK_SIZE \ | |
606 ((1020 - sizeof (struct float_block *)) / sizeof (struct Lisp_Float)) | |
607 | |
608 struct float_block | |
609 { | |
610 struct float_block *next; | |
611 struct Lisp_Float floats[FLOAT_BLOCK_SIZE]; | |
612 }; | |
613 | |
614 struct float_block *float_block; | |
615 int float_block_index; | |
616 | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
617 /* Total number of float blocks now in use. */ |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
618 int n_float_blocks; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
619 |
300 | 620 struct Lisp_Float *float_free_list; |
621 | |
622 void | |
623 init_float () | |
624 { | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
625 float_block = (struct float_block *) lisp_malloc (sizeof (struct float_block)); |
300 | 626 float_block->next = 0; |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
627 bzero ((char *) float_block->floats, sizeof float_block->floats); |
300 | 628 float_block_index = 0; |
629 float_free_list = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
630 n_float_blocks = 1; |
300 | 631 } |
632 | |
633 /* Explicitly free a float cell. */ | |
21514 | 634 void |
300 | 635 free_float (ptr) |
636 struct Lisp_Float *ptr; | |
637 { | |
19666
81957e8b80e2
(free_float, free_cons): Don't use the same field for chaining as for marking.
Richard M. Stallman <rms@gnu.org>
parents:
19621
diff
changeset
|
638 *(struct Lisp_Float **)&ptr->data = float_free_list; |
300 | 639 float_free_list = ptr; |
640 } | |
641 | |
642 Lisp_Object | |
643 make_float (float_value) | |
644 double float_value; | |
645 { | |
646 register Lisp_Object val; | |
647 | |
648 if (float_free_list) | |
649 { | |
19666
81957e8b80e2
(free_float, free_cons): Don't use the same field for chaining as for marking.
Richard M. Stallman <rms@gnu.org>
parents:
19621
diff
changeset
|
650 /* We use the data field for chaining the free list |
81957e8b80e2
(free_float, free_cons): Don't use the same field for chaining as for marking.
Richard M. Stallman <rms@gnu.org>
parents:
19621
diff
changeset
|
651 so that we won't use the same field that has the mark bit. */ |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
652 XSETFLOAT (val, float_free_list); |
19666
81957e8b80e2
(free_float, free_cons): Don't use the same field for chaining as for marking.
Richard M. Stallman <rms@gnu.org>
parents:
19621
diff
changeset
|
653 float_free_list = *(struct Lisp_Float **)&float_free_list->data; |
300 | 654 } |
655 else | |
656 { | |
657 if (float_block_index == FLOAT_BLOCK_SIZE) | |
658 { | |
12529 | 659 register struct float_block *new; |
660 | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
661 new = (struct float_block *) lisp_malloc (sizeof (struct float_block)); |
300 | 662 VALIDATE_LISP_STORAGE (new, sizeof *new); |
663 new->next = float_block; | |
664 float_block = new; | |
665 float_block_index = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
666 n_float_blocks++; |
300 | 667 } |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
668 XSETFLOAT (val, &float_block->floats[float_block_index++]); |
300 | 669 } |
670 XFLOAT (val)->data = float_value; | |
9295
17d393a8eed6
(free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents:
9261
diff
changeset
|
671 XSETFASTINT (XFLOAT (val)->type, 0); /* bug chasing -wsr */ |
300 | 672 consing_since_gc += sizeof (struct Lisp_Float); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
673 floats_consed++; |
300 | 674 return val; |
675 } | |
676 | |
677 #endif /* LISP_FLOAT_TYPE */ | |
678 | |
679 /* Allocation of cons cells */ | |
680 /* We store cons cells inside of cons_blocks, allocating a new | |
681 cons_block with malloc whenever necessary. Cons cells reclaimed by | |
682 GC are put on a free list to be reallocated before allocating | |
683 any new cons cells from the latest cons_block. | |
684 | |
685 Each cons_block is just under 1020 bytes long, | |
686 since malloc really allocates in units of powers of two | |
687 and uses 4 bytes for its own overhead. */ | |
688 | |
689 #define CONS_BLOCK_SIZE \ | |
690 ((1020 - sizeof (struct cons_block *)) / sizeof (struct Lisp_Cons)) | |
691 | |
692 struct cons_block | |
693 { | |
694 struct cons_block *next; | |
695 struct Lisp_Cons conses[CONS_BLOCK_SIZE]; | |
696 }; | |
697 | |
698 struct cons_block *cons_block; | |
699 int cons_block_index; | |
700 | |
701 struct Lisp_Cons *cons_free_list; | |
702 | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
703 /* Total number of cons blocks now in use. */ |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
704 int n_cons_blocks; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
705 |
300 | 706 void |
707 init_cons () | |
708 { | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
709 cons_block = (struct cons_block *) lisp_malloc (sizeof (struct cons_block)); |
300 | 710 cons_block->next = 0; |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
711 bzero ((char *) cons_block->conses, sizeof cons_block->conses); |
300 | 712 cons_block_index = 0; |
713 cons_free_list = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
714 n_cons_blocks = 1; |
300 | 715 } |
716 | |
717 /* Explicitly free a cons cell. */ | |
20375
1dd0bd0749b5
(malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents:
20057
diff
changeset
|
718 |
1dd0bd0749b5
(malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents:
20057
diff
changeset
|
719 void |
300 | 720 free_cons (ptr) |
721 struct Lisp_Cons *ptr; | |
722 { | |
19666
81957e8b80e2
(free_float, free_cons): Don't use the same field for chaining as for marking.
Richard M. Stallman <rms@gnu.org>
parents:
19621
diff
changeset
|
723 *(struct Lisp_Cons **)&ptr->cdr = cons_free_list; |
300 | 724 cons_free_list = ptr; |
725 } | |
726 | |
727 DEFUN ("cons", Fcons, Scons, 2, 2, 0, | |
728 "Create a new cons, give it CAR and CDR as components, and return it.") | |
729 (car, cdr) | |
730 Lisp_Object car, cdr; | |
731 { | |
732 register Lisp_Object val; | |
733 | |
734 if (cons_free_list) | |
735 { | |
19666
81957e8b80e2
(free_float, free_cons): Don't use the same field for chaining as for marking.
Richard M. Stallman <rms@gnu.org>
parents:
19621
diff
changeset
|
736 /* We use the cdr for chaining the free list |
81957e8b80e2
(free_float, free_cons): Don't use the same field for chaining as for marking.
Richard M. Stallman <rms@gnu.org>
parents:
19621
diff
changeset
|
737 so that we won't use the same field that has the mark bit. */ |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
738 XSETCONS (val, cons_free_list); |
19666
81957e8b80e2
(free_float, free_cons): Don't use the same field for chaining as for marking.
Richard M. Stallman <rms@gnu.org>
parents:
19621
diff
changeset
|
739 cons_free_list = *(struct Lisp_Cons **)&cons_free_list->cdr; |
300 | 740 } |
741 else | |
742 { | |
743 if (cons_block_index == CONS_BLOCK_SIZE) | |
744 { | |
12529 | 745 register struct cons_block *new; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
746 new = (struct cons_block *) lisp_malloc (sizeof (struct cons_block)); |
300 | 747 VALIDATE_LISP_STORAGE (new, sizeof *new); |
748 new->next = cons_block; | |
749 cons_block = new; | |
750 cons_block_index = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
751 n_cons_blocks++; |
300 | 752 } |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
753 XSETCONS (val, &cons_block->conses[cons_block_index++]); |
300 | 754 } |
755 XCONS (val)->car = car; | |
756 XCONS (val)->cdr = cdr; | |
757 consing_since_gc += sizeof (struct Lisp_Cons); | |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
758 cons_cells_consed++; |
300 | 759 return val; |
760 } | |
20849
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
761 |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
762 /* Make a list of 2, 3, 4 or 5 specified objects. */ |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
763 |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
764 Lisp_Object |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
765 list2 (arg1, arg2) |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
766 Lisp_Object arg1, arg2; |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
767 { |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
768 return Fcons (arg1, Fcons (arg2, Qnil)); |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
769 } |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
770 |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
771 Lisp_Object |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
772 list3 (arg1, arg2, arg3) |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
773 Lisp_Object arg1, arg2, arg3; |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
774 { |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
775 return Fcons (arg1, Fcons (arg2, Fcons (arg3, Qnil))); |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
776 } |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
777 |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
778 Lisp_Object |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
779 list4 (arg1, arg2, arg3, arg4) |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
780 Lisp_Object arg1, arg2, arg3, arg4; |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
781 { |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
782 return Fcons (arg1, Fcons (arg2, Fcons (arg3, Fcons (arg4, Qnil)))); |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
783 } |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
784 |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
785 Lisp_Object |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
786 list5 (arg1, arg2, arg3, arg4, arg5) |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
787 Lisp_Object arg1, arg2, arg3, arg4, arg5; |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
788 { |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
789 return Fcons (arg1, Fcons (arg2, Fcons (arg3, Fcons (arg4, |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
790 Fcons (arg5, Qnil))))); |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
791 } |
300 | 792 |
793 DEFUN ("list", Flist, Slist, 0, MANY, 0, | |
794 "Return a newly created list with specified arguments as elements.\n\ | |
795 Any number of arguments, even zero arguments, are allowed.") | |
796 (nargs, args) | |
797 int nargs; | |
798 register Lisp_Object *args; | |
799 { | |
13610
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
800 register Lisp_Object val; |
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
801 val = Qnil; |
300 | 802 |
13610
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
803 while (nargs > 0) |
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
804 { |
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
805 nargs--; |
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
806 val = Fcons (args[nargs], val); |
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
807 } |
300 | 808 return val; |
809 } | |
810 | |
811 DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, | |
812 "Return a newly created list of length LENGTH, with each element being INIT.") | |
813 (length, init) | |
814 register Lisp_Object length, init; | |
815 { | |
816 register Lisp_Object val; | |
817 register int size; | |
818 | |
9953
e0672d4cf470
(Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents:
9942
diff
changeset
|
819 CHECK_NATNUM (length, 0); |
e0672d4cf470
(Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents:
9942
diff
changeset
|
820 size = XFASTINT (length); |
300 | 821 |
822 val = Qnil; | |
823 while (size-- > 0) | |
824 val = Fcons (init, val); | |
825 return val; | |
826 } | |
827 | |
828 /* Allocation of vectors */ | |
829 | |
830 struct Lisp_Vector *all_vectors; | |
831 | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
832 /* Total number of vectorlike objects now in use. */ |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
833 int n_vectors; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
834 |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
835 struct Lisp_Vector * |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
836 allocate_vectorlike (len) |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
837 EMACS_INT len; |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
838 { |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
839 struct Lisp_Vector *p; |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
840 |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
841 #ifdef DOUG_LEA_MALLOC |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
842 /* Prevent mmap'ing the chunk (which is potentially very large). */ |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
843 mallopt (M_MMAP_MAX, 0); |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
844 #endif |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
845 p = (struct Lisp_Vector *)lisp_malloc (sizeof (struct Lisp_Vector) |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
846 + (len - 1) * sizeof (Lisp_Object)); |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
847 #ifdef DOUG_LEA_MALLOC |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
848 /* Back to a reasonable maximum of mmap'ed areas. */ |
23973
2eb9e2f5aa33
(MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
23958
diff
changeset
|
849 mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
850 #endif |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
851 VALIDATE_LISP_STORAGE (p, 0); |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
852 consing_since_gc += (sizeof (struct Lisp_Vector) |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
853 + (len - 1) * sizeof (Lisp_Object)); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
854 vector_cells_consed += len; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
855 n_vectors; |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
856 |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
857 p->next = all_vectors; |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
858 all_vectors = p; |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
859 return p; |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
860 } |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
861 |
300 | 862 DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0, |
863 "Return a newly created vector of length LENGTH, with each element being INIT.\n\ | |
864 See also the function `vector'.") | |
865 (length, init) | |
866 register Lisp_Object length, init; | |
867 { | |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
868 Lisp_Object vector; |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
869 register EMACS_INT sizei; |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
870 register int index; |
300 | 871 register struct Lisp_Vector *p; |
872 | |
9953
e0672d4cf470
(Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents:
9942
diff
changeset
|
873 CHECK_NATNUM (length, 0); |
e0672d4cf470
(Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents:
9942
diff
changeset
|
874 sizei = XFASTINT (length); |
300 | 875 |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
876 p = allocate_vectorlike (sizei); |
300 | 877 p->size = sizei; |
878 for (index = 0; index < sizei; index++) | |
879 p->contents[index] = init; | |
880 | |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
881 XSETVECTOR (vector, p); |
300 | 882 return vector; |
883 } | |
884 | |
13219
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
885 DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, |
13322
336cbb88a1e3
(Fmake_char_table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
13320
diff
changeset
|
886 "Return a newly created char-table, with purpose PURPOSE.\n\ |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
887 Each element is initialized to INIT, which defaults to nil.\n\ |
16479
52eaaf1cc0e3
(Fmake_char_table): Doc fix.
Erik Naggum <erik@naggum.no>
parents:
16231
diff
changeset
|
888 PURPOSE should be a symbol which has a `char-table-extra-slots' property.\n\ |
13219
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
889 The property's value should be an integer between 0 and 10.") |
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
890 (purpose, init) |
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
891 register Lisp_Object purpose, init; |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
892 { |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
893 Lisp_Object vector; |
13219
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
894 Lisp_Object n; |
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
895 CHECK_SYMBOL (purpose, 1); |
17328
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
896 n = Fget (purpose, Qchar_table_extra_slots); |
13219
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
897 CHECK_NUMBER (n, 0); |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
898 if (XINT (n) < 0 || XINT (n) > 10) |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
899 args_out_of_range (n, Qnil); |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
900 /* Add 2 to the size for the defalt and parent slots. */ |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
901 vector = Fmake_vector (make_number (CHAR_TABLE_STANDARD_SLOTS + XINT (n)), |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
902 init); |
17328
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
903 XCHAR_TABLE (vector)->top = Qt; |
13150
3778c95adca9
(Fmake_char_table): Initialize parent to nil.
Erik Naggum <erik@naggum.no>
parents:
13141
diff
changeset
|
904 XCHAR_TABLE (vector)->parent = Qnil; |
13219
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
905 XCHAR_TABLE (vector)->purpose = purpose; |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
906 XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
907 return vector; |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
908 } |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
909 |
17328
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
910 /* Return a newly created sub char table with default value DEFALT. |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
911 Since a sub char table does not appear as a top level Emacs Lisp |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
912 object, we don't need a Lisp interface to make it. */ |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
913 |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
914 Lisp_Object |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
915 make_sub_char_table (defalt) |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
916 Lisp_Object defalt; |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
917 { |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
918 Lisp_Object vector |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
919 = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), Qnil); |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
920 XCHAR_TABLE (vector)->top = Qnil; |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
921 XCHAR_TABLE (vector)->defalt = defalt; |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
922 XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
923 return vector; |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
924 } |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
925 |
300 | 926 DEFUN ("vector", Fvector, Svector, 0, MANY, 0, |
927 "Return a newly created vector with specified arguments as elements.\n\ | |
928 Any number of arguments, even zero arguments, are allowed.") | |
929 (nargs, args) | |
930 register int nargs; | |
931 Lisp_Object *args; | |
932 { | |
933 register Lisp_Object len, val; | |
934 register int index; | |
935 register struct Lisp_Vector *p; | |
936 | |
9295
17d393a8eed6
(free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents:
9261
diff
changeset
|
937 XSETFASTINT (len, nargs); |
300 | 938 val = Fmake_vector (len, Qnil); |
939 p = XVECTOR (val); | |
940 for (index = 0; index < nargs; index++) | |
941 p->contents[index] = args[index]; | |
942 return val; | |
943 } | |
944 | |
945 DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, | |
946 "Create a byte-code object with specified arguments as elements.\n\ | |
947 The arguments should be the arglist, bytecode-string, constant vector,\n\ | |
948 stack size, (optional) doc string, and (optional) interactive spec.\n\ | |
949 The first four arguments are required; at most six have any\n\ | |
950 significance.") | |
951 (nargs, args) | |
952 register int nargs; | |
953 Lisp_Object *args; | |
954 { | |
955 register Lisp_Object len, val; | |
956 register int index; | |
957 register struct Lisp_Vector *p; | |
958 | |
9295
17d393a8eed6
(free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents:
9261
diff
changeset
|
959 XSETFASTINT (len, nargs); |
485 | 960 if (!NILP (Vpurify_flag)) |
16101
039e96495054
(Fmake_byte_code): Call make_pure_vector using nargs.
Richard M. Stallman <rms@gnu.org>
parents:
16100
diff
changeset
|
961 val = make_pure_vector ((EMACS_INT) nargs); |
300 | 962 else |
963 val = Fmake_vector (len, Qnil); | |
964 p = XVECTOR (val); | |
965 for (index = 0; index < nargs; index++) | |
966 { | |
485 | 967 if (!NILP (Vpurify_flag)) |
300 | 968 args[index] = Fpurecopy (args[index]); |
969 p->contents[index] = args[index]; | |
970 } | |
18104
b2a669ef69b1
(Fmake_byte_code): Set val from p, not from val.
Richard M. Stallman <rms@gnu.org>
parents:
18010
diff
changeset
|
971 XSETCOMPILED (val, p); |
300 | 972 return val; |
973 } | |
974 | |
975 /* Allocation of symbols. | |
976 Just like allocation of conses! | |
977 | |
978 Each symbol_block is just under 1020 bytes long, | |
979 since malloc really allocates in units of powers of two | |
980 and uses 4 bytes for its own overhead. */ | |
981 | |
982 #define SYMBOL_BLOCK_SIZE \ | |
983 ((1020 - sizeof (struct symbol_block *)) / sizeof (struct Lisp_Symbol)) | |
984 | |
985 struct symbol_block | |
986 { | |
987 struct symbol_block *next; | |
988 struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE]; | |
989 }; | |
990 | |
991 struct symbol_block *symbol_block; | |
992 int symbol_block_index; | |
993 | |
994 struct Lisp_Symbol *symbol_free_list; | |
995 | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
996 /* Total number of symbol blocks now in use. */ |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
997 int n_symbol_blocks; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
998 |
300 | 999 void |
1000 init_symbol () | |
1001 { | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1002 symbol_block = (struct symbol_block *) lisp_malloc (sizeof (struct symbol_block)); |
300 | 1003 symbol_block->next = 0; |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
1004 bzero ((char *) symbol_block->symbols, sizeof symbol_block->symbols); |
300 | 1005 symbol_block_index = 0; |
1006 symbol_free_list = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1007 n_symbol_blocks = 1; |
300 | 1008 } |
1009 | |
1010 DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, | |
1011 "Return a newly allocated uninterned symbol whose name is NAME.\n\ | |
1012 Its value and function definition are void, and its property list is nil.") | |
14093
338f645e6b9a
(Fmake_symbol): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
1013 (name) |
338f645e6b9a
(Fmake_symbol): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
1014 Lisp_Object name; |
300 | 1015 { |
1016 register Lisp_Object val; | |
1017 register struct Lisp_Symbol *p; | |
1018 | |
14093
338f645e6b9a
(Fmake_symbol): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
1019 CHECK_STRING (name, 0); |
300 | 1020 |
1021 if (symbol_free_list) | |
1022 { | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1023 XSETSYMBOL (val, symbol_free_list); |
9942
c189487b08dd
(free_float): Don't assume XFASTINT accesses the raw bits.
Karl Heuer <kwzh@gnu.org>
parents:
9926
diff
changeset
|
1024 symbol_free_list = *(struct Lisp_Symbol **)&symbol_free_list->value; |
300 | 1025 } |
1026 else | |
1027 { | |
1028 if (symbol_block_index == SYMBOL_BLOCK_SIZE) | |
1029 { | |
12529 | 1030 struct symbol_block *new; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1031 new = (struct symbol_block *) lisp_malloc (sizeof (struct symbol_block)); |
300 | 1032 VALIDATE_LISP_STORAGE (new, sizeof *new); |
1033 new->next = symbol_block; | |
1034 symbol_block = new; | |
1035 symbol_block_index = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1036 n_symbol_blocks++; |
300 | 1037 } |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1038 XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]); |
300 | 1039 } |
1040 p = XSYMBOL (val); | |
14095
d612434249db
(Fmake_symbol): Harmonize arguments with documentation (correctly).
Erik Naggum <erik@naggum.no>
parents:
14093
diff
changeset
|
1041 p->name = XSTRING (name); |
16223
bab3f12493b6
(Fmake_symbol): Initialize `obarray' field.
Erik Naggum <erik@naggum.no>
parents:
16101
diff
changeset
|
1042 p->obarray = Qnil; |
300 | 1043 p->plist = Qnil; |
1044 p->value = Qunbound; | |
1045 p->function = Qunbound; | |
1046 p->next = 0; | |
1047 consing_since_gc += sizeof (struct Lisp_Symbol); | |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
1048 symbols_consed++; |
300 | 1049 return val; |
1050 } | |
1051 | |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1052 /* Allocation of markers and other objects that share that structure. |
300 | 1053 Works like allocation of conses. */ |
1054 | |
1055 #define MARKER_BLOCK_SIZE \ | |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1056 ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc)) |
300 | 1057 |
1058 struct marker_block | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1059 { |
300 | 1060 struct marker_block *next; |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1061 union Lisp_Misc markers[MARKER_BLOCK_SIZE]; |
300 | 1062 }; |
1063 | |
1064 struct marker_block *marker_block; | |
1065 int marker_block_index; | |
1066 | |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1067 union Lisp_Misc *marker_free_list; |
300 | 1068 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1069 /* Total number of marker blocks now in use. */ |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1070 int n_marker_blocks; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1071 |
300 | 1072 void |
1073 init_marker () | |
1074 { | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1075 marker_block = (struct marker_block *) lisp_malloc (sizeof (struct marker_block)); |
300 | 1076 marker_block->next = 0; |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
1077 bzero ((char *) marker_block->markers, sizeof marker_block->markers); |
300 | 1078 marker_block_index = 0; |
1079 marker_free_list = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1080 n_marker_blocks = 1; |
300 | 1081 } |
1082 | |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1083 /* Return a newly allocated Lisp_Misc object, with no substructure. */ |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1084 Lisp_Object |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1085 allocate_misc () |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1086 { |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1087 Lisp_Object val; |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1088 |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1089 if (marker_free_list) |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1090 { |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1091 XSETMISC (val, marker_free_list); |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1092 marker_free_list = marker_free_list->u_free.chain; |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1093 } |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1094 else |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1095 { |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1096 if (marker_block_index == MARKER_BLOCK_SIZE) |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1097 { |
12529 | 1098 struct marker_block *new; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1099 new = (struct marker_block *) lisp_malloc (sizeof (struct marker_block)); |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1100 VALIDATE_LISP_STORAGE (new, sizeof *new); |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1101 new->next = marker_block; |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1102 marker_block = new; |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1103 marker_block_index = 0; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1104 n_marker_blocks++; |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1105 } |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1106 XSETMISC (val, &marker_block->markers[marker_block_index++]); |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1107 } |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1108 consing_since_gc += sizeof (union Lisp_Misc); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
1109 misc_objects_consed++; |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1110 return val; |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1111 } |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1112 |
300 | 1113 DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, |
1114 "Return a newly allocated marker which does not point at any place.") | |
1115 () | |
1116 { | |
1117 register Lisp_Object val; | |
1118 register struct Lisp_Marker *p; | |
638 | 1119 |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
1120 val = allocate_misc (); |
11243
054ecfce1820
(Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11048
diff
changeset
|
1121 XMISCTYPE (val) = Lisp_Misc_Marker; |
300 | 1122 p = XMARKER (val); |
1123 p->buffer = 0; | |
20565
aa9b7c5f0f62
(Fmake_marker): Initialize marker's bytepos and charpos.
Richard M. Stallman <rms@gnu.org>
parents:
20495
diff
changeset
|
1124 p->bytepos = 0; |
aa9b7c5f0f62
(Fmake_marker): Initialize marker's bytepos and charpos.
Richard M. Stallman <rms@gnu.org>
parents:
20495
diff
changeset
|
1125 p->charpos = 0; |
300 | 1126 p->chain = Qnil; |
13008
f042ef632b22
(Fmake_marker): Initialize insertion_type to 0.
Richard M. Stallman <rms@gnu.org>
parents:
12748
diff
changeset
|
1127 p->insertion_type = 0; |
300 | 1128 return val; |
1129 } | |
19332
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
1130 |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
1131 /* Put MARKER back on the free list after using it temporarily. */ |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
1132 |
20375
1dd0bd0749b5
(malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents:
20057
diff
changeset
|
1133 void |
19332
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
1134 free_marker (marker) |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
1135 Lisp_Object marker; |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
1136 { |
19621
74151390752c
(free_marker): Call unchain_marker.
Richard M. Stallman <rms@gnu.org>
parents:
19332
diff
changeset
|
1137 unchain_marker (marker); |
74151390752c
(free_marker): Call unchain_marker.
Richard M. Stallman <rms@gnu.org>
parents:
19332
diff
changeset
|
1138 |
19332
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
1139 XMISC (marker)->u_marker.type = Lisp_Misc_Free; |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
1140 XMISC (marker)->u_free.chain = marker_free_list; |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
1141 marker_free_list = XMISC (marker); |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
1142 |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
1143 total_free_markers++; |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
1144 } |
300 | 1145 |
1146 /* Allocation of strings */ | |
1147 | |
1148 /* Strings reside inside of string_blocks. The entire data of the string, | |
1149 both the size and the contents, live in part of the `chars' component of a string_block. | |
1150 The `pos' component is the index within `chars' of the first free byte. | |
1151 | |
1152 first_string_block points to the first string_block ever allocated. | |
1153 Each block points to the next one with its `next' field. | |
1154 The `prev' fields chain in reverse order. | |
1155 The last one allocated is the one currently being filled. | |
1156 current_string_block points to it. | |
1157 | |
1158 The string_blocks that hold individual large strings | |
1159 go in a separate chain, started by large_string_blocks. */ | |
1160 | |
1161 | |
1162 /* String blocks contain this many useful bytes. | |
1163 8188 is power of 2, minus 4 for malloc overhead. */ | |
1164 #define STRING_BLOCK_SIZE (8188 - sizeof (struct string_block_head)) | |
1165 | |
1166 /* A string bigger than this gets its own specially-made string block | |
1167 if it doesn't fit in the current one. */ | |
1168 #define STRING_BLOCK_OUTSIZE 1024 | |
1169 | |
1170 struct string_block_head | |
1171 { | |
1172 struct string_block *next, *prev; | |
14764
26224976a917
(struct string_block_head): Change to match string_block.
Karl Heuer <kwzh@gnu.org>
parents:
14216
diff
changeset
|
1173 EMACS_INT pos; |
300 | 1174 }; |
1175 | |
1176 struct string_block | |
1177 { | |
1178 struct string_block *next, *prev; | |
8817
48ff00bebef6
(pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
1179 EMACS_INT pos; |
300 | 1180 char chars[STRING_BLOCK_SIZE]; |
1181 }; | |
1182 | |
1183 /* This points to the string block we are now allocating strings. */ | |
1184 | |
1185 struct string_block *current_string_block; | |
1186 | |
1187 /* This points to the oldest string block, the one that starts the chain. */ | |
1188 | |
1189 struct string_block *first_string_block; | |
1190 | |
1191 /* Last string block in chain of those made for individual large strings. */ | |
1192 | |
1193 struct string_block *large_string_blocks; | |
1194 | |
1195 /* If SIZE is the length of a string, this returns how many bytes | |
1196 the string occupies in a string_block (including padding). */ | |
1197 | |
20659 | 1198 #define STRING_FULLSIZE(size) (((size) + 1 + STRING_BASE_SIZE + STRING_PAD - 1) \ |
1199 & ~(STRING_PAD - 1)) | |
1200 /* Add 1 for the null terminator, | |
1201 and add STRING_PAD - 1 as part of rounding up. */ | |
1202 | |
1203 #define STRING_PAD (sizeof (EMACS_INT)) | |
1204 /* Size of the stuff in the string not including its data. */ | |
1205 #define STRING_BASE_SIZE (((sizeof (struct Lisp_String) - 1) / STRING_PAD) * STRING_PAD) | |
300 | 1206 |
1207 #if 0 | |
1208 #define STRING_FULLSIZE(SIZE) \ | |
8817
48ff00bebef6
(pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
1209 (((SIZE) + 2 * sizeof (EMACS_INT)) & ~(sizeof (EMACS_INT) - 1)) |
300 | 1210 #endif |
1211 | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1212 /* Total number of string blocks now in use. */ |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1213 int n_string_blocks; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1214 |
300 | 1215 void |
1216 init_strings () | |
1217 { | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1218 current_string_block = (struct string_block *) lisp_malloc (sizeof (struct string_block)); |
300 | 1219 first_string_block = current_string_block; |
1220 consing_since_gc += sizeof (struct string_block); | |
1221 current_string_block->next = 0; | |
1222 current_string_block->prev = 0; | |
1223 current_string_block->pos = 0; | |
1224 large_string_blocks = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1225 n_string_blocks = 1; |
300 | 1226 } |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1227 |
300 | 1228 DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, |
1229 "Return a newly created string of length LENGTH, with each element being INIT.\n\ | |
1230 Both LENGTH and INIT must be numbers.") | |
1231 (length, init) | |
1232 Lisp_Object length, init; | |
1233 { | |
1234 register Lisp_Object val; | |
21084
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1235 register unsigned char *p, *end; |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1236 int c, nbytes; |
300 | 1237 |
9953
e0672d4cf470
(Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents:
9942
diff
changeset
|
1238 CHECK_NATNUM (length, 0); |
300 | 1239 CHECK_NUMBER (init, 1); |
21084
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1240 |
300 | 1241 c = XINT (init); |
21084
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1242 if (SINGLE_BYTE_CHAR_P (c)) |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1243 { |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1244 nbytes = XINT (length); |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1245 val = make_uninit_string (nbytes); |
21084
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1246 p = XSTRING (val)->data; |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1247 end = p + XSTRING (val)->size; |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1248 while (p != end) |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1249 *p++ = c; |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1250 } |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1251 else |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1252 { |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1253 unsigned char work[4], *str; |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1254 int len = CHAR_STRING (c, work, str); |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1255 |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1256 nbytes = len * XINT (length); |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1257 val = make_uninit_multibyte_string (XINT (length), nbytes); |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1258 p = XSTRING (val)->data; |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1259 end = p + nbytes; |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1260 while (p != end) |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1261 { |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1262 bcopy (str, p, len); |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1263 p += len; |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1264 } |
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
1265 } |
300 | 1266 *p = 0; |
1267 return val; | |
1268 } | |
1269 | |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1270 DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, |
18010
7a38a8767242
(Fmake_bool_vector): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
17831
diff
changeset
|
1271 "Return a new bool-vector of length LENGTH, using INIT for as each element.\n\ |
7a38a8767242
(Fmake_bool_vector): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
17831
diff
changeset
|
1272 LENGTH must be a number. INIT matters only in whether it is t or nil.") |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1273 (length, init) |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1274 Lisp_Object length, init; |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1275 { |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1276 register Lisp_Object val; |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1277 struct Lisp_Bool_Vector *p; |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1278 int real_init, i; |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1279 int length_in_chars, length_in_elts, bits_per_value; |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1280 |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1281 CHECK_NATNUM (length, 0); |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1282 |
13363
941c37982f37
(BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
Karl Heuer <kwzh@gnu.org>
parents:
13322
diff
changeset
|
1283 bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR; |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1284 |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1285 length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value; |
21948
d366b3e31fae
(Fmake_bool_vector): Clear out extraneous bits at end.
Richard M. Stallman <rms@gnu.org>
parents:
21680
diff
changeset
|
1286 length_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1) / BITS_PER_CHAR); |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1287 |
17021
35f01092d865
(Fmake_char_table): Typo in doc-string fixed. Handle
Karl Heuer <kwzh@gnu.org>
parents:
16538
diff
changeset
|
1288 /* We must allocate one more elements than LENGTH_IN_ELTS for the |
35f01092d865
(Fmake_char_table): Typo in doc-string fixed. Handle
Karl Heuer <kwzh@gnu.org>
parents:
16538
diff
changeset
|
1289 slot `size' of the struct Lisp_Bool_Vector. */ |
35f01092d865
(Fmake_char_table): Typo in doc-string fixed. Handle
Karl Heuer <kwzh@gnu.org>
parents:
16538
diff
changeset
|
1290 val = Fmake_vector (make_number (length_in_elts + 1), Qnil); |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1291 p = XBOOL_VECTOR (val); |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1292 /* Get rid of any bits that would cause confusion. */ |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1293 p->vector_size = 0; |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1294 XSETBOOL_VECTOR (val, p); |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1295 p->size = XFASTINT (length); |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1296 |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1297 real_init = (NILP (init) ? 0 : -1); |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1298 for (i = 0; i < length_in_chars ; i++) |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1299 p->data[i] = real_init; |
21948
d366b3e31fae
(Fmake_bool_vector): Clear out extraneous bits at end.
Richard M. Stallman <rms@gnu.org>
parents:
21680
diff
changeset
|
1300 /* Clear the extraneous bits in the last byte. */ |
d366b3e31fae
(Fmake_bool_vector): Clear out extraneous bits at end.
Richard M. Stallman <rms@gnu.org>
parents:
21680
diff
changeset
|
1301 if (XINT (length) != length_in_chars * BITS_PER_CHAR) |
d366b3e31fae
(Fmake_bool_vector): Clear out extraneous bits at end.
Richard M. Stallman <rms@gnu.org>
parents:
21680
diff
changeset
|
1302 XBOOL_VECTOR (val)->data[length_in_chars - 1] |
d366b3e31fae
(Fmake_bool_vector): Clear out extraneous bits at end.
Richard M. Stallman <rms@gnu.org>
parents:
21680
diff
changeset
|
1303 &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1; |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1304 |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1305 return val; |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
1306 } |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1307 |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1308 /* Make a string from NBYTES bytes at CONTENTS, |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1309 and compute the number of characters from the contents. |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1310 This string may be unibyte or multibyte, depending on the contents. */ |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1311 |
300 | 1312 Lisp_Object |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1313 make_string (contents, nbytes) |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1314 char *contents; |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1315 int nbytes; |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1316 { |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1317 register Lisp_Object val; |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1318 int nchars = chars_in_text (contents, nbytes); |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1319 val = make_uninit_multibyte_string (nchars, nbytes); |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1320 bcopy (contents, XSTRING (val)->data, nbytes); |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1321 if (STRING_BYTES (XSTRING (val)) == XSTRING (val)->size) |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1322 SET_STRING_BYTES (XSTRING (val), -1); |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1323 return val; |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1324 } |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1325 |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1326 /* Make a unibyte string from LENGTH bytes at CONTENTS. */ |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1327 |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1328 Lisp_Object |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1329 make_unibyte_string (contents, length) |
300 | 1330 char *contents; |
1331 int length; | |
1332 { | |
1333 register Lisp_Object val; | |
1334 val = make_uninit_string (length); | |
1335 bcopy (contents, XSTRING (val)->data, length); | |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1336 SET_STRING_BYTES (XSTRING (val), -1); |
300 | 1337 return val; |
1338 } | |
1339 | |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1340 /* Make a multibyte string from NCHARS characters |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1341 occupying NBYTES bytes at CONTENTS. */ |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1342 |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1343 Lisp_Object |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1344 make_multibyte_string (contents, nchars, nbytes) |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1345 char *contents; |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1346 int nchars, nbytes; |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1347 { |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1348 register Lisp_Object val; |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1349 val = make_uninit_multibyte_string (nchars, nbytes); |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1350 bcopy (contents, XSTRING (val)->data, nbytes); |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1351 return val; |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1352 } |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1353 |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1354 /* Make a string from NCHARS characters |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1355 occupying NBYTES bytes at CONTENTS. |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1356 It is a multibyte string if NBYTES != NCHARS. */ |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1357 |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1358 Lisp_Object |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1359 make_string_from_bytes (contents, nchars, nbytes) |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1360 char *contents; |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1361 int nchars, nbytes; |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1362 { |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1363 register Lisp_Object val; |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1364 val = make_uninit_multibyte_string (nchars, nbytes); |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1365 bcopy (contents, XSTRING (val)->data, nbytes); |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1366 if (STRING_BYTES (XSTRING (val)) == XSTRING (val)->size) |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1367 SET_STRING_BYTES (XSTRING (val), -1); |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1368 return val; |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1369 } |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1370 |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1371 /* Make a multibyte string from NCHARS characters |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1372 occupying NBYTES bytes at CONTENTS. */ |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1373 |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1374 Lisp_Object |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1375 make_specified_string (contents, nchars, nbytes, multibyte) |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1376 char *contents; |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1377 int nchars, nbytes; |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1378 int multibyte; |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1379 { |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1380 register Lisp_Object val; |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1381 val = make_uninit_multibyte_string (nchars, nbytes); |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1382 bcopy (contents, XSTRING (val)->data, nbytes); |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1383 if (!multibyte) |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1384 SET_STRING_BYTES (XSTRING (val), -1); |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1385 return val; |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1386 } |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1387 |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1388 /* Make a string from the data at STR, |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1389 treating it as multibyte if the data warrants. */ |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1390 |
300 | 1391 Lisp_Object |
1392 build_string (str) | |
1393 char *str; | |
1394 { | |
1395 return make_string (str, strlen (str)); | |
1396 } | |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1397 |
300 | 1398 Lisp_Object |
1399 make_uninit_string (length) | |
1400 int length; | |
1401 { | |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1402 Lisp_Object val; |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1403 val = make_uninit_multibyte_string (length, length); |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1404 SET_STRING_BYTES (XSTRING (val), -1); |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1405 return val; |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1406 } |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1407 |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1408 Lisp_Object |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1409 make_uninit_multibyte_string (length, length_byte) |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1410 int length, length_byte; |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1411 { |
300 | 1412 register Lisp_Object val; |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1413 register int fullsize = STRING_FULLSIZE (length_byte); |
300 | 1414 |
1415 if (length < 0) abort (); | |
1416 | |
1417 if (fullsize <= STRING_BLOCK_SIZE - current_string_block->pos) | |
1418 /* This string can fit in the current string block */ | |
1419 { | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1420 XSETSTRING (val, |
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1421 ((struct Lisp_String *) |
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1422 (current_string_block->chars + current_string_block->pos))); |
300 | 1423 current_string_block->pos += fullsize; |
1424 } | |
1425 else if (fullsize > STRING_BLOCK_OUTSIZE) | |
1426 /* This string gets its own string block */ | |
1427 { | |
12529 | 1428 register struct string_block *new; |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
1429 #ifdef DOUG_LEA_MALLOC |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
1430 /* Prevent mmap'ing the chunk (which is potentially very large). */ |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
1431 mallopt (M_MMAP_MAX, 0); |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
1432 #endif |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1433 new = (struct string_block *) lisp_malloc (sizeof (struct string_block_head) + fullsize); |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
1434 #ifdef DOUG_LEA_MALLOC |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
1435 /* Back to a reasonable maximum of mmap'ed areas. */ |
23973
2eb9e2f5aa33
(MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
23958
diff
changeset
|
1436 mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
1437 #endif |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1438 n_string_blocks++; |
300 | 1439 VALIDATE_LISP_STORAGE (new, 0); |
1440 consing_since_gc += sizeof (struct string_block_head) + fullsize; | |
1441 new->pos = fullsize; | |
1442 new->next = large_string_blocks; | |
1443 large_string_blocks = new; | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1444 XSETSTRING (val, |
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1445 ((struct Lisp_String *) |
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1446 ((struct string_block_head *)new + 1))); |
300 | 1447 } |
1448 else | |
1449 /* Make a new current string block and start it off with this string */ | |
1450 { | |
12529 | 1451 register struct string_block *new; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1452 new = (struct string_block *) lisp_malloc (sizeof (struct string_block)); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1453 n_string_blocks++; |
300 | 1454 VALIDATE_LISP_STORAGE (new, sizeof *new); |
1455 consing_since_gc += sizeof (struct string_block); | |
1456 current_string_block->next = new; | |
1457 new->prev = current_string_block; | |
1458 new->next = 0; | |
1459 current_string_block = new; | |
1460 new->pos = fullsize; | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1461 XSETSTRING (val, |
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1462 (struct Lisp_String *) current_string_block->chars); |
300 | 1463 } |
1464 | |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
1465 string_chars_consed += fullsize; |
300 | 1466 XSTRING (val)->size = length; |
21244
50929073a0ba
Use STRING_BYTES and SET_STRING_BYTES.
Richard M. Stallman <rms@gnu.org>
parents:
21143
diff
changeset
|
1467 SET_STRING_BYTES (XSTRING (val), length_byte); |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1468 XSTRING (val)->data[length_byte] = 0; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
1469 INITIALIZE_INTERVAL (XSTRING (val), NULL_INTERVAL); |
300 | 1470 |
1471 return val; | |
1472 } | |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1473 |
300 | 1474 /* Return a newly created vector or string with specified arguments as |
2013
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
1475 elements. If all the arguments are characters that can fit |
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
1476 in a string of events, make a string; otherwise, make a vector. |
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
1477 |
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
1478 Any number of arguments, even zero arguments, are allowed. */ |
300 | 1479 |
1480 Lisp_Object | |
2013
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
1481 make_event_array (nargs, args) |
300 | 1482 register int nargs; |
1483 Lisp_Object *args; | |
1484 { | |
1485 int i; | |
1486 | |
1487 for (i = 0; i < nargs; i++) | |
2013
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
1488 /* The things that fit in a string |
3536
58d5ee6ec253
(make_event_array): Ignore bits above CHAR_META.
Richard M. Stallman <rms@gnu.org>
parents:
3181
diff
changeset
|
1489 are characters that are in 0...127, |
58d5ee6ec253
(make_event_array): Ignore bits above CHAR_META.
Richard M. Stallman <rms@gnu.org>
parents:
3181
diff
changeset
|
1490 after discarding the meta bit and all the bits above it. */ |
9144
0e29f6a4fe7c
(Fmake_list, Fmake_vector, Fmake_string, make_event_array): Use type test
Karl Heuer <kwzh@gnu.org>
parents:
8940
diff
changeset
|
1491 if (!INTEGERP (args[i]) |
3536
58d5ee6ec253
(make_event_array): Ignore bits above CHAR_META.
Richard M. Stallman <rms@gnu.org>
parents:
3181
diff
changeset
|
1492 || (XUINT (args[i]) & ~(-CHAR_META)) >= 0200) |
300 | 1493 return Fvector (nargs, args); |
1494 | |
1495 /* Since the loop exited, we know that all the things in it are | |
1496 characters, so we can make a string. */ | |
1497 { | |
6492
8372dce85f8a
(make_event_array): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
parents:
6227
diff
changeset
|
1498 Lisp_Object result; |
300 | 1499 |
18104
b2a669ef69b1
(Fmake_byte_code): Set val from p, not from val.
Richard M. Stallman <rms@gnu.org>
parents:
18010
diff
changeset
|
1500 result = Fmake_string (make_number (nargs), make_number (0)); |
300 | 1501 for (i = 0; i < nargs; i++) |
2013
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
1502 { |
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
1503 XSTRING (result)->data[i] = XINT (args[i]); |
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
1504 /* Move the meta bit to the right place for a string char. */ |
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
1505 if (XINT (args[i]) & CHAR_META) |
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
1506 XSTRING (result)->data[i] |= 0x80; |
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
1507 } |
300 | 1508 |
1509 return result; | |
1510 } | |
1511 } | |
1512 | |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
1513 /* Pure storage management. */ |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
1514 |
300 | 1515 /* Must get an error if pure storage is full, |
1516 since if it cannot hold a large string | |
1517 it may be able to hold conses that point to that string; | |
1518 then the string is not protected from gc. */ | |
1519 | |
1520 Lisp_Object | |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1521 make_pure_string (data, length, length_byte, multibyte) |
300 | 1522 char *data; |
1523 int length; | |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1524 int length_byte; |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1525 int multibyte; |
300 | 1526 { |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1527 |
300 | 1528 register Lisp_Object new; |
20659 | 1529 register int size = STRING_FULLSIZE (length_byte); |
300 | 1530 |
1531 if (pureptr + size > PURESIZE) | |
1532 error ("Pure Lisp storage exhausted"); | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1533 XSETSTRING (new, PUREBEG + pureptr); |
300 | 1534 XSTRING (new)->size = length; |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1535 SET_STRING_BYTES (XSTRING (new), (multibyte ? length_byte : -1)); |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1536 bcopy (data, XSTRING (new)->data, length_byte); |
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1537 XSTRING (new)->data[length_byte] = 0; |
4956
0f94e1e7d273
(make_pure_string): If we USE_TEXT_PROPERTIES, set the
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1538 |
0f94e1e7d273
(make_pure_string): If we USE_TEXT_PROPERTIES, set the
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1539 /* We must give strings in pure storage some kind of interval. So we |
0f94e1e7d273
(make_pure_string): If we USE_TEXT_PROPERTIES, set the
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1540 give them a null one. */ |
0f94e1e7d273
(make_pure_string): If we USE_TEXT_PROPERTIES, set the
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1541 #if defined (USE_TEXT_PROPERTIES) |
0f94e1e7d273
(make_pure_string): If we USE_TEXT_PROPERTIES, set the
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1542 XSTRING (new)->intervals = NULL_INTERVAL; |
0f94e1e7d273
(make_pure_string): If we USE_TEXT_PROPERTIES, set the
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
1543 #endif |
20659 | 1544 pureptr += size; |
300 | 1545 return new; |
1546 } | |
1547 | |
1548 Lisp_Object | |
1549 pure_cons (car, cdr) | |
1550 Lisp_Object car, cdr; | |
1551 { | |
1552 register Lisp_Object new; | |
1553 | |
1554 if (pureptr + sizeof (struct Lisp_Cons) > PURESIZE) | |
1555 error ("Pure Lisp storage exhausted"); | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1556 XSETCONS (new, PUREBEG + pureptr); |
300 | 1557 pureptr += sizeof (struct Lisp_Cons); |
1558 XCONS (new)->car = Fpurecopy (car); | |
1559 XCONS (new)->cdr = Fpurecopy (cdr); | |
1560 return new; | |
1561 } | |
1562 | |
1563 #ifdef LISP_FLOAT_TYPE | |
1564 | |
1565 Lisp_Object | |
1566 make_pure_float (num) | |
1567 double num; | |
1568 { | |
1569 register Lisp_Object new; | |
1570 | |
1939
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1571 /* Make sure that PUREBEG + pureptr is aligned on at least a sizeof |
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1572 (double) boundary. Some architectures (like the sparc) require |
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1573 this, and I suspect that floats are rare enough that it's no |
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1574 tragedy for those that do. */ |
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1575 { |
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1576 int alignment; |
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1577 char *p = PUREBEG + pureptr; |
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1578 |
1936
82bbf90208d4
* alloc.c (make_pure_float): Align pureptr according to __alignof,
Jim Blandy <jimb@redhat.com>
parents:
1908
diff
changeset
|
1579 #ifdef __GNUC__ |
82bbf90208d4
* alloc.c (make_pure_float): Align pureptr according to __alignof,
Jim Blandy <jimb@redhat.com>
parents:
1908
diff
changeset
|
1580 #if __GNUC__ >= 2 |
1939
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1581 alignment = __alignof (struct Lisp_Float); |
1936
82bbf90208d4
* alloc.c (make_pure_float): Align pureptr according to __alignof,
Jim Blandy <jimb@redhat.com>
parents:
1908
diff
changeset
|
1582 #else |
1939
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1583 alignment = sizeof (struct Lisp_Float); |
1936
82bbf90208d4
* alloc.c (make_pure_float): Align pureptr according to __alignof,
Jim Blandy <jimb@redhat.com>
parents:
1908
diff
changeset
|
1584 #endif |
82bbf90208d4
* alloc.c (make_pure_float): Align pureptr according to __alignof,
Jim Blandy <jimb@redhat.com>
parents:
1908
diff
changeset
|
1585 #else |
1939
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1586 alignment = sizeof (struct Lisp_Float); |
1936
82bbf90208d4
* alloc.c (make_pure_float): Align pureptr according to __alignof,
Jim Blandy <jimb@redhat.com>
parents:
1908
diff
changeset
|
1587 #endif |
1939
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1588 p = (char *) (((unsigned long) p + alignment - 1) & - alignment); |
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1589 pureptr = p - PUREBEG; |
def7b9c64935
* alloc.c (make_pure_float): Assure that PUREBEG + pureptr is
Jim Blandy <jimb@redhat.com>
parents:
1936
diff
changeset
|
1590 } |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
1591 |
300 | 1592 if (pureptr + sizeof (struct Lisp_Float) > PURESIZE) |
1593 error ("Pure Lisp storage exhausted"); | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1594 XSETFLOAT (new, PUREBEG + pureptr); |
300 | 1595 pureptr += sizeof (struct Lisp_Float); |
1596 XFLOAT (new)->data = num; | |
9295
17d393a8eed6
(free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents:
9261
diff
changeset
|
1597 XSETFASTINT (XFLOAT (new)->type, 0); /* bug chasing -wsr */ |
300 | 1598 return new; |
1599 } | |
1600 | |
1601 #endif /* LISP_FLOAT_TYPE */ | |
1602 | |
1603 Lisp_Object | |
1604 make_pure_vector (len) | |
8817
48ff00bebef6
(pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
1605 EMACS_INT len; |
300 | 1606 { |
1607 register Lisp_Object new; | |
8817
48ff00bebef6
(pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
1608 register EMACS_INT size = sizeof (struct Lisp_Vector) + (len - 1) * sizeof (Lisp_Object); |
300 | 1609 |
1610 if (pureptr + size > PURESIZE) | |
1611 error ("Pure Lisp storage exhausted"); | |
1612 | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1613 XSETVECTOR (new, PUREBEG + pureptr); |
300 | 1614 pureptr += size; |
1615 XVECTOR (new)->size = len; | |
1616 return new; | |
1617 } | |
1618 | |
1619 DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, | |
1620 "Make a copy of OBJECT in pure storage.\n\ | |
1621 Recursively copies contents of vectors and cons cells.\n\ | |
1622 Does not copy symbols.") | |
1623 (obj) | |
1624 register Lisp_Object obj; | |
1625 { | |
485 | 1626 if (NILP (Vpurify_flag)) |
300 | 1627 return obj; |
1628 | |
1629 if ((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE) | |
1630 && (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure) | |
1631 return obj; | |
1632 | |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1633 if (CONSP (obj)) |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1634 return pure_cons (XCONS (obj)->car, XCONS (obj)->cdr); |
300 | 1635 #ifdef LISP_FLOAT_TYPE |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1636 else if (FLOATP (obj)) |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1637 return make_pure_float (XFLOAT (obj)->data); |
300 | 1638 #endif /* LISP_FLOAT_TYPE */ |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1639 else if (STRINGP (obj)) |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
1640 return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size, |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1641 STRING_BYTES (XSTRING (obj)), |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
1642 STRING_MULTIBYTE (obj)); |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1643 else if (COMPILEDP (obj) || VECTORP (obj)) |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1644 { |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1645 register struct Lisp_Vector *vec; |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1646 register int i, size; |
300 | 1647 |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1648 size = XVECTOR (obj)->size; |
10427
5faba1b094d5
(Fpurecopy): Mask size field when copying pseudovector.
Karl Heuer <kwzh@gnu.org>
parents:
10414
diff
changeset
|
1649 if (size & PSEUDOVECTOR_FLAG) |
5faba1b094d5
(Fpurecopy): Mask size field when copying pseudovector.
Karl Heuer <kwzh@gnu.org>
parents:
10414
diff
changeset
|
1650 size &= PSEUDOVECTOR_SIZE_MASK; |
16100
ccd19852de65
(Fpurecopy): Cast arg to make_pure_vector.
Richard M. Stallman <rms@gnu.org>
parents:
16051
diff
changeset
|
1651 vec = XVECTOR (make_pure_vector ((EMACS_INT) size)); |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1652 for (i = 0; i < size; i++) |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1653 vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]); |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1654 if (COMPILEDP (obj)) |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1655 XSETCOMPILED (obj, vec); |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1656 else |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1657 XSETVECTOR (obj, vec); |
300 | 1658 return obj; |
1659 } | |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1660 else if (MARKERP (obj)) |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1661 error ("Attempt to copy a marker to pure storage"); |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1662 else |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
1663 return obj; |
300 | 1664 } |
1665 | |
1666 /* Recording what needs to be marked for gc. */ | |
1667 | |
1668 struct gcpro *gcprolist; | |
1669 | |
10855
fddf2b79ebcf
(mark_perdisplays): Update to reflect current Lisp_Objects.
Karl Heuer <kwzh@gnu.org>
parents:
10796
diff
changeset
|
1670 #define NSTATICS 768 |
300 | 1671 |
1672 Lisp_Object *staticvec[NSTATICS] = {0}; | |
1673 | |
1674 int staticidx = 0; | |
1675 | |
1676 /* Put an entry in staticvec, pointing at the variable whose address is given */ | |
1677 | |
1678 void | |
1679 staticpro (varaddress) | |
1680 Lisp_Object *varaddress; | |
1681 { | |
1682 staticvec[staticidx++] = varaddress; | |
1683 if (staticidx >= NSTATICS) | |
1684 abort (); | |
1685 } | |
1686 | |
1687 struct catchtag | |
1688 { | |
1689 Lisp_Object tag; | |
1690 Lisp_Object val; | |
1691 struct catchtag *next; | |
20391
d6605eeb5bd5
Comment fix (to avoid "unterminated comment" warning).
Karl Heuer <kwzh@gnu.org>
parents:
20375
diff
changeset
|
1692 #if 0 /* We don't need this for GC purposes */ |
d6605eeb5bd5
Comment fix (to avoid "unterminated comment" warning).
Karl Heuer <kwzh@gnu.org>
parents:
20375
diff
changeset
|
1693 jmp_buf jmp; |
d6605eeb5bd5
Comment fix (to avoid "unterminated comment" warning).
Karl Heuer <kwzh@gnu.org>
parents:
20375
diff
changeset
|
1694 #endif |
300 | 1695 }; |
1696 | |
1697 struct backtrace | |
1698 { | |
1699 struct backtrace *next; | |
1700 Lisp_Object *function; | |
1701 Lisp_Object *args; /* Points to vector of args. */ | |
1702 int nargs; /* length of vector */ | |
1703 /* if nargs is UNEVALLED, args points to slot holding list of unevalled args */ | |
1704 char evalargs; | |
1705 }; | |
1706 | |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
1707 /* Garbage collection! */ |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
1708 |
11374
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1709 /* Temporarily prevent garbage collection. */ |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1710 |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1711 int |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1712 inhibit_garbage_collection () |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1713 { |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1714 int count = specpdl_ptr - specpdl; |
11679
1ced2d67d411
(gc_cons_threshold): Make this an EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
11593
diff
changeset
|
1715 Lisp_Object number; |
13363
941c37982f37
(BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
Karl Heuer <kwzh@gnu.org>
parents:
13322
diff
changeset
|
1716 int nbits = min (VALBITS, BITS_PER_INT); |
11374
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1717 |
11727
53ccd2d608ee
(gc_cons_threshold): Change back to int.
Richard M. Stallman <rms@gnu.org>
parents:
11679
diff
changeset
|
1718 XSETINT (number, ((EMACS_INT) 1 << (nbits - 1)) - 1); |
11679
1ced2d67d411
(gc_cons_threshold): Make this an EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
11593
diff
changeset
|
1719 |
1ced2d67d411
(gc_cons_threshold): Make this an EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
11593
diff
changeset
|
1720 specbind (Qgc_cons_threshold, number); |
11374
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1721 |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1722 return count; |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1723 } |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
1724 |
300 | 1725 DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", |
1726 "Reclaim storage for Lisp objects no longer needed.\n\ | |
1727 Returns info on amount of space in use:\n\ | |
1728 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)\n\ | |
1729 (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS\n\ | |
16001
36d2c4a8e064
(Fgarbage_collect): Report used and free intervals.
Richard M. Stallman <rms@gnu.org>
parents:
15960
diff
changeset
|
1730 (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS))\n\ |
300 | 1731 Garbage collection happens automatically if you cons more than\n\ |
1732 `gc-cons-threshold' bytes of Lisp data since previous garbage collection.") | |
1733 () | |
1734 { | |
1735 register struct gcpro *tail; | |
1736 register struct specbinding *bind; | |
1737 struct catchtag *catch; | |
1738 struct handler *handler; | |
1739 register struct backtrace *backlist; | |
1740 register Lisp_Object tem; | |
1741 char *omessage = echo_area_glyphs; | |
5874
fbda87c8ad54
(Fgarbage_collect): Save echo_area_glyphs_length.
Karl Heuer <kwzh@gnu.org>
parents:
5868
diff
changeset
|
1742 int omessage_length = echo_area_glyphs_length; |
20495 | 1743 int oldmultibyte = message_enable_multibyte; |
300 | 1744 char stack_top_variable; |
1745 register int i; | |
1746 | |
11892
6be0b7a0ac44
(Fgarbage_collect): Clear consing_since_gc first thing.
Karl Heuer <kwzh@gnu.org>
parents:
11727
diff
changeset
|
1747 /* In case user calls debug_print during GC, |
6be0b7a0ac44
(Fgarbage_collect): Clear consing_since_gc first thing.
Karl Heuer <kwzh@gnu.org>
parents:
11727
diff
changeset
|
1748 don't let that cause a recursive GC. */ |
6be0b7a0ac44
(Fgarbage_collect): Clear consing_since_gc first thing.
Karl Heuer <kwzh@gnu.org>
parents:
11727
diff
changeset
|
1749 consing_since_gc = 0; |
6be0b7a0ac44
(Fgarbage_collect): Clear consing_since_gc first thing.
Karl Heuer <kwzh@gnu.org>
parents:
11727
diff
changeset
|
1750 |
300 | 1751 /* Save a copy of the contents of the stack, for debugging. */ |
1752 #if MAX_SAVE_STACK > 0 | |
485 | 1753 if (NILP (Vpurify_flag)) |
300 | 1754 { |
1755 i = &stack_top_variable - stack_bottom; | |
1756 if (i < 0) i = -i; | |
1757 if (i < MAX_SAVE_STACK) | |
1758 { | |
1759 if (stack_copy == 0) | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
1760 stack_copy = (char *) xmalloc (stack_copy_size = i); |
300 | 1761 else if (stack_copy_size < i) |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
1762 stack_copy = (char *) xrealloc (stack_copy, (stack_copy_size = i)); |
300 | 1763 if (stack_copy) |
1764 { | |
8817
48ff00bebef6
(pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
1765 if ((EMACS_INT) (&stack_top_variable - stack_bottom) > 0) |
300 | 1766 bcopy (stack_bottom, stack_copy, i); |
1767 else | |
1768 bcopy (&stack_top_variable, stack_copy, i); | |
1769 } | |
1770 } | |
1771 } | |
1772 #endif /* MAX_SAVE_STACK > 0 */ | |
1773 | |
14959
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
1774 if (garbage_collection_messages) |
10395
c121703d35c7
(Fgarbage_collect): Don't log the GC message.
Karl Heuer <kwzh@gnu.org>
parents:
10389
diff
changeset
|
1775 message1_nolog ("Garbage collecting..."); |
300 | 1776 |
23534
6f9c70db3a58
(Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents:
22382
diff
changeset
|
1777 BLOCK_INPUT; |
6f9c70db3a58
(Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents:
22382
diff
changeset
|
1778 |
22220
a0cd311af6e3
(Fgarbage_collect): Call shrink_regexp_cache.
Richard M. Stallman <rms@gnu.org>
parents:
21948
diff
changeset
|
1779 shrink_regexp_cache (); |
a0cd311af6e3
(Fgarbage_collect): Call shrink_regexp_cache.
Richard M. Stallman <rms@gnu.org>
parents:
21948
diff
changeset
|
1780 |
21680
c744d468bfb6
(Fgarbage_collect): Don't truncate command-history here.
Richard M. Stallman <rms@gnu.org>
parents:
21514
diff
changeset
|
1781 /* Don't keep undo information around forever. */ |
300 | 1782 { |
1783 register struct buffer *nextb = all_buffers; | |
1784 | |
1785 while (nextb) | |
1786 { | |
648 | 1787 /* If a buffer's undo list is Qt, that means that undo is |
1788 turned off in that buffer. Calling truncate_undo_list on | |
1789 Qt tends to return NULL, which effectively turns undo back on. | |
1790 So don't call truncate_undo_list if undo_list is Qt. */ | |
1791 if (! EQ (nextb->undo_list, Qt)) | |
1792 nextb->undo_list | |
764 | 1793 = truncate_undo_list (nextb->undo_list, undo_limit, |
1794 undo_strong_limit); | |
300 | 1795 nextb = nextb->next; |
1796 } | |
1797 } | |
1798 | |
1799 gc_in_progress = 1; | |
1800 | |
16231 | 1801 /* clear_marks (); */ |
300 | 1802 |
1803 /* In each "large string", set the MARKBIT of the size field. | |
1804 That enables mark_object to recognize them. */ | |
1805 { | |
1806 register struct string_block *b; | |
1807 for (b = large_string_blocks; b; b = b->next) | |
1808 ((struct Lisp_String *)(&b->chars[0]))->size |= MARKBIT; | |
1809 } | |
1810 | |
1811 /* Mark all the special slots that serve as the roots of accessibility. | |
1812 | |
1813 Usually the special slots to mark are contained in particular structures. | |
1814 Then we know no slot is marked twice because the structures don't overlap. | |
1815 In some cases, the structures point to the slots to be marked. | |
1816 For these, we use MARKBIT to avoid double marking of the slot. */ | |
1817 | |
1818 for (i = 0; i < staticidx; i++) | |
1819 mark_object (staticvec[i]); | |
1820 for (tail = gcprolist; tail; tail = tail->next) | |
1821 for (i = 0; i < tail->nvars; i++) | |
1822 if (!XMARKBIT (tail->var[i])) | |
1823 { | |
1824 mark_object (&tail->var[i]); | |
1825 XMARK (tail->var[i]); | |
1826 } | |
1827 for (bind = specpdl; bind != specpdl_ptr; bind++) | |
1828 { | |
1829 mark_object (&bind->symbol); | |
1830 mark_object (&bind->old_value); | |
1831 } | |
1832 for (catch = catchlist; catch; catch = catch->next) | |
1833 { | |
1834 mark_object (&catch->tag); | |
1835 mark_object (&catch->val); | |
1836 } | |
1837 for (handler = handlerlist; handler; handler = handler->next) | |
1838 { | |
1839 mark_object (&handler->handler); | |
1840 mark_object (&handler->var); | |
1841 } | |
1842 for (backlist = backtrace_list; backlist; backlist = backlist->next) | |
1843 { | |
1844 if (!XMARKBIT (*backlist->function)) | |
1845 { | |
1846 mark_object (backlist->function); | |
1847 XMARK (*backlist->function); | |
1848 } | |
1849 if (backlist->nargs == UNEVALLED || backlist->nargs == MANY) | |
1850 i = 0; | |
1851 else | |
1852 i = backlist->nargs - 1; | |
1853 for (; i >= 0; i--) | |
1854 if (!XMARKBIT (backlist->args[i])) | |
1855 { | |
1856 mark_object (&backlist->args[i]); | |
1857 XMARK (backlist->args[i]); | |
1858 } | |
1859 } | |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
1860 mark_kboards (); |
300 | 1861 |
21306
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1862 /* Look thru every buffer's undo list |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1863 for elements that update markers that were not marked, |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1864 and delete them. */ |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1865 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1866 register struct buffer *nextb = all_buffers; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1867 |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1868 while (nextb) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1869 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1870 /* If a buffer's undo list is Qt, that means that undo is |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1871 turned off in that buffer. Calling truncate_undo_list on |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1872 Qt tends to return NULL, which effectively turns undo back on. |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1873 So don't call truncate_undo_list if undo_list is Qt. */ |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1874 if (! EQ (nextb->undo_list, Qt)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1875 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1876 Lisp_Object tail, prev; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1877 tail = nextb->undo_list; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1878 prev = Qnil; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1879 while (CONSP (tail)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1880 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1881 if (GC_CONSP (XCONS (tail)->car) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1882 && GC_MARKERP (XCONS (XCONS (tail)->car)->car) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1883 && ! XMARKBIT (XMARKER (XCONS (XCONS (tail)->car)->car)->chain)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1884 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1885 if (NILP (prev)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1886 nextb->undo_list = tail = XCONS (tail)->cdr; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1887 else |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1888 tail = XCONS (prev)->cdr = XCONS (tail)->cdr; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1889 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1890 else |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1891 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1892 prev = tail; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1893 tail = XCONS (tail)->cdr; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1894 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1895 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1896 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1897 |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1898 nextb = nextb->next; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1899 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1900 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
1901 |
300 | 1902 gc_sweep (); |
1903 | |
1904 /* Clear the mark bits that we set in certain root slots. */ | |
1905 | |
1906 for (tail = gcprolist; tail; tail = tail->next) | |
1907 for (i = 0; i < tail->nvars; i++) | |
1908 XUNMARK (tail->var[i]); | |
1909 for (backlist = backtrace_list; backlist; backlist = backlist->next) | |
1910 { | |
1911 XUNMARK (*backlist->function); | |
1912 if (backlist->nargs == UNEVALLED || backlist->nargs == MANY) | |
1913 i = 0; | |
1914 else | |
1915 i = backlist->nargs - 1; | |
1916 for (; i >= 0; i--) | |
1917 XUNMARK (backlist->args[i]); | |
1918 } | |
1919 XUNMARK (buffer_defaults.name); | |
1920 XUNMARK (buffer_local_symbols.name); | |
1921 | |
23534
6f9c70db3a58
(Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents:
22382
diff
changeset
|
1922 UNBLOCK_INPUT; |
6f9c70db3a58
(Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents:
22382
diff
changeset
|
1923 |
16231 | 1924 /* clear_marks (); */ |
300 | 1925 gc_in_progress = 0; |
1926 | |
1927 consing_since_gc = 0; | |
1928 if (gc_cons_threshold < 10000) | |
1929 gc_cons_threshold = 10000; | |
1930 | |
14959
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
1931 if (garbage_collection_messages) |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
1932 { |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
1933 if (omessage || minibuf_level > 0) |
20495 | 1934 message2_nolog (omessage, omessage_length, oldmultibyte); |
14959
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
1935 else |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
1936 message1_nolog ("Garbage collecting...done"); |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
1937 } |
300 | 1938 |
1939 return Fcons (Fcons (make_number (total_conses), | |
1940 make_number (total_free_conses)), | |
1941 Fcons (Fcons (make_number (total_symbols), | |
1942 make_number (total_free_symbols)), | |
1943 Fcons (Fcons (make_number (total_markers), | |
1944 make_number (total_free_markers)), | |
1945 Fcons (make_number (total_string_size), | |
1946 Fcons (make_number (total_vector_size), | |
16001
36d2c4a8e064
(Fgarbage_collect): Report used and free intervals.
Richard M. Stallman <rms@gnu.org>
parents:
15960
diff
changeset
|
1947 Fcons (Fcons |
300 | 1948 #ifdef LISP_FLOAT_TYPE |
16001
36d2c4a8e064
(Fgarbage_collect): Report used and free intervals.
Richard M. Stallman <rms@gnu.org>
parents:
15960
diff
changeset
|
1949 (make_number (total_floats), |
36d2c4a8e064
(Fgarbage_collect): Report used and free intervals.
Richard M. Stallman <rms@gnu.org>
parents:
15960
diff
changeset
|
1950 make_number (total_free_floats)), |
300 | 1951 #else /* not LISP_FLOAT_TYPE */ |
16001
36d2c4a8e064
(Fgarbage_collect): Report used and free intervals.
Richard M. Stallman <rms@gnu.org>
parents:
15960
diff
changeset
|
1952 (make_number (0), make_number (0)), |
300 | 1953 #endif /* not LISP_FLOAT_TYPE */ |
16001
36d2c4a8e064
(Fgarbage_collect): Report used and free intervals.
Richard M. Stallman <rms@gnu.org>
parents:
15960
diff
changeset
|
1954 Fcons (Fcons |
36d2c4a8e064
(Fgarbage_collect): Report used and free intervals.
Richard M. Stallman <rms@gnu.org>
parents:
15960
diff
changeset
|
1955 #ifdef USE_TEXT_PROPERTIES |
36d2c4a8e064
(Fgarbage_collect): Report used and free intervals.
Richard M. Stallman <rms@gnu.org>
parents:
15960
diff
changeset
|
1956 (make_number (total_intervals), |
36d2c4a8e064
(Fgarbage_collect): Report used and free intervals.
Richard M. Stallman <rms@gnu.org>
parents:
15960
diff
changeset
|
1957 make_number (total_free_intervals)), |
36d2c4a8e064
(Fgarbage_collect): Report used and free intervals.
Richard M. Stallman <rms@gnu.org>
parents:
15960
diff
changeset
|
1958 #else /* not USE_TEXT_PROPERTIES */ |
36d2c4a8e064
(Fgarbage_collect): Report used and free intervals.
Richard M. Stallman <rms@gnu.org>
parents:
15960
diff
changeset
|
1959 (make_number (0), make_number (0)), |
36d2c4a8e064
(Fgarbage_collect): Report used and free intervals.
Richard M. Stallman <rms@gnu.org>
parents:
15960
diff
changeset
|
1960 #endif /* not USE_TEXT_PROPERTIES */ |
36d2c4a8e064
(Fgarbage_collect): Report used and free intervals.
Richard M. Stallman <rms@gnu.org>
parents:
15960
diff
changeset
|
1961 Qnil))))))); |
300 | 1962 } |
1963 | |
1964 #if 0 | |
1965 static void | |
1966 clear_marks () | |
1967 { | |
1968 /* Clear marks on all conses */ | |
1969 { | |
1970 register struct cons_block *cblk; | |
1971 register int lim = cons_block_index; | |
1972 | |
1973 for (cblk = cons_block; cblk; cblk = cblk->next) | |
1974 { | |
1975 register int i; | |
1976 for (i = 0; i < lim; i++) | |
1977 XUNMARK (cblk->conses[i].car); | |
1978 lim = CONS_BLOCK_SIZE; | |
1979 } | |
1980 } | |
1981 /* Clear marks on all symbols */ | |
1982 { | |
1983 register struct symbol_block *sblk; | |
1984 register int lim = symbol_block_index; | |
1985 | |
1986 for (sblk = symbol_block; sblk; sblk = sblk->next) | |
1987 { | |
1988 register int i; | |
1989 for (i = 0; i < lim; i++) | |
1990 { | |
1991 XUNMARK (sblk->symbols[i].plist); | |
1992 } | |
1993 lim = SYMBOL_BLOCK_SIZE; | |
1994 } | |
1995 } | |
1996 /* Clear marks on all markers */ | |
1997 { | |
1998 register struct marker_block *sblk; | |
1999 register int lim = marker_block_index; | |
2000 | |
2001 for (sblk = marker_block; sblk; sblk = sblk->next) | |
2002 { | |
2003 register int i; | |
2004 for (i = 0; i < lim; i++) | |
11243
054ecfce1820
(Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11048
diff
changeset
|
2005 if (sblk->markers[i].u_marker.type == Lisp_Misc_Marker) |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2006 XUNMARK (sblk->markers[i].u_marker.chain); |
300 | 2007 lim = MARKER_BLOCK_SIZE; |
2008 } | |
2009 } | |
2010 /* Clear mark bits on all buffers */ | |
2011 { | |
2012 register struct buffer *nextb = all_buffers; | |
2013 | |
2014 while (nextb) | |
2015 { | |
2016 XUNMARK (nextb->name); | |
2017 nextb = nextb->next; | |
2018 } | |
2019 } | |
2020 } | |
2021 #endif | |
2022 | |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
2023 /* Mark reference to a Lisp_Object. |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
2024 If the object referred to has not been seen yet, recursively mark |
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
2025 all the references contained in it. |
300 | 2026 |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3581
diff
changeset
|
2027 If the object referenced is a short string, the referencing slot |
300 | 2028 is threaded into a chain of such slots, pointed to from |
2029 the `size' field of the string. The actual string size | |
2030 lives in the last slot in the chain. We recognize the end | |
2031 because it is < (unsigned) STRING_BLOCK_SIZE. */ | |
2032 | |
1168
2b07af77d7ec
(mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents:
1114
diff
changeset
|
2033 #define LAST_MARKED_SIZE 500 |
2b07af77d7ec
(mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents:
1114
diff
changeset
|
2034 Lisp_Object *last_marked[LAST_MARKED_SIZE]; |
2b07af77d7ec
(mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents:
1114
diff
changeset
|
2035 int last_marked_index; |
2b07af77d7ec
(mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents:
1114
diff
changeset
|
2036 |
300 | 2037 static void |
13553
fb12156faaf5
(mark_object): Don't overwrite original argument value.
Richard M. Stallman <rms@gnu.org>
parents:
13363
diff
changeset
|
2038 mark_object (argptr) |
fb12156faaf5
(mark_object): Don't overwrite original argument value.
Richard M. Stallman <rms@gnu.org>
parents:
13363
diff
changeset
|
2039 Lisp_Object *argptr; |
300 | 2040 { |
13553
fb12156faaf5
(mark_object): Don't overwrite original argument value.
Richard M. Stallman <rms@gnu.org>
parents:
13363
diff
changeset
|
2041 Lisp_Object *objptr = argptr; |
300 | 2042 register Lisp_Object obj; |
2043 | |
5868
a7bd57a60cb8
(mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents:
5353
diff
changeset
|
2044 loop: |
300 | 2045 obj = *objptr; |
5868
a7bd57a60cb8
(mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents:
5353
diff
changeset
|
2046 loop2: |
300 | 2047 XUNMARK (obj); |
2048 | |
2049 if ((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE) | |
2050 && (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure) | |
2051 return; | |
2052 | |
1168
2b07af77d7ec
(mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents:
1114
diff
changeset
|
2053 last_marked[last_marked_index++] = objptr; |
2b07af77d7ec
(mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents:
1114
diff
changeset
|
2054 if (last_marked_index == LAST_MARKED_SIZE) |
2b07af77d7ec
(mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents:
1114
diff
changeset
|
2055 last_marked_index = 0; |
2b07af77d7ec
(mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents:
1114
diff
changeset
|
2056 |
10457
2ab3bd0288a9
Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
parents:
10427
diff
changeset
|
2057 switch (SWITCH_ENUM_CAST (XGCTYPE (obj))) |
300 | 2058 { |
2059 case Lisp_String: | |
2060 { | |
2061 register struct Lisp_String *ptr = XSTRING (obj); | |
2062 | |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2063 MARK_INTERVAL_TREE (ptr->intervals); |
300 | 2064 if (ptr->size & MARKBIT) |
2065 /* A large string. Just set ARRAY_MARK_FLAG. */ | |
2066 ptr->size |= ARRAY_MARK_FLAG; | |
2067 else | |
2068 { | |
2069 /* A small string. Put this reference | |
2070 into the chain of references to it. | |
10413
bfe591f66299
(DONT_COPY_FLAG): Default this to 1.
Karl Heuer <kwzh@gnu.org>
parents:
10398
diff
changeset
|
2071 If the address includes MARKBIT, put that bit elsewhere |
300 | 2072 when we store OBJPTR into the size field. */ |
2073 | |
2074 if (XMARKBIT (*objptr)) | |
2075 { | |
9295
17d393a8eed6
(free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents:
9261
diff
changeset
|
2076 XSETFASTINT (*objptr, ptr->size); |
300 | 2077 XMARK (*objptr); |
2078 } | |
2079 else | |
9295
17d393a8eed6
(free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents:
9261
diff
changeset
|
2080 XSETFASTINT (*objptr, ptr->size); |
10389
162b3e6c4610
(DONT_COPY_FLAG): New bit flag.
Richard M. Stallman <rms@gnu.org>
parents:
10340
diff
changeset
|
2081 |
162b3e6c4610
(DONT_COPY_FLAG): New bit flag.
Richard M. Stallman <rms@gnu.org>
parents:
10340
diff
changeset
|
2082 if ((EMACS_INT) objptr & DONT_COPY_FLAG) |
162b3e6c4610
(DONT_COPY_FLAG): New bit flag.
Richard M. Stallman <rms@gnu.org>
parents:
10340
diff
changeset
|
2083 abort (); |
10413
bfe591f66299
(DONT_COPY_FLAG): Default this to 1.
Karl Heuer <kwzh@gnu.org>
parents:
10398
diff
changeset
|
2084 ptr->size = (EMACS_INT) objptr; |
bfe591f66299
(DONT_COPY_FLAG): Default this to 1.
Karl Heuer <kwzh@gnu.org>
parents:
10398
diff
changeset
|
2085 if (ptr->size & MARKBIT) |
bfe591f66299
(DONT_COPY_FLAG): Default this to 1.
Karl Heuer <kwzh@gnu.org>
parents:
10398
diff
changeset
|
2086 ptr->size ^= MARKBIT | DONT_COPY_FLAG; |
300 | 2087 } |
2088 } | |
2089 break; | |
2090 | |
10009
82f3daf76995
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
10004
diff
changeset
|
2091 case Lisp_Vectorlike: |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
2092 if (GC_BUFFERP (obj)) |
10340
ef58c7a5a4d6
(mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents:
10320
diff
changeset
|
2093 { |
ef58c7a5a4d6
(mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents:
10320
diff
changeset
|
2094 if (!XMARKBIT (XBUFFER (obj)->name)) |
ef58c7a5a4d6
(mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents:
10320
diff
changeset
|
2095 mark_buffer (obj); |
ef58c7a5a4d6
(mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents:
10320
diff
changeset
|
2096 } |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
2097 else if (GC_SUBRP (obj)) |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2098 break; |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2099 else if (GC_COMPILEDP (obj)) |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2100 /* We could treat this just like a vector, but it is better |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2101 to save the COMPILED_CONSTANTS element for last and avoid recursion |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2102 there. */ |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2103 { |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2104 register struct Lisp_Vector *ptr = XVECTOR (obj); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2105 register EMACS_INT size = ptr->size; |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2106 /* See comment above under Lisp_Vector. */ |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2107 struct Lisp_Vector *volatile ptr1 = ptr; |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2108 register int i; |
300 | 2109 |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2110 if (size & ARRAY_MARK_FLAG) |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2111 break; /* Already marked */ |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2112 ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */ |
10009
82f3daf76995
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
10004
diff
changeset
|
2113 size &= PSEUDOVECTOR_SIZE_MASK; |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2114 for (i = 0; i < size; i++) /* and then mark its elements */ |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2115 { |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2116 if (i != COMPILED_CONSTANTS) |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2117 mark_object (&ptr1->contents[i]); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2118 } |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2119 /* This cast should be unnecessary, but some Mips compiler complains |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2120 (MIPS-ABI + SysVR4, DC/OSx, etc). */ |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2121 objptr = (Lisp_Object *) &ptr1->contents[COMPILED_CONSTANTS]; |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2122 goto loop; |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2123 } |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2124 else if (GC_FRAMEP (obj)) |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2125 { |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2126 /* See comment above under Lisp_Vector for why this is volatile. */ |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2127 register struct frame *volatile ptr = XFRAME (obj); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2128 register EMACS_INT size = ptr->size; |
1295
a9241dc503ab
(mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents:
1168
diff
changeset
|
2129 |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2130 if (size & ARRAY_MARK_FLAG) break; /* Already marked */ |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2131 ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */ |
1295
a9241dc503ab
(mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents:
1168
diff
changeset
|
2132 |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2133 mark_object (&ptr->name); |
12273
377cbbd8a2ad
(mark_object): Mark icon_name field.
Richard M. Stallman <rms@gnu.org>
parents:
12175
diff
changeset
|
2134 mark_object (&ptr->icon_name); |
14216
5970a52070bb
(mark_object): Mark frame title field.
Richard M. Stallman <rms@gnu.org>
parents:
14186
diff
changeset
|
2135 mark_object (&ptr->title); |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2136 mark_object (&ptr->focus_frame); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2137 mark_object (&ptr->selected_window); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2138 mark_object (&ptr->minibuffer_window); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2139 mark_object (&ptr->param_alist); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2140 mark_object (&ptr->scroll_bars); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2141 mark_object (&ptr->condemned_scroll_bars); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2142 mark_object (&ptr->menu_bar_items); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2143 mark_object (&ptr->face_alist); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2144 mark_object (&ptr->menu_bar_vector); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2145 mark_object (&ptr->buffer_predicate); |
17217
571d0c136e48
(mark_object): Mark the buffer_list field.
Richard M. Stallman <rms@gnu.org>
parents:
17021
diff
changeset
|
2146 mark_object (&ptr->buffer_list); |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2147 } |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
2148 else if (GC_BOOL_VECTOR_P (obj)) |
15379
5cd52d4838f8
(mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents:
14959
diff
changeset
|
2149 { |
5cd52d4838f8
(mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents:
14959
diff
changeset
|
2150 register struct Lisp_Vector *ptr = XVECTOR (obj); |
5cd52d4838f8
(mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents:
14959
diff
changeset
|
2151 |
5cd52d4838f8
(mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents:
14959
diff
changeset
|
2152 if (ptr->size & ARRAY_MARK_FLAG) |
5cd52d4838f8
(mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents:
14959
diff
changeset
|
2153 break; /* Already marked */ |
5cd52d4838f8
(mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents:
14959
diff
changeset
|
2154 ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */ |
5cd52d4838f8
(mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents:
14959
diff
changeset
|
2155 } |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2156 else |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2157 { |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2158 register struct Lisp_Vector *ptr = XVECTOR (obj); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2159 register EMACS_INT size = ptr->size; |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2160 /* The reason we use ptr1 is to avoid an apparent hardware bug |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2161 that happens occasionally on the FSF's HP 300s. |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2162 The bug is that a2 gets clobbered by recursive calls to mark_object. |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2163 The clobberage seems to happen during function entry, |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2164 perhaps in the moveml instruction. |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2165 Yes, this is a crock, but we have to do it. */ |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2166 struct Lisp_Vector *volatile ptr1 = ptr; |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2167 register int i; |
300 | 2168 |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2169 if (size & ARRAY_MARK_FLAG) break; /* Already marked */ |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2170 ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */ |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2171 if (size & PSEUDOVECTOR_FLAG) |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2172 size &= PSEUDOVECTOR_SIZE_MASK; |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2173 for (i = 0; i < size; i++) /* and then mark its elements */ |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2174 mark_object (&ptr1->contents[i]); |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
2175 } |
300 | 2176 break; |
2177 | |
2178 case Lisp_Symbol: | |
2179 { | |
4494
15b073a6c860
(mark_object): Declare ptr volatile, or don't use it
Richard M. Stallman <rms@gnu.org>
parents:
4212
diff
changeset
|
2180 /* See comment above under Lisp_Vector for why this is volatile. */ |
15b073a6c860
(mark_object): Declare ptr volatile, or don't use it
Richard M. Stallman <rms@gnu.org>
parents:
4212
diff
changeset
|
2181 register struct Lisp_Symbol *volatile ptr = XSYMBOL (obj); |
300 | 2182 struct Lisp_Symbol *ptrx; |
2183 | |
2184 if (XMARKBIT (ptr->plist)) break; | |
2185 XMARK (ptr->plist); | |
2186 mark_object ((Lisp_Object *) &ptr->value); | |
2187 mark_object (&ptr->function); | |
2188 mark_object (&ptr->plist); | |
1114
903883eed4de
* alloc.c (mark_object): mark a symbol's name after marking its
Jim Blandy <jimb@redhat.com>
parents:
1000
diff
changeset
|
2189 XSETTYPE (*(Lisp_Object *) &ptr->name, Lisp_String); |
903883eed4de
* alloc.c (mark_object): mark a symbol's name after marking its
Jim Blandy <jimb@redhat.com>
parents:
1000
diff
changeset
|
2190 mark_object (&ptr->name); |
20768 | 2191 /* Note that we do not mark the obarray of the symbol. |
2192 It is safe not to do so because nothing accesses that | |
2193 slot except to check whether it is nil. */ | |
300 | 2194 ptr = ptr->next; |
2195 if (ptr) | |
2196 { | |
5868
a7bd57a60cb8
(mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents:
5353
diff
changeset
|
2197 /* For the benefit of the last_marked log. */ |
a7bd57a60cb8
(mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents:
5353
diff
changeset
|
2198 objptr = (Lisp_Object *)&XSYMBOL (obj)->next; |
2507
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
2199 ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */ |
300 | 2200 XSETSYMBOL (obj, ptrx); |
5868
a7bd57a60cb8
(mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents:
5353
diff
changeset
|
2201 /* We can't goto loop here because *objptr doesn't contain an |
a7bd57a60cb8
(mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents:
5353
diff
changeset
|
2202 actual Lisp_Object with valid datatype field. */ |
a7bd57a60cb8
(mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents:
5353
diff
changeset
|
2203 goto loop2; |
300 | 2204 } |
2205 } | |
2206 break; | |
2207 | |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2208 case Lisp_Misc: |
11243
054ecfce1820
(Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11048
diff
changeset
|
2209 switch (XMISCTYPE (obj)) |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2210 { |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2211 case Lisp_Misc_Marker: |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2212 XMARK (XMARKER (obj)->chain); |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2213 /* DO NOT mark thru the marker's chain. |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2214 The buffer's markers chain does not preserve markers from gc; |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2215 instead, markers are removed from the chain when freed by gc. */ |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2216 break; |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2217 |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2218 case Lisp_Misc_Buffer_Local_Value: |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2219 case Lisp_Misc_Some_Buffer_Local_Value: |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2220 { |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2221 register struct Lisp_Buffer_Local_Value *ptr |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2222 = XBUFFER_LOCAL_VALUE (obj); |
21143
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
2223 if (XMARKBIT (ptr->realvalue)) break; |
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
2224 XMARK (ptr->realvalue); |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2225 /* If the cdr is nil, avoid recursion for the car. */ |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2226 if (EQ (ptr->cdr, Qnil)) |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2227 { |
21143
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
2228 objptr = &ptr->realvalue; |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2229 goto loop; |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2230 } |
21143
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
2231 mark_object (&ptr->realvalue); |
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
2232 mark_object (&ptr->buffer); |
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
2233 mark_object (&ptr->frame); |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2234 /* See comment above under Lisp_Vector for why not use ptr here. */ |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2235 objptr = &XBUFFER_LOCAL_VALUE (obj)->cdr; |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2236 goto loop; |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2237 } |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2238 |
9463
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
2239 case Lisp_Misc_Intfwd: |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
2240 case Lisp_Misc_Boolfwd: |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
2241 case Lisp_Misc_Objfwd: |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
2242 case Lisp_Misc_Buffer_Objfwd: |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
2243 case Lisp_Misc_Kboard_Objfwd: |
9463
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
2244 /* Don't bother with Lisp_Buffer_Objfwd, |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
2245 since all markable slots in current buffer marked anyway. */ |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
2246 /* Don't need to do Lisp_Objfwd, since the places they point |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
2247 are protected with staticpro. */ |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
2248 break; |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
2249 |
9926
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2250 case Lisp_Misc_Overlay: |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2251 { |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2252 struct Lisp_Overlay *ptr = XOVERLAY (obj); |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2253 if (!XMARKBIT (ptr->plist)) |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2254 { |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2255 XMARK (ptr->plist); |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2256 mark_object (&ptr->start); |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2257 mark_object (&ptr->end); |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2258 objptr = &ptr->plist; |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2259 goto loop; |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2260 } |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2261 } |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2262 break; |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2263 |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2264 default: |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2265 abort (); |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2266 } |
300 | 2267 break; |
2268 | |
2269 case Lisp_Cons: | |
2270 { | |
2271 register struct Lisp_Cons *ptr = XCONS (obj); | |
2272 if (XMARKBIT (ptr->car)) break; | |
2273 XMARK (ptr->car); | |
1295
a9241dc503ab
(mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents:
1168
diff
changeset
|
2274 /* If the cdr is nil, avoid recursion for the car. */ |
a9241dc503ab
(mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents:
1168
diff
changeset
|
2275 if (EQ (ptr->cdr, Qnil)) |
a9241dc503ab
(mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents:
1168
diff
changeset
|
2276 { |
a9241dc503ab
(mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents:
1168
diff
changeset
|
2277 objptr = &ptr->car; |
a9241dc503ab
(mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents:
1168
diff
changeset
|
2278 goto loop; |
a9241dc503ab
(mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents:
1168
diff
changeset
|
2279 } |
300 | 2280 mark_object (&ptr->car); |
4494
15b073a6c860
(mark_object): Declare ptr volatile, or don't use it
Richard M. Stallman <rms@gnu.org>
parents:
4212
diff
changeset
|
2281 /* See comment above under Lisp_Vector for why not use ptr here. */ |
15b073a6c860
(mark_object): Declare ptr volatile, or don't use it
Richard M. Stallman <rms@gnu.org>
parents:
4212
diff
changeset
|
2282 objptr = &XCONS (obj)->cdr; |
300 | 2283 goto loop; |
2284 } | |
2285 | |
2286 #ifdef LISP_FLOAT_TYPE | |
2287 case Lisp_Float: | |
2288 XMARK (XFLOAT (obj)->type); | |
2289 break; | |
2290 #endif /* LISP_FLOAT_TYPE */ | |
2291 | |
2292 case Lisp_Int: | |
2293 break; | |
2294 | |
2295 default: | |
2296 abort (); | |
2297 } | |
2298 } | |
2299 | |
2300 /* Mark the pointers in a buffer structure. */ | |
2301 | |
2302 static void | |
2303 mark_buffer (buf) | |
2304 Lisp_Object buf; | |
2305 { | |
2306 register struct buffer *buffer = XBUFFER (buf); | |
2307 register Lisp_Object *ptr; | |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
2308 Lisp_Object base_buffer; |
300 | 2309 |
2310 /* This is the buffer's markbit */ | |
2311 mark_object (&buffer->name); | |
2312 XMARK (buffer->name); | |
2313 | |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
2314 MARK_INTERVAL_TREE (BUF_INTERVALS (buffer)); |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2315 |
21306
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2316 if (CONSP (buffer->undo_list)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2317 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2318 Lisp_Object tail; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2319 tail = buffer->undo_list; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2320 |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2321 while (CONSP (tail)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2322 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2323 register struct Lisp_Cons *ptr = XCONS (tail); |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2324 |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2325 if (XMARKBIT (ptr->car)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2326 break; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2327 XMARK (ptr->car); |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2328 if (GC_CONSP (ptr->car) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2329 && ! XMARKBIT (XCONS (ptr->car)->car) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2330 && GC_MARKERP (XCONS (ptr->car)->car)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2331 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2332 XMARK (XCONS (ptr->car)->car); |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2333 mark_object (&XCONS (ptr->car)->cdr); |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2334 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2335 else |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2336 mark_object (&ptr->car); |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2337 |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2338 if (CONSP (ptr->cdr)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2339 tail = ptr->cdr; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2340 else |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2341 break; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2342 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2343 |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2344 mark_object (&XCONS (tail)->cdr); |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2345 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2346 else |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2347 mark_object (&buffer->undo_list); |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
2348 |
300 | 2349 #if 0 |
2350 mark_object (buffer->syntax_table); | |
2351 | |
2352 /* Mark the various string-pointers in the buffer object. | |
2353 Since the strings may be relocated, we must mark them | |
2354 in their actual slots. So gc_sweep must convert each slot | |
2355 back to an ordinary C pointer. */ | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
2356 XSETSTRING (*(Lisp_Object *)&buffer->upcase_table, buffer->upcase_table); |
300 | 2357 mark_object ((Lisp_Object *)&buffer->upcase_table); |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
2358 XSETSTRING (*(Lisp_Object *)&buffer->downcase_table, buffer->downcase_table); |
300 | 2359 mark_object ((Lisp_Object *)&buffer->downcase_table); |
2360 | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
2361 XSETSTRING (*(Lisp_Object *)&buffer->sort_table, buffer->sort_table); |
300 | 2362 mark_object ((Lisp_Object *)&buffer->sort_table); |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
2363 XSETSTRING (*(Lisp_Object *)&buffer->folding_sort_table, buffer->folding_sort_table); |
300 | 2364 mark_object ((Lisp_Object *)&buffer->folding_sort_table); |
2365 #endif | |
2366 | |
2367 for (ptr = &buffer->name + 1; | |
2368 (char *)ptr < (char *)buffer + sizeof (struct buffer); | |
2369 ptr++) | |
2370 mark_object (ptr); | |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
2371 |
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
2372 /* If this is an indirect buffer, mark its base buffer. */ |
10340
ef58c7a5a4d6
(mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents:
10320
diff
changeset
|
2373 if (buffer->base_buffer && !XMARKBIT (buffer->base_buffer->name)) |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
2374 { |
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
2375 XSETBUFFER (base_buffer, buffer->base_buffer); |
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
2376 mark_buffer (base_buffer); |
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
2377 } |
300 | 2378 } |
10649
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
2379 |
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
2380 |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
2381 /* Mark the pointers in the kboard objects. */ |
10649
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
2382 |
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
2383 static void |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
2384 mark_kboards () |
10649
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
2385 { |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
2386 KBOARD *kb; |
11593
f5385353aae3
(mark_kboards): Mark the kbd macro and Vsystem_key_alist.
Karl Heuer <kwzh@gnu.org>
parents:
11430
diff
changeset
|
2387 Lisp_Object *p; |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
2388 for (kb = all_kboards; kb; kb = kb->next_kboard) |
10649
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
2389 { |
11593
f5385353aae3
(mark_kboards): Mark the kbd macro and Vsystem_key_alist.
Karl Heuer <kwzh@gnu.org>
parents:
11430
diff
changeset
|
2390 if (kb->kbd_macro_buffer) |
f5385353aae3
(mark_kboards): Mark the kbd macro and Vsystem_key_alist.
Karl Heuer <kwzh@gnu.org>
parents:
11430
diff
changeset
|
2391 for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++) |
f5385353aae3
(mark_kboards): Mark the kbd macro and Vsystem_key_alist.
Karl Heuer <kwzh@gnu.org>
parents:
11430
diff
changeset
|
2392 mark_object (p); |
22381
50e1804145be
(mark_kboards): Mark all the Lisp_Object fields.
Richard M. Stallman <rms@gnu.org>
parents:
22220
diff
changeset
|
2393 mark_object (&kb->Voverriding_terminal_local_map); |
50e1804145be
(mark_kboards): Mark all the Lisp_Object fields.
Richard M. Stallman <rms@gnu.org>
parents:
22220
diff
changeset
|
2394 mark_object (&kb->Vlast_command); |
50e1804145be
(mark_kboards): Mark all the Lisp_Object fields.
Richard M. Stallman <rms@gnu.org>
parents:
22220
diff
changeset
|
2395 mark_object (&kb->Vreal_last_command); |
12120
1fc112b5fdc4
(mark_kboards): Mark Vprefix_arg instead of
Karl Heuer <kwzh@gnu.org>
parents:
12096
diff
changeset
|
2396 mark_object (&kb->Vprefix_arg); |
22382
f7d2bdefcff7
(mark_kboards): Mark Vlast_prefix_arg too.
Richard M. Stallman <rms@gnu.org>
parents:
22381
diff
changeset
|
2397 mark_object (&kb->Vlast_prefix_arg); |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
2398 mark_object (&kb->kbd_queue); |
22381
50e1804145be
(mark_kboards): Mark all the Lisp_Object fields.
Richard M. Stallman <rms@gnu.org>
parents:
22220
diff
changeset
|
2399 mark_object (&kb->defining_kbd_macro); |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
2400 mark_object (&kb->Vlast_kbd_macro); |
11593
f5385353aae3
(mark_kboards): Mark the kbd macro and Vsystem_key_alist.
Karl Heuer <kwzh@gnu.org>
parents:
11430
diff
changeset
|
2401 mark_object (&kb->Vsystem_key_alist); |
12175
4e36e9e99082
(mark_kboards): Mark system_key_syms member.
Karl Heuer <kwzh@gnu.org>
parents:
12120
diff
changeset
|
2402 mark_object (&kb->system_key_syms); |
22381
50e1804145be
(mark_kboards): Mark all the Lisp_Object fields.
Richard M. Stallman <rms@gnu.org>
parents:
22220
diff
changeset
|
2403 mark_object (&kb->Vdefault_minibuffer_frame); |
10649
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
2404 } |
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
2405 } |
300 | 2406 |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
2407 /* Sweep: find all structures not marked, and free them. */ |
300 | 2408 |
2409 static void | |
2410 gc_sweep () | |
2411 { | |
2412 total_string_size = 0; | |
2413 compact_strings (); | |
2414 | |
2415 /* Put all unmarked conses on free list */ | |
2416 { | |
2417 register struct cons_block *cblk; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2418 struct cons_block **cprev = &cons_block; |
300 | 2419 register int lim = cons_block_index; |
2420 register int num_free = 0, num_used = 0; | |
2421 | |
2422 cons_free_list = 0; | |
2423 | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2424 for (cblk = cons_block; cblk; cblk = *cprev) |
300 | 2425 { |
2426 register int i; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2427 int this_free = 0; |
300 | 2428 for (i = 0; i < lim; i++) |
2429 if (!XMARKBIT (cblk->conses[i].car)) | |
2430 { | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2431 this_free++; |
19666
81957e8b80e2
(free_float, free_cons): Don't use the same field for chaining as for marking.
Richard M. Stallman <rms@gnu.org>
parents:
19621
diff
changeset
|
2432 *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list; |
300 | 2433 cons_free_list = &cblk->conses[i]; |
2434 } | |
2435 else | |
2436 { | |
2437 num_used++; | |
2438 XUNMARK (cblk->conses[i].car); | |
2439 } | |
2440 lim = CONS_BLOCK_SIZE; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2441 /* If this block contains only free conses and we have already |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2442 seen more than two blocks worth of free conses then deallocate |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2443 this block. */ |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2444 if (this_free == CONS_BLOCK_SIZE && num_free > CONS_BLOCK_SIZE) |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2445 { |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2446 *cprev = cblk->next; |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2447 /* Unhook from the free list. */ |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2448 cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2449 lisp_free (cblk); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2450 n_cons_blocks--; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2451 } |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2452 else |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2453 { |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2454 num_free += this_free; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2455 cprev = &cblk->next; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2456 } |
300 | 2457 } |
2458 total_conses = num_used; | |
2459 total_free_conses = num_free; | |
2460 } | |
2461 | |
2462 #ifdef LISP_FLOAT_TYPE | |
2463 /* Put all unmarked floats on free list */ | |
2464 { | |
2465 register struct float_block *fblk; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2466 struct float_block **fprev = &float_block; |
300 | 2467 register int lim = float_block_index; |
2468 register int num_free = 0, num_used = 0; | |
2469 | |
2470 float_free_list = 0; | |
2471 | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2472 for (fblk = float_block; fblk; fblk = *fprev) |
300 | 2473 { |
2474 register int i; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2475 int this_free = 0; |
300 | 2476 for (i = 0; i < lim; i++) |
2477 if (!XMARKBIT (fblk->floats[i].type)) | |
2478 { | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2479 this_free++; |
19666
81957e8b80e2
(free_float, free_cons): Don't use the same field for chaining as for marking.
Richard M. Stallman <rms@gnu.org>
parents:
19621
diff
changeset
|
2480 *(struct Lisp_Float **)&fblk->floats[i].data = float_free_list; |
300 | 2481 float_free_list = &fblk->floats[i]; |
2482 } | |
2483 else | |
2484 { | |
2485 num_used++; | |
2486 XUNMARK (fblk->floats[i].type); | |
2487 } | |
2488 lim = FLOAT_BLOCK_SIZE; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2489 /* If this block contains only free floats and we have already |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2490 seen more than two blocks worth of free floats then deallocate |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2491 this block. */ |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2492 if (this_free == FLOAT_BLOCK_SIZE && num_free > FLOAT_BLOCK_SIZE) |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2493 { |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2494 *fprev = fblk->next; |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2495 /* Unhook from the free list. */ |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2496 float_free_list = *(struct Lisp_Float **) &fblk->floats[0].data; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2497 lisp_free (fblk); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2498 n_float_blocks--; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2499 } |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2500 else |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2501 { |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2502 num_free += this_free; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2503 fprev = &fblk->next; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2504 } |
300 | 2505 } |
2506 total_floats = num_used; | |
2507 total_free_floats = num_free; | |
2508 } | |
2509 #endif /* LISP_FLOAT_TYPE */ | |
2510 | |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2511 #ifdef USE_TEXT_PROPERTIES |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2512 /* Put all unmarked intervals on free list */ |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2513 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2514 register struct interval_block *iblk; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2515 struct interval_block **iprev = &interval_block; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2516 register int lim = interval_block_index; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2517 register int num_free = 0, num_used = 0; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2518 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2519 interval_free_list = 0; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2520 |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2521 for (iblk = interval_block; iblk; iblk = *iprev) |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2522 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2523 register int i; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2524 int this_free = 0; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2525 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2526 for (i = 0; i < lim; i++) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2527 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2528 if (! XMARKBIT (iblk->intervals[i].plist)) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2529 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2530 iblk->intervals[i].parent = interval_free_list; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2531 interval_free_list = &iblk->intervals[i]; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2532 this_free++; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2533 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2534 else |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2535 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2536 num_used++; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2537 XUNMARK (iblk->intervals[i].plist); |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2538 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2539 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2540 lim = INTERVAL_BLOCK_SIZE; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2541 /* If this block contains only free intervals and we have already |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2542 seen more than two blocks worth of free intervals then |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2543 deallocate this block. */ |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2544 if (this_free == INTERVAL_BLOCK_SIZE && num_free > INTERVAL_BLOCK_SIZE) |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2545 { |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2546 *iprev = iblk->next; |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2547 /* Unhook from the free list. */ |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2548 interval_free_list = iblk->intervals[0].parent; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2549 lisp_free (iblk); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2550 n_interval_blocks--; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2551 } |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2552 else |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2553 { |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2554 num_free += this_free; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2555 iprev = &iblk->next; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2556 } |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2557 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2558 total_intervals = num_used; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2559 total_free_intervals = num_free; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2560 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2561 #endif /* USE_TEXT_PROPERTIES */ |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
2562 |
300 | 2563 /* Put all unmarked symbols on free list */ |
2564 { | |
2565 register struct symbol_block *sblk; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2566 struct symbol_block **sprev = &symbol_block; |
300 | 2567 register int lim = symbol_block_index; |
2568 register int num_free = 0, num_used = 0; | |
2569 | |
2570 symbol_free_list = 0; | |
2571 | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2572 for (sblk = symbol_block; sblk; sblk = *sprev) |
300 | 2573 { |
2574 register int i; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2575 int this_free = 0; |
300 | 2576 for (i = 0; i < lim; i++) |
2577 if (!XMARKBIT (sblk->symbols[i].plist)) | |
2578 { | |
9942
c189487b08dd
(free_float): Don't assume XFASTINT accesses the raw bits.
Karl Heuer <kwzh@gnu.org>
parents:
9926
diff
changeset
|
2579 *(struct Lisp_Symbol **)&sblk->symbols[i].value = symbol_free_list; |
300 | 2580 symbol_free_list = &sblk->symbols[i]; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2581 this_free++; |
300 | 2582 } |
2583 else | |
2584 { | |
2585 num_used++; | |
2586 sblk->symbols[i].name | |
2587 = XSTRING (*(Lisp_Object *) &sblk->symbols[i].name); | |
2588 XUNMARK (sblk->symbols[i].plist); | |
2589 } | |
2590 lim = SYMBOL_BLOCK_SIZE; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2591 /* If this block contains only free symbols and we have already |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2592 seen more than two blocks worth of free symbols then deallocate |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2593 this block. */ |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2594 if (this_free == SYMBOL_BLOCK_SIZE && num_free > SYMBOL_BLOCK_SIZE) |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2595 { |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2596 *sprev = sblk->next; |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2597 /* Unhook from the free list. */ |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2598 symbol_free_list = *(struct Lisp_Symbol **)&sblk->symbols[0].value; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2599 lisp_free (sblk); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2600 n_symbol_blocks--; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2601 } |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2602 else |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2603 { |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2604 num_free += this_free; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2605 sprev = &sblk->next; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2606 } |
300 | 2607 } |
2608 total_symbols = num_used; | |
2609 total_free_symbols = num_free; | |
2610 } | |
2611 | |
2612 #ifndef standalone | |
21143
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
2613 /* Put all unmarked misc's on free list. |
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
2614 For a marker, first unchain it from the buffer it points into. */ |
300 | 2615 { |
2616 register struct marker_block *mblk; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2617 struct marker_block **mprev = &marker_block; |
300 | 2618 register int lim = marker_block_index; |
2619 register int num_free = 0, num_used = 0; | |
2620 | |
2621 marker_free_list = 0; | |
2622 | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2623 for (mblk = marker_block; mblk; mblk = *mprev) |
300 | 2624 { |
2625 register int i; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2626 int this_free = 0; |
11679
1ced2d67d411
(gc_cons_threshold): Make this an EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
11593
diff
changeset
|
2627 EMACS_INT already_free = -1; |
11403
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
2628 |
300 | 2629 for (i = 0; i < lim; i++) |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2630 { |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2631 Lisp_Object *markword; |
11243
054ecfce1820
(Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11048
diff
changeset
|
2632 switch (mblk->markers[i].u_marker.type) |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2633 { |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2634 case Lisp_Misc_Marker: |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2635 markword = &mblk->markers[i].u_marker.chain; |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2636 break; |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2637 case Lisp_Misc_Buffer_Local_Value: |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2638 case Lisp_Misc_Some_Buffer_Local_Value: |
21143
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
2639 markword = &mblk->markers[i].u_buffer_local_value.realvalue; |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2640 break; |
9926
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2641 case Lisp_Misc_Overlay: |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2642 markword = &mblk->markers[i].u_overlay.plist; |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2643 break; |
11403
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
2644 case Lisp_Misc_Free: |
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
2645 /* If the object was already free, keep it |
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
2646 on the free list. */ |
18621
53b95f307c75
(memory_full): Pass Qnil to Fsignal for ERROR_SYMBOL.
Richard M. Stallman <rms@gnu.org>
parents:
18104
diff
changeset
|
2647 markword = (Lisp_Object *) &already_free; |
11403
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
2648 break; |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2649 default: |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2650 markword = 0; |
9926
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
2651 break; |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2652 } |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2653 if (markword && !XMARKBIT (*markword)) |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2654 { |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2655 Lisp_Object tem; |
11243
054ecfce1820
(Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11048
diff
changeset
|
2656 if (mblk->markers[i].u_marker.type == Lisp_Misc_Marker) |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2657 { |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2658 /* tem1 avoids Sun compiler bug */ |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2659 struct Lisp_Marker *tem1 = &mblk->markers[i].u_marker; |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2660 XSETMARKER (tem, tem1); |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2661 unchain_marker (tem); |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2662 } |
11403
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
2663 /* Set the type of the freed object to Lisp_Misc_Free. |
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
2664 We could leave the type alone, since nobody checks it, |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2665 but this might catch bugs faster. */ |
11243
054ecfce1820
(Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11048
diff
changeset
|
2666 mblk->markers[i].u_marker.type = Lisp_Misc_Free; |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2667 mblk->markers[i].u_free.chain = marker_free_list; |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2668 marker_free_list = &mblk->markers[i]; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2669 this_free++; |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2670 } |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2671 else |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2672 { |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2673 num_used++; |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2674 if (markword) |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2675 XUNMARK (*markword); |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2676 } |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
2677 } |
300 | 2678 lim = MARKER_BLOCK_SIZE; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2679 /* If this block contains only free markers and we have already |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2680 seen more than two blocks worth of free markers then deallocate |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2681 this block. */ |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2682 if (this_free == MARKER_BLOCK_SIZE && num_free > MARKER_BLOCK_SIZE) |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2683 { |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2684 *mprev = mblk->next; |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2685 /* Unhook from the free list. */ |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2686 marker_free_list = mblk->markers[0].u_free.chain; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2687 lisp_free (mblk); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2688 n_marker_blocks--; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2689 } |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
2690 else |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2691 { |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2692 num_free += this_free; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2693 mprev = &mblk->next; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
2694 } |
300 | 2695 } |
2696 | |
2697 total_markers = num_used; | |
2698 total_free_markers = num_free; | |
2699 } | |
2700 | |
2701 /* Free all unmarked buffers */ | |
2702 { | |
2703 register struct buffer *buffer = all_buffers, *prev = 0, *next; | |
2704 | |
2705 while (buffer) | |
2706 if (!XMARKBIT (buffer->name)) | |
2707 { | |
2708 if (prev) | |
2709 prev->next = buffer->next; | |
2710 else | |
2711 all_buffers = buffer->next; | |
2712 next = buffer->next; | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
2713 xfree (buffer); |
300 | 2714 buffer = next; |
2715 } | |
2716 else | |
2717 { | |
2718 XUNMARK (buffer->name); | |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
2719 UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer)); |
300 | 2720 |
2721 #if 0 | |
2722 /* Each `struct Lisp_String *' was turned into a Lisp_Object | |
2723 for purposes of marking and relocation. | |
2724 Turn them back into C pointers now. */ | |
2725 buffer->upcase_table | |
2726 = XSTRING (*(Lisp_Object *)&buffer->upcase_table); | |
2727 buffer->downcase_table | |
2728 = XSTRING (*(Lisp_Object *)&buffer->downcase_table); | |
2729 buffer->sort_table | |
2730 = XSTRING (*(Lisp_Object *)&buffer->sort_table); | |
2731 buffer->folding_sort_table | |
2732 = XSTRING (*(Lisp_Object *)&buffer->folding_sort_table); | |
2733 #endif | |
2734 | |
2735 prev = buffer, buffer = buffer->next; | |
2736 } | |
2737 } | |
2738 | |
2739 #endif /* standalone */ | |
2740 | |
2741 /* Free all unmarked vectors */ | |
2742 { | |
2743 register struct Lisp_Vector *vector = all_vectors, *prev = 0, *next; | |
2744 total_vector_size = 0; | |
2745 | |
2746 while (vector) | |
2747 if (!(vector->size & ARRAY_MARK_FLAG)) | |
2748 { | |
2749 if (prev) | |
2750 prev->next = vector->next; | |
2751 else | |
2752 all_vectors = vector->next; | |
2753 next = vector->next; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2754 lisp_free (vector); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2755 n_vectors--; |
300 | 2756 vector = next; |
2757 } | |
2758 else | |
2759 { | |
2760 vector->size &= ~ARRAY_MARK_FLAG; | |
11403
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
2761 if (vector->size & PSEUDOVECTOR_FLAG) |
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
2762 total_vector_size += (PSEUDOVECTOR_SIZE_MASK & vector->size); |
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
2763 else |
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
2764 total_vector_size += vector->size; |
300 | 2765 prev = vector, vector = vector->next; |
2766 } | |
2767 } | |
2768 | |
2769 /* Free all "large strings" not marked with ARRAY_MARK_FLAG. */ | |
2770 { | |
2771 register struct string_block *sb = large_string_blocks, *prev = 0, *next; | |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2772 struct Lisp_String *s; |
300 | 2773 |
2774 while (sb) | |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2775 { |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2776 s = (struct Lisp_String *) &sb->chars[0]; |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2777 if (s->size & ARRAY_MARK_FLAG) |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2778 { |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2779 ((struct Lisp_String *)(&sb->chars[0]))->size |
10413
bfe591f66299
(DONT_COPY_FLAG): Default this to 1.
Karl Heuer <kwzh@gnu.org>
parents:
10398
diff
changeset
|
2780 &= ~ARRAY_MARK_FLAG & ~MARKBIT; |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2781 UNMARK_BALANCE_INTERVALS (s->intervals); |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2782 total_string_size += ((struct Lisp_String *)(&sb->chars[0]))->size; |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2783 prev = sb, sb = sb->next; |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2784 } |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2785 else |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2786 { |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2787 if (prev) |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2788 prev->next = sb->next; |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2789 else |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2790 large_string_blocks = sb->next; |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2791 next = sb->next; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2792 lisp_free (sb); |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2793 sb = next; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2794 n_string_blocks--; |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2795 } |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2796 } |
300 | 2797 } |
2798 } | |
2799 | |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
2800 /* Compactify strings, relocate references, and free empty string blocks. */ |
300 | 2801 |
2802 static void | |
2803 compact_strings () | |
2804 { | |
2805 /* String block of old strings we are scanning. */ | |
2806 register struct string_block *from_sb; | |
2807 /* A preceding string block (or maybe the same one) | |
2808 where we are copying the still-live strings to. */ | |
2809 register struct string_block *to_sb; | |
2810 int pos; | |
2811 int to_pos; | |
2812 | |
2813 to_sb = first_string_block; | |
2814 to_pos = 0; | |
2815 | |
2816 /* Scan each existing string block sequentially, string by string. */ | |
2817 for (from_sb = first_string_block; from_sb; from_sb = from_sb->next) | |
2818 { | |
2819 pos = 0; | |
2820 /* POS is the index of the next string in the block. */ | |
2821 while (pos < from_sb->pos) | |
2822 { | |
2823 register struct Lisp_String *nextstr | |
2824 = (struct Lisp_String *) &from_sb->chars[pos]; | |
2825 | |
2826 register struct Lisp_String *newaddr; | |
8817
48ff00bebef6
(pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
2827 register EMACS_INT size = nextstr->size; |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
2828 EMACS_INT size_byte = nextstr->size_byte; |
300 | 2829 |
2830 /* NEXTSTR is the old address of the next string. | |
2831 Just skip it if it isn't marked. */ | |
10389
162b3e6c4610
(DONT_COPY_FLAG): New bit flag.
Richard M. Stallman <rms@gnu.org>
parents:
10340
diff
changeset
|
2832 if (((EMACS_UINT) size & ~DONT_COPY_FLAG) > STRING_BLOCK_SIZE) |
300 | 2833 { |
2834 /* It is marked, so its size field is really a chain of refs. | |
2835 Find the end of the chain, where the actual size lives. */ | |
10389
162b3e6c4610
(DONT_COPY_FLAG): New bit flag.
Richard M. Stallman <rms@gnu.org>
parents:
10340
diff
changeset
|
2836 while (((EMACS_UINT) size & ~DONT_COPY_FLAG) > STRING_BLOCK_SIZE) |
300 | 2837 { |
10389
162b3e6c4610
(DONT_COPY_FLAG): New bit flag.
Richard M. Stallman <rms@gnu.org>
parents:
10340
diff
changeset
|
2838 if (size & DONT_COPY_FLAG) |
162b3e6c4610
(DONT_COPY_FLAG): New bit flag.
Richard M. Stallman <rms@gnu.org>
parents:
10340
diff
changeset
|
2839 size ^= MARKBIT | DONT_COPY_FLAG; |
8817
48ff00bebef6
(pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
2840 size = *(EMACS_INT *)size & ~MARKBIT; |
300 | 2841 } |
2842 | |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
2843 if (size_byte < 0) |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
2844 size_byte = size; |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
2845 |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
2846 total_string_size += size_byte; |
300 | 2847 |
2848 /* If it won't fit in TO_SB, close it out, | |
2849 and move to the next sb. Keep doing so until | |
2850 TO_SB reaches a large enough, empty enough string block. | |
2851 We know that TO_SB cannot advance past FROM_SB here | |
2852 since FROM_SB is large enough to contain this string. | |
2853 Any string blocks skipped here | |
2854 will be patched out and freed later. */ | |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
2855 while (to_pos + STRING_FULLSIZE (size_byte) |
300 | 2856 > max (to_sb->pos, STRING_BLOCK_SIZE)) |
2857 { | |
2858 to_sb->pos = to_pos; | |
2859 to_sb = to_sb->next; | |
2860 to_pos = 0; | |
2861 } | |
2862 /* Compute new address of this string | |
2863 and update TO_POS for the space being used. */ | |
2864 newaddr = (struct Lisp_String *) &to_sb->chars[to_pos]; | |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
2865 to_pos += STRING_FULLSIZE (size_byte); |
300 | 2866 |
2867 /* Copy the string itself to the new place. */ | |
2868 if (nextstr != newaddr) | |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
2869 bcopy (nextstr, newaddr, STRING_FULLSIZE (size_byte)); |
300 | 2870 |
2871 /* Go through NEXTSTR's chain of references | |
2872 and make each slot in the chain point to | |
2873 the new address of this string. */ | |
2874 size = newaddr->size; | |
10389
162b3e6c4610
(DONT_COPY_FLAG): New bit flag.
Richard M. Stallman <rms@gnu.org>
parents:
10340
diff
changeset
|
2875 while (((EMACS_UINT) size & ~DONT_COPY_FLAG) > STRING_BLOCK_SIZE) |
300 | 2876 { |
2877 register Lisp_Object *objptr; | |
10389
162b3e6c4610
(DONT_COPY_FLAG): New bit flag.
Richard M. Stallman <rms@gnu.org>
parents:
10340
diff
changeset
|
2878 if (size & DONT_COPY_FLAG) |
162b3e6c4610
(DONT_COPY_FLAG): New bit flag.
Richard M. Stallman <rms@gnu.org>
parents:
10340
diff
changeset
|
2879 size ^= MARKBIT | DONT_COPY_FLAG; |
300 | 2880 objptr = (Lisp_Object *)size; |
2881 | |
2882 size = XFASTINT (*objptr) & ~MARKBIT; | |
2883 if (XMARKBIT (*objptr)) | |
2884 { | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
2885 XSETSTRING (*objptr, newaddr); |
300 | 2886 XMARK (*objptr); |
2887 } | |
2888 else | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
2889 XSETSTRING (*objptr, newaddr); |
300 | 2890 } |
2891 /* Store the actual size in the size field. */ | |
2892 newaddr->size = size; | |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2893 |
4212
a696547fb51e
(compact_strings): Add USE_TEXT_PROPERTIES conditional.
Richard M. Stallman <rms@gnu.org>
parents:
4139
diff
changeset
|
2894 #ifdef USE_TEXT_PROPERTIES |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2895 /* Now that the string has been relocated, rebalance its |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2896 interval tree, and update the tree's parent pointer. */ |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2897 if (! NULL_INTERVAL_P (newaddr->intervals)) |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2898 { |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2899 UNMARK_BALANCE_INTERVALS (newaddr->intervals); |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
2900 XSETSTRING (* (Lisp_Object *) &newaddr->intervals->parent, |
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
2901 newaddr); |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
2902 } |
4212
a696547fb51e
(compact_strings): Add USE_TEXT_PROPERTIES conditional.
Richard M. Stallman <rms@gnu.org>
parents:
4139
diff
changeset
|
2903 #endif /* USE_TEXT_PROPERTIES */ |
300 | 2904 } |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
2905 else if (size_byte < 0) |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
2906 size_byte = size; |
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
2907 |
20587
eaf988c7e291
(make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents:
20565
diff
changeset
|
2908 pos += STRING_FULLSIZE (size_byte); |
300 | 2909 } |
2910 } | |
2911 | |
2912 /* Close out the last string block still used and free any that follow. */ | |
2913 to_sb->pos = to_pos; | |
2914 current_string_block = to_sb; | |
2915 | |
2916 from_sb = to_sb->next; | |
2917 to_sb->next = 0; | |
2918 while (from_sb) | |
2919 { | |
2920 to_sb = from_sb->next; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2921 lisp_free (from_sb); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2922 n_string_blocks--; |
300 | 2923 from_sb = to_sb; |
2924 } | |
2925 | |
2926 /* Free any empty string blocks further back in the chain. | |
2927 This loop will never free first_string_block, but it is very | |
2928 unlikely that that one will become empty, so why bother checking? */ | |
2929 | |
2930 from_sb = first_string_block; | |
2931 while (to_sb = from_sb->next) | |
2932 { | |
2933 if (to_sb->pos == 0) | |
2934 { | |
2935 if (from_sb->next = to_sb->next) | |
2936 from_sb->next->prev = from_sb; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2937 lisp_free (to_sb); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2938 n_string_blocks--; |
300 | 2939 } |
2940 else | |
2941 from_sb = to_sb; | |
2942 } | |
2943 } | |
2944 | |
1327
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
2945 /* Debugging aids. */ |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
2946 |
5353
6389ed5b45ac
(Fmemory_limit): No longer interactive.
Richard M. Stallman <rms@gnu.org>
parents:
4956
diff
changeset
|
2947 DEFUN ("memory-limit", Fmemory_limit, Smemory_limit, 0, 0, 0, |
1327
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
2948 "Return the address of the last byte Emacs has allocated, divided by 1024.\n\ |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
2949 This may be helpful in debugging Emacs's memory usage.\n\ |
1893
b047e77f3be4
(Fmemory_limit): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
1784
diff
changeset
|
2950 We divide the value by 1024 to make sure it fits in a Lisp integer.") |
1327
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
2951 () |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
2952 { |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
2953 Lisp_Object end; |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
2954 |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
2955 XSETINT (end, (EMACS_INT) sbrk (0) / 1024); |
1327
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
2956 |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
2957 return end; |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
2958 } |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
2959 |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2960 DEFUN ("memory-use-counts", Fmemory_use_counts, Smemory_use_counts, 0, 0, 0, |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2961 "Return a list of counters that measure how much consing there has been.\n\ |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2962 Each of these counters increments for a certain kind of object.\n\ |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2963 The counters wrap around from the largest positive integer to zero.\n\ |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2964 Garbage collection does not decrease them.\n\ |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2965 The elements of the value are as follows:\n\ |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2966 (CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS MISCS INTERVALS)\n\ |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2967 All are in units of 1 = one object consed\n\ |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2968 except for VECTOR-CELLS and STRING-CHARS, which count the total length of\n\ |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2969 objects consed.\n\ |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2970 MISCS include overlays, markers, and some internal types.\n\ |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2971 Frames, windows, buffers, and subprocesses count as vectors\n\ |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2972 (but the contents of a buffer's text do not count here).") |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2973 () |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2974 { |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2975 Lisp_Object lisp_cons_cells_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2976 Lisp_Object lisp_floats_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2977 Lisp_Object lisp_vector_cells_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2978 Lisp_Object lisp_symbols_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2979 Lisp_Object lisp_string_chars_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2980 Lisp_Object lisp_misc_objects_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2981 Lisp_Object lisp_intervals_consed; |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2982 |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2983 XSETINT (lisp_cons_cells_consed, |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
2984 cons_cells_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2985 XSETINT (lisp_floats_consed, |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
2986 floats_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2987 XSETINT (lisp_vector_cells_consed, |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
2988 vector_cells_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2989 XSETINT (lisp_symbols_consed, |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
2990 symbols_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2991 XSETINT (lisp_string_chars_consed, |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
2992 string_chars_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2993 XSETINT (lisp_misc_objects_consed, |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
2994 misc_objects_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2995 XSETINT (lisp_intervals_consed, |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
2996 intervals_consed & ~(((EMACS_INT) 1) << (VALBITS - 1))); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2997 |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2998 return Fcons (lisp_cons_cells_consed, |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2999 Fcons (lisp_floats_consed, |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
3000 Fcons (lisp_vector_cells_consed, |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
3001 Fcons (lisp_symbols_consed, |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
3002 Fcons (lisp_string_chars_consed, |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
3003 Fcons (lisp_misc_objects_consed, |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
3004 Fcons (lisp_intervals_consed, |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
3005 Qnil))))))); |
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
3006 } |
1327
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
3007 |
300 | 3008 /* Initialization */ |
3009 | |
21514 | 3010 void |
300 | 3011 init_alloc_once () |
3012 { | |
3013 /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */ | |
3014 pureptr = 0; | |
356 | 3015 #ifdef HAVE_SHM |
3016 pure_size = PURESIZE; | |
3017 #endif | |
300 | 3018 all_vectors = 0; |
3019 ignore_warnings = 1; | |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
3020 #ifdef DOUG_LEA_MALLOC |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
3021 mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */ |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
3022 mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */ |
23973
2eb9e2f5aa33
(MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
23958
diff
changeset
|
3023 mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); /* max. number of mmap'ed areas */ |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
3024 #endif |
300 | 3025 init_strings (); |
3026 init_cons (); | |
3027 init_symbol (); | |
3028 init_marker (); | |
3029 #ifdef LISP_FLOAT_TYPE | |
3030 init_float (); | |
3031 #endif /* LISP_FLOAT_TYPE */ | |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
3032 INIT_INTERVALS; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
3033 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
3034 #ifdef REL_ALLOC |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
3035 malloc_hysteresis = 32; |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
3036 #else |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
3037 malloc_hysteresis = 0; |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
3038 #endif |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
3039 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
3040 spare_memory = (char *) malloc (SPARE_MEMORY); |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
3041 |
300 | 3042 ignore_warnings = 0; |
3043 gcprolist = 0; | |
3044 staticidx = 0; | |
3045 consing_since_gc = 0; | |
12605
c5798bb57fdd
(init_alloc_once): Set gc_cons_threshold from Lisp obj size.
Richard M. Stallman <rms@gnu.org>
parents:
12529
diff
changeset
|
3046 gc_cons_threshold = 100000 * sizeof (Lisp_Object); |
300 | 3047 #ifdef VIRT_ADDR_VARIES |
3048 malloc_sbrk_unused = 1<<22; /* A large number */ | |
3049 malloc_sbrk_used = 100000; /* as reasonable as any number */ | |
3050 #endif /* VIRT_ADDR_VARIES */ | |
3051 } | |
3052 | |
21514 | 3053 void |
300 | 3054 init_alloc () |
3055 { | |
3056 gcprolist = 0; | |
3057 } | |
3058 | |
3059 void | |
3060 syms_of_alloc () | |
3061 { | |
3062 DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold, | |
3063 "*Number of bytes of consing between garbage collections.\n\ | |
3064 Garbage collection can happen automatically once this many bytes have been\n\ | |
3065 allocated since the last garbage collection. All data types count.\n\n\ | |
3066 Garbage collection happens automatically only when `eval' is called.\n\n\ | |
3067 By binding this temporarily to a large number, you can effectively\n\ | |
3068 prevent garbage collection during a part of the program."); | |
3069 | |
3070 DEFVAR_INT ("pure-bytes-used", &pureptr, | |
3071 "Number of bytes of sharable Lisp data allocated so far."); | |
3072 | |
15960
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3073 DEFVAR_INT ("cons-cells-consed", &cons_cells_consed, |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3074 "Number of cons cells that have been consed so far."); |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3075 |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3076 DEFVAR_INT ("floats-consed", &floats_consed, |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3077 "Number of floats that have been consed so far."); |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3078 |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3079 DEFVAR_INT ("vector-cells-consed", &vector_cells_consed, |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3080 "Number of vector cells that have been consed so far."); |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3081 |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3082 DEFVAR_INT ("symbols-consed", &symbols_consed, |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3083 "Number of symbols that have been consed so far."); |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3084 |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3085 DEFVAR_INT ("string-chars-consed", &string_chars_consed, |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3086 "Number of string characters that have been consed so far."); |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3087 |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3088 DEFVAR_INT ("misc-objects-consed", &misc_objects_consed, |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3089 "Number of miscellaneous objects that have been consed so far."); |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3090 |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3091 DEFVAR_INT ("intervals-consed", &intervals_consed, |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3092 "Number of intervals that have been consed so far."); |
12c61b25b7b6
(syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents:
15379
diff
changeset
|
3093 |
300 | 3094 #if 0 |
3095 DEFVAR_INT ("data-bytes-used", &malloc_sbrk_used, | |
3096 "Number of bytes of unshared memory allocated in this session."); | |
3097 | |
3098 DEFVAR_INT ("data-bytes-free", &malloc_sbrk_unused, | |
3099 "Number of bytes of unshared memory remaining available in this session."); | |
3100 #endif | |
3101 | |
3102 DEFVAR_LISP ("purify-flag", &Vpurify_flag, | |
3103 "Non-nil means loading Lisp code in order to dump an executable.\n\ | |
3104 This means that certain objects should be allocated in shared (pure) space."); | |
3105 | |
764 | 3106 DEFVAR_INT ("undo-limit", &undo_limit, |
300 | 3107 "Keep no more undo information once it exceeds this size.\n\ |
764 | 3108 This limit is applied when garbage collection happens.\n\ |
300 | 3109 The size is counted as the number of bytes occupied,\n\ |
3110 which includes both saved text and other data."); | |
764 | 3111 undo_limit = 20000; |
300 | 3112 |
764 | 3113 DEFVAR_INT ("undo-strong-limit", &undo_strong_limit, |
300 | 3114 "Don't keep more than this much size of undo information.\n\ |
3115 A command which pushes past this size is itself forgotten.\n\ | |
764 | 3116 This limit is applied when garbage collection happens.\n\ |
300 | 3117 The size is counted as the number of bytes occupied,\n\ |
3118 which includes both saved text and other data."); | |
764 | 3119 undo_strong_limit = 30000; |
300 | 3120 |
14959
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
3121 DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages, |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
3122 "Non-nil means display messages at start and end of garbage collection."); |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
3123 garbage_collection_messages = 0; |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
3124 |
6116
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
3125 /* We build this in advance because if we wait until we need it, we might |
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
3126 not be able to allocate the memory to hold it. */ |
6133
752d4237f869
(memory_signal_data): No longer static.
Richard M. Stallman <rms@gnu.org>
parents:
6116
diff
changeset
|
3127 memory_signal_data |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
3128 = Fcons (Qerror, Fcons (build_string ("Memory exhausted--use M-x save-some-buffers RET"), Qnil)); |
6116
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
3129 staticpro (&memory_signal_data); |
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
3130 |
11374
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
3131 staticpro (&Qgc_cons_threshold); |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
3132 Qgc_cons_threshold = intern ("gc-cons-threshold"); |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
3133 |
13219
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
3134 staticpro (&Qchar_table_extra_slots); |
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
3135 Qchar_table_extra_slots = intern ("char-table-extra-slots"); |
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
3136 |
300 | 3137 defsubr (&Scons); |
3138 defsubr (&Slist); | |
3139 defsubr (&Svector); | |
3140 defsubr (&Smake_byte_code); | |
3141 defsubr (&Smake_list); | |
3142 defsubr (&Smake_vector); | |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
3143 defsubr (&Smake_char_table); |
300 | 3144 defsubr (&Smake_string); |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
3145 defsubr (&Smake_bool_vector); |
300 | 3146 defsubr (&Smake_symbol); |
3147 defsubr (&Smake_marker); | |
3148 defsubr (&Spurecopy); | |
3149 defsubr (&Sgarbage_collect); | |
1327
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
3150 defsubr (&Smemory_limit); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
3151 defsubr (&Smemory_use_counts); |
300 | 3152 } |