annotate src/alloc.c @ 40081:07d7dbf18784

(reassert_line_highlight_hook, change_line_highlight_hook): Variables removed. (reassert_line_highlight, change_line_highlight): Functions removed. (standout_requested): Variable removed. (update_end, highlight_if_desired): Don't use it. (chars_wasted, copybuf): Variables removed. (write_standout_marker): Function removed. (cursor_to, clear_to_end, clear_frame, clear_end_of_line_raw) (clear_end_of_line_raw, write_glyphs, ins_del_lines): Don't use `chars_wasted' or `copybuf'. (calculate_costs): Don't allocate `chars_wasted' or `copybuf'. Set `costs_set' to true. (cursor_to, clear_end_of_line): Test `costs_set' instead of `chars_wasted'. (clear_end_of_line): Function removed. (clear_end_of_line_raw): Renamed to `clear_end_of_line'. (clear_to_end): Call `clear_end_of_line' instead of `clear_end_of_line_raw'.
author Miles Bader <miles@gnu.org>
date Sat, 20 Oct 2001 05:53:04 +0000
parents eac4e9ae201c
children d3cc7dd5d75a
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.
35170
a9b677239421 (Fgarbage_collect): Use a record_unwind_protect to
Gerd Moellmann <gerd@gnu.org>
parents: 34325
diff changeset
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 2001
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
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
29 /* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
30 memory. Can do this only if using gmalloc.c. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
31
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
32 #if defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
33 #undef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
34 #endif
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
35
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
36 /* 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
37 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
38 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
39
26164
d39ec0a27081 more XCAR/XCDR/XFLOAT_DATA uses, to help isolete lisp engine
Ken Raeburn <raeburn@raeburn.org>
parents: 26088
diff changeset
40 #undef HIDE_LISP_IMPLEMENTATION
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
41 #include "lisp.h"
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
42 #include "process.h"
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
43 #include "intervals.h"
356
5b180834eacf *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 300
diff changeset
44 #include "puresize.h"
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
45 #include "buffer.h"
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
46 #include "window.h"
31102
6a0caa788013 Include keyboard.h before frame.h.
Andrew Innes <andrewi@gnu.org>
parents: 30914
diff changeset
47 #include "keyboard.h"
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
48 #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
49 #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
50 #include "charset.h"
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 624
diff changeset
51 #include "syssignal.h"
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
52 #include <setjmp.h>
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 624
diff changeset
53
30784
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
54 #ifdef HAVE_UNISTD_H
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
55 #include <unistd.h>
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
56 #else
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
57 extern POINTER_TYPE *sbrk ();
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
58 #endif
12096
cdc859dd813b Declare sbrk.
Karl Heuer <kwzh@gnu.org>
parents: 11892
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 #ifdef DOUG_LEA_MALLOC
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
61
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
62 #include <malloc.h>
31892
2f3d88ac2b38 (__malloc_size_t) [DOUG_LEA_MALLOC]: Don't redefine it.
Dave Love <fx@gnu.org>
parents: 31889
diff changeset
63 /* 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
64 #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
65 #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
66 #endif
23973
2eb9e2f5aa33 (MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 23958
diff changeset
67
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
68 /* 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
69 value that explicitly means "no limit". */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
70
23973
2eb9e2f5aa33 (MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 23958
diff changeset
71 #define MMAP_MAX_AREAS 100000000
2eb9e2f5aa33 (MMAP_MAX_AREAS): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 23958
diff changeset
72
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
73 #else /* not DOUG_LEA_MALLOC */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
74
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
75 /* 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
76
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
77 #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
78 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
79 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
80
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
81 #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
82
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
83 /* Macro to verify that storage intended for Lisp objects is not
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
84 out of range to fit in the space for a pointer.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
85 ADDRESS is the start of the block, and SIZE
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
86 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
87
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
88 #define VALIDATE_LISP_STORAGE(address, size) \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
89 do \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
90 { \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
91 Lisp_Object val; \
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
92 XSETCONS (val, (char *) address + size); \
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
93 if ((char *) XCONS (val) != (char *) address + size) \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
94 { \
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
95 xfree (address); \
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
96 memory_full (); \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
97 } \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
98 } while (0)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
99
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
100 /* 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
101
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
102 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
103
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
104 /* 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
105 to a struct Lisp_String. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
106
28469
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
107 #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
108 #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
109 #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
110
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
111 /* 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
112 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
113 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
114 strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
115
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
116 #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
117 #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
118
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
119 /* 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
120
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
121 int consing_since_gc;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
122
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
123 /* 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
124
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
125 int cons_cells_consed;
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
126 int floats_consed;
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
127 int vector_cells_consed;
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
128 int symbols_consed;
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
129 int string_chars_consed;
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
130 int misc_objects_consed;
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
131 int intervals_consed;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
132 int strings_consed;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
133
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
134 /* 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
135
11727
53ccd2d608ee (gc_cons_threshold): Change back to int.
Richard M. Stallman <rms@gnu.org>
parents: 11679
diff changeset
136 int gc_cons_threshold;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
137
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
138 /* Nonzero during GC. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
139
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
140 int gc_in_progress;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
141
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
142 /* 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
143
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
144 int garbage_collection_messages;
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
145
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
146 #ifndef VIRT_ADDR_VARIES
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
147 extern
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
148 #endif /* VIRT_ADDR_VARIES */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
149 int malloc_sbrk_used;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
150
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
151 #ifndef VIRT_ADDR_VARIES
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
152 extern
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
153 #endif /* VIRT_ADDR_VARIES */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
154 int malloc_sbrk_unused;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
155
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
156 /* 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
157
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
158 int undo_limit;
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
159 int undo_strong_limit;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
160
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
161 /* 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
162
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
163 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
164 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
165 static int total_free_floats, total_floats;
19332
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
166
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
167 /* 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
168 out of memory. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
169
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
170 static char *spare_memory;
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
171
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
172 /* 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
173
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
174 #define SPARE_MEMORY (1 << 14)
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
175
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
176 /* 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
177
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
178 static int malloc_hysteresis;
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
179
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
180 /* 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
181
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
182 Lisp_Object Vpurify_flag;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
183
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
184 #ifndef HAVE_SHM
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
185
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
186 /* Force it into data space! */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
187
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
188 EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,};
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
189 #define PUREBEG (char *) pure
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
190
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
191 #else /* HAVE_SHM */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
192
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
193 #define pure PURE_SEG_BITS /* Use shared memory segment */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
194 #define PUREBEG (char *)PURE_SEG_BITS
356
5b180834eacf *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 300
diff changeset
195
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
196 #endif /* HAVE_SHM */
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
197
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
198 /* Pointer to the pure area, and its size. */
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
199
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
200 static char *purebeg;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
201 static size_t pure_size;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
202
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
203 /* Number of bytes of pure storage used before pure storage overflowed.
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
204 If this is non-zero, this implies that an overflow occurred. */
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
205
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
206 static size_t pure_bytes_used_before_overflow;
300
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) \
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
212 < (PNTR_COMPARISON_TYPE) ((char *) purebeg + pure_size)) \
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
213 && ((PNTR_COMPARISON_TYPE) (P) \
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
214 >= (PNTR_COMPARISON_TYPE) purebeg))
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
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
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
247 /* Hook run after GC has finished. */
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
248
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
249 Lisp_Object Vpost_gc_hook, Qpost_gc_hook;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
250
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
251 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
252 static void mark_kboards P_ ((void));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
253 static void gc_sweep P_ ((void));
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
254 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
255 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
256
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
257 #ifdef HAVE_WINDOW_SYSTEM
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
258 static void mark_image P_ ((struct image *));
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
259 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
260 #endif /* HAVE_WINDOW_SYSTEM */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
261
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
262 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
263 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
264 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
265 static void sweep_strings P_ ((void));
20495
db1be942dc12 (Fgarbage_collect):
Richard M. Stallman <rms@gnu.org>
parents: 20391
diff changeset
266
db1be942dc12 (Fgarbage_collect):
Richard M. Stallman <rms@gnu.org>
parents: 20391
diff changeset
267 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
268
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
269 /* 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
270 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
271 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
272
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
273 enum mem_type
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
274 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
275 MEM_TYPE_NON_LISP,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
276 MEM_TYPE_BUFFER,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
277 MEM_TYPE_CONS,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
278 MEM_TYPE_STRING,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
279 MEM_TYPE_MISC,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
280 MEM_TYPE_SYMBOL,
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
281 MEM_TYPE_FLOAT,
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
282 /* Keep the following vector-like types together, with
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
283 MEM_TYPE_WINDOW being the last, and MEM_TYPE_VECTOR the
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
284 first. Or change the code of live_vector_p, for instance. */
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
285 MEM_TYPE_VECTOR,
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
286 MEM_TYPE_PROCESS,
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
287 MEM_TYPE_HASH_TABLE,
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
288 MEM_TYPE_FRAME,
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
289 MEM_TYPE_WINDOW
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
290 };
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
291
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
292 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
27746
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
293
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
294 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
295 #include <stdio.h> /* For fprintf. */
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
296 #endif
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
297
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
298 /* 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
299 on free lists recognizable in O(1). */
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
300
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
301 Lisp_Object Vdead;
2556e20596b8 (enum mem_type): Compile unconditionally.
Gerd Moellmann <gerd@gnu.org>
parents: 27738
diff changeset
302
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
303 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
304
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
305 enum mem_type allocated_mem_type;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
306 int dont_register_blocks;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
307
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
308 #endif /* GC_MALLOC_CHECK */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
309
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
310 /* A node in the red-black tree describing allocated memory containing
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
311 Lisp data. Each such block is recorded with its start and end
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
312 address when it is allocated, and removed from the tree when it
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
313 is freed.
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
314
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
315 A red-black tree is a balanced binary tree with the following
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
316 properties:
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
317
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
318 1. Every node is either red or black.
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
319 2. Every leaf is black.
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
320 3. If a node is red, then both of its children are black.
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
321 4. Every simple path from a node to a descendant leaf contains
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
322 the same number of black nodes.
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
323 5. The root is always black.
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
324
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
325 When nodes are inserted into the tree, or deleted from the tree,
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
326 the tree is "fixed" so that these properties are always true.
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
327
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
328 A red-black tree with N internal nodes has height at most 2
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
329 log(N+1). Searches, insertions and deletions are done in O(log N).
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
330 Please see a text book about data structures for a detailed
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
331 description of red-black trees. Any book worth its salt should
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
332 describe them. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
333
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
334 struct mem_node
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
335 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
336 struct mem_node *left, *right, *parent;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
337
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
338 /* Start and end of allocated region. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
339 void *start, *end;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
340
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
341 /* Node color. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
342 enum {MEM_BLACK, MEM_RED} color;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
343
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
344 /* Memory type. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
345 enum mem_type type;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
346 };
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
347
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
348 /* Base address of stack. Set in main. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
349
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
350 Lisp_Object *stack_base;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
351
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
352 /* Root of the tree describing allocated Lisp memory. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
353
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
354 static struct mem_node *mem_root;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
355
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
356 /* Lowest and highest known address in the heap. */
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
357
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
358 static void *min_heap_address, *max_heap_address;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
359
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
360 /* Sentinel node of the tree. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
361
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
362 static struct mem_node mem_z;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
363 #define MEM_NIL &mem_z
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
364
30914
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
365 static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type));
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
366 static struct Lisp_Vector *allocate_vectorlike P_ ((EMACS_INT, enum mem_type));
30784
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
367 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
368 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
369 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
370 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
371 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
372 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
373 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
374 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
375 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
376 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
377 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
378 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
379 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
380 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
381 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
382 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
383 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
384 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
385 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
386
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
387 #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
388 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
389 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
390
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
391 #endif /* GC_MARK_STACK || GC_MALLOC_CHECK */
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
392
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
393 /* Recording what needs to be marked for gc. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
394
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
395 struct gcpro *gcprolist;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
396
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
397 /* Addresses of staticpro'd variables. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
398
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
399 #define NSTATICS 1024
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
400 Lisp_Object *staticvec[NSTATICS] = {0};
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
401
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
402 /* Index of next unused slot in staticvec. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
403
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
404 int staticidx = 0;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
405
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
406 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
407
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
408
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
409 /* 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
410 ALIGNMENT must be a power of 2. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
411
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
412 #define ALIGN(SZ, ALIGNMENT) \
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
413 (((SZ) + (ALIGNMENT) - 1) & ~((ALIGNMENT) - 1))
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
414
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
415
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
416
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
417 /************************************************************************
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
418 Malloc
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
419 ************************************************************************/
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
420
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
421 /* 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
422 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
423
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
424 Lisp_Object
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
425 malloc_warning_1 (str)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
426 Lisp_Object str;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
427 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
428 Fprinc (str, Vstandard_output);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
429 write_string ("\nKilling some buffers may delay running out of memory.\n", -1);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
430 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
431 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
432 return Qnil;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
433 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
434
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
435
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
436 /* 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
437 storage. */
20375
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
438
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
439 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
440 malloc_warning (str)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
441 char *str;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
442 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
443 pending_malloc_warning = str;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
444 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
445
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
446
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
447 /* 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
448
20375
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
449 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
450 display_malloc_warning ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
451 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
452 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
453
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
454 val = build_string (pending_malloc_warning);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
455 pending_malloc_warning = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
456 internal_with_output_to_temp_buffer (" *Danger*", malloc_warning_1, val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
457 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
458
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
459
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
460 #ifdef DOUG_LEA_MALLOC
17831
9238a2254a23 (BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents: 17348
diff changeset
461 # define BYTES_USED (mallinfo ().arena)
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
462 #else
17831
9238a2254a23 (BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents: 17348
diff changeset
463 # define BYTES_USED _bytes_used
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
464 #endif
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
465
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
466
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
467 /* Called if malloc returns zero. */
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
468
20375
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
469 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
470 memory_full ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
471 {
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
472 #ifndef SYSTEM_MALLOC
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
473 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
474 #endif
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
475
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
476 /* 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
477 if (spare_memory)
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
478 {
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
479 free (spare_memory);
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
480 spare_memory = 0;
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
481 }
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
482
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
483 /* 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
484 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
485 while (1)
18621
53b95f307c75 (memory_full): Pass Qnil to Fsignal for ERROR_SYMBOL.
Richard M. Stallman <rms@gnu.org>
parents: 18104
diff changeset
486 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
487 }
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
488
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
489
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
490 /* 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
491
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
492 void
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
493 buffer_memory_full ()
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
494 {
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
495 /* 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
496 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
497 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
498 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
499 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
500 malloc. */
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
501
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
502 #ifndef REL_ALLOC
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
503 memory_full ();
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
504 #endif
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
505
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
506 /* 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
507 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
508 while (1)
64417bbbb128 (memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents: 5874
diff changeset
509 Fsignal (Qerror, memory_signal_data);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
510 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
511
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
512
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
513 /* Like malloc but check for no memory and block interrupt input.. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
514
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
515 POINTER_TYPE *
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
516 xmalloc (size)
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
517 size_t size;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
518 {
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
519 register POINTER_TYPE *val;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
520
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
521 BLOCK_INPUT;
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
522 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
523 UNBLOCK_INPUT;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
524
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
525 if (!val && size)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
526 memory_full ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
527 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
528 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
529
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
530
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
531 /* 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
532
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
533 POINTER_TYPE *
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
534 xrealloc (block, size)
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
535 POINTER_TYPE *block;
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
536 size_t size;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
537 {
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
538 register POINTER_TYPE *val;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
539
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
540 BLOCK_INPUT;
590
1a6483439acc *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
541 /* We must call malloc explicitly when BLOCK is 0, since some
1a6483439acc *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
542 reallocs don't do this. */
1a6483439acc *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 485
diff changeset
543 if (! block)
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
544 val = (POINTER_TYPE *) malloc (size);
600
a8d78999e46d *** empty log message ***
Noah Friedman <friedman@splode.com>
parents: 590
diff changeset
545 else
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
546 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
547 UNBLOCK_INPUT;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
548
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
549 if (!val && size) memory_full ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
550 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
551 }
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
552
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
553
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
554 /* 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
555
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
556 void
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
557 xfree (block)
29781
4a3b0c2cbcd5 (xmalloc, xrealloc, xfree): Define using POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 29743
diff changeset
558 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
559 {
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
560 BLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
561 free (block);
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
562 UNBLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
563 }
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
564
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
565
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
566 /* Like strdup, but uses xmalloc. */
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
567
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
568 char *
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
569 xstrdup (s)
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
570 char *s;
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
571 {
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
572 size_t len = strlen (s) + 1;
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
573 char *p = (char *) xmalloc (len);
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
574 bcopy (s, p, len);
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
575 return p;
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
576 }
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
577
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
578
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
579 /* 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
580 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
581 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
582
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
583 static POINTER_TYPE *
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
584 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
585 size_t nbytes;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
586 enum mem_type type;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
587 {
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
588 register void *val;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
589
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
590 BLOCK_INPUT;
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
591
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
592 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
593 allocated_mem_type = type;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
594 #endif
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
595
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
596 val = (void *) malloc (nbytes);
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
597
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
598 #if GC_MARK_STACK && !defined GC_MALLOC_CHECK
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
599 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
600 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
601 #endif
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
602
28411
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
603 UNBLOCK_INPUT;
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
604 if (!val && nbytes)
ecba29fa0198 (xstrdup): Moved here from xfaces.c.
Gerd Moellmann <gerd@gnu.org>
parents: 28406
diff changeset
605 memory_full ();
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
606 return val;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
607 }
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
608
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
609
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
610 /* 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
611 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
612
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
613 struct buffer *
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
614 allocate_buffer ()
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
615 {
39228
fcb8e48eec89 allocate_buffer): Call VALIDATE_LISP_STORAGE.
Gerd Moellmann <gerd@gnu.org>
parents: 38696
diff changeset
616 struct buffer *b
fcb8e48eec89 allocate_buffer): Call VALIDATE_LISP_STORAGE.
Gerd Moellmann <gerd@gnu.org>
parents: 38696
diff changeset
617 = (struct buffer *) lisp_malloc (sizeof (struct buffer),
fcb8e48eec89 allocate_buffer): Call VALIDATE_LISP_STORAGE.
Gerd Moellmann <gerd@gnu.org>
parents: 38696
diff changeset
618 MEM_TYPE_BUFFER);
fcb8e48eec89 allocate_buffer): Call VALIDATE_LISP_STORAGE.
Gerd Moellmann <gerd@gnu.org>
parents: 38696
diff changeset
619 VALIDATE_LISP_STORAGE (b, sizeof *b);
fcb8e48eec89 allocate_buffer): Call VALIDATE_LISP_STORAGE.
Gerd Moellmann <gerd@gnu.org>
parents: 38696
diff changeset
620 return b;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
621 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
622
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
623
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
624 /* 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
625 call to lisp_malloc. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
626
30784
dbc1e69a89a9 [HAVE_UNISTD_H]: Include unistd.h; don't declare sbrk.
Dave Love <fx@gnu.org>
parents: 30557
diff changeset
627 static void
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
628 lisp_free (block)
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
629 POINTER_TYPE *block;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
630 {
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
631 BLOCK_INPUT;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
632 free (block);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
633 #if GC_MARK_STACK && !defined GC_MALLOC_CHECK
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
634 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
635 #endif
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
636 UNBLOCK_INPUT;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
637 }
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
638
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
639
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
640 /* 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
641
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
642 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
643 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
644 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
645 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
646 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
647 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
648 GNU malloc. */
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 #ifndef SYSTEM_MALLOC
30914
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
651 #ifndef DOUG_LEA_MALLOC
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
652 extern void * (*__malloc_hook) P_ ((size_t));
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
653 extern void * (*__realloc_hook) P_ ((void *, size_t));
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
654 extern void (*__free_hook) P_ ((void *));
6362b1fc09f2 (lisp_malloc): Declare with POINTER_TYPE.
Dave Love <fx@gnu.org>
parents: 30823
diff changeset
655 /* 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
656 #endif /* DOUG_LEA_MALLOC */
2507
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
657 static void * (*old_malloc_hook) ();
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
658 static void * (*old_realloc_hook) ();
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
659 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
660
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
661 /* 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
662
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
663 static void
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
664 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
665 void *ptr;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
666 {
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
667 BLOCK_INPUT;
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
668
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
669 #ifdef GC_MALLOC_CHECK
32776
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
670 if (ptr)
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
671 {
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
672 struct mem_node *m;
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
673
32776
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
674 m = mem_find (ptr);
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
675 if (m == MEM_NIL || m->start != ptr)
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
676 {
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
677 fprintf (stderr,
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
678 "Freeing `%p' which wasn't allocated with malloc\n", ptr);
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
679 abort ();
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
680 }
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
681 else
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
682 {
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
683 /* fprintf (stderr, "free %p...%p (%p)\n", m->start, m->end, ptr); */
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
684 mem_delete (m);
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
685 }
416924b6f303 (emacs_blocked_free) [GC_MALLOC_CHECK]: Handle freeing
Gerd Moellmann <gerd@gnu.org>
parents: 32700
diff changeset
686 }
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
687 #endif /* GC_MALLOC_CHECK */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
688
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
689 __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
690 free (ptr);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
691
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
692 /* 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
693 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
694 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
695 if (spare_memory == 0
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
696 /* 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
697 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
698 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
699 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
700 && (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
701 > 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
702 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
703
2507
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
704 __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
705 UNBLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
706 }
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
707
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
708
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
709 /* 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
710 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
711 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
712
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
713 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
714
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
715 void
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
716 refill_memory_reserve ()
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
717 {
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
718 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
719 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
720 }
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
721
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
722
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
723 /* 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
724
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
725 static void *
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
726 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
727 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
728 {
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
729 void *value;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
730
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
731 BLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
732 __malloc_hook = old_malloc_hook;
17831
9238a2254a23 (BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents: 17348
diff changeset
733 #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
734 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
735 #else
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
736 __malloc_extra_blocks = malloc_hysteresis;
17831
9238a2254a23 (BYTES_USED): Put # at the beginning of line.
Kenichi Handa <handa@m17n.org>
parents: 17348
diff changeset
737 #endif
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
738
3581
152fd924c7bb * alloc.c (emacs_blocked_malloc, emacs_blocked_realloc): Cast the
Jim Blandy <jimb@redhat.com>
parents: 3536
diff changeset
739 value = (void *) malloc (size);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
740
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
741 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
742 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
743 struct mem_node *m = mem_find (value);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
744 if (m != MEM_NIL)
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
745 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
746 fprintf (stderr, "Malloc returned %p which is already in use\n",
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
747 value);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
748 fprintf (stderr, "Region in use is %p...%p, %u bytes, type %d\n",
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
749 m->start, m->end, (char *) m->end - (char *) m->start,
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
750 m->type);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
751 abort ();
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
752 }
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
753
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
754 if (!dont_register_blocks)
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
755 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
756 mem_insert (value, (char *) value + max (1, size), allocated_mem_type);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
757 allocated_mem_type = MEM_TYPE_NON_LISP;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
758 }
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
759 }
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
760 #endif /* GC_MALLOC_CHECK */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
761
2507
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
762 __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
763 UNBLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
764
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
765 /* fprintf (stderr, "%p malloc\n", value); */
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
766 return value;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
767 }
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
768
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
769
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
770 /* 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
771
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
772 static void *
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
773 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
774 void *ptr;
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
775 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
776 {
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
777 void *value;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
778
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
779 BLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
780 __realloc_hook = old_realloc_hook;
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
781
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
782 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
783 if (ptr)
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
784 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
785 struct mem_node *m = mem_find (ptr);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
786 if (m == MEM_NIL || m->start != ptr)
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
787 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
788 fprintf (stderr,
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
789 "Realloc of %p which wasn't allocated with malloc\n",
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
790 ptr);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
791 abort ();
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
792 }
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
793
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
794 mem_delete (m);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
795 }
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
796
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
797 /* fprintf (stderr, "%p -> realloc\n", ptr); */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
798
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
799 /* Prevent malloc from registering blocks. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
800 dont_register_blocks = 1;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
801 #endif /* GC_MALLOC_CHECK */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
802
3581
152fd924c7bb * alloc.c (emacs_blocked_malloc, emacs_blocked_realloc): Cast the
Jim Blandy <jimb@redhat.com>
parents: 3536
diff changeset
803 value = (void *) realloc (ptr, size);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
804
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
805 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
806 dont_register_blocks = 0;
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
807
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
808 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
809 struct mem_node *m = mem_find (value);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
810 if (m != MEM_NIL)
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
811 {
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
812 fprintf (stderr, "Realloc returns memory that is already in use\n");
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
813 abort ();
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
814 }
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
815
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
816 /* Can't handle zero size regions in the red-black tree. */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
817 mem_insert (value, (char *) value + max (size, 1), MEM_TYPE_NON_LISP);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
818 }
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
819
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
820 /* fprintf (stderr, "%p <- realloc\n", value); */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
821 #endif /* GC_MALLOC_CHECK */
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
822
2507
7ba4316ae840 * alloc.c (__malloc_hook, __realloc_hook, __free_hook): Declare
Jim Blandy <jimb@redhat.com>
parents: 2439
diff changeset
823 __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
824 UNBLOCK_INPUT;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
825
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
826 return value;
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
827 }
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
828
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
829
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
830 /* 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
831
2439
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
832 void
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
833 uninterrupt_malloc ()
b6c62e4abf59 Put interrupt input blocking in a separate file from xterm.h.
Jim Blandy <jimb@redhat.com>
parents: 2370
diff changeset
834 {
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
835 if (__free_hook != emacs_blocked_free)
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
836 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
837 __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
838
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
839 if (__malloc_hook != emacs_blocked_malloc)
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
840 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
841 __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
842
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
843 if (__realloc_hook != emacs_blocked_realloc)
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
844 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
845 __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
846 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
847
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
848 #endif /* not SYSTEM_MALLOC */
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
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
851
27142
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 Interval Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
854 ***********************************************************************/
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
855
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
856 /* 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
857 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
858
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
859 #define INTERVAL_BLOCK_SIZE \
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
860 ((1020 - sizeof (struct interval_block *)) / sizeof (struct interval))
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
861
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
862 /* 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
863 structure. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
864
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
865 struct interval_block
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
866 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
867 struct interval_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
868 struct interval intervals[INTERVAL_BLOCK_SIZE];
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
869 };
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
870
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
871 /* 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
872 blocks. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
873
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
874 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
875
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
876 /* 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
877 structure. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
878
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
879 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
880
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
881 /* 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
882
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
883 static int total_free_intervals, total_intervals;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
884
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
885 /* List of free intervals. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
886
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
887 INTERVAL interval_free_list;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
888
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
889 /* 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
890
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
891 int n_interval_blocks;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
892
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
893
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
894 /* Initialize interval allocation. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
895
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
896 static void
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
897 init_intervals ()
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
898 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
899 interval_block
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
900 = (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
901 MEM_TYPE_NON_LISP);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
902 interval_block->next = 0;
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
903 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
904 interval_block_index = 0;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
905 interval_free_list = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
906 n_interval_blocks = 1;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
907 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
908
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
909
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
910 /* Return a new interval. */
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
911
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
912 INTERVAL
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
913 make_interval ()
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
914 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
915 INTERVAL val;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
916
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
917 if (interval_free_list)
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
918 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
919 val = interval_free_list;
28269
fd13be8ae190 Changes towards better type safety regarding intervals, primarily
Ken Raeburn <raeburn@raeburn.org>
parents: 28220
diff changeset
920 interval_free_list = INTERVAL_PARENT (interval_free_list);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
921 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
922 else
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
923 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
924 if (interval_block_index == INTERVAL_BLOCK_SIZE)
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
925 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
926 register struct interval_block *newi;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
927
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
928 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
929 MEM_TYPE_NON_LISP);
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
930
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
931 VALIDATE_LISP_STORAGE (newi, sizeof *newi);
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
932 newi->next = interval_block;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
933 interval_block = newi;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
934 interval_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
935 n_interval_blocks++;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
936 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
937 val = &interval_block->intervals[interval_block_index++];
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
938 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
939 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
940 intervals_consed++;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
941 RESET_INTERVAL (val);
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
942 return val;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
943 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
944
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
945
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
946 /* Mark Lisp objects in interval I. */
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
947
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
948 static void
1957
54c8c66cd9ac (mark_interval): Add ignored arg.
Richard M. Stallman <rms@gnu.org>
parents: 1939
diff changeset
949 mark_interval (i, dummy)
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
950 register INTERVAL i;
1957
54c8c66cd9ac (mark_interval): Add ignored arg.
Richard M. Stallman <rms@gnu.org>
parents: 1939
diff changeset
951 Lisp_Object dummy;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
952 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
953 if (XMARKBIT (i->plist))
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
954 abort ();
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
955 mark_object (&i->plist);
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
956 XMARK (i->plist);
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
957 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
958
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
959
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
960 /* 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
961 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
962
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
963 static void
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
964 mark_interval_tree (tree)
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
965 register INTERVAL tree;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
966 {
4139
0b32ee899a3a Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents: 4087
diff changeset
967 /* 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
968 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
969 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
970
0b32ee899a3a Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents: 4087
diff changeset
971 /* 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
972 a cast. */
28406
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
973 XMARK (tree->up.obj);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
974
39859
36068b62b4c1 (mark_interval_tree): Use traverse_intervals_noorder.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39682
diff changeset
975 traverse_intervals_noorder (tree, mark_interval, Qnil);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
976 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
977
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
978
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
979 /* 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
980
4139
0b32ee899a3a Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents: 4087
diff changeset
981 #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
982 do { \
0b32ee899a3a Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents: 4087
diff changeset
983 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
984 && ! 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
985 mark_interval_tree (i); \
0b32ee899a3a Consistently use the mark bit of the root interval's parent field
Jim Blandy <jimb@redhat.com>
parents: 4087
diff changeset
986 } while (0)
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
987
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
988
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
989 /* 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
990 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
991 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
992
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
993 #define UNMARK_BALANCE_INTERVALS(i) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
994 do { \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
995 if (! NULL_INTERVAL_P (i)) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
996 { \
28406
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
997 XUNMARK ((i)->up.obj); \
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
998 (i) = balance_intervals (i); \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
999 } \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1000 } while (0)
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1001
28469
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
1002
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
1003 /* 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
1004 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
1005 #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
1006 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
1007 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
1008 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
1009 {
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
1010 Lisp_Object obj;
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
1011 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
1012 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
1013 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
1014 }
f66f2b4d5eb7 * alloc.c (MARK_STRING, UNMARK_STRING, STRING_MARKED_P): Expand non-union-type
Ken Raeburn <raeburn@raeburn.org>
parents: 28411
diff changeset
1015 #endif
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
1016
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1017 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1018 String Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1019 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1020
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1021 /* 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
1022 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
1023 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
1024 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
1025 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
1026 we keep.
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1027
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1028 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
1029 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
1030 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
1031
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1032 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
1033 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
1034 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
1035 its sdata structure.
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1036
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1037 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
1038 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
1039 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
1040 `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
1041 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
1042 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
1043
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1044 /* 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
1045 is 8192 minus malloc overhead. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1046
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1047 #define SBLOCK_SIZE 8188
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1048
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1049 /* 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
1050 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
1051
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1052 #define LARGE_STRING_BYTES 1024
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1053
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1054 /* 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
1055 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
1056
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1057 struct sdata
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1058 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1059 /* 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
1060 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
1061 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
1062 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
1063 (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
1064 contents. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1065 struct Lisp_String *string;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1066
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1067 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1068
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1069 EMACS_INT nbytes;
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1070 unsigned char data[1];
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1071
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1072 #define SDATA_NBYTES(S) (S)->nbytes
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1073 #define SDATA_DATA(S) (S)->data
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1074
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1075 #else /* not GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1076
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1077 union
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1078 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1079 /* When STRING in non-null. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1080 unsigned char data[1];
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1081
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1082 /* When STRING is null. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1083 EMACS_INT nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1084 } u;
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1085
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1086
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1087 #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
1088 #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
1089
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1090 #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
1091 };
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1092
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1093
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1094 /* 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
1095 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
1096 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
1097 as large as needed. */
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 struct sblock
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1100 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1101 /* Next in list. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1102 struct sblock *next;
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 /* 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
1105 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
1106 struct sdata *next_free;
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 /* Start of data. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1109 struct sdata first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1110 };
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1111
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1112 /* 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
1113 1024 minus malloc overhead. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1114
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1115 #define STRINGS_IN_STRING_BLOCK \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1116 ((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
1117
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1118 /* 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
1119 are allocated. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1120
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1121 struct string_block
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1122 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1123 struct string_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1124 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
1125 };
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 /* 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
1128 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
1129 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
1130
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1131 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
1132
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1133 /* List of sblocks for large strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1134
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1135 static struct sblock *large_sblocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1136
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1137 /* List of 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
1138
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1139 static struct string_block *string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1140 static int n_string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1141
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1142 /* Free-list of Lisp_Strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1143
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1144 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
1145
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1146 /* 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
1147
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1148 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
1149
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1150 /* 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
1151
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1152 static int total_string_size;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1153
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1154 /* 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
1155 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
1156 free-list. */
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 #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
1159
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1160 /* 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
1161 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
1162 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
1163 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
1164
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1165 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1166
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1167 #define SDATA_OF_STRING(S) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1168 ((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
1169 - sizeof (EMACS_INT)))
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1170
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1171 #else /* not GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1172
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1173 #define SDATA_OF_STRING(S) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1174 ((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
1175
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1176 #endif /* not GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1177
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1178 /* 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
1179 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
1180 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
1181
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1182 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1183
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1184 #define SDATA_SIZE(NBYTES) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1185 ((sizeof (struct Lisp_String *) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1186 + (NBYTES) + 1 \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1187 + sizeof (EMACS_INT) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1188 + sizeof (EMACS_INT) - 1) \
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1189 & ~(sizeof (EMACS_INT) - 1))
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1190
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1191 #else /* not GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1192
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1193 #define SDATA_SIZE(NBYTES) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1194 ((sizeof (struct Lisp_String *) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1195 + (NBYTES) + 1 \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1196 + sizeof (EMACS_INT) - 1) \
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1197 & ~(sizeof (EMACS_INT) - 1))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1198
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1199 #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
1200
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1201 /* 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
1202
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1203 void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1204 init_strings ()
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1205 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1206 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
1207 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
1208 string_blocks = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1209 n_string_blocks = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1210 string_free_list = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1211 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1212
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1213
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1214 #ifdef GC_CHECK_STRING_BYTES
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1215
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1216 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
1217
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1218 void check_string_bytes P_ ((int));
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1219 void check_sblock P_ ((struct sblock *));
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1220
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1221 #define CHECK_STRING_BYTES(S) STRING_BYTES (S)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1222
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1223
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1224 /* Like GC_STRING_BYTES, but with debugging check. */
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1225
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1226 int
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1227 string_bytes (s)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1228 struct Lisp_String *s;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1229 {
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1230 int nbytes = (s->size_byte < 0 ? s->size : s->size_byte) & ~MARKBIT;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1231 if (!PURE_POINTER_P (s)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1232 && s->data
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1233 && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1234 abort ();
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1235 return nbytes;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1236 }
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1237
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1238 /* Check validity Lisp strings' string_bytes member in B. */
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1239
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1240 void
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1241 check_sblock (b)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1242 struct sblock *b;
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1243 {
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1244 struct sdata *from, *end, *from_end;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1245
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1246 end = b->next_free;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1247
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1248 for (from = &b->first_data; from < end; from = from_end)
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1249 {
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1250 /* Compute the next FROM here because copying below may
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1251 overwrite data we need to compute it. */
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1252 int nbytes;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1253
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1254 /* Check that the string size recorded in the string is the
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1255 same as the one recorded in the sdata structure. */
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1256 if (from->string)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1257 CHECK_STRING_BYTES (from->string);
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1258
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1259 if (from->string)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1260 nbytes = GC_STRING_BYTES (from->string);
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1261 else
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1262 nbytes = SDATA_NBYTES (from);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1263
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1264 nbytes = SDATA_SIZE (nbytes);
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1265 from_end = (struct sdata *) ((char *) from + nbytes);
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1266 }
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1267 }
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1268
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1269
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1270 /* Check validity of Lisp strings' string_bytes member. ALL_P
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1271 non-zero means check all strings, otherwise check only most
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1272 recently allocated strings. Used for hunting a bug. */
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1273
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1274 void
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1275 check_string_bytes (all_p)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1276 int all_p;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1277 {
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1278 if (all_p)
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1279 {
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1280 struct sblock *b;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1281
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1282 for (b = large_sblocks; b; b = b->next)
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1283 {
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1284 struct Lisp_String *s = b->first_data.string;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1285 if (s)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1286 CHECK_STRING_BYTES (s);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1287 }
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1288
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1289 for (b = oldest_sblock; b; b = b->next)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1290 check_sblock (b);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1291 }
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1292 else
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1293 check_sblock (current_sblock);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1294 }
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1295
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1296 #endif /* GC_CHECK_STRING_BYTES */
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1297
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1298
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1299 /* Return a new Lisp_String. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1300
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1301 static struct Lisp_String *
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1302 allocate_string ()
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 struct Lisp_String *s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1305
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1306 /* 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
1307 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
1308 if (string_free_list == NULL)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1309 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1310 struct string_block *b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1311 int i;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1312
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1313 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
1314 VALIDATE_LISP_STORAGE (b, sizeof *b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1315 bzero (b, sizeof *b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1316 b->next = string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1317 string_blocks = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1318 ++n_string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1319
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1320 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
1321 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1322 s = b->strings + i;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1323 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
1324 string_free_list = s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1325 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1326
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1327 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
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 /* 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
1331 s = string_free_list;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1332 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
1333
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1334 /* 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
1335 bzero (s, sizeof *s);
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 --total_free_strings;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1338 ++total_strings;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1339 ++strings_consed;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1340 consing_since_gc += sizeof *s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1341
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1342 #ifdef GC_CHECK_STRING_BYTES
35660
b9366f467430 * alloc.c (allocate_string) [macintosh]: Call check_string_bytes
Andrew Choi <akochoi@shaw.ca>
parents: 35183
diff changeset
1343 if (!noninteractive
b9366f467430 * alloc.c (allocate_string) [macintosh]: Call check_string_bytes
Andrew Choi <akochoi@shaw.ca>
parents: 35183
diff changeset
1344 #ifdef macintosh
b9366f467430 * alloc.c (allocate_string) [macintosh]: Call check_string_bytes
Andrew Choi <akochoi@shaw.ca>
parents: 35183
diff changeset
1345 && current_sblock
b9366f467430 * alloc.c (allocate_string) [macintosh]: Call check_string_bytes
Andrew Choi <akochoi@shaw.ca>
parents: 35183
diff changeset
1346 #endif
b9366f467430 * alloc.c (allocate_string) [macintosh]: Call check_string_bytes
Andrew Choi <akochoi@shaw.ca>
parents: 35183
diff changeset
1347 )
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1348 {
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1349 if (++check_string_bytes_count == 200)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1350 {
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1351 check_string_bytes_count = 0;
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1352 check_string_bytes (1);
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1353 }
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1354 else
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1355 check_string_bytes (0);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1356 }
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
1357 #endif /* GC_CHECK_STRING_BYTES */
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
1358
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1359 return s;
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
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1363 /* 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
1364 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
1365 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
1366 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
1367 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
1368
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1369 void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1370 allocate_string_data (s, nchars, nbytes)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1371 struct Lisp_String *s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1372 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1373 {
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1374 struct sdata *data, *old_data;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1375 struct sblock *b;
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1376 int needed, old_nbytes;
27142
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 /* 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
1379 of string data. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1380 needed = SDATA_SIZE (nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1381
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1382 if (nbytes > LARGE_STRING_BYTES)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1383 {
30557
5056adb52e97 (lisp_malloc, lisp_free): Use size_t and POINTER_TYPE.
Gerd Moellmann <gerd@gnu.org>
parents: 30317
diff changeset
1384 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
1385
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1386 #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
1387 /* 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
1388 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
1389 a dumped Emacs. */
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1390 mallopt (M_MMAP_MAX, 0);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1391 #endif
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1392
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1393 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
1394
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1395 #ifdef DOUG_LEA_MALLOC
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1396 /* 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
1397 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
1398 #endif
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1399
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1400 b->next_free = &b->first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1401 b->first_data.string = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1402 b->next = large_sblocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1403 large_sblocks = b;
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 else if (current_sblock == NULL
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1406 || (((char *) current_sblock + SBLOCK_SIZE
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1407 - (char *) current_sblock->next_free)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1408 < needed))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1409 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1410 /* 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
1411 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
1412 b->next_free = &b->first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1413 b->first_data.string = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1414 b->next = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1415
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1416 if (current_sblock)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1417 current_sblock->next = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1418 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1419 oldest_sblock = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1420 current_sblock = b;
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 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1423 b = current_sblock;
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1424
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1425 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
1426 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
1427
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1428 data = b->next_free;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1429 data->string = s;
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1430 s->data = SDATA_DATA (data);
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1431 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1432 SDATA_NBYTES (data) = nbytes;
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1433 #endif
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1434 s->size = nchars;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1435 s->size_byte = nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1436 s->data[nbytes] = '\0';
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1437 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
1438
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1439 /* 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
1440 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
1441 in it. */
30293
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1442 if (old_data)
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1443 {
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1444 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
1445 old_data->string = NULL;
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1446 }
4a27d6a88c43 (allocate_string_data): If string had already data
Gerd Moellmann <gerd@gnu.org>
parents: 29781
diff changeset
1447
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1448 consing_since_gc += needed;
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
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1451
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1452 /* Sweep and compact strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1453
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1454 static void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1455 sweep_strings ()
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1456 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1457 struct string_block *b, *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1458 struct string_block *live_blocks = NULL;
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 string_free_list = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1461 total_strings = total_free_strings = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1462 total_string_size = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1463
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1464 /* 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
1465 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
1466 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1467 int i, nfree = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1468 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
1469
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1470 next = b->next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1471
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1472 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
1473 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1474 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
1475
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1476 if (s->data)
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 /* 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
1479 if (STRING_MARKED_P (s))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1480 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1481 /* 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
1482 UNMARK_STRING (s);
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 if (!NULL_INTERVAL_P (s->intervals))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1485 UNMARK_BALANCE_INTERVALS (s->intervals);
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 ++total_strings;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1488 total_string_size += STRING_BYTES (s);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1489 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1490 else
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 /* 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
1493 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
1494
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1495 /* 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
1496 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
1497 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
1498 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1499 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
1500 abort ();
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1501 #else
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1502 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
1503 #endif
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1504 data->string = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1505
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1506 /* 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
1507 know it's free. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1508 s->data = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1509
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1510 /* 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
1511 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
1512 string_free_list = s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1513 ++nfree;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1514 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1515 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1516 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1517 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1518 /* 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
1519 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
1520 string_free_list = s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1521 ++nfree;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1522 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1523 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1524
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1525 /* 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
1526 the first two of them. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1527 if (nfree == STRINGS_IN_STRING_BLOCK
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1528 && 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
1529 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1530 lisp_free (b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1531 --n_string_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1532 string_free_list = free_list_before;
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 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1535 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1536 total_free_strings += nfree;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1537 b->next = live_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1538 live_blocks = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1539 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1540 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1541
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1542 string_blocks = live_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1543 free_large_strings ();
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1544 compact_small_strings ();
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1545 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1546
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1547
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1548 /* Free dead large strings. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1549
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1550 static void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1551 free_large_strings ()
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1552 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1553 struct sblock *b, *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1554 struct sblock *live_blocks = NULL;
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 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
1557 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1558 next = b->next;
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 if (b->first_data.string == NULL)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1561 lisp_free (b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1562 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1563 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1564 b->next = live_blocks;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1565 live_blocks = b;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1566 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1567 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1568
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1569 large_sblocks = live_blocks;
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 /* 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
1574 data of live strings after compaction. */
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 static void
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1577 compact_small_strings ()
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1578 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1579 struct sblock *b, *tb, *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1580 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
1581 struct sdata *to_end, *from_end;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1582
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1583 /* 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
1584 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
1585 tb = oldest_sblock;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1586 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
1587 to = &tb->first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1588
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1589 /* 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
1590 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
1591 copying will happen this way. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1592 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
1593 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1594 end = b->next_free;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1595 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
1596
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1597 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
1598 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1599 /* 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
1600 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
1601 int nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1602
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1603 #ifdef GC_CHECK_STRING_BYTES
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1604 /* 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
1605 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
1606 if (from->string
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1607 && 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
1608 abort ();
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1609 #endif /* GC_CHECK_STRING_BYTES */
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1610
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1611 if (from->string)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1612 nbytes = GC_STRING_BYTES (from->string);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1613 else
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
1614 nbytes = SDATA_NBYTES (from);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1615
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1616 nbytes = SDATA_SIZE (nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1617 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
1618
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1619 /* 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
1620 if (from->string)
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 /* 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
1623 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
1624 if (to_end > tb_end)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1625 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1626 tb->next_free = to;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1627 tb = tb->next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1628 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
1629 to = &tb->first_data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1630 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
1631 }
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 /* 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
1634 if (from != to)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1635 {
30823
8ee3740aaf60 (compact_small_strings): Use safe_bcopy, add an
Gerd Moellmann <gerd@gnu.org>
parents: 30784
diff changeset
1636 xassert (tb != b || to <= from);
8ee3740aaf60 (compact_small_strings): Use safe_bcopy, add an
Gerd Moellmann <gerd@gnu.org>
parents: 30784
diff changeset
1637 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
1638 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
1639 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1640
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1641 /* 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
1642 to = to_end;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1643 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1644 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1645 }
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 /* 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
1648 we can free them. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1649 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
1650 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1651 next = b->next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1652 lisp_free (b);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1653 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1654
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1655 tb->next_free = to;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1656 tb->next = NULL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1657 current_sblock = tb;
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
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1660
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1661 DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1662 doc: /* Return a newly created string of length LENGTH, with each element being INIT.
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1663 Both LENGTH and INIT must be numbers. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1664 (length, init)
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1665 Lisp_Object length, init;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1666 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1667 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1668 register unsigned char *p, *end;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1669 int c, nbytes;
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 CHECK_NATNUM (length, 0);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1672 CHECK_NUMBER (init, 1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1673
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1674 c = XINT (init);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1675 if (SINGLE_BYTE_CHAR_P (c))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1676 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1677 nbytes = XINT (length);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1678 val = make_uninit_string (nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1679 p = XSTRING (val)->data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1680 end = p + XSTRING (val)->size;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1681 while (p != end)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1682 *p++ = c;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1683 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1684 else
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1685 {
33800
7f148cfbd1f7 (Fmake_string): Use MAX_MULTIBYTE_LENGTH, instead of hard coded `4'.
Kenichi Handa <handa@m17n.org>
parents: 33764
diff changeset
1686 unsigned char str[MAX_MULTIBYTE_LENGTH];
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1687 int len = CHAR_STRING (c, str);
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 nbytes = len * XINT (length);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1690 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
1691 p = XSTRING (val)->data;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1692 end = p + nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1693 while (p != end)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1694 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1695 bcopy (str, p, len);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1696 p += len;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1697 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1698 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1699
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1700 *p = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1701 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1702 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1703
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1704
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1705 DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1706 doc: /* Return a new bool-vector of length LENGTH, using INIT for as each element.
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1707 LENGTH must be a number. INIT matters only in whether it is t or nil. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
1708 (length, init)
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1709 Lisp_Object length, init;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1710 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1711 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1712 struct Lisp_Bool_Vector *p;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1713 int real_init, i;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1714 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
1715
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1716 CHECK_NATNUM (length, 0);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1717
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1718 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
1719
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1720 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
1721 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
1722
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1723 /* 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
1724 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
1725 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
1726 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
1727
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1728 /* 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
1729 p->vector_size = 0;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1730 XSETBOOL_VECTOR (val, p);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1731 p->size = XFASTINT (length);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1732
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1733 real_init = (NILP (init) ? 0 : -1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1734 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
1735 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
1736
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1737 /* 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
1738 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
1739 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
1740 &= (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
1741
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1742 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1743 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1744
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1745
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1746 /* 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
1747 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
1748 multibyte, depending on the contents. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1749
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1750 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1751 make_string (contents, nbytes)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1752 char *contents;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1753 int nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1754 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1755 register Lisp_Object val;
28997
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
1756 int nchars, multibyte_nbytes;
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
1757
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
1758 parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes);
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
1759 if (nbytes == nchars || nbytes != multibyte_nbytes)
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
1760 /* 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
1761 multibyte sequence. We must make unibyte string. */
33623
dda5cbf94928 (make_string): Fix previous change. Be sure to make
Kenichi Handa <handa@m17n.org>
parents: 32776
diff changeset
1762 val = make_unibyte_string (contents, nbytes);
dda5cbf94928 (make_string): Fix previous change. Be sure to make
Kenichi Handa <handa@m17n.org>
parents: 32776
diff changeset
1763 else
dda5cbf94928 (make_string): Fix previous change. Be sure to make
Kenichi Handa <handa@m17n.org>
parents: 32776
diff changeset
1764 val = make_multibyte_string (contents, nchars, nbytes);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1765 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1766 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1767
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1768
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1769 /* 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
1770
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1771 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1772 make_unibyte_string (contents, length)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1773 char *contents;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1774 int length;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1775 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1776 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1777 val = make_uninit_string (length);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1778 bcopy (contents, XSTRING (val)->data, length);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1779 SET_STRING_BYTES (XSTRING (val), -1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1780 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1781 }
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
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1784 /* 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
1785 bytes at CONTENTS. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1786
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1787 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1788 make_multibyte_string (contents, nchars, nbytes)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1789 char *contents;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1790 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1791 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1792 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1793 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
1794 bcopy (contents, XSTRING (val)->data, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1795 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1796 }
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
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1799 /* 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
1800 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
1801
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1802 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1803 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
1804 char *contents;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1805 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1806 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1807 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1808 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
1809 bcopy (contents, XSTRING (val)->data, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1810 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
1811 SET_STRING_BYTES (XSTRING (val), -1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1812 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1813 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1814
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1815
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1816 /* 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
1817 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
1818 string as multibyte. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1819
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1820 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1821 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
1822 char *contents;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1823 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1824 int multibyte;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1825 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1826 register Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1827 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
1828 bcopy (contents, XSTRING (val)->data, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1829 if (!multibyte)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1830 SET_STRING_BYTES (XSTRING (val), -1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1831 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1832 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1833
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1834
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1835 /* 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
1836 data warrants. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1837
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1838 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1839 build_string (str)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1840 char *str;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1841 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1842 return make_string (str, strlen (str));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1843 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1844
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1845
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1846 /* Return 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
1847 occupying LENGTH bytes. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1848
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1849 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1850 make_uninit_string (length)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1851 int length;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1852 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1853 Lisp_Object val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1854 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
1855 SET_STRING_BYTES (XSTRING (val), -1);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1856 return val;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1857 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1858
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1859
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1860 /* 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
1861 which occupy NBYTES bytes. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1862
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1863 Lisp_Object
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1864 make_uninit_multibyte_string (nchars, nbytes)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1865 int nchars, nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1866 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1867 Lisp_Object string;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1868 struct Lisp_String *s;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1869
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1870 if (nchars < 0)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1871 abort ();
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1872
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1873 s = allocate_string ();
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1874 allocate_string_data (s, nchars, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1875 XSETSTRING (string, s);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1876 string_chars_consed += nbytes;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1877 return string;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1878 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1879
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1880
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1881
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1882 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1883 Float Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1884 ***********************************************************************/
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
1885
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1886 /* 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
1887 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
1888 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
1889 any new float cells from the latest float_block.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1890
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1891 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
1892 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
1893 overhead. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1894
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1895 #define FLOAT_BLOCK_SIZE \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1896 ((1020 - sizeof (struct float_block *)) / sizeof (struct Lisp_Float))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1897
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1898 struct float_block
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1899 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1900 struct float_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1901 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
1902 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1903
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1904 /* Current float_block. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1905
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1906 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
1907
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1908 /* 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
1909
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1910 int float_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1911
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1912 /* 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
1913
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1914 int n_float_blocks;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1915
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1916 /* 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
1917
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1918 struct Lisp_Float *float_free_list;
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
39297
aff361cfdccb Fix a typo in a comment. From Pavel Janik.
Eli Zaretskii <eliz@gnu.org>
parents: 39228
diff changeset
1921 /* Initialize float allocation. */
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1922
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1923 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1924 init_float ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1925 {
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1926 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
1927 MEM_TYPE_FLOAT);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1928 float_block->next = 0;
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
1929 bzero ((char *) float_block->floats, sizeof float_block->floats);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1930 float_block_index = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1931 float_free_list = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1932 n_float_blocks = 1;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1933 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1934
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1935
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1936 /* 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
1937
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21379
diff changeset
1938 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1939 free_float (ptr)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1940 struct Lisp_Float *ptr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1941 {
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
1942 *(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
1943 #if GC_MARK_STACK
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1944 ptr->type = Vdead;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1945 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1946 float_free_list = ptr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1947 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1948
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1949
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
1950 /* 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
1951
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1952 Lisp_Object
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1953 make_float (float_value)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1954 double float_value;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1955 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1956 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1957
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1958 if (float_free_list)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1959 {
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
1960 /* 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
1961 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
1962 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
1963 float_free_list = *(struct Lisp_Float **)&float_free_list->data;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1964 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1965 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1966 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1967 if (float_block_index == FLOAT_BLOCK_SIZE)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1968 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
1969 register struct float_block *new;
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
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 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
1972 MEM_TYPE_FLOAT);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1973 VALIDATE_LISP_STORAGE (new, sizeof *new);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1974 new->next = float_block;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1975 float_block = new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1976 float_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
1977 n_float_blocks++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1978 }
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
1979 XSETFLOAT (val, &float_block->floats[float_block_index++]);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1980 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1981
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
1982 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
1983 XSETFASTINT (XFLOAT (val)->type, 0); /* bug chasing -wsr */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1984 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
1985 floats_consed++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1986 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1987 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1988
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1989
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1990
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1991 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1992 Cons Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1993 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
1994
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1995 /* We store cons cells inside of cons_blocks, allocating a new
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1996 cons_block with malloc whenever necessary. Cons cells reclaimed by
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1997 GC are put on a free list to be reallocated before allocating
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1998 any new cons cells from the latest cons_block.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
1999
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2000 Each cons_block is just under 1020 bytes long,
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2001 since malloc really allocates in units of powers of two
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2002 and uses 4 bytes for its own overhead. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2003
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2004 #define CONS_BLOCK_SIZE \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2005 ((1020 - sizeof (struct cons_block *)) / sizeof (struct Lisp_Cons))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2006
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2007 struct cons_block
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2008 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2009 struct cons_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2010 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
2011 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2012
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2013 /* Current cons_block. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2014
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2015 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
2016
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2017 /* 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
2018
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2019 int cons_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2020
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2021 /* 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
2022
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2023 struct Lisp_Cons *cons_free_list;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2024
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2025 /* 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
2026
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2027 int n_cons_blocks;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2028
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2029
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2030 /* Initialize cons allocation. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2031
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2032 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2033 init_cons ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2034 {
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2035 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
2036 MEM_TYPE_CONS);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2037 cons_block->next = 0;
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
2038 bzero ((char *) cons_block->conses, sizeof cons_block->conses);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2039 cons_block_index = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2040 cons_free_list = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2041 n_cons_blocks = 1;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2042 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2043
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2044
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2045 /* 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
2046
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
2047 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2048 free_cons (ptr)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2049 struct Lisp_Cons *ptr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2050 {
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
2051 *(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
2052 #if GC_MARK_STACK
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2053 ptr->car = Vdead;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2054 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2055 cons_free_list = ptr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2056 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2057
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2058
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2059 DEFUN ("cons", Fcons, Scons, 2, 2, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2060 doc: /* Create a new cons, give it CAR and CDR as components, and return it. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2061 (car, cdr)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2062 Lisp_Object car, cdr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2063 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2064 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2065
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2066 if (cons_free_list)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2067 {
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
2068 /* 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
2069 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
2070 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
2071 cons_free_list = *(struct Lisp_Cons **)&cons_free_list->cdr;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2072 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2073 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2074 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2075 if (cons_block_index == CONS_BLOCK_SIZE)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2076 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
2077 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
2078 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
2079 MEM_TYPE_CONS);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2080 VALIDATE_LISP_STORAGE (new, sizeof *new);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2081 new->next = cons_block;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2082 cons_block = new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2083 cons_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2084 n_cons_blocks++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2085 }
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
2086 XSETCONS (val, &cons_block->conses[cons_block_index++]);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2087 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2088
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
2089 XSETCAR (val, car);
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
2090 XSETCDR (val, cdr);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2091 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
2092 cons_cells_consed++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2093 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2094 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2095
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2096
20849
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2097 /* 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
2098
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2099 Lisp_Object
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2100 list2 (arg1, arg2)
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2101 Lisp_Object arg1, arg2;
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2102 {
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2103 return Fcons (arg1, Fcons (arg2, Qnil));
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2104 }
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2105
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2106
20849
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2107 Lisp_Object
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2108 list3 (arg1, arg2, arg3)
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2109 Lisp_Object arg1, arg2, arg3;
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2110 {
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2111 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
2112 }
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2113
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2114
20849
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2115 Lisp_Object
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2116 list4 (arg1, arg2, arg3, arg4)
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2117 Lisp_Object arg1, arg2, arg3, arg4;
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2118 {
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2119 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
2120 }
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2121
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2122
20849
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2123 Lisp_Object
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2124 list5 (arg1, arg2, arg3, arg4, arg5)
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2125 Lisp_Object arg1, arg2, arg3, arg4, arg5;
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2126 {
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2127 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
2128 Fcons (arg5, Qnil)))));
3b2f72ed135c (list2, list3, list4, list5): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 20768
diff changeset
2129 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2130
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2131
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2132 DEFUN ("list", Flist, Slist, 0, MANY, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2133 doc: /* Return a newly created list with specified arguments as elements.
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2134 Any number of arguments, even zero arguments, are allowed. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2135 (nargs, args)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2136 int nargs;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2137 register Lisp_Object *args;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2138 {
13610
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2139 register Lisp_Object val;
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2140 val = Qnil;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2141
13610
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2142 while (nargs > 0)
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2143 {
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2144 nargs--;
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2145 val = Fcons (args[nargs], val);
8e82e46aa77b (Flist): Avoid using -- in while condition.
Richard M. Stallman <rms@gnu.org>
parents: 13553
diff changeset
2146 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2147 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2148 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2149
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2150
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2151 DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2152 doc: /* Return a newly created list of length LENGTH, with each element being INIT. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2153 (length, init)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2154 register Lisp_Object length, init;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2155 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2156 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2157 register int size;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2158
9953
e0672d4cf470 (Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents: 9942
diff changeset
2159 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
2160 size = XFASTINT (length);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2161
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2162 val = Qnil;
35762
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2163 while (size > 0)
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2164 {
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2165 val = Fcons (init, val);
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2166 --size;
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2167
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2168 if (size > 0)
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2169 {
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2170 val = Fcons (init, val);
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2171 --size;
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2172
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2173 if (size > 0)
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2174 {
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2175 val = Fcons (init, val);
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2176 --size;
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2177
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2178 if (size > 0)
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2179 {
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2180 val = Fcons (init, val);
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2181 --size;
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2182
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2183 if (size > 0)
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2184 {
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2185 val = Fcons (init, val);
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2186 --size;
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2187 }
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2188 }
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2189 }
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2190 }
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2191
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2192 QUIT;
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2193 }
e197a82c3286 (Fmake_list): Add a QUIT in the loop; unroll the loop.
Gerd Moellmann <gerd@gnu.org>
parents: 35660
diff changeset
2194
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2195 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2196 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2197
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2198
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2199
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2200 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2201 Vector Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2202 ***********************************************************************/
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2203
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2204 /* 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
2205
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2206 struct Lisp_Vector *all_vectors;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2207
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2208 /* 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
2209
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2210 int n_vectors;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2211
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2212
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2213 /* 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
2214 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
2215
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2216 static struct Lisp_Vector *
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2217 allocate_vectorlike (len, type)
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2218 EMACS_INT len;
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2219 enum mem_type type;
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2220 {
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2221 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
2222 size_t nbytes;
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2223
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
2224 #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
2225 /* 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
2226 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
2227 a dumped Emacs. */
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
2228 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
2229 #endif
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2230
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2231 nbytes = sizeof *p + (len - 1) * sizeof p->contents[0];
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2232 p = (struct Lisp_Vector *) lisp_malloc (nbytes, type);
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2233
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
2234 #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
2235 /* 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
2236 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
2237 #endif
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2238
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2239 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
2240 consing_since_gc += nbytes;
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
2241 vector_cells_consed += len;
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2242
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2243 p->next = all_vectors;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2244 all_vectors = p;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2245 ++n_vectors;
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2246 return p;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2247 }
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2248
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2249
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2250 /* Allocate a vector with NSLOTS slots. */
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2251
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2252 struct Lisp_Vector *
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2253 allocate_vector (nslots)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2254 EMACS_INT nslots;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2255 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2256 struct Lisp_Vector *v = allocate_vectorlike (nslots, MEM_TYPE_VECTOR);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2257 v->size = nslots;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2258 return v;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2259 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2260
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2261
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2262 /* Allocate other vector-like structures. */
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2263
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2264 struct Lisp_Hash_Table *
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2265 allocate_hash_table ()
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2266 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2267 EMACS_INT len = VECSIZE (struct Lisp_Hash_Table);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2268 struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_HASH_TABLE);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2269 EMACS_INT i;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2270
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2271 v->size = len;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2272 for (i = 0; i < len; ++i)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2273 v->contents[i] = Qnil;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2274
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2275 return (struct Lisp_Hash_Table *) v;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2276 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2277
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2278
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2279 struct window *
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2280 allocate_window ()
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2281 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2282 EMACS_INT len = VECSIZE (struct window);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2283 struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_WINDOW);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2284 EMACS_INT i;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2285
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2286 for (i = 0; i < len; ++i)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2287 v->contents[i] = Qnil;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2288 v->size = len;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2289
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2290 return (struct window *) v;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2291 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2292
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2293
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2294 struct frame *
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2295 allocate_frame ()
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2296 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2297 EMACS_INT len = VECSIZE (struct frame);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2298 struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_FRAME);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2299 EMACS_INT i;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2300
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2301 for (i = 0; i < len; ++i)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2302 v->contents[i] = make_number (0);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2303 v->size = len;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2304 return (struct frame *) v;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2305 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2306
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2307
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2308 struct Lisp_Process *
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2309 allocate_process ()
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2310 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2311 EMACS_INT len = VECSIZE (struct Lisp_Process);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2312 struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_PROCESS);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2313 EMACS_INT i;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2314
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2315 for (i = 0; i < len; ++i)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2316 v->contents[i] = Qnil;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2317 v->size = len;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2318
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2319 return (struct Lisp_Process *) v;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2320 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2321
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2322
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2323 struct Lisp_Vector *
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2324 allocate_other_vector (len)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2325 EMACS_INT len;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2326 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2327 struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_VECTOR);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2328 EMACS_INT i;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2329
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2330 for (i = 0; i < len; ++i)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2331 v->contents[i] = Qnil;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2332 v->size = len;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2333
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2334 return v;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2335 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2336
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2337
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2338 DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2339 doc: /* Return a newly created vector of length LENGTH, with each element being INIT.
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2340 See also the function `vector'. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2341 (length, init)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2342 register Lisp_Object length, init;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2343 {
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2344 Lisp_Object vector;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2345 register EMACS_INT sizei;
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2346 register int index;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2347 register struct Lisp_Vector *p;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2348
9953
e0672d4cf470 (Fmake_list, Fmake_vector, Fmake_string): Use CHECK_NATNUM instead of its
Karl Heuer <kwzh@gnu.org>
parents: 9942
diff changeset
2349 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
2350 sizei = XFASTINT (length);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2351
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2352 p = allocate_vector (sizei);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2353 for (index = 0; index < sizei; index++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2354 p->contents[index] = init;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2355
9968
943a61c764a5 (Fmake_vector): Call allocate_vectorlike.
Karl Heuer <kwzh@gnu.org>
parents: 9953
diff changeset
2356 XSETVECTOR (vector, p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2357 return vector;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2358 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2359
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2360
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
2361 DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2362 doc: /* Return a newly created char-table, with purpose PURPOSE.
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
2363 Each element is initialized to INIT, which defaults to nil.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
2364 PURPOSE should be a symbol which has a `char-table-extra-slots' property.
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2365 The property's value should be an integer between 0 and 10. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2366 (purpose, init)
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
2367 register Lisp_Object purpose, init;
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2368 {
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2369 Lisp_Object vector;
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
2370 Lisp_Object n;
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
2371 CHECK_SYMBOL (purpose, 1);
17328
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2372 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
2373 CHECK_NUMBER (n, 0);
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2374 if (XINT (n) < 0 || XINT (n) > 10)
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2375 args_out_of_range (n, Qnil);
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2376 /* 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
2377 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
2378 init);
17328
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2379 XCHAR_TABLE (vector)->top = Qt;
13150
3778c95adca9 (Fmake_char_table): Initialize parent to nil.
Erik Naggum <erik@naggum.no>
parents: 13141
diff changeset
2380 XCHAR_TABLE (vector)->parent = Qnil;
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
2381 XCHAR_TABLE (vector)->purpose = purpose;
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2382 XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2383 return vector;
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2384 }
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
2385
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2386
17328
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2387 /* 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
2388 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
2389 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
2390
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2391 Lisp_Object
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2392 make_sub_char_table (defalt)
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2393 Lisp_Object defalt;
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2394 {
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2395 Lisp_Object vector
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2396 = 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
2397 XCHAR_TABLE (vector)->top = Qnil;
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2398 XCHAR_TABLE (vector)->defalt = defalt;
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2399 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
2400 return vector;
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2401 }
e2a6f31ee014 (Fmake_char_table): Adjusted for the new structure of
Kenichi Handa <handa@m17n.org>
parents: 17217
diff changeset
2402
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2403
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2404 DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2405 doc: /* Return a newly created vector with specified arguments as elements.
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2406 Any number of arguments, even zero arguments, are allowed. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2407 (nargs, args)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2408 register int nargs;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2409 Lisp_Object *args;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2410 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2411 register Lisp_Object len, val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2412 register int index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2413 register struct Lisp_Vector *p;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2414
9295
17d393a8eed6 (free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents: 9261
diff changeset
2415 XSETFASTINT (len, nargs);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2416 val = Fmake_vector (len, Qnil);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2417 p = XVECTOR (val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2418 for (index = 0; index < nargs; index++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2419 p->contents[index] = args[index];
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2420 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2421 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2422
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2423
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2424 DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2425 doc: /* Create a byte-code object with specified arguments as elements.
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
2426 The arguments should be the arglist, bytecode-string, constant vector,
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
2427 stack size, (optional) doc string, and (optional) interactive spec.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
2428 The first four arguments are required; at most six have any
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2429 significance. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2430 (nargs, args)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2431 register int nargs;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2432 Lisp_Object *args;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2433 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2434 register Lisp_Object len, val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2435 register int index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2436 register struct Lisp_Vector *p;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2437
9295
17d393a8eed6 (free_float, make_float, free_cons, Flist, Fvector, Fmake_byte_code,
Karl Heuer <kwzh@gnu.org>
parents: 9261
diff changeset
2438 XSETFASTINT (len, nargs);
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 434
diff changeset
2439 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
2440 val = make_pure_vector ((EMACS_INT) nargs);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2441 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2442 val = Fmake_vector (len, Qnil);
28997
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
2443
fc8d42f77d4f (Fmake_byte_code): If BYTECODE-STRING is multibyte,
Kenichi Handa <handa@m17n.org>
parents: 28469
diff changeset
2444 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
2445 /* 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
2446 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
2447 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
2448 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
2449 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
2450 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
2451
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2452 p = XVECTOR (val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2453 for (index = 0; index < nargs; index++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2454 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 434
diff changeset
2455 if (!NILP (Vpurify_flag))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2456 args[index] = Fpurecopy (args[index]);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2457 p->contents[index] = args[index];
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2458 }
18104
b2a669ef69b1 (Fmake_byte_code): Set val from p, not from val.
Richard M. Stallman <rms@gnu.org>
parents: 18010
diff changeset
2459 XSETCOMPILED (val, p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2460 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2461 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2462
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2463
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2464
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2465 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2466 Symbol Allocation
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2467 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2468
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2469 /* 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
2470 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
2471 own overhead. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2472
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2473 #define SYMBOL_BLOCK_SIZE \
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2474 ((1020 - sizeof (struct symbol_block *)) / sizeof (struct Lisp_Symbol))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2475
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2476 struct symbol_block
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2477 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2478 struct symbol_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2479 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
2480 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2481
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2482 /* 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
2483 structure in it. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2484
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2485 struct symbol_block *symbol_block;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2486 int symbol_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2487
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2488 /* List of free symbols. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2489
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2490 struct Lisp_Symbol *symbol_free_list;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2491
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2492 /* 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
2493
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2494 int n_symbol_blocks;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2495
27738
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 /* Initialize symbol allocation. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2498
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2499 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2500 init_symbol ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2501 {
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2502 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
2503 MEM_TYPE_SYMBOL);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2504 symbol_block->next = 0;
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
2505 bzero ((char *) symbol_block->symbols, sizeof symbol_block->symbols);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2506 symbol_block_index = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2507 symbol_free_list = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2508 n_symbol_blocks = 1;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2509 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2510
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2511
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2512 DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2513 doc: /* Return a newly allocated uninterned symbol whose name is NAME.
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2514 Its value and function definition are void, and its property list is nil. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2515 (name)
14093
338f645e6b9a (Fmake_symbol): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2516 Lisp_Object name;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2517 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2518 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2519 register struct Lisp_Symbol *p;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2520
14093
338f645e6b9a (Fmake_symbol): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents: 14036
diff changeset
2521 CHECK_STRING (name, 0);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2522
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2523 if (symbol_free_list)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2524 {
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
2525 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
2526 symbol_free_list = *(struct Lisp_Symbol **)&symbol_free_list->value;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2527 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2528 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2529 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2530 if (symbol_block_index == SYMBOL_BLOCK_SIZE)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2531 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
2532 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
2533 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
2534 MEM_TYPE_SYMBOL);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2535 VALIDATE_LISP_STORAGE (new, sizeof *new);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2536 new->next = symbol_block;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2537 symbol_block = new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2538 symbol_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2539 n_symbol_blocks++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2540 }
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
2541 XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2542 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2543
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2544 p = XSYMBOL (val);
14095
d612434249db (Fmake_symbol): Harmonize arguments with documentation (correctly).
Erik Naggum <erik@naggum.no>
parents: 14093
diff changeset
2545 p->name = XSTRING (name);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2546 p->plist = Qnil;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2547 p->value = Qunbound;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2548 p->function = Qunbound;
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
2549 p->next = NULL;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
2550 p->interned = SYMBOL_UNINTERNED;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
2551 p->constant = 0;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
2552 p->indirect_variable = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2553 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
2554 symbols_consed++;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2555 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2556 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2557
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2558
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2559
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2560 /***********************************************************************
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2561 Marker (Misc) Allocation
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2562 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2563
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2564 /* Allocation of markers and other objects that share that structure.
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2565 Works like allocation of conses. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2566
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2567 #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
2568 ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2569
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2570 struct marker_block
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2571 {
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2572 struct marker_block *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2573 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
2574 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2575
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2576 struct marker_block *marker_block;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2577 int marker_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2578
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2579 union Lisp_Misc *marker_free_list;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2580
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2581 /* 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
2582
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2583 int n_marker_blocks;
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2584
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2585 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2586 init_marker ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2587 {
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2588 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
2589 MEM_TYPE_MISC);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2590 marker_block->next = 0;
13320
e0f3a961851a Cast first arg to bzero.
Richard M. Stallman <rms@gnu.org>
parents: 13219
diff changeset
2591 bzero ((char *) marker_block->markers, sizeof marker_block->markers);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2592 marker_block_index = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2593 marker_free_list = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2594 n_marker_blocks = 1;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2595 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2596
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2597 /* 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
2598
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2599 Lisp_Object
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2600 allocate_misc ()
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2601 {
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2602 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
2603
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2604 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
2605 {
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2606 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
2607 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
2608 }
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2609 else
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2610 {
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2611 if (marker_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
2612 {
12529
c7d32f5da2b3 (Flist): Rewritten.
Karl Heuer <kwzh@gnu.org>
parents: 12273
diff changeset
2613 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
2614 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
2615 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
2616 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
2617 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
2618 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
2619 marker_block_index = 0;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
2620 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
2621 }
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2622 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
2623 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2624
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2625 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
2626 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
2627 return val;
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2628 }
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2629
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2630 DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2631 doc: /* Return a newly allocated marker which does not point at any place. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
2632 ()
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2633 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2634 register Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2635 register struct Lisp_Marker *p;
638
40b255f55df3 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 624
diff changeset
2636
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
2637 val = allocate_misc ();
11243
054ecfce1820 (Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11048
diff changeset
2638 XMISCTYPE (val) = Lisp_Misc_Marker;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2639 p = XMARKER (val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2640 p->buffer = 0;
20565
aa9b7c5f0f62 (Fmake_marker): Initialize marker's bytepos and charpos.
Richard M. Stallman <rms@gnu.org>
parents: 20495
diff changeset
2641 p->bytepos = 0;
aa9b7c5f0f62 (Fmake_marker): Initialize marker's bytepos and charpos.
Richard M. Stallman <rms@gnu.org>
parents: 20495
diff changeset
2642 p->charpos = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2643 p->chain = Qnil;
13008
f042ef632b22 (Fmake_marker): Initialize insertion_type to 0.
Richard M. Stallman <rms@gnu.org>
parents: 12748
diff changeset
2644 p->insertion_type = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2645 return val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2646 }
19332
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2647
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2648 /* 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
2649
20375
1dd0bd0749b5 (malloc_warning, display_malloc_warning): Return void.
Andreas Schwab <schwab@suse.de>
parents: 20057
diff changeset
2650 void
19332
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2651 free_marker (marker)
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2652 Lisp_Object marker;
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2653 {
19621
74151390752c (free_marker): Call unchain_marker.
Richard M. Stallman <rms@gnu.org>
parents: 19332
diff changeset
2654 unchain_marker (marker);
74151390752c (free_marker): Call unchain_marker.
Richard M. Stallman <rms@gnu.org>
parents: 19332
diff changeset
2655
19332
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2656 XMISC (marker)->u_marker.type = Lisp_Misc_Free;
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2657 XMISC (marker)->u_free.chain = marker_free_list;
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2658 marker_free_list = XMISC (marker);
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2659
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2660 total_free_markers++;
58f14958f5d5 (free_marker): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18621
diff changeset
2661 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2662
21258
693573ac0944 (make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
2663
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2664 /* 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
2665 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
2666 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
2667
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2668 Any number of arguments, even zero arguments, are allowed. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2669
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2670 Lisp_Object
2013
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2671 make_event_array (nargs, args)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2672 register int nargs;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2673 Lisp_Object *args;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2674 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2675 int i;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2676
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2677 for (i = 0; i < nargs; i++)
2013
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2678 /* 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
2679 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
2680 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
2681 if (!INTEGERP (args[i])
3536
58d5ee6ec253 (make_event_array): Ignore bits above CHAR_META.
Richard M. Stallman <rms@gnu.org>
parents: 3181
diff changeset
2682 || (XUINT (args[i]) & ~(-CHAR_META)) >= 0200)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2683 return Fvector (nargs, args);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2684
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2685 /* Since the loop exited, we know that all the things in it are
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2686 characters, so we can make a string. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2687 {
6492
8372dce85f8a (make_event_array): Use assignment, not initialization.
Karl Heuer <kwzh@gnu.org>
parents: 6227
diff changeset
2688 Lisp_Object result;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2689
18104
b2a669ef69b1 (Fmake_byte_code): Set val from p, not from val.
Richard M. Stallman <rms@gnu.org>
parents: 18010
diff changeset
2690 result = Fmake_string (make_number (nargs), make_number (0));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2691 for (i = 0; i < nargs; i++)
2013
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2692 {
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2693 XSTRING (result)->data[i] = XINT (args[i]);
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2694 /* 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
2695 if (XINT (args[i]) & CHAR_META)
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2696 XSTRING (result)->data[i] |= 0x80;
e2a164ac4088 (Fmake_rope, Frope_elt): Fns deleted.
Richard M. Stallman <rms@gnu.org>
parents: 1994
diff changeset
2697 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2698
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2699 return result;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2700 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2701 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2702
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
2703
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
2704
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2705 /************************************************************************
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2706 C Stack Marking
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2707 ************************************************************************/
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2708
32700
25c6c2562e31 (toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents: 32699
diff changeset
2709 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
25c6c2562e31 (toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents: 32699
diff changeset
2710
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2711 /* 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
2712
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2713 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2714 mem_init ()
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2715 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2716 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
2717 mem_z.parent = NULL;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2718 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
2719 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
2720 mem_root = MEM_NIL;
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
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2723
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2724 /* 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
2725 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
2726
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2727 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
2728 mem_find (start)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2729 void *start;
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 struct mem_node *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2732
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2733 if (start < min_heap_address || start > max_heap_address)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2734 return MEM_NIL;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2735
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2736 /* 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
2737 mem_z.start = start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2738 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
2739
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2740 p = mem_root;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2741 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
2742 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
2743 return p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2744 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2745
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2746
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2747 /* 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
2748 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
2749 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
2750
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2751 static struct mem_node *
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2752 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
2753 void *start, *end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2754 enum mem_type type;
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 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
2757
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2758 if (start < min_heap_address)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2759 min_heap_address = start;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2760 if (end > max_heap_address)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2761 max_heap_address = end;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
2762
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2763 /* 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
2764 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
2765 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
2766 c = mem_root;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2767 parent = NULL;
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 #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
2770
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2771 while (c != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2772 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2773 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
2774 abort ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2775 parent = c;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2776 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
2777 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2778
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2779 #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
2780
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2781 while (c != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2782 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2783 parent = c;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2784 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
2785 }
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 #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
2788
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2789 /* Create a new node. */
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
2790 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
2791 x = (struct mem_node *) _malloc_internal (sizeof *x);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
2792 if (x == NULL)
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
2793 abort ();
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
2794 #else
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2795 x = (struct mem_node *) xmalloc (sizeof *x);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
2796 #endif
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2797 x->start = start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2798 x->end = end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2799 x->type = type;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2800 x->parent = parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2801 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
2802 x->color = MEM_RED;
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 /* 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
2805 if (parent)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2806 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2807 if (start < parent->start)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2808 parent->left = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2809 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2810 parent->right = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2811 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2812 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2813 mem_root = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2814
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2815 /* 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
2816 mem_insert_fixup (x);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
2817
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2818 return x;
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
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2821
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2822 /* 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
2823 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
2824
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2825 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2826 mem_insert_fixup (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2827 struct mem_node *x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2828 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2829 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
2830 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2831 /* 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
2832 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
2833
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2834 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
2835 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2836 /* 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
2837 "uncle". */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2838 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
2839
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2840 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
2841 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2842 /* 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
2843 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
2844 with the grandparent. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2845 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
2846 y->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2847 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
2848 x = x->parent->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2849 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2850 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2851 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2852 /* 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
2853 red, uncle is black. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2854 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
2855 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2856 x = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2857 mem_rotate_left (x);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2858 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2859
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2860 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
2861 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
2862 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
2863 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2864 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2865 else
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 /* 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
2868 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
2869
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2870 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
2871 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2872 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
2873 y->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2874 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
2875 x = x->parent->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2876 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2877 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2878 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2879 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
2880 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2881 x = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2882 mem_rotate_right (x);
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 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
2886 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
2887 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
2888 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2889 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2890 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2891
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2892 /* 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
2893 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
2894 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
2895 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2896
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2897
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2898 /* (x) (y)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2899 / \ / \
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2900 a (y) ===> (x) c
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2901 / \ / \
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2902 b c a b */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2903
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2904 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2905 mem_rotate_left (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2906 struct mem_node *x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2907 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2908 struct mem_node *y;
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 /* 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
2911 y = x->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2912 x->right = y->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2913 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
2914 y->left->parent = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2915
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2916 /* 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
2917 if (y != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2918 y->parent = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2919
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2920 /* 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
2921 if (x->parent)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2922 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2923 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
2924 x->parent->left = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2925 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2926 x->parent->right = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2927 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2928 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2929 mem_root = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2930
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2931 /* 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
2932 y->left = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2933 if (x != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2934 x->parent = y;
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
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2938 /* (x) (Y)
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 (y) c ===> a (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2941 / \ / \
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2942 a b b c */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2943
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2944 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2945 mem_rotate_right (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2946 struct mem_node *x;
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 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
2949
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2950 x->left = y->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2951 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
2952 y->right->parent = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2953
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2954 if (y != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2955 y->parent = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2956 if (x->parent)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2957 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2958 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
2959 x->parent->right = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2960 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2961 x->parent->left = y;
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 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2964 mem_root = y;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2965
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2966 y->right = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2967 if (x != MEM_NIL)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2968 x->parent = y;
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
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2971
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2972 /* 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
2973
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2974 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2975 mem_delete (z)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2976 struct mem_node *z;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2977 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2978 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
2979
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2980 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
2981 return;
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 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
2984 y = z;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2985 else
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 y = z->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2988 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
2989 y = y->left;
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
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2992 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
2993 x = y->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2994 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2995 x = y->right;
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 x->parent = y->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2998 if (y->parent)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
2999 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3000 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
3001 y->parent->left = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3002 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3003 y->parent->right = x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3004 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3005 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3006 mem_root = x;
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 if (y != z)
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 z->start = y->start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3011 z->end = y->end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3012 z->type = y->type;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3013 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3014
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3015 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
3016 mem_delete_fixup (x);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3017
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3018 #ifdef GC_MALLOC_CHECK
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3019 _free_internal (y);
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3020 #else
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3021 xfree (y);
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
3022 #endif
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3023 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3024
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3025
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3026 /* 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
3027 deletion. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3028
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3029 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3030 mem_delete_fixup (x)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3031 struct mem_node *x;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3032 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3033 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
3034 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3035 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
3036 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3037 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
3038
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3039 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
3040 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3041 w->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3042 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
3043 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
3044 w = x->parent->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3045 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3046
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3047 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
3048 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3049 w->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3050 x = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3051 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3052 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3053 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3054 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
3055 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3056 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
3057 w->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3058 mem_rotate_right (w);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3059 w = x->parent->right;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3060 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3061 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
3062 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
3063 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
3064 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
3065 x = mem_root;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3066 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3067 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3068 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3069 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3070 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
3071
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3072 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
3073 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3074 w->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3075 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
3076 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
3077 w = x->parent->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3078 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3079
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3080 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
3081 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3082 w->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3083 x = x->parent;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3084 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3085 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3086 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3087 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
3088 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3089 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
3090 w->color = MEM_RED;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3091 mem_rotate_left (w);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3092 w = x->parent->left;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3093 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3094
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3095 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
3096 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
3097 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
3098 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
3099 x = mem_root;
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 }
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
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3104 x->color = MEM_BLACK;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3105 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3106
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3107
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3108 /* 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
3109 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
3110
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3111 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3112 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
3113 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3114 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3115 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3116 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
3117 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3118 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
3119 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
3120
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3121 /* 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
3122 must not be on the free-list. */
37049
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
3123 return (offset >= 0
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
3124 && offset % sizeof b->strings[0] == 0
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3125 && ((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
3126 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3127 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3128 return 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3129 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3130
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3131
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3132 /* 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
3133 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
3134
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3135 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3136 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
3137 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3138 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3139 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3140 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
3141 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3142 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
3143 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
3144
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3145 /* 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
3146 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
3147 and not be on the free-list. */
37049
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
3148 return (offset >= 0
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
3149 && offset % sizeof b->conses[0] == 0
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3150 && (b != cons_block
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3151 || 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
3152 && !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
3153 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3154 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3155 return 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3156 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3157
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3158
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3159 /* 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
3160 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
3161
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3162 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3163 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
3164 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3165 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3166 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3167 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
3168 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3169 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
3170 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
3171
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3172 /* 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
3173 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
3174 and not be on the free-list. */
37049
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
3175 return (offset >= 0
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
3176 && offset % sizeof b->symbols[0] == 0
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3177 && (b != symbol_block
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3178 || 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
3179 && !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
3180 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3181 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3182 return 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3183 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3184
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3185
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3186 /* 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
3187 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
3188
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3189 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3190 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
3191 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3192 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3193 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3194 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
3195 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3196 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
3197 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
3198
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3199 /* 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
3200 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
3201 and not be on the free-list. */
37049
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
3202 return (offset >= 0
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
3203 && offset % sizeof b->floats[0] == 0
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3204 && (b != float_block
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3205 || 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
3206 && !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
3207 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3208 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3209 return 0;
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
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3212
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3213 /* 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
3214 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
3215
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3216 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3217 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
3218 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3219 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3220 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3221 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
3222 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3223 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
3224 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
3225
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3226 /* 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
3227 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
3228 and not be on the free-list. */
37049
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
3229 return (offset >= 0
184d1fb71cc1 (live_string_p, live_cons_p, live_symbol_p)
Gerd Moellmann <gerd@gnu.org>
parents: 36487
diff changeset
3230 && offset % sizeof b->markers[0] == 0
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3231 && (b != marker_block
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3232 || 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
3233 && ((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
3234 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3235 else
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3236 return 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3237 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3238
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3239
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3240 /* 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
3241 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
3242
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3243 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3244 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
3245 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3246 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3247 {
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3248 return (p == m->start
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3249 && m->type >= MEM_TYPE_VECTOR
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3250 && m->type <= MEM_TYPE_WINDOW);
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3251 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3252
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3253
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3254 /* 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
3255 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
3256
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3257 static INLINE int
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3258 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
3259 struct mem_node *m;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3260 void *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3261 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3262 /* 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
3263 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
3264 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
3265 && p == m->start
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3266 && !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
3267 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3268
32700
25c6c2562e31 (toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents: 32699
diff changeset
3269 #endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */
25c6c2562e31 (toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents: 32699
diff changeset
3270
25c6c2562e31 (toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents: 32699
diff changeset
3271 #if GC_MARK_STACK
25c6c2562e31 (toplevel): Conditionalize compilation of mem_*
Gerd Moellmann <gerd@gnu.org>
parents: 32699
diff changeset
3272
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3273 #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
3274
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3275 /* 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
3276 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
3277
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3278 #define MAX_ZOMBIES 10
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3279 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
3280
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3281 /* Number of zombie objects. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3282
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3283 static int nzombies;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3284
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3285 /* Number of garbage collections. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3286
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3287 static int ngcs;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3288
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3289 /* 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
3290
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3291 static double avg_zombies;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3292
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3293 /* 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
3294
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3295 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
3296
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3297 /* 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
3298
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3299 static double avg_live;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3300
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3301 DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "",
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3302 doc: /* Show information about live and zombie objects. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3303 ()
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3304 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3305 Lisp_Object args[7];
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3306 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
3307 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
3308 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
3309 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
3310 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
3311 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
3312 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
3313 return Fmessage (7, args);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3314 }
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 #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
3317
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3318
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3319 /* 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
3320
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3321 static INLINE void
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3322 mark_maybe_object (obj)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3323 Lisp_Object obj;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3324 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3325 void *po = (void *) XPNTR (obj);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3326 struct mem_node *m = mem_find (po);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3327
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3328 if (m != MEM_NIL)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3329 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3330 int mark_p = 0;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3331
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3332 switch (XGCTYPE (obj))
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3333 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3334 case Lisp_String:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3335 mark_p = (live_string_p (m, po)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3336 && !STRING_MARKED_P ((struct Lisp_String *) po));
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3337 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3338
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3339 case Lisp_Cons:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3340 mark_p = (live_cons_p (m, po)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3341 && !XMARKBIT (XCONS (obj)->car));
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3342 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3343
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3344 case Lisp_Symbol:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3345 mark_p = (live_symbol_p (m, po)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3346 && !XMARKBIT (XSYMBOL (obj)->plist));
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3347 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3348
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3349 case Lisp_Float:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3350 mark_p = (live_float_p (m, po)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3351 && !XMARKBIT (XFLOAT (obj)->type));
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3352 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3353
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3354 case Lisp_Vectorlike:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3355 /* 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
3356 buffer because checking that dereferences the pointer
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3357 PO which might point anywhere. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3358 if (live_vector_p (m, po))
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3359 mark_p = (!GC_SUBRP (obj)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3360 && !(XVECTOR (obj)->size & ARRAY_MARK_FLAG));
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3361 else if (live_buffer_p (m, po))
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3362 mark_p = GC_BUFFERP (obj) && !XMARKBIT (XBUFFER (obj)->name);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3363 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3364
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3365 case Lisp_Misc:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3366 if (live_misc_p (m, po))
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3367 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3368 switch (XMISCTYPE (obj))
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3369 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3370 case Lisp_Misc_Marker:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3371 mark_p = !XMARKBIT (XMARKER (obj)->chain);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3372 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3373
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3374 case Lisp_Misc_Buffer_Local_Value:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3375 case Lisp_Misc_Some_Buffer_Local_Value:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3376 mark_p = !XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3377 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3378
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3379 case Lisp_Misc_Overlay:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3380 mark_p = !XMARKBIT (XOVERLAY (obj)->plist);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3381 break;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3382 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3383 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3384 break;
31829
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
3385
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
3386 case Lisp_Int:
31897
a292cc13911a (GC_CHECK_STRING_BYTES): Temporarily define, for bug
Gerd Moellmann <gerd@gnu.org>
parents: 31892
diff changeset
3387 case Lisp_Type_Limit:
31829
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
3388 break;
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3389 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3390
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3391 if (mark_p)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3392 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3393 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3394 if (nzombies < MAX_ZOMBIES)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3395 zombies[nzombies] = *p;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3396 ++nzombies;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3397 #endif
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3398 mark_object (&obj);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3399 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3400 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3401 }
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3402
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3403
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3404 /* If P points to Lisp data, mark that as live if it isn't already
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3405 marked. */
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3406
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3407 static INLINE void
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3408 mark_maybe_pointer (p)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3409 void *p;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3410 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3411 struct mem_node *m;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3412
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3413 /* Quickly rule out some values which can't point to Lisp data. We
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3414 assume that Lisp data is aligned on even addresses. */
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3415 if ((EMACS_INT) p & 1)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3416 return;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3417
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3418 m = mem_find (p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3419 if (m != MEM_NIL)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3420 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3421 Lisp_Object obj = Qnil;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3422
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3423 switch (m->type)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3424 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3425 case MEM_TYPE_NON_LISP:
36487
4df2ac60690e (mark_maybe_pointer): Fix a typo in a comment.
Eli Zaretskii <eliz@gnu.org>
parents: 36435
diff changeset
3426 /* Nothing to do; not a pointer to Lisp memory. */
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3427 break;
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3428
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3429 case MEM_TYPE_BUFFER:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3430 if (live_buffer_p (m, p)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3431 && !XMARKBIT (((struct buffer *) p)->name))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3432 XSETVECTOR (obj, p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3433 break;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3434
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3435 case MEM_TYPE_CONS:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3436 if (live_cons_p (m, p)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3437 && !XMARKBIT (((struct Lisp_Cons *) p)->car))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3438 XSETCONS (obj, p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3439 break;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3440
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3441 case MEM_TYPE_STRING:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3442 if (live_string_p (m, p)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3443 && !STRING_MARKED_P ((struct Lisp_String *) p))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3444 XSETSTRING (obj, p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3445 break;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3446
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3447 case MEM_TYPE_MISC:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3448 if (live_misc_p (m, p))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3449 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3450 Lisp_Object tem;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3451 XSETMISC (tem, p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3452
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3453 switch (XMISCTYPE (tem))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3454 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3455 case Lisp_Misc_Marker:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3456 if (!XMARKBIT (XMARKER (tem)->chain))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3457 obj = tem;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3458 break;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3459
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3460 case Lisp_Misc_Buffer_Local_Value:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3461 case Lisp_Misc_Some_Buffer_Local_Value:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3462 if (!XMARKBIT (XBUFFER_LOCAL_VALUE (tem)->realvalue))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3463 obj = tem;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3464 break;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3465
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3466 case Lisp_Misc_Overlay:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3467 if (!XMARKBIT (XOVERLAY (tem)->plist))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3468 obj = tem;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3469 break;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3470 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3471 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3472 break;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3473
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3474 case MEM_TYPE_SYMBOL:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3475 if (live_symbol_p (m, p)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3476 && !XMARKBIT (((struct Lisp_Symbol *) p)->plist))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3477 XSETSYMBOL (obj, p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3478 break;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3479
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3480 case MEM_TYPE_FLOAT:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3481 if (live_float_p (m, p)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3482 && !XMARKBIT (((struct Lisp_Float *) p)->type))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3483 XSETFLOAT (obj, p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3484 break;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3485
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3486 case MEM_TYPE_VECTOR:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3487 case MEM_TYPE_PROCESS:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3488 case MEM_TYPE_HASH_TABLE:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3489 case MEM_TYPE_FRAME:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3490 case MEM_TYPE_WINDOW:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3491 if (live_vector_p (m, p))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3492 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3493 Lisp_Object tem;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3494 XSETVECTOR (tem, p);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3495 if (!GC_SUBRP (tem)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3496 && !(XVECTOR (tem)->size & ARRAY_MARK_FLAG))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3497 obj = tem;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3498 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3499 break;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3500
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3501 default:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3502 abort ();
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3503 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3504
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3505 if (!GC_NILP (obj))
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3506 mark_object (&obj);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3507 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3508 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3509
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3510
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3511 /* Mark Lisp objects referenced from the address range START..END. */
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3512
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3513 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3514 mark_memory (start, end)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3515 void *start, *end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3516 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3517 Lisp_Object *p;
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3518 void **pp;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3519
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3520 #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
3521 nzombies = 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3522 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3523
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3524 /* 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
3525 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
3526 if (end < start)
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3527 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3528 void *tem = start;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3529 start = end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3530 end = tem;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3531 }
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3532
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3533 /* Mark Lisp_Objects. */
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3534 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
3535 mark_maybe_object (*p);
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3536
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3537 /* Mark Lisp data pointed to. This is necessary because, in some
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3538 situations, the C compiler optimizes Lisp objects away, so that
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3539 only a pointer to them remains. Example:
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3540
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3541 DEFUN ("testme", Ftestme, Stestme, 0, 0, 0, "")
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3542 ()
36435
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3543 {
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3544 Lisp_Object obj = build_string ("test");
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3545 struct Lisp_String *s = XSTRING (obj);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3546 Fgarbage_collect ();
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3547 fprintf (stderr, "test `%s'\n", s->data);
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3548 return Qnil;
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3549 }
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3550
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3551 Here, `obj' isn't really used, and the compiler optimizes it
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3552 away. The only reference to the life string is through the
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3553 pointer `s'. */
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3554
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3555 for (pp = (void **) start; (void *) pp < end; ++pp)
5a989d353a68 (toplevel): Include process.h.
Gerd Moellmann <gerd@gnu.org>
parents: 35762
diff changeset
3556 mark_maybe_pointer (*pp);
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3557 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3558
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3559
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3560 #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
3561
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3562 static int setjmp_tested_p, longjmps_done;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3563
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3564 #define SETJMP_WILL_LIKELY_WORK "\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3565 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3566 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
3567 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
3568 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
3569 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3570 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
3571 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
3572 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
3573 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3574 Please mail the result to <gerd@gnu.org>.\n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3575 "
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3576
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3577 #define SETJMP_WILL_NOT_WORK "\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3578 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3579 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
3580 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
3581 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
3582 solution for your system.\n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3583 \n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3584 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
3585 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
3586 Please mail the result to <gerd@gnu.org>.\n\
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3587 "
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3588
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3589
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3590 /* 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
3591 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
3592 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
3593 conservative stack marking. Only the sources or a disassembly
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3594 can prove that. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3595
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3596 static void
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3597 test_setjmp ()
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3598 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3599 char buf[10];
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3600 register int x;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3601 jmp_buf jbuf;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3602 int result = 0;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3603
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3604 /* Arrange for X to be put in a register. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3605 sprintf (buf, "1");
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3606 x = strlen (buf);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3607 x = 2 * x - 1;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3608
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3609 setjmp (jbuf);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3610 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
3611 {
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3612 /* 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
3613
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3614 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
3615 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
3616 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
3617 isn't sure.
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3618
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3619 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
3620 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
3621
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3622 if (x == 1)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3623 fprintf (stderr, SETJMP_WILL_LIKELY_WORK);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3624 else
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3625 {
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3626 fprintf (stderr, SETJMP_WILL_NOT_WORK);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3627 exit (1);
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3628 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3629 }
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3630
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3631 ++longjmps_done;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3632 x = 2;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3633 if (longjmps_done == 1)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3634 longjmp (jbuf, 1);
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3635 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3636
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3637 #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
3638
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3639
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3640 #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
3641
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3642 /* 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
3643
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3644 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3645 check_gcpros ()
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3646 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3647 struct gcpro *p;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3648 int i;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3649
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3650 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
3651 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
3652 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
3653 abort ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3654 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3655
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3656 #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
3657
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3658 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3659 dump_zombies ()
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3660 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3661 int i;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3662
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3663 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
3664 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
3665 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3666 fprintf (stderr, " %d = ", i);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3667 debug_print (zombies[i]);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3668 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3669 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3670
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3671 #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
3672
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3673
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3674 /* Mark live Lisp objects on the C stack.
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3675
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3676 There are several system-dependent problems to consider when
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3677 porting this to new architectures:
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3678
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3679 Processor Registers
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3680
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3681 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
3682 variables or are used to pass parameters.
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3683
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3684 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
3685 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
3686 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
3687
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3688 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
3689 implementation assumes that calling setjmp saves registers we need
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3690 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
3691 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
3692 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
3693
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3694 Stack Layout
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3695
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3696 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
3697 For example, the stack might look like this
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3698
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3699 +----------------+
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3700 | Lisp_Object | size = 4
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3701 +----------------+
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3702 | something else | size = 2
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3703 +----------------+
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3704 | Lisp_Object | size = 4
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3705 +----------------+
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3706 | ... |
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3707
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3708 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
3709 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
3710 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
3711 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
3712 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
3713 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
3714 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
3715 from the stack start.
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3716
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3717 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
3718 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
3719
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3720 static void
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3721 mark_stack ()
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3722 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3723 jmp_buf j;
31829
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
3724 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
3725 void *end;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3726
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3727 /* 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
3728 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
3729 #ifdef sparc
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3730 asm ("ta 3");
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3731 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3732
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3733 /* 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
3734 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
3735 pass parameters. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3736 #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
3737 GC_SAVE_REGISTERS_ON_STACK (end);
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3738 #else /* not GC_SAVE_REGISTERS_ON_STACK */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3739
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3740 #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
3741 setjmp will definitely work, test it
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3742 and print a message with the result
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3743 of the test. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3744 if (!setjmp_tested_p)
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3745 {
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3746 setjmp_tested_p = 1;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3747 test_setjmp ();
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3748 }
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3749 #endif /* GC_SETJMP_WORKS */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3750
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3751 setjmp (j);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3752 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
3753 #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
3754
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3755 /* 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
3756 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
3757 over the stack segments. */
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3758 #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
3759 mark_memory (stack_base, end);
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3760 mark_memory ((char *) stack_base + 1, end);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3761 mark_memory ((char *) stack_base + 2, end);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3762 mark_memory ((char *) stack_base + 3, end);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3763 #elif GC_LISP_OBJECT_ALIGNMENT == 2
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3764 mark_memory (stack_base, end);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3765 mark_memory ((char *) stack_base + 2, end);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3766 #else
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3767 mark_memory (stack_base, end);
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
3768 #endif
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3769
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3770 #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
3771 check_gcpros ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3772 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3773 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3774
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3775
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3776 #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
3777
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3778
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3779
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3780 /***********************************************************************
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3781 Pure Storage Management
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3782 ***********************************************************************/
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3783
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3784 /* 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
3785 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
3786 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
3787
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3788 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
3789 the allocated object is recorded in pure_types. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3790
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3791 static POINTER_TYPE *
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3792 pure_alloc (size, type)
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3793 size_t size;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3794 int type;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3795 {
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3796 size_t nbytes;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3797 POINTER_TYPE *result;
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3798 char *beg = purebeg;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3799
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3800 /* Give Lisp_Floats an extra alignment. */
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3801 if (type == Lisp_Float)
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3802 {
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3803 size_t alignment;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3804 #if defined __GNUC__ && __GNUC__ >= 2
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3805 alignment = __alignof (struct Lisp_Float);
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3806 #else
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3807 alignment = sizeof (struct Lisp_Float);
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3808 #endif
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3809 pure_bytes_used = ALIGN (pure_bytes_used, alignment);
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3810 }
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3811
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3812 nbytes = ALIGN (size, sizeof (EMACS_INT));
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3813
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3814 if (pure_bytes_used + nbytes > pure_size)
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3815 {
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3816 beg = purebeg = (char *) xmalloc (PURESIZE);
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3817 pure_size = PURESIZE;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3818 pure_bytes_used_before_overflow += pure_bytes_used;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3819 pure_bytes_used = 0;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3820 }
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3821
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3822 result = (POINTER_TYPE *) (beg + pure_bytes_used);
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3823 pure_bytes_used += nbytes;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3824 return result;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3825 }
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3826
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3827
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3828 /* Signal an error if PURESIZE is too small. */
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3829
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3830 void
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3831 check_pure_size ()
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3832 {
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3833 if (pure_bytes_used_before_overflow)
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3834 error ("Pure Lisp storage overflow (approx. %d bytes needed)",
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3835 (int) (pure_bytes_used + pure_bytes_used_before_overflow));
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3836 }
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3837
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
3838
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3839 /* 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
3840 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
3841 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
3842
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3843 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
3844 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
3845 string; then the string is not protected from gc. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3846
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3847 Lisp_Object
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3848 make_pure_string (data, nchars, nbytes, multibyte)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3849 char *data;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3850 int nchars, nbytes;
21258
693573ac0944 (make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
3851 int multibyte;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3852 {
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3853 Lisp_Object string;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3854 struct Lisp_String *s;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3855
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3856 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
3857 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
3858 s->size = nchars;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3859 s->size_byte = multibyte ? nbytes : -1;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3860 bcopy (data, s->data, nbytes);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3861 s->data[nbytes] = '\0';
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3862 s->intervals = NULL_INTERVAL;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3863 XSETSTRING (string, s);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3864 return string;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3865 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3866
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3867
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3868 /* 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
3869 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
3870
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3871 Lisp_Object
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3872 pure_cons (car, cdr)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3873 Lisp_Object car, cdr;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3874 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3875 register Lisp_Object new;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3876 struct Lisp_Cons *p;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3877
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3878 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
3879 XSETCONS (new, p);
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
3880 XSETCAR (new, Fpurecopy (car));
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
3881 XSETCDR (new, Fpurecopy (cdr));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3882 return new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3883 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3884
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3885
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3886 /* 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
3887
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3888 Lisp_Object
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3889 make_pure_float (num)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3890 double num;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3891 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3892 register Lisp_Object new;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3893 struct Lisp_Float *p;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3894
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3895 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
3896 XSETFLOAT (new, p);
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
3897 XFLOAT_DATA (new) = num;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3898 return new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3899 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3900
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3901
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3902 /* 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
3903 pure space. */
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3904
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3905 Lisp_Object
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3906 make_pure_vector (len)
8817
48ff00bebef6 (pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
3907 EMACS_INT len;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3908 {
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3909 Lisp_Object new;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3910 struct Lisp_Vector *p;
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3911 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
3912
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3913 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
3914 XSETVECTOR (new, p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3915 XVECTOR (new)->size = len;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3916 return new;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3917 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3918
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3919
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3920 DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3921 doc: /* Make a copy of OBJECT in pure storage.
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
3922 Recursively copies contents of vectors and cons cells.
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3923 Does not copy symbols. Copies strings without text properties. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
3924 (obj)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3925 register Lisp_Object obj;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3926 {
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 434
diff changeset
3927 if (NILP (Vpurify_flag))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3928 return obj;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3929
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
3930 if (PURE_POINTER_P (XPNTR (obj)))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3931 return obj;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3932
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3933 if (CONSP (obj))
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
3934 return pure_cons (XCAR (obj), XCDR (obj));
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3935 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
3936 return make_pure_float (XFLOAT_DATA (obj));
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3937 else if (STRINGP (obj))
20587
eaf988c7e291 (make_pure_string): New arg length_byte.
Richard M. Stallman <rms@gnu.org>
parents: 20565
diff changeset
3938 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
3939 STRING_BYTES (XSTRING (obj)),
693573ac0944 (make_specified_string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 21244
diff changeset
3940 STRING_MULTIBYTE (obj));
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3941 else if (COMPILEDP (obj) || VECTORP (obj))
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3942 {
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3943 register struct Lisp_Vector *vec;
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3944 register int i, size;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3945
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3946 size = XVECTOR (obj)->size;
10427
5faba1b094d5 (Fpurecopy): Mask size field when copying pseudovector.
Karl Heuer <kwzh@gnu.org>
parents: 10414
diff changeset
3947 if (size & PSEUDOVECTOR_FLAG)
5faba1b094d5 (Fpurecopy): Mask size field when copying pseudovector.
Karl Heuer <kwzh@gnu.org>
parents: 10414
diff changeset
3948 size &= PSEUDOVECTOR_SIZE_MASK;
16100
ccd19852de65 (Fpurecopy): Cast arg to make_pure_vector.
Richard M. Stallman <rms@gnu.org>
parents: 16051
diff changeset
3949 vec = XVECTOR (make_pure_vector ((EMACS_INT) size));
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3950 for (i = 0; i < size; i++)
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3951 vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3952 if (COMPILEDP (obj))
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3953 XSETCOMPILED (obj, vec);
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3954 else
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3955 XSETVECTOR (obj, vec);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3956 return obj;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3957 }
10004
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3958 else if (MARKERP (obj))
2c57cb7eba5f (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 9968
diff changeset
3959 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
3960
43566b0aec59 Avoid some more compiler warnings.
Gerd Moellmann <gerd@gnu.org>
parents: 31576
diff changeset
3961 return obj;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3962 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3963
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3964
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3965
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3966 /***********************************************************************
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3967 Protection from GC
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3968 ***********************************************************************/
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
3969
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3970 /* 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
3971 VARADDRESS. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3972
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3973 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3974 staticpro (varaddress)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3975 Lisp_Object *varaddress;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3976 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3977 staticvec[staticidx++] = varaddress;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3978 if (staticidx >= NSTATICS)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3979 abort ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3980 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3981
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3982 struct catchtag
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3983 {
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3984 Lisp_Object tag;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3985 Lisp_Object val;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3986 struct catchtag *next;
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3987 };
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3988
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
3989 struct backtrace
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3990 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3991 struct backtrace *next;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3992 Lisp_Object *function;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3993 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
3994 int nargs; /* Length of vector. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3995 /* 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
3996 unevalled args. */
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3997 char evalargs;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3998 };
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
3999
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4000
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4001
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4002 /***********************************************************************
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4003 Protection from GC
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4004 ***********************************************************************/
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
4005
11374
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4006 /* Temporarily prevent garbage collection. */
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4007
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4008 int
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4009 inhibit_garbage_collection ()
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4010 {
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4011 int count = specpdl_ptr - specpdl;
39633
a0bf0cb8ff3e (inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents: 39572
diff changeset
4012 specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM));
11374
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4013 return count;
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4014 }
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
4015
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4016
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4017 DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4018 doc: /* Reclaim storage for Lisp objects no longer needed.
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
4019 Returns info on amount of space in use:
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
4020 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
4021 (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
4022 (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS)
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
4023 (USED-STRINGS . FREE-STRINGS))
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
4024 Garbage collection happens automatically if you cons more than
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4025 `gc-cons-threshold' bytes of Lisp data since previous garbage collection. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
4026 ()
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4027 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4028 register struct gcpro *tail;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4029 register struct specbinding *bind;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4030 struct catchtag *catch;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4031 struct handler *handler;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4032 register struct backtrace *backlist;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4033 char stack_top_variable;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4034 register int i;
25343
fe92158a9e83 (Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents: 25133
diff changeset
4035 int message_p;
34270
773e6aa2ec38 (Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents: 33800
diff changeset
4036 Lisp_Object total[8];
35170
a9b677239421 (Fgarbage_collect): Use a record_unwind_protect to
Gerd Moellmann <gerd@gnu.org>
parents: 34325
diff changeset
4037 int count = BINDING_STACK_SIZE ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4038
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4039 /* Can't GC if pure storage overflowed because we can't determine
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4040 if something is a pure object or not. */
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4041 if (pure_bytes_used_before_overflow)
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4042 return Qnil;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4043
11892
6be0b7a0ac44 (Fgarbage_collect): Clear consing_since_gc first thing.
Karl Heuer <kwzh@gnu.org>
parents: 11727
diff changeset
4044 /* 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
4045 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
4046 consing_since_gc = 0;
6be0b7a0ac44 (Fgarbage_collect): Clear consing_since_gc first thing.
Karl Heuer <kwzh@gnu.org>
parents: 11727
diff changeset
4047
25343
fe92158a9e83 (Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents: 25133
diff changeset
4048 /* 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
4049 message_p = push_message ();
35170
a9b677239421 (Fgarbage_collect): Use a record_unwind_protect to
Gerd Moellmann <gerd@gnu.org>
parents: 34325
diff changeset
4050 record_unwind_protect (push_message_unwind, Qnil);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4051
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4052 /* Save a copy of the contents of the stack, for debugging. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4053 #if MAX_SAVE_STACK > 0
485
8c615e453683 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 434
diff changeset
4054 if (NILP (Vpurify_flag))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4055 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4056 i = &stack_top_variable - stack_bottom;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4057 if (i < 0) i = -i;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4058 if (i < MAX_SAVE_STACK)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4059 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4060 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
4061 stack_copy = (char *) xmalloc (stack_copy_size = i);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4062 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
4063 stack_copy = (char *) xrealloc (stack_copy, (stack_copy_size = i));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4064 if (stack_copy)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4065 {
8817
48ff00bebef6 (pure, pure_size): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 7307
diff changeset
4066 if ((EMACS_INT) (&stack_top_variable - stack_bottom) > 0)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4067 bcopy (stack_bottom, stack_copy, i);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4068 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4069 bcopy (&stack_top_variable, stack_copy, i);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4070 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4071 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4072 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4073 #endif /* MAX_SAVE_STACK > 0 */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4074
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
4075 if (garbage_collection_messages)
10395
c121703d35c7 (Fgarbage_collect): Don't log the GC message.
Karl Heuer <kwzh@gnu.org>
parents: 10389
diff changeset
4076 message1_nolog ("Garbage collecting...");
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4077
23534
6f9c70db3a58 (Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents: 22382
diff changeset
4078 BLOCK_INPUT;
6f9c70db3a58 (Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents: 22382
diff changeset
4079
22220
a0cd311af6e3 (Fgarbage_collect): Call shrink_regexp_cache.
Richard M. Stallman <rms@gnu.org>
parents: 21948
diff changeset
4080 shrink_regexp_cache ();
a0cd311af6e3 (Fgarbage_collect): Call shrink_regexp_cache.
Richard M. Stallman <rms@gnu.org>
parents: 21948
diff changeset
4081
21680
c744d468bfb6 (Fgarbage_collect): Don't truncate command-history here.
Richard M. Stallman <rms@gnu.org>
parents: 21514
diff changeset
4082 /* Don't keep undo information around forever. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4083 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4084 register struct buffer *nextb = all_buffers;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4085
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4086 while (nextb)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4087 {
648
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
4088 /* 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
4089 turned off in that buffer. Calling truncate_undo_list on
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
4090 Qt tends to return NULL, which effectively turns undo back on.
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
4091 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
4092 if (! EQ (nextb->undo_list, Qt))
70b112526394 *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 638
diff changeset
4093 nextb->undo_list
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
4094 = truncate_undo_list (nextb->undo_list, undo_limit,
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
4095 undo_strong_limit);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4096 nextb = nextb->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4097 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4098 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4099
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4100 gc_in_progress = 1;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4101
16231
5ce3b59f093b Comment changes.
Erik Naggum <erik@naggum.no>
parents: 16223
diff changeset
4102 /* clear_marks (); */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4103
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4104 /* Mark all the special slots that serve as the roots of accessibility.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4105
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4106 Usually the special slots to mark are contained in particular structures.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4107 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
4108 In some cases, the structures point to the slots to be marked.
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4109 For these, we use MARKBIT to avoid double marking of the slot. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4110
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4111 for (i = 0; i < staticidx; i++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4112 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
4113
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4114 #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
4115 || 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
4116 mark_stack ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4117 #else
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4118 for (tail = gcprolist; tail; tail = tail->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4119 for (i = 0; i < tail->nvars; i++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4120 if (!XMARKBIT (tail->var[i]))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4121 {
32099
31541e0a2704 (Fgarbage_collect): Prevent compiler warning for a call
Eli Zaretskii <eliz@gnu.org>
parents: 31897
diff changeset
4122 /* Explicit casting prevents compiler warning about
31541e0a2704 (Fgarbage_collect): Prevent compiler warning for a call
Eli Zaretskii <eliz@gnu.org>
parents: 31897
diff changeset
4123 discarding the `volatile' qualifier. */
31541e0a2704 (Fgarbage_collect): Prevent compiler warning for a call
Eli Zaretskii <eliz@gnu.org>
parents: 31897
diff changeset
4124 mark_object ((Lisp_Object *)&tail->var[i]);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4125 XMARK (tail->var[i]);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4126 }
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4127 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4128
26364
7b0217d9259c (Fgarbage_collect): Call mark_byte_stack and
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
4129 mark_byte_stack ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4130 for (bind = specpdl; bind != specpdl_ptr; bind++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4131 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4132 mark_object (&bind->symbol);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4133 mark_object (&bind->old_value);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4134 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4135 for (catch = catchlist; catch; catch = catch->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4136 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4137 mark_object (&catch->tag);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4138 mark_object (&catch->val);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4139 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4140 for (handler = handlerlist; handler; handler = handler->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4141 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4142 mark_object (&handler->handler);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4143 mark_object (&handler->var);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4144 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4145 for (backlist = backtrace_list; backlist; backlist = backlist->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4146 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4147 if (!XMARKBIT (*backlist->function))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4148 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4149 mark_object (backlist->function);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4150 XMARK (*backlist->function);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4151 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4152 if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4153 i = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4154 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4155 i = backlist->nargs - 1;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4156 for (; i >= 0; i--)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4157 if (!XMARKBIT (backlist->args[i]))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4158 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4159 mark_object (&backlist->args[i]);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4160 XMARK (backlist->args[i]);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4161 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4162 }
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4163 mark_kboards ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4164
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4165 /* 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
4166 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
4167 and delete them. */
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4168 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4169 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
4170
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4171 while (nextb)
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4172 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4173 /* 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
4174 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
4175 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
4176 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
4177 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
4178 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4179 Lisp_Object tail, prev;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4180 tail = nextb->undo_list;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4181 prev = Qnil;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4182 while (CONSP (tail))
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4183 {
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
4184 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
4185 && 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
4186 && ! 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
4187 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4188 if (NILP (prev))
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
4189 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
4190 else
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
4191 {
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
4192 tail = XCDR (tail);
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
4193 XSETCDR (prev, tail);
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
4194 }
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4195 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4196 else
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4197 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4198 prev = tail;
25645
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
4199 tail = XCDR (tail);
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4200 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4201 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4202 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4203
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4204 nextb = nextb->next;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4205 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4206 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4207
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4208 #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
4209 mark_stack ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4210 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4211
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4212 gc_sweep ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4213
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4214 /* Clear the mark bits that we set in certain root slots. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4215
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4216 #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
4217 || GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4218 for (tail = gcprolist; tail; tail = tail->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4219 for (i = 0; i < tail->nvars; i++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4220 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
4221 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4222
26378
cbf297593a79 (Fgarbage_collect): Call unmark_byte_stack.
Gerd Moellmann <gerd@gnu.org>
parents: 26372
diff changeset
4223 unmark_byte_stack ();
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4224 for (backlist = backtrace_list; backlist; backlist = backlist->next)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4225 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4226 XUNMARK (*backlist->function);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4227 if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4228 i = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4229 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4230 i = backlist->nargs - 1;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4231 for (; i >= 0; i--)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4232 XUNMARK (backlist->args[i]);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4233 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4234 XUNMARK (buffer_defaults.name);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4235 XUNMARK (buffer_local_symbols.name);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4236
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4237 #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
4238 dump_zombies ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4239 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4240
23534
6f9c70db3a58 (Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents: 22382
diff changeset
4241 UNBLOCK_INPUT;
6f9c70db3a58 (Fgarbage_collect): Block input around most of the function.
Richard M. Stallman <rms@gnu.org>
parents: 22382
diff changeset
4242
16231
5ce3b59f093b Comment changes.
Erik Naggum <erik@naggum.no>
parents: 16223
diff changeset
4243 /* clear_marks (); */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4244 gc_in_progress = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4245
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4246 consing_since_gc = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4247 if (gc_cons_threshold < 10000)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4248 gc_cons_threshold = 10000;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4249
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
4250 if (garbage_collection_messages)
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
4251 {
25343
fe92158a9e83 (Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents: 25133
diff changeset
4252 if (message_p || minibuf_level > 0)
fe92158a9e83 (Fgarbage_collect): Use push_message, restore_message,
Gerd Moellmann <gerd@gnu.org>
parents: 25133
diff changeset
4253 restore_message ();
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
4254 else
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
4255 message1_nolog ("Garbage collecting...done");
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
4256 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4257
35170
a9b677239421 (Fgarbage_collect): Use a record_unwind_protect to
Gerd Moellmann <gerd@gnu.org>
parents: 34325
diff changeset
4258 unbind_to (count, Qnil);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4259
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4260 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
4261 make_number (total_free_conses));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4262 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
4263 make_number (total_free_symbols));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4264 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
4265 make_number (total_free_markers));
34270
773e6aa2ec38 (Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents: 33800
diff changeset
4266 total[3] = make_number (total_string_size);
773e6aa2ec38 (Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents: 33800
diff changeset
4267 total[4] = make_number (total_vector_size);
773e6aa2ec38 (Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents: 33800
diff changeset
4268 total[5] = Fcons (make_number (total_floats),
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4269 make_number (total_free_floats));
34270
773e6aa2ec38 (Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents: 33800
diff changeset
4270 total[6] = Fcons (make_number (total_intervals),
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4271 make_number (total_free_intervals));
34270
773e6aa2ec38 (Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents: 33800
diff changeset
4272 total[7] = Fcons (make_number (total_strings),
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4273 make_number (total_free_strings));
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4274
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4275 #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
4276 {
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4277 /* 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
4278 double nlive = 0;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4279
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4280 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
4281 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
4282
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4283 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
4284 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
4285 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
4286 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
4287 ++ngcs;
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4288 }
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4289 #endif
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4290
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4291 if (!NILP (Vpost_gc_hook))
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4292 {
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4293 int count = inhibit_garbage_collection ();
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4294 safe_run_hooks (Qpost_gc_hook);
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4295 unbind_to (count, Qnil);
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4296 }
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
4297
34270
773e6aa2ec38 (Fgarbage_collect): Dox fix. Return a list as
Gerd Moellmann <gerd@gnu.org>
parents: 33800
diff changeset
4298 return Flist (sizeof total / sizeof *total, total);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4299 }
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4300
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4301
25367
823e14641544 (mark_glyph_matrix): Mark strings only.
Gerd Moellmann <gerd@gnu.org>
parents: 25343
diff changeset
4302 /* 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
4303 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
4304
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4305 static void
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4306 mark_glyph_matrix (matrix)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4307 struct glyph_matrix *matrix;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4308 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4309 struct glyph_row *row = matrix->rows;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4310 struct glyph_row *end = row + matrix->nrows;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4311
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4312 for (; row < end; ++row)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4313 if (row->enabled_p)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4314 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4315 int area;
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4316 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
4317 {
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4318 struct glyph *glyph = row->glyphs[area];
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4319 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
4320
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4321 for (; glyph < end_glyph; ++glyph)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4322 if (GC_STRINGP (glyph->object)
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4323 && !STRING_MARKED_P (XSTRING (glyph->object)))
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4324 mark_object (&glyph->object);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4325 }
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4326 }
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4327 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4328
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4329
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4330 /* 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
4331
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4332 static void
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4333 mark_face_cache (c)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4334 struct face_cache *c;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4335 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4336 if (c)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4337 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4338 int i, j;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4339 for (i = 0; i < c->used; ++i)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4340 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4341 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
4342
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4343 if (face)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4344 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4345 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
4346 mark_object (&face->lface[j]);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4347 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4348 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4349 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4350 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4351
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4352
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4353 #ifdef HAVE_WINDOW_SYSTEM
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4354
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4355 /* Mark Lisp objects in image IMG. */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4356
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4357 static void
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4358 mark_image (img)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4359 struct image *img;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4360 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4361 mark_object (&img->spec);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4362
31892
2f3d88ac2b38 (__malloc_size_t) [DOUG_LEA_MALLOC]: Don't redefine it.
Dave Love <fx@gnu.org>
parents: 31889
diff changeset
4363 if (!NILP (img->data.lisp_val))
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4364 mark_object (&img->data.lisp_val);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4365 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4366
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4367
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4368 /* 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
4369 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
4370
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4371 static void
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4372 mark_image_cache (f)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4373 struct frame *f;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4374 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4375 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
4376 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4377
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4378 #endif /* HAVE_X_WINDOWS */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4379
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4380
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4381
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
4382 /* 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
4383 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
4384 all the references contained in it. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4385
1168
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
4386 #define LAST_MARKED_SIZE 500
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
4387 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
4388 int last_marked_index;
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
4389
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4390 void
13553
fb12156faaf5 (mark_object): Don't overwrite original argument value.
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
4391 mark_object (argptr)
fb12156faaf5 (mark_object): Don't overwrite original argument value.
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
4392 Lisp_Object *argptr;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4393 {
13553
fb12156faaf5 (mark_object): Don't overwrite original argument value.
Richard M. Stallman <rms@gnu.org>
parents: 13363
diff changeset
4394 Lisp_Object *objptr = argptr;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4395 register Lisp_Object obj;
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4396 #ifdef GC_CHECK_MARKED_OBJECTS
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4397 void *po;
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4398 struct mem_node *m;
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4399 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4400
5868
a7bd57a60cb8 (mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents: 5353
diff changeset
4401 loop:
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4402 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
4403 loop2:
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4404 XUNMARK (obj);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4405
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
4406 if (PURE_POINTER_P (XPNTR (obj)))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4407 return;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4408
1168
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
4409 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
4410 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
4411 last_marked_index = 0;
2b07af77d7ec (mark_object): Save last 500 values of objptr.
Richard M. Stallman <rms@gnu.org>
parents: 1114
diff changeset
4412
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4413 /* 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
4414 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
4415 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
4416 #ifdef GC_CHECK_MARKED_OBJECTS
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4417
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4418 po = (void *) XPNTR (obj);
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4419
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4420 /* 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
4421 structure allocated from the heap. */
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4422 #define CHECK_ALLOCATED() \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4423 do { \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4424 m = mem_find (po); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4425 if (m == MEM_NIL) \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4426 abort (); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4427 } while (0)
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4428
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4429 /* 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
4430 function LIVEP. */
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4431 #define CHECK_LIVE(LIVEP) \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4432 do { \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4433 if (!LIVEP (m, po)) \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4434 abort (); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4435 } while (0)
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4436
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4437 /* 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
4438 #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
4439 do { \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4440 CHECK_ALLOCATED (); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4441 CHECK_LIVE (LIVEP); \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4442 } while (0) \
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4443
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4444 #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
4445
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4446 #define CHECK_ALLOCATED() (void) 0
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4447 #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
4448 #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
4449
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4450 #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
4451
10457
2ab3bd0288a9 Change all occurences of SWITCH_ENUM_BUG to use SWITCH_ENUM_CAST instead.
Karl Heuer <kwzh@gnu.org>
parents: 10427
diff changeset
4452 switch (SWITCH_ENUM_CAST (XGCTYPE (obj)))
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4453 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4454 case Lisp_String:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4455 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4456 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
4457 CHECK_ALLOCATED_AND_LIVE (live_string_p);
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4458 MARK_INTERVAL_TREE (ptr->intervals);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4459 MARK_STRING (ptr);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
4460 #ifdef GC_CHECK_STRING_BYTES
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
4461 /* Check that the string size recorded in the string is the
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
4462 same as the one recorded in the sdata structure. */
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
4463 CHECK_STRING_BYTES (ptr);
32587
b3918817f15f (mark_object) [GC_CHECK_STRING_BYTES]: Check validity of
Gerd Moellmann <gerd@gnu.org>
parents: 32360
diff changeset
4464 #endif /* GC_CHECK_STRING_BYTES */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4465 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4466 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4467
10009
82f3daf76995 (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 10004
diff changeset
4468 case Lisp_Vectorlike:
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4469 #ifdef GC_CHECK_MARKED_OBJECTS
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4470 m = mem_find (po);
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4471 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
4472 && po != &buffer_defaults
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4473 && po != &buffer_local_symbols)
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4474 abort ();
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4475 #endif /* GC_CHECK_MARKED_OBJECTS */
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4476
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4477 if (GC_BUFFERP (obj))
10340
ef58c7a5a4d6 (mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents: 10320
diff changeset
4478 {
ef58c7a5a4d6 (mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents: 10320
diff changeset
4479 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
4480 {
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4481 #ifdef GC_CHECK_MARKED_OBJECTS
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4482 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
4483 {
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4484 struct buffer *b;
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4485 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
4486 ;
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4487 if (b == NULL)
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4488 abort ();
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4489 }
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4490 #endif /* GC_CHECK_MARKED_OBJECTS */
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4491 mark_buffer (obj);
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4492 }
10340
ef58c7a5a4d6 (mark_object, mark_buffer): Don't mark buffer twice.
Karl Heuer <kwzh@gnu.org>
parents: 10320
diff changeset
4493 }
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4494 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
4495 break;
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4496 else if (GC_COMPILEDP (obj))
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4497 /* 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
4498 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
4499 recursion there. */
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4500 {
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4501 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
4502 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
4503 register int i;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4504
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4505 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
4506 break; /* Already marked */
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4507
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4508 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
4509 ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
10009
82f3daf76995 (Fpurecopy): Use type test macros.
Karl Heuer <kwzh@gnu.org>
parents: 10004
diff changeset
4510 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
4511 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
4512 {
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4513 if (i != COMPILED_CONSTANTS)
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4514 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
4515 }
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4516 /* 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
4517 (MIPS-ABI + SysVR4, DC/OSx, etc). */
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4518 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
4519 goto loop;
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4520 }
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4521 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
4522 {
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4523 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
4524 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
4525
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4526 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
4527 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
4528
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4529 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
4530 mark_object (&ptr->name);
12273
377cbbd8a2ad (mark_object): Mark icon_name field.
Richard M. Stallman <rms@gnu.org>
parents: 12175
diff changeset
4531 mark_object (&ptr->icon_name);
14216
5970a52070bb (mark_object): Mark frame title field.
Richard M. Stallman <rms@gnu.org>
parents: 14186
diff changeset
4532 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
4533 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
4534 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
4535 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
4536 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
4537 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
4538 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
4539 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
4540 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
4541 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
4542 mark_object (&ptr->buffer_predicate);
17217
571d0c136e48 (mark_object): Mark the buffer_list field.
Richard M. Stallman <rms@gnu.org>
parents: 17021
diff changeset
4543 mark_object (&ptr->buffer_list);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4544 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
4545 mark_object (&ptr->tool_bar_window);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4546 mark_face_cache (ptr->face_cache);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4547 #ifdef HAVE_WINDOW_SYSTEM
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4548 mark_image_cache (ptr);
33764
a832bb73de79 (mark_object) <frame>: Mark tool bar items differently.
Gerd Moellmann <gerd@gnu.org>
parents: 33623
diff changeset
4549 mark_object (&ptr->tool_bar_items);
25544
693ca9ba497a Change spelling of `toolbar' to `tool_bar' or `tool-bar'.
Gerd Moellmann <gerd@gnu.org>
parents: 25452
diff changeset
4550 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
4551 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
4552 #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
4553 }
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
4554 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
4555 {
5cd52d4838f8 (mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents: 14959
diff changeset
4556 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
4557
5cd52d4838f8 (mark_object): Do set ARRAY_MARK_FLAG for bool-vectors.
Richard M. Stallman <rms@gnu.org>
parents: 14959
diff changeset
4558 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
4559 break; /* Already marked */
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4560 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
4561 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
4562 }
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4563 else if (GC_WINDOWP (obj))
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4564 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4565 register struct Lisp_Vector *ptr = XVECTOR (obj);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4566 struct window *w = XWINDOW (obj);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4567 register EMACS_INT size = ptr->size;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4568 register int i;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4569
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4570 /* Stop if already marked. */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4571 if (size & ARRAY_MARK_FLAG)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4572 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4573
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4574 /* Mark it. */
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4575 CHECK_LIVE (live_vector_p);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4576 ptr->size |= ARRAY_MARK_FLAG;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4577
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4578 /* 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
4579 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
4580 for (i = 0;
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4581 (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
4582 i++)
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4583 mark_object (&ptr->contents[i]);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4584
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4585 /* 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
4586 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
4587 memory. */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4588 if (NILP (w->hchild)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4589 && NILP (w->vchild)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4590 && w->current_matrix)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4591 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4592 mark_glyph_matrix (w->current_matrix);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4593 mark_glyph_matrix (w->desired_matrix);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4594 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4595 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4596 else if (GC_HASH_TABLE_P (obj))
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4597 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4598 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
4599 EMACS_INT size = h->size;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4600
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4601 /* Stop if already marked. */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4602 if (size & ARRAY_MARK_FLAG)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4603 break;
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4604
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4605 /* Mark it. */
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4606 CHECK_LIVE (live_vector_p);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4607 h->size |= ARRAY_MARK_FLAG;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4608
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4609 /* Mark contents. */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4610 mark_object (&h->test);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4611 mark_object (&h->weak);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4612 mark_object (&h->rehash_size);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4613 mark_object (&h->rehash_threshold);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4614 mark_object (&h->hash);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4615 mark_object (&h->next);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4616 mark_object (&h->index);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4617 mark_object (&h->user_hash_function);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4618 mark_object (&h->user_cmp_function);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4619
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4620 /* 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
4621 For weak tables, mark only the vector. */
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4622 if (GC_NILP (h->weak))
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4623 mark_object (&h->key_and_value);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4624 else
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4625 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
4626
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4627 }
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4628 else
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4629 {
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4630 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
4631 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
4632 register int i;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4633
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4634 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
4635 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
4636 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
4637 if (size & PSEUDOVECTOR_FLAG)
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4638 size &= PSEUDOVECTOR_SIZE_MASK;
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4639
10291
96273a6ec492 (mark_object): Don't use Lisp_Process, Lisp_Window.
Richard M. Stallman <rms@gnu.org>
parents: 10206
diff changeset
4640 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
4641 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
4642 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4643 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4644
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4645 case Lisp_Symbol:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4646 {
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4647 register struct Lisp_Symbol *ptr = XSYMBOL (obj);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4648 struct Lisp_Symbol *ptrx;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4649
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4650 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
4651 CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4652 XMARK (ptr->plist);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4653 mark_object ((Lisp_Object *) &ptr->value);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4654 mark_object (&ptr->function);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4655 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
4656
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4657 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
4658 MARK_STRING (ptr->name);
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4659 MARK_INTERVAL_TREE (ptr->name->intervals);
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4660
20768
6ebcbdec2e07 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 20708
diff changeset
4661 /* Note that we do not mark the obarray of the symbol.
6ebcbdec2e07 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 20708
diff changeset
4662 It is safe not to do so because nothing accesses that
6ebcbdec2e07 Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 20708
diff changeset
4663 slot except to check whether it is nil. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4664 ptr = ptr->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4665 if (ptr)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4666 {
5868
a7bd57a60cb8 (mark_object): Fetch obj from *objptr at loop, not at the gotos.
Karl Heuer <kwzh@gnu.org>
parents: 5353
diff changeset
4667 /* 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
4668 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
4669 ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4670 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
4671 /* 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
4672 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
4673 goto loop2;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4674 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4675 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4676 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4677
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
4678 case Lisp_Misc:
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4679 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
4680 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
4681 {
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
4682 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
4683 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
4684 /* 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
4685 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
4686 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
4687 break;
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
4688
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4689 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
4690 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
4691 {
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4692 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
4693 = XBUFFER_LOCAL_VALUE (obj);
21143
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
4694 if (XMARKBIT (ptr->realvalue)) break;
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
4695 XMARK (ptr->realvalue);
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4696 /* 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
4697 if (EQ (ptr->cdr, Qnil))
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4698 {
21143
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
4699 objptr = &ptr->realvalue;
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4700 goto loop;
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4701 }
21143
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
4702 mark_object (&ptr->realvalue);
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
4703 mark_object (&ptr->buffer);
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
4704 mark_object (&ptr->frame);
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4705 objptr = &ptr->cdr;
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4706 goto loop;
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4707 }
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
4708
9463
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4709 case Lisp_Misc_Intfwd:
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4710 case Lisp_Misc_Boolfwd:
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4711 case Lisp_Misc_Objfwd:
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4712 case Lisp_Misc_Buffer_Objfwd:
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4713 case Lisp_Misc_Kboard_Objfwd:
9463
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4714 /* Don't bother with Lisp_Buffer_Objfwd,
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4715 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
4716 /* 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
4717 are protected with staticpro. */
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4718 break;
a40af805e036 (mark_object): Use the new substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9437
diff changeset
4719
9926
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4720 case Lisp_Misc_Overlay:
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4721 {
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4722 struct Lisp_Overlay *ptr = XOVERLAY (obj);
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4723 if (!XMARKBIT (ptr->plist))
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4724 {
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4725 XMARK (ptr->plist);
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4726 mark_object (&ptr->start);
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4727 mark_object (&ptr->end);
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4728 objptr = &ptr->plist;
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4729 goto loop;
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4730 }
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4731 }
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4732 break;
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
4733
9437
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
4734 default:
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
4735 abort ();
c7d7fb56b42d (MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the
Karl Heuer <kwzh@gnu.org>
parents: 9367
diff changeset
4736 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4737 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4738
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4739 case Lisp_Cons:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4740 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4741 register struct Lisp_Cons *ptr = XCONS (obj);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4742 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
4743 CHECK_ALLOCATED_AND_LIVE (live_cons_p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4744 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
4745 /* 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
4746 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
4747 {
a9241dc503ab (mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents: 1168
diff changeset
4748 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
4749 goto loop;
a9241dc503ab (mark_object): Avoid car recursion on cons with nil in cdr.
Richard M. Stallman <rms@gnu.org>
parents: 1168
diff changeset
4750 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4751 mark_object (&ptr->car);
32360
d8b668a486d7 (mark_object): Remove all workarounds installed on
Andreas Schwab <schwab@suse.de>
parents: 32099
diff changeset
4752 objptr = &ptr->cdr;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4753 goto loop;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4754 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4755
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4756 case Lisp_Float:
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4757 CHECK_ALLOCATED_AND_LIVE (live_float_p);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4758 XMARK (XFLOAT (obj)->type);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4759 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4760
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4761 case Lisp_Int:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4762 break;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4763
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4764 default:
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4765 abort ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4766 }
29743
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4767
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4768 #undef CHECK_LIVE
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4769 #undef CHECK_ALLOCATED
1d802b332e0d (mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no
Gerd Moellmann <gerd@gnu.org>
parents: 28997
diff changeset
4770 #undef CHECK_ALLOCATED_AND_LIVE
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4771 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4772
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4773 /* Mark the pointers in a buffer structure. */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4774
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4775 static void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4776 mark_buffer (buf)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4777 Lisp_Object buf;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4778 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4779 register struct buffer *buffer = XBUFFER (buf);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4780 register Lisp_Object *ptr;
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4781 Lisp_Object base_buffer;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4782
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4783 /* This is the buffer's markbit */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4784 mark_object (&buffer->name);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4785 XMARK (buffer->name);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4786
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4787 MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
4788
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4789 if (CONSP (buffer->undo_list))
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4790 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4791 Lisp_Object tail;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4792 tail = buffer->undo_list;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4793
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4794 while (CONSP (tail))
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4795 {
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4796 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
4797
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4798 if (XMARKBIT (ptr->car))
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4799 break;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4800 XMARK (ptr->car);
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4801 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
4802 && ! XMARKBIT (XCAR (ptr->car))
a14111a2a100 Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents: 25544
diff changeset
4803 && 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
4804 {
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
4805 XMARK (XCAR_AS_LVALUE (ptr->car));
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
4806 mark_object (&XCDR_AS_LVALUE (ptr->car));
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4807 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4808 else
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4809 mark_object (&ptr->car);
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4810
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4811 if (CONSP (ptr->cdr))
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4812 tail = ptr->cdr;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4813 else
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4814 break;
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4815 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4816
39973
579177964efa Avoid (most) uses of XCAR/XCDR as lvalues, for flexibility in experimenting
Ken Raeburn <raeburn@raeburn.org>
parents: 39914
diff changeset
4817 mark_object (&XCDR_AS_LVALUE (tail));
21306
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4818 }
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4819 else
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4820 mark_object (&buffer->undo_list);
dc2cbd40703c (mark_buffer): Mark the undo_list slot specially;
Richard M. Stallman <rms@gnu.org>
parents: 21258
diff changeset
4821
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4822 for (ptr = &buffer->name + 1;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4823 (char *)ptr < (char *)buffer + sizeof (struct buffer);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4824 ptr++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4825 mark_object (ptr);
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4826
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4827 /* 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
4828 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
4829 {
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4830 XSETBUFFER (base_buffer, buffer->base_buffer);
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4831 mark_buffer (base_buffer);
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
4832 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4833 }
10649
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4834
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4835
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4836 /* Mark the pointers in the kboard objects. */
10649
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4837
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4838 static void
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4839 mark_kboards ()
10649
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4840 {
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4841 KBOARD *kb;
11593
f5385353aae3 (mark_kboards): Mark the kbd macro and Vsystem_key_alist.
Karl Heuer <kwzh@gnu.org>
parents: 11430
diff changeset
4842 Lisp_Object *p;
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4843 for (kb = all_kboards; kb; kb = kb->next_kboard)
10649
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4844 {
11593
f5385353aae3 (mark_kboards): Mark the kbd macro and Vsystem_key_alist.
Karl Heuer <kwzh@gnu.org>
parents: 11430
diff changeset
4845 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
4846 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
4847 mark_object (p);
22381
50e1804145be (mark_kboards): Mark all the Lisp_Object fields.
Richard M. Stallman <rms@gnu.org>
parents: 22220
diff changeset
4848 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
4849 mark_object (&kb->Vlast_command);
50e1804145be (mark_kboards): Mark all the Lisp_Object fields.
Richard M. Stallman <rms@gnu.org>
parents: 22220
diff changeset
4850 mark_object (&kb->Vreal_last_command);
12120
1fc112b5fdc4 (mark_kboards): Mark Vprefix_arg instead of
Karl Heuer <kwzh@gnu.org>
parents: 12096
diff changeset
4851 mark_object (&kb->Vprefix_arg);
22382
f7d2bdefcff7 (mark_kboards): Mark Vlast_prefix_arg too.
Richard M. Stallman <rms@gnu.org>
parents: 22381
diff changeset
4852 mark_object (&kb->Vlast_prefix_arg);
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4853 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
4854 mark_object (&kb->defining_kbd_macro);
11018
2d9bdf1ba3d1 (mark_kboards): Renamed from mark_perdisplays.
Karl Heuer <kwzh@gnu.org>
parents: 10936
diff changeset
4855 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
4856 mark_object (&kb->Vsystem_key_alist);
12175
4e36e9e99082 (mark_kboards): Mark system_key_syms member.
Karl Heuer <kwzh@gnu.org>
parents: 12120
diff changeset
4857 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
4858 mark_object (&kb->Vdefault_minibuffer_frame);
10649
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4859 }
52cdd8cc8d3e (mark_perdisplays): New function.
Karl Heuer <kwzh@gnu.org>
parents: 10581
diff changeset
4860 }
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4861
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4862
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4863 /* 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
4864 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
4865
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4866 int
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4867 survives_gc_p (obj)
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4868 Lisp_Object obj;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4869 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4870 int survives_p;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4871
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4872 switch (XGCTYPE (obj))
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4873 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4874 case Lisp_Int:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4875 survives_p = 1;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4876 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4877
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4878 case Lisp_Symbol:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4879 survives_p = XMARKBIT (XSYMBOL (obj)->plist);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4880 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4881
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4882 case Lisp_Misc:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4883 switch (XMISCTYPE (obj))
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4884 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4885 case Lisp_Misc_Marker:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4886 survives_p = XMARKBIT (obj);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4887 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4888
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4889 case Lisp_Misc_Buffer_Local_Value:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4890 case Lisp_Misc_Some_Buffer_Local_Value:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4891 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
4892 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4893
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4894 case Lisp_Misc_Intfwd:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4895 case Lisp_Misc_Boolfwd:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4896 case Lisp_Misc_Objfwd:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4897 case Lisp_Misc_Buffer_Objfwd:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4898 case Lisp_Misc_Kboard_Objfwd:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4899 survives_p = 1;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4900 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4901
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4902 case Lisp_Misc_Overlay:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4903 survives_p = XMARKBIT (XOVERLAY (obj)->plist);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4904 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4905
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4906 default:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4907 abort ();
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4908 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4909 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4910
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4911 case Lisp_String:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4912 {
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4913 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
4914 survives_p = STRING_MARKED_P (s);
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4915 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4916 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4917
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4918 case Lisp_Vectorlike:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4919 if (GC_BUFFERP (obj))
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4920 survives_p = XMARKBIT (XBUFFER (obj)->name);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4921 else if (GC_SUBRP (obj))
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4922 survives_p = 1;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4923 else
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4924 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
4925 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4926
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4927 case Lisp_Cons:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4928 survives_p = XMARKBIT (XCAR (obj));
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4929 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4930
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4931 case Lisp_Float:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4932 survives_p = XMARKBIT (XFLOAT (obj)->type);
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4933 break;
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4934
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4935 default:
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4936 abort ();
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4937 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4938
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4939 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
4940 }
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4941
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4942
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4943
1908
d649f2179d67 * alloc.c (make_pure_float): Align pureptr on a sizeof (double)
Jim Blandy <jimb@redhat.com>
parents: 1893
diff changeset
4944 /* Sweep: find all structures not marked, and free them. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4945
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4946 static void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4947 gc_sweep ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4948 {
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4949 /* 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
4950 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
4951 sweep_weak_hash_tables ();
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
4952
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
4953 sweep_strings ();
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
4954 #ifdef GC_CHECK_STRING_BYTES
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
4955 if (!noninteractive)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
4956 check_string_bytes (1);
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
4957 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4958
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4959 /* Put all unmarked conses on free list */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4960 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4961 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
4962 struct cons_block **cprev = &cons_block;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4963 register int lim = cons_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4964 register int num_free = 0, num_used = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4965
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4966 cons_free_list = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4967
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4968 for (cblk = cons_block; cblk; cblk = *cprev)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4969 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4970 register int i;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4971 int this_free = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4972 for (i = 0; i < lim; i++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4973 if (!XMARKBIT (cblk->conses[i].car))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4974 {
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4975 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
4976 *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4977 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
4978 #if GC_MARK_STACK
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
4979 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
4980 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4981 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4982 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4983 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4984 num_used++;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4985 XUNMARK (cblk->conses[i].car);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4986 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
4987 lim = CONS_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4988 /* 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
4989 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
4990 this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
4991 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
4992 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4993 *cprev = cblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4994 /* Unhook from the free list. */
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4995 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
4996 lisp_free (cblk);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
4997 n_cons_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4998 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
4999 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5000 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5001 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5002 cprev = &cblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5003 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5004 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5005 total_conses = num_used;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5006 total_free_conses = num_free;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5007 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5008
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5009 /* Put all unmarked floats on free list */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5010 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5011 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
5012 struct float_block **fprev = &float_block;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5013 register int lim = float_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5014 register int num_free = 0, num_used = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5015
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5016 float_free_list = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5017
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5018 for (fblk = float_block; fblk; fblk = *fprev)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5019 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5020 register int i;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5021 int this_free = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5022 for (i = 0; i < lim; i++)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5023 if (!XMARKBIT (fblk->floats[i].type))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5024 {
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5025 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
5026 *(struct Lisp_Float **)&fblk->floats[i].data = float_free_list;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5027 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
5028 #if GC_MARK_STACK
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5029 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
5030 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5031 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5032 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5033 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5034 num_used++;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5035 XUNMARK (fblk->floats[i].type);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5036 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5037 lim = FLOAT_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5038 /* 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
5039 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
5040 this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5041 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
5042 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5043 *fprev = fblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5044 /* Unhook from the free list. */
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5045 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
5046 lisp_free (fblk);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
5047 n_float_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5048 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5049 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5050 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5051 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5052 fprev = &fblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5053 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5054 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5055 total_floats = num_used;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5056 total_free_floats = num_free;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5057 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5058
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5059 /* Put all unmarked intervals on free list */
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5060 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5061 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
5062 struct interval_block **iprev = &interval_block;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5063 register int lim = interval_block_index;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5064 register int num_free = 0, num_used = 0;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5065
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5066 interval_free_list = 0;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5067
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5068 for (iblk = interval_block; iblk; iblk = *iprev)
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5069 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5070 register int i;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5071 int this_free = 0;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5072
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5073 for (i = 0; i < lim; i++)
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5074 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5075 if (! XMARKBIT (iblk->intervals[i].plist))
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5076 {
28269
fd13be8ae190 Changes towards better type safety regarding intervals, primarily
Ken Raeburn <raeburn@raeburn.org>
parents: 28220
diff changeset
5077 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
5078 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
5079 this_free++;
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5080 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5081 else
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5082 {
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5083 num_used++;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5084 XUNMARK (iblk->intervals[i].plist);
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5085 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5086 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5087 lim = INTERVAL_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5088 /* 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
5089 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
5090 deallocate this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5091 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
5092 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5093 *iprev = iblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5094 /* Unhook from the free list. */
28269
fd13be8ae190 Changes towards better type safety regarding intervals, primarily
Ken Raeburn <raeburn@raeburn.org>
parents: 28220
diff changeset
5095 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
5096 lisp_free (iblk);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
5097 n_interval_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5098 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5099 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5100 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5101 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5102 iprev = &iblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5103 }
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5104 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5105 total_intervals = num_used;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5106 total_free_intervals = num_free;
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5107 }
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5108
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5109 /* Put all unmarked symbols on free list */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5110 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5111 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
5112 struct symbol_block **sprev = &symbol_block;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5113 register int lim = symbol_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5114 register int num_free = 0, num_used = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5115
34308
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5116 symbol_free_list = NULL;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5117
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5118 for (sblk = symbol_block; sblk; sblk = *sprev)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5119 {
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5120 int this_free = 0;
34308
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5121 struct Lisp_Symbol *sym = sblk->symbols;
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5122 struct Lisp_Symbol *end = sym + lim;
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5123
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5124 for (; sym < end; ++sym)
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5125 {
34325
a65d8c29442a (gc_sweep): Add comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 34308
diff changeset
5126 /* Check if the symbol was created during loadup. In such a case
a65d8c29442a (gc_sweep): Add comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 34308
diff changeset
5127 it might be pointed to by pure bytecode which we don't trace,
a65d8c29442a (gc_sweep): Add comment.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 34308
diff changeset
5128 so we conservatively assume that it is live. */
34308
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5129 int pure_p = PURE_POINTER_P (sym->name);
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5130
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5131 if (!XMARKBIT (sym->plist) && !pure_p)
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5132 {
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5133 *(struct Lisp_Symbol **) &sym->value = symbol_free_list;
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5134 symbol_free_list = sym;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5135 #if GC_MARK_STACK
34308
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5136 symbol_free_list->function = Vdead;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5137 #endif
34308
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5138 ++this_free;
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5139 }
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5140 else
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5141 {
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5142 ++num_used;
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5143 if (!pure_p)
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5144 UNMARK_STRING (sym->name);
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5145 XUNMARK (sym->plist);
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5146 }
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5147 }
6d490e8ef117 (gc_sweep): Prevent symbols read during loadup
Gerd Moellmann <gerd@gnu.org>
parents: 34270
diff changeset
5148
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5149 lim = SYMBOL_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5150 /* 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
5151 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
5152 this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5153 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
5154 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5155 *sprev = sblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5156 /* Unhook from the free list. */
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5157 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
5158 lisp_free (sblk);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
5159 n_symbol_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5160 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5161 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5162 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5163 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5164 sprev = &sblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5165 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5166 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5167 total_symbols = num_used;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5168 total_free_symbols = num_free;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5169 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5170
21143
ce12eac1ee45 (gc_sweep, mark_object): Handle new data structure
Richard M. Stallman <rms@gnu.org>
parents: 21084
diff changeset
5171 /* 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
5172 For a marker, first unchain it from the buffer it points into. */
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5173 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5174 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
5175 struct marker_block **mprev = &marker_block;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5176 register int lim = marker_block_index;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5177 register int num_free = 0, num_used = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5178
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5179 marker_free_list = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5180
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5181 for (mblk = marker_block; mblk; mblk = *mprev)
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5182 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5183 register int i;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5184 int this_free = 0;
11679
1ced2d67d411 (gc_cons_threshold): Make this an EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents: 11593
diff changeset
5185 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
5186
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5187 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
5188 {
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5189 Lisp_Object *markword;
11243
054ecfce1820 (Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11048
diff changeset
5190 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
5191 {
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5192 case Lisp_Misc_Marker:
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5193 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
5194 break;
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5195 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
5196 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
5197 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
5198 break;
9926
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
5199 case Lisp_Misc_Overlay:
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
5200 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
5201 break;
11403
bd3241a14d0a (gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents: 11374
diff changeset
5202 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
5203 /* 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
5204 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
5205 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
5206 break;
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5207 default:
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5208 markword = 0;
9926
2a9f99682f82 (mark_object, gc_sweep): Use new overlay substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9893
diff changeset
5209 break;
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5210 }
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5211 if (markword && !XMARKBIT (*markword))
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5212 {
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5213 Lisp_Object tem;
11243
054ecfce1820 (Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11048
diff changeset
5214 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
5215 {
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5216 /* tem1 avoids Sun compiler bug */
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5217 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
5218 XSETMARKER (tem, tem1);
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5219 unchain_marker (tem);
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5220 }
11403
bd3241a14d0a (gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents: 11374
diff changeset
5221 /* 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
5222 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
5223 but this might catch bugs faster. */
11243
054ecfce1820 (Fmake_marker, mark_object): Use XMISCTYPE.
Richard M. Stallman <rms@gnu.org>
parents: 11048
diff changeset
5224 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
5225 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
5226 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
5227 this_free++;
9893
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5228 }
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5229 else
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5230 {
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5231 num_used++;
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5232 if (markword)
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5233 XUNMARK (*markword);
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5234 }
8421d09f2afe (mark_object): New code to handle buffer-local substructure.
Karl Heuer <kwzh@gnu.org>
parents: 9463
diff changeset
5235 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5236 lim = MARKER_BLOCK_SIZE;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5237 /* 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
5238 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
5239 this block. */
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5240 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
5241 {
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5242 *mprev = mblk->next;
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5243 /* Unhook from the free list. */
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5244 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
5245 lisp_free (mblk);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
5246 n_marker_blocks--;
20057
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5247 }
612cd201aea5 (gc_sweep): Free memory blocks that contain only unused
Karl Heuer <kwzh@gnu.org>
parents: 19666
diff changeset
5248 else
21379
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5249 {
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5250 num_free += this_free;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5251 mprev = &mblk->next;
1701bf5b9dec (gc_sweep): Avoid using two loop variables counting the
Andreas Schwab <schwab@suse.de>
parents: 21306
diff changeset
5252 }
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5253 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5254
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5255 total_markers = num_used;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5256 total_free_markers = num_free;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5257 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5258
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5259 /* Free all unmarked buffers */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5260 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5261 register struct buffer *buffer = all_buffers, *prev = 0, *next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5262
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5263 while (buffer)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5264 if (!XMARKBIT (buffer->name))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5265 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5266 if (prev)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5267 prev->next = buffer->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5268 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5269 all_buffers = buffer->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5270 next = buffer->next;
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5271 lisp_free (buffer);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5272 buffer = next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5273 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5274 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5275 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5276 XUNMARK (buffer->name);
10307
e6e75fd0916d (mark_buffer, gc_sweep): Use BUF_INTERVALS.
Richard M. Stallman <rms@gnu.org>
parents: 10291
diff changeset
5277 UNMARK_BALANCE_INTERVALS (BUF_INTERVALS (buffer));
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5278 prev = buffer, buffer = buffer->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5279 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5280 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5281
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5282 /* Free all unmarked vectors */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5283 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5284 register struct Lisp_Vector *vector = all_vectors, *prev = 0, *next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5285 total_vector_size = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5286
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5287 while (vector)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5288 if (!(vector->size & ARRAY_MARK_FLAG))
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5289 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5290 if (prev)
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5291 prev->next = vector->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5292 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5293 all_vectors = vector->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5294 next = vector->next;
23958
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
5295 lisp_free (vector);
7094b74ce0a6 (lisp_malloc, lisp_free): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 23534
diff changeset
5296 n_vectors--;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5297 vector = next;
25024
3bb745067f0e (gc_sweep): Call sweep_weak_hash_tables.
Gerd Moellmann <gerd@gnu.org>
parents: 23973
diff changeset
5298
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5299 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5300 else
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5301 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5302 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
5303 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
5304 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
5305 else
bd3241a14d0a (gc_sweep): If a misc has type Lisp_Misc_Free,
Richard M. Stallman <rms@gnu.org>
parents: 11374
diff changeset
5306 total_vector_size += vector->size;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5307 prev = vector, vector = vector->next;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5308 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5309 }
35183
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
5310
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
5311 #ifdef GC_CHECK_STRING_BYTES
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
5312 if (!noninteractive)
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
5313 check_string_bytes (1);
cc2a06489f0d (CHECK_STRING_BYTES) [GC_CHECK_STRING_BYTES]: New macro.
Gerd Moellmann <gerd@gnu.org>
parents: 35170
diff changeset
5314 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5315 }
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5316
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5317
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5318
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5319
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
5320 /* Debugging aids. */
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
5321
5353
6389ed5b45ac (Fmemory_limit): No longer interactive.
Richard M. Stallman <rms@gnu.org>
parents: 4956
diff changeset
5322 DEFUN ("memory-limit", Fmemory_limit, Smemory_limit, 0, 0, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5323 doc: /* Return the address of the last byte Emacs has allocated, divided by 1024.
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5324 This may be helpful in debugging Emacs's memory usage.
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5325 We divide the value by 1024 to make sure it fits in a Lisp integer. */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5326 ()
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
5327 {
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
5328 Lisp_Object end;
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
5329
9261
e5ba7993d378 (VALIDATE_LISP_STORAGE, make_float, Fcons, Fmake_vector, Fmake_symbol,
Karl Heuer <kwzh@gnu.org>
parents: 9144
diff changeset
5330 XSETINT (end, (EMACS_INT) sbrk (0) / 1024);
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
5331
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
5332 return end;
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
5333 }
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
5334
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
5335 DEFUN ("memory-use-counts", Fmemory_use_counts, Smemory_use_counts, 0, 0, 0,
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5336 doc: /* Return a list of counters that measure how much consing there has been.
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5337 Each of these counters increments for a certain kind of object.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5338 The counters wrap around from the largest positive integer to zero.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5339 Garbage collection does not decrease them.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5340 The elements of the value are as follows:
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5341 (CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS MISCS INTERVALS STRINGS)
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5342 All are in units of 1 = one object consed
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5343 except for VECTOR-CELLS and STRING-CHARS, which count the total length of
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5344 objects consed.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5345 MISCS include overlays, markers, and some internal types.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5346 Frames, windows, buffers, and subprocesses count as vectors
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5347 (but the contents of a buffer's text do not count here). */)
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5348 ()
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
5349 {
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5350 Lisp_Object consed[8];
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5351
39633
a0bf0cb8ff3e (inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents: 39572
diff changeset
5352 consed[0] = make_number (min (MOST_POSITIVE_FIXNUM, cons_cells_consed));
a0bf0cb8ff3e (inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents: 39572
diff changeset
5353 consed[1] = make_number (min (MOST_POSITIVE_FIXNUM, floats_consed));
a0bf0cb8ff3e (inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents: 39572
diff changeset
5354 consed[2] = make_number (min (MOST_POSITIVE_FIXNUM, vector_cells_consed));
a0bf0cb8ff3e (inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents: 39572
diff changeset
5355 consed[3] = make_number (min (MOST_POSITIVE_FIXNUM, symbols_consed));
a0bf0cb8ff3e (inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents: 39572
diff changeset
5356 consed[4] = make_number (min (MOST_POSITIVE_FIXNUM, string_chars_consed));
a0bf0cb8ff3e (inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents: 39572
diff changeset
5357 consed[5] = make_number (min (MOST_POSITIVE_FIXNUM, misc_objects_consed));
a0bf0cb8ff3e (inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents: 39572
diff changeset
5358 consed[6] = make_number (min (MOST_POSITIVE_FIXNUM, intervals_consed));
a0bf0cb8ff3e (inhibit_garbage_collection): Simplify.
Gerd Moellmann <gerd@gnu.org>
parents: 39572
diff changeset
5359 consed[7] = make_number (min (MOST_POSITIVE_FIXNUM, strings_consed));
27142
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5360
f742c86fcc15 (Fgarbage_collect): Return number of live and free
Gerd Moellmann <gerd@gnu.org>
parents: 27006
diff changeset
5361 return Flist (8, consed);
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
5362 }
28406
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
5363
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
5364 int suppress_checking;
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
5365 void
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
5366 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
5367 const char *msg;
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
5368 const char *file;
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
5369 int line;
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
5370 {
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
5371 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
5372 file, line, msg);
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
5373 abort ();
451721e784a8 Stop assuming interval pointers and lisp objects can be distinguished by
Ken Raeburn <raeburn@raeburn.org>
parents: 28374
diff changeset
5374 }
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
5375
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5376 /* Initialization */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5377
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21379
diff changeset
5378 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5379 init_alloc_once ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5380 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5381 /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5382 purebeg = PUREBEG;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5383 pure_size = PURESIZE;
32594
e0646c73bf81 (pure_bytes_used): Renamed from pureptr.
Gerd Moellmann <gerd@gnu.org>
parents: 32587
diff changeset
5384 pure_bytes_used = 0;
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5385 pure_bytes_used_before_overflow = 0;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5386
32692
0343fe9ef3ac (toplevel) [SYSTEM_MALLOC || DOUG_LEA_MALLOC]: Undef
Gerd Moellmann <gerd@gnu.org>
parents: 32609
diff changeset
5387 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5388 mem_init ();
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5389 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
5390 #endif
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5391
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5392 all_vectors = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5393 ignore_warnings = 1;
17345
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
5394 #ifdef DOUG_LEA_MALLOC
4e11e27ce1f1 For glibc's malloc, include <malloc.h> for mallinfo,
Richard M. Stallman <rms@gnu.org>
parents: 17328
diff changeset
5395 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
5396 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
5397 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
5398 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5399 init_strings ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5400 init_cons ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5401 init_symbol ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5402 init_marker ();
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5403 init_float ();
27738
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5404 init_intervals ();
1300
b13b79e28eb5 * alloc.c: #include "intervals.h".
Joseph Arceneaux <jla@gnu.org>
parents: 1295
diff changeset
5405
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
5406 #ifdef REL_ALLOC
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
5407 malloc_hysteresis = 32;
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
5408 #else
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
5409 malloc_hysteresis = 0;
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
5410 #endif
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
5411
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
5412 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
5413
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5414 ignore_warnings = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5415 gcprolist = 0;
26364
7b0217d9259c (Fgarbage_collect): Call mark_byte_stack and
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
5416 byte_stack_list = 0;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5417 staticidx = 0;
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5418 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
5419 gc_cons_threshold = 100000 * sizeof (Lisp_Object);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5420 #ifdef VIRT_ADDR_VARIES
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5421 malloc_sbrk_unused = 1<<22; /* A large number */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5422 malloc_sbrk_used = 100000; /* as reasonable as any number */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5423 #endif /* VIRT_ADDR_VARIES */
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5424 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5425
21514
fa9ff387d260 Fix -Wimplicit warnings.
Andreas Schwab <schwab@suse.de>
parents: 21379
diff changeset
5426 void
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5427 init_alloc ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5428 {
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5429 gcprolist = 0;
26364
7b0217d9259c (Fgarbage_collect): Call mark_byte_stack and
Gerd Moellmann <gerd@gnu.org>
parents: 26164
diff changeset
5430 byte_stack_list = 0;
28365
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
5431 #if GC_MARK_STACK
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
5432 #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
5433 setjmp_tested_p = longjmps_done = 0;
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
5434 #endif
a72abbd8dc16 (mark_maybe_object): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28269
diff changeset
5435 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5436 }
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5437
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5438 void
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5439 syms_of_alloc ()
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5440 {
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5441 DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5442 doc: /* *Number of bytes of consing between garbage collections.
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5443 Garbage collection can happen automatically once this many bytes have been
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5444 allocated since the last garbage collection. All data types count.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5445
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5446 Garbage collection happens automatically only when `eval' is called.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5447
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5448 By binding this temporarily to a large number, you can effectively
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5449 prevent garbage collection during a part of the program. */);
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5450
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5451 DEFVAR_INT ("pure-bytes-used", &pure_bytes_used,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5452 doc: /* Number of bytes of sharable Lisp data allocated so far. */);
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5453
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5454 DEFVAR_INT ("cons-cells-consed", &cons_cells_consed,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5455 doc: /* Number of cons cells that have been consed so far. */);
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5456
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5457 DEFVAR_INT ("floats-consed", &floats_consed,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5458 doc: /* Number of floats that have been consed so far. */);
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5459
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5460 DEFVAR_INT ("vector-cells-consed", &vector_cells_consed,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5461 doc: /* Number of vector cells that have been consed so far. */);
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5462
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5463 DEFVAR_INT ("symbols-consed", &symbols_consed,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5464 doc: /* Number of symbols that have been consed so far. */);
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5465
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5466 DEFVAR_INT ("string-chars-consed", &string_chars_consed,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5467 doc: /* Number of string characters that have been consed so far. */);
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5468
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5469 DEFVAR_INT ("misc-objects-consed", &misc_objects_consed,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5470 doc: /* Number of miscellaneous objects that have been consed so far. */);
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5471
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5472 DEFVAR_INT ("intervals-consed", &intervals_consed,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5473 doc: /* Number of intervals that have been consed so far. */);
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5474
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5475 DEFVAR_INT ("strings-consed", &strings_consed,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5476 doc: /* Number of strings that have been consed so far. */);
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5477
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5478 DEFVAR_LISP ("purify-flag", &Vpurify_flag,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5479 doc: /* Non-nil means loading Lisp code in order to dump an executable.
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5480 This means that certain objects should be allocated in shared (pure) space. */);
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5481
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5482 DEFVAR_INT ("undo-limit", &undo_limit,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5483 doc: /* Keep no more undo information once it exceeds this size.
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5484 This limit is applied when garbage collection happens.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5485 The size is counted as the number of bytes occupied,
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5486 which includes both saved text and other data. */);
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
5487 undo_limit = 20000;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5488
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5489 DEFVAR_INT ("undo-strong-limit", &undo_strong_limit,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5490 doc: /* Don't keep more than this much size of undo information.
39914
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5491 A command which pushes past this size is itself forgotten.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5492 This limit is applied when garbage collection happens.
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5493 The size is counted as the number of bytes occupied,
91951fb5b9e5 Put doc strings in comments.
Gerd Moellmann <gerd@gnu.org>
parents: 39859
diff changeset
5494 which includes both saved text and other data. */);
764
bb24f1180bb6 entered into RCS
Jim Blandy <jimb@redhat.com>
parents: 727
diff changeset
5495 undo_strong_limit = 30000;
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5496
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5497 DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5498 doc: /* Non-nil means display messages at start and end of garbage collection. */);
14959
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
5499 garbage_collection_messages = 0;
f2b5d784fa88 (garbage_collection_messages): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 14764
diff changeset
5500
39988
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5501 DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook,
eac4e9ae201c Change doc-string comments to `new style' [w/`doc:' keyword].
Miles Bader <miles@gnu.org>
parents: 39973
diff changeset
5502 doc: /* Hook run after garbage collection has finished. */);
39572
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5503 Vpost_gc_hook = Qnil;
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5504 Qpost_gc_hook = intern ("post-gc-hook");
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5505 staticpro (&Qpost_gc_hook);
715a67381594 (purebeg, pure_size, pure_bytes_used_before_overflow):
Gerd Moellmann <gerd@gnu.org>
parents: 39297
diff changeset
5506
6116
64417bbbb128 (memory_full): Use new variable memory_signal_data with precomputed value
Karl Heuer <kwzh@gnu.org>
parents: 5874
diff changeset
5507 /* 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
5508 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
5509 memory_signal_data
10673
337c3a4d5fef (emacs_blocked_malloc): Set __malloc_extra_blocks here.
Richard M. Stallman <rms@gnu.org>
parents: 10649
diff changeset
5510 = 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
5511 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
5512
11374
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
5513 staticpro (&Qgc_cons_threshold);
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
5514 Qgc_cons_threshold = intern ("gc-cons-threshold");
1ebc81f84aa4 (inhibit_garbage_collection): New function.
Richard M. Stallman <rms@gnu.org>
parents: 11341
diff changeset
5515
13219
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
5516 staticpro (&Qchar_table_extra_slots);
99b5164a319d (Qchar_table_extra_slots): New variable.
Richard M. Stallman <rms@gnu.org>
parents: 13150
diff changeset
5517 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
5518
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5519 defsubr (&Scons);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5520 defsubr (&Slist);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5521 defsubr (&Svector);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5522 defsubr (&Smake_byte_code);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5523 defsubr (&Smake_list);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5524 defsubr (&Smake_vector);
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
5525 defsubr (&Smake_char_table);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5526 defsubr (&Smake_string);
13141
4a4d1d8e89e5 (Fmake_chartable, Fmake_boolvector): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 13008
diff changeset
5527 defsubr (&Smake_bool_vector);
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5528 defsubr (&Smake_symbol);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5529 defsubr (&Smake_marker);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5530 defsubr (&Spurecopy);
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5531 defsubr (&Sgarbage_collect);
1327
ef16e7c0d402 * alloc.c (Fmemory_limit): New function.
Jim Blandy <jimb@redhat.com>
parents: 1318
diff changeset
5532 defsubr (&Smemory_limit);
12748
3433bb446e06 (cons_cells_consed, floats_consed, vector_cells_consed)
Richard M. Stallman <rms@gnu.org>
parents: 12605
diff changeset
5533 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
5534
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5535 #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
5536 defsubr (&Sgc_status);
581c76c41ca4 (mark_object): Don't mark symbol names in pure space.
Gerd Moellmann <gerd@gnu.org>
parents: 27727
diff changeset
5537 #endif
300
4ee2046fcb72 Initial revision
Jim Blandy <jimb@redhat.com>
parents:
diff changeset
5538 }