annotate src/alloc.c @ 32684:303175f14c7d

(height-affecting-face-attributes): Use `defconst'.
author Miles Bader <miles@gnu.org>
date Fri, 20 Oct 2000 12:21:30 +0000
parents 350e0378e6f9
children 0343fe9ef3ac
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1 /* Storage allocation and gc for GNU Emacs Lisp interpreter.
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000
20708
ed9ed828415e Update copyright year.
Richard M. Stallman <rms@gnu.org>
parents: 20659
diff changeset
3 Free Software Foundation, Inc.
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5 This file is part of GNU Emacs.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
6
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
7 GNU Emacs is free software; you can redistribute it and/or modify
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
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
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
10 any later version.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
11
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
12 GNU Emacs is distributed in the hope that it will be useful,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
15 GNU General Public License for more details.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
16
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
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
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
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
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
25 /* 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
26
3003
5a73d384f45e * syssignal.h: Don't #include <signal.h>
Jim Blandy <jimb@redhat.com>
parents: 2961
diff changeset
27 #include <signal.h>
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
28
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
29 /* Define this temporarily to hunt a bug. If defined, the size of
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
30 strings is always recorded in sdata structures so that it can be
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
31 compared to the sizes recorded in Lisp strings. */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
32
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
33 #define GC_CHECK_STRING_BYTES 1
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
34
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
35 /* 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
36 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
37 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
38
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
39 #undef HIDE_LISP_IMPLEMENTATION
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
40 #include "lisp.h"
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
41 #include "intervals.h"
356
5b180834eacf *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 300
diff changeset
42 #include "puresize.h"
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
43 #include "buffer.h"
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
44 #include "window.h"
31102
6a0caa788013 Include keyboard.h before frame.h.
Andrew Innes <andrewi@gnu.org>
parents: 30914
diff changeset
45 #include "keyboard.h"
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
46 #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
47 #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
48 #include "charset.h"
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 624
diff changeset
49 #include "syssignal.h"
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
50 #include <setjmp.h>
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 624
diff changeset
51
30784
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
52 #ifdef HAVE_UNISTD_H
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
53 #include <unistd.h>
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
54 #else
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
55 extern POINTER_TYPE *sbrk ();
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
56 #endif
12096
cdc859dd813b Declare sbrk.
Karl Heuer <kwzh@gnu.org>
parents: 11892
diff changeset
57
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
58 #ifdef DOUG_LEA_MALLOC
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
59
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
60 #include <malloc.h>
31892
2f3d88ac2b38 (__malloc_size_t) [DOUG_LEA_MALLOC]: Don't redefine it.
Dave Love <fx@gnu.org>
parents: 31889
diff changeset
61 /* 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
62 #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
63 #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
64 #endif
23973
2eb9e2f5aa33 (MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 23958
diff changeset
65
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
66 /* 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
67 value that explicitly means "no limit". */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
68
23973
2eb9e2f5aa33 (MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 23958
diff changeset
69 #define MMAP_MAX_AREAS 100000000
2eb9e2f5aa33 (MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 23958
diff changeset
70
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
71 #else /* not DOUG_LEA_MALLOC */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
72
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
73 /* 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
74
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
75 #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
76 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
77 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
78
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
79 #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
80
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
81 #define max(A,B) ((A) > (B) ? (A) : (B))
11727
53ccd2d608ee (gc_cons_threshold): Change back to int.
Richard M. Stallman <rms@gnu.org>
parents: 11679
diff changeset
82 #define min(A,B) ((A) < (B) ? (A) : (B))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
83
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
84 /* Macro to verify that storage intended for Lisp objects is not
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
85 out of range to fit in the space for a pointer.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
86 ADDRESS is the start of the block, and SIZE
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
87 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
88
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
89 #define VALIDATE_LISP_STORAGE(address, size) \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
90 do \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
91 { \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
92 Lisp_Object val; \
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
93 XSETCONS (val, (char *) address + size); \
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
94 if ((char *) XCONS (val) != (char *) address + size) \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
95 { \
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
96 xfree (address); \
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
97 memory_full (); \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
98 } \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
99 } while (0)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
100
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
101 /* 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
102
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
103 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
104
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
105 /* 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
106 to a struct Lisp_String. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
107
28469
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
108 #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
109 #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
110 #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
111
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
112 /* 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
113 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
114 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
115 strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
116
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
117 #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
118 #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
119
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
120 /* 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
121
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
122 int consing_since_gc;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
123
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
124 /* 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
125
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
126 int cons_cells_consed;
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
127 int floats_consed;
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
128 int vector_cells_consed;
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
129 int symbols_consed;
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
130 int string_chars_consed;
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
131 int misc_objects_consed;
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
132 int intervals_consed;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
133 int strings_consed;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
134
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
135 /* 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
136
11727
53ccd2d608ee (gc_cons_threshold): Change back to int.
Richard M. Stallman <rms@gnu.org>
parents: 11679
diff changeset
137 int gc_cons_threshold;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
138
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
139 /* Nonzero during GC. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
140
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
141 int gc_in_progress;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
142
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
143 /* 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
144
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
145 int garbage_collection_messages;
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
146
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
147 #ifndef VIRT_ADDR_VARIES
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
148 extern
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
149 #endif /* VIRT_ADDR_VARIES */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
150 int malloc_sbrk_used;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
151
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
152 #ifndef VIRT_ADDR_VARIES
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
153 extern
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
154 #endif /* VIRT_ADDR_VARIES */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
155 int malloc_sbrk_unused;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
156
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
157 /* 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
158
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
159 int undo_limit;
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
160 int undo_strong_limit;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
161
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
162 /* 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
163
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
164 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
165 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
166 static int total_free_floats, total_floats;
19332
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
167
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
168 /* 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
169 out of memory. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
170
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
171 static char *spare_memory;
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
172
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
173 /* 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
174
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
175 #define SPARE_MEMORY (1 << 14)
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
176
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
177 /* 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
178
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
179 static int malloc_hysteresis;
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
180
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
181 /* 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
182
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
183 Lisp_Object Vpurify_flag;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
184
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
185 #ifndef HAVE_SHM
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
186
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
187 /* Force it into data space! */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
188
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
189 EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,};
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
190 #define PUREBEG (char *) pure
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
191
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
192 #else /* not HAVE_SHM */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
193
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
194 #define pure PURE_SEG_BITS /* Use shared memory segment */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
195 #define PUREBEG (char *)PURE_SEG_BITS
356
5b180834eacf *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 300
diff changeset
196
5b180834eacf *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 300
diff changeset
197 /* This variable is used only by the XPNTR macro when HAVE_SHM is
5b180834eacf *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 300
diff changeset
198 defined. If we used the PURESIZE macro directly there, that would
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
199 make most of Emacs dependent on puresize.h, which we don't want -
356
5b180834eacf *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 300
diff changeset
200 you should be able to change that without too much recompilation.
5b180834eacf *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 300
diff changeset
201 So map_in_data initializes pure_size, and the dependencies work
5b180834eacf *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 300
diff changeset
202 out. */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
203
8817
48ff00bebef6 (pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
204 EMACS_INT pure_size;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
205
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
206 #endif /* not HAVE_SHM */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
207
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
208 /* 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
209
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
210 #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
211 (((PNTR_COMPARISON_TYPE) (P) \
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
212 < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE)) \
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
213 && ((PNTR_COMPARISON_TYPE) (P) \
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
214 >= (PNTR_COMPARISON_TYPE) pure))
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
215
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
216 /* 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
217
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
218 int pure_bytes_used;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
219
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
220 /* 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
221 displayed. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
222
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
223 char *pending_malloc_warning;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
224
6116
64417bbbb128 (memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents: 5874
diff changeset
225 /* 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
226
6133
752d4237f869 (memory_signal_data): No longer static.
Richard M. Stallman <rms@gnu.org>
parents: 6116
diff changeset
227 Lisp_Object memory_signal_data;
6116
64417bbbb128 (memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents: 5874
diff changeset
228
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
229 /* Maximum amount of C stack to save when a GC happens. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
230
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
231 #ifndef MAX_SAVE_STACK
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
232 #define MAX_SAVE_STACK 16000
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
233 #endif
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
234
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
235 /* Buffer in which we save a copy of the C stack at each GC. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
236
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
237 char *stack_copy;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
238 int stack_copy_size;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
239
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
240 /* 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
241 Currently not used. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
242
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
243 int ignore_warnings;
1318
0edeba6fc9fc Fixed typos.
Joseph Arceneaux <jla@gnu.org>
parents: 1300
diff changeset
244
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
245 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
246
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
247 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
248 static void mark_kboards P_ ((void));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
249 static void gc_sweep P_ ((void));
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
250 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
251 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
252
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
253 #ifdef HAVE_WINDOW_SYSTEM
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
254 static void mark_image P_ ((struct image *));
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
255 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
256 #endif /* HAVE_WINDOW_SYSTEM */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
257
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
258 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
259 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
260 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
261 static void sweep_strings P_ ((void));
20495
db1be942dc12 (Fgarbage_collect):
Richard M. Stallman <rms@gnu.org>
parents: 20391
diff changeset
262
db1be942dc12 (Fgarbage_collect):
Richard M. Stallman <rms@gnu.org>
parents: 20391
diff changeset
263 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
264
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
265 /* 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
266 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
267 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
268
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
269 enum mem_type
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
270 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
271 MEM_TYPE_NON_LISP,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
272 MEM_TYPE_BUFFER,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
273 MEM_TYPE_CONS,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
274 MEM_TYPE_STRING,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
275 MEM_TYPE_MISC,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
276 MEM_TYPE_SYMBOL,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
277 MEM_TYPE_FLOAT,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
278 MEM_TYPE_VECTOR
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
27746
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
281 #if GC_MARK_STACK
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
282
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
283 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
284 #include <stdio.h> /* For fprintf. */
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
285 #endif
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
286
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
287 /* 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
288 on free lists recognizable in O(1). */
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
289
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
290 Lisp_Object Vdead;
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
291
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
292 struct mem_node;
30914
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
293 static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type));
30784
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
294 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
295 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
296 static void init_stack P_ ((Lisp_Object *));
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
297 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
298 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
299 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
300 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
301 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
302 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
303 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
304 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
305 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
306 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
307 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
308 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
309 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
310 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
311 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
312 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
313 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
314
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
315 #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
316 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
317 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
318
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
319 #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
320
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
321 /* Recording what needs to be marked for gc. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
322
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
323 struct gcpro *gcprolist;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
324
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
325 /* Addresses of staticpro'd variables. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
326
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
327 #define NSTATICS 1024
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
328 Lisp_Object *staticvec[NSTATICS] = {0};
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
329
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
330 /* Index of next unused slot in staticvec. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
331
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
332 int staticidx = 0;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
333
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
334 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
335
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
336
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
337 /* 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
338 ALIGNMENT must be a power of 2. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
339
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
340 #define ALIGN(SZ, ALIGNMENT) \
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
341 (((SZ) + (ALIGNMENT) - 1) & ~((ALIGNMENT) - 1))
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
342
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
343
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
344 /************************************************************************
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
345 Malloc
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
346 ************************************************************************/
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
347
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
348 /* Write STR to Vstandard_output plus some advice on how to free some
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
349 memory. Called when memory gets low. */
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
350
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
351 Lisp_Object
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
352 malloc_warning_1 (str)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
353 Lisp_Object str;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
354 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
355 Fprinc (str, Vstandard_output);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
356 write_string ("\nKilling some buffers may delay running out of memory.\n", -1);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
357 write_string ("However, certainly by the time you receive the 95% warning,\n", -1);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
358 write_string ("you should clean up, kill this Emacs, and start a new one.", -1);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
359 return Qnil;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
360 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
361
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
362
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
363 /* Function malloc calls this if it finds we are near exhausting
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
364 storage. */
20375
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
365
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
366 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
367 malloc_warning (str)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
368 char *str;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
369 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
370 pending_malloc_warning = str;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
371 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
372
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
373
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
374 /* Display a malloc warning in buffer *Danger*. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
375
20375
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
376 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
377 display_malloc_warning ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
378 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
379 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
380
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
381 val = build_string (pending_malloc_warning);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
382 pending_malloc_warning = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
383 internal_with_output_to_temp_buffer (" *Danger*", malloc_warning_1, val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
384 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
385
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
386
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
387 #ifdef DOUG_LEA_MALLOC
17831
9238a2254a23 (BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents: 17348
diff changeset
388 # 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
389 #else
17831
9238a2254a23 (BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents: 17348
diff changeset
390 # 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
391 #endif
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
392
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
393
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
394 /* 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
395
20375
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
396 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
397 memory_full ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
398 {
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
399 #ifndef SYSTEM_MALLOC
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
400 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
401 #endif
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
402
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
403 /* 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
404 if (spare_memory)
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
405 {
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
406 free (spare_memory);
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
407 spare_memory = 0;
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
408 }
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
409
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
410 /* 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
411 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
412 while (1)
18621
53b95f307c75 (memory_full): Pass Qnil to Fsignal for ERROR_SYMBOL.
Richard M. Stallman <rms@gnu.org>
parents: 18104
diff changeset
413 Fsignal (Qnil, memory_signal_data);
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
414 }
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
415
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
416
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
417 /* 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
418
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
419 void
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
420 buffer_memory_full ()
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
421 {
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
422 /* 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
423 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
424 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
425 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
426 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
427 malloc. */
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
428
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
429 #ifndef REL_ALLOC
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
430 memory_full ();
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
431 #endif
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
432
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
433 /* 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
434 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
435 while (1)
64417bbbb128 (memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents: 5874
diff changeset
436 Fsignal (Qerror, memory_signal_data);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
437 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
438
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
439
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
440 /* Like malloc but check for no memory and block interrupt input.. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
441
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
442 POINTER_TYPE *
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
443 xmalloc (size)
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
444 size_t size;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
445 {
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
446 register POINTER_TYPE *val;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
447
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
448 BLOCK_INPUT;
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
449 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
450 UNBLOCK_INPUT;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
451
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
452 if (!val && size)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
453 memory_full ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
454 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
455 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
456
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
457
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
458 /* 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
459
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
460 POINTER_TYPE *
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
461 xrealloc (block, size)
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
462 POINTER_TYPE *block;
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
463 size_t size;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
464 {
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
465 register POINTER_TYPE *val;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
466
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
467 BLOCK_INPUT;
590
1a6483439acc *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
468 /* We must call malloc explicitly when BLOCK is 0, since some
1a6483439acc *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
469 reallocs don't do this. */
1a6483439acc *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
470 if (! block)
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
471 val = (POINTER_TYPE *) malloc (size);
600
a8d78999e46d *** empty log message ***
Noah Friedman <friedman@splode.com>
parents: 590
diff changeset
472 else
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
473 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
474 UNBLOCK_INPUT;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
475
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
476 if (!val && size) memory_full ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
477 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
478 }
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
479
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
480
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
481 /* 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
482
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
483 void
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
484 xfree (block)
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
485 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
486 {
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
487 BLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
488 free (block);
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
489 UNBLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
490 }
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
491
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
492
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
493 /* Like strdup, but uses xmalloc. */
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
494
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
495 char *
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
496 xstrdup (s)
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
497 char *s;
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
498 {
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
499 size_t len = strlen (s) + 1;
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
500 char *p = (char *) xmalloc (len);
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
501 bcopy (s, p, len);
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
502 return p;
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
503 }
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
504
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
505
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
506 /* 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
507 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
508 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
509
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
510 static POINTER_TYPE *
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
511 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
512 size_t nbytes;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
513 enum mem_type type;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
514 {
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
515 register void *val;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
516
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
517 BLOCK_INPUT;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
518 val = (void *) malloc (nbytes);
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
519
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
520 #if GC_MARK_STACK
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
521 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
522 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
523 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
524
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
525 UNBLOCK_INPUT;
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
526 if (!val && nbytes)
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
527 memory_full ();
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
528 return val;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
529 }
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
530
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
531
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
532 /* 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
533 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
534
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
535 struct buffer *
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
536 allocate_buffer ()
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
537 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
538 return (struct buffer *) lisp_malloc (sizeof (struct buffer),
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
539 MEM_TYPE_BUFFER);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
540 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
541
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
542
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
543 /* 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
544 call to lisp_malloc. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
545
30784
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
546 static void
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
547 lisp_free (block)
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
548 POINTER_TYPE *block;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
549 {
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
550 BLOCK_INPUT;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
551 free (block);
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
552 #if GC_MARK_STACK
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
553 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
554 #endif
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
555 UNBLOCK_INPUT;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
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
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
558
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
559 /* 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
560
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
561 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
562 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
563 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
564 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
565 might call malloc, so we can't really protect them unless you're
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
566 using GNU malloc. Fortunately, most of the major operating can use
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
567 GNU malloc. */
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
568
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
569 #ifndef SYSTEM_MALLOC
30914
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
570 #ifndef DOUG_LEA_MALLOC
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
571 extern void * (*__malloc_hook) P_ ((size_t));
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
572 extern void * (*__realloc_hook) P_ ((void *, size_t));
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
573 extern void (*__free_hook) P_ ((void *));
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
574 /* 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
575 #endif /* DOUG_LEA_MALLOC */
2507
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
576 static void * (*old_malloc_hook) ();
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
577 static void * (*old_realloc_hook) ();
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
578 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
579
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
580 /* 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
581
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
582 static void
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
583 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
584 void *ptr;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
585 {
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
586 BLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
587 __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
588 free (ptr);
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
589 /* 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
590 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
591 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
592 if (spare_memory == 0
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
593 /* 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
594 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
595 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
596 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
597 && (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
598 > 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
599 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
600
2507
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
601 __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
602 UNBLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
603 }
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
604
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
605
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
606 /* 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
607 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
608 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
609
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
610 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
611
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
612 void
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
613 refill_memory_reserve ()
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
614 {
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
615 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
616 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
617 }
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
618
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
619
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
620 /* 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
621
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
622 static void *
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
623 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
624 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
625 {
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
626 void *value;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
627
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
628 BLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
629 __malloc_hook = old_malloc_hook;
17831
9238a2254a23 (BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents: 17348
diff changeset
630 #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
631 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
632 #else
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
633 __malloc_extra_blocks = malloc_hysteresis;
17831
9238a2254a23 (BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents: 17348
diff changeset
634 #endif
3581
152fd924c7bb * alloc.c (emacs_blocked_malloc, emacs_blocked_realloc): Cast the
Jim Blandy <jimb@redhat.com>
parents: 3536
diff changeset
635 value = (void *) malloc (size);
2507
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
636 __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
637 UNBLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
638
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
639 return value;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
640 }
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
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
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
643 /* 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
644
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
645 static void *
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
646 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
647 void *ptr;
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
648 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
649 {
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
650 void *value;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
651
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
652 BLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
653 __realloc_hook = old_realloc_hook;
3581
152fd924c7bb * alloc.c (emacs_blocked_malloc, emacs_blocked_realloc): Cast the
Jim Blandy <jimb@redhat.com>
parents: 3536
diff changeset
654 value = (void *) realloc (ptr, size);
2507
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
655 __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
656 UNBLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
657
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
658 return value;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
659 }
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
660
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
661
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
662 /* 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
663
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
664 void
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
665 uninterrupt_malloc ()
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
666 {
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
667 if (__free_hook != emacs_blocked_free)
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
668 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
669 __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
670
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
671 if (__malloc_hook != emacs_blocked_malloc)
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
672 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
673 __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
674
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
675 if (__realloc_hook != emacs_blocked_realloc)
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
676 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
677 __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
678 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
679
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
680 #endif /* not SYSTEM_MALLOC */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
681
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
682
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
683
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
684 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
685 Interval Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
686 ***********************************************************************/
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
687
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
688 /* 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
689 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
690
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
691 #define INTERVAL_BLOCK_SIZE \
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
692 ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval))
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
693
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
694 /* 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
695 structure. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
696
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
697 struct interval_block
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
698 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
699 struct interval_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
700 struct interval intervals[INTERVAL_BLOCK_SIZE];
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
701 };
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
702
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
703 /* 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
704 blocks. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
705
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
706 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
707
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
708 /* 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
709 structure. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
710
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
711 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
712
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
713 /* 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
714
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
715 static int total_free_intervals, total_intervals;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
716
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
717 /* List of free intervals. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
718
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
719 INTERVAL interval_free_list;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
720
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
721 /* 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
722
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
723 int n_interval_blocks;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
724
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
725
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
726 /* Initialize interval allocation. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
727
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
728 static void
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
729 init_intervals ()
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
730 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
731 interval_block
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
732 = (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
733 MEM_TYPE_NON_LISP);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
734 interval_block->next = 0;
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
735 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
736 interval_block_index = 0;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
737 interval_free_list = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
738 n_interval_blocks = 1;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
739 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
740
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
741
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
742 /* Return a new interval. */
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
743
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
744 INTERVAL
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
745 make_interval ()
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
746 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
747 INTERVAL val;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
748
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
749 if (interval_free_list)
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
750 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
751 val = interval_free_list;
28269
fd13be8ae190 Changes towards better type safety regarding intervals, primarily
Ken Raeburn <raeburn@raeburn.org>
parents: 28220
diff changeset
752 interval_free_list = INTERVAL_PARENT (interval_free_list);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
753 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
754 else
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
755 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
756 if (interval_block_index == INTERVAL_BLOCK_SIZE)
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
757 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
758 register struct interval_block *newi;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
759
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
760 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
761 MEM_TYPE_NON_LISP);
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
762
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
763 VALIDATE_LISP_STORAGE (newi, sizeof *newi);
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
764 newi->next = interval_block;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
765 interval_block = newi;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
766 interval_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
767 n_interval_blocks++;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
768 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
769 val = &interval_block->intervals[interval_block_index++];
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
770 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
771 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
772 intervals_consed++;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
773 RESET_INTERVAL (val);
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
774 return val;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
775 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
776
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
777
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
778 /* Mark Lisp objects in interval I. */
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
779
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
780 static void
1957
54c8c66cd9ac (mark_interval): Add ignored arg.
Richard M. Stallman <rms@gnu.org>
parents: 1939
diff changeset
781 mark_interval (i, dummy)
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
782 register INTERVAL i;
1957
54c8c66cd9ac (mark_interval): Add ignored arg.
Richard M. Stallman <rms@gnu.org>
parents: 1939
diff changeset
783 Lisp_Object dummy;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
784 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
785 if (XMARKBIT (i->plist))
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
786 abort ();
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
787 mark_object (&i->plist);
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
788 XMARK (i->plist);
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
789 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
790
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
791
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
792 /* 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
793 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
794
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
795 static void
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
796 mark_interval_tree (tree)
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
797 register INTERVAL tree;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
798 {
4139
0b32ee899a3a Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents: 4087
diff changeset
799 /* 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
800 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
801 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
802
0b32ee899a3a Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents: 4087
diff changeset
803 /* 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
804 a cast. */
28406
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
805 XMARK (tree->up.obj);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
806
1957
54c8c66cd9ac (mark_interval): Add ignored arg.
Richard M. Stallman <rms@gnu.org>
parents: 1939
diff changeset
807 traverse_intervals (tree, 1, 0, mark_interval, Qnil);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
808 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
809
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
810
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
811 /* 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
812
4139
0b32ee899a3a Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents: 4087
diff changeset
813 #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
814 do { \
0b32ee899a3a Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents: 4087
diff changeset
815 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
816 && ! 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
817 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
818 } while (0)
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
819
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
820
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
821 /* 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
822 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
823 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
824
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
825 #define UNMARK_BALANCE_INTERVALS(i) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
826 do { \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
827 if (! NULL_INTERVAL_P (i)) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
828 { \
28406
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
829 XUNMARK ((i)->up.obj); \
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
830 (i) = balance_intervals (i); \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
831 } \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
832 } while (0)
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
833
28469
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
834
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
835 /* 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
836 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
837 #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
838 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
839 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
840 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
841 {
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
842 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
843 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
844 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
845 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
846 }
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
847 #endif
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
848
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
849 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
850 String Allocation
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
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
853 /* 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
854 string_block is allocated, all the Lisp_Strings it contains are
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
855 added to a free-list stiing_free_list. When a new Lisp_String is
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
856 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
857 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
858 we keep.
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
859
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
860 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
861 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
862 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
863
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
864 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
865 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
866 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
867 its sdata structure.
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
868
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
869 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
870 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
871 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
872 `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
873 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
874 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
875
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
876 /* 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
877 is 8192 minus malloc overhead. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
878
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
879 #define SBLOCK_SIZE 8188
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
880
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
881 /* 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
882 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
883
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
884 #define LARGE_STRING_BYTES 1024
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
885
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
886 /* 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
887 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
888
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
889 struct sdata
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
890 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
891 /* 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
892 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
893 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
894 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
895 (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
896 contents. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
897 struct Lisp_String *string;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
898
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
899 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
900
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
901 EMACS_INT nbytes;
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
902 unsigned char data[1];
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
903
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
904 #define SDATA_NBYTES(S) (S)->nbytes
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
905 #define SDATA_DATA(S) (S)->data
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
906
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
907 #else /* not GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
908
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
909 union
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
910 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
911 /* When STRING in non-null. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
912 unsigned char data[1];
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
913
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
914 /* When STRING is null. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
915 EMACS_INT nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
916 } u;
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
917
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
918
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
919 #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
920 #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
921
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
922 #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
923 };
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
924
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
925
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
926 /* 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
927 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
928 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
929 as large as needed. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
930
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
931 struct sblock
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
932 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
933 /* Next in list. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
934 struct sblock *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
935
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
936 /* 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
937 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
938 struct sdata *next_free;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
939
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
940 /* Start of data. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
941 struct sdata first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
942 };
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
943
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
944 /* 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
945 1024 minus malloc overhead. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
946
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
947 #define STRINGS_IN_STRING_BLOCK \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
948 ((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
949
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
950 /* 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
951 are allocated. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
952
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
953 struct string_block
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
954 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
955 struct string_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
956 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
957 };
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
958
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
959 /* 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
960 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
961 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
962
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
963 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
964
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
965 /* List of sblocks for large strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
966
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
967 static struct sblock *large_sblocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
968
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
969 /* 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
970
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
971 static struct string_block *string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
972 static int n_string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
973
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
974 /* Free-list of Lisp_Strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
975
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
976 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
977
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
978 /* 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
979
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
980 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
981
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
982 /* 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
983
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
984 static int total_string_size;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
985
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
986 /* 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
987 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
988 free-list. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
989
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
990 #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
991
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
992 /* 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
993 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
994 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
995 structure starts at a constant offset in front of that. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
996
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
997 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
998
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
999 #define SDATA_OF_STRING(S) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1000 ((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
1001 - sizeof (EMACS_INT)))
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1002
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1003 #else /* not GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1004
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1005 #define SDATA_OF_STRING(S) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1006 ((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
1007
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1008 #endif /* not GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1009
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1010 /* 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
1011 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
1012 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
1013
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1014 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1015
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1016 #define SDATA_SIZE(NBYTES) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1017 ((sizeof (struct Lisp_String *) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1018 + (NBYTES) + 1 \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1019 + sizeof (EMACS_INT) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1020 + sizeof (EMACS_INT) - 1) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1021 & ~(sizeof (EMACS_INT) - 1))
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1022
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1023 #else /* not GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1024
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1025 #define SDATA_SIZE(NBYTES) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1026 ((sizeof (struct Lisp_String *) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1027 + (NBYTES) + 1 \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1028 + sizeof (EMACS_INT) - 1) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1029 & ~(sizeof (EMACS_INT) - 1))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1030
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1031 #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
1032
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1033 /* 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
1034
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1035 void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1036 init_strings ()
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1037 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1038 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
1039 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
1040 string_blocks = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1041 n_string_blocks = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1042 string_free_list = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1043 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1044
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1045
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1046 #ifdef GC_CHECK_STRING_BYTES
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1047
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1048 /* Check validity of all live Lisp strings' string_bytes member.
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1049 Used for hunting a bug. */
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1050
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1051 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
1052
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1053 void
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1054 check_string_bytes ()
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1055 {
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1056 struct sblock *b;
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1057
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1058 for (b = large_sblocks; b; b = b->next)
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1059 {
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1060 struct Lisp_String *s = b->first_data.string;
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1061 if (s && GC_STRING_BYTES (s) != SDATA_NBYTES (SDATA_OF_STRING (s)))
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1062 abort ();
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1063 }
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1064
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1065 for (b = oldest_sblock; b; b = b->next)
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1066 {
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1067 struct sdata *from, *end, *from_end;
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1068
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1069 end = b->next_free;
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1070
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1071 for (from = &b->first_data; from < end; from = from_end)
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1072 {
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1073 /* Compute the next FROM here because copying below may
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1074 overwrite data we need to compute it. */
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1075 int nbytes;
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1076
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1077 /* Check that the string size recorded in the string is the
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1078 same as the one recorded in the sdata structure. */
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1079 if (from->string
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1080 && GC_STRING_BYTES (from->string) != SDATA_NBYTES (from))
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1081 abort ();
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1082
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1083 if (from->string)
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1084 nbytes = GC_STRING_BYTES (from->string);
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1085 else
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1086 nbytes = SDATA_NBYTES (from);
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1087
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1088 nbytes = SDATA_SIZE (nbytes);
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1089 from_end = (struct sdata *) ((char *) from + nbytes);
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1090 }
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1091 }
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1092 }
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1093
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1094 #endif /* GC_CHECK_STRING_BYTES */
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1095
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1096
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1097 /* Return a new Lisp_String. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1098
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1099 static struct Lisp_String *
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1100 allocate_string ()
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1101 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1102 struct Lisp_String *s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1103
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1104 /* 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
1105 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
1106 if (string_free_list == NULL)
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 struct string_block *b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1109 int i;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1110
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1111 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
1112 VALIDATE_LISP_STORAGE (b, sizeof *b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1113 bzero (b, sizeof *b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1114 b->next = string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1115 string_blocks = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1116 ++n_string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1117
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1118 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
1119 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1120 s = b->strings + i;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1121 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
1122 string_free_list = s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1123 }
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 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
1126 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1127
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1128 /* 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
1129 s = string_free_list;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1130 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
1131
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1132 /* 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
1133 bzero (s, sizeof *s);
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 --total_free_strings;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1136 ++total_strings;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1137 ++strings_consed;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1138 consing_since_gc += sizeof *s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1139
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1140 #ifdef GC_CHECK_STRING_BYTES
32609
350e0378e6f9 (allocate_string) [GC_CHECK_STRING_BYTES]: Call
Gerd Moellmann <gerd@gnu.org>
parents: 32594
diff changeset
1141 if (!noninteractive && ++check_string_bytes_count == 50)
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1142 {
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1143 check_string_bytes_count = 0;
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1144 check_string_bytes ();
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1145 }
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1146 #endif
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1147
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1148 return s;
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
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 /* 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
1153 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
1154 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
1155 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
1156 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
1157
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1158 void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1159 allocate_string_data (s, nchars, nbytes)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1160 struct Lisp_String *s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1161 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1162 {
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1163 struct sdata *data, *old_data;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1164 struct sblock *b;
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1165 int needed, old_nbytes;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1166
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1167 /* 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
1168 of string data. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1169 needed = SDATA_SIZE (nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1170
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1171 if (nbytes > LARGE_STRING_BYTES)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1172 {
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
1173 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
1174
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1175 #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
1176 /* 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
1177 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
1178 a dumped Emacs. */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1179 mallopt (M_MMAP_MAX, 0);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1180 #endif
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1181
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1182 b = (struct sblock *) lisp_malloc (size, MEM_TYPE_NON_LISP);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1183
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1184 #ifdef DOUG_LEA_MALLOC
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1185 /* 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
1186 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
1187 #endif
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1188
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1189 b->next_free = &b->first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1190 b->first_data.string = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1191 b->next = large_sblocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1192 large_sblocks = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1193 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1194 else if (current_sblock == NULL
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1195 || (((char *) current_sblock + SBLOCK_SIZE
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1196 - (char *) current_sblock->next_free)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1197 < needed))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1198 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1199 /* 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
1200 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
1201 b->next_free = &b->first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1202 b->first_data.string = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1203 b->next = NULL;
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 if (current_sblock)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1206 current_sblock->next = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1207 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1208 oldest_sblock = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1209 current_sblock = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1210 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1211 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1212 b = current_sblock;
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1213
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1214 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
1215 old_nbytes = GC_STRING_BYTES (s);
27142
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 data = b->next_free;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1218 data->string = s;
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1219 s->data = SDATA_DATA (data);
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1220 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1221 SDATA_NBYTES (data) = nbytes;
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1222 #endif
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1223 s->size = nchars;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1224 s->size_byte = nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1225 s->data[nbytes] = '\0';
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1226 b->next_free = (struct sdata *) ((char *) data + needed);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1227
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1228 /* 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
1229 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
1230 in it. */
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1231 if (old_data)
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1232 {
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1233 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
1234 old_data->string = NULL;
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1235 }
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1236
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1237 consing_since_gc += needed;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1238 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1239
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1240
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1241 /* Sweep and compact strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1242
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1243 static void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1244 sweep_strings ()
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1245 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1246 struct string_block *b, *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1247 struct string_block *live_blocks = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1248
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1249 string_free_list = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1250 total_strings = total_free_strings = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1251 total_string_size = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1252
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1253 /* 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
1254 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
1255 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1256 int i, nfree = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1257 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
1258
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1259 next = b->next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1260
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1261 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
1262 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1263 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
1264
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1265 if (s->data)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1266 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1267 /* 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
1268 if (STRING_MARKED_P (s))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1269 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1270 /* 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
1271 UNMARK_STRING (s);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1272
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1273 if (!NULL_INTERVAL_P (s->intervals))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1274 UNMARK_BALANCE_INTERVALS (s->intervals);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1275
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1276 ++total_strings;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1277 total_string_size += STRING_BYTES (s);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1278 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1279 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1280 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1281 /* 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
1282 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
1283
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1284 /* 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
1285 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
1286 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
1287 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1288 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
1289 abort ();
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1290 #else
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1291 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
1292 #endif
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1293 data->string = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1294
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1295 /* 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
1296 know it's free. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1297 s->data = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1298
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1299 /* 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
1300 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
1301 string_free_list = s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1302 ++nfree;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1303 }
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 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1306 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1307 /* 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
1308 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
1309 string_free_list = s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1310 ++nfree;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1311 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1312 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1313
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1314 /* 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
1315 the first two of them. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1316 if (nfree == STRINGS_IN_STRING_BLOCK
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1317 && 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
1318 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1319 lisp_free (b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1320 --n_string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1321 string_free_list = free_list_before;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1322 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1323 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1324 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1325 total_free_strings += nfree;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1326 b->next = live_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1327 live_blocks = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1328 }
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 string_blocks = live_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1332 free_large_strings ();
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1333 compact_small_strings ();
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1334 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1335
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1336
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1337 /* Free dead large strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1338
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1339 static void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1340 free_large_strings ()
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1341 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1342 struct sblock *b, *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1343 struct sblock *live_blocks = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1344
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1345 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
1346 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1347 next = b->next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1348
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1349 if (b->first_data.string == NULL)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1350 lisp_free (b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1351 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1352 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1353 b->next = live_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1354 live_blocks = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1355 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1356 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1357
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1358 large_sblocks = live_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1359 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1360
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1361
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1362 /* 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
1363 data of live strings after compaction. */
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 static void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1366 compact_small_strings ()
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1367 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1368 struct sblock *b, *tb, *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1369 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
1370 struct sdata *to_end, *from_end;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1371
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1372 /* 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
1373 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
1374 tb = oldest_sblock;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1375 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
1376 to = &tb->first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1377
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1378 /* 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
1379 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
1380 copying will happen this way. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1381 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
1382 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1383 end = b->next_free;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1384 xassert ((char *) end <= (char *) b + SBLOCK_SIZE);
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 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
1387 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1388 /* 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
1389 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
1390 int nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1391
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1392 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1393 /* 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
1394 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
1395 if (from->string
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1396 && 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
1397 abort ();
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1398 #endif /* GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1399
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1400 if (from->string)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1401 nbytes = GC_STRING_BYTES (from->string);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1402 else
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1403 nbytes = SDATA_NBYTES (from);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1404
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1405 nbytes = SDATA_SIZE (nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1406 from_end = (struct sdata *) ((char *) from + nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1407
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1408 /* 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
1409 if (from->string)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1410 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1411 /* 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
1412 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
1413 if (to_end > tb_end)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1414 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1415 tb->next_free = to;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1416 tb = tb->next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1417 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
1418 to = &tb->first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1419 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
1420 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1421
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1422 /* 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
1423 if (from != to)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1424 {
30823
8ee3740aaf60 (compact_small_strings): Use safe_bcopy, add an
Gerd Moellmann <gerd@gnu.org>
parents: 30784
diff changeset
1425 xassert (tb != b || to <= from);
8ee3740aaf60 (compact_small_strings): Use safe_bcopy, add an
Gerd Moellmann <gerd@gnu.org>
parents: 30784
diff changeset
1426 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
1427 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
1428 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1429
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1430 /* 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
1431 to = to_end;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1432 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1433 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1434 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1435
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1436 /* 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
1437 we can free them. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1438 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
1439 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1440 next = b->next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1441 lisp_free (b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1442 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1443
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1444 tb->next_free = to;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1445 tb->next = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1446 current_sblock = tb;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1447 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1448
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1449
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1450 DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1451 "Return a newly created string of length LENGTH, with each element being INIT.\n\
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1452 Both LENGTH and INIT must be numbers.")
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1453 (length, init)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1454 Lisp_Object length, init;
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 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1457 register unsigned char *p, *end;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1458 int c, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1459
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1460 CHECK_NATNUM (length, 0);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1461 CHECK_NUMBER (init, 1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1462
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1463 c = XINT (init);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1464 if (SINGLE_BYTE_CHAR_P (c))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1465 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1466 nbytes = XINT (length);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1467 val = make_uninit_string (nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1468 p = XSTRING (val)->data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1469 end = p + XSTRING (val)->size;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1470 while (p != end)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1471 *p++ = c;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1472 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1473 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1474 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1475 unsigned char str[4];
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1476 int len = CHAR_STRING (c, str);
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 nbytes = len * XINT (length);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1479 val = make_uninit_multibyte_string (XINT (length), nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1480 p = XSTRING (val)->data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1481 end = p + nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1482 while (p != end)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1483 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1484 bcopy (str, p, len);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1485 p += len;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1486 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1487 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1488
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1489 *p = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1490 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1491 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1492
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 DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1495 "Return a new bool-vector of length LENGTH, using INIT for as each element.\n\
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1496 LENGTH must be a number. INIT matters only in whether it is t or nil.")
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1497 (length, init)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1498 Lisp_Object length, init;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1499 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1500 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1501 struct Lisp_Bool_Vector *p;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1502 int real_init, i;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1503 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
1504
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1505 CHECK_NATNUM (length, 0);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1506
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1507 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
1508
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1509 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
1510 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
1511
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1512 /* 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
1513 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
1514 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
1515 p = XBOOL_VECTOR (val);
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1516
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1517 /* 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
1518 p->vector_size = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1519 XSETBOOL_VECTOR (val, p);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1520 p->size = XFASTINT (length);
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 real_init = (NILP (init) ? 0 : -1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1523 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
1524 p->data[i] = real_init;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1525
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1526 /* 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
1527 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
1528 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
1529 &= (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
1530
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1531 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1532 }
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
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1535 /* 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
1536 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
1537 multibyte, depending on the contents. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1538
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1539 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1540 make_string (contents, nbytes)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1541 char *contents;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1542 int nbytes;
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 register Lisp_Object val;
28997
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
1545 int nchars, multibyte_nbytes;
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
1546
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
1547 parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1548 val = make_uninit_multibyte_string (nchars, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1549 bcopy (contents, XSTRING (val)->data, nbytes);
28997
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
1550 if (nbytes == nchars || nbytes != multibyte_nbytes)
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
1551 /* 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
1552 multibyte sequence. We must make unibyte string. */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1553 SET_STRING_BYTES (XSTRING (val), -1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1554 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1555 }
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
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1558 /* 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
1559
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1560 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1561 make_unibyte_string (contents, length)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1562 char *contents;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1563 int length;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1564 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1565 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1566 val = make_uninit_string (length);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1567 bcopy (contents, XSTRING (val)->data, length);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1568 SET_STRING_BYTES (XSTRING (val), -1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1569 return val;
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 /* 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
1574 bytes at CONTENTS. */
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 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1577 make_multibyte_string (contents, nchars, nbytes)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1578 char *contents;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1579 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1580 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1581 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1582 val = make_uninit_multibyte_string (nchars, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1583 bcopy (contents, XSTRING (val)->data, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1584 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1585 }
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
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1588 /* 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
1589 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
1590
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1591 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1592 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
1593 char *contents;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1594 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1595 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1596 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1597 val = make_uninit_multibyte_string (nchars, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1598 bcopy (contents, XSTRING (val)->data, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1599 if (STRING_BYTES (XSTRING (val)) == XSTRING (val)->size)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1600 SET_STRING_BYTES (XSTRING (val), -1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1601 return val;
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
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1604
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1605 /* 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
1606 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
1607 string as multibyte. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1608
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1609 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1610 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
1611 char *contents;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1612 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1613 int multibyte;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1614 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1615 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1616 val = make_uninit_multibyte_string (nchars, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1617 bcopy (contents, XSTRING (val)->data, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1618 if (!multibyte)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1619 SET_STRING_BYTES (XSTRING (val), -1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1620 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1621 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1622
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1623
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1624 /* 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
1625 data warrants. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1626
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1627 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1628 build_string (str)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1629 char *str;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1630 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1631 return make_string (str, strlen (str));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1632 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1633
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1634
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1635 /* 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
1636 occupying LENGTH bytes. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1637
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1638 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1639 make_uninit_string (length)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1640 int length;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1641 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1642 Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1643 val = make_uninit_multibyte_string (length, length);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1644 SET_STRING_BYTES (XSTRING (val), -1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1645 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1646 }
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 /* 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
1650 which occupy NBYTES bytes. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1651
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1652 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1653 make_uninit_multibyte_string (nchars, nbytes)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1654 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1655 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1656 Lisp_Object string;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1657 struct Lisp_String *s;
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 if (nchars < 0)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1660 abort ();
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1661
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1662 s = allocate_string ();
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1663 allocate_string_data (s, nchars, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1664 XSETSTRING (string, s);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1665 string_chars_consed += nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1666 return string;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1667 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1668
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1669
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 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1672 Float Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1673 ***********************************************************************/
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
1674
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1675 /* 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
1676 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
1677 by GC are put on a free list to be reallocated before allocating
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1678 any new float cells from the latest float_block.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1679
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1680 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
1681 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
1682 overhead. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1683
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1684 #define FLOAT_BLOCK_SIZE \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1685 ((1020 - sizeof (struct float_block *)) / sizeof (struct Lisp_Float))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1686
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1687 struct float_block
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1688 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1689 struct float_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1690 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
1691 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1692
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1693 /* Current float_block. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1694
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1695 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
1696
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1697 /* 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
1698
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1699 int float_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1700
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1701 /* 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
1702
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1703 int n_float_blocks;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1704
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1705 /* 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
1706
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1707 struct Lisp_Float *float_free_list;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1708
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1709
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1710 /* Initialze float allocation. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1711
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1712 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1713 init_float ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1714 {
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1715 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
1716 MEM_TYPE_FLOAT);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1717 float_block->next = 0;
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
1718 bzero ((char *) float_block->floats, sizeof float_block->floats);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1719 float_block_index = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1720 float_free_list = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1721 n_float_blocks = 1;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1722 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1723
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1724
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1725 /* 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
1726
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21379
diff changeset
1727 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1728 free_float (ptr)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1729 struct Lisp_Float *ptr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1730 {
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
1731 *(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
1732 #if GC_MARK_STACK
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1733 ptr->type = Vdead;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1734 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1735 float_free_list = ptr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1736 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1737
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1739 /* 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
1740
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1741 Lisp_Object
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1742 make_float (float_value)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1743 double float_value;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1744 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1745 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1746
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1747 if (float_free_list)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1748 {
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
1749 /* 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
1750 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
1751 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
1752 float_free_list = *(struct Lisp_Float **)&float_free_list->data;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1753 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1754 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1755 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1756 if (float_block_index == FLOAT_BLOCK_SIZE)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1757 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
1758 register struct float_block *new;
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
1759
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1760 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
1761 MEM_TYPE_FLOAT);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1762 VALIDATE_LISP_STORAGE (new, sizeof *new);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1763 new->next = float_block;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1764 float_block = new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1765 float_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1766 n_float_blocks++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1767 }
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
1768 XSETFLOAT (val, &float_block->floats[float_block_index++]);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1769 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1770
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
1771 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
1772 XSETFASTINT (XFLOAT (val)->type, 0); /* bug chasing -wsr */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1773 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
1774 floats_consed++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1775 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1776 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1777
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1778
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1779
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1780 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1781 Cons Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1782 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1783
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1784 /* We store cons cells inside of cons_blocks, allocating a new
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1785 cons_block with malloc whenever necessary. Cons cells reclaimed by
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1786 GC are put on a free list to be reallocated before allocating
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1787 any new cons cells from the latest cons_block.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1788
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1789 Each cons_block is just under 1020 bytes long,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1790 since malloc really allocates in units of powers of two
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1791 and uses 4 bytes for its own overhead. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1792
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1793 #define CONS_BLOCK_SIZE \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1794 ((1020 - sizeof (struct cons_block *)) / sizeof (struct Lisp_Cons))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1795
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1796 struct cons_block
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1797 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1798 struct cons_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1799 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
1800 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1801
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1802 /* Current cons_block. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1803
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1804 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
1805
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1806 /* 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
1807
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1808 int cons_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1809
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1810 /* 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
1811
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1812 struct Lisp_Cons *cons_free_list;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1813
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1814 /* 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
1815
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1816 int n_cons_blocks;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1817
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1818
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1819 /* Initialize cons allocation. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1820
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1821 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1822 init_cons ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1823 {
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1824 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
1825 MEM_TYPE_CONS);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1826 cons_block->next = 0;
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
1827 bzero ((char *) cons_block->conses, sizeof cons_block->conses);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1828 cons_block_index = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1829 cons_free_list = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1830 n_cons_blocks = 1;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1831 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1832
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1833
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1834 /* 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
1835
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
1836 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1837 free_cons (ptr)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1838 struct Lisp_Cons *ptr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1839 {
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
1840 *(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
1841 #if GC_MARK_STACK
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1842 ptr->car = Vdead;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1843 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1844 cons_free_list = ptr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1845 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1846
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1847
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1848 DEFUN ("cons", Fcons, Scons, 2, 2, 0,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1849 "Create a new cons, give it CAR and CDR as components, and return it.")
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1850 (car, cdr)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1851 Lisp_Object car, cdr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1852 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1853 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1854
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1855 if (cons_free_list)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1856 {
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
1857 /* 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
1858 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
1859 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
1860 cons_free_list = *(struct Lisp_Cons **)&cons_free_list->cdr;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1861 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1862 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1863 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1864 if (cons_block_index == CONS_BLOCK_SIZE)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1865 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
1866 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
1867 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
1868 MEM_TYPE_CONS);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1869 VALIDATE_LISP_STORAGE (new, sizeof *new);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1870 new->next = cons_block;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1871 cons_block = new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1872 cons_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1873 n_cons_blocks++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1874 }
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
1875 XSETCONS (val, &cons_block->conses[cons_block_index++]);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1876 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1877
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
1878 XCAR (val) = car;
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
1879 XCDR (val) = cdr;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1880 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
1881 cons_cells_consed++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1882 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1883 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1884
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1885
20849
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1886 /* 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
1887
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1888 Lisp_Object
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1889 list2 (arg1, arg2)
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1890 Lisp_Object arg1, arg2;
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1891 {
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1892 return Fcons (arg1, Fcons (arg2, Qnil));
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1893 }
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1894
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1895
20849
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1896 Lisp_Object
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1897 list3 (arg1, arg2, arg3)
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1898 Lisp_Object arg1, arg2, arg3;
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1899 {
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1900 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
1901 }
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1902
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1903
20849
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1904 Lisp_Object
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1905 list4 (arg1, arg2, arg3, arg4)
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1906 Lisp_Object arg1, arg2, arg3, arg4;
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1907 {
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1908 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
1909 }
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1910
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1911
20849
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1912 Lisp_Object
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1913 list5 (arg1, arg2, arg3, arg4, arg5)
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1914 Lisp_Object arg1, arg2, arg3, arg4, arg5;
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1915 {
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1916 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
1917 Fcons (arg5, Qnil)))));
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
1918 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
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
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1921 DEFUN ("list", Flist, Slist, 0, MANY, 0,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1922 "Return a newly created list with specified arguments as elements.\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1923 Any number of arguments, even zero arguments, are allowed.")
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1924 (nargs, args)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1925 int nargs;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1926 register Lisp_Object *args;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1927 {
13610
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
1928 register Lisp_Object val;
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
1929 val = Qnil;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1930
13610
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
1931 while (nargs > 0)
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
1932 {
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
1933 nargs--;
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
1934 val = Fcons (args[nargs], val);
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
1935 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1936 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1937 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1938
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1939
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1940 DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1941 "Return a newly created list of length LENGTH, with each element being INIT.")
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1942 (length, init)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1943 register Lisp_Object length, init;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1944 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1945 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1946 register int size;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1947
9953
e0672d4cf470 (Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents: 9942
diff changeset
1948 CHECK_NATNUM (length, 0);
e0672d4cf470 (Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents: 9942
diff changeset
1949 size = XFASTINT (length);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1950
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1951 val = Qnil;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1952 while (size-- > 0)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1953 val = Fcons (init, val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1954 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1955 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1956
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1957
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1958
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1959 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1960 Vector Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1961 ***********************************************************************/
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1962
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1963 /* 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
1964
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1965 struct Lisp_Vector *all_vectors;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1966
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1967 /* 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
1968
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1969 int n_vectors;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1970
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1971
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1972 /* 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
1973 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
1974
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
1975 struct Lisp_Vector *
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
1976 allocate_vectorlike (len)
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
1977 EMACS_INT len;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
1978 {
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
1979 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
1980 size_t nbytes;
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
1981
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
1982 #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
1983 /* 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
1984 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
1985 a dumped Emacs. */
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
1986 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
1987 #endif
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1988
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1989 nbytes = sizeof *p + (len - 1) * sizeof p->contents[0];
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1990 p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTOR);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1991
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
1992 #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
1993 /* 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
1994 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
1995 #endif
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1996
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
1997 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
1998 consing_since_gc += nbytes;
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
1999 vector_cells_consed += len;
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2000
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2001 p->next = all_vectors;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2002 all_vectors = p;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2003 ++n_vectors;
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2004 return p;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2005 }
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2006
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2007
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2008 DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2009 "Return a newly created vector of length LENGTH, with each element being INIT.\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2010 See also the function `vector'.")
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2011 (length, init)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2012 register Lisp_Object length, init;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2013 {
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2014 Lisp_Object vector;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2015 register EMACS_INT sizei;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2016 register int index;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2017 register struct Lisp_Vector *p;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2018
9953
e0672d4cf470 (Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents: 9942
diff changeset
2019 CHECK_NATNUM (length, 0);
e0672d4cf470 (Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents: 9942
diff changeset
2020 sizei = XFASTINT (length);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2021
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2022 p = allocate_vectorlike (sizei);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2023 p->size = sizei;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2024 for (index = 0; index < sizei; index++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2025 p->contents[index] = init;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2026
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2027 XSETVECTOR (vector, p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2028 return vector;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2029 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2030
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2031
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
2032 DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
13322
336cbb88a1e3 (Fmake_char_table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 13320
diff changeset
2033 "Return a newly created char-table, with purpose PURPOSE.\n\
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2034 Each element is initialized to INIT, which defaults to nil.\n\
16479
52eaaf1cc0e3 (Fmake_char_table): Doc fix.
Erik Naggum <erik@naggum.no>
parents: 16231
diff changeset
2035 PURPOSE should be a symbol which has a `char-table-extra-slots' property.\n\
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
2036 The property's value should be an integer between 0 and 10.")
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
2037 (purpose, init)
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
2038 register Lisp_Object purpose, init;
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2039 {
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2040 Lisp_Object vector;
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
2041 Lisp_Object n;
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
2042 CHECK_SYMBOL (purpose, 1);
17328
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2043 n = Fget (purpose, Qchar_table_extra_slots);
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
2044 CHECK_NUMBER (n, 0);
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2045 if (XINT (n) < 0 || XINT (n) > 10)
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2046 args_out_of_range (n, Qnil);
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2047 /* 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
2048 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
2049 init);
17328
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2050 XCHAR_TABLE (vector)->top = Qt;
13150
3778c95adca9 (Fmake_char_table): Initialize parent to nil.
Erik Naggum <erik@naggum.no>
parents: 13141
diff changeset
2051 XCHAR_TABLE (vector)->parent = Qnil;
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
2052 XCHAR_TABLE (vector)->purpose = purpose;
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2053 XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2054 return vector;
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2055 }
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2056
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2057
17328
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2058 /* 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
2059 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
2060 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
2061
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2062 Lisp_Object
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2063 make_sub_char_table (defalt)
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2064 Lisp_Object defalt;
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2065 {
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2066 Lisp_Object vector
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2067 = 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
2068 XCHAR_TABLE (vector)->top = Qnil;
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2069 XCHAR_TABLE (vector)->defalt = defalt;
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2070 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
2071 return vector;
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2072 }
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2073
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2074
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2075 DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2076 "Return a newly created vector with specified arguments as elements.\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2077 Any number of arguments, even zero arguments, are allowed.")
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2078 (nargs, args)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2079 register int nargs;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2080 Lisp_Object *args;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2081 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2082 register Lisp_Object len, val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2083 register int index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2084 register struct Lisp_Vector *p;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2085
9295
17d393a8eed6 (free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents: 9261
diff changeset
2086 XSETFASTINT (len, nargs);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2087 val = Fmake_vector (len, Qnil);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2088 p = XVECTOR (val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2089 for (index = 0; index < nargs; index++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2090 p->contents[index] = args[index];
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2091 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2092 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2093
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2094
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2095 DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2096 "Create a byte-code object with specified arguments as elements.\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2097 The arguments should be the arglist, bytecode-string, constant vector,\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2098 stack size, (optional) doc string, and (optional) interactive spec.\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2099 The first four arguments are required; at most six have any\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2100 significance.")
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2101 (nargs, args)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2102 register int nargs;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2103 Lisp_Object *args;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2104 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2105 register Lisp_Object len, val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2106 register int index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2107 register struct Lisp_Vector *p;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2108
9295
17d393a8eed6 (free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents: 9261
diff changeset
2109 XSETFASTINT (len, nargs);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 434
diff changeset
2110 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
2111 val = make_pure_vector ((EMACS_INT) nargs);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2112 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2113 val = Fmake_vector (len, Qnil);
28997
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
2114
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
2115 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
2116 /* 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
2117 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
2118 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
2119 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
2120 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
2121 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
2122
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2123 p = XVECTOR (val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2124 for (index = 0; index < nargs; index++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2125 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 434
diff changeset
2126 if (!NILP (Vpurify_flag))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2127 args[index] = Fpurecopy (args[index]);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2128 p->contents[index] = args[index];
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2129 }
18104
b2a669ef69b1 (Fmake_byte_code): Set val from p, not from val.
Richard M. Stallman <rms@gnu.org>
parents: 18010
diff changeset
2130 XSETCOMPILED (val, p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2131 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2132 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2133
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2134
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2135
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2136 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2137 Symbol Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2138 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2139
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2140 /* 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
2141 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
2142 own overhead. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2143
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2144 #define SYMBOL_BLOCK_SIZE \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2145 ((1020 - sizeof (struct symbol_block *)) / sizeof (struct Lisp_Symbol))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2146
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2147 struct symbol_block
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2148 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2149 struct symbol_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2150 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
2151 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2152
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2153 /* 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
2154 structure in it. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2155
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2156 struct symbol_block *symbol_block;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2157 int symbol_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2158
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2159 /* List of free symbols. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2160
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2161 struct Lisp_Symbol *symbol_free_list;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2162
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2163 /* 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
2164
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2165 int n_symbol_blocks;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2166
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2167
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2168 /* Initialize symbol allocation. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2169
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2170 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2171 init_symbol ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2172 {
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2173 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
2174 MEM_TYPE_SYMBOL);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2175 symbol_block->next = 0;
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
2176 bzero ((char *) symbol_block->symbols, sizeof symbol_block->symbols);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2177 symbol_block_index = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2178 symbol_free_list = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2179 n_symbol_blocks = 1;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2180 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2181
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2182
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2183 DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2184 "Return a newly allocated uninterned symbol whose name is NAME.\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2185 Its value and function definition are void, and its property list is nil.")
14093
338f645e6b9a (Fmake_symbol): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2186 (name)
338f645e6b9a (Fmake_symbol): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2187 Lisp_Object name;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2188 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2189 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2190 register struct Lisp_Symbol *p;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2191
14093
338f645e6b9a (Fmake_symbol): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2192 CHECK_STRING (name, 0);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2193
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2194 if (symbol_free_list)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2195 {
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
2196 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
2197 symbol_free_list = *(struct Lisp_Symbol **)&symbol_free_list->value;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2198 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2199 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2200 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2201 if (symbol_block_index == SYMBOL_BLOCK_SIZE)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2202 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
2203 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
2204 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
2205 MEM_TYPE_SYMBOL);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2206 VALIDATE_LISP_STORAGE (new, sizeof *new);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2207 new->next = symbol_block;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2208 symbol_block = new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2209 symbol_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2210 n_symbol_blocks++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2211 }
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
2212 XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2213 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2214
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2215 p = XSYMBOL (val);
14095
d612434249db (Fmake_symbol): Harmonize arguments with documentation (correctly).
Erik Naggum <erik@naggum.no>
parents: 14093
diff changeset
2216 p->name = XSTRING (name);
16223
bab3f12493b6 (Fmake_symbol): Initialize `obarray' field.
Erik Naggum <erik@naggum.no>
parents: 16101
diff changeset
2217 p->obarray = Qnil;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2218 p->plist = Qnil;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2219 p->value = Qunbound;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2220 p->function = Qunbound;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2221 p->next = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2222 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
2223 symbols_consed++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2224 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2225 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2226
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2227
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2228
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2229 /***********************************************************************
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2230 Marker (Misc) Allocation
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2231 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2232
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2233 /* Allocation of markers and other objects that share that structure.
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2234 Works like allocation of conses. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2235
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2236 #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
2237 ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2238
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2239 struct marker_block
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2240 {
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2241 struct marker_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2242 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
2243 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2244
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2245 struct marker_block *marker_block;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2246 int marker_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2247
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2248 union Lisp_Misc *marker_free_list;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2249
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2250 /* 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
2251
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2252 int n_marker_blocks;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2253
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2254 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2255 init_marker ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2256 {
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2257 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
2258 MEM_TYPE_MISC);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2259 marker_block->next = 0;
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
2260 bzero ((char *) marker_block->markers, sizeof marker_block->markers);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2261 marker_block_index = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2262 marker_free_list = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2263 n_marker_blocks = 1;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2264 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2265
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2266 /* 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
2267
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2268 Lisp_Object
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2269 allocate_misc ()
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2270 {
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2271 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
2272
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2273 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
2274 {
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2275 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
2276 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
2277 }
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2278 else
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2279 {
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2280 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
2281 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
2282 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
2283 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
2284 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
2285 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
2286 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
2287 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
2288 marker_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2289 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
2290 }
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2291 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
2292 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2293
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2294 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
2295 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
2296 return val;
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2297 }
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2298
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2299 DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2300 "Return a newly allocated marker which does not point at any place.")
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2301 ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2302 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2303 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2304 register struct Lisp_Marker *p;
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 624
diff changeset
2305
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2306 val = allocate_misc ();
11243
054ecfce1820 (Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11048
diff changeset
2307 XMISCTYPE (val) = Lisp_Misc_Marker;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2308 p = XMARKER (val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2309 p->buffer = 0;
20565
aa9b7c5f0f62 (Fmake_marker): Initialize marker's bytepos and charpos.
Richard M. Stallman <rms@gnu.org>
parents: 20495
diff changeset
2310 p->bytepos = 0;
aa9b7c5f0f62 (Fmake_marker): Initialize marker's bytepos and charpos.
Richard M. Stallman <rms@gnu.org>
parents: 20495
diff changeset
2311 p->charpos = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2312 p->chain = Qnil;
13008
f042ef632b22 (Fmake_marker): Initialize insertion_type to 0.
Richard M. Stallman <rms@gnu.org>
parents: 12748
diff changeset
2313 p->insertion_type = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2314 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2315 }
19332
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2316
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2317 /* 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
2318
20375
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
2319 void
19332
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2320 free_marker (marker)
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2321 Lisp_Object marker;
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2322 {
19621
74151390752c (free_marker): Call unchain_marker.
Richard M. Stallman <rms@gnu.org>
parents: 19332
diff changeset
2323 unchain_marker (marker);
74151390752c (free_marker): Call unchain_marker.
Richard M. Stallman <rms@gnu.org>
parents: 19332
diff changeset
2324
19332
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2325 XMISC (marker)->u_marker.type = Lisp_Misc_Free;
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2326 XMISC (marker)->u_free.chain = marker_free_list;
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2327 marker_free_list = XMISC (marker);
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2328
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2329 total_free_markers++;
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2330 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2331
21258
693573ac0944 (make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
2332
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2333 /* 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
2334 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
2335 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
2336
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2337 Any number of arguments, even zero arguments, are allowed. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2338
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2339 Lisp_Object
2013
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2340 make_event_array (nargs, args)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2341 register int nargs;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2342 Lisp_Object *args;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2343 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2344 int i;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2345
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2346 for (i = 0; i < nargs; i++)
2013
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2347 /* 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
2348 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
2349 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
2350 if (!INTEGERP (args[i])
3536
58d5ee6ec253 (make_event_array): Ignore bits above CHAR_META.
Richard M. Stallman <rms@gnu.org>
parents: 3181
diff changeset
2351 || (XUINT (args[i]) & ~(-CHAR_META)) >= 0200)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2352 return Fvector (nargs, args);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2353
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2354 /* Since the loop exited, we know that all the things in it are
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2355 characters, so we can make a string. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2356 {
6492
8372dce85f8a (make_event_array): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
parents: 6227
diff changeset
2357 Lisp_Object result;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2358
18104
b2a669ef69b1 (Fmake_byte_code): Set val from p, not from val.
Richard M. Stallman <rms@gnu.org>
parents: 18010
diff changeset
2359 result = Fmake_string (make_number (nargs), make_number (0));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2360 for (i = 0; i < nargs; i++)
2013
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2361 {
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2362 XSTRING (result)->data[i] = XINT (args[i]);
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2363 /* 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
2364 if (XINT (args[i]) & CHAR_META)
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2365 XSTRING (result)->data[i] |= 0x80;
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2366 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2367
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2368 return result;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2369 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2370 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2371
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2372
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2373
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2374 /************************************************************************
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2375 C Stack Marking
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2376 ************************************************************************/
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2377
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2378 #if GC_MARK_STACK
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2379
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2380
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2381 /* Base address of stack. Set in main. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2382
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2383 Lisp_Object *stack_base;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2384
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2385 /* A node in the red-black tree describing allocated memory containing
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2386 Lisp data. Each such block is recorded with its start and end
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2387 address when it is allocated, and removed from the tree when it
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2388 is freed.
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2389
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2390 A red-black tree is a balanced binary tree with the following
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2391 properties:
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2392
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2393 1. Every node is either red or black.
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2394 2. Every leaf is black.
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2395 3. If a node is red, then both of its children are black.
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2396 4. Every simple path from a node to a descendant leaf contains
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2397 the same number of black nodes.
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2398 5. The root is always black.
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2399
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2400 When nodes are inserted into the tree, or deleted from the tree,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2401 the tree is "fixed" so that these properties are always true.
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2402
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2403 A red-black tree with N internal nodes has height at most 2
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2404 log(N+1). Searches, insertions and deletions are done in O(log N).
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2405 Please see a text book about data structures for a detailed
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2406 description of red-black trees. Any book worth its salt should
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2407 describe them. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2408
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2409 struct mem_node
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2410 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2411 struct mem_node *left, *right, *parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2412
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2413 /* Start and end of allocated region. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2414 void *start, *end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2415
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2416 /* Node color. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2417 enum {MEM_BLACK, MEM_RED} color;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2418
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2419 /* Memory type. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2420 enum mem_type type;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2421 };
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2422
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2423 /* Root of the tree describing allocated Lisp memory. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2424
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2425 static struct mem_node *mem_root;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2426
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2427 /* Sentinel node of the tree. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2428
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2429 static struct mem_node mem_z;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2430 #define MEM_NIL &mem_z
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2431
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2432
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2433 /* 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
2434
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2435 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2436 mem_init ()
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2437 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2438 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
2439 mem_z.parent = NULL;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2440 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
2441 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
2442 mem_root = MEM_NIL;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2443 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2444
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2445
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2446 /* 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
2447 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
2448
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2449 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
2450 mem_find (start)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2451 void *start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2452 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2453 struct mem_node *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2454
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2455 /* 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
2456 mem_z.start = start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2457 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
2458
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2459 p = mem_root;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2460 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
2461 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
2462 return p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2463 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2464
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2465
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2466 /* 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
2467 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
2468 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
2469
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2470 static struct mem_node *
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2471 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
2472 void *start, *end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2473 enum mem_type type;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2474 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2475 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
2476
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2477 /* 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
2478 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
2479 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
2480 c = mem_root;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2481 parent = NULL;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2482
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2483 #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
2484
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2485 while (c != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2486 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2487 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
2488 abort ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2489 parent = c;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2490 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
2491 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2492
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2493 #else /* 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
2494
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2495 while (c != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2496 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2497 parent = c;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2498 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
2499 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2500
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2501 #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
2502
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2503 /* Create a new node. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2504 x = (struct mem_node *) xmalloc (sizeof *x);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2505 x->start = start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2506 x->end = end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2507 x->type = type;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2508 x->parent = parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2509 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
2510 x->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2511
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2512 /* 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
2513 if (parent)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2514 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2515 if (start < parent->start)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2516 parent->left = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2517 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2518 parent->right = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2519 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2520 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2521 mem_root = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2522
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2523 /* 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
2524 mem_insert_fixup (x);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2525 return x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2526 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2527
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2528
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2529 /* 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
2530 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
2531
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2532 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2533 mem_insert_fixup (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2534 struct mem_node *x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2535 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2536 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
2537 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2538 /* 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
2539 red-black tree property #3. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2540
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2541 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
2542 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2543 /* 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
2544 "uncle". */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2545 struct mem_node *y = x->parent->parent->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2546
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2547 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
2548 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2549 /* 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
2550 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
2551 with the grandparent. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2552 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
2553 y->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2554 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
2555 x = x->parent->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2556 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2557 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2558 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2559 /* 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
2560 red, uncle is black. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2561 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
2562 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2563 x = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2564 mem_rotate_left (x);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2565 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2566
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2567 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
2568 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
2569 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
2570 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2571 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2572 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2573 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2574 /* 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
2575 struct mem_node *y = x->parent->parent->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2576
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2577 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
2578 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2579 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
2580 y->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2581 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
2582 x = x->parent->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2583 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2584 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2585 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2586 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
2587 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2588 x = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2589 mem_rotate_right (x);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2590 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2591
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2592 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
2593 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
2594 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
2595 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2596 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2597 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2598
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2599 /* 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
2600 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
2601 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
2602 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2603
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2604
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2605 /* (x) (y)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2606 / \ / \
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2607 a (y) ===> (x) c
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2608 / \ / \
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2609 b c a b */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2610
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2611 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2612 mem_rotate_left (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2613 struct mem_node *x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2614 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2615 struct mem_node *y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2616
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2617 /* 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
2618 y = x->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2619 x->right = y->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2620 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
2621 y->left->parent = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2622
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2623 /* 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
2624 if (y != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2625 y->parent = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2626
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2627 /* 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
2628 if (x->parent)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2629 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2630 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
2631 x->parent->left = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2632 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2633 x->parent->right = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2634 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2635 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2636 mem_root = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2637
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2638 /* 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
2639 y->left = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2640 if (x != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2641 x->parent = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2642 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2643
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2644
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2645 /* (x) (Y)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2646 / \ / \
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2647 (y) c ===> a (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2648 / \ / \
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2649 a b b c */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2650
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2651 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2652 mem_rotate_right (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2653 struct mem_node *x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2654 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2655 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
2656
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2657 x->left = y->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2658 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
2659 y->right->parent = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2660
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2661 if (y != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2662 y->parent = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2663 if (x->parent)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2664 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2665 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
2666 x->parent->right = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2667 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2668 x->parent->left = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2669 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2670 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2671 mem_root = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2672
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2673 y->right = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2674 if (x != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2675 x->parent = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2676 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2677
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2678
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2679 /* 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
2680
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2681 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2682 mem_delete (z)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2683 struct mem_node *z;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2684 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2685 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
2686
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2687 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
2688 return;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2689
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2690 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
2691 y = z;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2692 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2693 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2694 y = z->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2695 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
2696 y = y->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2697 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2698
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2699 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
2700 x = y->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2701 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2702 x = y->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2703
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2704 x->parent = y->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2705 if (y->parent)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2706 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2707 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
2708 y->parent->left = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2709 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2710 y->parent->right = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2711 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2712 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2713 mem_root = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2714
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2715 if (y != z)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2716 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2717 z->start = y->start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2718 z->end = y->end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2719 z->type = y->type;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2720 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2721
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2722 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
2723 mem_delete_fixup (x);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2724 xfree (y);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2725 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2726
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2727
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2728 /* 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
2729 deletion. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2730
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2731 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2732 mem_delete_fixup (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2733 struct mem_node *x;
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 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
2736 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2737 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
2738 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2739 struct mem_node *w = x->parent->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2740
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2741 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
2742 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2743 w->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2744 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
2745 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
2746 w = x->parent->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2747 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2748
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2749 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
2750 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2751 w->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2752 x = x->parent;
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 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2755 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2756 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
2757 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2758 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
2759 w->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2760 mem_rotate_right (w);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2761 w = x->parent->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2762 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2763 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
2764 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
2765 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
2766 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
2767 x = mem_root;
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 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2770 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2771 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2772 struct mem_node *w = x->parent->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2773
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2774 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
2775 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2776 w->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2777 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
2778 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
2779 w = x->parent->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2780 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2781
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2782 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
2783 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2784 w->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2785 x = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2786 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2787 else
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 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
2790 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2791 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
2792 w->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2793 mem_rotate_left (w);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2794 w = x->parent->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2795 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2796
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2797 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
2798 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
2799 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
2800 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
2801 x = mem_root;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2802 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2803 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2804 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2805
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2806 x->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2807 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2808
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2809
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2810 /* 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
2811 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
2812
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2813 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2814 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
2815 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2816 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2817 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2818 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
2819 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2820 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
2821 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
2822
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2823 /* 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
2824 must not be on the free-list. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2825 return (offset % sizeof b->strings[0] == 0
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2826 && ((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
2827 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2828 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2829 return 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2830 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2831
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2832
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2833 /* 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
2834 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
2835
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2836 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2837 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
2838 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2839 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2840 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2841 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
2842 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2843 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
2844 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
2845
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2846 /* 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
2847 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
2848 and not be on the free-list. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2849 return (offset % sizeof b->conses[0] == 0
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2850 && (b != cons_block
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2851 || 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
2852 && !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
2853 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2854 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2855 return 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2856 }
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 /* 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
2860 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
2861
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2862 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2863 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
2864 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2865 void *p;
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 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
2868 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2869 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
2870 int offset = (char *) p - (char *) &b->symbols[0];
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2871
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2872 /* 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
2873 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
2874 and not be on the free-list. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2875 return (offset % sizeof b->symbols[0] == 0
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2876 && (b != symbol_block
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2877 || 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
2878 && !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
2879 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2880 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2881 return 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2882 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2883
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2884
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2885 /* 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
2886 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
2887
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2888 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2889 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
2890 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2891 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2892 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2893 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
2894 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2895 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
2896 int offset = (char *) p - (char *) &b->floats[0];
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 /* 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
2899 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
2900 and not be on the free-list. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2901 return (offset % sizeof b->floats[0] == 0
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2902 && (b != float_block
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2903 || 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
2904 && !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
2905 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2906 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2907 return 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2908 }
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
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2911 /* 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
2912 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
2913
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2914 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2915 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
2916 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2917 void *p;
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 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
2920 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2921 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
2922 int offset = (char *) p - (char *) &b->markers[0];
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2923
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2924 /* 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
2925 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
2926 and not be on the free-list. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2927 return (offset % sizeof b->markers[0] == 0
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2928 && (b != marker_block
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2929 || 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
2930 && ((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
2931 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2932 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2933 return 0;
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
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2936
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2937 /* 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
2938 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
2939
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2940 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2941 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
2942 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2943 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2944 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2945 return m->type == MEM_TYPE_VECTOR && p == m->start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2946 }
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
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2949 /* 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
2950 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
2951
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2952 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2953 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
2954 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2955 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2956 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2957 /* 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
2958 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
2959 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
2960 && p == m->start
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2961 && !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
2962 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2963
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2964
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2965 #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
2966
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2967 /* 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
2968 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
2969
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2970 #define MAX_ZOMBIES 10
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2971 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
2972
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2973 /* Number of zombie objects. */
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 static int nzombies;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2976
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2977 /* Number of garbage collections. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2978
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2979 static int ngcs;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2980
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2981 /* 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
2982
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2983 static double avg_zombies;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2984
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2985 /* 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
2986
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2987 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
2988
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2989 /* 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
2990
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2991 static double avg_live;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2992
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2993 DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "",
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2994 "Show information about live and zombie objects.")
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 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2997 Lisp_Object args[7];
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2998 args[0] = build_string ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d");
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2999 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
3000 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
3001 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
3002 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
3003 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
3004 args[6] = make_number (max_zombies);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3005 return Fmessage (7, args);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3006 }
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 #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
3009
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3010
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3011 /* 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
3012
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3013 static INLINE void
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3014 mark_maybe_object (obj)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3015 Lisp_Object obj;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3016 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3017 void *po = (void *) XPNTR (obj);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3018 struct mem_node *m = mem_find (po);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3019
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3020 if (m != MEM_NIL)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3021 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3022 int mark_p = 0;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3023
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3024 switch (XGCTYPE (obj))
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3025 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3026 case Lisp_String:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3027 mark_p = (live_string_p (m, po)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3028 && !STRING_MARKED_P ((struct Lisp_String *) po));
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3029 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3030
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3031 case Lisp_Cons:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3032 mark_p = (live_cons_p (m, po)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3033 && !XMARKBIT (XCONS (obj)->car));
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3034 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3035
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3036 case Lisp_Symbol:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3037 mark_p = (live_symbol_p (m, po)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3038 && !XMARKBIT (XSYMBOL (obj)->plist));
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3039 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3040
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3041 case Lisp_Float:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3042 mark_p = (live_float_p (m, po)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3043 && !XMARKBIT (XFLOAT (obj)->type));
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3044 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3045
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3046 case Lisp_Vectorlike:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3047 /* 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
3048 buffer because checking that dereferences the pointer
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3049 PO which might point anywhere. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3050 if (live_vector_p (m, po))
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3051 mark_p = (!GC_SUBRP (obj)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3052 && !(XVECTOR (obj)->size & ARRAY_MARK_FLAG));
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3053 else if (live_buffer_p (m, po))
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3054 mark_p = GC_BUFFERP (obj) && !XMARKBIT (XBUFFER (obj)->name);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3055 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3056
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3057 case Lisp_Misc:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3058 if (live_misc_p (m, po))
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3059 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3060 switch (XMISCTYPE (obj))
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3061 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3062 case Lisp_Misc_Marker:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3063 mark_p = !XMARKBIT (XMARKER (obj)->chain);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3064 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3065
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3066 case Lisp_Misc_Buffer_Local_Value:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3067 case Lisp_Misc_Some_Buffer_Local_Value:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3068 mark_p = !XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3069 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3070
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3071 case Lisp_Misc_Overlay:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3072 mark_p = !XMARKBIT (XOVERLAY (obj)->plist);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3073 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3074 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3075 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3076 break;
31829
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
3077
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
3078 case Lisp_Int:
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
3079 case Lisp_Type_Limit:
31829
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
3080 break;
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3081 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3082
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3083 if (mark_p)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3084 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3085 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3086 if (nzombies < MAX_ZOMBIES)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3087 zombies[nzombies] = *p;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3088 ++nzombies;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3089 #endif
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3090 mark_object (&obj);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3091 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3092 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3093 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3094
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3095 /* Mark Lisp objects in the address range START..END. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3096
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3097 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3098 mark_memory (start, end)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3099 void *start, *end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3100 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3101 Lisp_Object *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3102
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3103 #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
3104 nzombies = 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3105 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3106
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3107 /* 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
3108 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
3109 if (end < start)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3110 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3111 void *tem = start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3112 start = end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3113 end = tem;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3114 }
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3115
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3116 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
3117 mark_maybe_object (*p);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3118 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3119
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3120
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3121 #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
3122
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3123 static int setjmp_tested_p, longjmps_done;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3124
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3125 #define SETJMP_WILL_LIKELY_WORK "\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3126 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3127 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
3128 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
3129 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
3130 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3131 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
3132 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
3133 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
3134 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3135 Please mail the result to <gerd@gnu.org>.\n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3136 "
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3137
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3138 #define SETJMP_WILL_NOT_WORK "\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3139 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3140 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
3141 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
3142 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
3143 solution for your system.\n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3144 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3145 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
3146 try to find a way to make it work on your system.\n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3147 Please mail the result to <gerd@gnu.org>.\n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3148 "
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3149
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3150
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3151 /* 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
3152 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
3153 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
3154 conservative stack marking. Only the sources or a disassembly
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3155 can prove that. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3156
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3157 static void
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3158 test_setjmp ()
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3159 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3160 char buf[10];
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3161 register int x;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3162 jmp_buf jbuf;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3163 int result = 0;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3164
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3165 /* Arrange for X to be put in a register. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3166 sprintf (buf, "1");
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3167 x = strlen (buf);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3168 x = 2 * x - 1;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3169
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3170 setjmp (jbuf);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3171 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
3172 {
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3173 /* 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
3174
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3175 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
3176 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
3177 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
3178 isn't sure.
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3179
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3180 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
3181 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
3182
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3183 if (x == 1)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3184 fprintf (stderr, SETJMP_WILL_LIKELY_WORK);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3185 else
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3186 {
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3187 fprintf (stderr, SETJMP_WILL_NOT_WORK);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3188 exit (1);
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3189 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3190 }
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3191
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3192 ++longjmps_done;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3193 x = 2;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3194 if (longjmps_done == 1)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3195 longjmp (jbuf, 1);
27738
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
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3198 #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
3199
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3200
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3201 #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
3202
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3203 /* 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
3204
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3205 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3206 check_gcpros ()
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3207 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3208 struct gcpro *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3209 int i;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3210
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3211 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
3212 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
3213 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
3214 abort ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3215 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3216
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3217 #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
3218
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3219 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3220 dump_zombies ()
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 int i;
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 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
3225 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
3226 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3227 fprintf (stderr, " %d = ", i);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3228 debug_print (zombies[i]);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3229 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3230 }
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 #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
3233
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3234
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3235 /* Mark live Lisp objects on the C stack.
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3236
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3237 There are several system-dependent problems to consider when
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3238 porting this to new architectures:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3239
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3240 Processor Registers
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3241
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3242 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
3243 variables or are used to pass parameters.
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3244
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3245 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
3246 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
3247 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
3248
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3249 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
3250 implementation assumes that calling setjmp saves registers we need
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3251 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
3252 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
3253 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
3254
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3255 Stack Layout
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3256
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3257 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
3258 For example, the stack might look like this
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3259
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3260 +----------------+
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3261 | Lisp_Object | size = 4
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3262 +----------------+
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3263 | something else | size = 2
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3264 +----------------+
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3265 | Lisp_Object | size = 4
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3266 +----------------+
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3267 | ... |
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3268
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3269 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
3270 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
3271 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
3272 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
3273 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
3274 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
3275 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
3276 from the stack start.
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3277
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3278 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
3279 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
3280
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3281 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3282 mark_stack ()
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3283 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3284 jmp_buf j;
31829
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
3285 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
3286 void *end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3287
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3288 /* 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
3289 the process is contained in the stack. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3290 #ifdef sparc
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3291 asm ("ta 3");
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3292 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3293
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3294 /* 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
3295 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
3296 pass parameters. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3297 #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
3298 GC_SAVE_REGISTERS_ON_STACK (end);
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3299 #else /* not GC_SAVE_REGISTERS_ON_STACK */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3300
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3301 #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
3302 setjmp will definitely work, test it
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3303 and print a message with the result
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3304 of the test. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3305 if (!setjmp_tested_p)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3306 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3307 setjmp_tested_p = 1;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3308 test_setjmp ();
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3309 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3310 #endif /* GC_SETJMP_WORKS */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3311
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3312 setjmp (j);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3313 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
3314 #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
3315
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3316 /* 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
3317 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
3318 over the stack segments. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3319 #if GC_LISP_OBJECT_ALIGNMENT == 1
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3320 mark_memory (stack_base, end);
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3321 mark_memory ((char *) stack_base + 1, end);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3322 mark_memory ((char *) stack_base + 2, end);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3323 mark_memory ((char *) stack_base + 3, end);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3324 #elif GC_LISP_OBJECT_ALIGNMENT == 2
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3325 mark_memory (stack_base, end);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3326 mark_memory ((char *) stack_base + 2, end);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3327 #else
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3328 mark_memory (stack_base, end);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3329 #endif
27738
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 #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
3332 check_gcpros ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3333 #endif
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
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 #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
3338
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3339
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3340
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3341 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3342 Pure Storage Management
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3343 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3344
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3345 /* 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
3346 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
3347 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
3348
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3349 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
3350 the allocated object is recorded in pure_types. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3351
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3352 static POINTER_TYPE *
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3353 pure_alloc (size, type)
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3354 size_t size;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3355 int type;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3356 {
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3357 size_t nbytes;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3358 POINTER_TYPE *result;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3359 char *beg = PUREBEG;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3360
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3361 /* Give Lisp_Floats an extra alignment. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3362 if (type == Lisp_Float)
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3363 {
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3364 size_t alignment;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3365 #if defined __GNUC__ && __GNUC__ >= 2
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3366 alignment = __alignof (struct Lisp_Float);
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3367 #else
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3368 alignment = sizeof (struct Lisp_Float);
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3369 #endif
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3370 pure_bytes_used = ALIGN (pure_bytes_used, alignment);
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3371 }
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3372
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3373 nbytes = ALIGN (size, sizeof (EMACS_INT));
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3374 if (pure_bytes_used + nbytes > PURESIZE)
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3375 error ("Pure Lisp storage exhausted");
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3376
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3377 result = (POINTER_TYPE *) (beg + pure_bytes_used);
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3378 pure_bytes_used += nbytes;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3379 return result;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3380 }
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3381
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3382
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3383 /* 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
3384 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
3385 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
3386
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3387 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
3388 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
3389 string; then the string is not protected from gc. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3390
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3391 Lisp_Object
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3392 make_pure_string (data, nchars, nbytes, multibyte)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3393 char *data;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3394 int nchars, nbytes;
21258
693573ac0944 (make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
3395 int multibyte;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3396 {
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3397 Lisp_Object string;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3398 struct Lisp_String *s;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3399
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3400 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
3401 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
3402 s->size = nchars;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3403 s->size_byte = multibyte ? nbytes : -1;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3404 bcopy (data, s->data, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3405 s->data[nbytes] = '\0';
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3406 s->intervals = NULL_INTERVAL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3407 XSETSTRING (string, s);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3408 return string;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3409 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3410
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3411
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3412 /* 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
3413 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
3414
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3415 Lisp_Object
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3416 pure_cons (car, cdr)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3417 Lisp_Object car, cdr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3418 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3419 register Lisp_Object new;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3420 struct Lisp_Cons *p;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3421
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3422 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
3423 XSETCONS (new, p);
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
3424 XCAR (new) = Fpurecopy (car);
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
3425 XCDR (new) = Fpurecopy (cdr);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3426 return new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3427 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3428
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3429
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3430 /* 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
3431
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3432 Lisp_Object
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3433 make_pure_float (num)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3434 double num;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3435 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3436 register Lisp_Object new;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3437 struct Lisp_Float *p;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3438
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3439 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
3440 XSETFLOAT (new, p);
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
3441 XFLOAT_DATA (new) = num;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3442 return new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3443 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3444
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3445
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3446 /* 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
3447 pure space. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3448
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3449 Lisp_Object
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3450 make_pure_vector (len)
8817
48ff00bebef6 (pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
3451 EMACS_INT len;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3452 {
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3453 Lisp_Object new;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3454 struct Lisp_Vector *p;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3455 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
3456
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3457 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
3458 XSETVECTOR (new, p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3459 XVECTOR (new)->size = len;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3460 return new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3461 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3462
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3463
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3464 DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3465 "Make a copy of OBJECT in pure storage.\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3466 Recursively copies contents of vectors and cons cells.\n\
27348
46cf02cace2d (purecopy): Doc fix.
Dave Love <fx@gnu.org>
parents: 27142
diff changeset
3467 Does not copy symbols. Copies strings without text properties.")
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3468 (obj)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3469 register Lisp_Object obj;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3470 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 434
diff changeset
3471 if (NILP (Vpurify_flag))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3472 return obj;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3473
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3474 if (PURE_POINTER_P (XPNTR (obj)))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3475 return obj;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3476
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3477 if (CONSP (obj))
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
3478 return pure_cons (XCAR (obj), XCDR (obj));
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3479 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
3480 return make_pure_float (XFLOAT_DATA (obj));
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3481 else if (STRINGP (obj))
20587
eaf988c7e291 (make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents: 20565
diff changeset
3482 return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size,
21258
693573ac0944 (make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
3483 STRING_BYTES (XSTRING (obj)),
693573ac0944 (make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
3484 STRING_MULTIBYTE (obj));
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3485 else if (COMPILEDP (obj) || VECTORP (obj))
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3486 {
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3487 register struct Lisp_Vector *vec;
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3488 register int i, size;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3489
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3490 size = XVECTOR (obj)->size;
10427
5faba1b094d5 (Fpurecopy): Mask size field when copying pseudovector.
Karl Heuer <kwzh@gnu.org>
parents: 10414
diff changeset
3491 if (size & PSEUDOVECTOR_FLAG)
5faba1b094d5 (Fpurecopy): Mask size field when copying pseudovector.
Karl Heuer <kwzh@gnu.org>
parents: 10414
diff changeset
3492 size &= PSEUDOVECTOR_SIZE_MASK;
16100
ccd19852de65 (Fpurecopy): Cast arg to make_pure_vector.
Richard M. Stallman <rms@gnu.org>
parents: 16051
diff changeset
3493 vec = XVECTOR (make_pure_vector ((EMACS_INT) size));
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3494 for (i = 0; i < size; i++)
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3495 vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3496 if (COMPILEDP (obj))
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3497 XSETCOMPILED (obj, vec);
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3498 else
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3499 XSETVECTOR (obj, vec);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3500 return obj;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3501 }
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3502 else if (MARKERP (obj))
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3503 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
3504
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
3505 return obj;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3506 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3507
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3508
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3509
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3510 /***********************************************************************
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3511 Protection from GC
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3512 ***********************************************************************/
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3513
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3514 /* 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
3515 VARADDRESS. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3516
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3517 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3518 staticpro (varaddress)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3519 Lisp_Object *varaddress;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3520 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3521 staticvec[staticidx++] = varaddress;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3522 if (staticidx >= NSTATICS)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3523 abort ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3524 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3525
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3526 struct catchtag
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3527 {
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3528 Lisp_Object tag;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3529 Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3530 struct catchtag *next;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3531 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3532
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3533 struct backtrace
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3534 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3535 struct backtrace *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3536 Lisp_Object *function;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3537 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
3538 int nargs; /* Length of vector. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3539 /* 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
3540 unevalled args. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3541 char evalargs;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3542 };
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3543
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3544
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3545
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3546 /***********************************************************************
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3547 Protection from GC
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3548 ***********************************************************************/
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
3549
11374
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
3550 /* Temporarily prevent garbage collection. */
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
3551
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
3552 int
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
3553 inhibit_garbage_collection ()
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
3554 {
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
3555 int count = specpdl_ptr - specpdl;
11679
1ced2d67d411 (gc_cons_threshold): Make this an EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 11593
diff changeset
3556 Lisp_Object number;
13363
941c37982f37 (BITS_PER_SHORT, BITS_PER_INT, BITS_PER_LONG):
Karl Heuer <kwzh@gnu.org>
parents: 13322
diff changeset
3557 int nbits = min (VALBITS, BITS_PER_INT);
11374
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
3558
11727
53ccd2d608ee (gc_cons_threshold): Change back to int.
Richard M. Stallman <rms@gnu.org>
parents: 11679
diff changeset
3559 XSETINT (number, ((EMACS_INT) 1 << (nbits - 1)) - 1);
11679
1ced2d67d411 (gc_cons_threshold): Make this an EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 11593
diff changeset
3560
1ced2d67d411 (gc_cons_threshold): Make this an EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 11593
diff changeset
3561 specbind (Qgc_cons_threshold, number);
11374
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
3562
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
3563 return count;
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
3564 }
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
3565
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3566
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3567 DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3568 "Reclaim storage for Lisp objects no longer needed.\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3569 Returns info on amount of space in use:\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3570 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3571 (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS\n\
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3572 (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS\n\
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3573 (USED-STRINGS . FREE-STRINGS))\n\
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3574 Garbage collection happens automatically if you cons more than\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3575 `gc-cons-threshold' bytes of Lisp data since previous garbage collection.")
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3576 ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3577 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3578 register struct gcpro *tail;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3579 register struct specbinding *bind;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3580 struct catchtag *catch;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3581 struct handler *handler;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3582 register struct backtrace *backlist;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3583 char stack_top_variable;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3584 register int i;
25343
fe92158a9e83 (Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents: 25133
diff changeset
3585 int message_p;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3586 Lisp_Object total[7];
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3587
11892
6be0b7a0ac44 (Fgarbage_collect): Clear consing_since_gc first thing.
Karl Heuer <kwzh@gnu.org>
parents: 11727
diff changeset
3588 /* 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
3589 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
3590 consing_since_gc = 0;
6be0b7a0ac44 (Fgarbage_collect): Clear consing_since_gc first thing.
Karl Heuer <kwzh@gnu.org>
parents: 11727
diff changeset
3591
25343
fe92158a9e83 (Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents: 25133
diff changeset
3592 /* 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
3593 message_p = push_message ();
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3594
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3595 /* Save a copy of the contents of the stack, for debugging. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3596 #if MAX_SAVE_STACK > 0
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 434
diff changeset
3597 if (NILP (Vpurify_flag))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3598 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3599 i = &stack_top_variable - stack_bottom;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3600 if (i < 0) i = -i;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3601 if (i < MAX_SAVE_STACK)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3602 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3603 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
3604 stack_copy = (char *) xmalloc (stack_copy_size = i);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3605 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
3606 stack_copy = (char *) xrealloc (stack_copy, (stack_copy_size = i));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3607 if (stack_copy)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3608 {
8817
48ff00bebef6 (pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
3609 if ((EMACS_INT) (&stack_top_variable - stack_bottom) > 0)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3610 bcopy (stack_bottom, stack_copy, i);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3611 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3612 bcopy (&stack_top_variable, stack_copy, i);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3613 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3614 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3615 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3616 #endif /* MAX_SAVE_STACK > 0 */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3617
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
3618 if (garbage_collection_messages)
10395
c121703d35c7 (Fgarbage_collect): Don't log the GC message.
Karl Heuer <kwzh@gnu.org>
parents: 10389
diff changeset
3619 message1_nolog ("Garbage collecting...");
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3620
23534
6f9c70db3a58 (Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents: 22382
diff changeset
3621 BLOCK_INPUT;
6f9c70db3a58 (Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents: 22382
diff changeset
3622
22220
a0cd311af6e3 (Fgarbage_collect): Call shrink_regexp_cache.
Richard M. Stallman <rms@gnu.org>
parents: 21948
diff changeset
3623 shrink_regexp_cache ();
a0cd311af6e3 (Fgarbage_collect): Call shrink_regexp_cache.
Richard M. Stallman <rms@gnu.org>
parents: 21948
diff changeset
3624
21680
c744d468bfb6 (Fgarbage_collect): Don't truncate command-history here.
Richard M. Stallman <rms@gnu.org>
parents: 21514
diff changeset
3625 /* Don't keep undo information around forever. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3626 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3627 register struct buffer *nextb = all_buffers;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3628
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3629 while (nextb)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3630 {
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
3631 /* If a buffer's undo list is Qt, that means that undo is
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
3632 turned off in that buffer. Calling truncate_undo_list on
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
3633 Qt tends to return NULL, which effectively turns undo back on.
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
3634 So don't call truncate_undo_list if undo_list is Qt. */
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
3635 if (! EQ (nextb->undo_list, Qt))
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
3636 nextb->undo_list
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
3637 = truncate_undo_list (nextb->undo_list, undo_limit,
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
3638 undo_strong_limit);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3639 nextb = nextb->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3640 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3641 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3642
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3643 gc_in_progress = 1;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3644
16231
5ce3b59f093b Comment changes.
Erik Naggum <erik@naggum.no>
parents: 16223
diff changeset
3645 /* clear_marks (); */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3646
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3647 /* Mark all the special slots that serve as the roots of accessibility.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3648
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3649 Usually the special slots to mark are contained in particular structures.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3650 Then we know no slot is marked twice because the structures don't overlap.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3651 In some cases, the structures point to the slots to be marked.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3652 For these, we use MARKBIT to avoid double marking of the slot. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3653
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3654 for (i = 0; i < staticidx; i++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3655 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
3656
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3657 #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
3658 || 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
3659 mark_stack ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3660 #else
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3661 for (tail = gcprolist; tail; tail = tail->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3662 for (i = 0; i < tail->nvars; i++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3663 if (!XMARKBIT (tail->var[i]))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3664 {
32099
31541e0a2704 (Fgarbage_collect): Prevent compiler warning for a call
Eli Zaretskii <eliz@gnu.org>
parents: 31897
diff changeset
3665 /* Explicit casting prevents compiler warning about
31541e0a2704 (Fgarbage_collect): Prevent compiler warning for a call
Eli Zaretskii <eliz@gnu.org>
parents: 31897
diff changeset
3666 discarding the `volatile' qualifier. */
31541e0a2704 (Fgarbage_collect): Prevent compiler warning for a call
Eli Zaretskii <eliz@gnu.org>
parents: 31897
diff changeset
3667 mark_object ((Lisp_Object *)&tail->var[i]);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3668 XMARK (tail->var[i]);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3669 }
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3670 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3671
26364
7b0217d9259c (Fgarbage_collect): Call mark_byte_stack and
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
3672 mark_byte_stack ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3673 for (bind = specpdl; bind != specpdl_ptr; bind++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3674 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3675 mark_object (&bind->symbol);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3676 mark_object (&bind->old_value);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3677 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3678 for (catch = catchlist; catch; catch = catch->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3679 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3680 mark_object (&catch->tag);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3681 mark_object (&catch->val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3682 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3683 for (handler = handlerlist; handler; handler = handler->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3684 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3685 mark_object (&handler->handler);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3686 mark_object (&handler->var);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3687 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3688 for (backlist = backtrace_list; backlist; backlist = backlist->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3689 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3690 if (!XMARKBIT (*backlist->function))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3691 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3692 mark_object (backlist->function);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3693 XMARK (*backlist->function);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3694 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3695 if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3696 i = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3697 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3698 i = backlist->nargs - 1;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3699 for (; i >= 0; i--)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3700 if (!XMARKBIT (backlist->args[i]))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3701 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3702 mark_object (&backlist->args[i]);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3703 XMARK (backlist->args[i]);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3704 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3705 }
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
3706 mark_kboards ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3707
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3708 /* 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
3709 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
3710 and delete them. */
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3711 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3712 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
3713
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3714 while (nextb)
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3715 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3716 /* 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
3717 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
3718 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
3719 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
3720 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
3721 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3722 Lisp_Object tail, prev;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3723 tail = nextb->undo_list;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3724 prev = Qnil;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3725 while (CONSP (tail))
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3726 {
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
3727 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
3728 && 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
3729 && ! 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
3730 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3731 if (NILP (prev))
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
3732 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
3733 else
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
3734 tail = XCDR (prev) = XCDR (tail);
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3735 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3736 else
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3737 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3738 prev = tail;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
3739 tail = XCDR (tail);
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3740 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3741 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3742 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3743
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3744 nextb = nextb->next;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3745 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3746 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
3747
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3748 #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
3749 mark_stack ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3750 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3751
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3752 gc_sweep ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3753
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3754 /* Clear the mark bits that we set in certain root slots. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3755
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3756 #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
3757 || GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3758 for (tail = gcprolist; tail; tail = tail->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3759 for (i = 0; i < tail->nvars; i++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3760 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
3761 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3762
26378
cbf297593a79 (Fgarbage_collect): Call unmark_byte_stack.
Gerd Moellmann <gerd@gnu.org>
parents: 26372
diff changeset
3763 unmark_byte_stack ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3764 for (backlist = backtrace_list; backlist; backlist = backlist->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3765 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3766 XUNMARK (*backlist->function);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3767 if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3768 i = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3769 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3770 i = backlist->nargs - 1;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3771 for (; i >= 0; i--)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3772 XUNMARK (backlist->args[i]);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3773 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3774 XUNMARK (buffer_defaults.name);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3775 XUNMARK (buffer_local_symbols.name);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3776
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3777 #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
3778 dump_zombies ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3779 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3780
23534
6f9c70db3a58 (Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents: 22382
diff changeset
3781 UNBLOCK_INPUT;
6f9c70db3a58 (Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents: 22382
diff changeset
3782
16231
5ce3b59f093b Comment changes.
Erik Naggum <erik@naggum.no>
parents: 16223
diff changeset
3783 /* clear_marks (); */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3784 gc_in_progress = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3785
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3786 consing_since_gc = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3787 if (gc_cons_threshold < 10000)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3788 gc_cons_threshold = 10000;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3789
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
3790 if (garbage_collection_messages)
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
3791 {
25343
fe92158a9e83 (Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents: 25133
diff changeset
3792 if (message_p || minibuf_level > 0)
fe92158a9e83 (Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents: 25133
diff changeset
3793 restore_message ();
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
3794 else
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
3795 message1_nolog ("Garbage collecting...done");
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
3796 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3797
25343
fe92158a9e83 (Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents: 25133
diff changeset
3798 pop_message ();
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3799
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3800 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
3801 make_number (total_free_conses));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3802 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
3803 make_number (total_free_symbols));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3804 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
3805 make_number (total_free_markers));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3806 total[3] = Fcons (make_number (total_string_size),
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3807 make_number (total_vector_size));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3808 total[4] = Fcons (make_number (total_floats),
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3809 make_number (total_free_floats));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3810 total[5] = Fcons (make_number (total_intervals),
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3811 make_number (total_free_intervals));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3812 total[6] = Fcons (make_number (total_strings),
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3813 make_number (total_free_strings));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3814
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3815 #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
3816 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3817 /* 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
3818 double nlive = 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3819
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3820 for (i = 0; i < 7; ++i)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3821 nlive += XFASTINT (XCAR (total[i]));
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3822
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3823 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
3824 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
3825 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
3826 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
3827 ++ngcs;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3828 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3829 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3830
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3831 return Flist (7, total);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3832 }
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3833
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3834
25367
823e14641544 (mark_glyph_matrix): Mark strings only.
Gerd Moellmann <gerd@gnu.org>
parents: 25343
diff changeset
3835 /* 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
3836 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
3837
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3838 static void
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3839 mark_glyph_matrix (matrix)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3840 struct glyph_matrix *matrix;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3841 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3842 struct glyph_row *row = matrix->rows;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3843 struct glyph_row *end = row + matrix->nrows;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3844
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3845 for (; row < end; ++row)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3846 if (row->enabled_p)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3847 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3848 int area;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3849 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
3850 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3851 struct glyph *glyph = row->glyphs[area];
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3852 struct glyph *end_glyph = glyph + row->used[area];
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3853
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3854 for (; glyph < end_glyph; ++glyph)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3855 if (GC_STRINGP (glyph->object)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3856 && !STRING_MARKED_P (XSTRING (glyph->object)))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3857 mark_object (&glyph->object);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3858 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3859 }
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3860 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3861
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3862
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3863 /* 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
3864
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3865 static void
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3866 mark_face_cache (c)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3867 struct face_cache *c;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3868 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3869 if (c)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3870 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3871 int i, j;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3872 for (i = 0; i < c->used; ++i)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3873 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3874 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
3875
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3876 if (face)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3877 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3878 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
3879 mark_object (&face->lface[j]);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3880 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3881 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3882 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3883 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3884
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3885
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3886 #ifdef HAVE_WINDOW_SYSTEM
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3887
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3888 /* Mark Lisp objects in image IMG. */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3889
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3890 static void
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3891 mark_image (img)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3892 struct image *img;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3893 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3894 mark_object (&img->spec);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3895
31892
2f3d88ac2b38 (__malloc_size_t) [DOUG_LEA_MALLOC]: Don't redefine it.
Dave Love <fx@gnu.org>
parents: 31889
diff changeset
3896 if (!NILP (img->data.lisp_val))
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3897 mark_object (&img->data.lisp_val);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3898 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3899
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3900
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3901 /* 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
3902 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
3903
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3904 static void
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3905 mark_image_cache (f)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3906 struct frame *f;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3907 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3908 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
3909 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3910
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3911 #endif /* HAVE_X_WINDOWS */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3912
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3913
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3914
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
3915 /* 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
3916 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
3917 all the references contained in it. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3918
1168
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
3919 #define LAST_MARKED_SIZE 500
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
3920 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
3921 int last_marked_index;
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
3922
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
3923 void
13553
fb12156faaf5 (mark_object): Don't overwrite original argument value.
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
3924 mark_object (argptr)
fb12156faaf5 (mark_object): Don't overwrite original argument value.
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
3925 Lisp_Object *argptr;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3926 {
13553
fb12156faaf5 (mark_object): Don't overwrite original argument value.
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
3927 Lisp_Object *objptr = argptr;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3928 register Lisp_Object obj;
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3929 #ifdef GC_CHECK_MARKED_OBJECTS
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3930 void *po;
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3931 struct mem_node *m;
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3932 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3933
5868
a7bd57a60cb8 (mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents: 5353
diff changeset
3934 loop:
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3935 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
3936 loop2:
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3937 XUNMARK (obj);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3938
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3939 if (PURE_POINTER_P (XPNTR (obj)))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3940 return;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3941
1168
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
3942 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
3943 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
3944 last_marked_index = 0;
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
3945
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3946 /* 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
3947 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
3948 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
3949 #ifdef GC_CHECK_MARKED_OBJECTS
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3950
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3951 po = (void *) XPNTR (obj);
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3952
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3953 /* 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
3954 structure allocated from the heap. */
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3955 #define CHECK_ALLOCATED() \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3956 do { \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3957 m = mem_find (po); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3958 if (m == MEM_NIL) \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3959 abort (); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3960 } while (0)
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3961
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3962 /* 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
3963 function LIVEP. */
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3964 #define CHECK_LIVE(LIVEP) \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3965 do { \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3966 if (!LIVEP (m, po)) \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3967 abort (); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3968 } while (0)
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3969
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3970 /* 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
3971 #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
3972 do { \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3973 CHECK_ALLOCATED (); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3974 CHECK_LIVE (LIVEP); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3975 } while (0) \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3976
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3977 #else /* not GC_CHECK_MARKED_OBJECTS */
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3978
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3979 #define CHECK_ALLOCATED() (void) 0
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3980 #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
3981 #define CHECK_ALLOCATED_AND_LIVE(LIVEP) (void) 0
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3982
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
3983 #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
3984
10457
2ab3bd0288a9 Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
parents: 10427
diff changeset
3985 switch (SWITCH_ENUM_CAST (XGCTYPE (obj)))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3986 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3987 case Lisp_String:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3988 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3989 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
3990 CHECK_ALLOCATED_AND_LIVE (live_string_p);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
3991 MARK_INTERVAL_TREE (ptr->intervals);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3992 MARK_STRING (ptr);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
3993 #ifdef GC_CHECK_STRING_BYTES
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
3994 {
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
3995 /* Check that the string size recorded in the string is the
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
3996 same as the one recorded in the sdata structure. */
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
3997 struct sdata *p = SDATA_OF_STRING (ptr);
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
3998 if (GC_STRING_BYTES (ptr) != SDATA_NBYTES (p))
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
3999 abort ();
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
4000 }
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
4001 #endif /* GC_CHECK_STRING_BYTES */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4002 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4003 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4004
10009
82f3daf76995 (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 10004
diff changeset
4005 case Lisp_Vectorlike:
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4006 #ifdef GC_CHECK_MARKED_OBJECTS
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4007 m = mem_find (po);
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4008 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
4009 && po != &buffer_defaults
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4010 && po != &buffer_local_symbols)
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4011 abort ();
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4012 #endif /* GC_CHECK_MARKED_OBJECTS */
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4013
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4014 if (GC_BUFFERP (obj))
10340
ef58c7a5a4d6 (mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents: 10320
diff changeset
4015 {
ef58c7a5a4d6 (mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents: 10320
diff changeset
4016 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
4017 {
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4018 #ifdef GC_CHECK_MARKED_OBJECTS
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4019 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
4020 {
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4021 struct buffer *b;
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4022 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
4023 ;
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4024 if (b == NULL)
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4025 abort ();
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4026 }
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4027 #endif /* GC_CHECK_MARKED_OBJECTS */
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4028 mark_buffer (obj);
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4029 }
10340
ef58c7a5a4d6 (mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents: 10320
diff changeset
4030 }
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4031 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
4032 break;
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4033 else if (GC_COMPILEDP (obj))
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4034 /* 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
4035 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
4036 recursion there. */
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4037 {
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4038 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
4039 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
4040 register int i;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4041
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4042 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
4043 break; /* Already marked */
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4044
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4045 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
4046 ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
10009
82f3daf76995 (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 10004
diff changeset
4047 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
4048 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
4049 {
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4050 if (i != COMPILED_CONSTANTS)
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4051 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
4052 }
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4053 /* 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
4054 (MIPS-ABI + SysVR4, DC/OSx, etc). */
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4055 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
4056 goto loop;
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4057 }
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4058 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
4059 {
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4060 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
4061 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
4062
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4063 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
4064 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
4065
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4066 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
4067 mark_object (&ptr->name);
12273
377cbbd8a2ad (mark_object): Mark icon_name field.
Richard M. Stallman <rms@gnu.org>
parents: 12175
diff changeset
4068 mark_object (&ptr->icon_name);
14216
5970a52070bb (mark_object): Mark frame title field.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
4069 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
4070 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
4071 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
4072 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
4073 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
4074 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
4075 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
4076 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
4077 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
4078 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
4079 mark_object (&ptr->buffer_predicate);
17217
571d0c136e48 (mark_object): Mark the buffer_list field.
Richard M. Stallman <rms@gnu.org>
parents: 17021
diff changeset
4080 mark_object (&ptr->buffer_list);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4081 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
4082 mark_object (&ptr->tool_bar_window);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4083 mark_face_cache (ptr->face_cache);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4084 #ifdef HAVE_WINDOW_SYSTEM
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4085 mark_image_cache (ptr);
25544
693ca9ba497a Change spelling of `toolbar' to `tool_bar' or `tool-bar'.
Gerd Moellmann <gerd@gnu.org>
parents: 25452
diff changeset
4086 mark_object (&ptr->desired_tool_bar_items);
693ca9ba497a Change spelling of `toolbar' to `tool_bar' or `tool-bar'.
Gerd Moellmann <gerd@gnu.org>
parents: 25452
diff changeset
4087 mark_object (&ptr->current_tool_bar_items);
693ca9ba497a Change spelling of `toolbar' to `tool_bar' or `tool-bar'.
Gerd Moellmann <gerd@gnu.org>
parents: 25452
diff changeset
4088 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
4089 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
4090 #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
4091 }
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
4092 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
4093 {
5cd52d4838f8 (mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents: 14959
diff changeset
4094 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
4095
5cd52d4838f8 (mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents: 14959
diff changeset
4096 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
4097 break; /* Already marked */
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4098 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
4099 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
4100 }
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4101 else if (GC_WINDOWP (obj))
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4102 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4103 register struct Lisp_Vector *ptr = XVECTOR (obj);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4104 struct window *w = XWINDOW (obj);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4105 register EMACS_INT size = ptr->size;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4106 register int i;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4107
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4108 /* Stop if already marked. */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4109 if (size & ARRAY_MARK_FLAG)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4110 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4111
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4112 /* Mark it. */
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4113 CHECK_LIVE (live_vector_p);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4114 ptr->size |= ARRAY_MARK_FLAG;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4115
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4116 /* 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
4117 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
4118 for (i = 0;
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4119 (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
4120 i++)
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4121 mark_object (&ptr->contents[i]);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4122
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4123 /* 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
4124 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
4125 memory. */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4126 if (NILP (w->hchild)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4127 && NILP (w->vchild)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4128 && w->current_matrix)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4129 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4130 mark_glyph_matrix (w->current_matrix);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4131 mark_glyph_matrix (w->desired_matrix);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4132 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4133 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4134 else if (GC_HASH_TABLE_P (obj))
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4135 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4136 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
4137 EMACS_INT size = h->size;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4138
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4139 /* Stop if already marked. */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4140 if (size & ARRAY_MARK_FLAG)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4141 break;
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4142
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4143 /* Mark it. */
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4144 CHECK_LIVE (live_vector_p);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4145 h->size |= ARRAY_MARK_FLAG;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4146
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4147 /* Mark contents. */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4148 mark_object (&h->test);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4149 mark_object (&h->weak);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4150 mark_object (&h->rehash_size);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4151 mark_object (&h->rehash_threshold);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4152 mark_object (&h->hash);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4153 mark_object (&h->next);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4154 mark_object (&h->index);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4155 mark_object (&h->user_hash_function);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4156 mark_object (&h->user_cmp_function);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4157
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4158 /* 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
4159 For weak tables, mark only the vector. */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4160 if (GC_NILP (h->weak))
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4161 mark_object (&h->key_and_value);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4162 else
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4163 XVECTOR (h->key_and_value)->size |= ARRAY_MARK_FLAG;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4164
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4165 }
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4166 else
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4167 {
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4168 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
4169 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
4170 register int i;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4171
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4172 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
4173 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
4174 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
4175 if (size & PSEUDOVECTOR_FLAG)
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4176 size &= PSEUDOVECTOR_SIZE_MASK;
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4177
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4178 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
4179 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
4180 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4181 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4182
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4183 case Lisp_Symbol:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4184 {
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4185 register struct Lisp_Symbol *ptr = XSYMBOL (obj);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4186 struct Lisp_Symbol *ptrx;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4187
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4188 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
4189 CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4190 XMARK (ptr->plist);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4191 mark_object ((Lisp_Object *) &ptr->value);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4192 mark_object (&ptr->function);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4193 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
4194
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4195 if (!PURE_POINTER_P (ptr->name))
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4196 MARK_STRING (ptr->name);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4197 MARK_INTERVAL_TREE (ptr->name->intervals);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4198
20768
6ebcbdec2e07 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 20708
diff changeset
4199 /* Note that we do not mark the obarray of the symbol.
6ebcbdec2e07 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 20708
diff changeset
4200 It is safe not to do so because nothing accesses that
6ebcbdec2e07 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 20708
diff changeset
4201 slot except to check whether it is nil. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4202 ptr = ptr->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4203 if (ptr)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4204 {
5868
a7bd57a60cb8 (mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents: 5353
diff changeset
4205 /* 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
4206 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
4207 ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4208 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
4209 /* 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
4210 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
4211 goto loop2;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4212 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4213 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4214 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4215
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
4216 case Lisp_Misc:
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4217 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
4218 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
4219 {
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
4220 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
4221 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
4222 /* 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
4223 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
4224 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
4225 break;
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
4226
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4227 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
4228 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
4229 {
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4230 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
4231 = XBUFFER_LOCAL_VALUE (obj);
21143
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
4232 if (XMARKBIT (ptr->realvalue)) break;
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
4233 XMARK (ptr->realvalue);
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4234 /* 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
4235 if (EQ (ptr->cdr, Qnil))
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4236 {
21143
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
4237 objptr = &ptr->realvalue;
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4238 goto loop;
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4239 }
21143
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
4240 mark_object (&ptr->realvalue);
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
4241 mark_object (&ptr->buffer);
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
4242 mark_object (&ptr->frame);
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4243 objptr = &ptr->cdr;
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4244 goto loop;
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4245 }
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4246
9463
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4247 case Lisp_Misc_Intfwd:
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4248 case Lisp_Misc_Boolfwd:
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4249 case Lisp_Misc_Objfwd:
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4250 case Lisp_Misc_Buffer_Objfwd:
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4251 case Lisp_Misc_Kboard_Objfwd:
9463
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4252 /* Don't bother with Lisp_Buffer_Objfwd,
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4253 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
4254 /* 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
4255 are protected with staticpro. */
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4256 break;
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4257
9926
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4258 case Lisp_Misc_Overlay:
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4259 {
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4260 struct Lisp_Overlay *ptr = XOVERLAY (obj);
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4261 if (!XMARKBIT (ptr->plist))
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4262 {
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4263 XMARK (ptr->plist);
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4264 mark_object (&ptr->start);
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4265 mark_object (&ptr->end);
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4266 objptr = &ptr->plist;
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4267 goto loop;
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4268 }
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4269 }
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4270 break;
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4271
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
4272 default:
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
4273 abort ();
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
4274 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4275 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4276
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4277 case Lisp_Cons:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4278 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4279 register struct Lisp_Cons *ptr = XCONS (obj);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4280 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
4281 CHECK_ALLOCATED_AND_LIVE (live_cons_p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4282 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
4283 /* 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
4284 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
4285 {
a9241dc503ab (mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents: 1168
diff changeset
4286 objptr = &ptr->car;
a9241dc503ab (mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents: 1168
diff changeset
4287 goto loop;
a9241dc503ab (mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents: 1168
diff changeset
4288 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4289 mark_object (&ptr->car);
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4290 objptr = &ptr->cdr;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4291 goto loop;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4292 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4293
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4294 case Lisp_Float:
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4295 CHECK_ALLOCATED_AND_LIVE (live_float_p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4296 XMARK (XFLOAT (obj)->type);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4297 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4298
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4299 case Lisp_Int:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4300 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4301
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4302 default:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4303 abort ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4304 }
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4305
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4306 #undef CHECK_LIVE
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4307 #undef CHECK_ALLOCATED
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4308 #undef CHECK_ALLOCATED_AND_LIVE
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4309 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4310
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4311 /* Mark the pointers in a buffer structure. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4312
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4313 static void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4314 mark_buffer (buf)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4315 Lisp_Object buf;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4316 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4317 register struct buffer *buffer = XBUFFER (buf);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4318 register Lisp_Object *ptr;
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4319 Lisp_Object base_buffer;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4320
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4321 /* This is the buffer's markbit */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4322 mark_object (&buffer->name);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4323 XMARK (buffer->name);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4324
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4325 MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4326
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4327 if (CONSP (buffer->undo_list))
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4328 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4329 Lisp_Object tail;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4330 tail = buffer->undo_list;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4331
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4332 while (CONSP (tail))
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4333 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4334 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
4335
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4336 if (XMARKBIT (ptr->car))
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4337 break;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4338 XMARK (ptr->car);
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4339 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
4340 && ! XMARKBIT (XCAR (ptr->car))
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
4341 && 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
4342 {
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
4343 XMARK (XCAR (ptr->car));
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
4344 mark_object (&XCDR (ptr->car));
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4345 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4346 else
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4347 mark_object (&ptr->car);
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4348
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4349 if (CONSP (ptr->cdr))
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4350 tail = ptr->cdr;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4351 else
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4352 break;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4353 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4354
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
4355 mark_object (&XCDR (tail));
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4356 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4357 else
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4358 mark_object (&buffer->undo_list);
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4359
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4360 for (ptr = &buffer->name + 1;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4361 (char *)ptr < (char *)buffer + sizeof (struct buffer);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4362 ptr++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4363 mark_object (ptr);
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4364
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4365 /* 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
4366 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
4367 {
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4368 XSETBUFFER (base_buffer, buffer->base_buffer);
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4369 mark_buffer (base_buffer);
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4370 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4371 }
10649
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4372
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4373
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4374 /* Mark the pointers in the kboard objects. */
10649
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4375
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4376 static void
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4377 mark_kboards ()
10649
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4378 {
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4379 KBOARD *kb;
11593
f5385353aae3 (mark_kboards): Mark the kbd macro and Vsystem_key_alist.
Karl Heuer <kwzh@gnu.org>
parents: 11430
diff changeset
4380 Lisp_Object *p;
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4381 for (kb = all_kboards; kb; kb = kb->next_kboard)
10649
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4382 {
11593
f5385353aae3 (mark_kboards): Mark the kbd macro and Vsystem_key_alist.
Karl Heuer <kwzh@gnu.org>
parents: 11430
diff changeset
4383 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
4384 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
4385 mark_object (p);
22381
50e1804145be (mark_kboards): Mark all the Lisp_Object fields.
Richard M. Stallman <rms@gnu.org>
parents: 22220
diff changeset
4386 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
4387 mark_object (&kb->Vlast_command);
50e1804145be (mark_kboards): Mark all the Lisp_Object fields.
Richard M. Stallman <rms@gnu.org>
parents: 22220
diff changeset
4388 mark_object (&kb->Vreal_last_command);
12120
1fc112b5fdc4 (mark_kboards): Mark Vprefix_arg instead of
Karl Heuer <kwzh@gnu.org>
parents: 12096
diff changeset
4389 mark_object (&kb->Vprefix_arg);
22382
f7d2bdefcff7 (mark_kboards): Mark Vlast_prefix_arg too.
Richard M. Stallman <rms@gnu.org>
parents: 22381
diff changeset
4390 mark_object (&kb->Vlast_prefix_arg);
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4391 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
4392 mark_object (&kb->defining_kbd_macro);
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4393 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
4394 mark_object (&kb->Vsystem_key_alist);
12175
4e36e9e99082 (mark_kboards): Mark system_key_syms member.
Karl Heuer <kwzh@gnu.org>
parents: 12120
diff changeset
4395 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
4396 mark_object (&kb->Vdefault_minibuffer_frame);
10649
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4397 }
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4398 }
25024
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
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4401 /* 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
4402 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
4403
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4404 int
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4405 survives_gc_p (obj)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4406 Lisp_Object obj;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4407 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4408 int survives_p;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4409
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4410 switch (XGCTYPE (obj))
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4411 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4412 case Lisp_Int:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4413 survives_p = 1;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4414 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4415
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4416 case Lisp_Symbol:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4417 survives_p = XMARKBIT (XSYMBOL (obj)->plist);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4418 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4419
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4420 case Lisp_Misc:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4421 switch (XMISCTYPE (obj))
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 case Lisp_Misc_Marker:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4424 survives_p = XMARKBIT (obj);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4425 break;
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 case Lisp_Misc_Buffer_Local_Value:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4428 case Lisp_Misc_Some_Buffer_Local_Value:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4429 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
4430 break;
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 case Lisp_Misc_Intfwd:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4433 case Lisp_Misc_Boolfwd:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4434 case Lisp_Misc_Objfwd:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4435 case Lisp_Misc_Buffer_Objfwd:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4436 case Lisp_Misc_Kboard_Objfwd:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4437 survives_p = 1;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4438 break;
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 case Lisp_Misc_Overlay:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4441 survives_p = XMARKBIT (XOVERLAY (obj)->plist);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4442 break;
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 default:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4445 abort ();
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4446 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4447 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4448
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4449 case Lisp_String:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4450 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4451 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
4452 survives_p = STRING_MARKED_P (s);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4453 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4454 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4455
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4456 case Lisp_Vectorlike:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4457 if (GC_BUFFERP (obj))
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4458 survives_p = XMARKBIT (XBUFFER (obj)->name);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4459 else if (GC_SUBRP (obj))
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4460 survives_p = 1;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4461 else
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4462 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
4463 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4464
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4465 case Lisp_Cons:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4466 survives_p = XMARKBIT (XCAR (obj));
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4467 break;
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 case Lisp_Float:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4470 survives_p = XMARKBIT (XFLOAT (obj)->type);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4471 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4472
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4473 default:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4474 abort ();
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4475 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4476
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4477 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
4478 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4479
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4480
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4481
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
4482 /* Sweep: find all structures not marked, and free them. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4483
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4484 static void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4485 gc_sweep ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4486 {
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4487 /* 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
4488 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
4489 sweep_weak_hash_tables ();
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4490
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4491 sweep_strings ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4492
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4493 /* Put all unmarked conses on free list */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4494 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4495 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
4496 struct cons_block **cprev = &cons_block;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4497 register int lim = cons_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4498 register int num_free = 0, num_used = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4499
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4500 cons_free_list = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4501
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4502 for (cblk = cons_block; cblk; cblk = *cprev)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4503 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4504 register int i;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4505 int this_free = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4506 for (i = 0; i < lim; i++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4507 if (!XMARKBIT (cblk->conses[i].car))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4508 {
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4509 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
4510 *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4511 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
4512 #if GC_MARK_STACK
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4513 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
4514 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4515 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4516 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4517 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4518 num_used++;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4519 XUNMARK (cblk->conses[i].car);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4520 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4521 lim = CONS_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4522 /* 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
4523 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
4524 this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4525 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
4526 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4527 *cprev = cblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4528 /* Unhook from the free list. */
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4529 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
4530 lisp_free (cblk);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
4531 n_cons_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4532 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4533 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4534 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4535 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4536 cprev = &cblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4537 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4538 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4539 total_conses = num_used;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4540 total_free_conses = num_free;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4541 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4542
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4543 /* Put all unmarked floats on free list */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4544 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4545 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
4546 struct float_block **fprev = &float_block;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4547 register int lim = float_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4548 register int num_free = 0, num_used = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4549
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4550 float_free_list = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4551
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4552 for (fblk = float_block; fblk; fblk = *fprev)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4553 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4554 register int i;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4555 int this_free = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4556 for (i = 0; i < lim; i++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4557 if (!XMARKBIT (fblk->floats[i].type))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4558 {
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4559 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
4560 *(struct Lisp_Float **)&fblk->floats[i].data = float_free_list;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4561 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
4562 #if GC_MARK_STACK
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4563 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
4564 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4565 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4566 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4567 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4568 num_used++;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4569 XUNMARK (fblk->floats[i].type);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4570 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4571 lim = FLOAT_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4572 /* 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
4573 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
4574 this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4575 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
4576 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4577 *fprev = fblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4578 /* Unhook from the free list. */
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4579 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
4580 lisp_free (fblk);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
4581 n_float_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4582 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4583 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4584 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4585 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4586 fprev = &fblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4587 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4588 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4589 total_floats = num_used;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4590 total_free_floats = num_free;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4591 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4592
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4593 /* Put all unmarked intervals on free list */
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4594 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4595 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
4596 struct interval_block **iprev = &interval_block;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4597 register int lim = interval_block_index;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4598 register int num_free = 0, num_used = 0;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4599
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4600 interval_free_list = 0;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4601
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4602 for (iblk = interval_block; iblk; iblk = *iprev)
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4603 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4604 register int i;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4605 int this_free = 0;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4606
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4607 for (i = 0; i < lim; i++)
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4608 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4609 if (! XMARKBIT (iblk->intervals[i].plist))
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4610 {
28269
fd13be8ae190 Changes towards better type safety regarding intervals, primarily
Ken Raeburn <raeburn@raeburn.org>
parents: 28220
diff changeset
4611 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
4612 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
4613 this_free++;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4614 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4615 else
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4616 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4617 num_used++;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4618 XUNMARK (iblk->intervals[i].plist);
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4619 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4620 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4621 lim = INTERVAL_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4622 /* 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
4623 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
4624 deallocate this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4625 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
4626 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4627 *iprev = iblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4628 /* Unhook from the free list. */
28269
fd13be8ae190 Changes towards better type safety regarding intervals, primarily
Ken Raeburn <raeburn@raeburn.org>
parents: 28220
diff changeset
4629 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
4630 lisp_free (iblk);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
4631 n_interval_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4632 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4633 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4634 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4635 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4636 iprev = &iblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4637 }
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4638 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4639 total_intervals = num_used;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4640 total_free_intervals = num_free;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4641 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4642
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4643 /* Put all unmarked symbols on free list */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4644 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4645 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
4646 struct symbol_block **sprev = &symbol_block;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4647 register int lim = symbol_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4648 register int num_free = 0, num_used = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4649
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4650 symbol_free_list = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4651
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4652 for (sblk = symbol_block; sblk; sblk = *sprev)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4653 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4654 register int i;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4655 int this_free = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4656 for (i = 0; i < lim; i++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4657 if (!XMARKBIT (sblk->symbols[i].plist))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4658 {
9942
c189487b08dd (free_float): Don't assume XFASTINT accesses the raw bits.
Karl Heuer <kwzh@gnu.org>
parents: 9926
diff changeset
4659 *(struct Lisp_Symbol **)&sblk->symbols[i].value = symbol_free_list;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4660 symbol_free_list = &sblk->symbols[i];
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4661 #if GC_MARK_STACK
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4662 symbol_free_list->function = Vdead;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4663 #endif
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4664 this_free++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4665 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4666 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4667 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4668 num_used++;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4669 if (!PURE_POINTER_P (sblk->symbols[i].name))
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4670 UNMARK_STRING (sblk->symbols[i].name);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4671 XUNMARK (sblk->symbols[i].plist);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4672 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4673 lim = SYMBOL_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4674 /* 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
4675 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
4676 this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4677 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
4678 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4679 *sprev = sblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4680 /* Unhook from the free list. */
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4681 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
4682 lisp_free (sblk);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
4683 n_symbol_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4684 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4685 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4686 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4687 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4688 sprev = &sblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4689 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4690 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4691 total_symbols = num_used;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4692 total_free_symbols = num_free;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4693 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4694
21143
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
4695 /* 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
4696 For a marker, first unchain it from the buffer it points into. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4697 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4698 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
4699 struct marker_block **mprev = &marker_block;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4700 register int lim = marker_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4701 register int num_free = 0, num_used = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4702
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4703 marker_free_list = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4704
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4705 for (mblk = marker_block; mblk; mblk = *mprev)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4706 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4707 register int i;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4708 int this_free = 0;
11679
1ced2d67d411 (gc_cons_threshold): Make this an EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 11593
diff changeset
4709 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
4710
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4711 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
4712 {
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4713 Lisp_Object *markword;
11243
054ecfce1820 (Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11048
diff changeset
4714 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
4715 {
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4716 case Lisp_Misc_Marker:
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4717 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
4718 break;
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4719 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
4720 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
4721 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
4722 break;
9926
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4723 case Lisp_Misc_Overlay:
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4724 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
4725 break;
11403
bd3241a14d0a (gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents: 11374
diff changeset
4726 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
4727 /* 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
4728 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
4729 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
4730 break;
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4731 default:
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4732 markword = 0;
9926
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4733 break;
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4734 }
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4735 if (markword && !XMARKBIT (*markword))
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4736 {
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4737 Lisp_Object tem;
11243
054ecfce1820 (Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11048
diff changeset
4738 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
4739 {
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4740 /* tem1 avoids Sun compiler bug */
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4741 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
4742 XSETMARKER (tem, tem1);
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4743 unchain_marker (tem);
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4744 }
11403
bd3241a14d0a (gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents: 11374
diff changeset
4745 /* 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
4746 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
4747 but this might catch bugs faster. */
11243
054ecfce1820 (Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11048
diff changeset
4748 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
4749 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
4750 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
4751 this_free++;
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4752 }
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4753 else
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4754 {
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4755 num_used++;
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4756 if (markword)
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4757 XUNMARK (*markword);
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4758 }
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4759 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4760 lim = MARKER_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4761 /* 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
4762 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
4763 this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4764 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
4765 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4766 *mprev = mblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4767 /* Unhook from the free list. */
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4768 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
4769 lisp_free (mblk);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
4770 n_marker_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4771 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4772 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4773 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4774 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4775 mprev = &mblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4776 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4777 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4778
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4779 total_markers = num_used;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4780 total_free_markers = num_free;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4781 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4782
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4783 /* Free all unmarked buffers */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4784 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4785 register struct buffer *buffer = all_buffers, *prev = 0, *next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4786
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4787 while (buffer)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4788 if (!XMARKBIT (buffer->name))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4789 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4790 if (prev)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4791 prev->next = buffer->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4792 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4793 all_buffers = buffer->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4794 next = buffer->next;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4795 lisp_free (buffer);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4796 buffer = next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4797 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4798 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4799 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4800 XUNMARK (buffer->name);
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4801 UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4802 prev = buffer, buffer = buffer->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4803 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4804 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4805
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4806 /* Free all unmarked vectors */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4807 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4808 register struct Lisp_Vector *vector = all_vectors, *prev = 0, *next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4809 total_vector_size = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4810
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4811 while (vector)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4812 if (!(vector->size & ARRAY_MARK_FLAG))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4813 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4814 if (prev)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4815 prev->next = vector->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4816 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4817 all_vectors = vector->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4818 next = vector->next;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
4819 lisp_free (vector);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
4820 n_vectors--;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4821 vector = next;
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4822
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4823 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4824 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4825 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4826 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
4827 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
4828 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
4829 else
bd3241a14d0a (gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents: 11374
diff changeset
4830 total_vector_size += vector->size;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4831 prev = vector, vector = vector->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4832 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4833 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4834 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4835
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4836
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4837
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4838
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
4839 /* Debugging aids. */
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
4840
5353
6389ed5b45ac (Fmemory_limit): No longer interactive.
Richard M. Stallman <rms@gnu.org>
parents: 4956
diff changeset
4841 DEFUN ("memory-limit", Fmemory_limit, Smemory_limit, 0, 0, 0,
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
4842 "Return the address of the last byte Emacs has allocated, divided by 1024.\n\
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
4843 This may be helpful in debugging Emacs's memory usage.\n\
1893
b047e77f3be4 (Fmemory_limit): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 1784
diff changeset
4844 We divide the value by 1024 to make sure it fits in a Lisp integer.")
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
4845 ()
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
4846 {
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
4847 Lisp_Object end;
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
4848
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
4849 XSETINT (end, (EMACS_INT) sbrk (0) / 1024);
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
4850
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
4851 return end;
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
4852 }
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
4853
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4854 DEFUN ("memory-use-counts", Fmemory_use_counts, Smemory_use_counts, 0, 0, 0,
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4855 "Return a list of counters that measure how much consing there has been.\n\
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4856 Each of these counters increments for a certain kind of object.\n\
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4857 The counters wrap around from the largest positive integer to zero.\n\
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4858 Garbage collection does not decrease them.\n\
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4859 The elements of the value are as follows:\n\
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4860 (CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS MISCS INTERVALS STRINGS)\n\
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4861 All are in units of 1 = one object consed\n\
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4862 except for VECTOR-CELLS and STRING-CHARS, which count the total length of\n\
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4863 objects consed.\n\
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4864 MISCS include overlays, markers, and some internal types.\n\
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4865 Frames, windows, buffers, and subprocesses count as vectors\n\
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4866 (but the contents of a buffer's text do not count here).")
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4867 ()
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4868 {
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4869 Lisp_Object consed[8];
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4870
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4871 XSETINT (consed[0],
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
4872 cons_cells_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4873 XSETINT (consed[1],
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
4874 floats_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4875 XSETINT (consed[2],
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
4876 vector_cells_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4877 XSETINT (consed[3],
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
4878 symbols_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4879 XSETINT (consed[4],
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
4880 string_chars_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4881 XSETINT (consed[5],
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
4882 misc_objects_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4883 XSETINT (consed[6],
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
4884 intervals_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4885 XSETINT (consed[7],
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4886 strings_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4887
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4888 return Flist (8, consed);
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
4889 }
28406
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
4890
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
4891 int suppress_checking;
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
4892 void
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
4893 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
4894 const char *msg;
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
4895 const char *file;
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
4896 int line;
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
4897 {
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
4898 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
4899 file, line, msg);
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
4900 abort ();
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
4901 }
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
4902
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4903 /* Initialization */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4904
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21379
diff changeset
4905 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4906 init_alloc_once ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4907 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4908 /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4909 pure_bytes_used = 0;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4910 #if GC_MARK_STACK
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4911 mem_init ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4912 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
4913 #endif
356
5b180834eacf *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 300
diff changeset
4914 #ifdef HAVE_SHM
5b180834eacf *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 300
diff changeset
4915 pure_size = PURESIZE;
5b180834eacf *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 300
diff changeset
4916 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4917 all_vectors = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4918 ignore_warnings = 1;
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
4919 #ifdef DOUG_LEA_MALLOC
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
4920 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
4921 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
4922 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
4923 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4924 init_strings ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4925 init_cons ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4926 init_symbol ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4927 init_marker ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4928 init_float ();
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4929 init_intervals ();
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4930
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
4931 #ifdef REL_ALLOC
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
4932 malloc_hysteresis = 32;
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
4933 #else
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
4934 malloc_hysteresis = 0;
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
4935 #endif
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
4936
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
4937 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
4938
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4939 ignore_warnings = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4940 gcprolist = 0;
26364
7b0217d9259c (Fgarbage_collect): Call mark_byte_stack and
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
4941 byte_stack_list = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4942 staticidx = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4943 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
4944 gc_cons_threshold = 100000 * sizeof (Lisp_Object);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4945 #ifdef VIRT_ADDR_VARIES
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4946 malloc_sbrk_unused = 1<<22; /* A large number */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4947 malloc_sbrk_used = 100000; /* as reasonable as any number */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4948 #endif /* VIRT_ADDR_VARIES */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4949 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4950
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21379
diff changeset
4951 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4952 init_alloc ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4953 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4954 gcprolist = 0;
26364
7b0217d9259c (Fgarbage_collect): Call mark_byte_stack and
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
4955 byte_stack_list = 0;
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4956 #if GC_MARK_STACK
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4957 #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
4958 setjmp_tested_p = longjmps_done = 0;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4959 #endif
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
4960 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4961 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4962
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4963 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4964 syms_of_alloc ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4965 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4966 DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4967 "*Number of bytes of consing between garbage collections.\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4968 Garbage collection can happen automatically once this many bytes have been\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4969 allocated since the last garbage collection. All data types count.\n\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4970 Garbage collection happens automatically only when `eval' is called.\n\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4971 By binding this temporarily to a large number, you can effectively\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4972 prevent garbage collection during a part of the program.");
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4973
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4974 DEFVAR_INT ("pure-bytes-used", &pure_bytes_used,
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4975 "Number of bytes of sharable Lisp data allocated so far.");
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4976
15960
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4977 DEFVAR_INT ("cons-cells-consed", &cons_cells_consed,
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4978 "Number of cons cells that have been consed so far.");
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4979
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4980 DEFVAR_INT ("floats-consed", &floats_consed,
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4981 "Number of floats that have been consed so far.");
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4982
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4983 DEFVAR_INT ("vector-cells-consed", &vector_cells_consed,
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4984 "Number of vector cells that have been consed so far.");
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4985
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4986 DEFVAR_INT ("symbols-consed", &symbols_consed,
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4987 "Number of symbols that have been consed so far.");
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4988
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4989 DEFVAR_INT ("string-chars-consed", &string_chars_consed,
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4990 "Number of string characters that have been consed so far.");
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4991
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4992 DEFVAR_INT ("misc-objects-consed", &misc_objects_consed,
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4993 "Number of miscellaneous objects that have been consed so far.");
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4994
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4995 DEFVAR_INT ("intervals-consed", &intervals_consed,
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4996 "Number of intervals that have been consed so far.");
12c61b25b7b6 (syms_of_alloc): Set up Lisp variables ...-consed,
Richard M. Stallman <rms@gnu.org>
parents: 15379
diff changeset
4997
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4998 DEFVAR_INT ("strings-consed", &strings_consed,
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4999 "Number of strings that have been consed so far.");
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5000
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5001 DEFVAR_LISP ("purify-flag", &Vpurify_flag,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5002 "Non-nil means loading Lisp code in order to dump an executable.\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5003 This means that certain objects should be allocated in shared (pure) space.");
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5004
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
5005 DEFVAR_INT ("undo-limit", &undo_limit,
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5006 "Keep no more undo information once it exceeds this size.\n\
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
5007 This limit is applied when garbage collection happens.\n\
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5008 The size is counted as the number of bytes occupied,\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5009 which includes both saved text and other data.");
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
5010 undo_limit = 20000;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5011
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
5012 DEFVAR_INT ("undo-strong-limit", &undo_strong_limit,
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5013 "Don't keep more than this much size of undo information.\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5014 A command which pushes past this size is itself forgotten.\n\
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
5015 This limit is applied when garbage collection happens.\n\
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5016 The size is counted as the number of bytes occupied,\n\
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5017 which includes both saved text and other data.");
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
5018 undo_strong_limit = 30000;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5019
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
5020 DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages,
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
5021 "Non-nil means display messages at start and end of garbage collection.");
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
5022 garbage_collection_messages = 0;
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
5023
6116
64417bbbb128 (memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents: 5874
diff changeset
5024 /* 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
5025 not be able to allocate the memory to hold it. */
6133
752d4237f869 (memory_signal_data): No longer static.
Richard M. Stallman <rms@gnu.org>
parents: 6116
diff changeset
5026 memory_signal_data
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
5027 = Fcons (Qerror, Fcons (build_string ("Memory exhausted--use M-x save-some-buffers RET"), Qnil));
6116
64417bbbb128 (memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents: 5874
diff changeset
5028 staticpro (&memory_signal_data);
64417bbbb128 (memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents: 5874
diff changeset
5029
11374
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
5030 staticpro (&Qgc_cons_threshold);
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
5031 Qgc_cons_threshold = intern ("gc-cons-threshold");
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
5032
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
5033 staticpro (&Qchar_table_extra_slots);
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
5034 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
5035
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5036 defsubr (&Scons);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5037 defsubr (&Slist);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5038 defsubr (&Svector);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5039 defsubr (&Smake_byte_code);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5040 defsubr (&Smake_list);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5041 defsubr (&Smake_vector);
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
5042 defsubr (&Smake_char_table);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5043 defsubr (&Smake_string);
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
5044 defsubr (&Smake_bool_vector);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5045 defsubr (&Smake_symbol);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5046 defsubr (&Smake_marker);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5047 defsubr (&Spurecopy);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5048 defsubr (&Sgarbage_collect);
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
5049 defsubr (&Smemory_limit);
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
5050 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
5051
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5052 #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
5053 defsubr (&Sgc_status);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5054 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5055 }