Mercurial > emacs
annotate src/alloc.c @ 49968:80ed3e75ba10
(read-envvar-name): Decode names.
(substitute-env-vars): Use eval-when-compile and char class.
(setenv): Doc fix. Encode the data (after checking that's
possible).
(getenv): Encode the name and decode the result.
author | Dave Love <fx@gnu.org> |
---|---|
date | Mon, 24 Feb 2003 22:51:41 +0000 |
parents | d9ade23e09df |
children | fdeb795fc0ec |
rev | line source |
---|---|
300 | 1 /* Storage allocation and gc for GNU Emacs Lisp interpreter. |
49139
e807249d08c1
(pure_alloc): Correct alignment for Lisp_Floats.
Andreas Schwab <schwab@suse.de>
parents:
49055
diff
changeset
|
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001, 2002, 2003 |
20708 | 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 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
25762
diff
changeset
|
22 #include <config.h> |
28374
7a3e8a76057b
Include stdio.h. Test STDC_HEADERS, not __STDC__.
Dave Love <fx@gnu.org>
parents:
28365
diff
changeset
|
23 #include <stdio.h> |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
25762
diff
changeset
|
24 |
47185
2ff45b08a155
(display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents:
46833
diff
changeset
|
25 #ifdef ALLOC_DEBUG |
2ff45b08a155
(display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents:
46833
diff
changeset
|
26 #undef INLINE |
2ff45b08a155
(display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents:
46833
diff
changeset
|
27 #endif |
2ff45b08a155
(display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents:
46833
diff
changeset
|
28 |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
29 /* Note that this declares bzero on OSF/1. How dumb. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
30 |
3003
5a73d384f45e
* syssignal.h: Don't #include <signal.h>
Jim Blandy <jimb@redhat.com>
parents:
2961
diff
changeset
|
31 #include <signal.h> |
300 | 32 |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
33 /* GC_MALLOC_CHECK defined means perform validity checks of malloc'd |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
34 memory. Can do this only if using gmalloc.c. */ |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
35 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
36 #if defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
37 #undef GC_MALLOC_CHECK |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
38 #endif |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
39 |
26164
d39ec0a27081
more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents:
26088
diff
changeset
|
40 /* This file is part of the core Lisp implementation, and thus must |
d39ec0a27081
more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents:
26088
diff
changeset
|
41 deal with the real data structures. If the Lisp implementation is |
d39ec0a27081
more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents:
26088
diff
changeset
|
42 replaced, this file likely will not be used. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
43 |
26164
d39ec0a27081
more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents:
26088
diff
changeset
|
44 #undef HIDE_LISP_IMPLEMENTATION |
300 | 45 #include "lisp.h" |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
46 #include "process.h" |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
47 #include "intervals.h" |
356 | 48 #include "puresize.h" |
300 | 49 #include "buffer.h" |
50 #include "window.h" | |
31102
6a0caa788013
Include keyboard.h before frame.h.
Andrew Innes <andrewi@gnu.org>
parents:
30914
diff
changeset
|
51 #include "keyboard.h" |
764 | 52 #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
|
53 #include "blockinput.h" |
21084
371ed7bdfd2b
(Fmake_string): Handle the case INIT is a multibyte character correctly.
Richard M. Stallman <rms@gnu.org>
parents:
20849
diff
changeset
|
54 #include "charset.h" |
638 | 55 #include "syssignal.h" |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
56 #include <setjmp.h> |
638 | 57 |
30784
dbc1e69a89a9
[HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents:
30557
diff
changeset
|
58 #ifdef HAVE_UNISTD_H |
dbc1e69a89a9
[HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents:
30557
diff
changeset
|
59 #include <unistd.h> |
dbc1e69a89a9
[HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents:
30557
diff
changeset
|
60 #else |
dbc1e69a89a9
[HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents:
30557
diff
changeset
|
61 extern POINTER_TYPE *sbrk (); |
dbc1e69a89a9
[HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents:
30557
diff
changeset
|
62 #endif |
12096 | 63 |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
64 #ifdef DOUG_LEA_MALLOC |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
65 |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
66 #include <malloc.h> |
31892
2f3d88ac2b38
(__malloc_size_t) [DOUG_LEA_MALLOC]: Don't redefine it.
Dave Love <fx@gnu.org>
parents:
31889
diff
changeset
|
67 /* malloc.h #defines this as size_t, at least in glibc2. */ |
2f3d88ac2b38
(__malloc_size_t) [DOUG_LEA_MALLOC]: Don't redefine it.
Dave Love <fx@gnu.org>
parents:
31889
diff
changeset
|
68 #ifndef __malloc_size_t |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
69 #define __malloc_size_t int |
31892
2f3d88ac2b38
(__malloc_size_t) [DOUG_LEA_MALLOC]: Don't redefine it.
Dave Love <fx@gnu.org>
parents:
31889
diff
changeset
|
70 #endif |
23973
2eb9e2f5aa33
(MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
23958
diff
changeset
|
71 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
72 /* Specify maximum number of areas to mmap. It would be nice to use a |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
73 value that explicitly means "no limit". */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
74 |
23973
2eb9e2f5aa33
(MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
23958
diff
changeset
|
75 #define MMAP_MAX_AREAS 100000000 |
2eb9e2f5aa33
(MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
23958
diff
changeset
|
76 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
77 #else /* not DOUG_LEA_MALLOC */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
78 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
79 /* 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
|
80 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
81 #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
|
82 extern __malloc_size_t _bytes_used; |
31892
2f3d88ac2b38
(__malloc_size_t) [DOUG_LEA_MALLOC]: Don't redefine it.
Dave Love <fx@gnu.org>
parents:
31889
diff
changeset
|
83 extern __malloc_size_t __malloc_extra_blocks; |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
84 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
85 #endif /* not DOUG_LEA_MALLOC */ |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
86 |
300 | 87 /* Macro to verify that storage intended for Lisp objects is not |
88 out of range to fit in the space for a pointer. | |
89 ADDRESS is the start of the block, and SIZE | |
90 is the amount of space within which objects can start. */ | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
91 |
300 | 92 #define VALIDATE_LISP_STORAGE(address, size) \ |
93 do \ | |
94 { \ | |
95 Lisp_Object val; \ | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
96 XSETCONS (val, (char *) address + size); \ |
300 | 97 if ((char *) XCONS (val) != (char *) address + size) \ |
98 { \ | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
99 xfree (address); \ |
300 | 100 memory_full (); \ |
101 } \ | |
102 } while (0) | |
103 | |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
104 /* Value of _bytes_used, when spare_memory was freed. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
105 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
106 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
|
107 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
108 /* Mark, unmark, query mark bit of a Lisp string. S must be a pointer |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
109 to a struct Lisp_String. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
110 |
28469
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
111 #define MARK_STRING(S) ((S)->size |= MARKBIT) |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
112 #define UNMARK_STRING(S) ((S)->size &= ~MARKBIT) |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
113 #define STRING_MARKED_P(S) ((S)->size & MARKBIT) |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
114 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
115 /* Value is the number of bytes/chars of S, a pointer to a struct |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
116 Lisp_String. This must be used instead of STRING_BYTES (S) or |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
117 S->size during GC, because S->size contains the mark bit for |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
118 strings. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
119 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
120 #define GC_STRING_BYTES(S) (STRING_BYTES (S) & ~MARKBIT) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
121 #define GC_STRING_CHARS(S) ((S)->size & ~MARKBIT) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
122 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
123 /* Number of bytes of consing done since the last gc. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
124 |
300 | 125 int consing_since_gc; |
126 | |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
127 /* Count the amount of consing of various sorts of space. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
128 |
43713
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43314
diff
changeset
|
129 EMACS_INT cons_cells_consed; |
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43314
diff
changeset
|
130 EMACS_INT floats_consed; |
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43314
diff
changeset
|
131 EMACS_INT vector_cells_consed; |
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43314
diff
changeset
|
132 EMACS_INT symbols_consed; |
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43314
diff
changeset
|
133 EMACS_INT string_chars_consed; |
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43314
diff
changeset
|
134 EMACS_INT misc_objects_consed; |
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43314
diff
changeset
|
135 EMACS_INT intervals_consed; |
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43314
diff
changeset
|
136 EMACS_INT strings_consed; |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
137 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
138 /* Number of bytes of consing since GC before another GC should be done. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
139 |
43713
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43314
diff
changeset
|
140 EMACS_INT gc_cons_threshold; |
300 | 141 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
142 /* Nonzero during GC. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
143 |
300 | 144 int gc_in_progress; |
145 | |
14959
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
146 /* Nonzero means display messages at beginning and end of GC. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
147 |
14959
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
148 int garbage_collection_messages; |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
149 |
300 | 150 #ifndef VIRT_ADDR_VARIES |
151 extern | |
152 #endif /* VIRT_ADDR_VARIES */ | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
153 int malloc_sbrk_used; |
300 | 154 |
155 #ifndef VIRT_ADDR_VARIES | |
156 extern | |
157 #endif /* VIRT_ADDR_VARIES */ | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
158 int malloc_sbrk_unused; |
300 | 159 |
764 | 160 /* Two limits controlling how much undo information to keep. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
161 |
43713
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43314
diff
changeset
|
162 EMACS_INT undo_limit; |
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43314
diff
changeset
|
163 EMACS_INT undo_strong_limit; |
300 | 164 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
165 /* Number of live and free conses etc. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
166 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
167 static int total_conses, total_markers, total_symbols, total_vector_size; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
168 static int total_free_conses, total_free_markers, total_free_symbols; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
169 static int total_free_floats, total_floats; |
19332
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
170 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
171 /* Points to memory space allocated as "spare", to be freed if we run |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
172 out of memory. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
173 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
174 static char *spare_memory; |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
175 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
176 /* Amount of spare memory to keep in reserve. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
177 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
178 #define SPARE_MEMORY (1 << 14) |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
179 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
180 /* Number of extra blocks malloc should get when it needs more core. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
181 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
182 static int malloc_hysteresis; |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
183 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
184 /* Non-nil means defun should do purecopy on the function definition. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
185 |
300 | 186 Lisp_Object Vpurify_flag; |
187 | |
46305
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
188 /* Non-nil means we are handling a memory-full error. */ |
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
189 |
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
190 Lisp_Object Vmemory_full; |
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
191 |
300 | 192 #ifndef HAVE_SHM |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
193 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
194 /* Force it into data space! */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
195 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
196 EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,}; |
300 | 197 #define PUREBEG (char *) pure |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
198 |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
199 #else /* HAVE_SHM */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
200 |
300 | 201 #define pure PURE_SEG_BITS /* Use shared memory segment */ |
202 #define PUREBEG (char *)PURE_SEG_BITS | |
356 | 203 |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
204 #endif /* HAVE_SHM */ |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
205 |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
206 /* Pointer to the pure area, and its size. */ |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
207 |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
208 static char *purebeg; |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
209 static size_t pure_size; |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
210 |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
211 /* Number of bytes of pure storage used before pure storage overflowed. |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
212 If this is non-zero, this implies that an overflow occurred. */ |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
213 |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
214 static size_t pure_bytes_used_before_overflow; |
300 | 215 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
216 /* Value is non-zero if P points into pure space. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
217 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
218 #define PURE_POINTER_P(P) \ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
219 (((PNTR_COMPARISON_TYPE) (P) \ |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
220 < (PNTR_COMPARISON_TYPE) ((char *) purebeg + pure_size)) \ |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
221 && ((PNTR_COMPARISON_TYPE) (P) \ |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
222 >= (PNTR_COMPARISON_TYPE) purebeg)) |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
223 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
224 /* Index in pure at which next pure object will be allocated.. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
225 |
43713
f92c4d87863a
Change defvar_int def and vars to use EMACS_INT instead of just int.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43314
diff
changeset
|
226 EMACS_INT pure_bytes_used; |
300 | 227 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
228 /* If nonzero, this is a warning delivered by malloc and not yet |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
229 displayed. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
230 |
300 | 231 char *pending_malloc_warning; |
232 | |
6116
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
233 /* Pre-computed signal argument for use when memory is exhausted. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
234 |
46305
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
235 Lisp_Object Vmemory_signal_data; |
6116
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
236 |
300 | 237 /* Maximum amount of C stack to save when a GC happens. */ |
238 | |
239 #ifndef MAX_SAVE_STACK | |
240 #define MAX_SAVE_STACK 16000 | |
241 #endif | |
242 | |
243 /* Buffer in which we save a copy of the C stack at each GC. */ | |
244 | |
245 char *stack_copy; | |
246 int stack_copy_size; | |
247 | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
248 /* Non-zero means ignore malloc warnings. Set during initialization. |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
249 Currently not used. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
250 |
300 | 251 int ignore_warnings; |
1318 | 252 |
13219
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
253 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
|
254 |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
255 /* Hook run after GC has finished. */ |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
256 |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
257 Lisp_Object Vpost_gc_hook, Qpost_gc_hook; |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
258 |
49529
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
259 Lisp_Object Vgc_elapsed; /* accumulated elapsed time in GC */ |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
260 EMACS_INT gcs_done; /* accumulated GCs */ |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
261 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
262 static void mark_buffer P_ ((Lisp_Object)); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
263 static void mark_kboards P_ ((void)); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
264 static void gc_sweep P_ ((void)); |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
265 static void mark_glyph_matrix P_ ((struct glyph_matrix *)); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
266 static void mark_face_cache P_ ((struct face_cache *)); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
267 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
268 #ifdef HAVE_WINDOW_SYSTEM |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
269 static void mark_image P_ ((struct image *)); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
270 static void mark_image_cache P_ ((struct frame *)); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
271 #endif /* HAVE_WINDOW_SYSTEM */ |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
272 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
273 static struct Lisp_String *allocate_string P_ ((void)); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
274 static void compact_small_strings P_ ((void)); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
275 static void free_large_strings P_ ((void)); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
276 static void sweep_strings P_ ((void)); |
20495 | 277 |
278 extern int message_enable_multibyte; | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
279 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
280 /* When scanning the C stack for live Lisp objects, Emacs keeps track |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
281 of what memory allocated via lisp_malloc is intended for what |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
282 purpose. This enumeration specifies the type of memory. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
283 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
284 enum mem_type |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
285 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
286 MEM_TYPE_NON_LISP, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
287 MEM_TYPE_BUFFER, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
288 MEM_TYPE_CONS, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
289 MEM_TYPE_STRING, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
290 MEM_TYPE_MISC, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
291 MEM_TYPE_SYMBOL, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
292 MEM_TYPE_FLOAT, |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
293 /* Keep the following vector-like types together, with |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
294 MEM_TYPE_WINDOW being the last, and MEM_TYPE_VECTOR the |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
295 first. Or change the code of live_vector_p, for instance. */ |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
296 MEM_TYPE_VECTOR, |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
297 MEM_TYPE_PROCESS, |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
298 MEM_TYPE_HASH_TABLE, |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
299 MEM_TYPE_FRAME, |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
300 MEM_TYPE_WINDOW |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
301 }; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
302 |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
303 #if GC_MARK_STACK || defined GC_MALLOC_CHECK |
27746
2556e20596b8
(enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents:
27738
diff
changeset
|
304 |
2556e20596b8
(enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents:
27738
diff
changeset
|
305 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
2556e20596b8
(enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents:
27738
diff
changeset
|
306 #include <stdio.h> /* For fprintf. */ |
2556e20596b8
(enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents:
27738
diff
changeset
|
307 #endif |
2556e20596b8
(enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents:
27738
diff
changeset
|
308 |
2556e20596b8
(enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents:
27738
diff
changeset
|
309 /* A unique object in pure space used to make some Lisp objects |
2556e20596b8
(enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents:
27738
diff
changeset
|
310 on free lists recognizable in O(1). */ |
2556e20596b8
(enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents:
27738
diff
changeset
|
311 |
2556e20596b8
(enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents:
27738
diff
changeset
|
312 Lisp_Object Vdead; |
2556e20596b8
(enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents:
27738
diff
changeset
|
313 |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
314 #ifdef GC_MALLOC_CHECK |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
315 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
316 enum mem_type allocated_mem_type; |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
317 int dont_register_blocks; |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
318 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
319 #endif /* GC_MALLOC_CHECK */ |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
320 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
321 /* A node in the red-black tree describing allocated memory containing |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
322 Lisp data. Each such block is recorded with its start and end |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
323 address when it is allocated, and removed from the tree when it |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
324 is freed. |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
325 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
326 A red-black tree is a balanced binary tree with the following |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
327 properties: |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
328 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
329 1. Every node is either red or black. |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
330 2. Every leaf is black. |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
331 3. If a node is red, then both of its children are black. |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
332 4. Every simple path from a node to a descendant leaf contains |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
333 the same number of black nodes. |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
334 5. The root is always black. |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
335 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
336 When nodes are inserted into the tree, or deleted from the tree, |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
337 the tree is "fixed" so that these properties are always true. |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
338 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
339 A red-black tree with N internal nodes has height at most 2 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
340 log(N+1). Searches, insertions and deletions are done in O(log N). |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
341 Please see a text book about data structures for a detailed |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
342 description of red-black trees. Any book worth its salt should |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
343 describe them. */ |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
344 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
345 struct mem_node |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
346 { |
48907 | 347 /* Children of this node. These pointers are never NULL. When there |
348 is no child, the value is MEM_NIL, which points to a dummy node. */ | |
349 struct mem_node *left, *right; | |
350 | |
351 /* The parent of this node. In the root node, this is NULL. */ | |
352 struct mem_node *parent; | |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
353 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
354 /* Start and end of allocated region. */ |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
355 void *start, *end; |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
356 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
357 /* Node color. */ |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
358 enum {MEM_BLACK, MEM_RED} color; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
359 |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
360 /* Memory type. */ |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
361 enum mem_type type; |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
362 }; |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
363 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
364 /* Base address of stack. Set in main. */ |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
365 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
366 Lisp_Object *stack_base; |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
367 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
368 /* Root of the tree describing allocated Lisp memory. */ |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
369 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
370 static struct mem_node *mem_root; |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
371 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
372 /* Lowest and highest known address in the heap. */ |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
373 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
374 static void *min_heap_address, *max_heap_address; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
375 |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
376 /* Sentinel node of the tree. */ |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
377 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
378 static struct mem_node mem_z; |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
379 #define MEM_NIL &mem_z |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
380 |
30914
6362b1fc09f2
(lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
30823
diff
changeset
|
381 static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type)); |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
382 static struct Lisp_Vector *allocate_vectorlike P_ ((EMACS_INT, enum mem_type)); |
30784
dbc1e69a89a9
[HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents:
30557
diff
changeset
|
383 static void lisp_free P_ ((POINTER_TYPE *)); |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
384 static void mark_stack P_ ((void)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
385 static int live_vector_p P_ ((struct mem_node *, void *)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
386 static int live_buffer_p P_ ((struct mem_node *, void *)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
387 static int live_string_p P_ ((struct mem_node *, void *)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
388 static int live_cons_p P_ ((struct mem_node *, void *)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
389 static int live_symbol_p P_ ((struct mem_node *, void *)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
390 static int live_float_p P_ ((struct mem_node *, void *)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
391 static int live_misc_p P_ ((struct mem_node *, void *)); |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
392 static void mark_maybe_object P_ ((Lisp_Object)); |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
393 static void mark_memory P_ ((void *, void *)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
394 static void mem_init P_ ((void)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
395 static struct mem_node *mem_insert P_ ((void *, void *, enum mem_type)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
396 static void mem_insert_fixup P_ ((struct mem_node *)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
397 static void mem_rotate_left P_ ((struct mem_node *)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
398 static void mem_rotate_right P_ ((struct mem_node *)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
399 static void mem_delete P_ ((struct mem_node *)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
400 static void mem_delete_fixup P_ ((struct mem_node *)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
401 static INLINE struct mem_node *mem_find P_ ((void *)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
402 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
403 #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
404 static void check_gcpros P_ ((void)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
405 #endif |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
406 |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
407 #endif /* GC_MARK_STACK || GC_MALLOC_CHECK */ |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
408 |
32594
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
409 /* Recording what needs to be marked for gc. */ |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
410 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
411 struct gcpro *gcprolist; |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
412 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
413 /* Addresses of staticpro'd variables. */ |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
414 |
43313
32f59a921eb9
(NSTATICS): Increase to 1280.
Andreas Schwab <schwab@suse.de>
parents:
43302
diff
changeset
|
415 #define NSTATICS 1280 |
32594
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
416 Lisp_Object *staticvec[NSTATICS] = {0}; |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
417 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
418 /* Index of next unused slot in staticvec. */ |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
419 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
420 int staticidx = 0; |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
421 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
422 static POINTER_TYPE *pure_alloc P_ ((size_t, int)); |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
423 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
424 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
425 /* Value is SZ rounded up to the next multiple of ALIGNMENT. |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
426 ALIGNMENT must be a power of 2. */ |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
427 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
428 #define ALIGN(SZ, ALIGNMENT) \ |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
429 (((SZ) + (ALIGNMENT) - 1) & ~((ALIGNMENT) - 1)) |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
430 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
431 |
300 | 432 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
433 /************************************************************************ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
434 Malloc |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
435 ************************************************************************/ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
436 |
47185
2ff45b08a155
(display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents:
46833
diff
changeset
|
437 /* Function 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
|
438 |
1dd0bd0749b5
(malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents:
20057
diff
changeset
|
439 void |
300 | 440 malloc_warning (str) |
441 char *str; | |
442 { | |
443 pending_malloc_warning = str; | |
444 } | |
445 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
446 |
47185
2ff45b08a155
(display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents:
46833
diff
changeset
|
447 /* Display an already-pending malloc warning. */ |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
448 |
20375
1dd0bd0749b5
(malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents:
20057
diff
changeset
|
449 void |
300 | 450 display_malloc_warning () |
451 { | |
47185
2ff45b08a155
(display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents:
46833
diff
changeset
|
452 call3 (intern ("display-warning"), |
2ff45b08a155
(display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents:
46833
diff
changeset
|
453 intern ("alloc"), |
2ff45b08a155
(display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents:
46833
diff
changeset
|
454 build_string (pending_malloc_warning), |
2ff45b08a155
(display_malloc_warning): Use display-warning.
Richard M. Stallman <rms@gnu.org>
parents:
46833
diff
changeset
|
455 intern ("emergency")); |
300 | 456 pending_malloc_warning = 0; |
457 } | |
458 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
459 |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
460 #ifdef DOUG_LEA_MALLOC |
17831
9238a2254a23
(BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents:
17348
diff
changeset
|
461 # 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
|
462 #else |
17831
9238a2254a23
(BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents:
17348
diff
changeset
|
463 # 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
|
464 #endif |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
465 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
466 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
467 /* 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
|
468 |
20375
1dd0bd0749b5
(malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents:
20057
diff
changeset
|
469 void |
300 | 470 memory_full () |
471 { | |
46305
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
472 Vmemory_full = Qt; |
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
473 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
474 #ifndef SYSTEM_MALLOC |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
475 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
|
476 #endif |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
477 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
478 /* 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
|
479 if (spare_memory) |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
480 { |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
481 free (spare_memory); |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
482 spare_memory = 0; |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
483 } |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
484 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
485 /* This used to call error, but if we've run out of memory, we could |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
486 get infinite recursion trying to build the string. */ |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
487 while (1) |
46305
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
488 Fsignal (Qnil, Vmemory_signal_data); |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
489 } |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
490 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
491 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
492 /* 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
|
493 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
494 void |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
495 buffer_memory_full () |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
496 { |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
497 /* If buffers use the relocating allocator, no need to free |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
498 spare_memory, because we may have plenty of malloc space left |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
499 that we could get, and if we don't, the malloc that fails will |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
500 itself cause spare_memory to be freed. If buffers don't use the |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
501 relocating allocator, treat this like any other failing |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
502 malloc. */ |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
503 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
504 #ifndef REL_ALLOC |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
505 memory_full (); |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
506 #endif |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
507 |
46305
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
508 Vmemory_full = Qt; |
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
509 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
510 /* This used to call error, but if we've run out of memory, we could |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
511 get infinite recursion trying to build the string. */ |
6116
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
512 while (1) |
46305
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
513 Fsignal (Qnil, Vmemory_signal_data); |
300 | 514 } |
515 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
516 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
517 /* Like malloc but check for no memory and block interrupt input.. */ |
300 | 518 |
29781
4a3b0c2cbcd5
(xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
29743
diff
changeset
|
519 POINTER_TYPE * |
300 | 520 xmalloc (size) |
30557
5056adb52e97
(lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents:
30317
diff
changeset
|
521 size_t size; |
300 | 522 { |
29781
4a3b0c2cbcd5
(xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
29743
diff
changeset
|
523 register POINTER_TYPE *val; |
300 | 524 |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
525 BLOCK_INPUT; |
29781
4a3b0c2cbcd5
(xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
29743
diff
changeset
|
526 val = (POINTER_TYPE *) malloc (size); |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
527 UNBLOCK_INPUT; |
300 | 528 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
529 if (!val && size) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
530 memory_full (); |
300 | 531 return val; |
532 } | |
533 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
534 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
535 /* Like realloc but check for no memory and block interrupt input.. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
536 |
29781
4a3b0c2cbcd5
(xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
29743
diff
changeset
|
537 POINTER_TYPE * |
300 | 538 xrealloc (block, size) |
29781
4a3b0c2cbcd5
(xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
29743
diff
changeset
|
539 POINTER_TYPE *block; |
30557
5056adb52e97
(lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents:
30317
diff
changeset
|
540 size_t size; |
300 | 541 { |
29781
4a3b0c2cbcd5
(xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
29743
diff
changeset
|
542 register POINTER_TYPE *val; |
300 | 543 |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
544 BLOCK_INPUT; |
590 | 545 /* We must call malloc explicitly when BLOCK is 0, since some |
546 reallocs don't do this. */ | |
547 if (! block) | |
29781
4a3b0c2cbcd5
(xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
29743
diff
changeset
|
548 val = (POINTER_TYPE *) malloc (size); |
600
a8d78999e46d
*** empty log message ***
Noah Friedman <friedman@splode.com>
parents:
590
diff
changeset
|
549 else |
29781
4a3b0c2cbcd5
(xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
29743
diff
changeset
|
550 val = (POINTER_TYPE *) 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
|
551 UNBLOCK_INPUT; |
300 | 552 |
553 if (!val && size) memory_full (); | |
554 return val; | |
555 } | |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
556 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
557 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
558 /* Like free but block interrupt input.. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
559 |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
560 void |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
561 xfree (block) |
29781
4a3b0c2cbcd5
(xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
29743
diff
changeset
|
562 POINTER_TYPE *block; |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
563 { |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
564 BLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
565 free (block); |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
566 UNBLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
567 } |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
568 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
569 |
28411
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
570 /* Like strdup, but uses xmalloc. */ |
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
571 |
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
572 char * |
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
573 xstrdup (s) |
46459
0a9cbcbdbe45
(xstrdup, make_string, make_unibyte_string)
Ken Raeburn <raeburn@raeburn.org>
parents:
46418
diff
changeset
|
574 const char *s; |
28411
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
575 { |
30557
5056adb52e97
(lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents:
30317
diff
changeset
|
576 size_t len = strlen (s) + 1; |
28411
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
577 char *p = (char *) xmalloc (len); |
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
578 bcopy (s, p, len); |
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
579 return p; |
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
580 } |
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
581 |
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
582 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
583 /* Like malloc but used for allocating Lisp data. NBYTES is the |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
584 number of bytes to allocate, TYPE describes the intended use of the |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
585 allcated memory block (for strings, for conses, ...). */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
586 |
30557
5056adb52e97
(lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents:
30317
diff
changeset
|
587 static POINTER_TYPE * |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
588 lisp_malloc (nbytes, type) |
30557
5056adb52e97
(lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents:
30317
diff
changeset
|
589 size_t nbytes; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
590 enum mem_type type; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
591 { |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
592 register void *val; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
593 |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
594 BLOCK_INPUT; |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
595 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
596 #ifdef GC_MALLOC_CHECK |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
597 allocated_mem_type = type; |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
598 #endif |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
599 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
600 val = (void *) malloc (nbytes); |
28411
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
601 |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
602 #if GC_MARK_STACK && !defined GC_MALLOC_CHECK |
28411
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
603 if (val && type != MEM_TYPE_NON_LISP) |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
604 mem_insert (val, (char *) val + nbytes, type); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
605 #endif |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
606 |
28411
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
607 UNBLOCK_INPUT; |
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
608 if (!val && nbytes) |
ecba29fa0198
(xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents:
28406
diff
changeset
|
609 memory_full (); |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
610 return val; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
611 } |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
612 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
613 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
614 /* Return a new buffer structure allocated from the heap with |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
615 a call to lisp_malloc. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
616 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
617 struct buffer * |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
618 allocate_buffer () |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
619 { |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
620 struct buffer *b |
39228
fcb8e48eec89
allocate_buffer): Call VALIDATE_LISP_STORAGE.
Gerd Moellmann <gerd@gnu.org>
parents:
38696
diff
changeset
|
621 = (struct buffer *) lisp_malloc (sizeof (struct buffer), |
fcb8e48eec89
allocate_buffer): Call VALIDATE_LISP_STORAGE.
Gerd Moellmann <gerd@gnu.org>
parents:
38696
diff
changeset
|
622 MEM_TYPE_BUFFER); |
fcb8e48eec89
allocate_buffer): Call VALIDATE_LISP_STORAGE.
Gerd Moellmann <gerd@gnu.org>
parents:
38696
diff
changeset
|
623 VALIDATE_LISP_STORAGE (b, sizeof *b); |
fcb8e48eec89
allocate_buffer): Call VALIDATE_LISP_STORAGE.
Gerd Moellmann <gerd@gnu.org>
parents:
38696
diff
changeset
|
624 return b; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
625 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
626 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
627 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
628 /* Free BLOCK. This must be called to free memory allocated with a |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
629 call to lisp_malloc. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
630 |
30784
dbc1e69a89a9
[HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents:
30557
diff
changeset
|
631 static void |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
632 lisp_free (block) |
30557
5056adb52e97
(lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents:
30317
diff
changeset
|
633 POINTER_TYPE *block; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
634 { |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
635 BLOCK_INPUT; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
636 free (block); |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
637 #if GC_MARK_STACK && !defined GC_MALLOC_CHECK |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
638 mem_delete (mem_find (block)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
639 #endif |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
640 UNBLOCK_INPUT; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
641 } |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
642 |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
643 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
644 /* 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
|
645 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
646 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
|
647 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
|
648 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
|
649 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
|
650 might call malloc, so we can't really protect them unless you're |
49529
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
651 using GNU malloc. Fortunately, most of the major operating systems |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
652 can use GNU malloc. */ |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
653 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
654 #ifndef SYSTEM_MALLOC |
30914
6362b1fc09f2
(lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
30823
diff
changeset
|
655 #ifndef DOUG_LEA_MALLOC |
6362b1fc09f2
(lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
30823
diff
changeset
|
656 extern void * (*__malloc_hook) P_ ((size_t)); |
6362b1fc09f2
(lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
30823
diff
changeset
|
657 extern void * (*__realloc_hook) P_ ((void *, size_t)); |
6362b1fc09f2
(lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
30823
diff
changeset
|
658 extern void (*__free_hook) P_ ((void *)); |
6362b1fc09f2
(lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
30823
diff
changeset
|
659 /* Else declared in malloc.h, perhaps with an extra arg. */ |
6362b1fc09f2
(lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents:
30823
diff
changeset
|
660 #endif /* DOUG_LEA_MALLOC */ |
2507
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
661 static void * (*old_malloc_hook) (); |
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
662 static void * (*old_realloc_hook) (); |
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
663 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
|
664 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
665 /* 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
|
666 |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
667 static void |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
668 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
|
669 void *ptr; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
670 { |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
671 BLOCK_INPUT; |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
672 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
673 #ifdef GC_MALLOC_CHECK |
32776
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
674 if (ptr) |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
675 { |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
676 struct mem_node *m; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
677 |
32776
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
678 m = mem_find (ptr); |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
679 if (m == MEM_NIL || m->start != ptr) |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
680 { |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
681 fprintf (stderr, |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
682 "Freeing `%p' which wasn't allocated with malloc\n", ptr); |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
683 abort (); |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
684 } |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
685 else |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
686 { |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
687 /* fprintf (stderr, "free %p...%p (%p)\n", m->start, m->end, ptr); */ |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
688 mem_delete (m); |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
689 } |
416924b6f303
(emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents:
32700
diff
changeset
|
690 } |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
691 #endif /* GC_MALLOC_CHECK */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
692 |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
693 __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
|
694 free (ptr); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
695 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
696 /* 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
|
697 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
|
698 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
|
699 if (spare_memory == 0 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
700 /* 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
|
701 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
|
702 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
|
703 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
|
704 && (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
|
705 > BYTES_USED + max (malloc_hysteresis, 4) * SPARE_MEMORY)) |
30557
5056adb52e97
(lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents:
30317
diff
changeset
|
706 spare_memory = (char *) malloc ((size_t) SPARE_MEMORY); |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
707 |
2507
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
708 __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
|
709 UNBLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
710 } |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
711 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
712 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
713 /* 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
|
714 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
|
715 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
|
716 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
717 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
|
718 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
719 void |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
720 refill_memory_reserve () |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
721 { |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
722 if (spare_memory == 0) |
30557
5056adb52e97
(lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents:
30317
diff
changeset
|
723 spare_memory = (char *) malloc ((size_t) SPARE_MEMORY); |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
724 } |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
725 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
726 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
727 /* 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
|
728 |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
729 static void * |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
730 emacs_blocked_malloc (size) |
30557
5056adb52e97
(lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents:
30317
diff
changeset
|
731 size_t size; |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
732 { |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
733 void *value; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
734 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
735 BLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
736 __malloc_hook = old_malloc_hook; |
17831
9238a2254a23
(BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents:
17348
diff
changeset
|
737 #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
|
738 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
|
739 #else |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
740 __malloc_extra_blocks = malloc_hysteresis; |
17831
9238a2254a23
(BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents:
17348
diff
changeset
|
741 #endif |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
742 |
3581
152fd924c7bb
* alloc.c (emacs_blocked_malloc, emacs_blocked_realloc): Cast the
Jim Blandy <jimb@redhat.com>
parents:
3536
diff
changeset
|
743 value = (void *) malloc (size); |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
744 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
745 #ifdef GC_MALLOC_CHECK |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
746 { |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
747 struct mem_node *m = mem_find (value); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
748 if (m != MEM_NIL) |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
749 { |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
750 fprintf (stderr, "Malloc returned %p which is already in use\n", |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
751 value); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
752 fprintf (stderr, "Region in use is %p...%p, %u bytes, type %d\n", |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
753 m->start, m->end, (char *) m->end - (char *) m->start, |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
754 m->type); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
755 abort (); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
756 } |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
757 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
758 if (!dont_register_blocks) |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
759 { |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
760 mem_insert (value, (char *) value + max (1, size), allocated_mem_type); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
761 allocated_mem_type = MEM_TYPE_NON_LISP; |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
762 } |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
763 } |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
764 #endif /* GC_MALLOC_CHECK */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
765 |
2507
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
766 __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
|
767 UNBLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
768 |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
769 /* fprintf (stderr, "%p malloc\n", value); */ |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
770 return value; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
771 } |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
772 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
773 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
774 /* This function is the realloc hook that Emacs uses. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
775 |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
776 static void * |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
777 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
|
778 void *ptr; |
30557
5056adb52e97
(lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents:
30317
diff
changeset
|
779 size_t size; |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
780 { |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
781 void *value; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
782 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
783 BLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
784 __realloc_hook = old_realloc_hook; |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
785 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
786 #ifdef GC_MALLOC_CHECK |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
787 if (ptr) |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
788 { |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
789 struct mem_node *m = mem_find (ptr); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
790 if (m == MEM_NIL || m->start != ptr) |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
791 { |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
792 fprintf (stderr, |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
793 "Realloc of %p which wasn't allocated with malloc\n", |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
794 ptr); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
795 abort (); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
796 } |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
797 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
798 mem_delete (m); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
799 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
800 |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
801 /* fprintf (stderr, "%p -> realloc\n", ptr); */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
802 |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
803 /* Prevent malloc from registering blocks. */ |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
804 dont_register_blocks = 1; |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
805 #endif /* GC_MALLOC_CHECK */ |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
806 |
3581
152fd924c7bb
* alloc.c (emacs_blocked_malloc, emacs_blocked_realloc): Cast the
Jim Blandy <jimb@redhat.com>
parents:
3536
diff
changeset
|
807 value = (void *) realloc (ptr, size); |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
808 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
809 #ifdef GC_MALLOC_CHECK |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
810 dont_register_blocks = 0; |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
811 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
812 { |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
813 struct mem_node *m = mem_find (value); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
814 if (m != MEM_NIL) |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
815 { |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
816 fprintf (stderr, "Realloc returns memory that is already in use\n"); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
817 abort (); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
818 } |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
819 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
820 /* Can't handle zero size regions in the red-black tree. */ |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
821 mem_insert (value, (char *) value + max (size, 1), MEM_TYPE_NON_LISP); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
822 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
823 |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
824 /* fprintf (stderr, "%p <- realloc\n", value); */ |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
825 #endif /* GC_MALLOC_CHECK */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
826 |
2507
7ba4316ae840
* alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents:
2439
diff
changeset
|
827 __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
|
828 UNBLOCK_INPUT; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
829 |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
830 return value; |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
831 } |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
832 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
833 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
834 /* Called from main to set up malloc to use our hooks. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
835 |
2439
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
836 void |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
837 uninterrupt_malloc () |
b6c62e4abf59
Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents:
2370
diff
changeset
|
838 { |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
839 if (__free_hook != emacs_blocked_free) |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
840 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
|
841 __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
|
842 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
843 if (__malloc_hook != emacs_blocked_malloc) |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
844 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
|
845 __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
|
846 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
847 if (__realloc_hook != emacs_blocked_realloc) |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
848 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
|
849 __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
|
850 } |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
851 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
852 #endif /* not SYSTEM_MALLOC */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
853 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
854 |
300 | 855 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
856 /*********************************************************************** |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
857 Interval Allocation |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
858 ***********************************************************************/ |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
859 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
860 /* Number of intervals allocated in an interval_block structure. |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
861 The 1020 is 1024 minus malloc overhead. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
862 |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
863 #define INTERVAL_BLOCK_SIZE \ |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
864 ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval)) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
865 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
866 /* Intervals are allocated in chunks in form of an interval_block |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
867 structure. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
868 |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
869 struct interval_block |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
870 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
871 struct interval_block *next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
872 struct interval intervals[INTERVAL_BLOCK_SIZE]; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
873 }; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
874 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
875 /* Current interval block. Its `next' pointer points to older |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
876 blocks. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
877 |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
878 struct interval_block *interval_block; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
879 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
880 /* Index in interval_block above of the next unused interval |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
881 structure. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
882 |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
883 static int interval_block_index; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
884 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
885 /* Number of free and live intervals. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
886 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
887 static int total_free_intervals, total_intervals; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
888 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
889 /* List of free intervals. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
890 |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
891 INTERVAL interval_free_list; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
892 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
893 /* Total number of interval blocks now in use. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
894 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
895 int n_interval_blocks; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
896 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
897 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
898 /* Initialize interval allocation. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
899 |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
900 static void |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
901 init_intervals () |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
902 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
903 interval_block |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
904 = (struct interval_block *) lisp_malloc (sizeof *interval_block, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
905 MEM_TYPE_NON_LISP); |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
906 interval_block->next = 0; |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
907 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
|
908 interval_block_index = 0; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
909 interval_free_list = 0; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
910 n_interval_blocks = 1; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
911 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
912 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
913 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
914 /* Return a new interval. */ |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
915 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
916 INTERVAL |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
917 make_interval () |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
918 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
919 INTERVAL val; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
920 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
921 if (interval_free_list) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
922 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
923 val = interval_free_list; |
28269
fd13be8ae190
Changes towards better type safety regarding intervals, primarily
Ken Raeburn <raeburn@raeburn.org>
parents:
28220
diff
changeset
|
924 interval_free_list = INTERVAL_PARENT (interval_free_list); |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
925 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
926 else |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
927 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
928 if (interval_block_index == INTERVAL_BLOCK_SIZE) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
929 { |
12529 | 930 register struct interval_block *newi; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
931 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
932 newi = (struct interval_block *) lisp_malloc (sizeof *newi, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
933 MEM_TYPE_NON_LISP); |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
934 |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
935 VALIDATE_LISP_STORAGE (newi, sizeof *newi); |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
936 newi->next = interval_block; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
937 interval_block = newi; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
938 interval_block_index = 0; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
939 n_interval_blocks++; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
940 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
941 val = &interval_block->intervals[interval_block_index++]; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
942 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
943 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
|
944 intervals_consed++; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
945 RESET_INTERVAL (val); |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
946 return val; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
947 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
948 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
949 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
950 /* Mark Lisp objects in interval I. */ |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
951 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
952 static void |
1957
54c8c66cd9ac
(mark_interval): Add ignored arg.
Richard M. Stallman <rms@gnu.org>
parents:
1939
diff
changeset
|
953 mark_interval (i, dummy) |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
954 register INTERVAL i; |
1957
54c8c66cd9ac
(mark_interval): Add ignored arg.
Richard M. Stallman <rms@gnu.org>
parents:
1939
diff
changeset
|
955 Lisp_Object dummy; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
956 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
957 if (XMARKBIT (i->plist)) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
958 abort (); |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
959 mark_object (&i->plist); |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
960 XMARK (i->plist); |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
961 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
962 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
963 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
964 /* Mark the interval tree rooted in TREE. Don't call this directly; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
965 use the macro MARK_INTERVAL_TREE instead. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
966 |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
967 static void |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
968 mark_interval_tree (tree) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
969 register INTERVAL tree; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
970 { |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
971 /* 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
|
972 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
|
973 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
|
974 |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
975 /* 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
|
976 a cast. */ |
28406
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
977 XMARK (tree->up.obj); |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
978 |
39859
36068b62b4c1
(mark_interval_tree): Use traverse_intervals_noorder.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39682
diff
changeset
|
979 traverse_intervals_noorder (tree, mark_interval, Qnil); |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
980 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
981 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
982 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
983 /* Mark the interval tree rooted in I. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
984 |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
985 #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
|
986 do { \ |
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
987 if (!NULL_INTERVAL_P (i) \ |
28406
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
988 && ! XMARKBIT (i->up.obj)) \ |
4139
0b32ee899a3a
Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents:
4087
diff
changeset
|
989 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
|
990 } while (0) |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
991 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
992 |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
993 /* The oddity in the call to XUNMARK is necessary because XUNMARK |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
994 expands to an assignment to its argument, and most C compilers |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
995 don't support casts on the left operand of `='. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
996 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
997 #define UNMARK_BALANCE_INTERVALS(i) \ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
998 do { \ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
999 if (! NULL_INTERVAL_P (i)) \ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1000 { \ |
28406
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
1001 XUNMARK ((i)->up.obj); \ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1002 (i) = balance_intervals (i); \ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1003 } \ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1004 } while (0) |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
1005 |
28469
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1006 |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1007 /* Number support. If NO_UNION_TYPE isn't in effect, we |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1008 can't create number objects in macros. */ |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1009 #ifndef make_number |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1010 Lisp_Object |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1011 make_number (n) |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1012 int n; |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1013 { |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1014 Lisp_Object obj; |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1015 obj.s.val = n; |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1016 obj.s.type = Lisp_Int; |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1017 return obj; |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1018 } |
f66f2b4d5eb7
* alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents:
28411
diff
changeset
|
1019 #endif |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
1020 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1021 /*********************************************************************** |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1022 String Allocation |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1023 ***********************************************************************/ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1024 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1025 /* Lisp_Strings are allocated in string_block structures. When a new |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1026 string_block is allocated, all the Lisp_Strings it contains are |
41831
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
1027 added to a free-list string_free_list. When a new Lisp_String is |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1028 needed, it is taken from that list. During the sweep phase of GC, |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1029 string_blocks that are entirely free are freed, except two which |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1030 we keep. |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1031 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1032 String data is allocated from sblock structures. Strings larger |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1033 than LARGE_STRING_BYTES, get their own sblock, data for smaller |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1034 strings is sub-allocated out of sblocks of size SBLOCK_SIZE. |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1035 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1036 Sblocks consist internally of sdata structures, one for each |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1037 Lisp_String. The sdata structure points to the Lisp_String it |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1038 belongs to. The Lisp_String points back to the `u.data' member of |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1039 its sdata structure. |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1040 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1041 When a Lisp_String is freed during GC, it is put back on |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1042 string_free_list, and its `data' member and its sdata's `string' |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1043 pointer is set to null. The size of the string is recorded in the |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1044 `u.nbytes' member of the sdata. So, sdata structures that are no |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1045 longer used, can be easily recognized, and it's easy to compact the |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1046 sblocks of small strings which we do in compact_small_strings. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1047 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1048 /* Size in bytes of an sblock structure used for small strings. This |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1049 is 8192 minus malloc overhead. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1050 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1051 #define SBLOCK_SIZE 8188 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1052 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1053 /* Strings larger than this are considered large strings. String data |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1054 for large strings is allocated from individual sblocks. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1055 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1056 #define LARGE_STRING_BYTES 1024 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1057 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1058 /* Structure describing string memory sub-allocated from an sblock. |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1059 This is where the contents of Lisp strings are stored. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1060 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1061 struct sdata |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1062 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1063 /* Back-pointer to the string this sdata belongs to. If null, this |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1064 structure is free, and the NBYTES member of the union below |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1065 contains the string's byte size (the same value that STRING_BYTES |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1066 would return if STRING were non-null). If non-null, STRING_BYTES |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1067 (STRING) is the size of the data, and DATA contains the string's |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1068 contents. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1069 struct Lisp_String *string; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1070 |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1071 #ifdef GC_CHECK_STRING_BYTES |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1072 |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1073 EMACS_INT nbytes; |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1074 unsigned char data[1]; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1075 |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1076 #define SDATA_NBYTES(S) (S)->nbytes |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1077 #define SDATA_DATA(S) (S)->data |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1078 |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1079 #else /* not GC_CHECK_STRING_BYTES */ |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1080 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1081 union |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1082 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1083 /* When STRING in non-null. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1084 unsigned char data[1]; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1085 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1086 /* When STRING is null. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1087 EMACS_INT nbytes; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1088 } u; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1089 |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1090 |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1091 #define SDATA_NBYTES(S) (S)->u.nbytes |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1092 #define SDATA_DATA(S) (S)->u.data |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1093 |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1094 #endif /* not GC_CHECK_STRING_BYTES */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1095 }; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1096 |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1097 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1098 /* Structure describing a block of memory which is sub-allocated to |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1099 obtain string data memory for strings. Blocks for small strings |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1100 are of fixed size SBLOCK_SIZE. Blocks for large strings are made |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1101 as large as needed. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1102 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1103 struct sblock |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1104 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1105 /* Next in list. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1106 struct sblock *next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1107 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1108 /* Pointer to the next free sdata block. This points past the end |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1109 of the sblock if there isn't any space left in this block. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1110 struct sdata *next_free; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1111 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1112 /* Start of data. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1113 struct sdata first_data; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1114 }; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1115 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1116 /* Number of Lisp strings in a string_block structure. The 1020 is |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1117 1024 minus malloc overhead. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1118 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1119 #define STRINGS_IN_STRING_BLOCK \ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1120 ((1020 - sizeof (struct string_block *)) / sizeof (struct Lisp_String)) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1121 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1122 /* Structure describing a block from which Lisp_String structures |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1123 are allocated. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1124 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1125 struct string_block |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1126 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1127 struct string_block *next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1128 struct Lisp_String strings[STRINGS_IN_STRING_BLOCK]; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1129 }; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1130 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1131 /* Head and tail of the list of sblock structures holding Lisp string |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1132 data. We always allocate from current_sblock. The NEXT pointers |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1133 in the sblock structures go from oldest_sblock to current_sblock. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1134 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1135 static struct sblock *oldest_sblock, *current_sblock; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1136 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1137 /* List of sblocks for large strings. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1138 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1139 static struct sblock *large_sblocks; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1140 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1141 /* List of string_block structures, and how many there are. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1142 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1143 static struct string_block *string_blocks; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1144 static int n_string_blocks; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1145 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1146 /* Free-list of Lisp_Strings. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1147 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1148 static struct Lisp_String *string_free_list; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1149 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1150 /* Number of live and free Lisp_Strings. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1151 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1152 static int total_strings, total_free_strings; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1153 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1154 /* Number of bytes used by live strings. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1155 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1156 static int total_string_size; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1157 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1158 /* Given a pointer to a Lisp_String S which is on the free-list |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1159 string_free_list, return a pointer to its successor in the |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1160 free-list. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1161 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1162 #define NEXT_FREE_LISP_STRING(S) (*(struct Lisp_String **) (S)) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1163 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1164 /* Return a pointer to the sdata structure belonging to Lisp string S. |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1165 S must be live, i.e. S->data must not be null. S->data is actually |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1166 a pointer to the `u.data' member of its sdata structure; the |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1167 structure starts at a constant offset in front of that. */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1168 |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1169 #ifdef GC_CHECK_STRING_BYTES |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1170 |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1171 #define SDATA_OF_STRING(S) \ |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1172 ((struct sdata *) ((S)->data - sizeof (struct Lisp_String *) \ |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1173 - sizeof (EMACS_INT))) |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1174 |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1175 #else /* not GC_CHECK_STRING_BYTES */ |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1176 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1177 #define SDATA_OF_STRING(S) \ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1178 ((struct sdata *) ((S)->data - sizeof (struct Lisp_String *))) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1179 |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1180 #endif /* not GC_CHECK_STRING_BYTES */ |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1181 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1182 /* Value is the size of an sdata structure large enough to hold NBYTES |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1183 bytes of string data. The value returned includes a terminating |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1184 NUL byte, the size of the sdata structure, and padding. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1185 |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1186 #ifdef GC_CHECK_STRING_BYTES |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1187 |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1188 #define SDATA_SIZE(NBYTES) \ |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1189 ((sizeof (struct Lisp_String *) \ |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1190 + (NBYTES) + 1 \ |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1191 + sizeof (EMACS_INT) \ |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1192 + sizeof (EMACS_INT) - 1) \ |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1193 & ~(sizeof (EMACS_INT) - 1)) |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1194 |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1195 #else /* not GC_CHECK_STRING_BYTES */ |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1196 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1197 #define SDATA_SIZE(NBYTES) \ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1198 ((sizeof (struct Lisp_String *) \ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1199 + (NBYTES) + 1 \ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1200 + sizeof (EMACS_INT) - 1) \ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1201 & ~(sizeof (EMACS_INT) - 1)) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1202 |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1203 #endif /* not GC_CHECK_STRING_BYTES */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1204 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1205 /* Initialize string allocation. Called from init_alloc_once. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1206 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1207 void |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1208 init_strings () |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1209 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1210 total_strings = total_free_strings = total_string_size = 0; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1211 oldest_sblock = current_sblock = large_sblocks = NULL; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1212 string_blocks = NULL; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1213 n_string_blocks = 0; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1214 string_free_list = NULL; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1215 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1216 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1217 |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1218 #ifdef GC_CHECK_STRING_BYTES |
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1219 |
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1220 static int check_string_bytes_count; |
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1221 |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1222 void check_string_bytes P_ ((int)); |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1223 void check_sblock P_ ((struct sblock *)); |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1224 |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1225 #define CHECK_STRING_BYTES(S) STRING_BYTES (S) |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1226 |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1227 |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1228 /* Like GC_STRING_BYTES, but with debugging check. */ |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1229 |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1230 int |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1231 string_bytes (s) |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1232 struct Lisp_String *s; |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1233 { |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1234 int nbytes = (s->size_byte < 0 ? s->size : s->size_byte) & ~MARKBIT; |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1235 if (!PURE_POINTER_P (s) |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1236 && s->data |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1237 && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1238 abort (); |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1239 return nbytes; |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1240 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1241 |
49529
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
1242 /* Check validity of Lisp strings' string_bytes member in B. */ |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1243 |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1244 void |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1245 check_sblock (b) |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1246 struct sblock *b; |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1247 { |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1248 struct sdata *from, *end, *from_end; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1249 |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1250 end = b->next_free; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1251 |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1252 for (from = &b->first_data; from < end; from = from_end) |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1253 { |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1254 /* Compute the next FROM here because copying below may |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1255 overwrite data we need to compute it. */ |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1256 int nbytes; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1257 |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1258 /* Check that the string size recorded in the string is the |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1259 same as the one recorded in the sdata structure. */ |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1260 if (from->string) |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1261 CHECK_STRING_BYTES (from->string); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1262 |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1263 if (from->string) |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1264 nbytes = GC_STRING_BYTES (from->string); |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1265 else |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1266 nbytes = SDATA_NBYTES (from); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1267 |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1268 nbytes = SDATA_SIZE (nbytes); |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1269 from_end = (struct sdata *) ((char *) from + nbytes); |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1270 } |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1271 } |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1272 |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1273 |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1274 /* Check validity of Lisp strings' string_bytes member. ALL_P |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1275 non-zero means check all strings, otherwise check only most |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1276 recently allocated strings. Used for hunting a bug. */ |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1277 |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1278 void |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1279 check_string_bytes (all_p) |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1280 int all_p; |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1281 { |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1282 if (all_p) |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1283 { |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1284 struct sblock *b; |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1285 |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1286 for (b = large_sblocks; b; b = b->next) |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1287 { |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1288 struct Lisp_String *s = b->first_data.string; |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1289 if (s) |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1290 CHECK_STRING_BYTES (s); |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1291 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1292 |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1293 for (b = oldest_sblock; b; b = b->next) |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1294 check_sblock (b); |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1295 } |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1296 else |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1297 check_sblock (current_sblock); |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1298 } |
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1299 |
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1300 #endif /* GC_CHECK_STRING_BYTES */ |
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1301 |
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1302 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1303 /* Return a new Lisp_String. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1304 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1305 static struct Lisp_String * |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1306 allocate_string () |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1307 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1308 struct Lisp_String *s; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1309 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1310 /* If the free-list is empty, allocate a new string_block, and |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1311 add all the Lisp_Strings in it to the free-list. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1312 if (string_free_list == NULL) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1313 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1314 struct string_block *b; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1315 int i; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1316 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1317 b = (struct string_block *) lisp_malloc (sizeof *b, MEM_TYPE_STRING); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1318 VALIDATE_LISP_STORAGE (b, sizeof *b); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1319 bzero (b, sizeof *b); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1320 b->next = string_blocks; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1321 string_blocks = b; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1322 ++n_string_blocks; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1323 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1324 for (i = STRINGS_IN_STRING_BLOCK - 1; i >= 0; --i) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1325 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1326 s = b->strings + i; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1327 NEXT_FREE_LISP_STRING (s) = string_free_list; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1328 string_free_list = s; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1329 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1330 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1331 total_free_strings += STRINGS_IN_STRING_BLOCK; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1332 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1333 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1334 /* Pop a Lisp_String off the free-list. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1335 s = string_free_list; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1336 string_free_list = NEXT_FREE_LISP_STRING (s); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1337 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1338 /* Probably not strictly necessary, but play it safe. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1339 bzero (s, sizeof *s); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1340 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1341 --total_free_strings; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1342 ++total_strings; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1343 ++strings_consed; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1344 consing_since_gc += sizeof *s; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1345 |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1346 #ifdef GC_CHECK_STRING_BYTES |
35660
b9366f467430
* alloc.c (allocate_string) [macintosh]: Call check_string_bytes
Andrew Choi <akochoi@shaw.ca>
parents:
35183
diff
changeset
|
1347 if (!noninteractive |
44890
01b93e5e53a7
Patch for building Emacs on Mac OS X. April 26, 2002. See ChangeLog,
Andrew Choi <akochoi@shaw.ca>
parents:
44149
diff
changeset
|
1348 #ifdef MAC_OS8 |
35660
b9366f467430
* alloc.c (allocate_string) [macintosh]: Call check_string_bytes
Andrew Choi <akochoi@shaw.ca>
parents:
35183
diff
changeset
|
1349 && current_sblock |
b9366f467430
* alloc.c (allocate_string) [macintosh]: Call check_string_bytes
Andrew Choi <akochoi@shaw.ca>
parents:
35183
diff
changeset
|
1350 #endif |
b9366f467430
* alloc.c (allocate_string) [macintosh]: Call check_string_bytes
Andrew Choi <akochoi@shaw.ca>
parents:
35183
diff
changeset
|
1351 ) |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1352 { |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1353 if (++check_string_bytes_count == 200) |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1354 { |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1355 check_string_bytes_count = 0; |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1356 check_string_bytes (1); |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1357 } |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1358 else |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1359 check_string_bytes (0); |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1360 } |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
1361 #endif /* GC_CHECK_STRING_BYTES */ |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
1362 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1363 return s; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1364 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1365 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1366 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1367 /* Set up Lisp_String S for holding NCHARS characters, NBYTES bytes, |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1368 plus a NUL byte at the end. Allocate an sdata structure for S, and |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1369 set S->data to its `u.data' member. Store a NUL byte at the end of |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1370 S->data. Set S->size to NCHARS and S->size_byte to NBYTES. Free |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1371 S->data if it was initially non-null. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1372 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1373 void |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1374 allocate_string_data (s, nchars, nbytes) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1375 struct Lisp_String *s; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1376 int nchars, nbytes; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1377 { |
30293
4a27d6a88c43
(allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents:
29781
diff
changeset
|
1378 struct sdata *data, *old_data; |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1379 struct sblock *b; |
30293
4a27d6a88c43
(allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents:
29781
diff
changeset
|
1380 int needed, old_nbytes; |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1381 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1382 /* Determine the number of bytes needed to store NBYTES bytes |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1383 of string data. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1384 needed = SDATA_SIZE (nbytes); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1385 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1386 if (nbytes > LARGE_STRING_BYTES) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1387 { |
30557
5056adb52e97
(lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents:
30317
diff
changeset
|
1388 size_t size = sizeof *b - sizeof (struct sdata) + needed; |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1389 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1390 #ifdef DOUG_LEA_MALLOC |
31576
717e7e2ca4fd
Add some comments about DOUG_LEA_MALLOC's use of mmap
Gerd Moellmann <gerd@gnu.org>
parents:
31102
diff
changeset
|
1391 /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed |
717e7e2ca4fd
Add some comments about DOUG_LEA_MALLOC's use of mmap
Gerd Moellmann <gerd@gnu.org>
parents:
31102
diff
changeset
|
1392 because mapped region contents are not preserved in |
717e7e2ca4fd
Add some comments about DOUG_LEA_MALLOC's use of mmap
Gerd Moellmann <gerd@gnu.org>
parents:
31102
diff
changeset
|
1393 a dumped Emacs. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1394 mallopt (M_MMAP_MAX, 0); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1395 #endif |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1396 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1397 b = (struct sblock *) lisp_malloc (size, MEM_TYPE_NON_LISP); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1398 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1399 #ifdef DOUG_LEA_MALLOC |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1400 /* Back to a reasonable maximum of mmap'ed areas. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1401 mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1402 #endif |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1403 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1404 b->next_free = &b->first_data; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1405 b->first_data.string = NULL; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1406 b->next = large_sblocks; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1407 large_sblocks = b; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1408 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1409 else if (current_sblock == NULL |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1410 || (((char *) current_sblock + SBLOCK_SIZE |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1411 - (char *) current_sblock->next_free) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1412 < needed)) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1413 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1414 /* Not enough room in the current sblock. */ |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1415 b = (struct sblock *) lisp_malloc (SBLOCK_SIZE, MEM_TYPE_NON_LISP); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1416 b->next_free = &b->first_data; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1417 b->first_data.string = NULL; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1418 b->next = NULL; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1419 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1420 if (current_sblock) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1421 current_sblock->next = b; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1422 else |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1423 oldest_sblock = b; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1424 current_sblock = b; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1425 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1426 else |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1427 b = current_sblock; |
30293
4a27d6a88c43
(allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents:
29781
diff
changeset
|
1428 |
4a27d6a88c43
(allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents:
29781
diff
changeset
|
1429 old_data = s->data ? SDATA_OF_STRING (s) : NULL; |
4a27d6a88c43
(allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents:
29781
diff
changeset
|
1430 old_nbytes = GC_STRING_BYTES (s); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1431 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1432 data = b->next_free; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1433 data->string = s; |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1434 s->data = SDATA_DATA (data); |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1435 #ifdef GC_CHECK_STRING_BYTES |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1436 SDATA_NBYTES (data) = nbytes; |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1437 #endif |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1438 s->size = nchars; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1439 s->size_byte = nbytes; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1440 s->data[nbytes] = '\0'; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1441 b->next_free = (struct sdata *) ((char *) data + needed); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1442 |
30293
4a27d6a88c43
(allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents:
29781
diff
changeset
|
1443 /* If S had already data assigned, mark that as free by setting its |
4a27d6a88c43
(allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents:
29781
diff
changeset
|
1444 string back-pointer to null, and recording the size of the data |
30317
96e65dc07fd7
(allocate_string_data): Don't copy old string contents.
Gerd Moellmann <gerd@gnu.org>
parents:
30293
diff
changeset
|
1445 in it. */ |
30293
4a27d6a88c43
(allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents:
29781
diff
changeset
|
1446 if (old_data) |
4a27d6a88c43
(allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents:
29781
diff
changeset
|
1447 { |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1448 SDATA_NBYTES (old_data) = old_nbytes; |
30293
4a27d6a88c43
(allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents:
29781
diff
changeset
|
1449 old_data->string = NULL; |
4a27d6a88c43
(allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents:
29781
diff
changeset
|
1450 } |
4a27d6a88c43
(allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents:
29781
diff
changeset
|
1451 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1452 consing_since_gc += needed; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1453 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1454 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1455 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1456 /* Sweep and compact strings. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1457 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1458 static void |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1459 sweep_strings () |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1460 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1461 struct string_block *b, *next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1462 struct string_block *live_blocks = NULL; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1463 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1464 string_free_list = NULL; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1465 total_strings = total_free_strings = 0; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1466 total_string_size = 0; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1467 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1468 /* Scan strings_blocks, free Lisp_Strings that aren't marked. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1469 for (b = string_blocks; b; b = next) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1470 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1471 int i, nfree = 0; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1472 struct Lisp_String *free_list_before = string_free_list; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1473 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1474 next = b->next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1475 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1476 for (i = 0; i < STRINGS_IN_STRING_BLOCK; ++i) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1477 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1478 struct Lisp_String *s = b->strings + i; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1479 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1480 if (s->data) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1481 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1482 /* String was not on free-list before. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1483 if (STRING_MARKED_P (s)) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1484 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1485 /* String is live; unmark it and its intervals. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1486 UNMARK_STRING (s); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1487 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1488 if (!NULL_INTERVAL_P (s->intervals)) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1489 UNMARK_BALANCE_INTERVALS (s->intervals); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1490 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1491 ++total_strings; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1492 total_string_size += STRING_BYTES (s); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1493 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1494 else |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1495 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1496 /* String is dead. Put it on the free-list. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1497 struct sdata *data = SDATA_OF_STRING (s); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1498 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1499 /* Save the size of S in its sdata so that we know |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1500 how large that is. Reset the sdata's string |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1501 back-pointer so that we know it's free. */ |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1502 #ifdef GC_CHECK_STRING_BYTES |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1503 if (GC_STRING_BYTES (s) != SDATA_NBYTES (data)) |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1504 abort (); |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1505 #else |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1506 data->u.nbytes = GC_STRING_BYTES (s); |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1507 #endif |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1508 data->string = NULL; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1509 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1510 /* Reset the strings's `data' member so that we |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1511 know it's free. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1512 s->data = NULL; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1513 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1514 /* Put the string on the free-list. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1515 NEXT_FREE_LISP_STRING (s) = string_free_list; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1516 string_free_list = s; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1517 ++nfree; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1518 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1519 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1520 else |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1521 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1522 /* S was on the free-list before. Put it there again. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1523 NEXT_FREE_LISP_STRING (s) = string_free_list; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1524 string_free_list = s; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1525 ++nfree; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1526 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1527 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1528 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1529 /* Free blocks that contain free Lisp_Strings only, except |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1530 the first two of them. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1531 if (nfree == STRINGS_IN_STRING_BLOCK |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1532 && total_free_strings > STRINGS_IN_STRING_BLOCK) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1533 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1534 lisp_free (b); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1535 --n_string_blocks; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1536 string_free_list = free_list_before; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1537 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1538 else |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1539 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1540 total_free_strings += nfree; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1541 b->next = live_blocks; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1542 live_blocks = b; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1543 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1544 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1545 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1546 string_blocks = live_blocks; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1547 free_large_strings (); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1548 compact_small_strings (); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1549 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1550 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1551 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1552 /* Free dead large strings. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1553 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1554 static void |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1555 free_large_strings () |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1556 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1557 struct sblock *b, *next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1558 struct sblock *live_blocks = NULL; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1559 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1560 for (b = large_sblocks; b; b = next) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1561 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1562 next = b->next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1563 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1564 if (b->first_data.string == NULL) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1565 lisp_free (b); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1566 else |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1567 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1568 b->next = live_blocks; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1569 live_blocks = b; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1570 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1571 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1572 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1573 large_sblocks = live_blocks; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1574 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1575 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1576 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1577 /* Compact data of small strings. Free sblocks that don't contain |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1578 data of live strings after compaction. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1579 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1580 static void |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1581 compact_small_strings () |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1582 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1583 struct sblock *b, *tb, *next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1584 struct sdata *from, *to, *end, *tb_end; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1585 struct sdata *to_end, *from_end; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1586 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1587 /* TB is the sblock we copy to, TO is the sdata within TB we copy |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1588 to, and TB_END is the end of TB. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1589 tb = oldest_sblock; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1590 tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1591 to = &tb->first_data; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1592 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1593 /* Step through the blocks from the oldest to the youngest. We |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1594 expect that old blocks will stabilize over time, so that less |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1595 copying will happen this way. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1596 for (b = oldest_sblock; b; b = b->next) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1597 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1598 end = b->next_free; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1599 xassert ((char *) end <= (char *) b + SBLOCK_SIZE); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1600 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1601 for (from = &b->first_data; from < end; from = from_end) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1602 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1603 /* Compute the next FROM here because copying below may |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1604 overwrite data we need to compute it. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1605 int nbytes; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1606 |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1607 #ifdef GC_CHECK_STRING_BYTES |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1608 /* Check that the string size recorded in the string is the |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1609 same as the one recorded in the sdata structure. */ |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1610 if (from->string |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1611 && GC_STRING_BYTES (from->string) != SDATA_NBYTES (from)) |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1612 abort (); |
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1613 #endif /* GC_CHECK_STRING_BYTES */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1614 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1615 if (from->string) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1616 nbytes = GC_STRING_BYTES (from->string); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1617 else |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1618 nbytes = SDATA_NBYTES (from); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1619 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1620 nbytes = SDATA_SIZE (nbytes); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1621 from_end = (struct sdata *) ((char *) from + nbytes); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1622 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1623 /* FROM->string non-null means it's alive. Copy its data. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1624 if (from->string) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1625 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1626 /* If TB is full, proceed with the next sblock. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1627 to_end = (struct sdata *) ((char *) to + nbytes); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1628 if (to_end > tb_end) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1629 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1630 tb->next_free = to; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1631 tb = tb->next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1632 tb_end = (struct sdata *) ((char *) tb + SBLOCK_SIZE); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1633 to = &tb->first_data; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1634 to_end = (struct sdata *) ((char *) to + nbytes); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1635 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1636 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1637 /* Copy, and update the string's `data' pointer. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1638 if (from != to) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1639 { |
30823
8ee3740aaf60
(compact_small_strings): Use safe_bcopy, add an
Gerd Moellmann <gerd@gnu.org>
parents:
30784
diff
changeset
|
1640 xassert (tb != b || to <= from); |
8ee3740aaf60
(compact_small_strings): Use safe_bcopy, add an
Gerd Moellmann <gerd@gnu.org>
parents:
30784
diff
changeset
|
1641 safe_bcopy ((char *) from, (char *) to, nbytes); |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
1642 to->string->data = SDATA_DATA (to); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1643 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1644 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1645 /* Advance past the sdata we copied to. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1646 to = to_end; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1647 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1648 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1649 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1650 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1651 /* The rest of the sblocks following TB don't contain live data, so |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1652 we can free them. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1653 for (b = tb->next; b; b = next) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1654 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1655 next = b->next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1656 lisp_free (b); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1657 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1658 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1659 tb->next_free = to; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1660 tb->next = NULL; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1661 current_sblock = tb; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1662 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1663 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1664 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1665 DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
1666 doc: /* Return a newly created string of length LENGTH, with each element being INIT. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1667 Both LENGTH and INIT must be numbers. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1668 (length, init) |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1669 Lisp_Object length, init; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1670 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1671 register Lisp_Object val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1672 register unsigned char *p, *end; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1673 int c, nbytes; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1674 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40113
diff
changeset
|
1675 CHECK_NATNUM (length); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40113
diff
changeset
|
1676 CHECK_NUMBER (init); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1677 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1678 c = XINT (init); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1679 if (SINGLE_BYTE_CHAR_P (c)) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1680 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1681 nbytes = XINT (length); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1682 val = make_uninit_string (nbytes); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
1683 p = SDATA (val); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
1684 end = p + SCHARS (val); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1685 while (p != end) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1686 *p++ = c; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1687 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1688 else |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1689 { |
33800
7f148cfbd1f7
(Fmake_string): Use MAX_MULTIBYTE_LENGTH, instead of hard coded `4'.
Kenichi Handa <handa@m17n.org>
parents:
33764
diff
changeset
|
1690 unsigned char str[MAX_MULTIBYTE_LENGTH]; |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1691 int len = CHAR_STRING (c, str); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1692 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1693 nbytes = len * XINT (length); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1694 val = make_uninit_multibyte_string (XINT (length), nbytes); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
1695 p = SDATA (val); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1696 end = p + nbytes; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1697 while (p != end) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1698 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1699 bcopy (str, p, len); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1700 p += len; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1701 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1702 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1703 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1704 *p = 0; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1705 return val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1706 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1707 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1708 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1709 DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
1710 doc: /* Return a new bool-vector of length LENGTH, using INIT for as each element. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1711 LENGTH must be a number. INIT matters only in whether it is t or nil. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
1712 (length, init) |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1713 Lisp_Object length, init; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1714 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1715 register Lisp_Object val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1716 struct Lisp_Bool_Vector *p; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1717 int real_init, i; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1718 int length_in_chars, length_in_elts, bits_per_value; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1719 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40113
diff
changeset
|
1720 CHECK_NATNUM (length); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1721 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1722 bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1723 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1724 length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1725 length_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1) / BITS_PER_CHAR); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1726 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1727 /* We must allocate one more elements than LENGTH_IN_ELTS for the |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1728 slot `size' of the struct Lisp_Bool_Vector. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1729 val = Fmake_vector (make_number (length_in_elts + 1), Qnil); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1730 p = XBOOL_VECTOR (val); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1731 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1732 /* Get rid of any bits that would cause confusion. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1733 p->vector_size = 0; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1734 XSETBOOL_VECTOR (val, p); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1735 p->size = XFASTINT (length); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1736 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1737 real_init = (NILP (init) ? 0 : -1); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1738 for (i = 0; i < length_in_chars ; i++) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1739 p->data[i] = real_init; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1740 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1741 /* Clear the extraneous bits in the last byte. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1742 if (XINT (length) != length_in_chars * BITS_PER_CHAR) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1743 XBOOL_VECTOR (val)->data[length_in_chars - 1] |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1744 &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1745 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1746 return val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1747 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1748 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1749 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1750 /* Make a string from NBYTES bytes at CONTENTS, and compute the number |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1751 of characters from the contents. This string may be unibyte or |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1752 multibyte, depending on the contents. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1753 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1754 Lisp_Object |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1755 make_string (contents, nbytes) |
46459
0a9cbcbdbe45
(xstrdup, make_string, make_unibyte_string)
Ken Raeburn <raeburn@raeburn.org>
parents:
46418
diff
changeset
|
1756 const char *contents; |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1757 int nbytes; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1758 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1759 register Lisp_Object val; |
28997
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
1760 int nchars, multibyte_nbytes; |
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
1761 |
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
1762 parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes); |
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
1763 if (nbytes == nchars || nbytes != multibyte_nbytes) |
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
1764 /* CONTENTS contains no multibyte sequences or contains an invalid |
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
1765 multibyte sequence. We must make unibyte string. */ |
33623
dda5cbf94928
(make_string): Fix previous change. Be sure to make
Kenichi Handa <handa@m17n.org>
parents:
32776
diff
changeset
|
1766 val = make_unibyte_string (contents, nbytes); |
dda5cbf94928
(make_string): Fix previous change. Be sure to make
Kenichi Handa <handa@m17n.org>
parents:
32776
diff
changeset
|
1767 else |
dda5cbf94928
(make_string): Fix previous change. Be sure to make
Kenichi Handa <handa@m17n.org>
parents:
32776
diff
changeset
|
1768 val = make_multibyte_string (contents, nchars, nbytes); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1769 return val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1770 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1771 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1772 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1773 /* Make an unibyte string from LENGTH bytes at CONTENTS. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1774 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1775 Lisp_Object |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1776 make_unibyte_string (contents, length) |
46459
0a9cbcbdbe45
(xstrdup, make_string, make_unibyte_string)
Ken Raeburn <raeburn@raeburn.org>
parents:
46418
diff
changeset
|
1777 const char *contents; |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1778 int length; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1779 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1780 register Lisp_Object val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1781 val = make_uninit_string (length); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
1782 bcopy (contents, SDATA (val), length); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
1783 STRING_SET_UNIBYTE (val); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1784 return val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1785 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1786 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1787 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1788 /* Make a multibyte string from NCHARS characters occupying NBYTES |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1789 bytes at CONTENTS. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1790 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1791 Lisp_Object |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1792 make_multibyte_string (contents, nchars, nbytes) |
46459
0a9cbcbdbe45
(xstrdup, make_string, make_unibyte_string)
Ken Raeburn <raeburn@raeburn.org>
parents:
46418
diff
changeset
|
1793 const char *contents; |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1794 int nchars, nbytes; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1795 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1796 register Lisp_Object val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1797 val = make_uninit_multibyte_string (nchars, nbytes); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
1798 bcopy (contents, SDATA (val), nbytes); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1799 return val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1800 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1801 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1802 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1803 /* Make a string from NCHARS characters occupying NBYTES bytes at |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1804 CONTENTS. It is a multibyte string if NBYTES != NCHARS. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1805 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1806 Lisp_Object |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1807 make_string_from_bytes (contents, nchars, nbytes) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1808 char *contents; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1809 int nchars, nbytes; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1810 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1811 register Lisp_Object val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1812 val = make_uninit_multibyte_string (nchars, nbytes); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
1813 bcopy (contents, SDATA (val), nbytes); |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
1814 if (SBYTES (val) == SCHARS (val)) |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
1815 STRING_SET_UNIBYTE (val); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1816 return val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1817 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1818 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1819 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1820 /* Make a string from NCHARS characters occupying NBYTES bytes at |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1821 CONTENTS. The argument MULTIBYTE controls whether to label the |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1822 string as multibyte. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1823 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1824 Lisp_Object |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1825 make_specified_string (contents, nchars, nbytes, multibyte) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1826 char *contents; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1827 int nchars, nbytes; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1828 int multibyte; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1829 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1830 register Lisp_Object val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1831 val = make_uninit_multibyte_string (nchars, nbytes); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
1832 bcopy (contents, SDATA (val), nbytes); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1833 if (!multibyte) |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
1834 STRING_SET_UNIBYTE (val); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1835 return val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1836 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1837 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1838 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1839 /* Make a string from the data at STR, treating it as multibyte if the |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1840 data warrants. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1841 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1842 Lisp_Object |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1843 build_string (str) |
46459
0a9cbcbdbe45
(xstrdup, make_string, make_unibyte_string)
Ken Raeburn <raeburn@raeburn.org>
parents:
46418
diff
changeset
|
1844 const char *str; |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1845 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1846 return make_string (str, strlen (str)); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1847 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1848 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1849 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1850 /* Return an unibyte Lisp_String set up to hold LENGTH characters |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1851 occupying LENGTH bytes. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1852 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1853 Lisp_Object |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1854 make_uninit_string (length) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1855 int length; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1856 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1857 Lisp_Object val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1858 val = make_uninit_multibyte_string (length, length); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
1859 STRING_SET_UNIBYTE (val); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1860 return val; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1861 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1862 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1863 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1864 /* Return a multibyte Lisp_String set up to hold NCHARS characters |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1865 which occupy NBYTES bytes. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1866 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1867 Lisp_Object |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1868 make_uninit_multibyte_string (nchars, nbytes) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1869 int nchars, nbytes; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1870 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1871 Lisp_Object string; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1872 struct Lisp_String *s; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1873 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1874 if (nchars < 0) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1875 abort (); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1876 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1877 s = allocate_string (); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1878 allocate_string_data (s, nchars, nbytes); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1879 XSETSTRING (string, s); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1880 string_chars_consed += nbytes; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1881 return string; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1882 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1883 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1884 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1885 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1886 /*********************************************************************** |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1887 Float Allocation |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1888 ***********************************************************************/ |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
1889 |
300 | 1890 /* We store float cells inside of float_blocks, allocating a new |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1891 float_block with malloc whenever necessary. Float cells reclaimed |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1892 by GC are put on a free list to be reallocated before allocating |
300 | 1893 any new float cells from the latest float_block. |
1894 | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1895 Each float_block is just under 1020 bytes long, since malloc really |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1896 allocates in units of powers of two and uses 4 bytes for its own |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1897 overhead. */ |
300 | 1898 |
1899 #define FLOAT_BLOCK_SIZE \ | |
1900 ((1020 - sizeof (struct float_block *)) / sizeof (struct Lisp_Float)) | |
1901 | |
1902 struct float_block | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1903 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1904 struct float_block *next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1905 struct Lisp_Float floats[FLOAT_BLOCK_SIZE]; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1906 }; |
300 | 1907 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1908 /* Current float_block. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1909 |
300 | 1910 struct float_block *float_block; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1911 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1912 /* Index of first unused Lisp_Float in the current float_block. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1913 |
300 | 1914 int float_block_index; |
1915 | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1916 /* Total number of float blocks now in use. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1917 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1918 int n_float_blocks; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1919 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1920 /* Free-list of Lisp_Floats. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1921 |
300 | 1922 struct Lisp_Float *float_free_list; |
1923 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1924 |
39297
aff361cfdccb
Fix a typo in a comment. From Pavel Janik.
Eli Zaretskii <eliz@gnu.org>
parents:
39228
diff
changeset
|
1925 /* Initialize float allocation. */ |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1926 |
300 | 1927 void |
1928 init_float () | |
1929 { | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1930 float_block = (struct float_block *) lisp_malloc (sizeof *float_block, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1931 MEM_TYPE_FLOAT); |
300 | 1932 float_block->next = 0; |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
1933 bzero ((char *) float_block->floats, sizeof float_block->floats); |
300 | 1934 float_block_index = 0; |
1935 float_free_list = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1936 n_float_blocks = 1; |
300 | 1937 } |
1938 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1939 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1940 /* Explicitly free a float cell by putting it on the free-list. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1941 |
21514 | 1942 void |
300 | 1943 free_float (ptr) |
1944 struct Lisp_Float *ptr; | |
1945 { | |
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
|
1946 *(struct Lisp_Float **)&ptr->data = float_free_list; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1947 #if GC_MARK_STACK |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1948 ptr->type = Vdead; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1949 #endif |
300 | 1950 float_free_list = ptr; |
1951 } | |
1952 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1953 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1954 /* Return a new float object with value FLOAT_VALUE. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1955 |
300 | 1956 Lisp_Object |
1957 make_float (float_value) | |
1958 double float_value; | |
1959 { | |
1960 register Lisp_Object val; | |
1961 | |
1962 if (float_free_list) | |
1963 { | |
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
|
1964 /* 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
|
1965 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
|
1966 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
|
1967 float_free_list = *(struct Lisp_Float **)&float_free_list->data; |
300 | 1968 } |
1969 else | |
1970 { | |
1971 if (float_block_index == FLOAT_BLOCK_SIZE) | |
1972 { | |
12529 | 1973 register struct float_block *new; |
1974 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1975 new = (struct float_block *) lisp_malloc (sizeof *new, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
1976 MEM_TYPE_FLOAT); |
300 | 1977 VALIDATE_LISP_STORAGE (new, sizeof *new); |
1978 new->next = float_block; | |
1979 float_block = new; | |
1980 float_block_index = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
1981 n_float_blocks++; |
300 | 1982 } |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
1983 XSETFLOAT (val, &float_block->floats[float_block_index++]); |
300 | 1984 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
1985 |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25544
diff
changeset
|
1986 XFLOAT_DATA (val) = float_value; |
9295
17d393a8eed6
(free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents:
9261
diff
changeset
|
1987 XSETFASTINT (XFLOAT (val)->type, 0); /* bug chasing -wsr */ |
300 | 1988 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
|
1989 floats_consed++; |
300 | 1990 return val; |
1991 } | |
1992 | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1993 |
300 | 1994 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1995 /*********************************************************************** |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1996 Cons Allocation |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1997 ***********************************************************************/ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
1998 |
300 | 1999 /* We store cons cells inside of cons_blocks, allocating a new |
2000 cons_block with malloc whenever necessary. Cons cells reclaimed by | |
2001 GC are put on a free list to be reallocated before allocating | |
2002 any new cons cells from the latest cons_block. | |
2003 | |
2004 Each cons_block is just under 1020 bytes long, | |
2005 since malloc really allocates in units of powers of two | |
2006 and uses 4 bytes for its own overhead. */ | |
2007 | |
2008 #define CONS_BLOCK_SIZE \ | |
2009 ((1020 - sizeof (struct cons_block *)) / sizeof (struct Lisp_Cons)) | |
2010 | |
2011 struct cons_block | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2012 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2013 struct cons_block *next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2014 struct Lisp_Cons conses[CONS_BLOCK_SIZE]; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2015 }; |
300 | 2016 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2017 /* Current cons_block. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2018 |
300 | 2019 struct cons_block *cons_block; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2020 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2021 /* Index of first unused Lisp_Cons in the current block. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2022 |
300 | 2023 int cons_block_index; |
2024 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2025 /* Free-list of Lisp_Cons structures. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2026 |
300 | 2027 struct Lisp_Cons *cons_free_list; |
2028 | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2029 /* Total number of cons blocks now in use. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2030 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2031 int n_cons_blocks; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2032 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2033 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2034 /* Initialize cons allocation. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2035 |
300 | 2036 void |
2037 init_cons () | |
2038 { | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2039 cons_block = (struct cons_block *) lisp_malloc (sizeof *cons_block, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2040 MEM_TYPE_CONS); |
300 | 2041 cons_block->next = 0; |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
2042 bzero ((char *) cons_block->conses, sizeof cons_block->conses); |
300 | 2043 cons_block_index = 0; |
2044 cons_free_list = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2045 n_cons_blocks = 1; |
300 | 2046 } |
2047 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2048 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2049 /* Explicitly free a cons cell by putting it on the free-list. */ |
20375
1dd0bd0749b5
(malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents:
20057
diff
changeset
|
2050 |
1dd0bd0749b5
(malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents:
20057
diff
changeset
|
2051 void |
300 | 2052 free_cons (ptr) |
2053 struct Lisp_Cons *ptr; | |
2054 { | |
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
|
2055 *(struct Lisp_Cons **)&ptr->cdr = cons_free_list; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2056 #if GC_MARK_STACK |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2057 ptr->car = Vdead; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2058 #endif |
300 | 2059 cons_free_list = ptr; |
2060 } | |
2061 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2062 |
300 | 2063 DEFUN ("cons", Fcons, Scons, 2, 2, 0, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
2064 doc: /* Create a new cons, give it CAR and CDR as components, and return it. */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2065 (car, cdr) |
300 | 2066 Lisp_Object car, cdr; |
2067 { | |
2068 register Lisp_Object val; | |
2069 | |
2070 if (cons_free_list) | |
2071 { | |
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
|
2072 /* 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
|
2073 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
|
2074 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
|
2075 cons_free_list = *(struct Lisp_Cons **)&cons_free_list->cdr; |
300 | 2076 } |
2077 else | |
2078 { | |
2079 if (cons_block_index == CONS_BLOCK_SIZE) | |
2080 { | |
12529 | 2081 register struct cons_block *new; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2082 new = (struct cons_block *) lisp_malloc (sizeof *new, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2083 MEM_TYPE_CONS); |
300 | 2084 VALIDATE_LISP_STORAGE (new, sizeof *new); |
2085 new->next = cons_block; | |
2086 cons_block = new; | |
2087 cons_block_index = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2088 n_cons_blocks++; |
300 | 2089 } |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
2090 XSETCONS (val, &cons_block->conses[cons_block_index++]); |
300 | 2091 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2092 |
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39914
diff
changeset
|
2093 XSETCAR (val, car); |
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39914
diff
changeset
|
2094 XSETCDR (val, cdr); |
300 | 2095 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
|
2096 cons_cells_consed++; |
300 | 2097 return val; |
2098 } | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2099 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2100 |
20849
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2101 /* 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
|
2102 |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2103 Lisp_Object |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2104 list2 (arg1, arg2) |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2105 Lisp_Object arg1, arg2; |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2106 { |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2107 return Fcons (arg1, Fcons (arg2, Qnil)); |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2108 } |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2109 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2110 |
20849
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2111 Lisp_Object |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2112 list3 (arg1, arg2, arg3) |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2113 Lisp_Object arg1, arg2, arg3; |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2114 { |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2115 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
|
2116 } |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2117 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2118 |
20849
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2119 Lisp_Object |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2120 list4 (arg1, arg2, arg3, arg4) |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2121 Lisp_Object arg1, arg2, arg3, arg4; |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2122 { |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2123 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
|
2124 } |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2125 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2126 |
20849
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2127 Lisp_Object |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2128 list5 (arg1, arg2, arg3, arg4, arg5) |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2129 Lisp_Object arg1, arg2, arg3, arg4, arg5; |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2130 { |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2131 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
|
2132 Fcons (arg5, Qnil))))); |
3b2f72ed135c
(list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
20768
diff
changeset
|
2133 } |
300 | 2134 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2135 |
300 | 2136 DEFUN ("list", Flist, Slist, 0, MANY, 0, |
40977 | 2137 doc: /* Return a newly created list with specified arguments as elements. |
40113
66132b83e52a
(Fmake_byte_code, Fvector, Flist): Add usage: string to doc string.
Miles Bader <miles@gnu.org>
parents:
40107
diff
changeset
|
2138 Any number of arguments, even zero arguments, are allowed. |
66132b83e52a
(Fmake_byte_code, Fvector, Flist): Add usage: string to doc string.
Miles Bader <miles@gnu.org>
parents:
40107
diff
changeset
|
2139 usage: (list &rest OBJECTS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2140 (nargs, args) |
300 | 2141 int nargs; |
2142 register Lisp_Object *args; | |
2143 { | |
13610
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
2144 register Lisp_Object val; |
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
2145 val = Qnil; |
300 | 2146 |
13610
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
2147 while (nargs > 0) |
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
2148 { |
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
2149 nargs--; |
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
2150 val = Fcons (args[nargs], val); |
8e82e46aa77b
(Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents:
13553
diff
changeset
|
2151 } |
300 | 2152 return val; |
2153 } | |
2154 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2155 |
300 | 2156 DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
2157 doc: /* Return a newly created list of length LENGTH, with each element being INIT. */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2158 (length, init) |
300 | 2159 register Lisp_Object length, init; |
2160 { | |
2161 register Lisp_Object val; | |
2162 register int size; | |
2163 | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40113
diff
changeset
|
2164 CHECK_NATNUM (length); |
9953
e0672d4cf470
(Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents:
9942
diff
changeset
|
2165 size = XFASTINT (length); |
300 | 2166 |
2167 val = Qnil; | |
35762
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2168 while (size > 0) |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2169 { |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2170 val = Fcons (init, val); |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2171 --size; |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2172 |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2173 if (size > 0) |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2174 { |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2175 val = Fcons (init, val); |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2176 --size; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2177 |
35762
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2178 if (size > 0) |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2179 { |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2180 val = Fcons (init, val); |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2181 --size; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2182 |
35762
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2183 if (size > 0) |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2184 { |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2185 val = Fcons (init, val); |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2186 --size; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2187 |
35762
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2188 if (size > 0) |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2189 { |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2190 val = Fcons (init, val); |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2191 --size; |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2192 } |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2193 } |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2194 } |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2195 } |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2196 |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2197 QUIT; |
e197a82c3286
(Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents:
35660
diff
changeset
|
2198 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2199 |
300 | 2200 return val; |
2201 } | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2202 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2203 |
300 | 2204 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2205 /*********************************************************************** |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2206 Vector Allocation |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2207 ***********************************************************************/ |
300 | 2208 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2209 /* Singly-linked list of all vectors. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2210 |
300 | 2211 struct Lisp_Vector *all_vectors; |
2212 | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2213 /* Total number of vector-like objects now in use. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2214 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2215 int n_vectors; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2216 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2217 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2218 /* Value is a pointer to a newly allocated Lisp_Vector structure |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2219 with room for LEN Lisp_Objects. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2220 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2221 static struct Lisp_Vector * |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2222 allocate_vectorlike (len, type) |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2223 EMACS_INT len; |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2224 enum mem_type type; |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2225 { |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2226 struct Lisp_Vector *p; |
30557
5056adb52e97
(lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents:
30317
diff
changeset
|
2227 size_t nbytes; |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2228 |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
2229 #ifdef DOUG_LEA_MALLOC |
31576
717e7e2ca4fd
Add some comments about DOUG_LEA_MALLOC's use of mmap
Gerd Moellmann <gerd@gnu.org>
parents:
31102
diff
changeset
|
2230 /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed |
717e7e2ca4fd
Add some comments about DOUG_LEA_MALLOC's use of mmap
Gerd Moellmann <gerd@gnu.org>
parents:
31102
diff
changeset
|
2231 because mapped region contents are not preserved in |
717e7e2ca4fd
Add some comments about DOUG_LEA_MALLOC's use of mmap
Gerd Moellmann <gerd@gnu.org>
parents:
31102
diff
changeset
|
2232 a dumped Emacs. */ |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
2233 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
|
2234 #endif |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2235 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2236 nbytes = sizeof *p + (len - 1) * sizeof p->contents[0]; |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2237 p = (struct Lisp_Vector *) lisp_malloc (nbytes, type); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2238 |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
2239 #ifdef DOUG_LEA_MALLOC |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2240 /* 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
|
2241 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
|
2242 #endif |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2243 |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2244 VALIDATE_LISP_STORAGE (p, 0); |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2245 consing_since_gc += nbytes; |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
2246 vector_cells_consed += len; |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2247 |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2248 p->next = all_vectors; |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2249 all_vectors = p; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2250 ++n_vectors; |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2251 return p; |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2252 } |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2253 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2254 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2255 /* Allocate a vector with NSLOTS slots. */ |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2256 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2257 struct Lisp_Vector * |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2258 allocate_vector (nslots) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2259 EMACS_INT nslots; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2260 { |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2261 struct Lisp_Vector *v = allocate_vectorlike (nslots, MEM_TYPE_VECTOR); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2262 v->size = nslots; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2263 return v; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2264 } |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2265 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2266 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2267 /* Allocate other vector-like structures. */ |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2268 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2269 struct Lisp_Hash_Table * |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2270 allocate_hash_table () |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2271 { |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2272 EMACS_INT len = VECSIZE (struct Lisp_Hash_Table); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2273 struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_HASH_TABLE); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2274 EMACS_INT i; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2275 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2276 v->size = len; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2277 for (i = 0; i < len; ++i) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2278 v->contents[i] = Qnil; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2279 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2280 return (struct Lisp_Hash_Table *) v; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2281 } |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2282 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2283 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2284 struct window * |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2285 allocate_window () |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2286 { |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2287 EMACS_INT len = VECSIZE (struct window); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2288 struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_WINDOW); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2289 EMACS_INT i; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2290 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2291 for (i = 0; i < len; ++i) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2292 v->contents[i] = Qnil; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2293 v->size = len; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2294 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2295 return (struct window *) v; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2296 } |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2297 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2298 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2299 struct frame * |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2300 allocate_frame () |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2301 { |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2302 EMACS_INT len = VECSIZE (struct frame); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2303 struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_FRAME); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2304 EMACS_INT i; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2305 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2306 for (i = 0; i < len; ++i) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2307 v->contents[i] = make_number (0); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2308 v->size = len; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2309 return (struct frame *) v; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2310 } |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2311 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2312 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2313 struct Lisp_Process * |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2314 allocate_process () |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2315 { |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2316 EMACS_INT len = VECSIZE (struct Lisp_Process); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2317 struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_PROCESS); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2318 EMACS_INT i; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2319 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2320 for (i = 0; i < len; ++i) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2321 v->contents[i] = Qnil; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2322 v->size = len; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2323 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2324 return (struct Lisp_Process *) v; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2325 } |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2326 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2327 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2328 struct Lisp_Vector * |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2329 allocate_other_vector (len) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2330 EMACS_INT len; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2331 { |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2332 struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_VECTOR); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2333 EMACS_INT i; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2334 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2335 for (i = 0; i < len; ++i) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2336 v->contents[i] = Qnil; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2337 v->size = len; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2338 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2339 return v; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2340 } |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2341 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2342 |
300 | 2343 DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
2344 doc: /* Return a newly created vector of length LENGTH, with each element being INIT. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2345 See also the function `vector'. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2346 (length, init) |
300 | 2347 register Lisp_Object length, init; |
2348 { | |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2349 Lisp_Object vector; |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2350 register EMACS_INT sizei; |
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2351 register int index; |
300 | 2352 register struct Lisp_Vector *p; |
2353 | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40113
diff
changeset
|
2354 CHECK_NATNUM (length); |
9953
e0672d4cf470
(Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents:
9942
diff
changeset
|
2355 sizei = XFASTINT (length); |
300 | 2356 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2357 p = allocate_vector (sizei); |
300 | 2358 for (index = 0; index < sizei; index++) |
2359 p->contents[index] = init; | |
2360 | |
9968
943a61c764a5
(Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents:
9953
diff
changeset
|
2361 XSETVECTOR (vector, p); |
300 | 2362 return vector; |
2363 } | |
2364 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2365 |
13219
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
2366 DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
2367 doc: /* Return a newly created char-table, with purpose PURPOSE. |
39914
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
2368 Each element is initialized to INIT, which defaults to nil. |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
2369 PURPOSE should be a symbol which has a `char-table-extra-slots' property. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2370 The property's value should be an integer between 0 and 10. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2371 (purpose, init) |
13219
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
2372 register Lisp_Object purpose, init; |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
2373 { |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
2374 Lisp_Object vector; |
13219
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
2375 Lisp_Object n; |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40113
diff
changeset
|
2376 CHECK_SYMBOL (purpose); |
17328
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
2377 n = Fget (purpose, Qchar_table_extra_slots); |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40113
diff
changeset
|
2378 CHECK_NUMBER (n); |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
2379 if (XINT (n) < 0 || XINT (n) > 10) |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
2380 args_out_of_range (n, Qnil); |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
2381 /* 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
|
2382 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
|
2383 init); |
17328
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
2384 XCHAR_TABLE (vector)->top = Qt; |
13150
3778c95adca9
(Fmake_char_table): Initialize parent to nil.
Erik Naggum <erik@naggum.no>
parents:
13141
diff
changeset
|
2385 XCHAR_TABLE (vector)->parent = Qnil; |
13219
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
2386 XCHAR_TABLE (vector)->purpose = purpose; |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
2387 XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
2388 return vector; |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
2389 } |
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
2390 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2391 |
17328
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
2392 /* 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
|
2393 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
|
2394 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
|
2395 |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
2396 Lisp_Object |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
2397 make_sub_char_table (defalt) |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
2398 Lisp_Object defalt; |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
2399 { |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
2400 Lisp_Object vector |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
2401 = 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
|
2402 XCHAR_TABLE (vector)->top = Qnil; |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
2403 XCHAR_TABLE (vector)->defalt = defalt; |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
2404 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
|
2405 return vector; |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
2406 } |
e2a6f31ee014
(Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents:
17217
diff
changeset
|
2407 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2408 |
300 | 2409 DEFUN ("vector", Fvector, Svector, 0, MANY, 0, |
40977 | 2410 doc: /* Return a newly created vector with specified arguments as elements. |
40113
66132b83e52a
(Fmake_byte_code, Fvector, Flist): Add usage: string to doc string.
Miles Bader <miles@gnu.org>
parents:
40107
diff
changeset
|
2411 Any number of arguments, even zero arguments, are allowed. |
66132b83e52a
(Fmake_byte_code, Fvector, Flist): Add usage: string to doc string.
Miles Bader <miles@gnu.org>
parents:
40107
diff
changeset
|
2412 usage: (vector &rest OBJECTS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2413 (nargs, args) |
300 | 2414 register int nargs; |
2415 Lisp_Object *args; | |
2416 { | |
2417 register Lisp_Object len, val; | |
2418 register int index; | |
2419 register struct Lisp_Vector *p; | |
2420 | |
9295
17d393a8eed6
(free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents:
9261
diff
changeset
|
2421 XSETFASTINT (len, nargs); |
300 | 2422 val = Fmake_vector (len, Qnil); |
2423 p = XVECTOR (val); | |
2424 for (index = 0; index < nargs; index++) | |
2425 p->contents[index] = args[index]; | |
2426 return val; | |
2427 } | |
2428 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2429 |
300 | 2430 DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
2431 doc: /* Create a byte-code object with specified arguments as elements. |
39914
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
2432 The arguments should be the arglist, bytecode-string, constant vector, |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
2433 stack size, (optional) doc string, and (optional) interactive spec. |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
2434 The first four arguments are required; at most six have any |
40113
66132b83e52a
(Fmake_byte_code, Fvector, Flist): Add usage: string to doc string.
Miles Bader <miles@gnu.org>
parents:
40107
diff
changeset
|
2435 significance. |
66132b83e52a
(Fmake_byte_code, Fvector, Flist): Add usage: string to doc string.
Miles Bader <miles@gnu.org>
parents:
40107
diff
changeset
|
2436 usage: (make-byte-code &rest ELEMENTS) */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2437 (nargs, args) |
300 | 2438 register int nargs; |
2439 Lisp_Object *args; | |
2440 { | |
2441 register Lisp_Object len, val; | |
2442 register int index; | |
2443 register struct Lisp_Vector *p; | |
2444 | |
9295
17d393a8eed6
(free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents:
9261
diff
changeset
|
2445 XSETFASTINT (len, nargs); |
485 | 2446 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
|
2447 val = make_pure_vector ((EMACS_INT) nargs); |
300 | 2448 else |
2449 val = Fmake_vector (len, Qnil); | |
28997
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
2450 |
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
2451 if (STRINGP (args[1]) && STRING_MULTIBYTE (args[1])) |
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
2452 /* BYTECODE-STRING must have been produced by Emacs 20.2 or the |
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
2453 earlier because they produced a raw 8-bit string for byte-code |
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
2454 and now such a byte-code string is loaded as multibyte while |
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
2455 raw 8-bit characters converted to multibyte form. Thus, now we |
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
2456 must convert them back to the original unibyte form. */ |
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
2457 args[1] = Fstring_as_unibyte (args[1]); |
fc8d42f77d4f
(Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents:
28469
diff
changeset
|
2458 |
300 | 2459 p = XVECTOR (val); |
2460 for (index = 0; index < nargs; index++) | |
2461 { | |
485 | 2462 if (!NILP (Vpurify_flag)) |
300 | 2463 args[index] = Fpurecopy (args[index]); |
2464 p->contents[index] = args[index]; | |
2465 } | |
18104
b2a669ef69b1
(Fmake_byte_code): Set val from p, not from val.
Richard M. Stallman <rms@gnu.org>
parents:
18010
diff
changeset
|
2466 XSETCOMPILED (val, p); |
300 | 2467 return val; |
2468 } | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2469 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2470 |
300 | 2471 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2472 /*********************************************************************** |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2473 Symbol Allocation |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2474 ***********************************************************************/ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2475 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2476 /* Each symbol_block is just under 1020 bytes long, since malloc |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2477 really allocates in units of powers of two and uses 4 bytes for its |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2478 own overhead. */ |
300 | 2479 |
2480 #define SYMBOL_BLOCK_SIZE \ | |
2481 ((1020 - sizeof (struct symbol_block *)) / sizeof (struct Lisp_Symbol)) | |
2482 | |
2483 struct symbol_block | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2484 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2485 struct symbol_block *next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2486 struct Lisp_Symbol symbols[SYMBOL_BLOCK_SIZE]; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2487 }; |
300 | 2488 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2489 /* Current symbol block and index of first unused Lisp_Symbol |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2490 structure in it. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2491 |
300 | 2492 struct symbol_block *symbol_block; |
2493 int symbol_block_index; | |
2494 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2495 /* List of free symbols. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2496 |
300 | 2497 struct Lisp_Symbol *symbol_free_list; |
2498 | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2499 /* Total number of symbol blocks now in use. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2500 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2501 int n_symbol_blocks; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2502 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2503 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2504 /* Initialize symbol allocation. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2505 |
300 | 2506 void |
2507 init_symbol () | |
2508 { | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2509 symbol_block = (struct symbol_block *) lisp_malloc (sizeof *symbol_block, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2510 MEM_TYPE_SYMBOL); |
300 | 2511 symbol_block->next = 0; |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
2512 bzero ((char *) symbol_block->symbols, sizeof symbol_block->symbols); |
300 | 2513 symbol_block_index = 0; |
2514 symbol_free_list = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2515 n_symbol_blocks = 1; |
300 | 2516 } |
2517 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2518 |
300 | 2519 DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
2520 doc: /* Return a newly allocated uninterned symbol whose name is NAME. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2521 Its value and function definition are void, and its property list is nil. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2522 (name) |
14093
338f645e6b9a
(Fmake_symbol): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
2523 Lisp_Object name; |
300 | 2524 { |
2525 register Lisp_Object val; | |
2526 register struct Lisp_Symbol *p; | |
2527 | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
40113
diff
changeset
|
2528 CHECK_STRING (name); |
300 | 2529 |
2530 if (symbol_free_list) | |
2531 { | |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
2532 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
|
2533 symbol_free_list = *(struct Lisp_Symbol **)&symbol_free_list->value; |
300 | 2534 } |
2535 else | |
2536 { | |
2537 if (symbol_block_index == SYMBOL_BLOCK_SIZE) | |
2538 { | |
12529 | 2539 struct symbol_block *new; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2540 new = (struct symbol_block *) lisp_malloc (sizeof *new, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2541 MEM_TYPE_SYMBOL); |
300 | 2542 VALIDATE_LISP_STORAGE (new, sizeof *new); |
2543 new->next = symbol_block; | |
2544 symbol_block = new; | |
2545 symbol_block_index = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2546 n_symbol_blocks++; |
300 | 2547 } |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
2548 XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]); |
300 | 2549 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2550 |
300 | 2551 p = XSYMBOL (val); |
45392
f3d7ab65641f
* alloc.c (Fmake_symbol): Set symbol xname field instead of name.
Ken Raeburn <raeburn@raeburn.org>
parents:
44890
diff
changeset
|
2552 p->xname = name; |
300 | 2553 p->plist = Qnil; |
2554 p->value = Qunbound; | |
2555 p->function = Qunbound; | |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
2556 p->next = NULL; |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
2557 p->interned = SYMBOL_UNINTERNED; |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
2558 p->constant = 0; |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
2559 p->indirect_variable = 0; |
300 | 2560 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
|
2561 symbols_consed++; |
300 | 2562 return val; |
2563 } | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2564 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2565 |
300 | 2566 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2567 /*********************************************************************** |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2568 Marker (Misc) Allocation |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2569 ***********************************************************************/ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2570 |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2571 /* Allocation of markers and other objects that share that structure. |
300 | 2572 Works like allocation of conses. */ |
2573 | |
2574 #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
|
2575 ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc)) |
300 | 2576 |
2577 struct marker_block | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2578 { |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2579 struct marker_block *next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2580 union Lisp_Misc markers[MARKER_BLOCK_SIZE]; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2581 }; |
300 | 2582 |
2583 struct marker_block *marker_block; | |
2584 int marker_block_index; | |
2585 | |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2586 union Lisp_Misc *marker_free_list; |
300 | 2587 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2588 /* Total number of marker blocks now in use. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2589 |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2590 int n_marker_blocks; |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2591 |
300 | 2592 void |
2593 init_marker () | |
2594 { | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2595 marker_block = (struct marker_block *) lisp_malloc (sizeof *marker_block, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2596 MEM_TYPE_MISC); |
300 | 2597 marker_block->next = 0; |
13320
e0f3a961851a
Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents:
13219
diff
changeset
|
2598 bzero ((char *) marker_block->markers, sizeof marker_block->markers); |
300 | 2599 marker_block_index = 0; |
2600 marker_free_list = 0; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2601 n_marker_blocks = 1; |
300 | 2602 } |
2603 | |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2604 /* Return a newly allocated Lisp_Misc object, with no substructure. */ |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2605 |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2606 Lisp_Object |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2607 allocate_misc () |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2608 { |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2609 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
|
2610 |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2611 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
|
2612 { |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2613 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
|
2614 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
|
2615 } |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2616 else |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2617 { |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2618 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
|
2619 { |
12529 | 2620 struct marker_block *new; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2621 new = (struct marker_block *) lisp_malloc (sizeof *new, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2622 MEM_TYPE_MISC); |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2623 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
|
2624 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
|
2625 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
|
2626 marker_block_index = 0; |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
2627 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
|
2628 } |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2629 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
|
2630 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2631 |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2632 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
|
2633 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
|
2634 return val; |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2635 } |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2636 |
49055
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2637 /* Return a Lisp_Misc_Save_Value object containing POINTER and |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2638 INTEGER. This is used to package C values to call record_unwind_protect. |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2639 The unwind function can get the C values back using XSAVE_VALUE. */ |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2640 |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2641 Lisp_Object |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2642 make_save_value (pointer, integer) |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2643 void *pointer; |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2644 int integer; |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2645 { |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2646 register Lisp_Object val; |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2647 register struct Lisp_Save_Value *p; |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2648 |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2649 val = allocate_misc (); |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2650 XMISCTYPE (val) = Lisp_Misc_Save_Value; |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2651 p = XSAVE_VALUE (val); |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2652 p->pointer = pointer; |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2653 p->integer = integer; |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2654 return val; |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2655 } |
cea2e52c7ca5
(make_save_value): New function.
Richard M. Stallman <rms@gnu.org>
parents:
48907
diff
changeset
|
2656 |
300 | 2657 DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
2658 doc: /* Return a newly allocated marker which does not point at any place. */) |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
2659 () |
300 | 2660 { |
2661 register Lisp_Object val; | |
2662 register struct Lisp_Marker *p; | |
638 | 2663 |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
2664 val = allocate_misc (); |
11243
054ecfce1820
(Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11048
diff
changeset
|
2665 XMISCTYPE (val) = Lisp_Misc_Marker; |
300 | 2666 p = XMARKER (val); |
2667 p->buffer = 0; | |
20565
aa9b7c5f0f62
(Fmake_marker): Initialize marker's bytepos and charpos.
Richard M. Stallman <rms@gnu.org>
parents:
20495
diff
changeset
|
2668 p->bytepos = 0; |
aa9b7c5f0f62
(Fmake_marker): Initialize marker's bytepos and charpos.
Richard M. Stallman <rms@gnu.org>
parents:
20495
diff
changeset
|
2669 p->charpos = 0; |
300 | 2670 p->chain = Qnil; |
13008
f042ef632b22
(Fmake_marker): Initialize insertion_type to 0.
Richard M. Stallman <rms@gnu.org>
parents:
12748
diff
changeset
|
2671 p->insertion_type = 0; |
300 | 2672 return val; |
2673 } | |
19332
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
2674 |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
2675 /* 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
|
2676 |
20375
1dd0bd0749b5
(malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents:
20057
diff
changeset
|
2677 void |
19332
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
2678 free_marker (marker) |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
2679 Lisp_Object marker; |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
2680 { |
19621
74151390752c
(free_marker): Call unchain_marker.
Richard M. Stallman <rms@gnu.org>
parents:
19332
diff
changeset
|
2681 unchain_marker (marker); |
74151390752c
(free_marker): Call unchain_marker.
Richard M. Stallman <rms@gnu.org>
parents:
19332
diff
changeset
|
2682 |
19332
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
2683 XMISC (marker)->u_marker.type = Lisp_Misc_Free; |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
2684 XMISC (marker)->u_free.chain = marker_free_list; |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
2685 marker_free_list = XMISC (marker); |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
2686 |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
2687 total_free_markers++; |
58f14958f5d5
(free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18621
diff
changeset
|
2688 } |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2689 |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
2690 |
300 | 2691 /* 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
|
2692 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
|
2693 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
|
2694 |
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
2695 Any number of arguments, even zero arguments, are allowed. */ |
300 | 2696 |
2697 Lisp_Object | |
2013
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
2698 make_event_array (nargs, args) |
300 | 2699 register int nargs; |
2700 Lisp_Object *args; | |
2701 { | |
2702 int i; | |
2703 | |
2704 for (i = 0; i < nargs; i++) | |
2013
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
2705 /* 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
|
2706 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
|
2707 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
|
2708 if (!INTEGERP (args[i]) |
3536
58d5ee6ec253
(make_event_array): Ignore bits above CHAR_META.
Richard M. Stallman <rms@gnu.org>
parents:
3181
diff
changeset
|
2709 || (XUINT (args[i]) & ~(-CHAR_META)) >= 0200) |
300 | 2710 return Fvector (nargs, args); |
2711 | |
2712 /* Since the loop exited, we know that all the things in it are | |
2713 characters, so we can make a string. */ | |
2714 { | |
6492
8372dce85f8a
(make_event_array): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
parents:
6227
diff
changeset
|
2715 Lisp_Object result; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2716 |
18104
b2a669ef69b1
(Fmake_byte_code): Set val from p, not from val.
Richard M. Stallman <rms@gnu.org>
parents:
18010
diff
changeset
|
2717 result = Fmake_string (make_number (nargs), make_number (0)); |
300 | 2718 for (i = 0; i < nargs; i++) |
2013
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
2719 { |
46418
b12a32662433
* alloc.c (make_event_array): Use SSET for storing into a string.
Ken Raeburn <raeburn@raeburn.org>
parents:
46370
diff
changeset
|
2720 SSET (result, i, XINT (args[i])); |
2013
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
2721 /* 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
|
2722 if (XINT (args[i]) & CHAR_META) |
46418
b12a32662433
* alloc.c (make_event_array): Use SSET for storing into a string.
Ken Raeburn <raeburn@raeburn.org>
parents:
46370
diff
changeset
|
2723 SSET (result, i, SREF (result, i) | 0x80); |
2013
e2a164ac4088
(Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents:
1994
diff
changeset
|
2724 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2725 |
300 | 2726 return result; |
2727 } | |
2728 } | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2729 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
2730 |
300 | 2731 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2732 /************************************************************************ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2733 C Stack Marking |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2734 ************************************************************************/ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2735 |
32700
25c6c2562e31
(toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents:
32699
diff
changeset
|
2736 #if GC_MARK_STACK || defined GC_MALLOC_CHECK |
25c6c2562e31
(toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents:
32699
diff
changeset
|
2737 |
42403 | 2738 /* Conservative C stack marking requires a method to identify possibly |
2739 live Lisp objects given a pointer value. We do this by keeping | |
2740 track of blocks of Lisp data that are allocated in a red-black tree | |
2741 (see also the comment of mem_node which is the type of nodes in | |
2742 that tree). Function lisp_malloc adds information for an allocated | |
2743 block to the red-black tree with calls to mem_insert, and function | |
2744 lisp_free removes it with mem_delete. Functions live_string_p etc | |
2745 call mem_find to lookup information about a given pointer in the | |
2746 tree, and use that to determine if the pointer points to a Lisp | |
2747 object or not. */ | |
2748 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2749 /* Initialize this part of alloc.c. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2750 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2751 static void |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2752 mem_init () |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2753 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2754 mem_z.left = mem_z.right = MEM_NIL; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2755 mem_z.parent = NULL; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2756 mem_z.color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2757 mem_z.start = mem_z.end = NULL; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2758 mem_root = MEM_NIL; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2759 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2760 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2761 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2762 /* Value is a pointer to the mem_node containing START. Value is |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2763 MEM_NIL if there is no node in the tree containing START. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2764 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2765 static INLINE struct mem_node * |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2766 mem_find (start) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2767 void *start; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2768 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2769 struct mem_node *p; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2770 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2771 if (start < min_heap_address || start > max_heap_address) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2772 return MEM_NIL; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2773 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2774 /* Make the search always successful to speed up the loop below. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2775 mem_z.start = start; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2776 mem_z.end = (char *) start + 1; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2777 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2778 p = mem_root; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2779 while (start < p->start || start >= p->end) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2780 p = start < p->start ? p->left : p->right; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2781 return p; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2782 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2783 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2784 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2785 /* Insert a new node into the tree for a block of memory with start |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2786 address START, end address END, and type TYPE. Value is a |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2787 pointer to the node that was inserted. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2788 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2789 static struct mem_node * |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2790 mem_insert (start, end, type) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2791 void *start, *end; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2792 enum mem_type type; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2793 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2794 struct mem_node *c, *parent, *x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2795 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2796 if (start < min_heap_address) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2797 min_heap_address = start; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2798 if (end > max_heap_address) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2799 max_heap_address = end; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
2800 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2801 /* See where in the tree a node for START belongs. In this |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2802 particular application, it shouldn't happen that a node is already |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2803 present. For debugging purposes, let's check that. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2804 c = mem_root; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2805 parent = NULL; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2806 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2807 #if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2808 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2809 while (c != MEM_NIL) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2810 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2811 if (start >= c->start && start < c->end) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2812 abort (); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2813 parent = c; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2814 c = start < c->start ? c->left : c->right; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2815 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2816 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2817 #else /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2818 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2819 while (c != MEM_NIL) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2820 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2821 parent = c; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2822 c = start < c->start ? c->left : c->right; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2823 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2824 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2825 #endif /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2826 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2827 /* Create a new node. */ |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
2828 #ifdef GC_MALLOC_CHECK |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
2829 x = (struct mem_node *) _malloc_internal (sizeof *x); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
2830 if (x == NULL) |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
2831 abort (); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
2832 #else |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2833 x = (struct mem_node *) xmalloc (sizeof *x); |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
2834 #endif |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2835 x->start = start; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2836 x->end = end; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2837 x->type = type; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2838 x->parent = parent; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2839 x->left = x->right = MEM_NIL; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2840 x->color = MEM_RED; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2841 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2842 /* Insert it as child of PARENT or install it as root. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2843 if (parent) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2844 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2845 if (start < parent->start) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2846 parent->left = x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2847 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2848 parent->right = x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2849 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2850 else |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2851 mem_root = x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2852 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2853 /* Re-establish red-black tree properties. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2854 mem_insert_fixup (x); |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
2855 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2856 return x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2857 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2858 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2859 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2860 /* Re-establish the red-black properties of the tree, and thereby |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2861 balance the tree, after node X has been inserted; X is always red. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2862 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2863 static void |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2864 mem_insert_fixup (x) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2865 struct mem_node *x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2866 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2867 while (x != mem_root && x->parent->color == MEM_RED) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2868 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2869 /* X is red and its parent is red. This is a violation of |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2870 red-black tree property #3. */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2871 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2872 if (x->parent == x->parent->parent->left) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2873 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2874 /* We're on the left side of our grandparent, and Y is our |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2875 "uncle". */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2876 struct mem_node *y = x->parent->parent->right; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2877 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2878 if (y->color == MEM_RED) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2879 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2880 /* Uncle and parent are red but should be black because |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2881 X is red. Change the colors accordingly and proceed |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2882 with the grandparent. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2883 x->parent->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2884 y->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2885 x->parent->parent->color = MEM_RED; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2886 x = x->parent->parent; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2887 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2888 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2889 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2890 /* Parent and uncle have different colors; parent is |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2891 red, uncle is black. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2892 if (x == x->parent->right) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2893 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2894 x = x->parent; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2895 mem_rotate_left (x); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2896 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2897 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2898 x->parent->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2899 x->parent->parent->color = MEM_RED; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2900 mem_rotate_right (x->parent->parent); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2901 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2902 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2903 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2904 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2905 /* This is the symmetrical case of above. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2906 struct mem_node *y = x->parent->parent->left; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2907 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2908 if (y->color == MEM_RED) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2909 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2910 x->parent->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2911 y->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2912 x->parent->parent->color = MEM_RED; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2913 x = x->parent->parent; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2914 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2915 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2916 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2917 if (x == x->parent->left) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2918 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2919 x = x->parent; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2920 mem_rotate_right (x); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2921 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2922 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2923 x->parent->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2924 x->parent->parent->color = MEM_RED; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2925 mem_rotate_left (x->parent->parent); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2926 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2927 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2928 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2929 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2930 /* The root may have been changed to red due to the algorithm. Set |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2931 it to black so that property #5 is satisfied. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2932 mem_root->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2933 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2934 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2935 |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2936 /* (x) (y) |
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2937 / \ / \ |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2938 a (y) ===> (x) c |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2939 / \ / \ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2940 b c a b */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2941 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2942 static void |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2943 mem_rotate_left (x) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2944 struct mem_node *x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2945 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2946 struct mem_node *y; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2947 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2948 /* Turn y's left sub-tree into x's right sub-tree. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2949 y = x->right; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2950 x->right = y->left; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2951 if (y->left != MEM_NIL) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2952 y->left->parent = x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2953 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2954 /* Y's parent was x's parent. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2955 if (y != MEM_NIL) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2956 y->parent = x->parent; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2957 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2958 /* Get the parent to point to y instead of x. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2959 if (x->parent) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2960 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2961 if (x == x->parent->left) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2962 x->parent->left = y; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2963 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2964 x->parent->right = y; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2965 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2966 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2967 mem_root = y; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2968 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2969 /* Put x on y's left. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2970 y->left = x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2971 if (x != MEM_NIL) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2972 x->parent = y; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2973 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2974 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2975 |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2976 /* (x) (Y) |
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2977 / \ / \ |
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2978 (y) c ===> a (x) |
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2979 / \ / \ |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2980 a b b c */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2981 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2982 static void |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2983 mem_rotate_right (x) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2984 struct mem_node *x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2985 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2986 struct mem_node *y = x->left; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2987 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2988 x->left = y->right; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2989 if (y->right != MEM_NIL) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2990 y->right->parent = x; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
2991 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2992 if (y != MEM_NIL) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2993 y->parent = x->parent; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2994 if (x->parent) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2995 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2996 if (x == x->parent->right) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2997 x->parent->right = y; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2998 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
2999 x->parent->left = y; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3000 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3001 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3002 mem_root = y; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3003 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3004 y->right = x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3005 if (x != MEM_NIL) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3006 x->parent = y; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3007 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3008 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3009 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3010 /* Delete node Z from the tree. If Z is null or MEM_NIL, do nothing. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3011 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3012 static void |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3013 mem_delete (z) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3014 struct mem_node *z; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3015 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3016 struct mem_node *x, *y; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3017 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3018 if (!z || z == MEM_NIL) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3019 return; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3020 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3021 if (z->left == MEM_NIL || z->right == MEM_NIL) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3022 y = z; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3023 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3024 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3025 y = z->right; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3026 while (y->left != MEM_NIL) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3027 y = y->left; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3028 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3029 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3030 if (y->left != MEM_NIL) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3031 x = y->left; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3032 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3033 x = y->right; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3034 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3035 x->parent = y->parent; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3036 if (y->parent) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3037 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3038 if (y == y->parent->left) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3039 y->parent->left = x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3040 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3041 y->parent->right = x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3042 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3043 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3044 mem_root = x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3045 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3046 if (y != z) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3047 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3048 z->start = y->start; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3049 z->end = y->end; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3050 z->type = y->type; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3051 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3052 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3053 if (y->color == MEM_BLACK) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3054 mem_delete_fixup (x); |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
3055 |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
3056 #ifdef GC_MALLOC_CHECK |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
3057 _free_internal (y); |
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
3058 #else |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3059 xfree (y); |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
3060 #endif |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3061 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3062 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3063 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3064 /* Re-establish the red-black properties of the tree, after a |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3065 deletion. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3066 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3067 static void |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3068 mem_delete_fixup (x) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3069 struct mem_node *x; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3070 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3071 while (x != mem_root && x->color == MEM_BLACK) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3072 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3073 if (x == x->parent->left) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3074 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3075 struct mem_node *w = x->parent->right; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3076 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3077 if (w->color == MEM_RED) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3078 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3079 w->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3080 x->parent->color = MEM_RED; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3081 mem_rotate_left (x->parent); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3082 w = x->parent->right; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3083 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3084 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3085 if (w->left->color == MEM_BLACK && w->right->color == MEM_BLACK) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3086 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3087 w->color = MEM_RED; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3088 x = x->parent; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3089 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3090 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3091 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3092 if (w->right->color == MEM_BLACK) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3093 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3094 w->left->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3095 w->color = MEM_RED; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3096 mem_rotate_right (w); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3097 w = x->parent->right; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3098 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3099 w->color = x->parent->color; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3100 x->parent->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3101 w->right->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3102 mem_rotate_left (x->parent); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3103 x = mem_root; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3104 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3105 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3106 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3107 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3108 struct mem_node *w = x->parent->left; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3109 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3110 if (w->color == MEM_RED) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3111 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3112 w->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3113 x->parent->color = MEM_RED; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3114 mem_rotate_right (x->parent); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3115 w = x->parent->left; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3116 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3117 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3118 if (w->right->color == MEM_BLACK && w->left->color == MEM_BLACK) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3119 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3120 w->color = MEM_RED; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3121 x = x->parent; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3122 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3123 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3124 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3125 if (w->left->color == MEM_BLACK) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3126 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3127 w->right->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3128 w->color = MEM_RED; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3129 mem_rotate_left (w); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3130 w = x->parent->left; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3131 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3132 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3133 w->color = x->parent->color; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3134 x->parent->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3135 w->left->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3136 mem_rotate_right (x->parent); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3137 x = mem_root; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3138 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3139 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3140 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3141 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3142 x->color = MEM_BLACK; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3143 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3144 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3145 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3146 /* Value is non-zero if P is a pointer to a live Lisp string on |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3147 the heap. M is a pointer to the mem_block for P. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3148 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3149 static INLINE int |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3150 live_string_p (m, p) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3151 struct mem_node *m; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3152 void *p; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3153 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3154 if (m->type == MEM_TYPE_STRING) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3155 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3156 struct string_block *b = (struct string_block *) m->start; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3157 int offset = (char *) p - (char *) &b->strings[0]; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3158 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3159 /* P must point to the start of a Lisp_String structure, and it |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3160 must not be on the free-list. */ |
37049
184d1fb71cc1
(live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents:
36487
diff
changeset
|
3161 return (offset >= 0 |
184d1fb71cc1
(live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents:
36487
diff
changeset
|
3162 && offset % sizeof b->strings[0] == 0 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3163 && ((struct Lisp_String *) p)->data != NULL); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3164 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3165 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3166 return 0; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3167 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3168 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3169 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3170 /* Value is non-zero if P is a pointer to a live Lisp cons on |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3171 the heap. M is a pointer to the mem_block for P. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3172 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3173 static INLINE int |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3174 live_cons_p (m, p) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3175 struct mem_node *m; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3176 void *p; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3177 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3178 if (m->type == MEM_TYPE_CONS) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3179 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3180 struct cons_block *b = (struct cons_block *) m->start; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3181 int offset = (char *) p - (char *) &b->conses[0]; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3182 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3183 /* P must point to the start of a Lisp_Cons, not be |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3184 one of the unused cells in the current cons block, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3185 and not be on the free-list. */ |
37049
184d1fb71cc1
(live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents:
36487
diff
changeset
|
3186 return (offset >= 0 |
184d1fb71cc1
(live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents:
36487
diff
changeset
|
3187 && offset % sizeof b->conses[0] == 0 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3188 && (b != cons_block |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3189 || offset / sizeof b->conses[0] < cons_block_index) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3190 && !EQ (((struct Lisp_Cons *) p)->car, Vdead)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3191 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3192 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3193 return 0; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3194 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3195 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3196 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3197 /* Value is non-zero if P is a pointer to a live Lisp symbol on |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3198 the heap. M is a pointer to the mem_block for P. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3199 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3200 static INLINE int |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3201 live_symbol_p (m, p) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3202 struct mem_node *m; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3203 void *p; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3204 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3205 if (m->type == MEM_TYPE_SYMBOL) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3206 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3207 struct symbol_block *b = (struct symbol_block *) m->start; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3208 int offset = (char *) p - (char *) &b->symbols[0]; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3209 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3210 /* P must point to the start of a Lisp_Symbol, not be |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3211 one of the unused cells in the current symbol block, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3212 and not be on the free-list. */ |
37049
184d1fb71cc1
(live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents:
36487
diff
changeset
|
3213 return (offset >= 0 |
184d1fb71cc1
(live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents:
36487
diff
changeset
|
3214 && offset % sizeof b->symbols[0] == 0 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3215 && (b != symbol_block |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3216 || offset / sizeof b->symbols[0] < symbol_block_index) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3217 && !EQ (((struct Lisp_Symbol *) p)->function, Vdead)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3218 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3219 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3220 return 0; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3221 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3222 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3223 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3224 /* Value is non-zero if P is a pointer to a live Lisp float on |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3225 the heap. M is a pointer to the mem_block for P. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3226 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3227 static INLINE int |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3228 live_float_p (m, p) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3229 struct mem_node *m; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3230 void *p; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3231 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3232 if (m->type == MEM_TYPE_FLOAT) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3233 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3234 struct float_block *b = (struct float_block *) m->start; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3235 int offset = (char *) p - (char *) &b->floats[0]; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3236 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3237 /* P must point to the start of a Lisp_Float, not be |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3238 one of the unused cells in the current float block, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3239 and not be on the free-list. */ |
37049
184d1fb71cc1
(live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents:
36487
diff
changeset
|
3240 return (offset >= 0 |
184d1fb71cc1
(live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents:
36487
diff
changeset
|
3241 && offset % sizeof b->floats[0] == 0 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3242 && (b != float_block |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3243 || offset / sizeof b->floats[0] < float_block_index) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3244 && !EQ (((struct Lisp_Float *) p)->type, Vdead)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3245 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3246 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3247 return 0; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3248 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3249 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3250 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3251 /* Value is non-zero if P is a pointer to a live Lisp Misc on |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3252 the heap. M is a pointer to the mem_block for P. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3253 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3254 static INLINE int |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3255 live_misc_p (m, p) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3256 struct mem_node *m; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3257 void *p; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3258 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3259 if (m->type == MEM_TYPE_MISC) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3260 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3261 struct marker_block *b = (struct marker_block *) m->start; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3262 int offset = (char *) p - (char *) &b->markers[0]; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3263 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3264 /* P must point to the start of a Lisp_Misc, not be |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3265 one of the unused cells in the current misc block, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3266 and not be on the free-list. */ |
37049
184d1fb71cc1
(live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents:
36487
diff
changeset
|
3267 return (offset >= 0 |
184d1fb71cc1
(live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents:
36487
diff
changeset
|
3268 && offset % sizeof b->markers[0] == 0 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3269 && (b != marker_block |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3270 || offset / sizeof b->markers[0] < marker_block_index) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3271 && ((union Lisp_Misc *) p)->u_marker.type != Lisp_Misc_Free); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3272 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3273 else |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3274 return 0; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3275 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3276 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3277 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3278 /* Value is non-zero if P is a pointer to a live vector-like object. |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3279 M is a pointer to the mem_block for P. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3280 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3281 static INLINE int |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3282 live_vector_p (m, p) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3283 struct mem_node *m; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3284 void *p; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3285 { |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3286 return (p == m->start |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3287 && m->type >= MEM_TYPE_VECTOR |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3288 && m->type <= MEM_TYPE_WINDOW); |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3289 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3290 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3291 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3292 /* Value is non-zero of P is a pointer to a live buffer. M is a |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3293 pointer to the mem_block for P. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3294 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3295 static INLINE int |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3296 live_buffer_p (m, p) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3297 struct mem_node *m; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3298 void *p; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3299 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3300 /* P must point to the start of the block, and the buffer |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3301 must not have been killed. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3302 return (m->type == MEM_TYPE_BUFFER |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3303 && p == m->start |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3304 && !NILP (((struct buffer *) p)->name)); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3305 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3306 |
32700
25c6c2562e31
(toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents:
32699
diff
changeset
|
3307 #endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */ |
25c6c2562e31
(toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents:
32699
diff
changeset
|
3308 |
25c6c2562e31
(toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents:
32699
diff
changeset
|
3309 #if GC_MARK_STACK |
25c6c2562e31
(toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents:
32699
diff
changeset
|
3310 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3311 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3312 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3313 /* Array of objects that are kept alive because the C stack contains |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3314 a pattern that looks like a reference to them . */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3315 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3316 #define MAX_ZOMBIES 10 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3317 static Lisp_Object zombies[MAX_ZOMBIES]; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3318 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3319 /* Number of zombie objects. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3320 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3321 static int nzombies; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3322 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3323 /* Number of garbage collections. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3324 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3325 static int ngcs; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3326 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3327 /* Average percentage of zombies per collection. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3328 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3329 static double avg_zombies; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3330 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3331 /* Max. number of live and zombie objects. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3332 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3333 static int max_live, max_zombies; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3334 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3335 /* Average number of live objects per GC. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3336 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3337 static double avg_live; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3338 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3339 DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "", |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3340 doc: /* Show information about live and zombie objects. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3341 () |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3342 { |
49357 | 3343 Lisp_Object args[8], zombie_list = Qnil; |
3344 int i; | |
3345 for (i = 0; i < nzombies; i++) | |
3346 zombie_list = Fcons (zombies[i], zombie_list); | |
3347 args[0] = build_string ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d\nzombies: %S"); | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3348 args[1] = make_number (ngcs); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3349 args[2] = make_float (avg_live); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3350 args[3] = make_float (avg_zombies); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3351 args[4] = make_float (avg_zombies / avg_live / 100); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3352 args[5] = make_number (max_live); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3353 args[6] = make_number (max_zombies); |
49357 | 3354 args[7] = zombie_list; |
3355 return Fmessage (8, args); | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3356 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3357 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3358 #endif /* GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3359 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3360 |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3361 /* Mark OBJ if we can prove it's a Lisp_Object. */ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3362 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3363 static INLINE void |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3364 mark_maybe_object (obj) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3365 Lisp_Object obj; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3366 { |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3367 void *po = (void *) XPNTR (obj); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3368 struct mem_node *m = mem_find (po); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3369 |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3370 if (m != MEM_NIL) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3371 { |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3372 int mark_p = 0; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3373 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3374 switch (XGCTYPE (obj)) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3375 { |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3376 case Lisp_String: |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3377 mark_p = (live_string_p (m, po) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3378 && !STRING_MARKED_P ((struct Lisp_String *) po)); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3379 break; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3380 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3381 case Lisp_Cons: |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3382 mark_p = (live_cons_p (m, po) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3383 && !XMARKBIT (XCONS (obj)->car)); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3384 break; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3385 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3386 case Lisp_Symbol: |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3387 mark_p = (live_symbol_p (m, po) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3388 && !XMARKBIT (XSYMBOL (obj)->plist)); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3389 break; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3390 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3391 case Lisp_Float: |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3392 mark_p = (live_float_p (m, po) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3393 && !XMARKBIT (XFLOAT (obj)->type)); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3394 break; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3395 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3396 case Lisp_Vectorlike: |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3397 /* Note: can't check GC_BUFFERP before we know it's a |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3398 buffer because checking that dereferences the pointer |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3399 PO which might point anywhere. */ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3400 if (live_vector_p (m, po)) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3401 mark_p = (!GC_SUBRP (obj) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3402 && !(XVECTOR (obj)->size & ARRAY_MARK_FLAG)); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3403 else if (live_buffer_p (m, po)) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3404 mark_p = GC_BUFFERP (obj) && !XMARKBIT (XBUFFER (obj)->name); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3405 break; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3406 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3407 case Lisp_Misc: |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3408 if (live_misc_p (m, po)) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3409 { |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3410 switch (XMISCTYPE (obj)) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3411 { |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3412 case Lisp_Misc_Marker: |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3413 mark_p = !XMARKBIT (XMARKER (obj)->chain); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3414 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3415 |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3416 case Lisp_Misc_Buffer_Local_Value: |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3417 case Lisp_Misc_Some_Buffer_Local_Value: |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3418 mark_p = !XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3419 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3420 |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3421 case Lisp_Misc_Overlay: |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3422 mark_p = !XMARKBIT (XOVERLAY (obj)->plist); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3423 break; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3424 } |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3425 } |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3426 break; |
31829
43566b0aec59
Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents:
31576
diff
changeset
|
3427 |
43566b0aec59
Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents:
31576
diff
changeset
|
3428 case Lisp_Int: |
31897
a292cc13911a
(GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents:
31892
diff
changeset
|
3429 case Lisp_Type_Limit: |
31829
43566b0aec59
Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents:
31576
diff
changeset
|
3430 break; |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3431 } |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3432 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3433 if (mark_p) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3434 { |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3435 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3436 if (nzombies < MAX_ZOMBIES) |
49357 | 3437 zombies[nzombies] = obj; |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3438 ++nzombies; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3439 #endif |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3440 mark_object (&obj); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3441 } |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3442 } |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3443 } |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3444 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3445 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3446 /* If P points to Lisp data, mark that as live if it isn't already |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3447 marked. */ |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3448 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3449 static INLINE void |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3450 mark_maybe_pointer (p) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3451 void *p; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3452 { |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3453 struct mem_node *m; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3454 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3455 /* Quickly rule out some values which can't point to Lisp data. We |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3456 assume that Lisp data is aligned on even addresses. */ |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3457 if ((EMACS_INT) p & 1) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3458 return; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3459 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3460 m = mem_find (p); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3461 if (m != MEM_NIL) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3462 { |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3463 Lisp_Object obj = Qnil; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3464 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3465 switch (m->type) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3466 { |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3467 case MEM_TYPE_NON_LISP: |
36487
4df2ac60690e
(mark_maybe_pointer): Fix a typo in a comment.
Eli Zaretskii <eliz@gnu.org>
parents:
36435
diff
changeset
|
3468 /* Nothing to do; not a pointer to Lisp memory. */ |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3469 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3470 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3471 case MEM_TYPE_BUFFER: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3472 if (live_buffer_p (m, p) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3473 && !XMARKBIT (((struct buffer *) p)->name)) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3474 XSETVECTOR (obj, p); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3475 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3476 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3477 case MEM_TYPE_CONS: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3478 if (live_cons_p (m, p) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3479 && !XMARKBIT (((struct Lisp_Cons *) p)->car)) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3480 XSETCONS (obj, p); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3481 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3482 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3483 case MEM_TYPE_STRING: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3484 if (live_string_p (m, p) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3485 && !STRING_MARKED_P ((struct Lisp_String *) p)) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3486 XSETSTRING (obj, p); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3487 break; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3488 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3489 case MEM_TYPE_MISC: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3490 if (live_misc_p (m, p)) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3491 { |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3492 Lisp_Object tem; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3493 XSETMISC (tem, p); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3494 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3495 switch (XMISCTYPE (tem)) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3496 { |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3497 case Lisp_Misc_Marker: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3498 if (!XMARKBIT (XMARKER (tem)->chain)) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3499 obj = tem; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3500 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3501 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3502 case Lisp_Misc_Buffer_Local_Value: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3503 case Lisp_Misc_Some_Buffer_Local_Value: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3504 if (!XMARKBIT (XBUFFER_LOCAL_VALUE (tem)->realvalue)) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3505 obj = tem; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3506 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3507 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3508 case Lisp_Misc_Overlay: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3509 if (!XMARKBIT (XOVERLAY (tem)->plist)) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3510 obj = tem; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3511 break; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3512 } |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3513 } |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3514 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3515 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3516 case MEM_TYPE_SYMBOL: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3517 if (live_symbol_p (m, p) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3518 && !XMARKBIT (((struct Lisp_Symbol *) p)->plist)) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3519 XSETSYMBOL (obj, p); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3520 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3521 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3522 case MEM_TYPE_FLOAT: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3523 if (live_float_p (m, p) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3524 && !XMARKBIT (((struct Lisp_Float *) p)->type)) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3525 XSETFLOAT (obj, p); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3526 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3527 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3528 case MEM_TYPE_VECTOR: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3529 case MEM_TYPE_PROCESS: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3530 case MEM_TYPE_HASH_TABLE: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3531 case MEM_TYPE_FRAME: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3532 case MEM_TYPE_WINDOW: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3533 if (live_vector_p (m, p)) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3534 { |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3535 Lisp_Object tem; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3536 XSETVECTOR (tem, p); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3537 if (!GC_SUBRP (tem) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3538 && !(XVECTOR (tem)->size & ARRAY_MARK_FLAG)) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3539 obj = tem; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3540 } |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3541 break; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3542 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3543 default: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3544 abort (); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3545 } |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3546 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3547 if (!GC_NILP (obj)) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3548 mark_object (&obj); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3549 } |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3550 } |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3551 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3552 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3553 /* Mark Lisp objects referenced from the address range START..END. */ |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3554 |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3555 static void |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3556 mark_memory (start, end) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3557 void *start, *end; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3558 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3559 Lisp_Object *p; |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3560 void **pp; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3561 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3562 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3563 nzombies = 0; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3564 #endif |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3565 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3566 /* Make START the pointer to the start of the memory region, |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3567 if it isn't already. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3568 if (end < start) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3569 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3570 void *tem = start; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3571 start = end; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3572 end = tem; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3573 } |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3574 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3575 /* Mark Lisp_Objects. */ |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3576 for (p = (Lisp_Object *) start; (void *) p < end; ++p) |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3577 mark_maybe_object (*p); |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3578 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3579 /* Mark Lisp data pointed to. This is necessary because, in some |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3580 situations, the C compiler optimizes Lisp objects away, so that |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3581 only a pointer to them remains. Example: |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3582 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3583 DEFUN ("testme", Ftestme, Stestme, 0, 0, 0, "") |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3584 () |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3585 { |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3586 Lisp_Object obj = build_string ("test"); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3587 struct Lisp_String *s = XSTRING (obj); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3588 Fgarbage_collect (); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3589 fprintf (stderr, "test `%s'\n", s->data); |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3590 return Qnil; |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3591 } |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3592 |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3593 Here, `obj' isn't really used, and the compiler optimizes it |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3594 away. The only reference to the life string is through the |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3595 pointer `s'. */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3596 |
36435
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3597 for (pp = (void **) start; (void *) pp < end; ++pp) |
5a989d353a68
(toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents:
35762
diff
changeset
|
3598 mark_maybe_pointer (*pp); |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3599 } |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3600 |
48316 | 3601 /* setjmp will work with GCC unless NON_SAVING_SETJMP is defined in |
3602 the GCC system configuration. In gcc 3.2, the only systems for | |
3603 which this is so are i386-sco5 non-ELF, i386-sysv3 (maybe included | |
3604 by others?) and ns32k-pc532-min. */ | |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3605 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3606 #if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3607 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3608 static int setjmp_tested_p, longjmps_done; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3609 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3610 #define SETJMP_WILL_LIKELY_WORK "\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3611 \n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3612 Emacs garbage collector has been changed to use conservative stack\n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3613 marking. Emacs has determined that the method it uses to do the\n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3614 marking will likely work on your system, but this isn't sure.\n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3615 \n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3616 If you are a system-programmer, or can get the help of a local wizard\n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3617 who is, please take a look at the function mark_stack in alloc.c, and\n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3618 verify that the methods used are appropriate for your system.\n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3619 \n\ |
43200
4082674ce69b
(SETJMP_WILL_LIKELY_WORK, SETJMP_WILL_NOT_WORK):
Kim F. Storm <storm@cua.dk>
parents:
43161
diff
changeset
|
3620 Please mail the result to <emacs-devel@gnu.org>.\n\ |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3621 " |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3622 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3623 #define SETJMP_WILL_NOT_WORK "\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3624 \n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3625 Emacs garbage collector has been changed to use conservative stack\n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3626 marking. Emacs has determined that the default method it uses to do the\n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3627 marking will not work on your system. We will need a system-dependent\n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3628 solution for your system.\n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3629 \n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3630 Please take a look at the function mark_stack in alloc.c, and\n\ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3631 try to find a way to make it work on your system.\n\ |
48316 | 3632 \n\ |
3633 Note that you may get false negatives, depending on the compiler.\n\ | |
3634 In particular, you need to use -O with GCC for this test.\n\ | |
3635 \n\ | |
43200
4082674ce69b
(SETJMP_WILL_LIKELY_WORK, SETJMP_WILL_NOT_WORK):
Kim F. Storm <storm@cua.dk>
parents:
43161
diff
changeset
|
3636 Please mail the result to <emacs-devel@gnu.org>.\n\ |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3637 " |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3638 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3639 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3640 /* Perform a quick check if it looks like setjmp saves registers in a |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3641 jmp_buf. Print a message to stderr saying so. When this test |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3642 succeeds, this is _not_ a proof that setjmp is sufficient for |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3643 conservative stack marking. Only the sources or a disassembly |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3644 can prove that. */ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3645 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3646 static void |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3647 test_setjmp () |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3648 { |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3649 char buf[10]; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3650 register int x; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3651 jmp_buf jbuf; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3652 int result = 0; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3653 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3654 /* Arrange for X to be put in a register. */ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3655 sprintf (buf, "1"); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3656 x = strlen (buf); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3657 x = 2 * x - 1; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3658 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3659 setjmp (jbuf); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3660 if (longjmps_done == 1) |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3661 { |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3662 /* Came here after the longjmp at the end of the function. |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3663 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3664 If x == 1, the longjmp has restored the register to its |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3665 value before the setjmp, and we can hope that setjmp |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3666 saves all such registers in the jmp_buf, although that |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3667 isn't sure. |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3668 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3669 For other values of X, either something really strange is |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3670 taking place, or the setjmp just didn't save the register. */ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3671 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3672 if (x == 1) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3673 fprintf (stderr, SETJMP_WILL_LIKELY_WORK); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3674 else |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3675 { |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3676 fprintf (stderr, SETJMP_WILL_NOT_WORK); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3677 exit (1); |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3678 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3679 } |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3680 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3681 ++longjmps_done; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3682 x = 2; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3683 if (longjmps_done == 1) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3684 longjmp (jbuf, 1); |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3685 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3686 |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3687 #endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3688 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3689 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3690 #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3691 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3692 /* Abort if anything GCPRO'd doesn't survive the GC. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3693 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3694 static void |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3695 check_gcpros () |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3696 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3697 struct gcpro *p; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3698 int i; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3699 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3700 for (p = gcprolist; p; p = p->next) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3701 for (i = 0; i < p->nvars; ++i) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3702 if (!survives_gc_p (p->var[i])) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3703 abort (); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3704 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3705 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3706 #elif GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3707 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3708 static void |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3709 dump_zombies () |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3710 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3711 int i; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3712 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3713 fprintf (stderr, "\nZombies kept alive = %d:\n", nzombies); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3714 for (i = 0; i < min (MAX_ZOMBIES, nzombies); ++i) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3715 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3716 fprintf (stderr, " %d = ", i); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3717 debug_print (zombies[i]); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3718 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3719 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3720 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3721 #endif /* GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3722 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3723 |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3724 /* Mark live Lisp objects on the C stack. |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3725 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3726 There are several system-dependent problems to consider when |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3727 porting this to new architectures: |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3728 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3729 Processor Registers |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3730 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3731 We have to mark Lisp objects in CPU registers that can hold local |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3732 variables or are used to pass parameters. |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3733 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3734 If GC_SAVE_REGISTERS_ON_STACK is defined, it should expand to |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3735 something that either saves relevant registers on the stack, or |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3736 calls mark_maybe_object passing it each register's contents. |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3737 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3738 If GC_SAVE_REGISTERS_ON_STACK is not defined, the current |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3739 implementation assumes that calling setjmp saves registers we need |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3740 to see in a jmp_buf which itself lies on the stack. This doesn't |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3741 have to be true! It must be verified for each system, possibly |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3742 by taking a look at the source code of setjmp. |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3743 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3744 Stack Layout |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3745 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3746 Architectures differ in the way their processor stack is organized. |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3747 For example, the stack might look like this |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3748 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3749 +----------------+ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3750 | Lisp_Object | size = 4 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3751 +----------------+ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3752 | something else | size = 2 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3753 +----------------+ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3754 | Lisp_Object | size = 4 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3755 +----------------+ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3756 | ... | |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3757 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3758 In such a case, not every Lisp_Object will be aligned equally. To |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3759 find all Lisp_Object on the stack it won't be sufficient to walk |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3760 the stack in steps of 4 bytes. Instead, two passes will be |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3761 necessary, one starting at the start of the stack, and a second |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3762 pass starting at the start of the stack + 2. Likewise, if the |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3763 minimal alignment of Lisp_Objects on the stack is 1, four passes |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3764 would be necessary, each one starting with one byte more offset |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3765 from the stack start. |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3766 |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3767 The current code assumes by default that Lisp_Objects are aligned |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3768 equally on the stack. */ |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3769 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3770 static void |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3771 mark_stack () |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3772 { |
43160
630c8b6deafd
(mark_stack): Don't assume sizeof (Lisp_Object) is 4.
Andreas Schwab <schwab@suse.de>
parents:
43005
diff
changeset
|
3773 int i; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3774 jmp_buf j; |
31829
43566b0aec59
Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents:
31576
diff
changeset
|
3775 volatile int stack_grows_down_p = (char *) &j > (char *) stack_base; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3776 void *end; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3777 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3778 /* This trick flushes the register windows so that all the state of |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3779 the process is contained in the stack. */ |
49414
668c96afa702
(mark_stack) [!GC_LISP_OBJECT_ALIGNMENT && __GNUC__]:
Dave Love <fx@gnu.org>
parents:
49357
diff
changeset
|
3780 /* Fixme: Code in the Boehm GC sugests flushing (with `flushrs') is |
668c96afa702
(mark_stack) [!GC_LISP_OBJECT_ALIGNMENT && __GNUC__]:
Dave Love <fx@gnu.org>
parents:
49357
diff
changeset
|
3781 needed on ia64 too. See mach_dep.c, where it also says inline |
668c96afa702
(mark_stack) [!GC_LISP_OBJECT_ALIGNMENT && __GNUC__]:
Dave Love <fx@gnu.org>
parents:
49357
diff
changeset
|
3782 assembler doesn't work with relevant proprietary compilers. */ |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3783 #ifdef sparc |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3784 asm ("ta 3"); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3785 #endif |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3786 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3787 /* Save registers that we need to see on the stack. We need to see |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3788 registers used to hold register variables and registers used to |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3789 pass parameters. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3790 #ifdef GC_SAVE_REGISTERS_ON_STACK |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3791 GC_SAVE_REGISTERS_ON_STACK (end); |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3792 #else /* not GC_SAVE_REGISTERS_ON_STACK */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3793 |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3794 #ifndef GC_SETJMP_WORKS /* If it hasn't been checked yet that |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3795 setjmp will definitely work, test it |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3796 and print a message with the result |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3797 of the test. */ |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3798 if (!setjmp_tested_p) |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3799 { |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3800 setjmp_tested_p = 1; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3801 test_setjmp (); |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3802 } |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3803 #endif /* GC_SETJMP_WORKS */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
3804 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3805 setjmp (j); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3806 end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j; |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3807 #endif /* not GC_SAVE_REGISTERS_ON_STACK */ |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3808 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3809 /* This assumes that the stack is a contiguous region in memory. If |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3810 that's not the case, something has to be done here to iterate |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3811 over the stack segments. */ |
43160
630c8b6deafd
(mark_stack): Don't assume sizeof (Lisp_Object) is 4.
Andreas Schwab <schwab@suse.de>
parents:
43005
diff
changeset
|
3812 #ifndef GC_LISP_OBJECT_ALIGNMENT |
49414
668c96afa702
(mark_stack) [!GC_LISP_OBJECT_ALIGNMENT && __GNUC__]:
Dave Love <fx@gnu.org>
parents:
49357
diff
changeset
|
3813 #ifdef __GNUC__ |
668c96afa702
(mark_stack) [!GC_LISP_OBJECT_ALIGNMENT && __GNUC__]:
Dave Love <fx@gnu.org>
parents:
49357
diff
changeset
|
3814 #define GC_LISP_OBJECT_ALIGNMENT __alignof__ (Lisp_Object) |
668c96afa702
(mark_stack) [!GC_LISP_OBJECT_ALIGNMENT && __GNUC__]:
Dave Love <fx@gnu.org>
parents:
49357
diff
changeset
|
3815 #else |
43160
630c8b6deafd
(mark_stack): Don't assume sizeof (Lisp_Object) is 4.
Andreas Schwab <schwab@suse.de>
parents:
43005
diff
changeset
|
3816 #define GC_LISP_OBJECT_ALIGNMENT sizeof (Lisp_Object) |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
3817 #endif |
49414
668c96afa702
(mark_stack) [!GC_LISP_OBJECT_ALIGNMENT && __GNUC__]:
Dave Love <fx@gnu.org>
parents:
49357
diff
changeset
|
3818 #endif |
43161
8a549ab185a2
Fix thinko in last change.
Andreas Schwab <schwab@suse.de>
parents:
43160
diff
changeset
|
3819 for (i = 0; i < sizeof (Lisp_Object); i += GC_LISP_OBJECT_ALIGNMENT) |
43160
630c8b6deafd
(mark_stack): Don't assume sizeof (Lisp_Object) is 4.
Andreas Schwab <schwab@suse.de>
parents:
43005
diff
changeset
|
3820 mark_memory ((char *) stack_base + i, end); |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3821 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3822 #if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3823 check_gcpros (); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3824 #endif |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3825 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3826 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3827 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3828 #endif /* GC_MARK_STACK != 0 */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3829 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3830 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3831 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3832 /*********************************************************************** |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3833 Pure Storage Management |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3834 ***********************************************************************/ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3835 |
32594
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3836 /* Allocate room for SIZE bytes from pure Lisp storage and return a |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3837 pointer to it. TYPE is the Lisp type for which the memory is |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3838 allocated. TYPE < 0 means it's not used for a Lisp object. |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3839 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3840 If store_pure_type_info is set and TYPE is >= 0, the type of |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3841 the allocated object is recorded in pure_types. */ |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3842 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3843 static POINTER_TYPE * |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3844 pure_alloc (size, type) |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3845 size_t size; |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3846 int type; |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3847 { |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3848 POINTER_TYPE *result; |
49159
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3849 size_t alignment = sizeof (EMACS_INT); |
32594
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3850 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3851 /* Give Lisp_Floats an extra alignment. */ |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3852 if (type == Lisp_Float) |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3853 { |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3854 #if defined __GNUC__ && __GNUC__ >= 2 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3855 alignment = __alignof (struct Lisp_Float); |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3856 #else |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3857 alignment = sizeof (struct Lisp_Float); |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3858 #endif |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3859 } |
49159
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3860 |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3861 again: |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3862 result = (POINTER_TYPE *) ALIGN ((EMACS_UINT)purebeg + pure_bytes_used, alignment); |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3863 pure_bytes_used = ((char *)result - (char *)purebeg) + size; |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3864 |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3865 if (pure_bytes_used <= pure_size) |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3866 return result; |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3867 |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3868 /* Don't allocate a large amount here, |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3869 because it might get mmap'd and then its address |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3870 might not be usable. */ |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3871 purebeg = (char *) xmalloc (10000); |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3872 pure_size = 10000; |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3873 pure_bytes_used_before_overflow += pure_bytes_used - size; |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3874 pure_bytes_used = 0; |
bc82a79251b5
(pure_alloc): Rewritten and simplified.
Kim F. Storm <storm@cua.dk>
parents:
49158
diff
changeset
|
3875 goto again; |
32594
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3876 } |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3877 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3878 |
44149
a3e6cfa20afd
(check_pure_size): Update the comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
44100
diff
changeset
|
3879 /* Print a warning if PURESIZE is too small. */ |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
3880 |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
3881 void |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
3882 check_pure_size () |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
3883 { |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
3884 if (pure_bytes_used_before_overflow) |
44100
57e965380c39
(check_pure_size): Only output a warning.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43751
diff
changeset
|
3885 message ("Pure Lisp storage overflow (approx. %d bytes needed)", |
57e965380c39
(check_pure_size): Only output a warning.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
43751
diff
changeset
|
3886 (int) (pure_bytes_used + pure_bytes_used_before_overflow)); |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
3887 } |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
3888 |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
3889 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3890 /* Return a string allocated in pure space. DATA is a buffer holding |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3891 NCHARS characters, and NBYTES bytes of string data. MULTIBYTE |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3892 non-zero means make the result string multibyte. |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3893 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3894 Must get an error if pure storage is full, since if it cannot hold |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3895 a large string it may be able to hold conses that point to that |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3896 string; then the string is not protected from gc. */ |
300 | 3897 |
3898 Lisp_Object | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3899 make_pure_string (data, nchars, nbytes, multibyte) |
300 | 3900 char *data; |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3901 int nchars, nbytes; |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
3902 int multibyte; |
300 | 3903 { |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3904 Lisp_Object string; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3905 struct Lisp_String *s; |
32594
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3906 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3907 s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3908 s->data = (unsigned char *) pure_alloc (nbytes + 1, -1); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3909 s->size = nchars; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3910 s->size_byte = multibyte ? nbytes : -1; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3911 bcopy (data, s->data, nbytes); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3912 s->data[nbytes] = '\0'; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3913 s->intervals = NULL_INTERVAL; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3914 XSETSTRING (string, s); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3915 return string; |
300 | 3916 } |
3917 | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
3918 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3919 /* Return a cons allocated from pure space. Give it pure copies |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3920 of CAR as car and CDR as cdr. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3921 |
300 | 3922 Lisp_Object |
3923 pure_cons (car, cdr) | |
3924 Lisp_Object car, cdr; | |
3925 { | |
3926 register Lisp_Object new; | |
32594
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3927 struct Lisp_Cons *p; |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3928 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3929 p = (struct Lisp_Cons *) pure_alloc (sizeof *p, Lisp_Cons); |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3930 XSETCONS (new, p); |
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39914
diff
changeset
|
3931 XSETCAR (new, Fpurecopy (car)); |
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39914
diff
changeset
|
3932 XSETCDR (new, Fpurecopy (cdr)); |
300 | 3933 return new; |
3934 } | |
3935 | |
3936 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3937 /* Value is a float object with value NUM allocated from pure space. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3938 |
300 | 3939 Lisp_Object |
3940 make_pure_float (num) | |
3941 double num; | |
3942 { | |
3943 register Lisp_Object new; | |
32594
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3944 struct Lisp_Float *p; |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3945 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3946 p = (struct Lisp_Float *) pure_alloc (sizeof *p, Lisp_Float); |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3947 XSETFLOAT (new, p); |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25544
diff
changeset
|
3948 XFLOAT_DATA (new) = num; |
300 | 3949 return new; |
3950 } | |
3951 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3952 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3953 /* Return a vector with room for LEN Lisp_Objects allocated from |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3954 pure space. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3955 |
300 | 3956 Lisp_Object |
3957 make_pure_vector (len) | |
8817
48ff00bebef6
(pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
3958 EMACS_INT len; |
300 | 3959 { |
32594
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3960 Lisp_Object new; |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3961 struct Lisp_Vector *p; |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3962 size_t size = sizeof *p + (len - 1) * sizeof (Lisp_Object); |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3963 |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3964 p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike); |
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3965 XSETVECTOR (new, p); |
300 | 3966 XVECTOR (new)->size = len; |
3967 return new; | |
3968 } | |
3969 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
3970 |
300 | 3971 DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3972 doc: /* Make a copy of OBJECT in pure storage. |
39914
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
3973 Recursively copies contents of vectors and cons cells. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3974 Does not copy symbols. Copies strings without text properties. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
3975 (obj) |
300 | 3976 register Lisp_Object obj; |
3977 { | |
485 | 3978 if (NILP (Vpurify_flag)) |
300 | 3979 return obj; |
3980 | |
32594
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
3981 if (PURE_POINTER_P (XPNTR (obj))) |
300 | 3982 return obj; |
3983 | |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
3984 if (CONSP (obj)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25544
diff
changeset
|
3985 return pure_cons (XCAR (obj), XCDR (obj)); |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
3986 else if (FLOATP (obj)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25544
diff
changeset
|
3987 return make_pure_float (XFLOAT_DATA (obj)); |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
3988 else if (STRINGP (obj)) |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
3989 return make_pure_string (SDATA (obj), SCHARS (obj), |
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
3990 SBYTES (obj), |
21258
693573ac0944
(make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
21244
diff
changeset
|
3991 STRING_MULTIBYTE (obj)); |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
3992 else if (COMPILEDP (obj) || VECTORP (obj)) |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
3993 { |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
3994 register struct Lisp_Vector *vec; |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
3995 register int i, size; |
300 | 3996 |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
3997 size = XVECTOR (obj)->size; |
10427
5faba1b094d5
(Fpurecopy): Mask size field when copying pseudovector.
Karl Heuer <kwzh@gnu.org>
parents:
10414
diff
changeset
|
3998 if (size & PSEUDOVECTOR_FLAG) |
5faba1b094d5
(Fpurecopy): Mask size field when copying pseudovector.
Karl Heuer <kwzh@gnu.org>
parents:
10414
diff
changeset
|
3999 size &= PSEUDOVECTOR_SIZE_MASK; |
16100
ccd19852de65
(Fpurecopy): Cast arg to make_pure_vector.
Richard M. Stallman <rms@gnu.org>
parents:
16051
diff
changeset
|
4000 vec = XVECTOR (make_pure_vector ((EMACS_INT) size)); |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
4001 for (i = 0; i < size; i++) |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
4002 vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]); |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
4003 if (COMPILEDP (obj)) |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
4004 XSETCOMPILED (obj, vec); |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
4005 else |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
4006 XSETVECTOR (obj, vec); |
300 | 4007 return obj; |
4008 } | |
10004
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
4009 else if (MARKERP (obj)) |
2c57cb7eba5f
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
9968
diff
changeset
|
4010 error ("Attempt to copy a marker to pure storage"); |
31829
43566b0aec59
Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents:
31576
diff
changeset
|
4011 |
43566b0aec59
Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents:
31576
diff
changeset
|
4012 return obj; |
300 | 4013 } |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4014 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4015 |
300 | 4016 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4017 /*********************************************************************** |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4018 Protection from GC |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4019 ***********************************************************************/ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4020 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4021 /* Put an entry in staticvec, pointing at the variable with address |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4022 VARADDRESS. */ |
300 | 4023 |
4024 void | |
4025 staticpro (varaddress) | |
4026 Lisp_Object *varaddress; | |
4027 { | |
4028 staticvec[staticidx++] = varaddress; | |
4029 if (staticidx >= NSTATICS) | |
4030 abort (); | |
4031 } | |
4032 | |
4033 struct catchtag | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4034 { |
300 | 4035 Lisp_Object tag; |
4036 Lisp_Object val; | |
4037 struct catchtag *next; | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4038 }; |
300 | 4039 |
4040 struct backtrace | |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4041 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4042 struct backtrace *next; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4043 Lisp_Object *function; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4044 Lisp_Object *args; /* Points to vector of args. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4045 int nargs; /* Length of vector. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4046 /* If nargs is UNEVALLED, args points to slot holding list of |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4047 unevalled args. */ |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4048 char evalargs; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4049 }; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4050 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4051 |
300 | 4052 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4053 /*********************************************************************** |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4054 Protection from GC |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4055 ***********************************************************************/ |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
4056 |
11374
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
4057 /* Temporarily prevent garbage collection. */ |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
4058 |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
4059 int |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
4060 inhibit_garbage_collection () |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
4061 { |
46293
1fb8f75062c6
Use macro SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
46285
diff
changeset
|
4062 int count = SPECPDL_INDEX (); |
41867
a555c6419185
(inhibit_garbage_collection): Don't exceed value an int can hold.
Andreas Schwab <schwab@suse.de>
parents:
41831
diff
changeset
|
4063 int nbits = min (VALBITS, BITS_PER_INT); |
a555c6419185
(inhibit_garbage_collection): Don't exceed value an int can hold.
Andreas Schwab <schwab@suse.de>
parents:
41831
diff
changeset
|
4064 |
a555c6419185
(inhibit_garbage_collection): Don't exceed value an int can hold.
Andreas Schwab <schwab@suse.de>
parents:
41831
diff
changeset
|
4065 specbind (Qgc_cons_threshold, make_number (((EMACS_INT) 1 << (nbits - 1)) - 1)); |
11374
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
4066 return count; |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
4067 } |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
4068 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4069 |
300 | 4070 DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "", |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4071 doc: /* Reclaim storage for Lisp objects no longer needed. |
39914
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
4072 Returns info on amount of space in use: |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
4073 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS) |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
4074 (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
4075 (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS) |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
4076 (USED-STRINGS . FREE-STRINGS)) |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
4077 Garbage collection happens automatically if you cons more than |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4078 `gc-cons-threshold' bytes of Lisp data since previous garbage collection. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
4079 () |
300 | 4080 { |
4081 register struct gcpro *tail; | |
4082 register struct specbinding *bind; | |
4083 struct catchtag *catch; | |
4084 struct handler *handler; | |
4085 register struct backtrace *backlist; | |
4086 char stack_top_variable; | |
4087 register int i; | |
25343
fe92158a9e83
(Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents:
25133
diff
changeset
|
4088 int message_p; |
34270
773e6aa2ec38
(Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents:
33800
diff
changeset
|
4089 Lisp_Object total[8]; |
46285
3f111801efb4
Rename BINDING_STACK_SIZE to SPECPDL_INDEX.
Juanma Barranquero <lekktu@gmail.com>
parents:
45392
diff
changeset
|
4090 int count = SPECPDL_INDEX (); |
49529
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
4091 EMACS_TIME t1, t2, t3; |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
4092 |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
4093 EMACS_GET_TIME (t1); |
300 | 4094 |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
4095 /* Can't GC if pure storage overflowed because we can't determine |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
4096 if something is a pure object or not. */ |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
4097 if (pure_bytes_used_before_overflow) |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
4098 return Qnil; |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
4099 |
11892
6be0b7a0ac44
(Fgarbage_collect): Clear consing_since_gc first thing.
Karl Heuer <kwzh@gnu.org>
parents:
11727
diff
changeset
|
4100 /* 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
|
4101 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
|
4102 consing_since_gc = 0; |
6be0b7a0ac44
(Fgarbage_collect): Clear consing_since_gc first thing.
Karl Heuer <kwzh@gnu.org>
parents:
11727
diff
changeset
|
4103 |
25343
fe92158a9e83
(Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents:
25133
diff
changeset
|
4104 /* Save what's currently displayed in the echo area. */ |
fe92158a9e83
(Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents:
25133
diff
changeset
|
4105 message_p = push_message (); |
47391
1afd007f814f
(Fgarbage_collect): Use pop_message_unwind.
Richard M. Stallman <rms@gnu.org>
parents:
47185
diff
changeset
|
4106 record_unwind_protect (pop_message_unwind, Qnil); |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4107 |
300 | 4108 /* Save a copy of the contents of the stack, for debugging. */ |
4109 #if MAX_SAVE_STACK > 0 | |
485 | 4110 if (NILP (Vpurify_flag)) |
300 | 4111 { |
4112 i = &stack_top_variable - stack_bottom; | |
4113 if (i < 0) i = -i; | |
4114 if (i < MAX_SAVE_STACK) | |
4115 { | |
4116 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
|
4117 stack_copy = (char *) xmalloc (stack_copy_size = i); |
300 | 4118 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
|
4119 stack_copy = (char *) xrealloc (stack_copy, (stack_copy_size = i)); |
300 | 4120 if (stack_copy) |
4121 { | |
8817
48ff00bebef6
(pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7307
diff
changeset
|
4122 if ((EMACS_INT) (&stack_top_variable - stack_bottom) > 0) |
300 | 4123 bcopy (stack_bottom, stack_copy, i); |
4124 else | |
4125 bcopy (&stack_top_variable, stack_copy, i); | |
4126 } | |
4127 } | |
4128 } | |
4129 #endif /* MAX_SAVE_STACK > 0 */ | |
4130 | |
14959
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
4131 if (garbage_collection_messages) |
10395
c121703d35c7
(Fgarbage_collect): Don't log the GC message.
Karl Heuer <kwzh@gnu.org>
parents:
10389
diff
changeset
|
4132 message1_nolog ("Garbage collecting..."); |
300 | 4133 |
23534
6f9c70db3a58
(Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents:
22382
diff
changeset
|
4134 BLOCK_INPUT; |
6f9c70db3a58
(Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents:
22382
diff
changeset
|
4135 |
22220
a0cd311af6e3
(Fgarbage_collect): Call shrink_regexp_cache.
Richard M. Stallman <rms@gnu.org>
parents:
21948
diff
changeset
|
4136 shrink_regexp_cache (); |
a0cd311af6e3
(Fgarbage_collect): Call shrink_regexp_cache.
Richard M. Stallman <rms@gnu.org>
parents:
21948
diff
changeset
|
4137 |
21680
c744d468bfb6
(Fgarbage_collect): Don't truncate command-history here.
Richard M. Stallman <rms@gnu.org>
parents:
21514
diff
changeset
|
4138 /* Don't keep undo information around forever. */ |
300 | 4139 { |
4140 register struct buffer *nextb = all_buffers; | |
4141 | |
4142 while (nextb) | |
4143 { | |
648 | 4144 /* If a buffer's undo list is Qt, that means that undo is |
4145 turned off in that buffer. Calling truncate_undo_list on | |
4146 Qt tends to return NULL, which effectively turns undo back on. | |
4147 So don't call truncate_undo_list if undo_list is Qt. */ | |
4148 if (! EQ (nextb->undo_list, Qt)) | |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4149 nextb->undo_list |
764 | 4150 = truncate_undo_list (nextb->undo_list, undo_limit, |
4151 undo_strong_limit); | |
41831
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4152 |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4153 /* Shrink buffer gaps, but skip indirect and dead buffers. */ |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4154 if (nextb->base_buffer == 0 && !NILP (nextb->name)) |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4155 { |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4156 /* If a buffer's gap size is more than 10% of the buffer |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4157 size, or larger than 2000 bytes, then shrink it |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4158 accordingly. Keep a minimum size of 20 bytes. */ |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4159 int size = min (2000, max (20, (nextb->text->z_byte / 10))); |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4160 |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4161 if (nextb->text->gap_size > size) |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4162 { |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4163 struct buffer *save_current = current_buffer; |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4164 current_buffer = nextb; |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4165 make_gap (-(nextb->text->gap_size - size)); |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4166 current_buffer = save_current; |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4167 } |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4168 } |
fa7af2e13043
(Fgarbage_collect): Shrink buffer gaps that are
Andrew Innes <andrewi@gnu.org>
parents:
40977
diff
changeset
|
4169 |
300 | 4170 nextb = nextb->next; |
4171 } | |
4172 } | |
4173 | |
4174 gc_in_progress = 1; | |
4175 | |
16231 | 4176 /* clear_marks (); */ |
300 | 4177 |
4178 /* Mark all the special slots that serve as the roots of accessibility. | |
4179 | |
4180 Usually the special slots to mark are contained in particular structures. | |
4181 Then we know no slot is marked twice because the structures don't overlap. | |
4182 In some cases, the structures point to the slots to be marked. | |
4183 For these, we use MARKBIT to avoid double marking of the slot. */ | |
4184 | |
4185 for (i = 0; i < staticidx; i++) | |
4186 mark_object (staticvec[i]); | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4187 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4188 #if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4189 || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS) |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4190 mark_stack (); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4191 #else |
300 | 4192 for (tail = gcprolist; tail; tail = tail->next) |
4193 for (i = 0; i < tail->nvars; i++) | |
4194 if (!XMARKBIT (tail->var[i])) | |
4195 { | |
32099
31541e0a2704
(Fgarbage_collect): Prevent compiler warning for a call
Eli Zaretskii <eliz@gnu.org>
parents:
31897
diff
changeset
|
4196 /* Explicit casting prevents compiler warning about |
31541e0a2704
(Fgarbage_collect): Prevent compiler warning for a call
Eli Zaretskii <eliz@gnu.org>
parents:
31897
diff
changeset
|
4197 discarding the `volatile' qualifier. */ |
31541e0a2704
(Fgarbage_collect): Prevent compiler warning for a call
Eli Zaretskii <eliz@gnu.org>
parents:
31897
diff
changeset
|
4198 mark_object ((Lisp_Object *)&tail->var[i]); |
300 | 4199 XMARK (tail->var[i]); |
4200 } | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4201 #endif |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4202 |
26364
7b0217d9259c
(Fgarbage_collect): Call mark_byte_stack and
Gerd Moellmann <gerd@gnu.org>
parents:
26164
diff
changeset
|
4203 mark_byte_stack (); |
300 | 4204 for (bind = specpdl; bind != specpdl_ptr; bind++) |
4205 { | |
4206 mark_object (&bind->symbol); | |
4207 mark_object (&bind->old_value); | |
4208 } | |
4209 for (catch = catchlist; catch; catch = catch->next) | |
4210 { | |
4211 mark_object (&catch->tag); | |
4212 mark_object (&catch->val); | |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4213 } |
300 | 4214 for (handler = handlerlist; handler; handler = handler->next) |
4215 { | |
4216 mark_object (&handler->handler); | |
4217 mark_object (&handler->var); | |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4218 } |
300 | 4219 for (backlist = backtrace_list; backlist; backlist = backlist->next) |
4220 { | |
4221 if (!XMARKBIT (*backlist->function)) | |
4222 { | |
4223 mark_object (backlist->function); | |
4224 XMARK (*backlist->function); | |
4225 } | |
4226 if (backlist->nargs == UNEVALLED || backlist->nargs == MANY) | |
4227 i = 0; | |
4228 else | |
4229 i = backlist->nargs - 1; | |
4230 for (; i >= 0; i--) | |
4231 if (!XMARKBIT (backlist->args[i])) | |
4232 { | |
4233 mark_object (&backlist->args[i]); | |
4234 XMARK (backlist->args[i]); | |
4235 } | |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4236 } |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
4237 mark_kboards (); |
300 | 4238 |
21306
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4239 /* 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
|
4240 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
|
4241 and delete them. */ |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4242 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4243 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
|
4244 |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4245 while (nextb) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4246 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4247 /* 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
|
4248 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
|
4249 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
|
4250 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
|
4251 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
|
4252 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4253 Lisp_Object tail, prev; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4254 tail = nextb->undo_list; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4255 prev = Qnil; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4256 while (CONSP (tail)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4257 { |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25544
diff
changeset
|
4258 if (GC_CONSP (XCAR (tail)) |
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25544
diff
changeset
|
4259 && GC_MARKERP (XCAR (XCAR (tail))) |
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25544
diff
changeset
|
4260 && ! XMARKBIT (XMARKER (XCAR (XCAR (tail)))->chain)) |
21306
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4261 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4262 if (NILP (prev)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25544
diff
changeset
|
4263 nextb->undo_list = tail = XCDR (tail); |
21306
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4264 else |
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39914
diff
changeset
|
4265 { |
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39914
diff
changeset
|
4266 tail = XCDR (tail); |
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39914
diff
changeset
|
4267 XSETCDR (prev, tail); |
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39914
diff
changeset
|
4268 } |
21306
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4269 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4270 else |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4271 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4272 prev = tail; |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25544
diff
changeset
|
4273 tail = XCDR (tail); |
21306
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4274 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4275 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4276 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4277 |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4278 nextb = nextb->next; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4279 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4280 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4281 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4282 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4283 mark_stack (); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4284 #endif |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4285 |
49322 | 4286 #ifdef USE_GTK |
4287 { | |
4288 extern void xg_mark_data (); | |
4289 xg_mark_data (); | |
4290 } | |
4291 #endif | |
4292 | |
300 | 4293 gc_sweep (); |
4294 | |
4295 /* Clear the mark bits that we set in certain root slots. */ | |
4296 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4297 #if (GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE \ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4298 || GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES) |
300 | 4299 for (tail = gcprolist; tail; tail = tail->next) |
4300 for (i = 0; i < tail->nvars; i++) | |
4301 XUNMARK (tail->var[i]); | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4302 #endif |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4303 |
26378
cbf297593a79
(Fgarbage_collect): Call unmark_byte_stack.
Gerd Moellmann <gerd@gnu.org>
parents:
26372
diff
changeset
|
4304 unmark_byte_stack (); |
300 | 4305 for (backlist = backtrace_list; backlist; backlist = backlist->next) |
4306 { | |
4307 XUNMARK (*backlist->function); | |
4308 if (backlist->nargs == UNEVALLED || backlist->nargs == MANY) | |
4309 i = 0; | |
4310 else | |
4311 i = backlist->nargs - 1; | |
4312 for (; i >= 0; i--) | |
4313 XUNMARK (backlist->args[i]); | |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4314 } |
300 | 4315 XUNMARK (buffer_defaults.name); |
4316 XUNMARK (buffer_local_symbols.name); | |
4317 | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4318 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES && 0 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4319 dump_zombies (); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4320 #endif |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4321 |
23534
6f9c70db3a58
(Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents:
22382
diff
changeset
|
4322 UNBLOCK_INPUT; |
6f9c70db3a58
(Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents:
22382
diff
changeset
|
4323 |
16231 | 4324 /* clear_marks (); */ |
300 | 4325 gc_in_progress = 0; |
4326 | |
4327 consing_since_gc = 0; | |
4328 if (gc_cons_threshold < 10000) | |
4329 gc_cons_threshold = 10000; | |
4330 | |
14959
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
4331 if (garbage_collection_messages) |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
4332 { |
25343
fe92158a9e83
(Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents:
25133
diff
changeset
|
4333 if (message_p || minibuf_level > 0) |
fe92158a9e83
(Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents:
25133
diff
changeset
|
4334 restore_message (); |
14959
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
4335 else |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
4336 message1_nolog ("Garbage collecting...done"); |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
4337 } |
300 | 4338 |
35170
a9b677239421
(Fgarbage_collect): Use a record_unwind_protect to
Gerd Moellmann <gerd@gnu.org>
parents:
34325
diff
changeset
|
4339 unbind_to (count, Qnil); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4340 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4341 total[0] = Fcons (make_number (total_conses), |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4342 make_number (total_free_conses)); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4343 total[1] = Fcons (make_number (total_symbols), |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4344 make_number (total_free_symbols)); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4345 total[2] = Fcons (make_number (total_markers), |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4346 make_number (total_free_markers)); |
34270
773e6aa2ec38
(Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents:
33800
diff
changeset
|
4347 total[3] = make_number (total_string_size); |
773e6aa2ec38
(Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents:
33800
diff
changeset
|
4348 total[4] = make_number (total_vector_size); |
773e6aa2ec38
(Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents:
33800
diff
changeset
|
4349 total[5] = Fcons (make_number (total_floats), |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4350 make_number (total_free_floats)); |
34270
773e6aa2ec38
(Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents:
33800
diff
changeset
|
4351 total[6] = Fcons (make_number (total_intervals), |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4352 make_number (total_free_intervals)); |
34270
773e6aa2ec38
(Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents:
33800
diff
changeset
|
4353 total[7] = Fcons (make_number (total_strings), |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4354 make_number (total_free_strings)); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4355 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4356 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4357 { |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4358 /* Compute average percentage of zombies. */ |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4359 double nlive = 0; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4360 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4361 for (i = 0; i < 7; ++i) |
49357 | 4362 if (CONSP (total[i])) |
4363 nlive += XFASTINT (XCAR (total[i])); | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4364 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4365 avg_live = (avg_live * ngcs + nlive) / (ngcs + 1); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4366 max_live = max (nlive, max_live); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4367 avg_zombies = (avg_zombies * ngcs + nzombies) / (ngcs + 1); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4368 max_zombies = max (nzombies, max_zombies); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4369 ++ngcs; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4370 } |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4371 #endif |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4372 |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
4373 if (!NILP (Vpost_gc_hook)) |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
4374 { |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
4375 int count = inhibit_garbage_collection (); |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
4376 safe_run_hooks (Qpost_gc_hook); |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
4377 unbind_to (count, Qnil); |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
4378 } |
49529
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
4379 |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
4380 /* Accumulate statistics. */ |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
4381 EMACS_GET_TIME (t2); |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
4382 EMACS_SUB_TIME (t3, t2, t1); |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
4383 if (FLOATP (Vgc_elapsed)) |
49911
d9ade23e09df
(Fgarbage_collect): Don't use XSETFLOAT.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49600
diff
changeset
|
4384 Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed) + |
d9ade23e09df
(Fgarbage_collect): Don't use XSETFLOAT.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49600
diff
changeset
|
4385 EMACS_SECS (t3) + |
d9ade23e09df
(Fgarbage_collect): Don't use XSETFLOAT.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49600
diff
changeset
|
4386 EMACS_USECS (t3) * 1.0e-6); |
49529
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
4387 gcs_done++; |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
4388 |
34270
773e6aa2ec38
(Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents:
33800
diff
changeset
|
4389 return Flist (sizeof total / sizeof *total, total); |
300 | 4390 } |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4391 |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4392 |
25367
823e14641544
(mark_glyph_matrix): Mark strings only.
Gerd Moellmann <gerd@gnu.org>
parents:
25343
diff
changeset
|
4393 /* Mark Lisp objects in glyph matrix MATRIX. Currently the |
823e14641544
(mark_glyph_matrix): Mark strings only.
Gerd Moellmann <gerd@gnu.org>
parents:
25343
diff
changeset
|
4394 only interesting objects referenced from glyphs are strings. */ |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4395 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4396 static void |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4397 mark_glyph_matrix (matrix) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4398 struct glyph_matrix *matrix; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4399 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4400 struct glyph_row *row = matrix->rows; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4401 struct glyph_row *end = row + matrix->nrows; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4402 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4403 for (; row < end; ++row) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4404 if (row->enabled_p) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4405 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4406 int area; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4407 for (area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4408 { |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4409 struct glyph *glyph = row->glyphs[area]; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4410 struct glyph *end_glyph = glyph + row->used[area]; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4411 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4412 for (; glyph < end_glyph; ++glyph) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4413 if (GC_STRINGP (glyph->object) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4414 && !STRING_MARKED_P (XSTRING (glyph->object))) |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4415 mark_object (&glyph->object); |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4416 } |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4417 } |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4418 } |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4419 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4420 |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4421 /* Mark Lisp faces in the face cache C. */ |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4422 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4423 static void |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4424 mark_face_cache (c) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4425 struct face_cache *c; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4426 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4427 if (c) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4428 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4429 int i, j; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4430 for (i = 0; i < c->used; ++i) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4431 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4432 struct face *face = FACE_FROM_ID (c->f, i); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4433 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4434 if (face) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4435 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4436 for (j = 0; j < LFACE_VECTOR_SIZE; ++j) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4437 mark_object (&face->lface[j]); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4438 } |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4439 } |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4440 } |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4441 } |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4442 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4443 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4444 #ifdef HAVE_WINDOW_SYSTEM |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4445 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4446 /* Mark Lisp objects in image IMG. */ |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4447 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4448 static void |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4449 mark_image (img) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4450 struct image *img; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4451 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4452 mark_object (&img->spec); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4453 |
31892
2f3d88ac2b38
(__malloc_size_t) [DOUG_LEA_MALLOC]: Don't redefine it.
Dave Love <fx@gnu.org>
parents:
31889
diff
changeset
|
4454 if (!NILP (img->data.lisp_val)) |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4455 mark_object (&img->data.lisp_val); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4456 } |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4457 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4458 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4459 /* Mark Lisp objects in image cache of frame F. It's done this way so |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4460 that we don't have to include xterm.h here. */ |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4461 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4462 static void |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4463 mark_image_cache (f) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4464 struct frame *f; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4465 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4466 forall_images_in_image_cache (f, mark_image); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4467 } |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4468 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4469 #endif /* HAVE_X_WINDOWS */ |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4470 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4471 |
300 | 4472 |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
4473 /* Mark reference to a Lisp_Object. |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4474 If the object referred to has not been seen yet, recursively mark |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4475 all the references contained in it. */ |
300 | 4476 |
1168
2b07af77d7ec
(mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents:
1114
diff
changeset
|
4477 #define LAST_MARKED_SIZE 500 |
2b07af77d7ec
(mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents:
1114
diff
changeset
|
4478 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
|
4479 int last_marked_index; |
2b07af77d7ec
(mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents:
1114
diff
changeset
|
4480 |
46833
b80760a75295
(mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents:
46459
diff
changeset
|
4481 /* For debugging--call abort when we cdr down this many |
b80760a75295
(mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents:
46459
diff
changeset
|
4482 links of a list, in mark_object. In debugging, |
b80760a75295
(mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents:
46459
diff
changeset
|
4483 the call to abort will hit a breakpoint. |
b80760a75295
(mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents:
46459
diff
changeset
|
4484 Normally this is zero and the check never goes off. */ |
b80760a75295
(mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents:
46459
diff
changeset
|
4485 int mark_object_loop_halt; |
b80760a75295
(mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents:
46459
diff
changeset
|
4486 |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4487 void |
13553
fb12156faaf5
(mark_object): Don't overwrite original argument value.
Richard M. Stallman <rms@gnu.org>
parents:
13363
diff
changeset
|
4488 mark_object (argptr) |
fb12156faaf5
(mark_object): Don't overwrite original argument value.
Richard M. Stallman <rms@gnu.org>
parents:
13363
diff
changeset
|
4489 Lisp_Object *argptr; |
300 | 4490 { |
13553
fb12156faaf5
(mark_object): Don't overwrite original argument value.
Richard M. Stallman <rms@gnu.org>
parents:
13363
diff
changeset
|
4491 Lisp_Object *objptr = argptr; |
300 | 4492 register Lisp_Object obj; |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4493 #ifdef GC_CHECK_MARKED_OBJECTS |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4494 void *po; |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4495 struct mem_node *m; |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4496 #endif |
46833
b80760a75295
(mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents:
46459
diff
changeset
|
4497 int cdr_count = 0; |
300 | 4498 |
5868
a7bd57a60cb8
(mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents:
5353
diff
changeset
|
4499 loop: |
300 | 4500 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
|
4501 loop2: |
300 | 4502 XUNMARK (obj); |
4503 | |
32594
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
4504 if (PURE_POINTER_P (XPNTR (obj))) |
300 | 4505 return; |
4506 | |
1168
2b07af77d7ec
(mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents:
1114
diff
changeset
|
4507 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
|
4508 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
|
4509 last_marked_index = 0; |
2b07af77d7ec
(mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents:
1114
diff
changeset
|
4510 |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4511 /* Perform some sanity checks on the objects marked here. Abort if |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4512 we encounter an object we know is bogus. This increases GC time |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4513 by ~80%, and requires compilation with GC_MARK_STACK != 0. */ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4514 #ifdef GC_CHECK_MARKED_OBJECTS |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4515 |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4516 po = (void *) XPNTR (obj); |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4517 |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4518 /* Check that the object pointed to by PO is known to be a Lisp |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4519 structure allocated from the heap. */ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4520 #define CHECK_ALLOCATED() \ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4521 do { \ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4522 m = mem_find (po); \ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4523 if (m == MEM_NIL) \ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4524 abort (); \ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4525 } while (0) |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4526 |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4527 /* Check that the object pointed to by PO is live, using predicate |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4528 function LIVEP. */ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4529 #define CHECK_LIVE(LIVEP) \ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4530 do { \ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4531 if (!LIVEP (m, po)) \ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4532 abort (); \ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4533 } while (0) |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4534 |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4535 /* Check both of the above conditions. */ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4536 #define CHECK_ALLOCATED_AND_LIVE(LIVEP) \ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4537 do { \ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4538 CHECK_ALLOCATED (); \ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4539 CHECK_LIVE (LIVEP); \ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4540 } while (0) \ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4541 |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4542 #else /* not GC_CHECK_MARKED_OBJECTS */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4543 |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4544 #define CHECK_ALLOCATED() (void) 0 |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4545 #define CHECK_LIVE(LIVEP) (void) 0 |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4546 #define CHECK_ALLOCATED_AND_LIVE(LIVEP) (void) 0 |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4547 |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4548 #endif /* not GC_CHECK_MARKED_OBJECTS */ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4549 |
10457
2ab3bd0288a9
Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
parents:
10427
diff
changeset
|
4550 switch (SWITCH_ENUM_CAST (XGCTYPE (obj))) |
300 | 4551 { |
4552 case Lisp_String: | |
4553 { | |
4554 register struct Lisp_String *ptr = XSTRING (obj); | |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4555 CHECK_ALLOCATED_AND_LIVE (live_string_p); |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
4556 MARK_INTERVAL_TREE (ptr->intervals); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4557 MARK_STRING (ptr); |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
4558 #ifdef GC_CHECK_STRING_BYTES |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
4559 /* Check that the string size recorded in the string is the |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
4560 same as the one recorded in the sdata structure. */ |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
4561 CHECK_STRING_BYTES (ptr); |
32587
b3918817f15f
(mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents:
32360
diff
changeset
|
4562 #endif /* GC_CHECK_STRING_BYTES */ |
300 | 4563 } |
4564 break; | |
4565 | |
10009
82f3daf76995
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
10004
diff
changeset
|
4566 case Lisp_Vectorlike: |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4567 #ifdef GC_CHECK_MARKED_OBJECTS |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4568 m = mem_find (po); |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4569 if (m == MEM_NIL && !GC_SUBRP (obj) |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4570 && po != &buffer_defaults |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4571 && po != &buffer_local_symbols) |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4572 abort (); |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4573 #endif /* GC_CHECK_MARKED_OBJECTS */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4574 |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
4575 if (GC_BUFFERP (obj)) |
10340
ef58c7a5a4d6
(mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents:
10320
diff
changeset
|
4576 { |
ef58c7a5a4d6
(mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents:
10320
diff
changeset
|
4577 if (!XMARKBIT (XBUFFER (obj)->name)) |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4578 { |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4579 #ifdef GC_CHECK_MARKED_OBJECTS |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4580 if (po != &buffer_defaults && po != &buffer_local_symbols) |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4581 { |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4582 struct buffer *b; |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4583 for (b = all_buffers; b && b != po; b = b->next) |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4584 ; |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4585 if (b == NULL) |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4586 abort (); |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4587 } |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4588 #endif /* GC_CHECK_MARKED_OBJECTS */ |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4589 mark_buffer (obj); |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4590 } |
10340
ef58c7a5a4d6
(mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents:
10320
diff
changeset
|
4591 } |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
4592 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
|
4593 break; |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4594 else if (GC_COMPILEDP (obj)) |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4595 /* We could treat this just like a vector, but it is better to |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4596 save the COMPILED_CONSTANTS element for last and avoid |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
4597 recursion there. */ |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4598 { |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4599 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
|
4600 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
|
4601 register int i; |
300 | 4602 |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4603 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
|
4604 break; /* Already marked */ |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4605 |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4606 CHECK_LIVE (live_vector_p); |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4607 ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */ |
10009
82f3daf76995
(Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents:
10004
diff
changeset
|
4608 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
|
4609 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
|
4610 { |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4611 if (i != COMPILED_CONSTANTS) |
32360
d8b668a486d7
(mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents:
32099
diff
changeset
|
4612 mark_object (&ptr->contents[i]); |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4613 } |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4614 /* 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
|
4615 (MIPS-ABI + SysVR4, DC/OSx, etc). */ |
32360
d8b668a486d7
(mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents:
32099
diff
changeset
|
4616 objptr = (Lisp_Object *) &ptr->contents[COMPILED_CONSTANTS]; |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4617 goto loop; |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4618 } |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4619 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
|
4620 { |
32360
d8b668a486d7
(mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents:
32099
diff
changeset
|
4621 register struct frame *ptr = XFRAME (obj); |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4622 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
|
4623 |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4624 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
|
4625 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
|
4626 |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4627 CHECK_LIVE (live_vector_p); |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4628 mark_object (&ptr->name); |
12273
377cbbd8a2ad
(mark_object): Mark icon_name field.
Richard M. Stallman <rms@gnu.org>
parents:
12175
diff
changeset
|
4629 mark_object (&ptr->icon_name); |
14216
5970a52070bb
(mark_object): Mark frame title field.
Richard M. Stallman <rms@gnu.org>
parents:
14186
diff
changeset
|
4630 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
|
4631 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
|
4632 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
|
4633 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
|
4634 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
|
4635 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
|
4636 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
|
4637 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
|
4638 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
|
4639 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
|
4640 mark_object (&ptr->buffer_predicate); |
17217
571d0c136e48
(mark_object): Mark the buffer_list field.
Richard M. Stallman <rms@gnu.org>
parents:
17021
diff
changeset
|
4641 mark_object (&ptr->buffer_list); |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4642 mark_object (&ptr->menu_bar_window); |
25544
693ca9ba497a
Change spelling of `toolbar' to `tool_bar' or `tool-bar'.
Gerd Moellmann <gerd@gnu.org>
parents:
25452
diff
changeset
|
4643 mark_object (&ptr->tool_bar_window); |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4644 mark_face_cache (ptr->face_cache); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4645 #ifdef HAVE_WINDOW_SYSTEM |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4646 mark_image_cache (ptr); |
33764
a832bb73de79
(mark_object) <frame>: Mark tool bar items differently.
Gerd Moellmann <gerd@gnu.org>
parents:
33623
diff
changeset
|
4647 mark_object (&ptr->tool_bar_items); |
25544
693ca9ba497a
Change spelling of `toolbar' to `tool_bar' or `tool-bar'.
Gerd Moellmann <gerd@gnu.org>
parents:
25452
diff
changeset
|
4648 mark_object (&ptr->desired_tool_bar_string); |
693ca9ba497a
Change spelling of `toolbar' to `tool_bar' or `tool-bar'.
Gerd Moellmann <gerd@gnu.org>
parents:
25452
diff
changeset
|
4649 mark_object (&ptr->current_tool_bar_string); |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4650 #endif /* HAVE_WINDOW_SYSTEM */ |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4651 } |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
4652 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
|
4653 { |
5cd52d4838f8
(mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents:
14959
diff
changeset
|
4654 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
|
4655 |
5cd52d4838f8
(mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents:
14959
diff
changeset
|
4656 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
|
4657 break; /* Already marked */ |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4658 CHECK_LIVE (live_vector_p); |
15379
5cd52d4838f8
(mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents:
14959
diff
changeset
|
4659 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
|
4660 } |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4661 else if (GC_WINDOWP (obj)) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4662 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4663 register struct Lisp_Vector *ptr = XVECTOR (obj); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4664 struct window *w = XWINDOW (obj); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4665 register EMACS_INT size = ptr->size; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4666 register int i; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4667 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4668 /* Stop if already marked. */ |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4669 if (size & ARRAY_MARK_FLAG) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4670 break; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4671 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4672 /* Mark it. */ |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4673 CHECK_LIVE (live_vector_p); |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4674 ptr->size |= ARRAY_MARK_FLAG; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4675 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4676 /* There is no Lisp data above The member CURRENT_MATRIX in |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4677 struct WINDOW. Stop marking when that slot is reached. */ |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4678 for (i = 0; |
32360
d8b668a486d7
(mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents:
32099
diff
changeset
|
4679 (char *) &ptr->contents[i] < (char *) &w->current_matrix; |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4680 i++) |
32360
d8b668a486d7
(mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents:
32099
diff
changeset
|
4681 mark_object (&ptr->contents[i]); |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4682 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4683 /* Mark glyphs for leaf windows. Marking window matrices is |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4684 sufficient because frame matrices use the same glyph |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4685 memory. */ |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4686 if (NILP (w->hchild) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4687 && NILP (w->vchild) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4688 && w->current_matrix) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4689 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4690 mark_glyph_matrix (w->current_matrix); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4691 mark_glyph_matrix (w->desired_matrix); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4692 } |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4693 } |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4694 else if (GC_HASH_TABLE_P (obj)) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4695 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4696 struct Lisp_Hash_Table *h = XHASH_TABLE (obj); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4697 EMACS_INT size = h->size; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4698 |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4699 /* Stop if already marked. */ |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4700 if (size & ARRAY_MARK_FLAG) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4701 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4702 |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4703 /* Mark it. */ |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4704 CHECK_LIVE (live_vector_p); |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4705 h->size |= ARRAY_MARK_FLAG; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4706 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4707 /* Mark contents. */ |
43005 | 4708 /* Do not mark next_free or next_weak. |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4709 Being in the next_weak chain |
43005 | 4710 should not keep the hash table alive. |
4711 No need to mark `count' since it is an integer. */ | |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4712 mark_object (&h->test); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4713 mark_object (&h->weak); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4714 mark_object (&h->rehash_size); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4715 mark_object (&h->rehash_threshold); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4716 mark_object (&h->hash); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4717 mark_object (&h->next); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4718 mark_object (&h->index); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4719 mark_object (&h->user_hash_function); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4720 mark_object (&h->user_cmp_function); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4721 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4722 /* If hash table is not weak, mark all keys and values. |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4723 For weak tables, mark only the vector. */ |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4724 if (GC_NILP (h->weak)) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4725 mark_object (&h->key_and_value); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4726 else |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4727 XVECTOR (h->key_and_value)->size |= ARRAY_MARK_FLAG; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4728 |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4729 } |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4730 else |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4731 { |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4732 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
|
4733 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
|
4734 register int i; |
300 | 4735 |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4736 if (size & ARRAY_MARK_FLAG) break; /* Already marked */ |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4737 CHECK_LIVE (live_vector_p); |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4738 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
|
4739 if (size & PSEUDOVECTOR_FLAG) |
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4740 size &= PSEUDOVECTOR_SIZE_MASK; |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4741 |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4742 for (i = 0; i < size; i++) /* and then mark its elements */ |
32360
d8b668a486d7
(mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents:
32099
diff
changeset
|
4743 mark_object (&ptr->contents[i]); |
10291
96273a6ec492
(mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents:
10206
diff
changeset
|
4744 } |
300 | 4745 break; |
4746 | |
4747 case Lisp_Symbol: | |
4748 { | |
32360
d8b668a486d7
(mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents:
32099
diff
changeset
|
4749 register struct Lisp_Symbol *ptr = XSYMBOL (obj); |
300 | 4750 struct Lisp_Symbol *ptrx; |
4751 | |
4752 if (XMARKBIT (ptr->plist)) break; | |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4753 CHECK_ALLOCATED_AND_LIVE (live_symbol_p); |
300 | 4754 XMARK (ptr->plist); |
4755 mark_object ((Lisp_Object *) &ptr->value); | |
4756 mark_object (&ptr->function); | |
4757 mark_object (&ptr->plist); | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
4758 |
45392
f3d7ab65641f
* alloc.c (Fmake_symbol): Set symbol xname field instead of name.
Ken Raeburn <raeburn@raeburn.org>
parents:
44890
diff
changeset
|
4759 if (!PURE_POINTER_P (XSTRING (ptr->xname))) |
f3d7ab65641f
* alloc.c (Fmake_symbol): Set symbol xname field instead of name.
Ken Raeburn <raeburn@raeburn.org>
parents:
44890
diff
changeset
|
4760 MARK_STRING (XSTRING (ptr->xname)); |
46370
40db0673e6f0
Most uses of XSTRING combined with STRING_BYTES or indirection changed to
Ken Raeburn <raeburn@raeburn.org>
parents:
46305
diff
changeset
|
4761 MARK_INTERVAL_TREE (STRING_INTERVALS (ptr->xname)); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4762 |
20768 | 4763 /* Note that we do not mark the obarray of the symbol. |
4764 It is safe not to do so because nothing accesses that | |
4765 slot except to check whether it is nil. */ | |
300 | 4766 ptr = ptr->next; |
4767 if (ptr) | |
4768 { | |
5868
a7bd57a60cb8
(mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents:
5353
diff
changeset
|
4769 /* 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
|
4770 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
|
4771 ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */ |
300 | 4772 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
|
4773 /* 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
|
4774 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
|
4775 goto loop2; |
300 | 4776 } |
4777 } | |
4778 break; | |
4779 | |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
4780 case Lisp_Misc: |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4781 CHECK_ALLOCATED_AND_LIVE (live_misc_p); |
11243
054ecfce1820
(Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11048
diff
changeset
|
4782 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
|
4783 { |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
4784 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
|
4785 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
|
4786 /* 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
|
4787 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
|
4788 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
|
4789 break; |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
4790 |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
4791 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
|
4792 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
|
4793 { |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
4794 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
|
4795 = XBUFFER_LOCAL_VALUE (obj); |
21143
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
4796 if (XMARKBIT (ptr->realvalue)) break; |
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
4797 XMARK (ptr->realvalue); |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
4798 /* 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
|
4799 if (EQ (ptr->cdr, Qnil)) |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
4800 { |
21143
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
4801 objptr = &ptr->realvalue; |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
4802 goto loop; |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
4803 } |
21143
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
4804 mark_object (&ptr->realvalue); |
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
4805 mark_object (&ptr->buffer); |
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
4806 mark_object (&ptr->frame); |
32360
d8b668a486d7
(mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents:
32099
diff
changeset
|
4807 objptr = &ptr->cdr; |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
4808 goto loop; |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
4809 } |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
4810 |
9463
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
4811 case Lisp_Misc_Intfwd: |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
4812 case Lisp_Misc_Boolfwd: |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
4813 case Lisp_Misc_Objfwd: |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
4814 case Lisp_Misc_Buffer_Objfwd: |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
4815 case Lisp_Misc_Kboard_Objfwd: |
9463
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
4816 /* Don't bother with Lisp_Buffer_Objfwd, |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
4817 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
|
4818 /* 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
|
4819 are protected with staticpro. */ |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
4820 break; |
a40af805e036
(mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9437
diff
changeset
|
4821 |
9926
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4822 case Lisp_Misc_Overlay: |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4823 { |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4824 struct Lisp_Overlay *ptr = XOVERLAY (obj); |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4825 if (!XMARKBIT (ptr->plist)) |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4826 { |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4827 XMARK (ptr->plist); |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4828 mark_object (&ptr->start); |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4829 mark_object (&ptr->end); |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4830 objptr = &ptr->plist; |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4831 goto loop; |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4832 } |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4833 } |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4834 break; |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
4835 |
9437
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
4836 default: |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
4837 abort (); |
c7d7fb56b42d
(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents:
9367
diff
changeset
|
4838 } |
300 | 4839 break; |
4840 | |
4841 case Lisp_Cons: | |
4842 { | |
4843 register struct Lisp_Cons *ptr = XCONS (obj); | |
4844 if (XMARKBIT (ptr->car)) break; | |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4845 CHECK_ALLOCATED_AND_LIVE (live_cons_p); |
300 | 4846 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
|
4847 /* 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
|
4848 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
|
4849 { |
a9241dc503ab
(mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents:
1168
diff
changeset
|
4850 objptr = &ptr->car; |
46833
b80760a75295
(mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents:
46459
diff
changeset
|
4851 cdr_count = 0; |
1295
a9241dc503ab
(mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents:
1168
diff
changeset
|
4852 goto loop; |
a9241dc503ab
(mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents:
1168
diff
changeset
|
4853 } |
300 | 4854 mark_object (&ptr->car); |
32360
d8b668a486d7
(mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents:
32099
diff
changeset
|
4855 objptr = &ptr->cdr; |
46833
b80760a75295
(mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents:
46459
diff
changeset
|
4856 cdr_count++; |
b80760a75295
(mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents:
46459
diff
changeset
|
4857 if (cdr_count == mark_object_loop_halt) |
b80760a75295
(mark_object): Detect long lists for debugging.
Richard M. Stallman <rms@gnu.org>
parents:
46459
diff
changeset
|
4858 abort (); |
300 | 4859 goto loop; |
4860 } | |
4861 | |
4862 case Lisp_Float: | |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4863 CHECK_ALLOCATED_AND_LIVE (live_float_p); |
300 | 4864 XMARK (XFLOAT (obj)->type); |
4865 break; | |
4866 | |
4867 case Lisp_Int: | |
4868 break; | |
4869 | |
4870 default: | |
4871 abort (); | |
4872 } | |
29743
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4873 |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4874 #undef CHECK_LIVE |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4875 #undef CHECK_ALLOCATED |
1d802b332e0d
(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents:
28997
diff
changeset
|
4876 #undef CHECK_ALLOCATED_AND_LIVE |
300 | 4877 } |
4878 | |
4879 /* Mark the pointers in a buffer structure. */ | |
4880 | |
4881 static void | |
4882 mark_buffer (buf) | |
4883 Lisp_Object buf; | |
4884 { | |
4885 register struct buffer *buffer = XBUFFER (buf); | |
4886 register Lisp_Object *ptr; | |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
4887 Lisp_Object base_buffer; |
300 | 4888 |
4889 /* This is the buffer's markbit */ | |
4890 mark_object (&buffer->name); | |
4891 XMARK (buffer->name); | |
4892 | |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
4893 MARK_INTERVAL_TREE (BUF_INTERVALS (buffer)); |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
4894 |
21306
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4895 if (CONSP (buffer->undo_list)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4896 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4897 Lisp_Object tail; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4898 tail = buffer->undo_list; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4899 |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4900 while (CONSP (tail)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4901 { |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4902 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
|
4903 |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4904 if (XMARKBIT (ptr->car)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4905 break; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4906 XMARK (ptr->car); |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4907 if (GC_CONSP (ptr->car) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25544
diff
changeset
|
4908 && ! XMARKBIT (XCAR (ptr->car)) |
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
25544
diff
changeset
|
4909 && GC_MARKERP (XCAR (ptr->car))) |
21306
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4910 { |
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39914
diff
changeset
|
4911 XMARK (XCAR_AS_LVALUE (ptr->car)); |
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39914
diff
changeset
|
4912 mark_object (&XCDR_AS_LVALUE (ptr->car)); |
21306
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4913 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4914 else |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4915 mark_object (&ptr->car); |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4916 |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4917 if (CONSP (ptr->cdr)) |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4918 tail = ptr->cdr; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4919 else |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4920 break; |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4921 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4922 |
39973
579177964efa
Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents:
39914
diff
changeset
|
4923 mark_object (&XCDR_AS_LVALUE (tail)); |
21306
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4924 } |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4925 else |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4926 mark_object (&buffer->undo_list); |
dc2cbd40703c
(mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents:
21258
diff
changeset
|
4927 |
300 | 4928 for (ptr = &buffer->name + 1; |
4929 (char *)ptr < (char *)buffer + sizeof (struct buffer); | |
4930 ptr++) | |
4931 mark_object (ptr); | |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
4932 |
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
4933 /* 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
|
4934 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
|
4935 { |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4936 XSETBUFFER (base_buffer, buffer->base_buffer); |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
4937 mark_buffer (base_buffer); |
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
4938 } |
300 | 4939 } |
10649
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
4940 |
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
4941 |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
4942 /* Mark the pointers in the kboard objects. */ |
10649
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
4943 |
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
4944 static void |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
4945 mark_kboards () |
10649
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
4946 { |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
4947 KBOARD *kb; |
11593
f5385353aae3
(mark_kboards): Mark the kbd macro and Vsystem_key_alist.
Karl Heuer <kwzh@gnu.org>
parents:
11430
diff
changeset
|
4948 Lisp_Object *p; |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
4949 for (kb = all_kboards; kb; kb = kb->next_kboard) |
10649
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
4950 { |
11593
f5385353aae3
(mark_kboards): Mark the kbd macro and Vsystem_key_alist.
Karl Heuer <kwzh@gnu.org>
parents:
11430
diff
changeset
|
4951 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
|
4952 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
|
4953 mark_object (p); |
22381
50e1804145be
(mark_kboards): Mark all the Lisp_Object fields.
Richard M. Stallman <rms@gnu.org>
parents:
22220
diff
changeset
|
4954 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
|
4955 mark_object (&kb->Vlast_command); |
50e1804145be
(mark_kboards): Mark all the Lisp_Object fields.
Richard M. Stallman <rms@gnu.org>
parents:
22220
diff
changeset
|
4956 mark_object (&kb->Vreal_last_command); |
12120
1fc112b5fdc4
(mark_kboards): Mark Vprefix_arg instead of
Karl Heuer <kwzh@gnu.org>
parents:
12096
diff
changeset
|
4957 mark_object (&kb->Vprefix_arg); |
22382
f7d2bdefcff7
(mark_kboards): Mark Vlast_prefix_arg too.
Richard M. Stallman <rms@gnu.org>
parents:
22381
diff
changeset
|
4958 mark_object (&kb->Vlast_prefix_arg); |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
4959 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
|
4960 mark_object (&kb->defining_kbd_macro); |
11018
2d9bdf1ba3d1
(mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents:
10936
diff
changeset
|
4961 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
|
4962 mark_object (&kb->Vsystem_key_alist); |
12175
4e36e9e99082
(mark_kboards): Mark system_key_syms member.
Karl Heuer <kwzh@gnu.org>
parents:
12120
diff
changeset
|
4963 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
|
4964 mark_object (&kb->Vdefault_minibuffer_frame); |
43751
c82e347557f1
(mark_kboards): Mark echo_string.
Gerd Moellmann <gerd@gnu.org>
parents:
43713
diff
changeset
|
4965 mark_object (&kb->echo_string); |
10649
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
4966 } |
52cdd8cc8d3e
(mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents:
10581
diff
changeset
|
4967 } |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4968 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4969 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4970 /* Value is non-zero if OBJ will survive the current GC because it's |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4971 either marked or does not need to be marked to survive. */ |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4972 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4973 int |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4974 survives_gc_p (obj) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4975 Lisp_Object obj; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4976 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4977 int survives_p; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4978 |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4979 switch (XGCTYPE (obj)) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4980 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4981 case Lisp_Int: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4982 survives_p = 1; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4983 break; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4984 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4985 case Lisp_Symbol: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4986 survives_p = XMARKBIT (XSYMBOL (obj)->plist); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4987 break; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4988 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4989 case Lisp_Misc: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4990 switch (XMISCTYPE (obj)) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4991 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4992 case Lisp_Misc_Marker: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4993 survives_p = XMARKBIT (obj); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4994 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
4995 |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4996 case Lisp_Misc_Buffer_Local_Value: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4997 case Lisp_Misc_Some_Buffer_Local_Value: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4998 survives_p = XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
4999 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
5000 |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5001 case Lisp_Misc_Intfwd: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5002 case Lisp_Misc_Boolfwd: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5003 case Lisp_Misc_Objfwd: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5004 case Lisp_Misc_Buffer_Objfwd: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5005 case Lisp_Misc_Kboard_Objfwd: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5006 survives_p = 1; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5007 break; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
5008 |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5009 case Lisp_Misc_Overlay: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5010 survives_p = XMARKBIT (XOVERLAY (obj)->plist); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5011 break; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5012 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5013 default: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5014 abort (); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5015 } |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5016 break; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5017 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5018 case Lisp_String: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5019 { |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5020 struct Lisp_String *s = XSTRING (obj); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
5021 survives_p = STRING_MARKED_P (s); |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5022 } |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5023 break; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5024 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5025 case Lisp_Vectorlike: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5026 if (GC_BUFFERP (obj)) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5027 survives_p = XMARKBIT (XBUFFER (obj)->name); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5028 else if (GC_SUBRP (obj)) |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5029 survives_p = 1; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5030 else |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5031 survives_p = XVECTOR (obj)->size & ARRAY_MARK_FLAG; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5032 break; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5033 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5034 case Lisp_Cons: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5035 survives_p = XMARKBIT (XCAR (obj)); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5036 break; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5037 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5038 case Lisp_Float: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5039 survives_p = XMARKBIT (XFLOAT (obj)->type); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5040 break; |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5041 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5042 default: |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5043 abort (); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5044 } |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5045 |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5046 return survives_p || PURE_POINTER_P ((void *) XPNTR (obj)); |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5047 } |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5048 |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5049 |
300 | 5050 |
1908
d649f2179d67
* alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents:
1893
diff
changeset
|
5051 /* Sweep: find all structures not marked, and free them. */ |
300 | 5052 |
5053 static void | |
5054 gc_sweep () | |
5055 { | |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5056 /* Remove or mark entries in weak hash tables. |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5057 This must be done before any object is unmarked. */ |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5058 sweep_weak_hash_tables (); |
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5059 |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
5060 sweep_strings (); |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
5061 #ifdef GC_CHECK_STRING_BYTES |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
5062 if (!noninteractive) |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
5063 check_string_bytes (1); |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
5064 #endif |
300 | 5065 |
5066 /* Put all unmarked conses on free list */ | |
5067 { | |
5068 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
|
5069 struct cons_block **cprev = &cons_block; |
300 | 5070 register int lim = cons_block_index; |
5071 register int num_free = 0, num_used = 0; | |
5072 | |
5073 cons_free_list = 0; | |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
5074 |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5075 for (cblk = cons_block; cblk; cblk = *cprev) |
300 | 5076 { |
5077 register int i; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5078 int this_free = 0; |
300 | 5079 for (i = 0; i < lim; i++) |
5080 if (!XMARKBIT (cblk->conses[i].car)) | |
5081 { | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5082 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
|
5083 *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list; |
300 | 5084 cons_free_list = &cblk->conses[i]; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5085 #if GC_MARK_STACK |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5086 cons_free_list->car = Vdead; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5087 #endif |
300 | 5088 } |
5089 else | |
5090 { | |
5091 num_used++; | |
5092 XUNMARK (cblk->conses[i].car); | |
5093 } | |
5094 lim = CONS_BLOCK_SIZE; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5095 /* 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
|
5096 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
|
5097 this block. */ |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5098 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
|
5099 { |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5100 *cprev = cblk->next; |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5101 /* Unhook from the free list. */ |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5102 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
|
5103 lisp_free (cblk); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
5104 n_cons_blocks--; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5105 } |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5106 else |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5107 { |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5108 num_free += this_free; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5109 cprev = &cblk->next; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5110 } |
300 | 5111 } |
5112 total_conses = num_used; | |
5113 total_free_conses = num_free; | |
5114 } | |
5115 | |
5116 /* Put all unmarked floats on free list */ | |
5117 { | |
5118 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
|
5119 struct float_block **fprev = &float_block; |
300 | 5120 register int lim = float_block_index; |
5121 register int num_free = 0, num_used = 0; | |
5122 | |
5123 float_free_list = 0; | |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
5124 |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5125 for (fblk = float_block; fblk; fblk = *fprev) |
300 | 5126 { |
5127 register int i; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5128 int this_free = 0; |
300 | 5129 for (i = 0; i < lim; i++) |
5130 if (!XMARKBIT (fblk->floats[i].type)) | |
5131 { | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5132 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
|
5133 *(struct Lisp_Float **)&fblk->floats[i].data = float_free_list; |
300 | 5134 float_free_list = &fblk->floats[i]; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5135 #if GC_MARK_STACK |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5136 float_free_list->type = Vdead; |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5137 #endif |
300 | 5138 } |
5139 else | |
5140 { | |
5141 num_used++; | |
5142 XUNMARK (fblk->floats[i].type); | |
5143 } | |
5144 lim = FLOAT_BLOCK_SIZE; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5145 /* 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
|
5146 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
|
5147 this block. */ |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5148 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
|
5149 { |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5150 *fprev = fblk->next; |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5151 /* Unhook from the free list. */ |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5152 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
|
5153 lisp_free (fblk); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
5154 n_float_blocks--; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5155 } |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5156 else |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5157 { |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5158 num_free += this_free; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5159 fprev = &fblk->next; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5160 } |
300 | 5161 } |
5162 total_floats = num_used; | |
5163 total_free_floats = num_free; | |
5164 } | |
5165 | |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5166 /* Put all unmarked intervals on free list */ |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5167 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5168 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
|
5169 struct interval_block **iprev = &interval_block; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5170 register int lim = interval_block_index; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5171 register int num_free = 0, num_used = 0; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5172 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5173 interval_free_list = 0; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5174 |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5175 for (iblk = interval_block; iblk; iblk = *iprev) |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5176 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5177 register int i; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5178 int this_free = 0; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5179 |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5180 for (i = 0; i < lim; i++) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5181 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5182 if (! XMARKBIT (iblk->intervals[i].plist)) |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5183 { |
28269
fd13be8ae190
Changes towards better type safety regarding intervals, primarily
Ken Raeburn <raeburn@raeburn.org>
parents:
28220
diff
changeset
|
5184 SET_INTERVAL_PARENT (&iblk->intervals[i], interval_free_list); |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5185 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
|
5186 this_free++; |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5187 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5188 else |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5189 { |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5190 num_used++; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5191 XUNMARK (iblk->intervals[i].plist); |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5192 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5193 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5194 lim = INTERVAL_BLOCK_SIZE; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5195 /* 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
|
5196 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
|
5197 deallocate this block. */ |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5198 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
|
5199 { |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5200 *iprev = iblk->next; |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5201 /* Unhook from the free list. */ |
28269
fd13be8ae190
Changes towards better type safety regarding intervals, primarily
Ken Raeburn <raeburn@raeburn.org>
parents:
28220
diff
changeset
|
5202 interval_free_list = INTERVAL_PARENT (&iblk->intervals[0]); |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
5203 lisp_free (iblk); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
5204 n_interval_blocks--; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5205 } |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5206 else |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5207 { |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5208 num_free += this_free; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5209 iprev = &iblk->next; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5210 } |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5211 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5212 total_intervals = num_used; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5213 total_free_intervals = num_free; |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5214 } |
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5215 |
300 | 5216 /* Put all unmarked symbols on free list */ |
5217 { | |
5218 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
|
5219 struct symbol_block **sprev = &symbol_block; |
300 | 5220 register int lim = symbol_block_index; |
5221 register int num_free = 0, num_used = 0; | |
5222 | |
34308
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5223 symbol_free_list = NULL; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
5224 |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5225 for (sblk = symbol_block; sblk; sblk = *sprev) |
300 | 5226 { |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5227 int this_free = 0; |
34308
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5228 struct Lisp_Symbol *sym = sblk->symbols; |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5229 struct Lisp_Symbol *end = sym + lim; |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5230 |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5231 for (; sym < end; ++sym) |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5232 { |
34325
a65d8c29442a
(gc_sweep): Add comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
34308
diff
changeset
|
5233 /* Check if the symbol was created during loadup. In such a case |
a65d8c29442a
(gc_sweep): Add comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
34308
diff
changeset
|
5234 it might be pointed to by pure bytecode which we don't trace, |
a65d8c29442a
(gc_sweep): Add comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
34308
diff
changeset
|
5235 so we conservatively assume that it is live. */ |
45392
f3d7ab65641f
* alloc.c (Fmake_symbol): Set symbol xname field instead of name.
Ken Raeburn <raeburn@raeburn.org>
parents:
44890
diff
changeset
|
5236 int pure_p = PURE_POINTER_P (XSTRING (sym->xname)); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
5237 |
34308
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5238 if (!XMARKBIT (sym->plist) && !pure_p) |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5239 { |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5240 *(struct Lisp_Symbol **) &sym->value = symbol_free_list; |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5241 symbol_free_list = sym; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5242 #if GC_MARK_STACK |
34308
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5243 symbol_free_list->function = Vdead; |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5244 #endif |
34308
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5245 ++this_free; |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5246 } |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5247 else |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5248 { |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5249 ++num_used; |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5250 if (!pure_p) |
45392
f3d7ab65641f
* alloc.c (Fmake_symbol): Set symbol xname field instead of name.
Ken Raeburn <raeburn@raeburn.org>
parents:
44890
diff
changeset
|
5251 UNMARK_STRING (XSTRING (sym->xname)); |
34308
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5252 XUNMARK (sym->plist); |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5253 } |
6d490e8ef117
(gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents:
34270
diff
changeset
|
5254 } |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
5255 |
300 | 5256 lim = SYMBOL_BLOCK_SIZE; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5257 /* 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
|
5258 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
|
5259 this block. */ |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5260 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
|
5261 { |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5262 *sprev = sblk->next; |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5263 /* Unhook from the free list. */ |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5264 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
|
5265 lisp_free (sblk); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
5266 n_symbol_blocks--; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5267 } |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5268 else |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5269 { |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5270 num_free += this_free; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5271 sprev = &sblk->next; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5272 } |
300 | 5273 } |
5274 total_symbols = num_used; | |
5275 total_free_symbols = num_free; | |
5276 } | |
5277 | |
21143
ce12eac1ee45
(gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents:
21084
diff
changeset
|
5278 /* 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
|
5279 For a marker, first unchain it from the buffer it points into. */ |
300 | 5280 { |
5281 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
|
5282 struct marker_block **mprev = &marker_block; |
300 | 5283 register int lim = marker_block_index; |
5284 register int num_free = 0, num_used = 0; | |
5285 | |
5286 marker_free_list = 0; | |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
5287 |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5288 for (mblk = marker_block; mblk; mblk = *mprev) |
300 | 5289 { |
5290 register int i; | |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5291 int this_free = 0; |
11679
1ced2d67d411
(gc_cons_threshold): Make this an EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
11593
diff
changeset
|
5292 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
|
5293 |
300 | 5294 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
|
5295 { |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5296 Lisp_Object *markword; |
11243
054ecfce1820
(Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11048
diff
changeset
|
5297 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
|
5298 { |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5299 case Lisp_Misc_Marker: |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5300 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
|
5301 break; |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5302 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
|
5303 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
|
5304 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
|
5305 break; |
9926
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
5306 case Lisp_Misc_Overlay: |
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
5307 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
|
5308 break; |
11403
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
5309 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
|
5310 /* 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
|
5311 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
|
5312 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
|
5313 break; |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5314 default: |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5315 markword = 0; |
9926
2a9f99682f82
(mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9893
diff
changeset
|
5316 break; |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5317 } |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5318 if (markword && !XMARKBIT (*markword)) |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5319 { |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5320 Lisp_Object tem; |
11243
054ecfce1820
(Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11048
diff
changeset
|
5321 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
|
5322 { |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5323 /* tem1 avoids Sun compiler bug */ |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5324 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
|
5325 XSETMARKER (tem, tem1); |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5326 unchain_marker (tem); |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5327 } |
11403
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
5328 /* 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
|
5329 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
|
5330 but this might catch bugs faster. */ |
11243
054ecfce1820
(Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents:
11048
diff
changeset
|
5331 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
|
5332 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
|
5333 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
|
5334 this_free++; |
9893
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5335 } |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5336 else |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5337 { |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5338 num_used++; |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5339 if (markword) |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5340 XUNMARK (*markword); |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5341 } |
8421d09f2afe
(mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents:
9463
diff
changeset
|
5342 } |
300 | 5343 lim = MARKER_BLOCK_SIZE; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5344 /* 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
|
5345 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
|
5346 this block. */ |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5347 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
|
5348 { |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5349 *mprev = mblk->next; |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5350 /* Unhook from the free list. */ |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5351 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
|
5352 lisp_free (mblk); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
5353 n_marker_blocks--; |
20057
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5354 } |
612cd201aea5
(gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents:
19666
diff
changeset
|
5355 else |
21379
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5356 { |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5357 num_free += this_free; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5358 mprev = &mblk->next; |
1701bf5b9dec
(gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents:
21306
diff
changeset
|
5359 } |
300 | 5360 } |
5361 | |
5362 total_markers = num_used; | |
5363 total_free_markers = num_free; | |
5364 } | |
5365 | |
5366 /* Free all unmarked buffers */ | |
5367 { | |
5368 register struct buffer *buffer = all_buffers, *prev = 0, *next; | |
5369 | |
5370 while (buffer) | |
5371 if (!XMARKBIT (buffer->name)) | |
5372 { | |
5373 if (prev) | |
5374 prev->next = buffer->next; | |
5375 else | |
5376 all_buffers = buffer->next; | |
5377 next = buffer->next; | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5378 lisp_free (buffer); |
300 | 5379 buffer = next; |
5380 } | |
5381 else | |
5382 { | |
5383 XUNMARK (buffer->name); | |
10307
e6e75fd0916d
(mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents:
10291
diff
changeset
|
5384 UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer)); |
300 | 5385 prev = buffer, buffer = buffer->next; |
5386 } | |
5387 } | |
5388 | |
5389 /* Free all unmarked vectors */ | |
5390 { | |
5391 register struct Lisp_Vector *vector = all_vectors, *prev = 0, *next; | |
5392 total_vector_size = 0; | |
5393 | |
5394 while (vector) | |
5395 if (!(vector->size & ARRAY_MARK_FLAG)) | |
5396 { | |
5397 if (prev) | |
5398 prev->next = vector->next; | |
5399 else | |
5400 all_vectors = vector->next; | |
5401 next = vector->next; | |
23958
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
5402 lisp_free (vector); |
7094b74ce0a6
(lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
23534
diff
changeset
|
5403 n_vectors--; |
300 | 5404 vector = next; |
25024
3bb745067f0e
(gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents:
23973
diff
changeset
|
5405 |
300 | 5406 } |
5407 else | |
5408 { | |
5409 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
|
5410 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
|
5411 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
|
5412 else |
bd3241a14d0a
(gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents:
11374
diff
changeset
|
5413 total_vector_size += vector->size; |
300 | 5414 prev = vector, vector = vector->next; |
5415 } | |
5416 } | |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49529
diff
changeset
|
5417 |
35183
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
5418 #ifdef GC_CHECK_STRING_BYTES |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
5419 if (!noninteractive) |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
5420 check_string_bytes (1); |
cc2a06489f0d
(CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents:
35170
diff
changeset
|
5421 #endif |
300 | 5422 } |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
5423 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
5424 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
5425 |
300 | 5426 |
1327
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
5427 /* Debugging aids. */ |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
5428 |
5353
6389ed5b45ac
(Fmemory_limit): No longer interactive.
Richard M. Stallman <rms@gnu.org>
parents:
4956
diff
changeset
|
5429 DEFUN ("memory-limit", Fmemory_limit, Smemory_limit, 0, 0, 0, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5430 doc: /* Return the address of the last byte Emacs has allocated, divided by 1024. |
39914
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5431 This may be helpful in debugging Emacs's memory usage. |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5432 We divide the value by 1024 to make sure it fits in a Lisp integer. */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5433 () |
1327
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
5434 { |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
5435 Lisp_Object end; |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
5436 |
9261
e5ba7993d378
(VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents:
9144
diff
changeset
|
5437 XSETINT (end, (EMACS_INT) sbrk (0) / 1024); |
1327
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
5438 |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
5439 return end; |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
5440 } |
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
5441 |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
5442 DEFUN ("memory-use-counts", Fmemory_use_counts, Smemory_use_counts, 0, 0, 0, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5443 doc: /* Return a list of counters that measure how much consing there has been. |
39914
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5444 Each of these counters increments for a certain kind of object. |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5445 The counters wrap around from the largest positive integer to zero. |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5446 Garbage collection does not decrease them. |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5447 The elements of the value are as follows: |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5448 (CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS MISCS INTERVALS STRINGS) |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5449 All are in units of 1 = one object consed |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5450 except for VECTOR-CELLS and STRING-CHARS, which count the total length of |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5451 objects consed. |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5452 MISCS include overlays, markers, and some internal types. |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5453 Frames, windows, buffers, and subprocesses count as vectors |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5454 (but the contents of a buffer's text do not count here). */) |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5455 () |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
5456 { |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
5457 Lisp_Object consed[8]; |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
5458 |
39633
a0bf0cb8ff3e
(inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents:
39572
diff
changeset
|
5459 consed[0] = make_number (min (MOST_POSITIVE_FIXNUM, cons_cells_consed)); |
a0bf0cb8ff3e
(inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents:
39572
diff
changeset
|
5460 consed[1] = make_number (min (MOST_POSITIVE_FIXNUM, floats_consed)); |
a0bf0cb8ff3e
(inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents:
39572
diff
changeset
|
5461 consed[2] = make_number (min (MOST_POSITIVE_FIXNUM, vector_cells_consed)); |
a0bf0cb8ff3e
(inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents:
39572
diff
changeset
|
5462 consed[3] = make_number (min (MOST_POSITIVE_FIXNUM, symbols_consed)); |
a0bf0cb8ff3e
(inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents:
39572
diff
changeset
|
5463 consed[4] = make_number (min (MOST_POSITIVE_FIXNUM, string_chars_consed)); |
a0bf0cb8ff3e
(inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents:
39572
diff
changeset
|
5464 consed[5] = make_number (min (MOST_POSITIVE_FIXNUM, misc_objects_consed)); |
a0bf0cb8ff3e
(inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents:
39572
diff
changeset
|
5465 consed[6] = make_number (min (MOST_POSITIVE_FIXNUM, intervals_consed)); |
a0bf0cb8ff3e
(inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents:
39572
diff
changeset
|
5466 consed[7] = make_number (min (MOST_POSITIVE_FIXNUM, strings_consed)); |
27142
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
5467 |
f742c86fcc15
(Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents:
27006
diff
changeset
|
5468 return Flist (8, consed); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
5469 } |
28406
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
5470 |
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
5471 int suppress_checking; |
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
5472 void |
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
5473 die (msg, file, line) |
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
5474 const char *msg; |
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
5475 const char *file; |
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
5476 int line; |
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
5477 { |
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
5478 fprintf (stderr, "\r\nEmacs fatal error: %s:%d: %s\r\n", |
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
5479 file, line, msg); |
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
5480 abort (); |
451721e784a8
Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents:
28374
diff
changeset
|
5481 } |
1327
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
5482 |
300 | 5483 /* Initialization */ |
5484 | |
21514 | 5485 void |
300 | 5486 init_alloc_once () |
5487 { | |
5488 /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */ | |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
5489 purebeg = PUREBEG; |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
5490 pure_size = PURESIZE; |
32594
e0646c73bf81
(pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents:
32587
diff
changeset
|
5491 pure_bytes_used = 0; |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
5492 pure_bytes_used_before_overflow = 0; |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
5493 |
32692
0343fe9ef3ac
(toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents:
32609
diff
changeset
|
5494 #if GC_MARK_STACK || defined GC_MALLOC_CHECK |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5495 mem_init (); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5496 Vdead = make_pure_string ("DEAD", 4, 4, 0); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5497 #endif |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
5498 |
300 | 5499 all_vectors = 0; |
5500 ignore_warnings = 1; | |
17345
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
5501 #ifdef DOUG_LEA_MALLOC |
4e11e27ce1f1
For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents:
17328
diff
changeset
|
5502 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
|
5503 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
|
5504 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
|
5505 #endif |
300 | 5506 init_strings (); |
5507 init_cons (); | |
5508 init_symbol (); | |
5509 init_marker (); | |
5510 init_float (); | |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5511 init_intervals (); |
1300
b13b79e28eb5
* alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents:
1295
diff
changeset
|
5512 |
10673
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
5513 #ifdef REL_ALLOC |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
5514 malloc_hysteresis = 32; |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
5515 #else |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
5516 malloc_hysteresis = 0; |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
5517 #endif |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
5518 |
337c3a4d5fef
(emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents:
10649
diff
changeset
|
5519 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
|
5520 |
300 | 5521 ignore_warnings = 0; |
5522 gcprolist = 0; | |
26364
7b0217d9259c
(Fgarbage_collect): Call mark_byte_stack and
Gerd Moellmann <gerd@gnu.org>
parents:
26164
diff
changeset
|
5523 byte_stack_list = 0; |
300 | 5524 staticidx = 0; |
5525 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
|
5526 gc_cons_threshold = 100000 * sizeof (Lisp_Object); |
300 | 5527 #ifdef VIRT_ADDR_VARIES |
5528 malloc_sbrk_unused = 1<<22; /* A large number */ | |
5529 malloc_sbrk_used = 100000; /* as reasonable as any number */ | |
5530 #endif /* VIRT_ADDR_VARIES */ | |
5531 } | |
5532 | |
21514 | 5533 void |
300 | 5534 init_alloc () |
5535 { | |
5536 gcprolist = 0; | |
26364
7b0217d9259c
(Fgarbage_collect): Call mark_byte_stack and
Gerd Moellmann <gerd@gnu.org>
parents:
26164
diff
changeset
|
5537 byte_stack_list = 0; |
28365
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
5538 #if GC_MARK_STACK |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
5539 #if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
5540 setjmp_tested_p = longjmps_done = 0; |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
5541 #endif |
a72abbd8dc16
(mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28269
diff
changeset
|
5542 #endif |
49529
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
5543 Vgc_elapsed = make_float (0.0); |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
5544 gcs_done = 0; |
300 | 5545 } |
5546 | |
5547 void | |
5548 syms_of_alloc () | |
5549 { | |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5550 DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5551 doc: /* *Number of bytes of consing between garbage collections. |
39914
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5552 Garbage collection can happen automatically once this many bytes have been |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5553 allocated since the last garbage collection. All data types count. |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5554 |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5555 Garbage collection happens automatically only when `eval' is called. |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5556 |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5557 By binding this temporarily to a large number, you can effectively |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5558 prevent garbage collection during a part of the program. */); |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5559 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5560 DEFVAR_INT ("pure-bytes-used", &pure_bytes_used, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5561 doc: /* Number of bytes of sharable Lisp data allocated so far. */); |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5562 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5563 DEFVAR_INT ("cons-cells-consed", &cons_cells_consed, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5564 doc: /* Number of cons cells that have been consed so far. */); |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5565 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5566 DEFVAR_INT ("floats-consed", &floats_consed, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5567 doc: /* Number of floats that have been consed so far. */); |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5568 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5569 DEFVAR_INT ("vector-cells-consed", &vector_cells_consed, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5570 doc: /* Number of vector cells that have been consed so far. */); |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5571 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5572 DEFVAR_INT ("symbols-consed", &symbols_consed, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5573 doc: /* Number of symbols that have been consed so far. */); |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5574 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5575 DEFVAR_INT ("string-chars-consed", &string_chars_consed, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5576 doc: /* Number of string characters that have been consed so far. */); |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5577 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5578 DEFVAR_INT ("misc-objects-consed", &misc_objects_consed, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5579 doc: /* Number of miscellaneous objects that have been consed so far. */); |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5580 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5581 DEFVAR_INT ("intervals-consed", &intervals_consed, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5582 doc: /* Number of intervals that have been consed so far. */); |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5583 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5584 DEFVAR_INT ("strings-consed", &strings_consed, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5585 doc: /* Number of strings that have been consed so far. */); |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5586 |
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5587 DEFVAR_LISP ("purify-flag", &Vpurify_flag, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5588 doc: /* Non-nil means loading Lisp code in order to dump an executable. |
39914
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5589 This means that certain objects should be allocated in shared (pure) space. */); |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5590 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5591 DEFVAR_INT ("undo-limit", &undo_limit, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5592 doc: /* Keep no more undo information once it exceeds this size. |
39914
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5593 This limit is applied when garbage collection happens. |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5594 The size is counted as the number of bytes occupied, |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5595 which includes both saved text and other data. */); |
764 | 5596 undo_limit = 20000; |
300 | 5597 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5598 DEFVAR_INT ("undo-strong-limit", &undo_strong_limit, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5599 doc: /* Don't keep more than this much size of undo information. |
39914
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5600 A command which pushes past this size is itself forgotten. |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5601 This limit is applied when garbage collection happens. |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5602 The size is counted as the number of bytes occupied, |
91951fb5b9e5
Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents:
39859
diff
changeset
|
5603 which includes both saved text and other data. */); |
764 | 5604 undo_strong_limit = 30000; |
300 | 5605 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5606 DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5607 doc: /* Non-nil means display messages at start and end of garbage collection. */); |
14959
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
5608 garbage_collection_messages = 0; |
f2b5d784fa88
(garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
14764
diff
changeset
|
5609 |
39988
eac4e9ae201c
Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents:
39973
diff
changeset
|
5610 DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook, |
40107
d3cc7dd5d75a
Reindent DEFUNs with doc: keywords.
Pavel Janík <Pavel@Janik.cz>
parents:
39988
diff
changeset
|
5611 doc: /* Hook run after garbage collection has finished. */); |
39572
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
5612 Vpost_gc_hook = Qnil; |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
5613 Qpost_gc_hook = intern ("post-gc-hook"); |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
5614 staticpro (&Qpost_gc_hook); |
715a67381594
(purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents:
39297
diff
changeset
|
5615 |
46305
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
5616 DEFVAR_LISP ("memory-signal-data", &Vmemory_signal_data, |
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
5617 doc: /* Precomputed `signal' argument for memory-full error. */); |
6116
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
5618 /* 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
|
5619 not be able to allocate the memory to hold it. */ |
46305
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
5620 Vmemory_signal_data |
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
5621 = list2 (Qerror, |
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
5622 build_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs")); |
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
5623 |
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
5624 DEFVAR_LISP ("memory-full", &Vmemory_full, |
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
5625 doc: /* Non-nil means we are handling a memory-full error. */); |
fed6b815dbeb
(Vmemory_full): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
46293
diff
changeset
|
5626 Vmemory_full = Qnil; |
6116
64417bbbb128
(memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents:
5874
diff
changeset
|
5627 |
11374
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
5628 staticpro (&Qgc_cons_threshold); |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
5629 Qgc_cons_threshold = intern ("gc-cons-threshold"); |
1ebc81f84aa4
(inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents:
11341
diff
changeset
|
5630 |
13219
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
5631 staticpro (&Qchar_table_extra_slots); |
99b5164a319d
(Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
13150
diff
changeset
|
5632 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
|
5633 |
49529
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
5634 DEFVAR_LISP ("gc-elapsed", &Vgc_elapsed, |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
5635 doc: /* Accumulated time elapsed in garbage collections. |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
5636 The time is in seconds as a floating point value. |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
5637 Programs may reset this to get statistics in a specific period. */); |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
5638 DEFVAR_INT ("gcs-done", &gcs_done, |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
5639 doc: /* Accumulated number of garbage collections done. |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
5640 Programs may reset this to get statistics in a specific period. */); |
fd79b3081e01
(Vgc_elapsed, gcs_done): New variables.
Dave Love <fx@gnu.org>
parents:
49414
diff
changeset
|
5641 |
300 | 5642 defsubr (&Scons); |
5643 defsubr (&Slist); | |
5644 defsubr (&Svector); | |
5645 defsubr (&Smake_byte_code); | |
5646 defsubr (&Smake_list); | |
5647 defsubr (&Smake_vector); | |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
5648 defsubr (&Smake_char_table); |
300 | 5649 defsubr (&Smake_string); |
13141
4a4d1d8e89e5
(Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
13008
diff
changeset
|
5650 defsubr (&Smake_bool_vector); |
300 | 5651 defsubr (&Smake_symbol); |
5652 defsubr (&Smake_marker); | |
5653 defsubr (&Spurecopy); | |
5654 defsubr (&Sgarbage_collect); | |
1327
ef16e7c0d402
* alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents:
1318
diff
changeset
|
5655 defsubr (&Smemory_limit); |
12748
3433bb446e06
(cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents:
12605
diff
changeset
|
5656 defsubr (&Smemory_use_counts); |
27738
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5657 |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5658 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5659 defsubr (&Sgc_status); |
581c76c41ca4
(mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents:
27727
diff
changeset
|
5660 #endif |
300 | 5661 } |